path: root/milter_api.ads

-- Milter API for Ada, a binding to Libmilter, the Sendmail mail filtering API
-- Copyright 2009 B. Persson, Bjorn@Rombobeorn.se
--
-- This library is free software: you can redistribute it and/or modify it
-- under the terms of the GNU General Public License version 3, as published
-- by the Free Software Foundation.


with Ada.Strings.Unbounded;
with Interfaces.C.Strings;
with Interfaces.C.Pointers;

package Milter_API is


   --
   -- Version numbers
   --

   type Binding_Version_Type is record
      Specification_Major : Positive;
      Specification_Minor : Positive;
      Implementation      : Positive;
   end record;

   function Binding_Version return Binding_Version_Type;
   -- Binding_Version returns the version of Milter_API that the program is
   -- linked with. If it is dynamically linked, then this is the version that
   -- is loaded at run time.
   -- The fields in the result are:
   --  · Specification_Major: incremented for each new major version of the
   --    Milter_API specification (this file).
   --  · Specification_Minor: incremented when changes are made to the
   --    specification and the major version number cannot be incremented.
   --  · Implementation: incremented for each new version of Milter_API
   --    when the specification is unchanged.

   function Binding_Version_String return String;
   -- Binding_Version_String returns the same version information as
   -- Binding_Version, but in string form.


   --
   -- Data types and constants
   --

   type SMFICTX_Pointer is private;
   -- SMFICTX_Pointer is the type of the opaque context pointers that Libmilter
   -- passes to the callback routines, and that these in turn must pass to the
   -- data access and message handling routines.

   type Milter_Data is limited interface;
   type Milter_Data_Pointer is access all Milter_Data'Class;
   pragma Convention(C, Milter_Data_Pointer);
   -- In order to keep some data between callback invocations, the milter must
   -- derive a type from Milter_Data and allocate one object of that type for
   -- each SMTP session. The pointer to that object must be stored with
   -- Set_Private_Data and retrieved with Private_Data.

   type Action is private;
   -- Action is returned by callback routines. The value is an instruction to
   -- the MTA on how to proceed with the message or connection.

   Continue : constant Action;
   -- Continue processing the message/connection.
   -- (SMFIS_CONTINUE)

   Reject : constant Action;
   -- Reject the message/connection.
   -- No further routines will be called for this message
   -- (or connection, if returned from a connection-oriented routine).
   -- (SMFIS_REJECT)

   Discard : constant Action;
   -- Accept the message,
   -- but silently discard the message.
   -- No further routines will be called for this message.
   -- This is only meaningful from message-oriented routines.
   -- (SMFIS_DISCARD)

   Accept_Definitely : constant Action;
   -- Accept the message/connection.
   -- No further routines will be called for this message
   -- (or connection, if returned from a connection-oriented routine;
   -- in this case, it causes all messages on this connection
   -- to be accepted without filtering).
   -- (SMFIS_ACCEPT)

   Fail_Temporarily : constant Action;
   -- Return a temporary failure, i.e.,
   -- the corresponding SMTP command will return a 4xx status code.
   -- In some cases this may prevent further routines from
   -- being called on this message or connection,
   -- although in other cases (e.g., when processing an envelope
   -- recipient) processing of the message will continue.
   -- (SMFIS_TEMPFAIL)

   type Sockaddr is private;

   type Arguments_Handle is private;

   type Unbounded_Strings is
      array(Positive range <>) of Ada.Strings.Unbounded.Unbounded_String;


   --
   -- Callback types
   --

   type Connect_Handler is access function
      (Context        : SMFICTX_Pointer;  -- the opaque context handle
       Client_Name    : String;           -- the name of the client
       Client_Address : Sockaddr)         -- the address of the client
      return Action;
   -- called at the start of each SMTP connection
   -- corresponds to xxfi_connect
   -- Client_Name is the host name of the client, as determined by a reverse
   -- lookup on the host address. Client_Address describes the client's endpoint
   -- of the SMTP connection. The means to access the contents of Client_Address
   -- are not implemented.

   type Helo_Handler is access function
      (Context     : SMFICTX_Pointer;  -- the opaque context handle
       Stated_Name : String)           -- what the client sent as parameter to
                                       -- the HELO or EHLO command
      return Action;
   -- called when the client sends a HELO or EHLO command
   -- corresponds to xxfi_helo

   type Sender_Handler is access function
      (Context   : SMFICTX_Pointer;   -- the opaque context handle
       Sender    : String;            -- the envelope sender address
       Arguments : Arguments_Handle)  -- ESMTP arguments to the MAIL command
      return Action;
   -- called once at the beginning of each message
   -- corresponds to xxfi_envfrom

   type Recipient_Handler is access function
      (Context   : SMFICTX_Pointer;   -- the opaque context handle
       Recipient : String;            -- an envelope recipient address
       Arguments : Arguments_Handle)  -- ESMTP arguments to the RCPT command
      return Action;
   -- called once per recipient
   -- corresponds to xxfi_envrcpt

   type Data_Handler is access function
      (Context : SMFICTX_Pointer)  -- the opaque context handle
      return Action;
   -- called when the client sends the DATA command
   -- corresponds to xxfi_data

   type Unknown_Command_Handler is access function
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Command : String)           -- the unknown command including arguments
      return Action;
   -- called if the client sends an SMTP command that is either unknown or not
   -- implemented by the MTA
   -- corresponds to xxfi_unknown

   type Header_Handler is access function
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Name    : String;           -- the name of the header
       Value   : String)           -- the content of the header
      return Action;
   -- called once per message header
   -- corresponds to xxfi_header

   type End_Of_Headers_Handler is access function
      (Context : SMFICTX_Pointer)  -- the opaque context handle
      return Action;
   -- called after all headers have been processed
   -- corresponds to xxfi_eoh

   type Body_Handler is access function
      (Context    : SMFICTX_Pointer;  -- the opaque context handle
       Body_Chunk : String)           -- a piece of the message body
      return Action;
   -- called zero or more times between End_Of_Headers_Handler and
   -- End_Of_Message_Handler
   -- corresponds to xxfi_body

   type End_Of_Message_Handler is access function
      (Context : SMFICTX_Pointer)  -- the opaque context handle
      return Action;
   -- called at the end of a message
   -- This is the place to call message modification procedures.
   -- corresponds to xxfi_eom

   type Abort_Handler is access procedure
      (Context : SMFICTX_Pointer);  -- the opaque context handle
   -- called at any time during message processing if the message is aborted
   -- corresponds to xxfi_abort

   type Close_Handler is access procedure
      (Context : SMFICTX_Pointer);  -- the opaque context handle
   -- called once at the end of each connection
   -- corresponds to xxfi_close


   --
   -- Exceptions
   --

   Failure : exception;
   -- A call to an API procedure failed.
   -- (The corresponding C function returned MI_FAILURE.)

   Unknown_Error : exception;
   -- A C function returned an undocumented result code.


   --
   -- Library control procedures
   --

   procedure Register
      (Name                              : String;
       Connected                         : Connect_Handler            := null;
       Helo                              : Helo_Handler               := null;
       Sender                            : Sender_Handler             := null;
       Recipient                         : Recipient_Handler          := null;
       Data                              : Data_Handler               := null;
       Unknown_Command                   : Unknown_Command_Handler    := null;
       Header                            : Header_Handler             := null;
       End_Of_Headers                    : End_Of_Headers_Handler     := null;
       Body_Chunk                        : Body_Handler               := null;
       End_Of_Message                    : End_Of_Message_Handler     := null;
       Aborted                           : Abort_Handler              := null;
       Closed                            : Close_Handler              := null;
       May_Add_Headers                   : Boolean                    := False;
       May_Change_Or_Delete_Headers      : Boolean                    := False;
       May_Replace_Body                  : Boolean                    := False;
       May_Add_Recipients                : Boolean                    := False;
       May_Remove_Recipients             : Boolean                    := False;
       May_Quarantine                    : Boolean                    := False);
   -- Register must be called exactly once before Main. It registers the
   -- callbacks and properties of the milter (calls smfi_register).

   procedure Set_Timeout(Timeout : Natural);
   -- Set_Timeout should only be called before Main. It sets the number of
   -- seconds Libmilter will wait for an MTA connection before timing out a
   -- socket (calls smfi_settimeout).

   procedure Set_Connection_Queue_Length(Length : Positive);
   -- Set_Connection_Queue_Length should only be called before Main. It
   -- sets the number of incoming connections to allow in the listen queue
   -- (calls smfi_setbacklog).

   procedure Set_Socket(Address : String);
   -- Set_Socket must be called once before Main. It specifies the socket
   -- through which the milter should communicate with the MTA (calls
   -- smfi_setconn).

   procedure Open_Socket(Remove_Old_Socket : Boolean);
   -- Open_Socket should only be called before Main. It creates the socket
   -- specified previously by a call to Set_Socket (calls smfi_opensocket).
   -- This allows the calling application to ensure that the socket can be
   -- created. If the socket is specified as a Unix domain socket and
   -- Remove_Old_Socket is true, then Libmilter will try to remove any existing
   -- socket before creating a new one.
   -- If Open_Socket is not called, then Main will create the socket.

   procedure Main;
   -- Hands control to the Libmilter event loop (calls smfi_main).

   procedure Set_Debug_Level(Level : Natural);
   -- Set_Debug_Level may be called from any routine at any time. It changes
   -- Libmilter's internal debug logging level (calls smfi_setdbg). A value of
   -- zero turns off debug logging. The greater the value the more detailed the
   -- logging.

   procedure Stop;
   -- Stop may be called from any of the callback routines or any error-handling
   -- routines at any time. It tells Libmilter to shut down the milter (calls
   -- smfi_stop).


   --
   -- Data access subprograms
   --

   function Arguments(Handle : Arguments_Handle) return Unbounded_Strings;
   -- Converts the ESMTP arguments to a MAIL or RCPT command into an array of
   -- unbounded strings.

   procedure Get_Symbol_Value
      (Context : in  SMFICTX_Pointer;  -- the opaque context handle
       Name    : in  String;           -- the name of the requested symbol
       Defined : out Boolean;          -- whether the requested symbol exists
       Value   : out Ada.Strings.Unbounded.Unbounded_String);
   -- Requests the value of a symbol ("macro") from the MTA. Value is
   -- meaningful only if Defined is True.

   procedure Set_Private_Data
      (Context : SMFICTX_Pointer;       -- the opaque context handle
       Data    : Milter_Data_Pointer);  -- pointer to private data
   -- Sets the private data pointer to be returned by future calls to
   -- Private_Data for this connection (calls smfi_setpriv).

   function Private_Data
      (Context : SMFICTX_Pointer)  -- the opaque context handle
      return Milter_Data_Pointer;
   -- Retrieves the private data pointer previously stored with Set_Private_Data
   -- for this connection (calls smfi_getpriv).

   subtype String_Of_Three is String(1..3);
   procedure Set_Reply
      (Context       : SMFICTX_Pointer;  -- the opaque context handle
       Reply_Code    : String_Of_Three;  -- three-digit (RFC 2821) reply code
       Extended_Code : String := "";     -- extended (RFC 2034) reply code
       Message       : String := "");    -- the text part of the reply
   -- Sets the reply codes and message to be used in subsequent SMTP error
   -- replies caused by the milter (calls smfi_setreply).
   -- There is no interface to smfi_setmlreply yet.


   --
   -- Message modification procedures
   --
   -- These procedures may only be called from a callback function registered as
   -- End_Of_Message.

   procedure Add_Header
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Name    : String;           -- the header field name
       Value   : String);          -- the header field body
   -- Adds a header field to the current message (calls smfi_addheader).

   procedure Change_Header
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Name    : String;           -- the header field name
       Index   : Positive;         -- index among headers with the same name
       Value   : String);          -- the new header field body
   -- Replaces the header field body of the specified header field in the
   -- current message (calls smfi_chgheader). Index specifies which of the
   -- headers with the name Name shall be changed.

   procedure Delete_Header
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Name    : String;           -- the header field name
       Index   : Positive);        -- index among headers with the same name
   -- Removes the specified header field from the current message (calls
   -- smfi_chgheader with headerv set to null).

   procedure Insert_Header
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Index   : Positive;         -- index among all headers
       Name    : String;           -- the header field name
       Value   : String);          -- the header field body
   -- Adds a header field at a specified position in the current message
   -- (calls smfi_insheader). Index specifies where in the list of headers it
   -- shall be inserted. 1 makes it the first header, 2 the second and so on.

   procedure Add_Recipient
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Address : String);          -- the new recipient's address
   -- Adds a recipient address to the envelope of the current message (calls
   -- smfi_addrcpt).

   procedure Delete_Recipient
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Address : String);          -- the recipient address to be removed
   -- Removes the specified recipient address from the envelope of the current
   -- message (calls smfi_delrcpt).

   procedure Replace_Body
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Data    : String);          -- the new message body
   -- Replaces the body of the current message (calls smfi_replacebody). If
   -- called more than once, subsequent calls append data to the new body.


   --
   -- Other message handling procedures
   --
   -- These procedures may only be called from a callback function registered as
   -- End_Of_Message.

   procedure Report_Progress
      (Context : SMFICTX_Pointer);  -- the opaque context handle
   -- Notifies the MTA that the milter is still working on a message (calls
   -- smfi_progress).

   procedure Quarantine_Message
      (Context : SMFICTX_Pointer;  -- the opaque context handle
       Reason  : String);          -- the quarantine reason
   -- Quarantines the current message (calls smfi_quarantine).


private

   type Dummy_Type is null record;
   type SMFICTX_Pointer is access Dummy_Type;
   pragma convention(C, Dummy_Type);
   pragma convention(C, SMFICTX_Pointer);

   type Action is range 0 .. 10;
   Continue          : constant Action := 0;
   Reject            : constant Action := 1;
   Discard           : constant Action := 2;
   Accept_Definitely : constant Action := 3;
   Fail_Temporarily  : constant Action := 4;
   All_Options       : constant Action := 10;

   type Sockaddr is null record;
   -- Accessing socket addresses isn't implemented. The type is declared just
   -- so that there's a chance that the API will be compatible if this gets
   -- implemented in the future.

   use Interfaces.C;
   use Interfaces.C.Strings;

   type chars_ptr_array is array(size_t range <>) of aliased chars_ptr;
   -- This type definition can be removed if and when Interfaces.C.Strings gets
   -- updated to conform to Ada 2005.

   package String_Arrays is
      new Interfaces.C.Pointers(Index              => size_t,
                                Element            => chars_ptr,
                                Element_Array      => chars_ptr_array,
                                Default_Terminator => Null_Ptr);

   type Arguments_Handle is record
      Pointer : String_Arrays.Pointer;
   end record;

end Milter_API;