· Added new features corresponding to new versions of Libmilter.

· Added a multiple-line version of Set_Reply.
· Added functions to access the client's IP address and port.
· Clarified error messages.
· Clarified some comments.

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;