imported

1 files changed, 427 insertions, 0 deletions

diff --git a/milter_api.ads b/milter_api.ads
new file mode 100644
index 0000000..3e37163
--- /dev/null
+++ b/milter_api.ads
@@ -0,0 +1,427 @@
+-- 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 Envelope_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 Envelope_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;
+       Envelope_Sender                   : Envelope_Sender_Handler    := null;
+       Envelope_Recipient                : Envelope_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_Recepients                : Boolean                    := False;
+       May_Remove_Recepients             : 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 recepient 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 recepient 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;