From c362ad36de4002064ffbf0bd3c187c6857cc6795 Mon Sep 17 00:00:00 2001 From: Björn Persson Date: Mon, 4 Jan 2010 23:45:43 +0000 Subject: imported --- milter_api.ads | 427 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 427 insertions(+) create mode 100644 milter_api.ads (limited to 'milter_api.ads') 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; -- cgit v1.2.3