-- 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;