diff options
| -rw-r--r-- | milter_api-set_reply.adb | 1467 | ||||
| -rw-r--r-- | milter_api.adb | 498 | ||||
| -rw-r--r-- | milter_api.ads | 326 | ||||
| -rw-r--r-- | sockaddr_functions.c | 68 |
4 files changed, 2229 insertions, 130 deletions
diff --git a/milter_api-set_reply.adb b/milter_api-set_reply.adb new file mode 100644 index 0000000..066c971 --- /dev/null +++ b/milter_api-set_reply.adb @@ -0,0 +1,1467 @@ +-- Ada Milter API, 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. + + +separate(Milter_API) +procedure Set_Reply + (Context : SMFICTX_Pointer; + Reply_Code : String_Of_Three; + Extended_Code : String := ""; + Message : Reply_Lines) +is + + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + line_25 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + line_25 : chars_ptr; + line_26 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + line_25 : chars_ptr; + line_26 : chars_ptr; + line_27 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + line_25 : chars_ptr; + line_26 : chars_ptr; + line_27 : chars_ptr; + line_28 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + line_25 : chars_ptr; + line_26 : chars_ptr; + line_27 : chars_ptr; + line_28 : chars_ptr; + line_29 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + line_25 : chars_ptr; + line_26 : chars_ptr; + line_27 : chars_ptr; + line_28 : chars_ptr; + line_29 : chars_ptr; + line_30 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + line_25 : chars_ptr; + line_26 : chars_ptr; + line_27 : chars_ptr; + line_28 : chars_ptr; + line_29 : chars_ptr; + line_30 : chars_ptr; + line_31 : chars_ptr; + stop : chars_ptr) + return int; + function smfi_setmlreply + (ctx : SMFICTX_Pointer; + rcode : char_array; + xcode : chars_ptr; + line_1 : chars_ptr; + line_2 : chars_ptr; + line_3 : chars_ptr; + line_4 : chars_ptr; + line_5 : chars_ptr; + line_6 : chars_ptr; + line_7 : chars_ptr; + line_8 : chars_ptr; + line_9 : chars_ptr; + line_10 : chars_ptr; + line_11 : chars_ptr; + line_12 : chars_ptr; + line_13 : chars_ptr; + line_14 : chars_ptr; + line_15 : chars_ptr; + line_16 : chars_ptr; + line_17 : chars_ptr; + line_18 : chars_ptr; + line_19 : chars_ptr; + line_20 : chars_ptr; + line_21 : chars_ptr; + line_22 : chars_ptr; + line_23 : chars_ptr; + line_24 : chars_ptr; + line_25 : chars_ptr; + line_26 : chars_ptr; + line_27 : chars_ptr; + line_28 : chars_ptr; + line_29 : chars_ptr; + line_30 : chars_ptr; + line_31 : chars_ptr; + line_32 : chars_ptr; + stop : chars_ptr) + return int; + pragma import(C, smfi_setmlreply); + + C_Reply_Code : aliased char_array := To_C(Reply_Code); + C_Extended_Code : aliased char_array := To_C(Extended_Code); + Extended_Code_Ptr : chars_ptr := Null_Ptr; + + subtype Reply_Line_Count is Natural range 0 .. Reply_Line_Index'Last; + Line_Count : constant Reply_Line_Count := Message'Last - Message'First + 1; + C_Message : array(1 .. Line_Count) of chars_ptr; + + Result : int; + +begin + + if Extended_Code'Length > 0 then + Extended_Code_Ptr := To_Chars_Ptr(C_Extended_Code'Unchecked_Access); + end if; + + for Index in C_Message'Range loop + C_Message(Index) := New_String(To_String(Message(Message'First + Index - 1))); + end loop; + + case Line_Count is + when 0 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + Null_Ptr); + when 1 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + Null_Ptr); + when 2 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + Null_Ptr); + when 3 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + Null_Ptr); + when 4 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + Null_Ptr); + when 5 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + Null_Ptr); + when 6 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + Null_Ptr); + when 7 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + Null_Ptr); + when 8 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + Null_Ptr); + when 9 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + Null_Ptr); + when 10 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + Null_Ptr); + when 11 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + Null_Ptr); + when 12 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + Null_Ptr); + when 13 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + Null_Ptr); + when 14 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + Null_Ptr); + when 15 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + Null_Ptr); + when 16 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + Null_Ptr); + when 17 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + Null_Ptr); + when 18 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + Null_Ptr); + when 19 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + Null_Ptr); + when 20 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + Null_Ptr); + when 21 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + Null_Ptr); + when 22 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + Null_Ptr); + when 23 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + Null_Ptr); + when 24 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + Null_Ptr); + when 25 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + C_Message(25), + Null_Ptr); + when 26 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + C_Message(25), + C_Message(26), + Null_Ptr); + when 27 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + C_Message(25), + C_Message(26), + C_Message(27), + Null_Ptr); + when 28 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + C_Message(25), + C_Message(26), + C_Message(27), + C_Message(28), + Null_Ptr); + when 29 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + C_Message(25), + C_Message(26), + C_Message(27), + C_Message(28), + C_Message(29), + Null_Ptr); + when 30 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + C_Message(25), + C_Message(26), + C_Message(27), + C_Message(28), + C_Message(29), + C_Message(30), + Null_Ptr); + when 31 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + C_Message(25), + C_Message(26), + C_Message(27), + C_Message(28), + C_Message(29), + C_Message(30), + C_Message(31), + Null_Ptr); + when 32 => + Result := smfi_setmlreply(Context, + C_Reply_Code, + Extended_Code_Ptr, + C_Message(1), + C_Message(2), + C_Message(3), + C_Message(4), + C_Message(5), + C_Message(6), + C_Message(7), + C_Message(8), + C_Message(9), + C_Message(10), + C_Message(11), + C_Message(12), + C_Message(13), + C_Message(14), + C_Message(15), + C_Message(16), + C_Message(17), + C_Message(18), + C_Message(19), + C_Message(20), + C_Message(21), + C_Message(22), + C_Message(23), + C_Message(24), + C_Message(25), + C_Message(26), + C_Message(27), + C_Message(28), + C_Message(29), + C_Message(30), + C_Message(31), + C_Message(32), + Null_Ptr); + end case; + + for Index in C_Message'Range loop + Free(C_Message(Index)); + end loop; + + Check_For_Error("smfi_setmlreply", Result); + +end Set_Reply; 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 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; diff --git a/sockaddr_functions.c b/sockaddr_functions.c new file mode 100644 index 0000000..6148414 --- /dev/null +++ b/sockaddr_functions.c @@ -0,0 +1,68 @@ +#include <stdint.h> +#include <string.h> +#include <sys/socket.h> +#include <netinet/in.h> +#include <arpa/inet.h> + + +extern const uint8_t milter_api_address_type_ipv4; +extern const uint8_t milter_api_address_type_ipv6; +extern const uint8_t milter_api_address_type_unknown; + + +uint8_t milter_api_address_type(struct sockaddr const* const endpoint) { + if(endpoint->sa_family == AF_INET) { + return milter_api_address_type_ipv4; + } else if(endpoint->sa_family == AF_INET6) { + return milter_api_address_type_ipv6; + } else { + return milter_api_address_type_unknown; + } +} + + +void milter_api_ipv4_address(struct sockaddr_in const* const endpoint, // in + uint8_t* const buffer) // out +{ + memcpy(buffer, &endpoint->sin_addr, 4); +} + + +void milter_api_ipv6_address(struct sockaddr_in6 const* const endpoint, // in + uint8_t* const buffer) // out +{ + memcpy(buffer, &endpoint->sin6_addr, 16); +} + + +void milter_api_address_string(struct sockaddr const* const endpoint, // in + char* const buffer, // out + const uint8_t size) // in +{ + char const* result = NULL; + + if(endpoint->sa_family == AF_INET) { + result = inet_ntop(endpoint->sa_family, + &((struct sockaddr_in const*)endpoint)->sin_addr, + buffer, size); + } else if(endpoint->sa_family == AF_INET6) { + result = inet_ntop(endpoint->sa_family, + &((struct sockaddr_in6 const*)endpoint)->sin6_addr, + buffer, size); + } + if(result == NULL) { + strncpy(buffer, "(error in address conversion)", size); + buffer[size - 1] = '\0'; + } +} + + +uint16_t milter_api_port(struct sockaddr const* const endpoint) { + if(endpoint->sa_family == AF_INET) { + return ntohs(((struct sockaddr_in const*)endpoint)->sin_port); + } else if(endpoint->sa_family == AF_INET6) { + return ntohs(((struct sockaddr_in6 const*)endpoint)->sin6_port); + } else { + return 0; + } +} |