diff options
Diffstat (limited to 'milter_api.adb')
| -rw-r--r-- | milter_api.adb | 498 |
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 |