· 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, 409 insertions, 89 deletions

diff --git a/milter_api.adb b/milter_api.adb
index 68f9bcb..e8f02d3 100644
--- a/milter_api.adb
+++ b/milter_api.adb
@@ -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
@@ -7,19 +7,17 @@
 
 
 with Ada.Exceptions; use Ada.Exceptions;
-with Ada.Strings.Fixed;
 with System_Log; use System_Log;
+with Ada.Strings.Fixed;
 
 package body Milter_API is
 
-   pragma Linker_Options("-lmilter");
-   pragma Linker_Options("-lpthread");
-
    use Ada.Strings.Unbounded;
    use type String_Arrays.Pointer;
+   use Interfaces;
 
 
-   Version : constant Binding_Version_Type := (1, 2, 1);
+   Version : constant Binding_Version_Type := (2, 1, 1);
 
    function Binding_Version return Binding_Version_Type is
    begin
@@ -34,23 +32,88 @@ package body Milter_API is
              Trim(Version.Implementation'Img, Left);
    end Binding_Version_String;
 
-   Target_Version : constant int := 2;
-   -- Target_Version is the value of SMFI_VERSION in the version of Libmilter
-   -- that this version of Milter_API is intended to match.
+   function Libmilter_Version return Libmilter_Version_Type is
+      procedure smfi_version
+         (pmajor : out unsigned;
+          pminor : out unsigned;
+          ppl    : out unsigned);
+      pragma import(C, smfi_version);
+      Major       : unsigned;
+      Minor       : unsigned;
+      Patch_Level : unsigned;
+   begin
+      smfi_version(Major, Minor, Patch_Level);
+      return (Natural(Major), Natural(Minor), Natural(Patch_Level));
+   end Libmilter_Version;
 
+   function Libmilter_Version_String return String is
+      Version : constant Libmilter_Version_Type := Libmilter_Version;
+      use Ada.Strings, Ada.Strings.Fixed;
+   begin
+      return Trim(Version.Major'Img, Left) & '.' &
+             Trim(Version.Minor'Img, Left) & '.' &
+             Trim(Version.Patch_Level'Img, Left);
+   end Libmilter_Version_String;
 
-   Real_Connect_Handler            : Connect_Handler;
-   Real_Helo_Handler               : Helo_Handler;
-   Real_Sender_Handler             : Sender_Handler;
-   Real_Recipient_Handler          : Recipient_Handler;
-   Real_Header_Handler             : Header_Handler;
-   Real_End_Of_Headers_Handler     : End_Of_Headers_Handler;
-   Real_Body_Handler               : Body_Handler;
-   Real_End_Of_Message_Handler     : End_Of_Message_Handler;
-   Real_Abort_Handler              : Abort_Handler;
-   Real_Close_Handler              : Close_Handler;
-   Real_Unknown_Command_Handler    : Unknown_Command_Handler;
-   Real_Data_Handler               : Data_Handler;
+
+   function Flag(B : Boolean) return unsigned_long is
+   begin
+      if B then
+         return 1;
+      else
+         return 0;
+      end if;
+   end Flag;
+   pragma Inline(Flag);
+
+
+   -- Option flags:
+   SMFIF_ADDHDRS     : constant := 16#1#;       -- add headers
+   SMFIF_CHGBODY     : constant := 16#2#;       -- replace body
+   SMFIF_ADDRCPT     : constant := 16#4#;       -- add envelope recipients
+   SMFIF_DELRCPT     : constant := 16#8#;       -- delete envelope recipients
+   SMFIF_CHGHDRS     : constant := 16#10#;      -- change/delete headers
+   SMFIF_QUARANTINE  : constant := 16#20#;      -- quarantine envelope
+   SMFIF_CHGFROM     : constant := 16#40#;      -- change envelope sender
+   SMFIF_ADDRCPT_PAR : constant := 16#80#;      -- add recipients with args
+   SMFIF_SETSYMLIST  : constant := 16#100#;     -- request set of symbols
+   SMFIP_NOCONNECT   : constant := 16#1#;       -- don't send connect info
+   SMFIP_NOHELO      : constant := 16#2#;       -- don't send HELO info
+   SMFIP_NOMAIL      : constant := 16#4#;       -- don't send MAIL info
+   SMFIP_NORCPT      : constant := 16#8#;       -- don't send RCPT info
+   SMFIP_NOBODY      : constant := 16#10#;      -- don't send body
+   SMFIP_NOHDRS      : constant := 16#20#;      -- don't send headers
+   SMFIP_NOEOH       : constant := 16#40#;      -- don't send EOH
+   SMFIP_NR_HDR      : constant := 16#80#;      -- No reply for headers
+   SMFIP_NOUNKNOWN   : constant := 16#100#;     -- don't send unknown commands
+   SMFIP_NODATA      : constant := 16#200#;     -- don't send DATA
+   SMFIP_SKIP        : constant := 16#400#;     -- MTA understands SMFIS_SKIP
+   SMFIP_RCPT_REJ    : constant := 16#800#;     -- also send rejected RCPTs
+   SMFIP_NR_CONN     : constant := 16#1000#;    -- No reply for connect
+   SMFIP_NR_HELO     : constant := 16#2000#;    -- No reply for HELO
+   SMFIP_NR_MAIL     : constant := 16#4000#;    -- No reply for MAIL
+   SMFIP_NR_RCPT     : constant := 16#8000#;    -- No reply for RCPT
+   SMFIP_NR_DATA     : constant := 16#10000#;   -- No reply for DATA
+   SMFIP_NR_UNKN     : constant := 16#20000#;   -- No reply for UNKN
+   SMFIP_NR_EOH      : constant := 16#40000#;   -- No reply for eoh
+   SMFIP_NR_BODY     : constant := 16#80000#;   -- No reply for body chunk
+   SMFIP_HDR_LEADSPC : constant := 16#100000#;  -- header value leading space
+
+
+   -- Callback pointers:
+   Real_Negotiator              : Negotiator;
+   Real_Connect_Handler         : Connect_Handler;
+   Real_Helo_Handler            : Helo_Handler;
+   Real_Sender_Handler          : Sender_Handler;
+   Real_Recipient_Handler       : Recipient_Handler;
+   Real_Data_Handler            : Data_Handler;
+   Real_Unknown_Command_Handler : Unknown_Command_Handler;
+   Real_Header_Handler          : Header_Handler;
+   Real_End_Of_Headers_Handler  : End_Of_Headers_Handler;
+   Real_Body_Handler            : Body_Handler;
+   Real_End_Of_Message_Handler  : End_Of_Message_Handler;
+   Real_Abort_Handler           : Abort_Handler;
+   Real_Close_Handler           : Close_Handler;
 
 
    type sfsistat is new int;
@@ -58,7 +121,8 @@ package body Milter_API is
 
    procedure Oops(E : Exception_Occurrence) is
    begin
-      Log(Error, Exception_Information(E));
+      Log(Error,
+          "Milter_API: Error in callback routine: " & Exception_Information(E));
       Stop;
    end Oops;
 
@@ -69,29 +133,143 @@ package body Milter_API is
    end Oops;
 
 
+   type C_Negotiator is access function
+      (ctx : SMFICTX_Pointer;
+       f0  : unsigned_long;
+       f1  : unsigned_long;
+       f2  : unsigned_long;
+       f3  : unsigned_long;
+       pf0 : access unsigned_long;
+       pf1 : access unsigned_long;
+       pf2 : access unsigned_long;
+       pf3 : access unsigned_long)
+      return sfsistat;
+   pragma convention(C, C_Negotiator);
+
+   function Negotiator_Relay
+      (ctx : SMFICTX_Pointer;
+       f0  : unsigned_long;
+       f1  : unsigned_long;
+       f2  : unsigned_long;
+       f3  : unsigned_long;
+       pf0 : access unsigned_long;
+       pf1 : access unsigned_long;
+       pf2 : access unsigned_long;
+       pf3 : access unsigned_long)
+      return sfsistat;
+   pragma convention(C, Negotiator_Relay);
+
+   function Negotiator_Relay
+      (ctx : SMFICTX_Pointer;
+       f0  : unsigned_long;
+       f1  : unsigned_long;
+       f2  : unsigned_long;
+       f3  : unsigned_long;
+       pf0 : access unsigned_long;
+       pf1 : access unsigned_long;
+       pf2 : access unsigned_long;
+       pf3 : access unsigned_long)
+      return sfsistat
+   is
+      Offered   : constant Options :=
+         (Add_Headers                 => (f0 and SMFIF_ADDHDRS)     /= 0,
+          Change_Or_Delete_Headers    => (f0 and SMFIF_CHGHDRS)     /= 0,
+          Replace_Body                => (f0 and SMFIF_CHGBODY)     /= 0,
+          Add_Recipients              => (f0 and SMFIF_ADDRCPT_PAR) /= 0,
+          Remove_Recipients           => (f0 and SMFIF_DELRCPT)     /= 0,
+          Quarantine                  => (f0 and SMFIF_QUARANTINE)  /= 0,
+          Change_Sender               => (f0 and SMFIF_CHGFROM)     /= 0,
+          Request_Symbols             => (f0 and SMFIF_SETSYMLIST)  /= 0,
+          Show_Rejected_Recipients    => (f1 and SMFIP_RCPT_REJ)    /= 0,
+          Skip_Further_Callbacks      => (f1 and SMFIP_SKIP)        /= 0,
+          Headers_With_Leading_Space  => (f1 and SMFIP_HDR_LEADSPC) /= 0,
+          Suppress_Connected          => (f1 and SMFIP_NOCONNECT)   /= 0,
+          Suppress_Helo               => (f1 and SMFIP_NOHELO)      /= 0,
+          Suppress_Sender             => (f1 and SMFIP_NOMAIL)      /= 0,
+          Suppress_Recipient          => (f1 and SMFIP_NORCPT)      /= 0,
+          Suppress_Data               => (f1 and SMFIP_NODATA)      /= 0,
+          Suppress_Unknown_Command    => (f1 and SMFIP_NOUNKNOWN)   /= 0,
+          Suppress_Header             => (f1 and SMFIP_NOHDRS)      /= 0,
+          Suppress_End_Of_Headers     => (f1 and SMFIP_NOEOH)       /= 0,
+          Suppress_Body_Chunk         => (f1 and SMFIP_NOBODY)      /= 0,
+          No_Reply_To_Connected       => (f1 and SMFIP_NR_CONN)     /= 0,
+          No_Reply_To_Helo            => (f1 and SMFIP_NR_HELO)     /= 0,
+          No_Reply_To_Sender          => (f1 and SMFIP_NR_MAIL)     /= 0,
+          No_Reply_To_Recipient       => (f1 and SMFIP_NR_RCPT)     /= 0,
+          No_Reply_To_Data            => (f1 and SMFIP_NR_DATA)     /= 0,
+          No_Reply_To_Unknown_Command => (f1 and SMFIP_NR_UNKN)     /= 0,
+          No_Reply_To_Header          => (f1 and SMFIP_NR_HDR)      /= 0,
+          No_Reply_To_End_Of_Headers  => (f1 and SMFIP_NR_EOH)      /= 0,
+          No_Reply_To_Body_Chunk      => (f1 and SMFIP_NR_BODY)     /= 0);
+      Result    : Negotiation_Result;
+      Requested : Options;
+   begin
+      Real_Negotiator(ctx, Offered, Result, Requested);
+      if Result = These_Options then
+         pf0.all :=
+            SMFIF_ADDHDRS     * Flag(Requested.Add_Headers) +
+            SMFIF_CHGHDRS     * Flag(Requested.Change_Or_Delete_Headers) +
+            SMFIF_CHGBODY     * Flag(Requested.Replace_Body) +
+            SMFIF_ADDRCPT_PAR * Flag(Requested.Add_Recipients) +
+            SMFIF_ADDRCPT     * Flag(False) +  -- not using smfi_addrcpt
+            SMFIF_DELRCPT     * Flag(Requested.Remove_Recipients) +
+            SMFIF_QUARANTINE  * Flag(Requested.Quarantine) +
+            SMFIF_CHGFROM     * Flag(Requested.Change_Sender) +
+            SMFIF_SETSYMLIST  * Flag(Requested.Request_Symbols);
+         pf1.all :=
+            SMFIP_RCPT_REJ    * Flag(Requested.Show_Rejected_Recipients) +
+            SMFIP_SKIP        * Flag(Requested.Skip_Further_Callbacks) +
+            SMFIP_HDR_LEADSPC * Flag(Requested.Headers_With_Leading_Space) +
+            SMFIP_NOCONNECT   * Flag(Requested.Suppress_Connected) +
+            SMFIP_NOHELO      * Flag(Requested.Suppress_Helo) +
+            SMFIP_NOMAIL      * Flag(Requested.Suppress_Sender) +
+            SMFIP_NORCPT      * Flag(Requested.Suppress_Recipient) +
+            SMFIP_NODATA      * Flag(Requested.Suppress_Data) +
+            SMFIP_NOUNKNOWN   * Flag(Requested.Suppress_Unknown_Command) +
+            SMFIP_NOHDRS      * Flag(Requested.Suppress_Header) +
+            SMFIP_NOEOH       * Flag(Requested.Suppress_End_Of_Headers) +
+            SMFIP_NOBODY      * Flag(Requested.Suppress_Body_Chunk) +
+            SMFIP_NR_CONN     * Flag(Requested.No_Reply_To_Connected) +
+            SMFIP_NR_HELO     * Flag(Requested.No_Reply_To_Helo) +
+            SMFIP_NR_MAIL     * Flag(Requested.No_Reply_To_Sender) +
+            SMFIP_NR_RCPT     * Flag(Requested.No_Reply_To_Recipient) +
+            SMFIP_NR_DATA     * Flag(Requested.No_Reply_To_Data) +
+            SMFIP_NR_UNKN     * Flag(Requested.No_Reply_To_Unknown_Command) +
+            SMFIP_NR_HDR      * Flag(Requested.No_Reply_To_Header) +
+            SMFIP_NR_EOH      * Flag(Requested.No_Reply_To_End_Of_Headers) +
+            SMFIP_NR_BODY     * Flag(Requested.No_Reply_To_Body_Chunk);
+         pf2.all := 0;
+         pf3.all := 0;
+      end if;
+      return sfsistat(Result);
+   exception
+      when E : others =>
+         Oops(E);
+         return sfsistat(Reject);
+   end Negotiator_Relay;
+
    type C_Connect_Handler is access function
       (ctx      : SMFICTX_Pointer;
        hostname : chars_ptr;
-       hostaddr : access Dummy_Type)
+       hostaddr : Sockaddr)
       return sfsistat;
    pragma convention(C, C_Connect_Handler);
 
    function Connect_Relay
       (ctx      : SMFICTX_Pointer;
        hostname : chars_ptr;
-       hostaddr : access Dummy_Type)
+       hostaddr : Sockaddr)
       return sfsistat;
    pragma convention(C, Connect_Relay);
 
    function Connect_Relay
       (ctx      : SMFICTX_Pointer;
        hostname : chars_ptr;
-       hostaddr : access Dummy_Type)
+       hostaddr : Sockaddr)
       return sfsistat
    is
-      Dummy : Sockaddr;
    begin
-      return sfsistat(Real_Connect_Handler(ctx, Value(hostname), Dummy));
+      return sfsistat(Real_Connect_Handler(ctx, Value(hostname), hostaddr));
    exception
       when E : others =>
          return Oops(E);
@@ -375,65 +553,56 @@ package body Milter_API is
 
 
    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)
    is
 
-      SMFIF_ADDHDRS     : constant := 16#1#;    -- add headers
-      SMFIF_CHGBODY     : constant := 16#2#;    -- replace body
-      SMFIF_ADDRCPT     : constant := 16#4#;    -- add envelope recipients
-      SMFIF_DELRCPT     : constant := 16#8#;    -- delete envelope recipients
-      SMFIF_CHGHDRS     : constant := 16#10#;   -- change/delete headers
-      SMFIF_QUARANTINE  : constant := 16#20#;   -- quarantine envelope
-
-      function BI(B : Boolean) return unsigned_long is
-      begin
-         if B then
-            return 1;
-         else
-            return 0;
-         end if;
-      end BI;
-
       type smfiDesc is record
-         xxfi_name      : chars_ptr     := New_String(Name);
-         xxfi_version   : int           := Target_Version;
+         xxfi_name      : chars_ptr := New_String(Name);
+         xxfi_version   : int;
          xxfi_flags     : unsigned_long :=
-            SMFIF_ADDHDRS     * BI(May_Add_Headers) +
-            SMFIF_CHGHDRS     * BI(May_Change_Or_Delete_Headers) +
-            SMFIF_CHGBODY     * BI(May_Replace_Body) +
-            SMFIF_ADDRCPT     * BI(May_Add_Recipients) +
-            SMFIF_DELRCPT     * BI(May_Remove_Recipients) +
-            SMFIF_QUARANTINE  * BI(May_Quarantine);
-         xxfi_connect   : C_Connect_Handler            := null;
-         xxfi_helo      : C_Helo_Handler               := null;
-         xxfi_envfrom   : C_Sender_Handler             := null;
-         xxfi_envrcpt   : C_Recipient_Handler          := null;
-         xxfi_header    : C_Header_Handler             := null;
-         xxfi_eoh       : C_End_Of_Headers_Handler     := null;
-         xxfi_body      : C_Body_Handler               := null;
-         xxfi_eom       : C_End_Of_Message_Handler     := null;
-         xxfi_abort     : C_Abort_Handler              := null;
-         xxfi_close     : C_Close_Handler              := null;
-         xxfi_unknown   : C_Unknown_Command_Handler    := null;
-         xxfi_data      : C_Data_Handler               := null;
+            SMFIF_ADDHDRS     * Flag(May_Add_Headers) +
+            SMFIF_CHGHDRS     * Flag(May_Change_Or_Delete_Headers) +
+            SMFIF_CHGBODY     * Flag(May_Replace_Body) +
+            SMFIF_ADDRCPT_PAR * Flag(May_Add_Recipients) +
+            SMFIF_ADDRCPT     * Flag(False) +  -- not using smfi_addrcpt
+            SMFIF_DELRCPT     * Flag(May_Remove_Recipients) +
+            SMFIF_QUARANTINE  * Flag(May_Quarantine) +
+            SMFIF_CHGFROM     * Flag(May_Change_Sender) +
+            SMFIF_SETSYMLIST  * Flag(May_Request_Symbols);
+         xxfi_connect   : C_Connect_Handler         := null;
+         xxfi_helo      : C_Helo_Handler            := null;
+         xxfi_envfrom   : C_Sender_Handler          := null;
+         xxfi_envrcpt   : C_Recipient_Handler       := null;
+         xxfi_header    : C_Header_Handler          := null;
+         xxfi_eoh       : C_End_Of_Headers_Handler  := null;
+         xxfi_body      : C_Body_Handler            := null;
+         xxfi_eom       : C_End_Of_Message_Handler  := null;
+         xxfi_abort     : C_Abort_Handler           := null;
+         xxfi_close     : C_Close_Handler           := null;
+         xxfi_unknown   : C_Unknown_Command_Handler := null;
+         xxfi_data      : C_Data_Handler            := null;
+         xxfi_negotiate : C_Negotiator              := null;
       end record;
       pragma convention(C_Pass_By_Copy, smfiDesc);
       Definition : smfiDesc;
@@ -441,8 +610,20 @@ package body Milter_API is
       function smfi_register(descr : smfiDesc) return int;
       pragma import(C, smfi_register);
 
+      Version : constant Libmilter_Version_Type := Libmilter_Version;
+
    begin  -- Register
 
+      -- The purpose of xxfi_version appears to be to check that the version of
+      -- Libmilter that the milter is dynamically linked with is compatible
+      -- with the version of the C header files that it was compiled against.
+      -- Such a check is meaningless for this binding, which is independent of
+      -- the C header files. Short-circuit the check by retrieving the version
+      -- of the dynamically linked library and feeding it back to the library.
+      Definition.xxfi_version := int(Version.Major * 2 ** 24 +
+                                     Version.Minor * 2 ** 8 +
+                                     Version.Patch_Level);
+
       if Connected /= null then
          Real_Connect_Handler := Connected;
          Definition.xxfi_connect := Connect_Relay'Access;
@@ -491,6 +672,10 @@ package body Milter_API is
          Real_Data_Handler := Data;
          Definition.xxfi_data := Data_Relay'Access;
       end if;
+      if Negotiate /= null then
+         Real_Negotiator := Negotiate;
+         Definition.xxfi_negotiate := Negotiator_Relay'Access;
+      end if;
 
       Check_For_Error("smfi_register", smfi_register(Definition));
 
@@ -520,7 +705,8 @@ package body Milter_API is
 
    procedure Open_Socket(Remove_Old_Socket : Boolean) is
       function smfi_opensocket(rmsocket : int) return int;
-      -- rmsocket is declared as bool. I hope a bool is always an int.
+      -- rmsocket is declared as bool, but bool is defined as int in mfapi.h,
+      -- subject to a lot of ifs.
       pragma import(C, smfi_opensocket);
       function I(B : Boolean) return int is
       begin if B then return 1; else return 0; end if; end I;
@@ -549,6 +735,23 @@ package body Milter_API is
       smfi_stop;
    end Stop;
 
+   procedure Request_Symbols
+      (Context : SMFICTX_Pointer;
+       Stage   : Protocol_Stage;
+       Names   : String)
+   is
+      function smfi_setsymlist
+         (ctx    : SMFICTX_Pointer;
+          stage  : int;
+          macros : char_array)
+         return int;
+      pragma import(C, smfi_setsymlist);
+   begin
+      Check_For_Error("smfi_setsymlist", smfi_setsymlist(Context,
+                                                         int(Stage),
+                                                         To_C(Names)));
+   end Request_Symbols;
+
    function Arguments(Handle : Arguments_Handle) return Unbounded_Strings is
       Ustrings : Unbounded_Strings
                  (1 .. Natural(String_Arrays.Virtual_Length(Handle.Pointer)));
@@ -642,6 +845,91 @@ package body Milter_API is
                                     Message_Ptr));
    end Set_Reply;
 
+   procedure Set_Reply
+      (Context       : SMFICTX_Pointer;
+       Reply_Code    : String_Of_Three;
+       Extended_Code : String := "";
+       Message       : Reply_Lines)
+   is separate;
+
+   milter_api_address_type_ipv4    : constant Unsigned_8 := 1;
+   milter_api_address_type_ipv6    : constant Unsigned_8 := 2;
+   milter_api_address_type_unknown : constant Unsigned_8 := 255;
+   pragma export(C, milter_api_address_type_ipv4);
+   pragma export(C, milter_api_address_type_ipv6);
+   pragma export(C, milter_api_address_type_unknown);
+
+   function Address(Endpoint : Sockaddr) return IP_Address is
+      type Unsigned_8_Pointer is access Unsigned_8;
+      function milter_api_address_type(endpoint : Sockaddr) return Unsigned_8;
+      procedure milter_api_ipv4_address(endpoint : in  Sockaddr;
+                                        buffer   : out Byte_Array);
+      procedure milter_api_ipv6_address(endpoint : in  Sockaddr;
+                                        buffer   : out Byte_Array);
+      pragma import(C, milter_api_address_type);
+      pragma import(C, milter_api_ipv4_address);
+      pragma import(C, milter_api_ipv6_address);
+      Address_Type : Unsigned_8;
+   begin
+      if Endpoint = Null_Address then
+         raise No_Address;
+      else
+         Address_Type := milter_api_address_type(Endpoint);
+         case Address_Type is
+            when milter_api_address_type_ipv4 =>
+               declare
+                  Address : IP_Address(IPv4);
+               begin
+                  milter_api_ipv4_address(Endpoint, Address.IPv4_Address);
+                  return Address;
+               end;
+            when milter_api_address_type_ipv6 =>
+               declare
+                  Address : IP_Address(IPv6);
+               begin
+                  milter_api_ipv6_address(Endpoint, Address.IPv6_Address);
+                  return Address;
+               end;
+            when others =>
+               raise Unknown_Address_Type;
+         end case;
+      end if;
+   end Address;
+
+   function Address(Endpoint : Sockaddr) return String is
+      procedure milter_api_address_string(endpoint : in  Sockaddr;
+                                          buffer   : out char_array;
+                                          size     : in  Unsigned_8);
+      pragma import(C, milter_api_address_string);
+      Buffer : char_array(1..46);
+      -- An IPv4-mapped IPv6 address in hybrid notation requires at most 45
+      -- characters plus a nul character.
+   begin
+      if Endpoint = Null_Address then
+         return "(address unavailable)";
+      else
+         milter_api_address_string(Endpoint, Buffer, Buffer'Length);
+         return To_Ada(Buffer);
+      end if;
+   end Address;
+
+   function Port(Endpoint : Sockaddr) return Unsigned_16 is
+      function milter_api_address_type(endpoint : Sockaddr) return Unsigned_8;
+      function milter_api_port(endpoint : Sockaddr) return Unsigned_16;
+      pragma import(C, milter_api_address_type);
+      pragma import(C, milter_api_port);
+   begin
+      if Endpoint = Null_Address then
+         raise No_Address;
+      else
+         case milter_api_address_type(Endpoint) is
+            when milter_api_address_type_ipv4 | milter_api_address_type_ipv6 =>
+               return milter_api_port(Endpoint);
+            when others =>
+               raise Unknown_Address_Type;
+         end case;
+      end if;
+   end Port;
 
    procedure Add_Header
       (Context : SMFICTX_Pointer;
@@ -721,14 +1009,46 @@ package body Milter_API is
                                      To_C(Value)));
    end Insert_Header;
 
-   procedure Add_Recipient(Context : SMFICTX_Pointer; Address : String) is
-      function smfi_addrcpt
+   procedure Change_Sender
+      (Context    : SMFICTX_Pointer;
+       Address    : String;
+       Parameters : String := "")
+   is
+      function smfi_chgfrom
          (ctx  : SMFICTX_Pointer;
-          rcpt : char_array)
+          mail : char_array;
+          args : chars_ptr)
          return int;
-      pragma import(C, smfi_addrcpt);
+      pragma import(C, smfi_chgfrom);
+      C_Parameters   : aliased char_array := To_C(Parameters);
+      Parameters_Ptr : chars_ptr := Null_Ptr;
    begin
-      Check_For_Error("smfi_addrcpt", smfi_addrcpt(Context, To_C(Address)));
+      if Parameters'Length > 0 then
+         Parameters_Ptr := To_Chars_Ptr(C_Parameters'Unchecked_Access);
+      end if;
+      Check_For_Error("smfi_chgfrom",
+                      smfi_chgfrom(Context, To_C(Address), Parameters_Ptr));
+   end Change_Sender;
+
+   procedure Add_Recipient
+      (Context    : SMFICTX_Pointer;
+       Address    : String;
+       Parameters : String := "")
+   is
+      function smfi_addrcpt_par
+         (ctx  : SMFICTX_Pointer;
+          rcpt : char_array;
+          args : chars_ptr)
+         return int;
+      pragma import(C, smfi_addrcpt_par);
+      C_Parameters   : aliased char_array := To_C(Parameters);
+      Parameters_Ptr : chars_ptr := Null_Ptr;
+   begin
+      if Parameters'Length > 0 then
+         Parameters_Ptr := To_Chars_Ptr(C_Parameters'Unchecked_Access);
+      end if;
+      Check_For_Error("smfi_addrcpt_par",
+                      smfi_addrcpt_par(Context, To_C(Address), Parameters_Ptr));
    end Add_Recipient;
 
    procedure Delete_Recipient(Context : SMFICTX_Pointer; Address : String) is