diff options
Diffstat (limited to 'milter_api.ads')
| -rw-r--r-- | milter_api.ads | 326 |
1 files changed, 285 insertions, 41 deletions
diff --git a/milter_api.ads b/milter_api.ads index 8a4facf..9097e69 100644 --- a/milter_api.ads +++ b/milter_api.ads @@ -1,5 +1,5 @@ --- Milter API for Ada, a binding to Libmilter, the Sendmail mail filtering API --- Copyright 2009 B. Persson, Bjorn@Rombobeorn.se +-- Ada Milter API, a binding to Libmilter, the Sendmail mail filtering API +-- Copyright 2009 - 2012 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 @@ -9,6 +9,7 @@ with Ada.Strings.Unbounded; with Interfaces.C.Strings; with Interfaces.C.Pointers; +with System; package Milter_API is @@ -39,11 +40,100 @@ package Milter_API is -- Binding_Version_String returns the same version information as -- Binding_Version, but in string form. + type Libmilter_Version_Type is record + Major : Natural; + Minor : Natural; + Patch_Level : Natural; + end record; + + function Libmilter_Version return Libmilter_Version_Type; + -- Libmilter_Version returns the version of Libmilter that Milter_API is + -- linked with (calls smfi_version). If it is dynamically linked, then this + -- is the version that is loaded at run time. + + function Libmilter_Version_String return String; + -- Libmilter_Version_String returns the same version information as + -- Libmilter_Version, but in string form. + -- -- Data types and constants -- + type Options is record + Add_Headers : Boolean := False; + -- The milter may add header fields to messages (call Add_Header). + Change_Or_Delete_Headers : Boolean := False; + -- The milter may change and/or delete header fields in messages (call + -- Change_Header and/or Delete_Header). + Replace_Body : Boolean := False; + -- The milter may replace message bodies (call Replace_Body). + Add_Recipients : Boolean := False; + -- The milter may add recipients to the SMTP envelope (with or without + -- ESMTP extension parameters attached) (call Add_Recipient). + Remove_Recipients : Boolean := False; + -- The milter may remove recipients from the SMTP envelope (call + -- Delete_Recipient). + Quarantine : Boolean := False; + -- The milter may quarantine messages (call Quarantine_Message). + Change_Sender : Boolean := False; + -- The milter may change the sender in the SMTP envelope (call + -- Change_Sender). + Request_Symbols : Boolean := False; + -- The milter may specify a set of symbols ("macros") that it wants (call + -- Request_Symbols). + Show_Rejected_Recipients : Boolean := False; + -- Call the Recipient_Handler also for RCPT commands that the MTA rejects + -- because the user is unknown or similar reasons. RCPT commands that are + -- rejected because of syntax errors or suchlike will still not be shown + -- to the milter. If the symbol {rcpt_mailer} has the value "error", then + -- the recipient will be rejected by the MTA. In that case the symbols + -- {rcpt_host} and {rcpt_addr} will usually contain an enhanced status + -- code and an error text, respectively. + Skip_Further_Callbacks : Boolean := False; + -- Callback routines may return Skip. + Headers_With_Leading_Space : Boolean := False; + -- Pass header values to the Header_Handler with leading space intact, + -- and do not add a leading space to headers when they are added, + -- inserted or changed. + Suppress_Connected : Boolean := False; + -- Don't call the Connect_Handler. + Suppress_Helo : Boolean := False; + -- Don't call the Helo_Handler. + Suppress_Sender : Boolean := False; + -- Don't call the Sender_Handler. + Suppress_Recipient : Boolean := False; + -- Don't call the Recipient_Handler + Suppress_Data : Boolean := False; + -- Don't call the Data_Handler. + Suppress_Unknown_Command : Boolean := False; + -- Don't call the Unknown_Command_Handler. + Suppress_Header : Boolean := False; + -- Don't call the Header_Handler. + Suppress_End_Of_Headers : Boolean := False; + -- Don't call the End_Of_Headers_Handler. + Suppress_Body_Chunk : Boolean := False; + -- Don't call the Body_Handler. + No_Reply_To_Connected : Boolean := False; + -- The Connect_Handler will return No_Reply. + No_Reply_To_Helo : Boolean := False; + -- The Helo_Handler will return No_Reply. + No_Reply_To_Sender : Boolean := False; + -- The Sender_Handler will return No_Reply. + No_Reply_To_Recipient : Boolean := False; + -- The Recipient_Handler will return No_Reply. + No_Reply_To_Data : Boolean := False; + -- The Data_Handler will return No_Reply. + No_Reply_To_Unknown_Command : Boolean := False; + -- The Unknown_Command_Handler will return No_Reply. + No_Reply_To_Header : Boolean := False; + -- The Header_Handler will return No_Reply. + No_Reply_To_End_Of_Headers : Boolean := False; + -- The End_Of_Headers_Handler will return No_Reply. + No_Reply_To_Body_Chunk : Boolean := False; + -- The Body_Handler will return No_Reply. + end record; + 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 @@ -57,6 +147,33 @@ package Milter_API is -- each SMTP session. The pointer to that object must be stored with -- Set_Private_Data and retrieved with Private_Data. + type Protocol_Stage is private; + -- A Protocol_Stage is passed to Request_Symbols to specify which callback + -- routines want the requested symbols. + + At_Connect : constant Protocol_Stage; + At_Helo : constant Protocol_Stage; + At_Sender : constant Protocol_Stage; + At_Recipient : constant Protocol_Stage; + At_Data : constant Protocol_Stage; + At_End_Of_Headers : constant Protocol_Stage; + At_End_Of_Message : constant Protocol_Stage; + + type Negotiation_Result is private; + -- Negotiation_Result is returned by the callback routine Negotiate. + + All_Options : constant Negotiation_Result; + -- Use all available protocol steps and actions. + -- (SMFIS_ALL_OPTS) + + These_Options : constant Negotiation_Result; + -- Use the selected protocol steps and actions. + -- (SMFIS_CONTINUE) + + Failed : constant Negotiation_Result; + -- The milter failed to start up. + -- (SMFIS_REJECT) + 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. @@ -95,18 +212,79 @@ package Milter_API is -- recipient) processing of the message will continue. -- (SMFIS_TEMPFAIL) + No_Reply : constant Action; + -- Do not send a reply to the MTA. + -- (SMFIS_NOREPLY) + + Skip : constant Action; + -- Skip over rest of same callbacks, e.g., body. + -- (SMFIS_SKIP) + type Sockaddr is private; + -- A Sockaddr is an opaque handle that points to a TCP endpoint address + -- (that is a combination of an IP address and a TCP port). The functions + -- Address and Port may be used to retrieve the address data. + + type Address_Family is (IPv4, IPv6); + + type Byte_Array is array(Positive range <>) of Interfaces.Unsigned_8; + for Byte_Array'Component_Size use 8; + + type IP_Address(Family : Address_Family := IPv4) is record + case Family is + when IPv4 => + IPv4_Address : Byte_Array(1..4); + when IPv6 => + IPv6_Address : Byte_Array(1..16); + end case; + end record; type Arguments_Handle is private; + -- An Arguments_Handle holds ESMTP arguments to a MAIL or RCPT command. The + -- function Arguments may be used to retrieve the arguments. type Unbounded_Strings is array(Positive range <>) of Ada.Strings.Unbounded.Unbounded_String; + subtype String_Of_Three is String(1..3); + -- three-digit (RFC 2821) reply code + + subtype Reply_Line_Index is Positive range 1 .. 32; + type Reply_Lines is + array(Reply_Line_Index range <>) of Ada.Strings.Unbounded.Unbounded_String; + -- -- Callback types -- + type Negotiator is access procedure + (Context : in SMFICTX_Pointer; -- the opaque context handle + Offered : in Options; -- options the MTA can provide + Result : out Negotiation_Result; -- how to proceed + Requested : out Options); -- options the milter wants to use + -- called at the start of each SMTP connection + -- A Negotiator enables a milter to determine which options are available + -- and dynamically select those which it needs and which are offered. If + -- some options are not available, the milter may fall back to a less + -- optimized way of working, operate with reduced functionality, or abort + -- the session and ask the user to upgrade. + -- corresponds to xxfi_negotiate + -- The possible values of Result are: + -- * All_Options: Use all available protocol steps and actions. The value of + -- Requested will be ignored. + -- * These_Options: Use those protocol steps and actions that are specified + -- in Requested. + -- * Failed: The milter failed to start up. It will not be contacted again + -- for the current connection. + -- More options may be added in future versions of Milter_API. If so, they + -- will be off by default so that milters that are unaware of them will + -- continue working the same way as before. To ensure that your Negotiator + -- will be compatible with future extensions, do not assign an aggregate to + -- Requested listing all the components. Either declare an Options variable + -- and assign to individual components, or use an aggregate with named + -- component associations and an "others => <>" association. + type Connect_Handler is access function (Context : SMFICTX_Pointer; -- the opaque context handle Client_Name : String; -- the name of the client @@ -129,18 +307,19 @@ package Milter_API is type Sender_Handler is access function (Context : SMFICTX_Pointer; -- the opaque context handle - Sender : String; -- the envelope sender address + Sender : String; -- the SMTP envelope sender address Arguments : Arguments_Handle) -- ESMTP arguments to the MAIL command return Action; - -- called once at the beginning of each message + -- called once at the beginning of each message, when the client sends the + -- MAIL command -- corresponds to xxfi_envfrom type Recipient_Handler is access function (Context : SMFICTX_Pointer; -- the opaque context handle - Recipient : String; -- an envelope recipient address + Recipient : String; -- an SMTP envelope recipient address Arguments : Arguments_Handle) -- ESMTP arguments to the RCPT command return Action; - -- called once per recipient + -- called once per recipient, when the client sends an RCPT command -- corresponds to xxfi_envrcpt type Data_Handler is access function @@ -208,31 +387,42 @@ package Milter_API is Unknown_Error : exception; -- A C function returned an undocumented result code. + No_Address : exception; + -- A Sockaddr handle that didn't point to anything was passed to Address or + -- Port. + + Unknown_Address_Type : exception; + -- A Sockaddr handle that pointed to something other than an IPv4 or IPv6 + -- address was passed to Address or Port. + -- -- 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); + (Name : String; + Negotiate : Negotiator := null; + 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; + May_Change_Sender : Boolean := False; + May_Request_Symbols : Boolean := False); -- Register must be called exactly once before Main. It registers the -- callbacks and properties of the milter (calls smfi_register). @@ -276,6 +466,18 @@ package Milter_API is -- + -- Protocol negotiation procedure + -- + + procedure Request_Symbols + (Context : SMFICTX_Pointer; -- the opaque context handle + Stage : Protocol_Stage; -- when the symbols are wanted + Names : String); -- space-separated list of wanted symbols + -- Defines the set of symbols ("macros") that the milter wants to receive + -- from the MTA at the specified protocol stage (calls smfi_setsymlist). + + + -- -- Data access subprograms -- @@ -288,8 +490,8 @@ package Milter_API is 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. + -- Requests the value of a symbol ("macro") from the MTA (calls + -- smfi_getsymval). Value is meaningful only if Defined is True. procedure Set_Private_Data (Context : SMFICTX_Pointer; -- the opaque context handle @@ -303,7 +505,6 @@ package Milter_API is -- 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 @@ -311,7 +512,27 @@ package Milter_API is 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. + + 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 : Reply_Lines); -- the text part of the reply + -- Sets the reply codes and multiple-line message to be used in subsequent + -- SMTP error replies caused by the milter (calls smfi_setmlreply). + + function Address(Endpoint : Sockaddr) return IP_Address; + -- Returns the IP address from a Sockaddr handle, or raises No_Address if + -- the handle doesn't point to anything. + + function Address(Endpoint : Sockaddr) return String; + -- Returns the textual representation of the IP address from a Sockaddr + -- handle, or returns "(address unavailable)" if the handle doesn't point to + -- anything. + + function Port(Endpoint : Sockaddr) return Interfaces.Unsigned_16; + -- Returns the TCP port from a Sockaddr handle, or raises No_Address if the + -- handle doesn't point to anything. -- @@ -351,17 +572,26 @@ package Milter_API is -- (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 Change_Sender + (Context : SMFICTX_Pointer; -- the opaque context handle + Address : String; -- the new sender address + Parameters : String := ""); -- extension parameters + -- Changes the sender address of the SMTP envelope of the current message, + -- optionally with ESMTP extension parameters attached (calls smfi_chgfrom). + 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). + (Context : SMFICTX_Pointer; -- the opaque context handle + Address : String; -- the new recipient address + Parameters : String := ""); -- extension parameters + -- Adds a recipient address to the SMTP envelope of the current message, + -- optionally with ESMTP extension parameters attached (calls + -- smfi_addrcpt_par). 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). + -- Removes the specified recipient address from the SMTP envelope of the + -- current message (calls smfi_delrcpt). procedure Replace_Body (Context : SMFICTX_Pointer; -- the opaque context handle @@ -394,18 +624,32 @@ private pragma convention(C, Dummy_Type); pragma convention(C, SMFICTX_Pointer); - type Action is range 0 .. 10; + type Protocol_Stage is range 0 .. 6; + At_Connect : constant Protocol_Stage := 0; + At_Helo : constant Protocol_Stage := 1; + At_Sender : constant Protocol_Stage := 2; + At_Recipient : constant Protocol_Stage := 3; + At_Data : constant Protocol_Stage := 4; + At_End_Of_Message : constant Protocol_Stage := 5; + At_End_Of_Headers : constant Protocol_Stage := 6; + + type Negotiation_Result is range 0 .. 10; + These_Options : constant Negotiation_Result := 0; + Failed : constant Negotiation_Result := 1; + All_Options : constant Negotiation_Result := 10; + + type Action is range 0 .. 8; 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; + No_Reply : constant Action := 7; + Skip : constant Action := 8; + + type Sockaddr is new System.Address; - 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. + Null_Address : constant Sockaddr := Sockaddr(System.Null_Address); use Interfaces.C; use Interfaces.C.Strings; |