topal-80/0000755000175000017500000000000013434071426010536 5ustar pjbpjbtopal-80/externals.adb0000644000175000017500000006622713434071426013230 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Text_IO; with GNAT.OS_Lib; with Interfaces.C; with Interfaces.C.Strings; with Misc; package body Externals is pragma Linker_Options("externals-c.o"); procedure C_Perror (S : in Interfaces.C.char_array); pragma Import(C, C_Perror, "perror"); function C_Errno return Interfaces.C.Int; pragma Import(C, C_Errno, "errno_wrapper"); function C_Glob_Actual (Pattern : in Interfaces.C.Char_Array) return Interfaces.C.Int; pragma Import(C, C_Glob_Actual, "glob_actual"); function C_Glob_Text (Index : Interfaces.C.Int) return Interfaces.C.Strings.Chars_Ptr; pragma Import(C, C_Glob_Text, "glob_text"); procedure C_Glob_Free; pragma Import(C, C_Glob_Free, "glob_free"); function Glob (Pattern : in String) return UBS_Array is C : Natural; begin Misc.Debug("Glob: Looking for pattern `" & Pattern & "'"); C := Natural(C_Glob_Actual(Interfaces.C.To_C(Pattern))); Misc.Debug("Glob: Count (C) is " & Integer'Image(C)); declare A : UBS_Array(1..C); begin for I in 1 .. C loop A(I) := ToUBS(Interfaces.C.Strings.Value(C_Glob_Text(Interfaces.C.Int(I - 1)))); Misc.Debug("Glob: Item " & Integer'Image(I) & " is `" & ToStr(A(I)) & "'"); end loop; Misc.Debug("Glob: Free'ing..."); C_Glob_Free; Misc.Debug("Glob: A'First = " & Integer'Image(A'First)); Misc.Debug("Glob: A'Last = " & Integer'Image(A'Last)); Misc.Debug("Glob: A'Length = " & Integer'Image(A'Length)); Misc.Debug("Glob: Done"); return A; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Glob"); raise; end Glob; -- Execute a command via `execvp'. function C_Execvp (File : in Interfaces.C.Char_Array; Argv : in Interfaces.C.Strings.Chars_Ptr_Array) return Interfaces.C.int; pragma Import(C, C_Execvp, "execvp"); -- Our wrapper for execvp. procedure Execvp (File : in String; Argv : in UBS) is AVA : constant UBS_Array := Misc.Split_Arguments(Argv); begin -- Handoff to Execvp (B). Execvp(File, AVA); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Execvp (A)"); raise; end Execvp; -- And another wrapper for execvp. procedure Execvp (File : in String; Argv : in UBS_Array) is use type Interfaces.C.Size_T; use type Interfaces.C.Strings.Chars_Ptr; use type UBS; LI : constant Interfaces.C.Size_T := Interfaces.C.Size_T(Argv'Last); AVC : Interfaces.C.Strings.Chars_Ptr_Array(0..LI+1); -- Last item should be NULL! RV : Integer; begin Misc.Debug("Execvp (B)"); if Argv'First /= 0 then Misc.Error("Argv first element should be 0."); end if; Misc.Debug("Argv is 0 to " & Integer'Image(Argv'Last)); Misc.Debug("Argv length (number of items) is " & Integer'Image(Argv'Length)); Misc.Debug("The C items are 0 to " & Integer'Image(Integer(LI))); for I in 0 .. LI loop AVC(I) := Interfaces.C.Strings.New_String(ToStr(Argv(Integer(I)))); Misc.Debug("Argc[" & Integer'Image(Integer(I)) & "]=`" & ToStr(Argv(Integer(I))) & "'"); end loop; -- Last item should be null! AVC(LI+1) := Interfaces.C.Strings.Null_Ptr; -- Check that the executable actually exists. declare use GNAT.OS_Lib; EP : String_Access; begin EP := Locate_Exec_On_Path(File); if EP = null then -- It's not there. Misc.Error("‘" & File & "’ is either not present or not executable."); end if; -- Free it. Free(EP); end; -- Actually do the exec. RV := Integer(C_Execvp(Interfaces.C.To_C(File), AVC)); if RV = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in Execvp (B)")); end if; Misc.Debug("Execvp: Command return value " & Misc.Trim_Leading_Spaces(Integer'Image(RV))); if RV = -1 then raise Exec_Failed; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Execvp (B), File=`" & File &"'"); raise; end Execvp; -- Pipe binding. type Filedes_Array is array (Positive range 1..2) of Interfaces.C.Int; pragma Convention (C, Filedes_Array); function C_Pipe (Files : in Filedes_Array) return Interfaces.C.int; pragma Import(C, C_Pipe, "pipe"); procedure Pipe (Reading : out Integer; Writing : out Integer) is RV : Integer; Filedes : Filedes_Array; begin Filedes := (0, 1); -- Suppress that warning. RV := Integer(C_Pipe(Filedes)); if RV = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in Pipe")); end if; Misc.Debug("Pipe: Command return value " & Misc.Trim_Leading_Spaces(Integer'Image(RV))); if RV = -1 then raise Pipe_Failed; end if; Reading := Integer(Filedes(1)); Writing := Integer(Filedes(2)); Misc.Debug("Pipe created; reading is " & Integer'Image(Reading) & " writing is " & Integer'Image(Writing)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Pipe"); raise; end Pipe; -- Fork binding. function C_Fork return Interfaces.C.int; pragma Import(C, C_Fork, "fork"); function Fork return Integer is RV : Integer; begin RV := Integer(C_Fork); if RV = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in Fork")); end if; Misc.Debug("Fork: Command return value " & Misc.Trim_Leading_Spaces(Integer'Image(RV))); if RV = -1 then raise Fork_Failed; end if; return RV; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Fork"); raise; end Fork; -- Dup2 binding function C_Dup2 (Oldfd, Newfd : Interfaces.C.Int) return Interfaces.C.int; pragma Import(C, C_Dup2, "dup2"); procedure Dup2 (Oldfd, Newfd : in Integer) is RV : Integer; begin RV := Integer(C_Dup2(Interfaces.C.Int(Oldfd), Interfaces.C.Int(Newfd))); if RV = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in Dup2")); end if; Misc.Debug("Dup2: Command return value " & Misc.Trim_Leading_Spaces(Integer'Image(RV))); if RV = -1 then raise Dup2_Failed; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Dup2"); raise; end Dup2; -- Binding for C Close. We'll need this to tidy up nicely. function C_Close (FD : Interfaces.C.Int) return Interfaces.C.int; pragma Import(C, C_Close, "close"); procedure CClose (FD : in Integer) is RV : Integer; begin RV := Integer(C_Close(Interfaces.C.Int(FD))); if RV = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in CClose")); end if; Misc.Debug("CClose: Command return value " & Misc.Trim_Leading_Spaces(Integer'Image(RV))); if RV = -1 then raise CClose_Failed; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.CClose"); raise; end CClose; -- Binding for waitpid. We return the subprocess exit code. function C_Waitpid_Wrapper (PID : Interfaces.C.Int) return Interfaces.C.int; pragma Import(C, C_Waitpid_Wrapper, "waitpid_wrapper"); function Waitpid (PID : Integer) return Integer is RV : Integer; begin RV := Integer(C_Waitpid_Wrapper(Interfaces.C.Int(PID))); if RV = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in Waitpid")); end if; Misc.Debug("Waitpid: Command return value " & Misc.Trim_Leading_Spaces(Integer'Image(RV))); if RV = -1 then raise Waitpid_Failed; end if; return RV; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Waitpid"); raise; end Waitpid; -- ForkExec: a replacement for System. function ForkExec (File : in String; Argv : in UBS_Array) return Integer is P, E : Integer; begin P := Fork; if P = 0 then -- Child. Execvp(File, Argv); return -1; else -- Parent. Wait for the child to finish. E := Waitpid(P); return E; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec"); raise; end ForkExec; function ForkExec (File : in String; Argv : in UBS) return Integer is AVA : constant UBS_Array := Misc.Split_Arguments(Argv); begin return ForkExec(File, AVA); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec (B)"); raise; end ForkExec; function C_Open_Append_Wrapper (S : Interfaces.C.Char_Array) return Interfaces.C.int; pragma Import(C, C_Open_Append_Wrapper, "open_append_wrapper"); function ForkExec_Append (File : in String; Argv : in UBS_Array; Target : in String) return Integer is T, P, E : Integer; begin P := Fork; if P = 0 then -- Child. -- Get new file handle. T := Integer(C_Open_Append_Wrapper(Interfaces.C.To_C(Target))); if T = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec_Append")); raise Open_Append_Failed; end if; Dup2(T, 1); Execvp(File, Argv); return -1; else -- Parent. Wait for the child to finish. E := Waitpid(P); return E; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec_Append"); raise; end ForkExec_Append; function C_Open_Out_Wrapper (S : Interfaces.C.Char_Array) return Interfaces.C.int; pragma Import(C, C_Open_Out_Wrapper, "open_out_wrapper"); function ForkExec_Out (File : in String; Argv : in UBS_Array; Target : in String) return Integer is T, P, E : Integer; begin P := Fork; if P = 0 then -- Child. -- Get new file handle. T := Integer(C_Open_Out_Wrapper(Interfaces.C.To_C(Target))); if T = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec_Out")); raise Open_Out_Failed; end if; Dup2(T, 1); Execvp(File, Argv); return -1; else -- Parent. Wait for the child to finish. E := Waitpid(P); return E; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec_Out"); raise; end ForkExec_Out; function ForkExec_Out (File : in String; Argv : in UBS; Target : in String) return Integer is AVA : constant UBS_Array := Misc.Split_Arguments(Argv); begin return ForkExec_Out(File, AVA, Target); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec_Out (B)"); raise; end ForkExec_Out; function C_Open_In_Wrapper (S : Interfaces.C.Char_Array) return Interfaces.C.int; pragma Import(C, C_Open_In_Wrapper, "open_in_wrapper"); function ForkExec_In (File : in String; Argv : in UBS_Array; Source : in String) return Integer is S, P, E : Integer; begin P := Fork; if P = 0 then -- Child. -- Get new file handle. S := Integer(C_Open_In_Wrapper(Interfaces.C.To_C(Source))); if S = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec_In")); raise Open_In_Failed; end if; Dup2(S, 0); Execvp(File, Argv); return -1; else -- Parent. Wait for the child to finish. E := Waitpid(P); return E; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec_In"); raise; end ForkExec_In; function ForkExec_InOut (File : in String; Argv : in UBS_Array; Source : in String; Target : in String) return Integer is S, T, P, E : Integer; begin P := Fork; if P = 0 then -- Child. -- Get new file handle. S := Integer(C_Open_In_Wrapper(Interfaces.C.To_C(Source))); if S = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec_InOut")); raise Open_In_Failed; end if; Dup2(S, 0); -- Get new file handle. T := Integer(C_Open_Out_Wrapper(Interfaces.C.To_C(Target))); if T = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec_InOut")); raise Open_Out_Failed; end if; Dup2(T, 1); Execvp(File, Argv); return -1; else -- Parent. Wait for the child to finish. E := Waitpid(P); return E; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec_InOut"); raise; end ForkExec_InOut; function ForkExec_InOut (File : in String; Argv : in UBS; Source : in String; Target : in String) return Integer is AVA : constant UBS_Array := Misc.Split_Arguments(Argv); begin return ForkExec_InOut(File, AVA, Source, Target); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec_InOut (B)"); raise; end ForkExec_InOut; procedure ForkExec2 (File1 : in String; Argv1 : in UBS_Array; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; Merge_StdErr1 : in Boolean := False; Report : in Boolean := False) is R, W, P1, P2 : Integer; begin if Report then Ada.Text_IO.New_Line; Ada.Text_IO.Put("Executing `" & File1 & "' and `" & File2 & "' with arguments "); for I in Argv1'First .. Argv1'Last loop Ada.Text_IO.Put("`" & ToStr(Argv1(I)) & "' "); end loop; Ada.Text_IO.Put(" and "); for I in Argv2'First .. Argv2'Last loop Ada.Text_IO.Put("`" & ToStr(Argv2(I)) & "' "); end loop; Ada.Text_IO.New_Line(2); end if; Pipe(R, W); P1 := Fork; if P1 = 0 then -- child1 CClose(R); Dup2(W, 1); if Merge_StdErr1 then Dup2(W, 2); end if; Execvp(File1, Argv1); else P2 := Fork; if P2 = 0 then -- child2 CClose(W); Dup2(R, 0); Execvp(File2, Argv2); else CClose(R); CClose(W); Exit1 := Waitpid(P1); Exit2 := Waitpid(P2); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec2"); raise; end ForkExec2; procedure ForkExec2 (File1 : in String; Argv1 : in UBS; Exit1 : out Integer; File2 : in String; Argv2 : in UBS; Exit2 : out Integer; Merge_StdErr1 : in Boolean := False; Report : in Boolean := False) is AVA1 : constant UBS_Array := Misc.Split_Arguments(Argv1); AVA2 : constant UBS_Array := Misc.Split_Arguments(Argv2); begin ForkExec2(File1, AVA1, Exit1, File2, AVA2, Exit2, Merge_StdErr1, Report); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec2 (B)"); raise; end ForkExec2; procedure ForkExec2_Out (File1 : in String; Argv1 : in UBS_Array; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; Target : in String) is T, R, W, P1, P2 : Integer; begin Pipe(R, W); P1 := Fork; if P1 = 0 then -- child1 CClose(R); Dup2(W, 1); Execvp(File1, Argv1); else P2 := Fork; if P2 = 0 then -- child2 CClose(W); Dup2(R, 0); -- Get new file handle. T := Integer(C_Open_Out_Wrapper(Interfaces.C.To_C(Target))); if T = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec2_Out")); raise Open_Out_Failed; end if; Dup2(T, 1); Execvp(File2, Argv2); else CClose(R); CClose(W); Exit1 := Waitpid(P1); Exit2 := Waitpid(P2); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec2_Out"); raise; end ForkExec2_Out; procedure ForkExec2_Out (File1 : in String; Argv1 : in UBS; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; Target : in String) is AVA1 : constant UBS_Array := Misc.Split_Arguments(Argv1); begin ForkExec2_Out(File1, AVA1, Exit1, File2, Argv2, Exit2, Target); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec2_Out(B)"); raise; end ForkExec2_Out; procedure ForkExec2_InOut (File1 : in String; Argv1 : in UBS_Array; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; Source : in String; Target : in String) is S, T, R, W, P1, P2 : Integer; begin Pipe(R, W); P1 := Fork; if P1 = 0 then -- child1 CClose(R); Dup2(W, 1); -- Get new file handle. S := Integer(C_Open_In_Wrapper(Interfaces.C.To_C(Source))); if S = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec2_InOut")); raise Open_In_Failed; end if; Dup2(S, 0); -- Get new file handle. Execvp(File1, Argv1); else P2 := Fork; if P2 = 0 then -- child2 CClose(W); Dup2(R, 0); -- Get new file handle. T := Integer(C_Open_Out_Wrapper(Interfaces.C.To_C(Target))); if T = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec2_InOut")); raise Open_Out_Failed; end if; Dup2(T, 1); Execvp(File2, Argv2); else CClose(R); CClose(W); Exit1 := Waitpid(P1); Exit2 := Waitpid(P2); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec2_InOut"); raise; end ForkExec2_InOut; procedure ForkExec3_Out (File1 : in String; Argv1 : in UBS; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; File3 : in String; Argv3 : in UBS_Array; Exit3 : out Integer; Target : in String) is T, R1, W1, R2, W2, P1, P2, P3 : Integer; AVA1 : constant UBS_Array := Misc.Split_Arguments(Argv1); begin Pipe(R1, W1); Pipe(R2, W2); P1 := Fork; if P1 = 0 then -- child1 CClose(R1); CClose(R2); CClose(W2); Dup2(W1, 1); Execvp(File1, AVA1); else P2 := Fork; if P2 = 0 then -- child2 CClose(W1); CClose(R2); Dup2(R1, 0); Dup2(W2, 1); Execvp(File2, Argv2); else P3 := Fork; if P3 = 0 then -- child3 CClose(R1); CClose(W1); CClose(W2); Dup2(R2, 0); -- Get new file handle. T := Integer(C_Open_Out_Wrapper(Interfaces.C.To_C(Target))); if T = -1 then Misc.Debug("Errno is " & Misc.Trim_Leading_Spaces(Integer'Image(Integer(C_Errno)))); C_Perror(Interfaces.C.To_C("Topal: problem in ForkExec3_Out")); raise Open_Out_Failed; end if; Dup2(T, 1); Execvp(File3, Argv3); else CClose(R1); CClose(W1); CClose(R2); CClose(W2); Exit1 := Waitpid(P1); Exit2 := Waitpid(P2); Exit3 := Waitpid(P3); end if; end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.ForkExec3_Out"); raise; end ForkExec3_Out; -- More wrappers. function Open_Append (S : String) return Integer is begin return Integer(C_Open_Append_Wrapper(Interfaces.C.To_C(S))); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Open_Append"); raise; end Open_Append; function Open_Out (S : String) return Integer is begin return Integer(C_Open_Out_Wrapper(Interfaces.C.To_C(S))); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Open_Out"); raise; end Open_Out; function Open_In (S : String) return Integer is begin return Integer(C_Open_In_Wrapper(Interfaces.C.To_C(S))); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Open_In"); raise; end Open_In; end Externals; topal-80/echo.ads0000644000175000017500000000153213434071426012146 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . package Echo is Operation_Failed : exception; procedure Set_Echo; procedure Clear_Echo; procedure Save_Terminal; procedure Restore_Terminal; end Echo; topal-80/readline.ads0000644000175000017500000000201413434071426013007 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . package Readline is function Get_String (Prompt : String := ""; Enable_Tab_Completion : Boolean := False) return String; procedure Add_History (History : in String; Remove_Empty : in Boolean := True); procedure Save_History; procedure Load_History; end Readline; topal-80/char_menus.adb0000644000175000017500000000635013434071426013336 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2010 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Exceptions; with Ada.Strings.Maps; with Ada.Text_IO; with Echo; with Misc; use Misc; package body Char_Menus is function Menu (Prompt : in String := Default_Prompt) return Index is use Ada.Strings.Maps; use Ada.Text_IO; C : Character; begin Debug("+Char_Menu.Menu"); if Accept_Chars'Length /= Char_Words'Length or Accept_Chars'First /= Char_Words'First then raise Arrays_Not_Matched; end if; if Config.Boolean_Opts(Debug) then Debug("Char_Menu.Menu: Prompt is `" & Prompt & "'"); begin for I in Accept_Chars'Range loop Debug("Char_Menu.Menu: Group " & Index'Image(I) & " Accept_Chars=`" & ToStr(Accept_Chars(I)) & "'"); end loop; exception when The_Exception : others => Debug("Exception raised in Accept_Chars bit: " & Ada.Exceptions.Exception_Name(The_Exception)); end; begin for I in Char_Words'Range loop Debug("Char_Menu.Menu: Group " & Index'Image(I) & " Char_Words=`" & ToStr(Char_Words(I)) & "'"); end loop; exception when The_Exception : others => Debug("Exception raised in Char_Words bit: " & Ada.Exceptions.Exception_Name(The_Exception)); end; end if; Put(Rewrite_Menu_Prompt(Prompt)); Entry_Loop: loop Echo.Clear_Echo; Debug("Menu.Char_Menu: About to Get_Immediate"); Get_Immediate(C); Debug("Menu.Char_Menu: Got: `" & C & "' value " & Integer'Image(Character'Pos(C))); Echo.Set_Echo; -- Now, run through the menu. for I in Accept_Chars'Range loop if Is_In(C, To_Set(ToStr(Accept_Chars(I)))) then Put(Do_SGR(Config.UBS_Opts(Colour_Menu_Choice)) & ToStr(Char_Words(I)) & Reset_SGR); New_Line(2); Debug("-Char_Menu.Menu with value " & Index'Image(I) & " for character `" & C & "'"); return I; end if; end loop; Debug("Menu.Char_Menu: No match for character `" & C & "'"); end loop Entry_Loop; exception when others => ErrorNE("Char_Menu.Menu: In exception handler. Re-raising."); raise; return Index'First; -- Never executed. end Menu; end Char_Menus; topal-80/pine-4.50.patch0000644000175000017500000001735513434071426013111 0ustar pjbpjbOnly in pine4.50/: .bld.hlp Only in pine4.50/: bin diff -cr OP/pine4.50/imap/src/c-client/mail.h pine4.50/imap/src/c-client/mail.h *** OP/pine4.50/imap/src/c-client/mail.h Tue Oct 29 01:10:29 2002 --- pine4.50/imap/src/c-client/mail.h Fri Nov 22 11:42:08 2002 *************** *** 651,656 **** --- 651,657 ---- unsigned long bytes; /* size of text in octets */ } size; char *md5; /* MD5 checksum */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ }; Only in pine4.50/imap/src/c-client: mail.h.orig Only in pine4.50/pine: date.c diff -cr OP/pine4.50/pine/pine.h pine4.50/pine/pine.h *** OP/pine4.50/pine/pine.h Wed Nov 20 18:19:44 2002 --- pine4.50/pine/pine.h Fri Nov 22 11:42:38 2002 *************** *** 63,69 **** #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.50" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" --- 63,69 ---- #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.50T" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" Only in pine4.50/pine: pine.h.orig Only in pine4.50/pine: pine.h.rej diff -cr OP/pine4.50/pine/send.c pine4.50/pine/send.c *** OP/pine4.50/pine/send.c Wed Nov 20 22:51:49 2002 --- pine4.50/pine/send.c Fri Nov 22 11:42:08 2002 *************** *** 4764,4769 **** --- 4764,4779 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) + /* This was a single part message which Topal mangled. */ + (*body)->type = TYPETEXT; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1) + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + (*body)->nested.part->body.type = TYPETEXT; + dprint(4, (debugfile, "=== send returning ===\n")); } *************** *** 6076,6088 **** ; rfc822_parse_content_header(nb,ucase(buf+8),s); ! if(nb->type == TYPETEXT ! && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); b->subtype = nb->subtype; nb->subtype = NULL; --- 6086,6098 ---- ; rfc822_parse_content_header(nb,ucase(buf+8),s); ! if(nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); + b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; *************** *** 6090,6095 **** --- 6100,6107 ---- b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + if (b->type != TYPETEXT) + b->topal_hack = 1; } mail_free_body(&nb); *************** *** 8726,8742 **** dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. --- 8738,8756 ---- dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (body->topal_hack != 1){ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ ! } break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. *************** *** 8906,8912 **** dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 8920,8927 ---- dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 8966,8972 **** * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT){ gf_link_filter(gf_local_nvtnl, NULL); } --- 8981,8988 ---- * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)){ gf_link_filter(gf_local_nvtnl, NULL); } *************** *** 9075,9089 **** ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); --- 9091,9117 ---- ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) ! { ! if(!(so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! else ! { ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); *************** *** 9341,9347 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 9369,9376 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); topal-80/configuration.ads0000644000175000017500000000272113434071426014100 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Configuration is Switch_Parse_Error : exception; function Set_Two_Way (S : String) return Boolean; Two_Way : constant array (Boolean) of UBS := (True => ToUBS("on"), False => ToUBS("off")); Config_Parse_Error : exception; procedure Read_Config_File (Warnings : out Boolean); procedure Dump (Overwrite_Config : in Boolean := False); procedure Edit_Configuration; procedure Edit_Own_Key(SMIME : in Boolean); procedure Default_Configuration (C : in out Config_Record); -- Deep copy the configuration. Right is the original; Left is the -- newly instantiated configuration. procedure Copy_Configuration(Left : in out Config_Record; Right : in Config_Record); end Configuration; topal-80/topal.man0000644000175000017500000000174113434071426012355 0ustar pjbpjb.TH TOPAL 1 "November 2, 2002" .SH NAME topal \- GPG/GnuPG and Alpine/Pine integration .SH SYNOPSIS .B topal [ .I options ] .LP .SH DESCRIPTION Topal is yet another program that links GnuPG and Pine/Alpine. It offers facilities to encrypt, decrypt, sign, and verify messages. It can also be used directly from the command-line. Multiple PGP blocks included in the text of a message are processed. Decryption and verification output can be cached to reduce the number of times the passphrase is entered. RFC2015/3156 multipart messages can be sent and received with help from some scripts, procmail and a (deprecated) patch to Pine/Alpine. It includes basic support for verifying S/MIME multipart/signed messages. There is a remote sending mode for reading email on a distant computer via SSH with secret keys on the local computer. There is a high level of configurability. .SH USAGE REFERENCE Use the -help option, or see the README file. .SH AUTHOR Phil Brooke, p.j.brooke@bcs.org.uk topal-80/Changelog.html0000644000175000017500000007220713434071426013323 0ustar pjbpjb Topal — Changelog

Topal — Changelog

Copyright © 2001–2018 Phillip J. Brooke

06/2001, 0.1
First alpha release.
06/2001, 0.2
Minor changes.
06/2001, 0.3
Major changes to how keys are identified and looked up.
06/2001, 0.4
Adding more customization features.
11/2001, 0.4.4
Cleaned up some error messages; added -nps mode.
11/2001, 0.4.5
Added ‘gpg-options’ config item with default ‘--no-options’. (Forgot to add this note as well....)
11/2001, 0.5.0
Dumped -verify and -decrypt modes in favour of the multiple-block ‘-display’ mode. Added -help. Added caching. Added more switches relating to caching. Better output formatting.
11/2001, 0.5.1
Improved menus. Tidied up some of the interface. Added -s, which does the same as -nps.
12/2001, 0.5.2
Tidied disclaimer. Added synonyms for -help (-h, -?, --help, --h) Cleaned up menus; keypresses aren't echoed any longer.
12/2001, 0.5.3
Altered packaging to include version in directory name. Changed names of some -clear options to be a bit more sensible. Changing config settings method (big change). Making -s the default operation. Some rearrangement of code, constants. Some configuration editing possible via Topal. Send has access to configuration menu.
12/2001, 0.5.4
Bug fix; one-off error in the sending menus.
12/2001, 0.5.5
Removed redundant examples directory. Changed over to HTML documentation. Tweaked the RELEASE stuff. Use space instead of enter when waiting to continue: this looks forward to offering a help option at every prompt. The receive/blocks stuff now uses an expanding array. The GPG return value is checked when receiving: if it's bad, then some bits of the output are omitted; the cache file is not written. The date bit of Topal output moved onto the previous line (echo -n blah blah).
12/2001, 0.5.6
Adding installation instructions. Using tee and PIPESTATUS to get stderr on screen during receiving while also saving that output and recording gpg's exit status. Changed RELEASE filename to release. Tidied up the Makefile. Invalid passphrase messages are grep'd out of the output. Added ‘fast continue’ options. Key lists in the configuration section now use expanding arrays. Changed key details selection message. Secret key selection now offers a menu of secret keys on the secret keyring. Initial recipient search excludes keys in XK list. Added key search/selection menu choice - much nicer to use than the add menu. More configuration stuff added (still more to do, although the config file can always be used). Partial documentation update.
2/2002, 0.5.7
Adding limited RFC2015/MIME decoding of multipart email.
2/2002, 0.5.8
Adding mime-construct to configuration in expectation of more RFC2015 features. Put test for the config file existing before actually attempting to read it (oops). Added -O2 -Wall and the TOPALDEBUG variable for compiling. Put up WWW page via own Freeserve site. Announcing via Freshmeat. Automating output WWW site generation (all the grunge in the Makefile).
3/2002, 0.6.0
Distribution uses a gzip'd binary now.... Added a pre-built binary that is statically linked against the GNAT stuff so that people don't need to acquire GNAT first (this, I believe, complies with the GNAT licence).
Added the scripts topal-fix-email and topal-fix-folder. This makes it a lot easier to work with other people's multipart/signed or /encrypted email. Procmail recipe added to this README.
Added display of application/pgp messages. Including the text of one of these in a reply might be difficult, but then, it was difficult without topal's mangling. At least they can be verified and read now.
-sendmime option added. Hack needed (in topal-pine-patch [now pine-4.44.patch]) to allow non-text/blah content-types in Pine. RFC2015 send and received done (including micalg detection when sending clearsigned messages: list used from RFC3156.). Ditto for application/pgp, but I'm not sure of some of the parameters, since I've only ever seen signed emails of this form.
Removed some of the waits for execution, since it seems reliable. Added error checking on return value of GPG in sends.
3/2002, 0.6.1
The Content-Type for MIME sending is displayed on the screen using ‘cat’ rather than ‘less’, which was getting to be annoying.
Two changes that are related to how I manage the source code: Slight tweak to makefile for keeping track of RCS files; and using rcs -n<symbolic-name> to tag the released files.
3/2002, 0.6.2
MIME clear-signed messages: trailing blank lines are now deleted before signing (this would cause BAD signature when verifying on some other MTAs). Added remarks to documentation about the patch to Pine and attachments.
4/2002, 0.6.3
RFC1847 multipart encapsulation added. (See section 6.1 of RFC3156.) Cleaned up related receiving/caching behaviour.
Another MIME clear-signed messages bugfix. This one sorts out line-end conventions correctly.
New patch for Pine: this stops a SEGFAULT when using RFC2015 stuff and other attachments at the same time.
Updated documentation; added man pages for the two scripts.
4/2002, 0.6.4
New patch for Pine. Adds a workaround for the problem where some versions of MS Exchange would silently lose inbound MIME clearsigned email. It turns out that a slight formatting change stops the problem.
5/2002, 6/2002; 0.6.5, 0.6.6, 0.6.7, 0.6.8
Adding more debugging, mostly to the menus code. Used for tracking down a nasty problem causing exceptions. Many thanks to Felix Madlener for pointing this out and testing the revised code.
7/2002, 0.6.9
Renamed the Pine patch for when new versions come out. (It's still the same patch as for Topal 0.6.4.) Added trap for non-existent file when using ‘-s’. Cache directory as well as .topal directory is also chmod'd to 700. Added README.txt to package file (even though it's generated from the .html) so that those who just want to ‘less’ it (instead of firing up a HTML reader) can do so.
8/2002, 0.7.0
Changed email address in man page. Lots more exception handling for extra info when something goes wrong. Moderate code reorganisation: mostly splitting blocks of code out for future work. Fixed ‘bug’ (feature?) where send fails if a public key is unusable (although this may risk sending plaintext through; we assume that if an output file was generated, then the GPG errors weren't fatal). Now we check instead if the output file exists. Checking all source files for any similar bugs in menus (cf. the 5/2002 entry). Modified MIME RFC2015 receiving function so that it isn't so reliant on shell calls of sed (which can fall over with nasty characters in an incoming emails boundary). Moreover, it can now cope with MIME parts that don't end with a newline. Tweaking MIME/verify cache handling: we shouldn't actually get an output file from GPG (since we're only verifying one part with the other); we put a vague warning if this happens, and trap when reading the cache. Added content-type to plaintext for MIME/encrypted. Documentation update.
8/2002, 0.7.1
Fixed minor bug with inverted return code (‘-s’ trap). Doc update.
9/2002, 0.7.2
Fixed minor bug in key list handling code (dealing with key selection).
9/2002; 0.7.3, 0.7.4 (BETA)
Disposed of the dependency on a shell by introducing Ada bindings for fork/exec/dup/pipe/glob, etc.. Several external binaries are no longer needed (cat, echo). Most return codes are now properly checked (although still need to do a better audit). Followed Eduardo Chappa's advice and changed Pine patch version letter. Miscellaneous cleanups and fixes. Many thanks to Peter Losher for giving me the incentive to sort out the external calls.
9/2002; 0.7.5 (BETA)
Tidying up structure of external calls, and how the various messages are built up and torn down. Changed the lynx switches at the suggestion of Felix Madlener (many thanks!). When receiving MIME encrypted attachments, the output is not included in the Topal output, but only in the metamail invocation.
10/2002; 0.7.6 (BETA)
Explicitly noted which versions are not intended for general use (beta versions). Rearranged command line parsing for more flexibility in future.
10/2002; 0.7.7 (BETA)
Re-implementing topal-fix-email and topal-fix-folder as part of the main topal binary. This removes the (script) dependency on munpack, but adds formail and diff to the main binary. Fixed some missing bits for particular binaries in configuration handling. Adding ‘important changes from last stable version’ documentation. Tweaked the body extraction procedure. Tweaked some output messages. Major changes to menus: they now use enumerated types rather than integers.... Tweaking cl_menu some more. Added ‘pass-thu’ option to send menu (so you can always use the Topal filter. This might also fix the minor problem with text/html occasionally being sent when it shouldn't be....) Fixed bug where MIME decrypt failure would still cause metamail to be invoked, but that's a waste of time.
10/2002; 0.7.8
Clearing out case statements with ‘when others’. Tidying up sending.adb. Fixed problem in MIME output where a leading blank line was added. Finally implemented ‘topal --fix-folders’ functionality added. No longer need the two old scripts (I hope)! Another documentation tidy-up. Added ‘inline-separate-output’ option: this effectively turns off the GnuPG/Topal wrappers in output. However, the side-effect is that the cache must be cleared when upgrading to this version.
11/2002; 0.7.9
Added some infrastructure for encrypting/signing attachments (but this is nowhere near working yet). Documentation and manpage update (again). Seems stable, will release.
2/2003; 0.7.10, 0.7.11
Tweaking distribution pages (mkdistrib). Including patches against Pine versions 4.50 and 4.53. (They're all more-or-less the same patch. It's pretty easy to apply them against 4.51 and 4.52 if you feel so inclined.) Further doc clean up (particular the stuff about important changes from previous stable versions). Implemented Felix M.'s suggestion for handling non-existant command-line options: things that aren't valid options, but are prefixed with a ‘-’ get a more helpful error message. --fix-email workaround also writes out the original input in the exception handler. Changed recommended procmail recipe so that Topal's exit code is checked.
2/2003; 0.7.12
Adding ‘workaround-error-log’ file to .topal. This accepts output from topal --fix-email when it fails to exit cleanly. Not quite clear if this bit works yet (was tracking down other problem). It appears that when running without a real terminal, the call to set_echo fails. Odd. Nasty workaround implemented.
2/2002; 0.7.13
Added missing includes to ada-echo-c.c. Perhaps related to issue in the previous entry.
4/2003; 0.7.13b
Bug fix release only - backported from (not-yet-released 0.8.0). Fixed bug when changing own signing key using the -config option - thanks to Stewart James for the bug report.
10/2003; 0.7.13.2
Bug fix release only - backported from (not-yet-released 0.8.0). Changed bug fix versioning scheme. Makefile now links properly against static GNAT runtime. Fixed problem which manifests as: ‘relocation error: /lib/libreadline.so.4: undefined symbol: BC’ (needed instruction to link against ncurses) - thanks to Marty Hoff for the bug report. Added patch against Pine version 4.58.
10/2003; 0.7.13.3
Now use -gnatwa and -gnato for all Ada compilation. It was omitted from the main binary build command before. Fixed all the resulting warnings.
1/2004; 0.7.13.4
Patched externals calls for errno to prevent (in some cases) warnings from ld.so, and in other cases, failures to build.
6/2004; 0.7.13.5
Added patch against Pine version 4.60. Updated some notices.
1/4/2005; 0.7.13.6
Calls to the GPG binary now have LANG set to C before exec so that we don't have to worry about different language output in GPG. Thanks for Joern Brederec for the bug report and suggestion of how to fix it.
2005-2007
Four internal development releases junked.
8/1/2008; release 55
--fix-email now replaces the original message with a multipart/misc wrapper, rather than expanding it into a multipart/alternative message.
Replaced some key selection code. Hopefully, this reduces the number of locale-dependent and GPG version-specific problems. Additionally, revoked, disabled and invalid keys are no longer offered; checks are made to ensure that the key is valid for encryption/signing when applicable.
New patch for Alpine 1.00. Includes configuration setting.
The ‘pass through unchanged’ send option no longer modifies the content-type to text/plain.
Should now build and run on Cygwin.
Licence is now GPL-3.
Attempt to prevent potential memory leak (if running for a long time) by making the implementation of expanding_array a controlled type.
Cleaned up Ada source to reduce warnings.
Other minor changes, e.g., better checks on keylists, documentation clean-up.
Changed release numbering.
HTML cleaned up and CSS added.
8/1/2008; release 56
--read-from option added to select different signing keys depending on the From line. Also added sake and sxk configurations.
Fixed bug in Keys.Remove.Key (didn't match if the full fingerprint wasn't given).
Command-line parser now accepts 1 or more hyphens for any option.
Improved keylist documentation.
Corrected release date for release 55... oops.
8/1/2008; release 57
Initial attempt at supporting attachments within Topal.
Changed MIME boundary detection code (the previous algorithm couldn't cope with multipart included in a signed email). Please tell me if this breaks your emails....
Bug fix to _INCLUDEALLHDRS_ - it needs to turn the CRLF back into LF or it might chop off some of your message....
22/6/2008; release 58
UI improvements (count keys in keylist, clearer indication of position in menus).
Added patch for Alpine 1.10. Renamed all patch files.
Default paths for binaries are no longer absolute.
Configuration files now allow comments, but they're not preserved by Topal.
Added more exception handling messages.
Sending and receiving both save off original input as tempfiles to help debugging.
Added --ask-charset command line option. This is really only for testing a new workaround for locale-related bad signatures. Please see locale problems in the notes and send feedback.
Started removing dependency on mime-construct; new source files mime.ad[sb].
Build date added to binary.
3/7/2008; release 59
Added sequence numbers to temporary files to reduce possible name conflicts.
The makefile's install target now installs to INSTALLPATH. This can be overridden, e.g., make install INSTALLPATH=/usr/local. The four more specific paths, INSTALLPATHBIN, INSTALLPATHMAN, INSTALLPATHDOC and INSTALLPATHPATCHES can also be overridden. Fixes request from Nils Schlupp re: ebuild.
The --ask-charset command-line option is now only used if a bad signature is returned; a second attempt is then made if a different character set is suggested by the user.
13/7/2008; release 60
Update installation instructions for make install.
We now use a modified version of Jeffrey S. Dutky's mime-tool instead of mime-construct for creating MIME messages. We include our modified version in the Topal tarball (since both are GPL, and our modifications are needed if creating MIME messages).
MIME viewing can now use metamail, use run-mailcap or save the attachment to the folder ~/.topal/viewmime (which you can then open in Alpine). run-mailcap and saving support are new.
Sending menu allows user to view and edit the email. A quicker method for changing/setting the signing (own) key is available.
14/7/2008; release 61
An initial, rather crude, but (for my purposes at least) effective remote mode for sending.
Some history is now saved.
17/7/2008; release 62
Added basic support for S/MIME verification of messages.
Quoted-printable encoder (in MIME-tool) improved (single dots and leading "From ") as per RFC2049.
Decode quoted-printable and base64 before calling run-mailcap.
Ignore errors in strip in Makefile (trips up Cygwin, which expects the executable to be foo.exe).
Update feature list for remote sending.
Internal changes to configuration storage.
31/8/2008; release 63
Update change list for release 62 (omitted some items...).
Give a sensible warning message instead of dying with an exception when (1) signing operations are called without own key set; (2) attempting to choose own key without any secret keys available.
Added some hints in the documentation.
Initial attempt at supporting remote decryption.
Handle SIGINT ourselves so that temporary files are cleaned up. Also clean up more often when exceptions occur.
24/10/2008; release 64
Update feature list for release 63's remote decryption support.
Add patch to Topal sources for Cygwin. (The recent interrupt code doesn't build.)
Bug fix: temporary files weren't being deleted, because Rm_Tempfiles_PID hadn't been changed to match Temp_File_Name.
Added patch for Alpine 2.00. Alpine's S/MIME needs to be turned off for Topal's S/MIME verification to work.
Bug fix in Externals.Simple.Guess_Content_Type.
1/5/2009; release 65
MIME sending now uses the current locale as the content-type header charset.
MIME receiving (verification) tries to use the character set given in its first attempt.
Signing calls to GPG use --textmode flag (shouldn't be needed if the dos2unix calls work, but experiments suggest some problems if we don't do this).
Fix remote server so that emails with multiple recipients are handled properly.
Added new patch to Alpine that might make it easier to read multipart signed/encrypted messages. This makes the procmail recipe redundant, but needs more testing.
Attempt to manage different character sets when verifying S/MIME.
MIME messages now include a prolog explaining that they're OpenPGP messages. Also added appropriate Content-Disposition headers to help client programs.
Update docs re: Alpine patches.
Code cleanup (e.g., vars that could be declared constant, and some unused procedure formals).
6/6/2009; release 66
Removed spurious spaces from Topal ‘-----’ text that were messing up format=flowed text. Note that this doesn't fix cache files that already have this problem.
Changed the default sending and receiving GPG options (use the -default option to see them). This does not override whatever is in your current .topal/config file.
Added a configuration option ‘omit-inline-disposition-name’: apparently some mail services mistreat inline MIME parts if they have a filename. If this option is set, then no filename parameter is added to inline content-disposition headers. The option can be changed via the configuration menu.
6/6/2009; release 67
Added another configuration option ‘omit-inline-disposition-header’. If a disposition header of value inline would be added, it's simply omitted altogether.
27/6/2009; release 68
Minor bug fix with configuration handling of omit-inline-disposition-header.
Added new configuration option save-on-send.
A range of major and minor changes to the sending interface.
Added the sd configuration option that allows keys or emails to be associated with particularly sending options.
When secret keys aren't available, still try to add a suitable key for self for encryption.
MIME viewer setting has been replaced by two: one for decrypt and one for verify.
Bad lines in the configuration file now result in a warning, not an exception.
Internal modifications to configuration handling.
21/7/2009; release 69
No longer calling an external app for line-end conversions.
Added a note re: Alpine's S/MIME message about certificates.
Show the list of recipients just before sending (from the to/cc/bcc lists; not lcc, as Alpine doesn't pass those to in the _RECIPIENTS_ token). The idea is to allow the user to spot the “oh no, I didn't intend to email that person” problem.
22/9/2009; release 70
Added use-agent configuration option. This has three values: (1) never use an agent, (2) only use it for decryption, (3) always use it. Don't put GPG's --[no-]use-agent options in any other configuration options or it might be confusing.
Adding attachments when using a non-MIME mode forces a change to a suitable mode (where possible).
Presentation changes for recipient list check.
Fixed a minor typo in a user message.
25/2/2010; release 71
Added more MICALGs from RFC4880.
Handle missing Content-Type headers in multipart messages.
Reorganise menus: hopefully, they're easier to read now. Add some colourisation (this can be disabled by setting ansi-terminal to off). Assorted tidying.
Warn if sending defaults to encryption, but some keys are missing.
Add -pd - pipe-display mode. Takes stdin and treats it as a MIME email for display/verification.
Release code is now taken from the README.html file rather than a separate release file.
Slight clean-up of this README.
25/2/2010; release 72
Fix menus for non-Pine sending. (‘Go’ wasn't working!)
Trap attempts to encrypt when no keys are in the key list.
Minor change to distrib text and Makefile.
Distrib target in Makefile now uses GPG agent.
29/4/2011; release 73
Fix crash when sending attachments with spaces in filenames.
Add new switch, wait-if-missing-keys, which requires the user to acknowledge if keys are missing when defaulting to encryption.
Slightly reorganise configuration menu to keep it within 24 lines.
Update documentation re: crashes related to the second patch and mailcap files.
Topal makes greater efforts to check that external commands exist before running them.
Exception messages are repeated via Ada's exception handling (if Topal panics).
Added decrypt-prereq option. See this note.
Experimental S/MIME sending support added.
More use of GnuPG's --status-fd option so that we can determine exit status properly.
Replaced ancient expanding_array package with Ada.Containers.Vectors.
Adding sendmail-path filter mode. This is needed for the S/MIME encrypted and S/MIME sign+encrypted modes. (Otherwise only Topal can read them; neither Outlook nor Thunderbird will cope with an S/MIME part inside multipart/mixed.) This mode also needs pinentry-qt for gpgsm: pinentry-curses doesn't like this environment.
In the sendmail-path filter mode, we no longer need the content-type guessing. We can simply re-use the content-type from the original header.
Added replace-ids option which can replace Message-ID (and also Content-ID) in sendmail-path filter mode.
The sendmail-path mode can also add a token to help spot our cc'd emails. Use something like st=user@domain,token to set a password. This is hashed with some headers for each email and added to an X-Topal-Send-Token header. Topal then has a -cst token mode which adds a X-Topal-Check-Send-Token header with either yes or no for that header.
Investigation suggests that group addresses are handled other than I expect. E.g., Group name:; in the to: field and the actual list of addresses in lcc field will result in the addresses appearing in the bcc field in sendmail-path filter mode.
Rewrite main documentation in LaTeX: the main manual is now topal.pdf. The change log is still in HTML.
Start adding interoperability notes to manual.
Diagnosing issue with clearsigned (both OpenPGP and S/MIME) emails that have passed through an MS Exchange server being corrupted.
Added opaque signing option for S/MIME.
Added attachment-trap boolean option. In -asend mode, this causes Topal to complain if the message body contains the string “attach” but doesn't have any attachments.
23/6/2011; release 74
Oops, wrong year in release 73 date….
Topal needs GNAT's -gnat05 switch.
Documentation update:
  • Noted the need for GNU's sed (particularly important if you're using Mac OS X).
  • Noted that gpg-agent needs HUPing if trustlist.txt is updated.

Added include-send-token switch, where 1 never includes them, 2 asks and 3 always includes them.
Warnings about configuration errors now go to stderr, rather than messing up other processing output.
Heuristic for attachment trap is improved. This now copes with the case where the email comprises a single multipart/mixed MIME part.
Some comparisons for content-types are case-insensitive now.
26/2/2012; release 75
Most changes this time are to cope with non-cryptographic meddling for my work environment.
Fix Clean_Email_Address to cope with mailboxes with double quotes and commas.
Added fix-fcc option that modifies a X-Topal-Fcc header. It is encrypted using the send-token for that sender to X-Topal-Fcce. The --check-send-token filter will also reverse this.
Added fix-bcc option that adds a X-Topal-Bcce header. It's handled similarly to X-Topal-Fcce, but records the Bcc contents. The --check-send-token filter will also reverse this. Fix token hashing so that it copes with different outputs from openssl sha1.
22/2/2015; release 76
Add -raw command, that can be used by piping a raw message (with free output) from Alpine. Also usable on an mbox from the command-line.
Multiple documentation updates, including deprecation of the two patches to Alpine, contact email address and copyright dates.
20/9/2015; release 77
Fix bad HTML formatting in this file.
Bug fix for clearsigning MIME files that don't have a MIME prologue.
Typo fixes from Nicolas Boulenguez to MIME-tool README, man page and mime.c. Thank you!
22/7/2018; release 78
Replace some ancient use of DES3 with AES128CBC.
Move from SHA1 to SHA256.
Packaging improvements (remove unnecessary binaries and change detached signature name).
Improvements to Makefile for downstream distributors.
Some of these changes are based on suggestions from Nicolas Boulenguez (particularly around the Makefile). Thank you again!
22/2/2019; release 79
Correct last changelog to show that we really did move from SHA1 to SHA256, not the other way!
Refactor key handling so that key selection works better. (If this breaks your setup, please let me know which GPG version you're using.) Improved de-duplication.
Change debug handling so that debug data goes to a file rather than messing up terminals.
22/2/2019; release 80
Fix broken build of mime-tool.

See the documentation in topal.pdf for further details.

topal-80/mkversionidtex0000755000175000017500000000136513434071426013544 0ustar pjbpjb#!/bin/sh # Topal: GPG/GnuPG and Alpine/Pine integration # Copyright (C) 2001--2018 Phillip J. Brooke # # This program 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. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . cat > versionid.tex <. with Char_Menus; with CL_Menus; with Globals; use Globals; pragma Elaborate_All(Char_Menus, CL_Menus); package Menus is -- Yes/no. type YN_Index is (Yes, No); package YN_Menus is new Char_Menus (Index => YN_Index); function YN_Menu is new YN_Menus.Menu (Accept_Chars => YN_Menus.MA'(No => ToUBS("Nn"), Yes => ToUBS("Yy")), Char_Words => YN_Menus.MA'(No => ToUBS("[No]"), Yes => ToUBS("[Yes]")), Default_Prompt => "{Y}es or {n}o? "); -- Yes/no/remote. type YNR_Index is (Yes, No, Remote); package YNR_Menus is new Char_Menus (Index => YNR_Index); function YNR_Menu is new YNR_Menus.Menu (Accept_Chars => YNR_Menus.MA'(No => ToUBS("Nn"), Yes => ToUBS("Yy"), Remote => ToUBS("Rr")), Char_Words => YNR_Menus.MA'(No => ToUBS("[No]"), Yes => ToUBS("[Yes]"), Remote => ToUBS("[Remote]")), Default_Prompt => "{Y}es, {n}o or {r}emote? "); -- Continue? type Wait_Index is (Continue); package Wait_Menus is new Char_Menus (Index => Wait_Index); function Wait_Menu is new Wait_Menus.Menu (Accept_Chars => Wait_Menus.MA'(Continue => ToUBS(" ")), Char_Words => Wait_Menus.MA'(Continue => ToUBS("[Continue]")), Default_Prompt => "Press {space} to continue: "); -- Configuration top edit menu. type Edit_Index is (Quit, Save, Binary_Paths, GPG_Options, DV_Settings, Own_Key, Key_Assoc, Key_Excl, Set_Defaults, Toggle_Debug, Reset, Toggle_ISO, MV_D_Setting, MV_V_Setting, UGA_Setting, Toggle_OIDN, Toggle_OIDH, Toggle_SOS, Toggle_WIMS); package Edit_Menus is new Char_Menus (Index => Edit_Index); function Edit_Menu is new Edit_Menus.Menu (Accept_Chars => Edit_Menus.MA'(Quit => ToUBS("qQ"), Save => ToUBS("sS"), Binary_Paths => ToUBS("pP"), GPG_Options => ToUBS("oO"), DV_Settings => ToUBS("eE"), Own_Key => ToUBS("mM"), Key_Assoc => ToUBS("aA"), Key_Excl => ToUBS("xX"), Set_Defaults => ToUBS("dD"), Toggle_Debug => ToUBS("bB"), Toggle_ISO => ToUBS("cC"), MV_D_Setting => ToUBS("vV"), MV_V_Setting => ToUBS("wW"), UGA_Setting => ToUBS("gG"), Toggle_OIDN => ToUBS("iI"), Toggle_OIDH => ToUBS("hH"), Toggle_SOS => ToUBS("nN"), Toggle_WIMS => ToUBS("tT"), Reset => ToUBS("rR")), Char_Words => Edit_Menus.MA'(Quit => ToUBS("[Quit editing]"), Save => ToUBS("[Save changes]"), Binary_Paths => ToUBS("[Change binary paths]"), GPG_Options => ToUBS("[Change GPG options]"), DV_Settings => ToUBS("[Change decrypt/verify settings]"), Own_Key => ToUBS("[Change own key]"), Key_Assoc => ToUBS("[Edit key associations]"), Key_Excl => ToUBS("[Edit key exclusions]"), Set_Defaults => ToUBS("[Set all defaults]"), Toggle_Debug => ToUBS("[Toggle debugging]"), Toggle_ISO => ToUBS("[Toggle inline-separate-output]"), MV_D_Setting => ToUBS("[Change MIME viewer (decrypt) setting]"), MV_V_Setting => ToUBS("[Change MIME viewer (verify) setting]"), UGA_Setting => ToUBS("[Change use-agent setting]"), Toggle_OIDN => ToUBS("[Toggle omit-inline-disposition-name]"), Toggle_OIDH => ToUBS("[Toggle omit-inline-disposition-header]"), Toggle_SOS => ToUBS("[Toggle save-on-send]"), Toggle_WIMS => ToUBS("[Toggle wait-if-missing-keys"), Reset => ToUBS("[Reset to current saved configuration]")), Default_Prompt => "Change: " & " {m} Own key" & " {o} GPG options" & NL & " {e} Decrypt/verify settings" & " {c} Toggle inline-separate-output" & NL & " {h} Toggle omit-inline-disposition-header" & NL & " {i} Toggle omit-inline-disposition-name" & NL & " {n} Toggle save-on-send {t} Toggle wait-if-missing-keys" & NL & " MIME viewer: {v} Change (decrypt) setting {w} Change (verify) setting" & NL & " {g} Change use GPG agent" & NL -- & " {a} Key associations (interactive config not implemented)" & NL -- & " {x} Key exclusions (interactive config not implemented)" & NL & " {p} Binary paths (interactive config not implemented)" & NL & " {r} Set config to current saved file" & " {d} Set all defaults" & NL & " {b} Toggle debugging" & NL & " {s} Save changes" & " {q} Quit editing" & NL); -- Configuration options submenu. type Options_Index is (Quit, Change_General, Change_GPG, Change_Receiving, Change_Sending, Default_General, Default_GPG, Default_Receiving, Default_Sending, Default_All); package Options_Menus is new Char_Menus (Index => Options_Index); function Options_Menu is new Options_Menus.Menu (Accept_Chars => Options_Menus.MA'(Quit => ToUBS("qQ"), Change_General => ToUBS("bB"), Change_GPG => ToUBS("aA"), Change_Receiving => ToUBS("cC"), Change_Sending => ToUBS("dD"), Default_General => ToUBS("fF"), Default_GPG => ToUBS("eE"), Default_Receiving => ToUBS("gG"), Default_Sending => ToUBS("hH"), Default_All => ToUBS("iI")), Char_Words => Options_Menus.MA'(Quit => ToUBS("[Quit options submenu]"), Change_General => ToUBS("[Change general options]"), Change_GPG => ToUBS("[Change GPG options]"), Change_Receiving => ToUBS("[Change receiving options]"), Change_Sending => ToUBS("[Change sending options]"), Default_General => ToUBS("[Set general options to default]"), Default_GPG => ToUBS("[Set GPG options to default]"), Default_Receiving => ToUBS("[Set receiving options to default]"), Default_Sending => ToUBS("[Set sending options to default]"), Default_All => ToUBS("[Set all defaults]")), Default_Prompt => "Change: {a} GPG {b} General {c} Receiving {d} Sending" & NL & "Defaults: {e} GPG {f} General {g} Receiving {h} Sending" & NL & "{q} Quit this submenu {i} Set all defaults" & NL); -- Configuration settings submenu. type Settings_Index is (Decrypt_Cached, Decrypt_Cached_Use, Decrypt_Not_Cached, Decrypt_Not_Cached_Use, Verify_Cached, Verify_Cached_Use, Verify_Not_Cached, Verify_Not_Cached_Use, Quit, All_Defaults, Toggle_Decrypt_Cached_Fast, Toggle_Verify_Cached_Fast, Toggle_Verify_Not_Cached_Fast); package Settings_Menus is new Char_Menus (Index => Settings_Index); function Settings_Menu is new Settings_Menus.Menu (Accept_Chars => Settings_Menus.MA'(Decrypt_Cached => ToUBS("aA"), Decrypt_Cached_Use => ToUBS("bB"), Decrypt_Not_Cached => ToUBS("cC"), Decrypt_Not_Cached_Use => ToUBS("dD"), Verify_Cached => ToUBS("eE"), Verify_Cached_Use => ToUBS("fF"), Verify_Not_Cached => ToUBS("gG"), Verify_Not_Cached_Use => ToUBS("hH"), Quit => ToUBS("qQ"), All_Defaults => ToUBS("iI"), Toggle_Decrypt_Cached_Fast => ToUBS("jJ"), Toggle_Verify_Cached_Fast => ToUBS("kK"), Toggle_Verify_Not_Cached_Fast => ToUBS("lL")), Char_Words => Settings_Menus.MA' (Decrypt_Cached => ToUBS("[Decrypt, cached]"), Decrypt_Cached_Use => ToUBS("[Decrypt, cached, cache usage]"), Decrypt_Not_Cached => ToUBS("[Decrypt, not cached]"), Decrypt_Not_Cached_Use => ToUBS("[Decrypt, not cached, cache usage]"), Verify_Cached => ToUBS("[Verify, cached]"), Verify_Cached_Use => ToUBS("[Verify, cached, cache usage]"), Verify_Not_Cached => ToUBS("[Verify, not cached]"), Verify_Not_Cached_Use => ToUBS("[Verify, not cached, cache usage]"), Quit => ToUBS("[Quit settings submenu]"), All_Defaults => ToUBS("[Set all defaults]"), Toggle_Decrypt_Cached_Fast => ToUBS("[Toggle decrypt/cached fast continue]"), Toggle_Verify_Cached_Fast => ToUBS("[Toggle verify/cached fast continue]"), Toggle_Verify_Not_Cached_Fast => ToUBS("[Toggle verify/not cached fast continue]")), Default_Prompt => "Decrypt: {a} Cached {b} Cache usage {c} Not cached {d} Cache usage" & NL & "Verify: {e} Cached {f} Cache usage {g} Not cached {h} Cache usage" & NL & "Tgl fast continue: {j} Decrypt/cached {k} Verify/cached {l} Verify/not cached" & NL & "{q} Quit this submenu {i} Set all defaults" & NL); -- Configuration three way switch. type Three_Way_Index is (Always, Ask, Never); package Three_Way_Menus is new Char_Menus (Index => Three_Way_Index); function Three_Way_Menu is new Three_Way_Menus.Menu (Accept_Chars => Three_Way_Menus.MA'(Always => ToUBS("aA"), Ask => ToUBS("sS"), Never => ToUBS("nN")), Char_Words => Three_Way_Menus.MA'(Always => ToUBS("[Always]"), Ask => ToUBS("[Ask]"), Never => ToUBS("[Never]")), Default_Prompt => "{a} Always {s} Ask {n} Never: "); -- Configuration five way switch. type Five_Way_Index is (UUse, Replace, AskReplace, IgnoreCache, OfferAll); package Five_Way_Menus is new Char_Menus (Index => Five_Way_Index); function Five_Way_Menu is new Five_Way_Menus.Menu (Accept_Chars => Five_Way_Menus.MA'(UUse => ToUBS("uU"), Replace => ToUBS("rR"), AskReplace => ToUBS("aA"), IgnoreCache => ToUBS("iI"), OfferAll => ToUBS("oO")), Char_Words => Five_Way_Menus.MA'(UUse => ToUBS("[Use]"), Replace => ToUBS("[Replace]"), AskReplace => ToUBS("[Ask-replace]"), IgnoreCache => ToUBS("[Ignore cache]"), OfferAll => ToUBS("[Offer all]")), Default_Prompt => "{u} Use {r} Replace {a} Ask-replace {i} Ignore {o} Offer: "); -- Use-replace-ignore choice. type URI_Index is (UUse, Replace, Ignore); package URI_Menus is new Char_Menus (Index => URI_Index); function URI_Menu is new URI_Menus.Menu (Accept_Chars => URI_Menus.MA'(UUse => ToUBS("uU"), Replace => ToUBS("rR"), Ignore => ToUBS("iI")), Char_Words => URI_Menus.MA'(UUse => ToUBS("[Use]"), Replace => ToUBS("[Replace]"), Ignore => ToUBS("[Ignore]")), Default_Prompt => "Cache file exists: {u}se it, {r}eplace it, or {i}gnore it? "); -- Sending menu. type SendMime_Index is (AAbort, ListEdit, AddOwn, EditOwn, AttachEdit, ViewMail, EditMail, Encrypt, SignEncrypt, ClearSign, NoGPG, -- PO means `preserve original'; -- otherwise, overwrite original. EncryptPO, SignEncryptPO, ClearSignPO, DetachSignPO, Configure, Remote, Go, -- Stuff that used to be in the MIME menu. InlinePlain, AppPGP, Multipart, MultipartEncap, SMIME); subtype Send_Modes is SendMime_Index range Encrypt .. DetachSignPO; subtype MIME_Modes is SendMime_Index Range InlinePlain .. SMIME; package Send_Menus is new Char_Menus (Index => SendMime_Index); function Send_Menu_Pine_Mime is new Send_Menus.Menu (Accept_Chars => Send_Menus.MA'(AAbort => ToUBS("qQ"), ListEdit => ToUBS("lLkK"), AddOwn => ToUBS("@"), EditOwn => ToUBS("wW"), AttachEdit => ToUBS("aA"), ViewMail => ToUBS("vV"), EditMail => ToUBS("mM"), Encrypt => ToUBS("eE"), SignEncrypt => ToUBS("sS"), ClearSign => ToUBS("cC"), Configure => ToUBS("oO"), NoGPG => ToUBS("nN"), Remote => ToUBS("rR"), Go => ToUBS("gG"), InlinePlain => ToUBS("1"), AppPGP => ToUBS("2"), Multipart => ToUBS("3"), MultipartEncap => ToUBS("4"), SMIME => ToUBS("pP"), EncryptPO | SignEncryptPO | ClearSignPO | DetachSignPO => ToUBS("")), Char_Words => Send_Menus.MA'(AAbort => ToUBS("[Abort]"), ListEdit => ToUBS("[List/edit current recipient keys]"), AddOwn => ToUBS("[Add own key]"), EditOwn => ToUBS("[Edit own key]"), AttachEdit => ToUBS("[List/edit attachments]"), ViewMail => ToUBS("[View mail]"), EditMail => ToUBS("[Edit mail]"), Encrypt => ToUBS("[Encrypt]"), SignEncrypt => ToUBS("[Sign-encrypt]"), ClearSign => ToUBS("[Clearsign]"), Configure => ToUBS("[Configuration]"), NoGPG => ToUBS("[Unchanged; no crypto]"), Remote => ToUBS("[Remote now]"), Go => ToUBS("[Go now]"), InlinePlain => ToUBS("[Inline plain text]"), AppPGP => ToUBS("[application/pgp]"), Multipart => ToUBS("[RFC2015 multipart]"), MultipartEncap => ToUBS("[Multipart encapsulated]"), SMIME => ToUBS("[SMIME]"), EncryptPO | SignEncryptPO | ClearSignPO | DetachSignPO => ToUBS("")), Default_Prompt => "{lkr} List/edit recip. keys {@} Add own key {w} Edit own key" & NL & "{n} Pass through unchanged {1} Inline plain {v} View mail " & NL & "{e} Encrypt {2} app/pgp {m} Edit mail" & NL & "{s} Sign-encrypt {3} multipart/* {a} List/edit attachments" & NL & "{c} Clearsign {4} multipart encap {o} Configuration" & NL & "{g} Go! {r} Remote! {q} Abort!" & NL & " {p} S/MIME " & NL ); function Send_Menu_Pine_Plain is new Send_Menus.Menu (Accept_Chars => Send_Menus.MA'(AAbort => ToUBS("qQ"), ListEdit => ToUBS("lLkK"), AddOwn => ToUBS("@"), EditOwn => ToUBS("wW"), AttachEdit => ToUBS(""), ViewMail => ToUBS("vV"), EditMail => ToUBS("mM"), Encrypt => ToUBS("eE"), SignEncrypt => ToUBS("sS"), ClearSign => ToUBS("cC"), Configure => ToUBS("oO"), NoGPG => ToUBS("nN"), Remote => ToUBS("rR"), Go => ToUBS("gG"), InlinePlain | AppPGP | Multipart | MultipartEncap | SMIME | EncryptPO | SignEncryptPO | ClearSignPO | DetachSignPO => ToUBS("")), Char_Words => Send_Menus.MA'(AAbort => ToUBS("[Abort]"), ListEdit => ToUBS("[List/edit current recipient keys]"), AddOwn => ToUBS("[Add own key]"), EditOwn => ToUBS("[Edit own key]"), AttachEdit => ToUBS(""), ViewMail => ToUBS("[View mail]"), EditMail => ToUBS("[Edit mail]"), Encrypt => ToUBS("[Encrypt]"), SignEncrypt => ToUBS("[Sign-encrypt]"), ClearSign => ToUBS("[Clearsign]"), Configure => ToUBS("[Configuration]"), NoGPG => ToUBS("[Unchanged; no GPG]"), Remote => ToUBS("[Remote now]"), Go => ToUBS("[Go now]"), InlinePlain | AppPGP | Multipart | MultipartEncap | SMIME | EncryptPO | SignEncryptPO | ClearSignPO | DetachSignPO => ToUBS("")), Default_Prompt => "{lkr} List/edit recip. keys {@} Add own key {w} Edit own key" & NL & "{n} Pass through unchanged {v} View mail " & NL & "{e} Encrypt {m} Edit mail" & NL & "{s} Sign-encrypt " & NL & "{c} Clearsign {o} Configuration" & NL & "{g} Go! {r} Remote! {q} Abort!" & NL ); function Send_Menu_NP is new Send_Menus.Menu (Accept_Chars => Send_Menus.MA'(AAbort => ToUBS("qQ"), ListEdit => ToUBS("lLkK"), AddOwn => ToUBS("@"), EditOwn => ToUBS("wW"), AttachEdit => ToUBS(""), ViewMail => ToUBS("vV"), EditMail => ToUBS("mM"), Encrypt => ToUBS("e"), SignEncrypt => ToUBS("s"), ClearSign => ToUBS("c"), EncryptPO => ToUBS("E"), SignEncryptPO => ToUBS("S"), ClearSignPO => ToUBS("C"), DetachSignPO => ToUBS("D"), NoGPG => ToUBS("nN"), Configure => ToUBS("oO"), Go => ToUBS("gG"), Remote | InlinePlain | AppPGP | Multipart | MultipartEncap | SMIME => ToUBS("")), Char_Words => Send_Menus.MA'(AAbort => ToUBS("[Abort]"), ListEdit => ToUBS("[List/edit current recipient keys]"), AddOwn => ToUBS("[Add own key]"), EditOwn => ToUBS("[Edit own key]"), AttachEdit => ToUBS(""), ViewMail => ToUBS("[View mail]"), EditMail => ToUBS("[Edit mail]"), Encrypt => ToUBS("[Encrypt, overwrite original]"), SignEncrypt => ToUBS("[Sign-encrypt, overwrite original]"), ClearSign => ToUBS("[Clearsign, overwrite original]"), EncryptPO => ToUBS("[Encrypt, preserve original]"), SignEncryptPO => ToUBS("[Sign-encrypt, preserve original]"), ClearSignPO => ToUBS("[Clearsign, preserve original]"), DetachSignPO => ToUBS("[Detach-sign]"), NoGPG => ToUBS("[Unchanged; no GPG]"), Configure => ToUBS("[Configuration]"), Go => ToUBS("[Go now]"), Remote | InlinePlain | AppPGP | Multipart | MultipartEncap | SMIME => ToUBS("")), Default_Prompt => "{lkr} List/edit recip. keys {@} Add own key {w} Edit own key" & NL & "{n} Pass through unchanged {D} Detach sig prsv {v} View mail " & NL & "{e} Encrypt {E} Encrypt prsv {m} Edit mail" & NL & "{s} Sign-encrypt {S} Sign-encrypt prsv {o} Configuration" & NL & "{c} Clearsign {C} Clearsign prsv {q} Abort!" & NL & "{g} Go! D, E, S and C preserve original file" & NL ); -- Operations on a specific key. type Specific_Key_Index is (Done, Display, DisplayVerbose, Remove, SSelect); package Specific_Key_Menus is new Char_Menus (Index => Specific_Key_Index); function Specific_Key_Menu1 is new Specific_Key_Menus.Menu (Accept_Chars => Specific_Key_Menus.MA'(Done => ToUBS("kKqQlL"), Display => ToUBS("dD"), DisplayVerbose => ToUBS("vV"), Remove => ToUBS("rR"), SSelect => ToUBS("")), Char_Words => Specific_Key_Menus.MA'(Done => ToUBS("[Return to key list]"), Display => ToUBS("[Display details]"), DisplayVerbose => ToUBS("[Verbose display details]"), Remove => ToUBS("[Remove key]"), SSelect => ToUBS("")), Default_Prompt => "{d} Display details of key with less {v} Verbosely" & NL & "{r} Remove key from list {kql} Return to key list " & NL); function Specific_Key_Menu2 is new Specific_Key_Menus.Menu (Accept_Chars => Specific_Key_Menus.MA'(Done => ToUBS("kKqQlL"), Display => ToUBS("dD"), DisplayVerbose => ToUBS("vV"), Remove => ToUBS(""), SSelect => ToUBS("sS")), Char_Words => Specific_Key_Menus.MA'(Done => ToUBS("[Return to key list]"), Display => ToUBS("[Display details]"), DisplayVerbose => ToUBS("[Verbose display details]"), Remove => ToUBS(""), SSelect => ToUBS("[Select this key]")), Default_Prompt => "{d} Display details of key with less {v} Verbosely" & NL & "{s} Select this key {kql} Return to key list " & NL); -- Key list menu. type Keylist_Index is (Done, AddPattern, AddSearch); package Keylist_Menus is new CL_Menus (Index => Keylist_Index); function Keylist_Menu is new Keylist_Menus.Menu (Accept_Chars => Keylist_Menus.MA'(Done => ToUBS("dDqQ"), AddPattern => ToUBS("aAkK"), AddSearch => ToUBS("sS")), Char_Words => Keylist_Menus.MA'(Done => ToUBS("[Return to main send menu]"), AddPattern => ToUBS("[Add keys from main keyring]"), AddSearch => ToUBS("[Select key from search]")), Default_Prompt => "Select key or {dq} to quit and return to main send menu" & NL & " or {s} to select a key after searching in the main keyring" & NL & " or {ak} to add keys from the main keyring " & NL & " (not recommended, use `s')" & NL, Default_Number_Word => "[", Default_Number_Trailword => "]" ); function Keylist_Menu2 is new Keylist_Menus.Menu (Accept_Chars => Keylist_Menus.MA'(Done => ToUBS("dDqQ"), AddPattern => ToUBS(""), AddSearch => ToUBS("")), Char_Words => Keylist_Menus.MA'(Done => ToUBS("[Return to main send menu]"), AddPattern => ToUBS(""), AddSearch => ToUBS("")), Default_Prompt => "Select key, or {dq} to quit and return to main send menu" & NL, Default_Number_Word => "[", Default_Number_Trailword => "]" ); -- Attachment list menu. type Attachlist_Index is (Done, Add); package Attachlist_Menus is new CL_Menus (Index => Attachlist_Index); function Attachlist_Menu is new Attachlist_Menus.Menu (Accept_Chars => Attachlist_Menus.MA'(Done => ToUBS("dDqQ"), Add => ToUBS("aA")), Char_Words => Attachlist_Menus.MA'(Done => ToUBS("[Return to main send menu]"), Add => ToUBS("[Add file]")), Default_Prompt => "Select file to remove" & NL & "{a} to add a file" & NL & "{dq} to quit and return to main send menu" & NL, Default_Number_Word => "[", Default_Number_Trailword => "]" ); -- Two menus for MIME viewers, one which includes ask. type MIME_Viewer_Index is (Ask, Metamail, Run_Mailcap, Save, Skip); MV_Values : constant array (Mime_Viewer_Index) of Integer := (Ask => 1, Metamail => 2, Run_Mailcap => 3, Save => 4, Skip => 5); package MIME_Viewer_Menus is new Char_Menus (Index => MIME_Viewer_Index); function MIME_Viewer_Menu1 is new MIME_Viewer_Menus.Menu (Accept_Chars => MIME_Viewer_Menus.MA'(Ask => ToUBS("aA"), Metamail => ToUBS("mM"), Run_Mailcap => ToUBS("rR"), Save => ToUBS("sS"), Skip => ToUBS("kK")), Char_Words => MIME_Viewer_Menus.MA'(Ask => ToUBS("[Ask]"), Metamail => ToUBS("[Metamail]"), Run_Mailcap => ToUBS("[Run-Mailcap]"), Save => ToUBS("[Save]"), Skip => ToUBS("[Skip]")), Default_Prompt => "{a} Ask {m} metamail {r} run-mailcap {s} Save {k} Skip: "); function MIME_Viewer_Menu2 is new MIME_Viewer_Menus.Menu (Accept_Chars => MIME_Viewer_Menus.MA'(Ask => ToUBS(""), Metamail => ToUBS("mM"), Run_Mailcap => ToUBS("rR"), Save => ToUBS("sS"), Skip => ToUBS("kK")), Char_Words => MIME_Viewer_Menus.MA'(Ask => ToUBS(""), Metamail => ToUBS("[Metamail]"), Run_Mailcap => ToUBS("[Run-Mailcap]"), Save => ToUBS("[Save]"), Skip => ToUBS("[Skip]")), Default_Prompt => "{m} metamail {r} run-mailcap {s} Save {k} Skip: "); -- Menu for use-agent. type Use_Agent_Index is (Never, Decrypt_Only, Always); UGA_Values : constant array (Use_Agent_Index) of Integer := (Never => 1, Decrypt_Only => 2, Always => 3); package Use_Agent_Menus is new Char_Menus (Index => Use_Agent_Index); function Use_Agent_Menu is new Use_Agent_Menus.Menu (Accept_Chars => Use_Agent_Menus.MA'(Never => ToUBS("nN"), Decrypt_Only => ToUBS("dD"), Always => ToUBS("aA")), Char_Words => Use_Agent_Menus.MA'(Never => ToUBS("[Never]"), Decrypt_Only => ToUBS("[Decrypt only]"), Always => ToUBS("[Always]")), Default_Prompt => "{n} Never {d} Decrypt only {a} Always: "); -- Wait procedure. procedure Wait; end Menus; topal-80/alpine-1.00.patch0000644000175000017500000004245713434071426013417 0ustar pjbpjbdiff -cr alpine-1.00.orig/alpine/send.c alpine-1.00.new/alpine/send.c *** alpine-1.00.orig/alpine/send.c 2007-12-05 17:50:54.000000000 +0000 --- alpine-1.00.new/alpine/send.c 2008-01-07 15:19:45.000000000 +0000 *************** *** 4025,4030 **** --- 4025,4047 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + /* Topal: Unmangle the body types. */ + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) { + /* This was a single part message which Topal mangled. */ + dprint((9, "Topal: unmangling single part message\n")); + (*body)->type = TYPETEXT; + } + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1 + && (*body)->nested.part->body.type == TYPEMULTIPART + && (*body)->nested.part->body.topal_hack == 1) { + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + dprint((9, "Topal: unmangling first part of multipart message\n")); + (*body)->nested.part->body.type = TYPETEXT; + } + dprint((4, "=== send returning ===\n")); } *************** *** 5265,5286 **** rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); if(nb->type == TYPETEXT && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ ! if(b->subtype) ! fs_give((void **) &b->subtype); ! b->subtype = nb->subtype; nb->subtype = NULL; ! mail_free_body_parameter(&b->parameter); b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); } ! mail_free_body(&nb); } --- 5282,5331 ---- rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); + /* Topal: We're working on the first + text segment of the message. If + the filter returns something that + isn't TYPETEXT, then we need to + pretend (later on) that this is in + fact a TYPETEXT, because Topal has + already encoded it.... + + Original code path first, then an + alternate path. + */ if(nb->type == TYPETEXT && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ ! if(b->subtype) ! fs_give((void **) &b->subtype); ! ! b->subtype = nb->subtype; ! nb->subtype = NULL; ! ! mail_free_body_parameter(&b->parameter); ! b->parameter = nb->parameter; ! nb->parameter = NULL; ! mail_free_body_parameter(&nb->parameter); ! } ! else if(F_ON(F_ENABLE_TOPAL_HACK, ps_global)){ ! /* Perhaps the type isn't TYPETEXT, ! and the hack is requested. So, ! let's mess with the types. */ ! if(nb->type != TYPETEXT){ ! b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; ! ! dprint((9, "Topal: mangling body!\n")); mail_free_body_parameter(&b->parameter); b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + b->topal_hack = 1; + } } ! /* Topal: end */ mail_free_body(&nb); } Only in alpine-1.00.new/imap: ip6 diff -cr alpine-1.00.orig/imap/src/c-client/mail.h alpine-1.00.new/imap/src/c-client/mail.h *** alpine-1.00.orig/imap/src/c-client/mail.h 2007-11-19 23:32:35.000000000 +0000 --- alpine-1.00.new/imap/src/c-client/mail.h 2008-01-07 12:54:20.000000000 +0000 *************** *** 775,780 **** --- 775,781 ---- unsigned long bytes; /* size of text in octets */ } size; char *md5; /* MD5 checksum */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ void *sparep; /* spare pointer reserved for main program */ }; diff -cr alpine-1.00.orig/pith/conf.c alpine-1.00.new/pith/conf.c *** alpine-1.00.orig/pith/conf.c 2007-12-13 19:31:13.000000000 +0000 --- alpine-1.00.new/pith/conf.c 2008-01-07 14:00:58.000000000 +0000 *************** *** 2778,2783 **** --- 2778,2785 ---- F_SEND_WO_CONFIRM, h_config_send_wo_confirm, PREF_SEND, 0}, {"strip-whitespace-before-send", "Strip Whitespace Before Sending", F_STRIP_WS_BEFORE_SEND, h_config_strip_ws_before_send, PREF_SEND, 0}, + {"enable-topal-hack", "Enable Topal hack for OpenPGP/MIME messages", + F_ENABLE_TOPAL_HACK, h_config_enable_topal_hack, PREF_HIDDEN, 0}, {"warn-if-blank-subject", "Warn if Blank Subject", F_WARN_ABOUT_NO_SUBJECT, h_config_warn_if_subj_blank, PREF_SEND, 0}, {"warn-if-blank-to-and-cc-and-newsgroups", "Warn if Blank To and CC and Newsgroups", diff -cr alpine-1.00.orig/pith/conftype.h alpine-1.00.new/pith/conftype.h *** alpine-1.00.orig/pith/conftype.h 2007-11-08 01:14:02.000000000 +0000 --- alpine-1.00.new/pith/conftype.h 2008-01-07 12:50:47.000000000 +0000 *************** *** 487,492 **** --- 487,493 ---- F_MARK_FCC_SEEN, F_MULNEWSRC_HOSTNAMES_AS_TYPED, F_STRIP_WS_BEFORE_SEND, + F_ENABLE_TOPAL_HACK, F_QUELL_FLOWED_TEXT, F_COMPOSE_ALWAYS_DOWNGRADE, F_SORT_DEFAULT_FCC_ALPHA, diff -cr alpine-1.00.orig/pith/pine.hlp alpine-1.00.new/pith/pine.hlp *** alpine-1.00.orig/pith/pine.hlp 2007-12-20 16:34:31.000000000 +0000 --- alpine-1.00.new/pith/pine.hlp 2008-01-07 12:47:42.000000000 +0000 *************** *** 3023,3028 **** --- 3023,3029 ----
  • FEATURE:
  • FEATURE:
  • FEATURE: +
  • FEATURE:
  • FEATURE:
  • FEATURE:
  • FEATURE: *************** *** 27962,27967 **** --- 27963,27983 ---- <End of help on this topic> + ====== h_config_enable_topal_hack ===== + + + FEATURE: <!--#echo var="FEAT_enable-topal-hack"--> + + +

    FEATURE:

    +

    + This feature allows Topal (and other sending-filters) to change the + MIME type of the email. This is potentially dangerous because it + pretends that multipart emails are plain emails. +

    + <End of help on this topic> + + ====== h_config_del_from_dot ===== diff -cr alpine-1.00.orig/pith/send.c alpine-1.00.new/pith/send.c *** alpine-1.00.orig/pith/send.c 2007-12-01 01:10:52.000000000 +0000 --- alpine-1.00.new/pith/send.c 2008-01-07 15:18:45.000000000 +0000 *************** *** 108,114 **** long pine_rfc822_output_body(BODY *,soutr_t,TCPSTREAM *); int pine_write_body_header(BODY *, soutr_t, TCPSTREAM *); int pine_write_header_line(char *, char *, STORE_S *); ! int pine_write_params(PARAMETER *, STORE_S *); char *tidy_smtp_mess(char *, char *, char *, size_t); int lmc_body_header_line(char *, int); int lmc_body_header_finish(void); --- 108,114 ---- long pine_rfc822_output_body(BODY *,soutr_t,TCPSTREAM *); int pine_write_body_header(BODY *, soutr_t, TCPSTREAM *); int pine_write_header_line(char *, char *, STORE_S *); ! int pine_write_params(PARAMETER *, STORE_S *, BODY *); char *tidy_smtp_mess(char *, char *, char *, size_t); int lmc_body_header_line(char *, int); int lmc_body_header_finish(void); *************** *** 1726,1732 **** --- 1726,1734 ---- /* set up counts and such to keep track sent percentage */ send_bytes_sent = 0; gf_filter_init(); /* zero piped byte count, 'n */ + dprint((1, "Topal: HERE 1!\n")); send_bytes_to_send = send_body_size(body); /* count body bytes */ + dprint((1, "Topal: HERE 2!\n")); ps_global->c_client_error[0] = error_buf[0] = '\0'; we_cancel = busy_cue(_("Sending mail"), send_bytes_to_send ? sent_percent : NULL, 0); *************** *** 1743,1748 **** --- 1745,1753 ---- #endif + dprint((1, "Topal: HERE 3!\n")); + + /* * If the user's asked for it, and we find that the first text * part (attachments all get b64'd) is non-7bit, ask for 8BITMIME. *************** *** 1750,1755 **** --- 1755,1761 ---- if(F_ON(F_ENABLE_8BIT, ps_global) && (bp = first_text_8bit(body))) smtp_opts |= SOP_8BITMIME; + dprint((1, "Topal: HERE 3.1!\n")); #ifdef DEBUG #ifndef DEBUGJOURNAL if(debug > 5 || (flags & CM_VERBOSE)) *************** *** 1813,1829 **** --- 1819,1839 ---- } } + dprint((1, "Topal: HERE 4!\n")); + /* * Install our rfc822 output routine */ sending_hooks.rfc822_out = mail_parameters(NULL, GET_RFC822OUTPUT, NULL); (void)mail_parameters(NULL, SET_RFC822OUTPUT, (void *)post_rfc822_output); + dprint((1, "Topal: HERE 5!\n")); /* * Allow for verbose posting */ (void) mail_parameters(NULL, SET_SMTPVERBOSE, (void *) pine_smtp_verbose_out); + dprint((1, "Topal: HERE 6!\n")); /* * We do this because we want mm_log to put the error message into *************** *** 1867,1872 **** --- 1877,1883 ---- ps_global->noshow_error = 0; + dprint((1, "Topal: HERE 7!\n")); TIME_STAMP("smtp open", 1); if(sending_stream){ unsigned short save_encoding, added_encoding; *************** *** 2429,2437 **** BODY * first_text_8bit(struct mail_bodystruct *body) { ! if(body->type == TYPEMULTIPART) /* advance to first contained part */ body = &body->nested.part->body; return((body->type == TYPETEXT && body->encoding != ENC7BIT) ? body : NULL); } --- 2440,2451 ---- BODY * first_text_8bit(struct mail_bodystruct *body) { ! /* Be careful of Topal changes... */ ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) /* advance to first contained part */ body = &body->nested.part->body; + /* Topal: this bit might not be correct, now. */ return((body->type == TYPETEXT && body->encoding != ENC7BIT) ? body : NULL); } *************** *** 2802,2820 **** dprint((4, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (!body->parameter) { /* cookie not set up yet? */ char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! snprintf (tmp,sizeof(tmp),"%ld-%ld-%ld=:%ld",gethostid (),random (),(long) time (0), (long) getpid ()); tmp[sizeof(tmp)-1] = '\0'; set_parameter(&body->parameter, "BOUNDARY", tmp); } - part = body->nested.part; /* encode body parts */ - do pine_encode_body (&part->body); - while ((part = part->next) != NULL); /* until done */ break; ! case TYPETEXT : /* * If the part is text we edited, then it is UTF-8. --- 2816,2836 ---- dprint((4, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (body->topal_hack != 1) { /* But only if Topal hasn't touched it! */ ! if (!body->parameter) { /* cookie not set up yet? */ char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! snprintf (tmp,sizeof(tmp),"%ld-%ld-%ld=:%ld",gethostid (),random (),(long) time (0), (long) getpid ()); tmp[sizeof(tmp)-1] = '\0'; set_parameter(&body->parameter, "BOUNDARY", tmp); + } + part = body->nested.part; /* encode body parts */ + do pine_encode_body (&part->body); + while ((part = part->next) != NULL); /* until done */ } break; ! case TYPETEXT : /* * If the part is text we edited, then it is UTF-8. *************** *** 4171,4177 **** dprint((4, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 4187,4195 ---- dprint((4, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling, ! unless Topal messed with it */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 4261,4270 **** * BEFORE applying any encoding (rfc1341: appendix G)... * NOTE: almost all filters expect CRLF newlines */ ! if(body->type == TYPETEXT ! && body->encoding != ENCBASE64 && !so_attr((STORE_S *) body->contents.text.data, "rawbody", NULL)){ ! gf_link_filter(gf_local_nvtnl, NULL); } switch (body->encoding) { /* all else needs filtering */ --- 4279,4292 ---- * BEFORE applying any encoding (rfc1341: appendix G)... * NOTE: almost all filters expect CRLF newlines */ ! if(((body->type == TYPETEXT ! && body->encoding != ENCBASE64) ! /* Or if Topal mucked with it... */ ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)) && !so_attr((STORE_S *) body->contents.text.data, "rawbody", NULL)){ ! if(body->topal_hack == 1) ! dprint((9, "Topal: Canonical conversion, although Topal has mangled...\n")); ! gf_link_filter(gf_local_nvtnl, NULL); } switch (body->encoding) { /* all else needs filtering */ *************** *** 4366,4372 **** return(pwbh_finish(0, so)); if(body->parameter){ ! if(!pine_write_params(body->parameter, so)) return(pwbh_finish(0, so)); } else if(!so_puts(so, "; CHARSET=US-ASCII")) --- 4388,4394 ---- return(pwbh_finish(0, so)); if(body->parameter){ ! if(!pine_write_params(body->parameter, so, body)) return(pwbh_finish(0, so)); } else if(!so_puts(so, "; CHARSET=US-ASCII")) *************** *** 4445,4451 **** && so_puts(so, body->disposition.type))) return(pwbh_finish(0, so)); ! if(!pine_write_params(body->disposition.parameter, so)) return(pwbh_finish(0, so)); if(!so_puts(so, "\015\012")) --- 4467,4473 ---- && so_puts(so, body->disposition.type))) return(pwbh_finish(0, so)); ! if(!pine_write_params(body->disposition.parameter, so, body)) return(pwbh_finish(0, so)); if(!so_puts(so, "\015\012")) *************** *** 4507,4513 **** * pine_write_param - convert, encode and write MIME header-field parameters */ int ! pine_write_params(PARAMETER *param, STORE_S *so) { for(; param; param = param->next){ int rv; --- 4529,4535 ---- * pine_write_param - convert, encode and write MIME header-field parameters */ int ! pine_write_params(PARAMETER *param, STORE_S *so, BODY *body) { for(; param; param = param->next){ int rv; *************** *** 4516,4524 **** cs = posting_characterset(param->value, NULL, HdrText); cv = utf8_to_charset(param->value, cs, 0); ! rv = (so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! if(cv && cv != param->value) fs_give((void **) &cv); --- 4538,4554 ---- cs = posting_characterset(param->value, NULL, HdrText); cv = utf8_to_charset(param->value, cs, 0); ! if (body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) { ! /* Did Topal introduce more parameters? */ ! dprint((9, "Topal: parameter encoding of protocol, with Topal hack\n")); ! rv = (so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! } ! else ! rv = (so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! if(cv && cv != param->value) fs_give((void **) &cv); *************** *** 4625,4631 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 4655,4663 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling ! but again, be careful of Topal */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); Only in alpine-1.00.orig/po: Makefile.in Only in alpine-1.00.new/po: stamp-po Only in alpine-1.00.new/regex: .deps Only in alpine-1.00.new/regex: Makefile diff -cr alpine-1.00.orig/web/src/alpined.d/compilation alpine-1.00.new/web/src/alpined.d/compilation *** alpine-1.00.orig/web/src/alpined.d/compilation 2007-12-15 00:27:02.000000000 +0000 --- alpine-1.00.new/web/src/alpined.d/compilation 2008-01-07 13:57:51.000000000 +0000 *************** *** 1 **** ! 117 --- 1 ---- ! 118 Only in alpine-1.00.new/web/src: Makefile Only in alpine-1.00.new/web/src/pubcookie: .deps Only in alpine-1.00.new/web/src/pubcookie: Makefile topal-80/sending-encrypt.adb0000644000175000017500000001546513434071426014332 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . separate(Sending) procedure Encrypt (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Send_Keys : in Keys.Key_List; Selection : in Send_Modes; Mime_Selection : in MIME_Modes; AL : in Attachments.Attachment_List; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean; New_Headers : out UVV) is Out_File : constant String := Temp_File_Name("out"); SFD_File : constant String := Temp_File_Name("sfd"); -- PCT = Prepend content-type. begin if Mime then begin Ada.Text_IO.New_Line(3); if Mime_Selection = Multipart or Mime_Selection = SMIME then declare PCT : constant String := Temp_File_Name("pct"); begin Echo_Out("Content-Type: " & The_Content_Type(Hdrfile, Actual_Send), PCT); Echo_Append("", PCT); Cat_Append(Tmpfile, PCT); Mv_F(PCT, Tmpfile); -- Call out to attachments in case we have to modify Tmpfile. Attachments.Replace_Tmpfile(Tmpfile, AL); end; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt (MIME block 1)"); raise; end; end if; begin if Mime_Selection = SMIME then -- Run GPG. Externals.GPG.GPGSM_Wrap_Encrypt(Out_File, SFD_File, Tmpfile, Send_Keys); else -- Run GPG. Externals.GPG.GPG_Wrap(" --armor --encrypt " & " " & " --output " & Out_File & " " & Keys.Processed_Recipient_List(Send_Keys) & " " & Tmpfile, Out_File, SFD_File); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt (GPG block)"); raise; end; begin if Selection = EncryptPO then -- Rename the file appropriately. Mv_F(Out_File, Tmpfile & ".asc"); elsif Mime_Selection /= SMIME then -- See later coments in S/MIME bit. Really, we'd like to -- just send Out_File as Tmpfile for that case, too, but we -- need to wrap it as a multipart/mixed file. Mv_F(Out_File, Tmpfile); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt (mv block)"); raise; end; if Mime then begin case Mime_Selection is when InlinePlain => -- Inline plain text Echo_Out("Content-Type: text/plain", Mimefile); New_Headers.Append(ToUBS("Content-Type: text/plain")); when AppPGP => -- application/pgp Echo_Out_N("Content-Type: application/pgp; format=text; x-action=encrypt ", Mimefile); New_Headers.Append(ToUBS("Content-Type: application/pgp; format=text; x-action=encrypt ")); when Multipart => -- RFC2015 multipart -- This is the nasty one. declare Blk1 : constant String := Temp_File_Name("mp1"); Blk2 : constant String := Temp_File_Name("mp2"); MC : constant String := Temp_File_Name("mc"); begin -- We first create the two blocks. -- The first block is easy: Echo_Out("Content-Type: application/pgp-encrypted", Blk1); Echo_Append("", Blk1); Echo_Append("Version: 1", Blk1); -- The second block starts with a -- content-type, then is the tmpfile we've -- put together. Echo_Out("Content-Type: application/octet-stream", Blk2); Echo_Append("Content-Disposition: attachment; filename=""message.asc""", Blk2); Echo_Append("", Blk2); Cat_Append(Tmpfile, Blk2); -- Now we put them together. Externals.Mail.Mimeconstruct2(Part1_Filename => Blk1, Part2_Filename => Blk2, Output_Filename => MC, Content_Type => "multipart/encrypted; protocol=""application/pgp-encrypted""", Prolog => "This is an OpenPGP/MIME encrypted message (RFC2440, RFC3156)."); -- Now we need to split these up. Mail.Extract_Content_Type_From_Header(MC, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MC, Tmpfile); end; when MultipartEncap => Error("Menu should not have allowed MultipartEncap here"); when SMIME => -- At this point, we've got Out_File. We want it to be -- CTE b64 and "Content-Type: application/pkcs7-mime; -- smime-type=enveloped-data; name=""smime.p7m". -- So we produce a single multipart mixed blob instead. declare MM : constant String := Temp_File_Name("mm"); MM2 : constant String := Temp_File_Name("mm2"); begin if Actual_Send then New_Headers.Append(ToUBS("Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=""smime.p7m""")); New_Headers.Append(ToUBS("Content-Transfer-Encoding: base64")); New_Headers.Append(ToUBS("Content-Disposition: attachment; filename=""smime.p7m""")); New_Headers.Append(ToUBS("Content-Description: S/MIME cryptographically encrypted message")); Externals.Simple.Mv_F(Out_File, Tmpfile); else Echo_Out("Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=""smime.p7m""", MM); Echo_Append("Content-Transfer-Encoding: base64", MM); Echo_Append("Content-Disposition: attachment; filename=""smime.p7m""", MM); Echo_Append("Content-Description: S/MIME cryptographically encrypted message", MM); Echo_Append("", MM); Cat_Append(Out_File, MM); Mail.Mimeconstruct_Mixed(UBS_Array'(1 => ToUBS(MM)), MM2); Mail.Extract_Content_Type_From_Header(MM2, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MM2, Tmpfile); end if; end; end case; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt (MIME block 2)"); raise; end; end if; if not Actual_Send then Check_Send(Tmpfile, Non_Pine, Mime, Mimefile, Hdrfile, Recipients); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Encrypt"); raise; end Encrypt; topal-80/globals.ads0000644000175000017500000001631513434071426012660 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Characters.Latin_1; with Ada.Containers.Vectors; with Ada.Strings.Unbounded; with Ada.Text_IO; package Globals is -- Initial number of keys to be associated. Initial_KL : constant Positive := 300; Not_Implemented : exception; -- Some renamings of unbounded strings. subtype UBS is Ada.Strings.Unbounded.Unbounded_String; NullUBS : UBS renames Ada.Strings.Unbounded.Null_Unbounded_String; function ToUBS(S : String) return UBS renames Ada.Strings.Unbounded.To_Unbounded_String; function ToStr(U : UBS) return String renames Ada.Strings.Unbounded.To_String; -- We will want to play with arrays of UBS. type UBS_Array is array (Integer range <>) of UBS; -- Pointers to UBS arrays. type UBS_Array_Pointer is access UBS_Array; -- We also want expanding arrays.... package UVP is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => UBS, "=" => Ada.Strings.Unbounded."="); subtype UVV is UVP.Vector; -- We also want key-value pairs of UBS. type UP is record Key, Value : UBS; end record; package UPP is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => UP); subtype UPV is UPP.Vector; -- Want to insert line feeds in some strings. NL : constant String := Ada.Characters.Latin_1.LF & ""; -- Some terminal twiddling. ANSI_CSI : constant String := Ada.Characters.Latin_1.ESC & "["; ANSI_SGR : constant String := "m"; ANSI_SGR_Reset : constant String := ANSI_CSI & ANSI_SGR; -- The result file stuff. Result_File : Ada.Text_IO.File_Type; -- What is our process ID? (Needed for tempfiles.) Our_PID : Integer; -- Our home directory. Topal_Directory : UBS; type Binaries is (Chmod, Clear, Cut, Date, Diff, File, Formail, GPGOP, GPGSM, Grep, Iconv, Less, Locale, Md5sum, Metamail, Mimeconstruct, Mimetool, Mkdir, Mkfifo, Mv, Openssl, Rm, Runmailcap, Scp, Sed, Ssh, Stty, Tee, Test); type Binaries_UBS is array (Binaries) of UBS; type UBS_Opts_Keys is (My_Key, General_Options, GPG_Options, GPGSM_Options, Receiving_Options, Sending_Options, Colour_Menu_Title, Colour_Menu_Key, Colour_Menu_Choice, Colour_Important, Colour_Banner, Colour_Info, Decrypt_Prereq); type Boolean_Opts_Keys is (Decrypt_Cached_Fast_Continue, Verify_Cached_Fast_Continue, Verify_Not_Cached_Fast_Continue, FE_Simple, Inline_Separate_Output, Omit_Inline_Disposition_Name, Omit_Inline_Disposition_Header, Save_On_Send, -- If true, write to .topal/lastmail ANSI_Terminal, Wait_If_Missing_Keys, Attachment_Trap, Fix_Fcc, Fix_Bcc, Debug, -- The following are not in the config file. No_Clean, -- Not preserved in config file. All_Headers, -- Not config file. Read_From, -- Not config file. Ask_Charset -- Not config file. ); subtype Boolean_Opts_Keys_Save is Boolean_Opts_Keys range Decrypt_Cached_Fast_Continue .. Debug; type Positive_Opts_Keys is (Decrypt_Not_Cached, Decrypt_Not_Cached_Use_Cache, Decrypt_Cached, Decrypt_Cached_Use_Cache, Verify_Not_Cached, Verify_Not_Cached_Use_Cache, Verify_Cached, Verify_Cached_Use_Cache, Mime_Viewer_Decrypt, Mime_Viewer_Verify, Use_Agent, Replace_IDs, Include_Send_Token); type UBS_Opts_Array is array (UBS_Opts_Keys) of UBS; type Boolean_Opts_Array is array (Boolean_Opts_Keys) of Boolean; type Positive_Opts_Array is array (Positive_Opts_Keys) of Positive; -- Configuration data types. type Config_Record is record Binary : Binaries_UBS; UBS_Opts : UBS_Opts_Array; Boolean_Opts : Boolean_Opts_Array; Positive_Opts : Positive_Opts_Array; -- decrypt-not-cached: 1 always, 2 ask, 3 never -- decrypt-not-cached-use-cache: 1 always, 2 ask, 3 never -- decrypt-cached: 1 always, 2 ask, 3 never -- decrypt-cached-use-cache: 1 use, 2 again-replace, -- 3 again-ask-replace, -- 4 again-never, 5 offer -- Ditto for verify-not-cached, verify-not-cached-use-cache, -- verify-cached, verify-cached-use-Cache -- MIME_Viewer: 1 ask, 2 use metamail, 3 use run-mailcap, -- 4 save dummy message to ~/mail, 5 skip attachments -- There is one for _Decrypt and one of _Verify. -- Use_Agent: asks about using gpg-agent. -- 1 never, 2 only for decrypting (not signing!), 3 always -- Replace_IDs: only effective in sendmail-path mode. -- 0 do nothing, 1 replace only Message-ID, 2 replace both Message-ID and Content-ID. -- 1 & 2 use this pattern replacement: -- -- to -- <1103061044360.3250%pjb@scm.tees.ac.uk> -- where the address used is Alt_Sign (from the From line). -- Include_Send_Token: only effective in sendmail-path mode. -- 1 never, 2 ask, 3 always. Defaults to 3, but you may find 2 more useful. -- A list of keys to be associated with email addresses. -- Key: the crypto key; Value: the email. AKE : UPV; -- A list of keys to be excluded from the key list. XK : UVV; -- And the same again, this time for the secret key lists. SAKE : UPV; -- A list of keys to be excluded from the key list. SXK : UVV; -- A list of keys and the default send mode. SD : UPV; -- A list of email addresses (Key) and the sendmail command to use (value). SC : UPV; -- Sending tokens. A list of email addresses (from) and the -- token to use. @ANY@ isn't valid. ST : UPV; end record; Config : Config_Record; end Globals; topal-80/attachments.adb0000644000175000017500000002250713434071426013527 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Text_IO; with Externals; use Externals; with Externals.Mail; with Externals.Simple; with Menus; use Menus; with Misc; use Misc; with Readline; package body Attachments is type Menu_Array_Ptr is access all Attachlist_Menus.MNA; -- Add an attachment to the list.... procedure Add_Attachment (Filename : in UBS; List : in out Attachment_List) is Match : Boolean := False; begin Debug("+Add_Attachment"); -- Is it a duplicate? Debug("Add_Attachment: Checking for duplicates"); declare use type UBS; begin Debug("Add_Attachment: Approaching duplicates loop"); for I in 1..Integer(List.AA.Length) loop Debug("Add_Attachment: In duplicates loop"); Match := Match or Filename = List.AA.Element(I); end loop; end; if not Match then -- Add the attachment. Debug("Add_Attachment: Adding an attachment"); List.AA.Append(Filename); Debug("Add_Attachment: Done adding an attachment"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Attachments.Add_Attachment"); raise; end Add_Attachment; -- Remove an attachment. procedure Remove_Attachment (Filename : in UBS; List : in out Attachment_List) is A_Num : Integer; A_Found : Boolean := False; use type UBS; begin for I in 1..Integer(List.AA.Length) loop if Filename = List.AA.Element(I) then A_Found := True; A_Num := I; end if; end loop; if A_Found then List.AA.Delete(A_Num); else raise Attachment_Not_Found; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Attachments.Remove_Attachment"); raise; end Remove_Attachment; -- List the keys and edit them as appropriate (include removing a key -- from that list, and adding one from the keyring. procedure List (List : in out Attachment_List) is A_Head_Length : constant Positive := 74; A_Menu : Menu_Array_Ptr; procedure Generate_A_List is begin Debug("+Generate_A_List"); -- Create a menu with the prefix of these attachments. A_Menu := new Attachlist_Menus.MNA(1..Integer(List.AA.Length)); for I in 1..Integer(List.AA.Length) loop declare S : constant String := ToStr(List.AA.Element(I)); begin if S'Length < A_Head_Length then A_Menu(I) := ToUBS(S); else -- Get the first 10, then ..., then A_Head_Length-13 of the last characters. A_Menu(I) := ToUBS(S(S'First..S'First+9) & "..." & S(S'Last-A_Head_Length+14..S'Last)); end if; end; end loop; Debug("-Generate_A_List"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Attachments.List.Generate_A_List"); raise; end Generate_A_List; Selection : Attachlist_Menus.CLM_Return; Selected : Integer; begin Debug("+List"); Generate_A_List; List_Keys_Loop: loop Ada.Text_IO.New_Line(5); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Menu_Title)) & "** Attachment menu:" & Reset_SGR); Ada.Text_IO.Put_Line(Integer'Image(Attachments.Count(List)) & " attachment(s)"); Selection := Attachlist_Menu(A_Menu.all); if not Selection.Is_Num then case Selection.I is when Done => exit List_Keys_Loop; when Add => -- Add filename. declare New_Filename : UBS; Alt_Filename : UBS; use Ada.Text_IO; begin New_Line(1); Put_Line("Add attachment:"); New_Filename := ToUBS(Readline.Get_String("Type filename: ", Enable_Tab_Completion => True)); -- Deal with the last space that we'll often get. declare NFN : constant String := ToStr(New_Filename); begin if NFN(NFN'Last) = ' ' then Alt_Filename := ToUBS(NFN(NFN'First..NFN'Last-1)); else Alt_Filename := New_Filename; end if; end; -- Does it exist? if Externals.Simple.Test_R(ToStr(New_Filename)) then Add_Attachment(New_Filename, List); Generate_A_List; elsif Externals.Simple.Test_R(ToStr(Alt_Filename)) then Add_Attachment(Alt_Filename, List); Generate_A_List; else Put_Line("`" & ToStr(New_Filename) & "' is not readable or does not exist (if you've used a `~', try expanding it)"); end if; end; end case; else -- Remove the given number. Selected := Selection.N; Remove_Attachment(List.AA.Element(Selected), List); Generate_A_List; end if; end loop List_Keys_Loop; Debug("-List_Keys"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Attachments.List"); raise; end List; procedure Empty_Attachment_List (List : in out Attachment_List) is begin List.AA := UVP.Empty_Vector; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Attachments.Empty_Attachment_List"); raise; end Empty_Attachment_List; function Count (List : in Attachment_List) return Natural is begin return Natural(List.AA.Length); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Attachments.Count"); raise; end Count; procedure Replace_Tmpfile (Tmpfile : in String; List : in Attachment_List) is AL : UBS_Array(1..Count(List)+1); BF : constant String := Temp_File_Name("att64-"); TF : constant String := Temp_File_Name("attrtf"); CT : UBS; begin -- Do nothing if the attachment list is empty. if Integer(List.AA.Length) /= 0 then -- Now, construct a list of items. AL(1) := ToUBS(Tmpfile); for I in 1..Integer(List.AA.Length) loop -- Guess the content type. CT := ToUBS(Externals.Simple.Guess_Content_Type(ToStr(List.AA.Element(I))) & "; name="""&Basename(ToStr(List.AA.Element(I)))&""""); -- Create a base64 subpart. Externals.Mail.Mimeconstruct_Subpart(Infile => ToStr(List.AA.Element(I)), Outfile => BF & Trim_Leading_Spaces(Integer'Image(I)), Content_Type => ToStr(CT), Dos2UnixU => True, Use_Encoding => True, Encoding => "base64"); -- Add the base64's file to the list. AL(I+1) := ToUBS(BF & Trim_Leading_Spaces(Integer'Image(I))); Ada.Text_IO.Put_Line("Added file `"&ToStr(List.AA.Element(I))&"' with content-type `"&ToStr(CT)&"'"); end loop; -- And call mimeconstruct. Externals.Mail.Mimeconstruct_Mixed(AL, TF); -- Then replace the original tmpfile. Externals.Simple.Mv_F(TF, Tmpfile); -- Convert to CR-LF line endings. Externals.Simple.Dos2Unix_U(Tmpfile); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Attachments.Replace_Tmpfile"); raise; end Replace_Tmpfile; end Attachments; topal-80/pine-4.60.patch0000644000175000017500000001735613434071426013113 0ustar pjbpjbdiff -cr OP/pine4.60/imap/src/c-client/mail.h NP/pine4.60/imap/src/c-client/mail.h *** OP/pine4.60/imap/src/c-client/mail.h Tue May 4 20:09:45 2004 --- NP/pine4.60/imap/src/c-client/mail.h Sat Jun 26 18:50:46 2004 *************** *** 703,708 **** --- 703,709 ---- } size; char *md5; /* MD5 checksum */ void *sparep; /* spare pointer reserved for main program */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ }; Only in NP/pine4.60/imap/src/c-client: mail.h.orig diff -cr OP/pine4.60/pine/pine.h NP/pine4.60/pine/pine.h *** OP/pine4.60/pine/pine.h Fri May 7 23:17:48 2004 --- NP/pine4.60/pine/pine.h Sat Jun 26 18:52:31 2004 *************** *** 63,69 **** #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.60" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" --- 63,69 ---- #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.60T" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" diff -cr OP/pine4.60/pine/send.c NP/pine4.60/pine/send.c *** OP/pine4.60/pine/send.c Thu May 6 18:47:28 2004 --- NP/pine4.60/pine/send.c Sat Jun 26 18:58:14 2004 *************** *** 5186,5191 **** --- 5186,5201 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) + /* This was a single part message which Topal mangled. */ + (*body)->type = TYPETEXT; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1) + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + (*body)->nested.part->body.type = TYPETEXT; + dprint(4, (debugfile, "=== send returning ===\n")); } *************** *** 6596,6608 **** rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); ! if(nb->type == TYPETEXT ! && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); b->subtype = nb->subtype; nb->subtype = NULL; --- 6606,6618 ---- rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); ! if(nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); + b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; *************** *** 6610,6615 **** --- 6620,6627 ---- b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + if (b->type != TYPETEXT) + b->topal_hack = 1; } mail_free_body(&nb); *************** *** 9254,9270 **** dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. --- 9266,9284 ---- dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (body->topal_hack != 1){ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ ! } break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. *************** *** 9435,9441 **** dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 9449,9456 ---- dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 9495,9501 **** * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT && body->encoding != ENCBASE64){ gf_link_filter(gf_local_nvtnl, NULL); } --- 9510,9517 ---- * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if((body->type == TYPETEXT && body->encoding != ENCBASE64) ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)){ gf_link_filter(gf_local_nvtnl, NULL); } *************** *** 9595,9609 **** ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); --- 9611,9637 ---- ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) ! { ! if(!(so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! else ! { ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); *************** *** 9834,9840 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 9862,9869 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); topal-80/Buildflags.mk0000644000175000017500000000207413434071426013146 0ustar pjbpjb# Parametrization of the compilations. ###################################################################### # Settings that we expect the distributor or end user to override by # local defaults. # It is common to pass default build flags via the environment instead # of the command line, so we use ?= instead of := or =. CC ?= gcc CFLAGS ?= -g -O2 -fstack-protector --param=ssp-buffer-size=4 -Wformat -Werror=format-security CPPFLAGS ?= -Wdate-time -D_FORTIFY_SOURCE=2 # Most people expect CFLAGS=-O2 to also affect Ada compilations, # unless ADAFLAGS is set directly. ADAFLAGS ?= $(filter-out -Wformat,$(CFLAGS)) LDFLAGS ?= -Wl,-z,relro gnatmake_options ?= ###################################################################### # It is possible to override these variables directly, but this is not # expected to be necessary. # Each FOO variable (end user selection) takes precedence over # default_FOO (author defaults). default_ADAFLAGS := -gnat2012 -gnatwa -gnata -gnato -gnateE default_CFLAGS := -Wall default_LDFLAGS := -Wl,--as-needed default_gnatmake_options := topal-80/receiving.ads0000644000175000017500000000230613434071426013203 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . package Receiving is -- We want to verify or decrypt a message. procedure Display (Tmpfile : in String); -- We want to verify or decrypt an RFC2015 MIME message. procedure Mime_Display (Infile : in String; Content_Type : in String); -- Handle the deprecated application/pgp content-type. procedure Mime_Display_APGP (Infile : in String; Content_Type : in String); -- Eat an entire email from stdin. procedure Process_Stdin; end Receiving; topal-80/externals-gpg.ads0000644000175000017500000001060313434071426014007 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Keys; package Externals.GPG is -- This returns the return value of GPG. -- This function also cleans up the error file to remove -- `gpg: Invalid passphrase; please try again ...' messages. -- ONLY USED FOR RECEIVING! function GPG_Tee (Input_File : String; Output_File : String; Err_File : String; Status_Filename : String) return Integer; function GPGSM_Tee (Input_File : String; Output_File : String; Err_File : String; Encoding_Arg : String; Status_Filename : String; Verify : Boolean) return Integer; -- This returns the return value of GPG. -- This function also cleans up the error file to remove -- `gpg: Invalid passphrase; please try again ...' messages. -- ONLY USED FOR RECEIVING (VERIFYING)! function GPG_Verify_Tee (Input_File : String; Sig_File : String; Output_File : String; Err_File : String; Status_Filename : String) return Integer; function GPGSM_Verify_Tee (Input_File : String; Sig_File : String; Output_File : String; Err_File : String; Status_Filename : String) return Integer; -- Determine the Micalg code from a file. Unrecognised_Micalg : exception; -- From the actual signature file. function Micalg_From_Filename (Sigfile : in String) return String; -- From the status-fd output. function Micalg_From_Status (Status_Filename : in String) return String; -- Search for Code in a status-fd file. function Grep_Status (Status_Filename : String; Code : String) return Boolean; -- Wrapper for GPG sending. GPG_Failed : exception; -- The args should for GPG should be complete (except for the -- leading gpg). The Out_Filename is for checking for the -- existence of an output file. Status_Filename is where GnuPG's -- --status-fd output should be directed. -- ONLY USED FOR SENDING! procedure GPG_Wrap (Args : in String; Out_Filename : in String; Status_Filename : in String); procedure GPGSM_Wrap (Args : in String; Out_Filename : in String; Status_Filename : in String; No_Exception : in Boolean := False); -- A variant of GPGSM_Wrap. We use this to allow us to fallback to -- using OpenSSL if GPGSM is whinging about unusable keys. procedure GPGSM_Wrap_Encrypt (Out_Filename : in String; Status_Filename : in String; In_Filename : in String; Send_Keys : in Keys.Key_List); -- Find a given key(s); dump into the Target filename. procedure Findkey (Key : in String; Target : in String; SMIME : in Boolean; Email : in Boolean := False; Secret : in Boolean := False); -- Find a given secret key(s); dump into the Target filename. procedure Findkey_Secret (Key : in String; Target : in String; SMIME : in Boolean); -- List the details of a given key(s); dump into the Target filename. procedure Listkey (Key : in String; Target : in String; SMIME : in Boolean); -- View (with a pager) the given key(s); optionally verbosely. procedure Viewkey (Key : in String; Verbose : in Boolean; SMIME : in Boolean); -- Extract the uid's from a gpgsm -k $key. procedure Brief_View_SMIME_Key (Key : in String; Target : in String); end Externals.GPG; topal-80/menus.adb0000644000175000017500000000214113434071426012333 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Text_IO; package body Menus is -- Wait for space. procedure Wait is Dummy : Wait_Index; pragma Unreferenced(Dummy); begin Ada.Text_IO.New_Line(2); Dummy := Wait_Menu; Ada.Text_IO.New_Line(2); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Menus.Wait"); raise; end Wait; end Menus; topal-80/screens/0000700000175000017500000000000013434071426012166 5ustar pjbpjbtopal-80/screens/keyListMenu.png0000644000175000017500000001117713434071426015166 0ustar pjbpjbPNG  IHDR@ pHYsHHFk> vpAg] /IDATxmWg#. =Իs( Řh4Nc<σBoBYBYBYBYBYBYBYBYBYBYBYBYBYBy|g3=!-ȚB6vO,*(BnZ#kG\!ZNCԗY~^J1BȽyq>G'|9T"NJF*.?£20Hӧk+҉||p,rKjx Tt+"/##Ezvñǔ BDY'!9wvpI><<8LZ!% ??#,% 6au1nB(C!8]px^&# [Fa{!q'N!)9˙q^Ltl>*A's"1'>)9kLCJPW`t"*2m$3~BUV᷑Lšܷz.wp8k.rK1UNΧ@nHK2OɏǃB Ys8dVӑ<}h=s݉?%!AӀ׷қЇ<P5捸ψJHVx!& D_} (E^Г^rpJT{t$'z$LyG̓v0WB;ȺeԬ;G#bB(g}t찏mL%t`^8bm+E!UīAvI:m[!.z$}"aDY_"rkڞ]nmAmiUB]g)]JVFVDs#am ,Md)úfяd۫zbK Y^R.[! fpRJEr\9gèA~.Jg˪yy|׿gy$'fd[+ 5DJۮ#TcVӭayd:7v pKT)H"j^R˄\'ΈطA:WG\mIM{p?vv&īASmCEc+x|=_Ms?qNvETY^e2`r]LTԘ16k_Gm5]y-;'(644_wVjh;nΈv;Ekg^<-.a^׈҃ͶwMdۈx틄EldZ m#k!]õq"HSB 9%VTJ&5,^SЪU:ܨ,rb[ 󼋳qQĖȥX2#4[`]^--ZլώlhikY€-s2C2)f 4љU(ɹi|!9^iy<7YHT56$B*W-.sZ֦*N "r3"+U$jL tsѿp׉/h/ sxNsch/t?x !aڌ-BNp5 䚐)5cvcW<yGp{[N;Jܐ-U;:kLKD1h.NT1WIQ0~)uELK~˵ `^ٚd HhRGZ̐GKI~Uä{%DNGjFqLu9ݙg}d 9ѷ6;#0-ysYr'd>g'БDch|mt@' RbrD9I\;nIdU tlSJrLŪMv>v0n~TeU^ a=`Z" _!d}88>)a%!,i]0ZG;AYρ7`"tVp)` I*bgpYW2 `KTUTJK-^&>VB&r" Ǘ60}ߣ (*B4+rZI9LӉMgp w2[ҋw7tiEn7>(9`)\J0'<9L"Vk1^yxTk֡qS$̹cscP4t v۱i`) <;7ͩm|S?V[9MrŽK8")Y?ɝ |E|5la=dOLMW:O͑QlB%sm`s*yMIsg:k/[Vv>e^1|7"6]ԇA0Եΐ$]!Ӳ&Z#VW[JV95zw0"룕(.G<+ c Gz)$n[1Q>lVUA&}mTZ|17/]&sGVJw% -uX_Esdq֊Y2Ɩa.Y7"~n^a"' |m5زd3O)w|Oԥ &SUK-zOH eO&7Du6E}ʩ0tZ(۝;^9gZ^3<9G>QRNxQHTQ`qx")A,(cFђ6kV^R-һF]{עәsrOCY(-(GYl >-LJ/@)aYo"' En^ͤ۶#wW~/A/5h#ʹ7ΪwP$DQ^\We+%#E JT$vv) DIlK-Y%ȩ V]Ӥ9Ge$wM1XL/B1Tz. NUDAcbƉFQ/g[A~p){95L)G<)w\']MMܢմMjU+zw$h5Ĭֈ#j)>~RT\Z c\Ơ_I>Ģa͹<~82Kp 8n>1jsNHwzRhUhr~?%uG|c2=(d4fh*T*#AJtB^82Bd ǺBB4*Ǭ F^NCy.o0<먼bd ^wD!^k=BtVM5YF& x D٫1hyl!BYBYBYBYBYBYBPܹ=_8%tEXtdate:create2011-04-29T11:19:32+01:00Q%tEXtdate:modify2011-04-29T11:19:32+01:00 IENDB`topal-80/screens/npsSendMenu.png0000644000175000017500000001043513434071426015150 0ustar pjbpjbPNG  IHDRK u pHYsHHFk> vpAgpXIDATxkrFYDGx=_{1!7<$yIcZ%sy;>.{v@`g5`kq#M*4[-/+Xyv}h(z~3 ڑmѢ͢z Z Y=5 Ii:<C] v~x0menV<~RÕ{aO?/?M p 1x&xzY=Q,3 kYCi1H wGZf1xg;Tǝj̀`9't~PY' l2 P" voaTI>Udz@j3~ cx{soopM1J|;z?p!U)TsB;Ežo Y鷥2UTe;dƚ49C`BYG}aq񍕣"ٸ*ۛ1FptP6 eDyIqQ(;AwD,`YBسso4="h&iQ'c9iYc`O֯>w@+}v ,ާ$? Vh4fn{b_)xC tW:*NKY:GT7T$NV#UNL( H5tBNBreUgMj 9iМi[LC_6^W%=Ǎ`l':&x=pU>*Wp{2-91\fū!r+: eY6[y 94ZEtD6SU5i-O2'0Mĉ\tW-|QmPr%kg4  h§0 B 3<= ֡JpY9:,nvS,*Ooh} T+vJy@FYNlwBEa*="MPܣ#%Zfi'8JX `K9Ø{ P`+Ώi9{%B'6ߠg@[<1ׯ}fف}д)X {غ_/.HʌQ-bg}#tjײ~jZ՚{0dÚ١ !m7_X^)n ?.+*J&a1i+ 2TaiC(+as}`<:VѷNG1BJ?+䥱v S#ntMmgiiVzDHUl{խ7cbjĝXuQ6#m͐/~.t45-Fr"%_Qj~"WkT9ZZgm:cH$\ns~H͞Ifp⵷wē[gmIxI u0&>5[F4ϹVh 7_% TO;~Tv^U|J~k6gXig}hG)Mq%9/a(6;t&9CfOwW=tnQw 3v05@3oyp_Cl&ܭu&6RԬz֣KmWL/X |ch&@37x,?&MNܡi<;h'TzDxxeȐt^~>xm3|qCVS Z72N6J;{FBN!FuO=(.%FJzOj`Y/xv ?+ŞREFK-f SP*ҸdA͇{^ck}9tґ,Wa.NzĐ{jG.LSW1#z &KYckQm=%_~ƫX. Oh_PzMBٚ7TYJh(uZ/z:=&t&+֏{TT*SkEyun2n7_E'[ᬛ`L_T}$=45<^fVz.]Kqk|L $ !4=9q`cz:|%>8QI6՚˽eTsqg\XY:yV-M[45[eyP:Ilå56![ ̛I gzcRq r0gIQӃkDŃA @[=e=UƯYY{>QoEGjdjeQڊ_^_O~ ))0ȩZTsϧ;>M4[ZM+J *{*٭>Y+'gE2*)|kuy,DR^Z zƬmjA\I8yaԘnqWI&J@\xսPbo,d+/`+ZID3%~, !UCmP{%]UK/ۤ9Sfn=f$Kp٧QVJs!4M҉Z4nVݳlŃA @[eJ,kcV\+9ve>BpA fޠLr}0ƹ|w|MY]&U/?񺷄[F6[.·{^ůr [:^Д2휴lO~ۊI8Uq|c`^նݧ/oj嬵0HSx M-zљSeB"j6E'%Қ(Qu.t7Nel3dHDy^=)(N0aM3sU4 K ՏMQ!Ҟ.56wM=x0X)'h6#|$FyBNB vpAgAhIDATx]&FW Ruf_:C88<g*wC4-@ UԶ⧅x~^;gwu 7f`6 npl`30 7f`6 npl?.| _.fpCa~Ca0>}&c\[m`)Rחa+Jv?d@|i1cLY̢z I]%9=vۢU1KSc\$$Z0lצg?4흥tlwXdX[X YW@:.CUA_ʸJ`Œ[]RUMϽSfqf2j;1M'MPp@+v\̽2;R߾}||͑p'p#q3[Xfa2ܯ؅Sp5x^e.˗I Ӳ=isYkg"{<}1{)VW$V)F O~KxNϲ-qJVsUoSĂVꋓ3s}f롅WI+%_1Nt`qIk~Eu`Y TV`Bз=ˌIRt1)fP²89saC)-N4b]e.=7fXpEG{\ 2͸#9訇 Zc*c^pGq8lbgGl1a=k-,`uJBv^Q:W;l &8aCty%Tsa7icYlh5/!f p0ܗb1UW}Xmǀᮑ|+vvWmSu-emURC9lrGLВ;l 3n`ƽ0̎@7ffܓ5Xb6%t,,%c,xT<(bQ|9oy,=G7'?jڎ@~1Y{lASe)a0iRn_RڝD6,XΚQ5ڡt mKwxl yW’>|쵷F]ŭmǝ=:d0  ׫~|̸s7?yzvHҙ$KXzٚZbGO_O׽y\*:JZvJJg,Z7I?ݘHS T꜋>2>j-W:jY [<׹>tO:'SS8J %CϟRӮj%5lqIJ{㛘wko%ϒ&y\*錫;3C1]M[+.`tm;g}g~uY$cUӉ SӔ{w{ =@MhrE(iKWզS|ޕu\I~3i}7J b/kLyrSN*J)K[bYr~tEFY\6.#_ʷ[`_GL`}fKr2W8͔ub 0]%3c5jMƧnM~7O`dvA-#aR&TUVZSJyuKނuJZԦIc?ܫwpq7Y[HT{mU>*=Rj+M!orX4U ^2QkҲ 4e~U&0Y]( >ĊO0614xliuaCeq~eX;]xzPb%2G̡eWI} "0`ĪZqNIX(,z= `7X%Q{[V3TV*KɕR㡵 HR>$?U"2e½Lt"Uj8O7)ܧ'%zYGt!3?eu_zuo ml[Mi9OFUGү^GQoI5n=*+\q~/wݬP>Um1 eXVLy`^oq~TEi#&L#B 6s@E$nev.lo]8ޥ8=:~\g=d_G"t,)S<0!1MU(J.WZ]c0&=I):|NtoΑqw,,oz)dzl +A]~gBق+i^zt#xu:Cq:73M ҡJ%VNg(i.pgXs-}Lwu^FK\v3o&3ƠZ'ǿ8y؈Eu&ߓt=XC_UK-1V: @ y<;׭yq0ָ (yZZ]c0d )P|۷nǰ,$O7n-=-\u#Lz|X6e/(7ضnsM'u>1{=NZ]Sd gBXɘDbǔG7}Ȳ7tyu8_Ȧm1Z%rMf]%fP f7/x3tV]vQrk8]@*43%eEv*mSK@/mʫXy"zPU= .2% :Gc}u II)AKTq^ܒ{RcysvsXϖ0ܯB⡘Nݻ- L. $Gn9yO\TB+ui(GUӹV>WU0zDK9I_0Vc! U:.\|o~G|uO#RLm݄"%pLܢL^vo@ukڈ =ڽ#mJշC BAtI4'-X{awqK7q]]rKWX帄؍fW̒T39S'~lK w"[%G4"S9{q\əf6LR}[ܽT'%8I8Ȕ%`y ;?) c8?Ţ]]$2Id_)B0FAdJȔgÜi^xE=M"S1fʕP[KYGF+Kd) Q 3|3 k3kqclsԘI2]"r^ ,-bJzsFd{]^,,tW2J)EjU^"S>i3>;SwQcitRUKr{e4|XpX]bq< <۰x[0r8+dF_ 2 7ցx2SEJx2o1`)[.4Gߵ/g^}uttq)hEQ3UdU+Lu6 jPxd]"g"^ w|̱fuޒK4n\++N$ǒqz&)#گLб0yߛ7XR[՘O z1p;vؑVؑۉoD iE|̇qji5 wf5! Q_c_X/OvJzHϧ.2%.N..2CX^Am87&)Q.dqaGA[ vpAgR IDATxQr( @=T-2?-\[d?!l^ۍA!d`i§?۟p{}sjο'WM%oKj,+Ӵ,oO7KcӏS|evǰOn:tLn><,U^"~2c ב*|֢r*"]fE4VsQ`{1q&t/Y,'[ w%(ɬk,z1<2RU:!YݙFn'Rትa2vS'hL)B>tC|GQ '5NX/<јpR|AIeZfߥ~{K& DTF|22Vce 41/ńu6[ƉKtjxPVRdJ%䰌2(Ԇ):5-=~(<\icd /ónޓ0)bnOϳ9ͼ(zZ>+}qB|Q}~a_|ݞtEɪtER)(".T&\r颾{c$\82#͐It#)j m_MCT]#[jQCK+2?.0&oTqUM&c~y X/֝ !Uv[Y.m~Sbw2c6q\9~+-g^r҆*2qu]qj+Z33_]p[j Up?xꤏ_NIf{Va gJv4zG1lA`Ւ+yd%gJ{W]I1,¡hFAܚ$K/'hiIx:N,UToj+7=Rαv͟?-8s^T甍zuJkȱ6&r־C8 ΏkQ5[ Mql庡 $p`nc%ԳvUXjjmuSJKVA1+&Иltaq?!axYe~!K<ήUZzxb*GG'᝚J! ޥw|!Y4ʽ% -ȦVdM2t_k'YwËg}k)}ϭ;wŊhWz6jQCaG[bR{"⁉o։%_Q/y~VI[+H׏Dzx$[S/عYo{l Xd{1[6m~t@qR-ܧM*[`Cu2{JT~5N@Jl0v*#3[cNzMK9hSX cQY 6;"*HWd(˜-KYe"WbavRM_҆@F gbZ`Q~nyl kh.ytOr6VugnOY,902p'0 H,<EČk1)[׸xXrc`zbֽ7ٌcJmaK+ ^Z{^s U`]М19%g_3(3r6fn]?ƲɠJl11鴔Z{imer2ƺ7iO !<1l+aOjsZJiܕ^I]˨1ywskpP:{YW-C~=qcuKeKot__,1¥Ek!® ͬky5n^̼ƉƦkZ9ijy:|m֑Qk~N#RKG$e9xzyѨze փ _˘uXE,qVz.9 6 ( , A6 ״p;Ԍ 8kY,`p X5g 8kY,`X+i*%tEXtdate:create2011-04-29T11:26:37+01:00k%tEXtdate:modify2011-04-29T11:26:37+01:00\5IENDB`topal-80/mkversionid0000755000175000017500000000317213434071426013021 0ustar pjbpjb#!/bin/sh # Topal: GPG/GnuPG and Alpine/Pine integration # Copyright (C) 2001--2008 Phillip J. Brooke # # This program 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. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . cat > version_id.adb <. -- Generated by a script. package body Version_ID is -- Release code. function Release return String is begin return "release $1"; end Release; -- Build date. function Build_Date return String is begin return "$2"; end Build_Date; end Version_ID; EOF topal-80/COPYING0000644000175000017500000010437413434071426011602 0ustar pjbpjb GNU GENERAL PUBLIC LICENSE Version 3, 29 June 2007 Copyright (C) 2007 Free Software Foundation, Inc. Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The GNU General Public License is a free, copyleft license for software and other kinds of works. The licenses for most software and other practical works are designed to take away your freedom to share and change the works. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change all versions of a program--to make sure it remains free software for all its users. We, the Free Software Foundation, use the GNU General Public License for most of our software; it applies also to any other work released this way by its authors. You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for them if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs, and that you know you can do these things. To protect your rights, we need to prevent others from denying you these rights or asking you to surrender the rights. Therefore, you have certain responsibilities if you distribute copies of the software, or if you modify it: responsibilities to respect the freedom of others. For example, if you distribute copies of such a program, whether gratis or for a fee, you must pass on to the recipients the same freedoms that you received. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. Developers that use the GNU GPL protect your rights with two steps: (1) assert copyright on the software, and (2) offer you this License giving you legal permission to copy, distribute and/or modify it. For the developers' and authors' protection, the GPL clearly explains that there is no warranty for this free software. For both users' and authors' sake, the GPL requires that modified versions be marked as changed, so that their problems will not be attributed erroneously to authors of previous versions. Some devices are designed to deny users access to install or run modified versions of the software inside them, although the manufacturer can do so. This is fundamentally incompatible with the aim of protecting users' freedom to change the software. The systematic pattern of such abuse occurs in the area of products for individuals to use, which is precisely where it is most unacceptable. Therefore, we have designed this version of the GPL to prohibit the practice for those products. If such problems arise substantially in other domains, we stand ready to extend this provision to those domains in future versions of the GPL, as needed to protect the freedom of users. Finally, every program is threatened constantly by software patents. States should not allow patents to restrict development and use of software on general-purpose computers, but in those that do, we wish to avoid the special danger that patents applied to a free program could make it effectively proprietary. To prevent this, the GPL assures that patents cannot be used to render the program non-free. The precise terms and conditions for copying, distribution and modification follow. TERMS AND CONDITIONS 0. Definitions. "This License" refers to version 3 of the GNU General Public License. "Copyright" also means copyright-like laws that apply to other kinds of works, such as semiconductor masks. "The Program" refers to any copyrightable work licensed under this License. Each licensee is addressed as "you". "Licensees" and "recipients" may be individuals or organizations. To "modify" a work means to copy from or adapt all or part of the work in a fashion requiring copyright permission, other than the making of an exact copy. The resulting work is called a "modified version" of the earlier work or a work "based on" the earlier work. A "covered work" means either the unmodified Program or a work based on the Program. To "propagate" a work means to do anything with it that, without permission, would make you directly or secondarily liable for infringement under applicable copyright law, except executing it on a computer or modifying a private copy. Propagation includes copying, distribution (with or without modification), making available to the public, and in some countries other activities as well. To "convey" a work means any kind of propagation that enables other parties to make or receive copies. Mere interaction with a user through a computer network, with no transfer of a copy, is not conveying. An interactive user interface displays "Appropriate Legal Notices" to the extent that it includes a convenient and prominently visible feature that (1) displays an appropriate copyright notice, and (2) tells the user that there is no warranty for the work (except to the extent that warranties are provided), that licensees may convey the work under this License, and how to view a copy of this License. If the interface presents a list of user commands or options, such as a menu, a prominent item in the list meets this criterion. 1. Source Code. The "source code" for a work means the preferred form of the work for making modifications to it. "Object code" means any non-source form of a work. A "Standard Interface" means an interface that either is an official standard defined by a recognized standards body, or, in the case of interfaces specified for a particular programming language, one that is widely used among developers working in that language. The "System Libraries" of an executable work include anything, other than the work as a whole, that (a) is included in the normal form of packaging a Major Component, but which is not part of that Major Component, and (b) serves only to enable use of the work with that Major Component, or to implement a Standard Interface for which an implementation is available to the public in source code form. A "Major Component", in this context, means a major essential component (kernel, window system, and so on) of the specific operating system (if any) on which the executable work runs, or a compiler used to produce the work, or an object code interpreter used to run it. The "Corresponding Source" for a work in object code form means all the source code needed to generate, install, and (for an executable work) run the object code and to modify the work, including scripts to control those activities. However, it does not include the work's System Libraries, or general-purpose tools or generally available free programs which are used unmodified in performing those activities but which are not part of the work. For example, Corresponding Source includes interface definition files associated with source files for the work, and the source code for shared libraries and dynamically linked subprograms that the work is specifically designed to require, such as by intimate data communication or control flow between those subprograms and other parts of the work. The Corresponding Source need not include anything that users can regenerate automatically from other parts of the Corresponding Source. The Corresponding Source for a work in source code form is that same work. 2. Basic Permissions. All rights granted under this License are granted for the term of copyright on the Program, and are irrevocable provided the stated conditions are met. This License explicitly affirms your unlimited permission to run the unmodified Program. The output from running a covered work is covered by this License only if the output, given its content, constitutes a covered work. This License acknowledges your rights of fair use or other equivalent, as provided by copyright law. You may make, run and propagate covered works that you do not convey, without conditions so long as your license otherwise remains in force. You may convey covered works to others for the sole purpose of having them make modifications exclusively for you, or provide you with facilities for running those works, provided that you comply with the terms of this License in conveying all material for which you do not control copyright. Those thus making or running the covered works for you must do so exclusively on your behalf, under your direction and control, on terms that prohibit them from making any copies of your copyrighted material outside their relationship with you. Conveying under any other circumstances is permitted solely under the conditions stated below. Sublicensing is not allowed; section 10 makes it unnecessary. 3. Protecting Users' Legal Rights From Anti-Circumvention Law. No covered work shall be deemed part of an effective technological measure under any applicable law fulfilling obligations under article 11 of the WIPO copyright treaty adopted on 20 December 1996, or similar laws prohibiting or restricting circumvention of such measures. When you convey a covered work, you waive any legal power to forbid circumvention of technological measures to the extent such circumvention is effected by exercising rights under this License with respect to the covered work, and you disclaim any intention to limit operation or modification of the work as a means of enforcing, against the work's users, your or third parties' legal rights to forbid circumvention of technological measures. 4. Conveying Verbatim Copies. You may convey verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice; keep intact all notices stating that this License and any non-permissive terms added in accord with section 7 apply to the code; keep intact all notices of the absence of any warranty; and give all recipients a copy of this License along with the Program. You may charge any price or no price for each copy that you convey, and you may offer support or warranty protection for a fee. 5. Conveying Modified Source Versions. You may convey a work based on the Program, or the modifications to produce it from the Program, in the form of source code under the terms of section 4, provided that you also meet all of these conditions: a) The work must carry prominent notices stating that you modified it, and giving a relevant date. b) The work must carry prominent notices stating that it is released under this License and any conditions added under section 7. This requirement modifies the requirement in section 4 to "keep intact all notices". c) You must license the entire work, as a whole, under this License to anyone who comes into possession of a copy. This License will therefore apply, along with any applicable section 7 additional terms, to the whole of the work, and all its parts, regardless of how they are packaged. This License gives no permission to license the work in any other way, but it does not invalidate such permission if you have separately received it. d) If the work has interactive user interfaces, each must display Appropriate Legal Notices; however, if the Program has interactive interfaces that do not display Appropriate Legal Notices, your work need not make them do so. A compilation of a covered work with other separate and independent works, which are not by their nature extensions of the covered work, and which are not combined with it such as to form a larger program, in or on a volume of a storage or distribution medium, is called an "aggregate" if the compilation and its resulting copyright are not used to limit the access or legal rights of the compilation's users beyond what the individual works permit. Inclusion of a covered work in an aggregate does not cause this License to apply to the other parts of the aggregate. 6. Conveying Non-Source Forms. You may convey a covered work in object code form under the terms of sections 4 and 5, provided that you also convey the machine-readable Corresponding Source under the terms of this License, in one of these ways: a) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by the Corresponding Source fixed on a durable physical medium customarily used for software interchange. b) Convey the object code in, or embodied in, a physical product (including a physical distribution medium), accompanied by a written offer, valid for at least three years and valid for as long as you offer spare parts or customer support for that product model, to give anyone who possesses the object code either (1) a copy of the Corresponding Source for all the software in the product that is covered by this License, on a durable physical medium customarily used for software interchange, for a price no more than your reasonable cost of physically performing this conveying of source, or (2) access to copy the Corresponding Source from a network server at no charge. c) Convey individual copies of the object code with a copy of the written offer to provide the Corresponding Source. This alternative is allowed only occasionally and noncommercially, and only if you received the object code with such an offer, in accord with subsection 6b. d) Convey the object code by offering access from a designated place (gratis or for a charge), and offer equivalent access to the Corresponding Source in the same way through the same place at no further charge. You need not require recipients to copy the Corresponding Source along with the object code. If the place to copy the object code is a network server, the Corresponding Source may be on a different server (operated by you or a third party) that supports equivalent copying facilities, provided you maintain clear directions next to the object code saying where to find the Corresponding Source. Regardless of what server hosts the Corresponding Source, you remain obligated to ensure that it is available for as long as needed to satisfy these requirements. e) Convey the object code using peer-to-peer transmission, provided you inform other peers where the object code and Corresponding Source of the work are being offered to the general public at no charge under subsection 6d. A separable portion of the object code, whose source code is excluded from the Corresponding Source as a System Library, need not be included in conveying the object code work. A "User Product" is either (1) a "consumer product", which means any tangible personal property which is normally used for personal, family, or household purposes, or (2) anything designed or sold for incorporation into a dwelling. In determining whether a product is a consumer product, doubtful cases shall be resolved in favor of coverage. For a particular product received by a particular user, "normally used" refers to a typical or common use of that class of product, regardless of the status of the particular user or of the way in which the particular user actually uses, or expects or is expected to use, the product. A product is a consumer product regardless of whether the product has substantial commercial, industrial or non-consumer uses, unless such uses represent the only significant mode of use of the product. "Installation Information" for a User Product means any methods, procedures, authorization keys, or other information required to install and execute modified versions of a covered work in that User Product from a modified version of its Corresponding Source. The information must suffice to ensure that the continued functioning of the modified object code is in no case prevented or interfered with solely because modification has been made. If you convey an object code work under this section in, or with, or specifically for use in, a User Product, and the conveying occurs as part of a transaction in which the right of possession and use of the User Product is transferred to the recipient in perpetuity or for a fixed term (regardless of how the transaction is characterized), the Corresponding Source conveyed under this section must be accompanied by the Installation Information. But this requirement does not apply if neither you nor any third party retains the ability to install modified object code on the User Product (for example, the work has been installed in ROM). The requirement to provide Installation Information does not include a requirement to continue to provide support service, warranty, or updates for a work that has been modified or installed by the recipient, or for the User Product in which it has been modified or installed. Access to a network may be denied when the modification itself materially and adversely affects the operation of the network or violates the rules and protocols for communication across the network. Corresponding Source conveyed, and Installation Information provided, in accord with this section must be in a format that is publicly documented (and with an implementation available to the public in source code form), and must require no special password or key for unpacking, reading or copying. 7. Additional Terms. "Additional permissions" are terms that supplement the terms of this License by making exceptions from one or more of its conditions. Additional permissions that are applicable to the entire Program shall be treated as though they were included in this License, to the extent that they are valid under applicable law. If additional permissions apply only to part of the Program, that part may be used separately under those permissions, but the entire Program remains governed by this License without regard to the additional permissions. When you convey a copy of a covered work, you may at your option remove any additional permissions from that copy, or from any part of it. (Additional permissions may be written to require their own removal in certain cases when you modify the work.) You may place additional permissions on material, added by you to a covered work, for which you have or can give appropriate copyright permission. Notwithstanding any other provision of this License, for material you add to a covered work, you may (if authorized by the copyright holders of that material) supplement the terms of this License with terms: a) Disclaiming warranty or limiting liability differently from the terms of sections 15 and 16 of this License; or b) Requiring preservation of specified reasonable legal notices or author attributions in that material or in the Appropriate Legal Notices displayed by works containing it; or c) Prohibiting misrepresentation of the origin of that material, or requiring that modified versions of such material be marked in reasonable ways as different from the original version; or d) Limiting the use for publicity purposes of names of licensors or authors of the material; or e) Declining to grant rights under trademark law for use of some trade names, trademarks, or service marks; or f) Requiring indemnification of licensors and authors of that material by anyone who conveys the material (or modified versions of it) with contractual assumptions of liability to the recipient, for any liability that these contractual assumptions directly impose on those licensors and authors. All other non-permissive additional terms are considered "further restrictions" within the meaning of section 10. If the Program as you received it, or any part of it, contains a notice stating that it is governed by this License along with a term that is a further restriction, you may remove that term. If a license document contains a further restriction but permits relicensing or conveying under this License, you may add to a covered work material governed by the terms of that license document, provided that the further restriction does not survive such relicensing or conveying. If you add terms to a covered work in accord with this section, you must place, in the relevant source files, a statement of the additional terms that apply to those files, or a notice indicating where to find the applicable terms. Additional terms, permissive or non-permissive, may be stated in the form of a separately written license, or stated as exceptions; the above requirements apply either way. 8. Termination. You may not propagate or modify a covered work except as expressly provided under this License. Any attempt otherwise to propagate or modify it is void, and will automatically terminate your rights under this License (including any patent licenses granted under the third paragraph of section 11). However, if you cease all violation of this License, then your license from a particular copyright holder is reinstated (a) provisionally, unless and until the copyright holder explicitly and finally terminates your license, and (b) permanently, if the copyright holder fails to notify you of the violation by some reasonable means prior to 60 days after the cessation. Moreover, your license from a particular copyright holder is reinstated permanently if the copyright holder notifies you of the violation by some reasonable means, this is the first time you have received notice of violation of this License (for any work) from that copyright holder, and you cure the violation prior to 30 days after your receipt of the notice. Termination of your rights under this section does not terminate the licenses of parties who have received copies or rights from you under this License. If your rights have been terminated and not permanently reinstated, you do not qualify to receive new licenses for the same material under section 10. 9. Acceptance Not Required for Having Copies. You are not required to accept this License in order to receive or run a copy of the Program. Ancillary propagation of a covered work occurring solely as a consequence of using peer-to-peer transmission to receive a copy likewise does not require acceptance. However, nothing other than this License grants you permission to propagate or modify any covered work. These actions infringe copyright if you do not accept this License. Therefore, by modifying or propagating a covered work, you indicate your acceptance of this License to do so. 10. Automatic Licensing of Downstream Recipients. Each time you convey a covered work, the recipient automatically receives a license from the original licensors, to run, modify and propagate that work, subject to this License. You are not responsible for enforcing compliance by third parties with this License. An "entity transaction" is a transaction transferring control of an organization, or substantially all assets of one, or subdividing an organization, or merging organizations. If propagation of a covered work results from an entity transaction, each party to that transaction who receives a copy of the work also receives whatever licenses to the work the party's predecessor in interest had or could give under the previous paragraph, plus a right to possession of the Corresponding Source of the work from the predecessor in interest, if the predecessor has it or can get it with reasonable efforts. You may not impose any further restrictions on the exercise of the rights granted or affirmed under this License. For example, you may not impose a license fee, royalty, or other charge for exercise of rights granted under this License, and you may not initiate litigation (including a cross-claim or counterclaim in a lawsuit) alleging that any patent claim is infringed by making, using, selling, offering for sale, or importing the Program or any portion of it. 11. Patents. A "contributor" is a copyright holder who authorizes use under this License of the Program or a work on which the Program is based. The work thus licensed is called the contributor's "contributor version". A contributor's "essential patent claims" are all patent claims owned or controlled by the contributor, whether already acquired or hereafter acquired, that would be infringed by some manner, permitted by this License, of making, using, or selling its contributor version, but do not include claims that would be infringed only as a consequence of further modification of the contributor version. For purposes of this definition, "control" includes the right to grant patent sublicenses in a manner consistent with the requirements of this License. Each contributor grants you a non-exclusive, worldwide, royalty-free patent license under the contributor's essential patent claims, to make, use, sell, offer for sale, import and otherwise run, modify and propagate the contents of its contributor version. In the following three paragraphs, a "patent license" is any express agreement or commitment, however denominated, not to enforce a patent (such as an express permission to practice a patent or covenant not to sue for patent infringement). To "grant" such a patent license to a party means to make such an agreement or commitment not to enforce a patent against the party. If you convey a covered work, knowingly relying on a patent license, and the Corresponding Source of the work is not available for anyone to copy, free of charge and under the terms of this License, through a publicly available network server or other readily accessible means, then you must either (1) cause the Corresponding Source to be so available, or (2) arrange to deprive yourself of the benefit of the patent license for this particular work, or (3) arrange, in a manner consistent with the requirements of this License, to extend the patent license to downstream recipients. "Knowingly relying" means you have actual knowledge that, but for the patent license, your conveying the covered work in a country, or your recipient's use of the covered work in a country, would infringe one or more identifiable patents in that country that you have reason to believe are valid. If, pursuant to or in connection with a single transaction or arrangement, you convey, or propagate by procuring conveyance of, a covered work, and grant a patent license to some of the parties receiving the covered work authorizing them to use, propagate, modify or convey a specific copy of the covered work, then the patent license you grant is automatically extended to all recipients of the covered work and works based on it. A patent license is "discriminatory" if it does not include within the scope of its coverage, prohibits the exercise of, or is conditioned on the non-exercise of one or more of the rights that are specifically granted under this License. You may not convey a covered work if you are a party to an arrangement with a third party that is in the business of distributing software, under which you make payment to the third party based on the extent of your activity of conveying the work, and under which the third party grants, to any of the parties who would receive the covered work from you, a discriminatory patent license (a) in connection with copies of the covered work conveyed by you (or copies made from those copies), or (b) primarily for and in connection with specific products or compilations that contain the covered work, unless you entered into that arrangement, or that patent license was granted, prior to 28 March 2007. Nothing in this License shall be construed as excluding or limiting any implied license or other defenses to infringement that may otherwise be available to you under applicable patent law. 12. No Surrender of Others' Freedom. If conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot convey a covered work so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not convey it at all. For example, if you agree to terms that obligate you to collect a royalty for further conveying from those to whom you convey the Program, the only way you could satisfy both those terms and this License would be to refrain entirely from conveying the Program. 13. Use with the GNU Affero General Public License. Notwithstanding any other provision of this License, you have permission to link or combine any covered work with a work licensed under version 3 of the GNU Affero General Public License into a single combined work, and to convey the resulting work. The terms of this License will continue to apply to the part which is the covered work, but the special requirements of the GNU Affero General Public License, section 13, concerning interaction through a network will apply to the combination as such. 14. Revised Versions of this License. The Free Software Foundation may publish revised and/or new versions of the GNU General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies that a certain numbered version of the GNU General Public License "or any later version" applies to it, you have the option of following the terms and conditions either of that numbered version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the GNU General Public License, you may choose any version ever published by the Free Software Foundation. If the Program specifies that a proxy can decide which future versions of the GNU General Public License can be used, that proxy's public statement of acceptance of a version permanently authorizes you to choose that version for the Program. Later license versions may give you additional or different permissions. However, no additional obligations are imposed on any author or copyright holder as a result of your choosing to follow a later version. 15. Disclaimer of Warranty. THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. Limitation of Liability. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 17. Interpretation of Sections 15 and 16. If the disclaimer of warranty and limitation of liability provided above cannot be given local legal effect according to their terms, reviewing courts shall apply local law that most closely approximates an absolute waiver of all civil liability in connection with the Program, unless a warranty or assumption of liability accompanies a copy of the Program in return for a fee. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively state the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software: you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation, either version 3 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . Also add information on how to contact you by electronic and paper mail. If the program does terminal interaction, make it output a short notice like this when it starts in an interactive mode: Copyright (C) This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, your program's commands might be different; for a GUI interface, you would use an "about box". You should also get your employer (if you work as a programmer) or school, if any, to sign a "copyright disclaimer" for the program, if necessary. For more information on this, and how to apply and follow the GNU GPL, see . The GNU General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Lesser General Public License instead of this License. But first, please read . topal-80/pine-4.58.patch0000644000175000017500000001710313434071426013110 0ustar pjbpjbdiff -cr OP/pine4.58/imap/src/c-client/mail.h NP/pine4.58/imap/src/c-client/mail.h *** OP/pine4.58/imap/src/c-client/mail.h Tue Aug 19 22:46:41 2003 --- NP/pine4.58/imap/src/c-client/mail.h Fri Sep 19 10:02:18 2003 *************** *** 678,683 **** --- 678,684 ---- } size; char *md5; /* MD5 checksum */ void *sparep; /* spare pointer reserved for main program */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ }; diff -cr OP/pine4.58/pine/pine.h NP/pine4.58/pine/pine.h *** OP/pine4.58/pine/pine.h Tue Sep 9 22:52:38 2003 --- NP/pine4.58/pine/pine.h Fri Sep 19 10:02:18 2003 *************** *** 63,69 **** #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.58" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" --- 63,69 ---- #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.58T" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" diff -cr OP/pine4.58/pine/send.c NP/pine4.58/pine/send.c *** OP/pine4.58/pine/send.c Fri Aug 29 23:03:08 2003 --- NP/pine4.58/pine/send.c Fri Sep 19 10:02:18 2003 *************** *** 5094,5099 **** --- 5094,5109 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) + /* This was a single part message which Topal mangled. */ + (*body)->type = TYPETEXT; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1) + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + (*body)->nested.part->body.type = TYPETEXT; + dprint(4, (debugfile, "=== send returning ===\n")); } *************** *** 6440,6452 **** ; rfc822_parse_content_header(nb,ucase(buf+8),s); ! if(nb->type == TYPETEXT ! && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); b->subtype = nb->subtype; nb->subtype = NULL; --- 6450,6462 ---- ; rfc822_parse_content_header(nb,ucase(buf+8),s); ! if(nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); + b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; *************** *** 6454,6459 **** --- 6464,6471 ---- b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + if (b->type != TYPETEXT) + b->topal_hack = 1; } mail_free_body(&nb); *************** *** 9032,9048 **** dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. --- 9044,9062 ---- dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (body->topal_hack != 1){ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ ! } break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. *************** *** 9212,9218 **** dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 9226,9233 ---- dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 9272,9278 **** * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT){ gf_link_filter(gf_local_nvtnl, NULL); } --- 9287,9294 ---- * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)){ gf_link_filter(gf_local_nvtnl, NULL); } *************** *** 9372,9386 **** ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); --- 9388,9414 ---- ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) ! { ! if(!(so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! else ! { ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); *************** *** 9611,9617 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 9639,9646 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); topal-80/misc.ads0000644000175000017500000001167413434071426012173 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Sequential_IO; with Ada.Text_IO; with Globals; use Globals; package Misc is -- How to handle errors and debugging. Panic : exception; User_Interrupt : exception; procedure Error (The_Error : in String); -- ErrorNE (error-no-exception) doesn't raise an exception. -- You need to do it. procedure ErrorNE (The_Error : in String); procedure Debug (Message : in String); procedure Close_Debug; -- A flag that allows Open_TTY to inhibit (any further) writing to stderr. Inhibit_Stderr : Boolean := False; -- Receiving.Split_Two_Parts and others needs to write out files without -- an end-of-line being appended (as happens with Text_IO). package Character_IO is new Ada.Sequential_IO (Element_Type => Character); procedure Character_IO_Put (F : in Character_IO.File_Type; S : in String); procedure Character_IO_Put_Line (F : in Character_IO.File_Type; S : in String); -- Strings to integers. String_Not_Integer : exception; function String_To_Integer (S : String) return Integer; function String_To_Integer (S : UBS) return Integer; -- Throw away leading blanks from a string. function Trim_Leading_Spaces (S : String) return String; -- Case insensitive comparison of two strings. function EqualCI (A, B : UBS) return Boolean; function EqualCI (A : String; B : UBS) return Boolean; function EqualCI (A : UBS; B : String) return Boolean; function EqualCI (A, B : String) return Boolean; -- Create our own temporary file names. A sequence number is also -- inserted unless Use_Sequence_Number is set to False. function Temp_File_Name (Tail : String; Use_Sequence_Number : Boolean := True) return String; -- An `unbounded' Get_Line. function Unbounded_Get_Line (File : in Ada.Text_IO.File_Type) return UBS; function Unbounded_Get_Line return UBS; -- Eat and fold an entire file. -- Set Include_LF to true to add a LF each new line. function Read_Fold (File : in String; Include_LF : in Boolean := False) return UBS; -- Open and close the result file. procedure Open_Result_File (Resultfile : in String); procedure Close_Result_File; -- Disclaimer. procedure Disclaimer; -- Wrapper for reading unbounded strings out of the config record. -- If the string is empty, then barf. Need_Nonempty_String : exception; function Value_Nonempty (V : UBS) return UBS; function Value_Nonempty (V : UBS) return String; -- Split up a string into multiple tokens, using spaces as the -- delimiter, but also honouring quoting and stuffing using `"'. function Split_Arguments (A : UBS) return UBS_Array; -- Split up a GPG colon-separated line. function Split_GPG_Colons (AS : String) return UBS_Array; -- Construct a UP. function UPC (A, B : String) return UP; function UPC (A, B : UBS) return UP; -- Get the basename of a filename. function Basename (S : String) return String; -- Basename. function Command_Basename return String; -- Hexadecimal decoder. function Hex_Decode (S : in String) return Natural; -- Have we got base64 or binary? function Guess_SMIME_Encoding(Infile : String) return String; -- Return a string for --[no-]use-agent depending on config and the -- type of operation. function UGA_Str (Signing : Boolean) return String; -- Write terminal SGR string. function Do_SGR (S : String) return String; function Do_SGR (U : UBS) return String; -- Reset terminal SGR. function Reset_SGR return String; -- Rewrite menu prompts. function Rewrite_Menu_Prompt (S : in String) return String; -- We turn SIGINT into an exception so that we can clean up -- temporary files. -- Handle interrupts, SIGINT, etc. pragma Unreserve_All_Interrupts; -- because we want to be able to handle ctrl-C. protected Signal_Handlers is procedure Sigint_Handler; function Sigint_Pending return Boolean; pragma Interrupt_Handler(Sigint_Handler); private Sigint_Pending_Flag : Boolean := False; end Signal_Handlers; -- And a procedure for taking over sigint. procedure Set_Sigint_Handler; end Misc; topal-80/alpine-2.00.patch-10000644000175000017500000004054113434071426013546 0ustar pjbpjbdiff -cr alpine-2.00.orig/alpine/send.c alpine-2.00.new/alpine/send.c *** alpine-2.00.orig/alpine/send.c 2008-06-30 23:03:35.000000000 +0100 --- alpine-2.00.new/alpine/send.c 2009-05-01 13:40:37.000000000 +0100 *************** *** 4039,4044 **** --- 4039,4061 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + /* Topal: Unmangle the body types. */ + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) { + /* This was a single part message which Topal mangled. */ + dprint((9, "Topal: unmangling single part message\n")); + (*body)->type = TYPETEXT; + } + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1 + && (*body)->nested.part->body.type == TYPEMULTIPART + && (*body)->nested.part->body.topal_hack == 1) { + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + dprint((9, "Topal: unmangling first part of multipart message\n")); + (*body)->nested.part->body.type = TYPETEXT; + } + dprint((4, "=== send returning ===\n")); } *************** *** 5365,5386 **** rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); if(nb->type == TYPETEXT && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ ! if(b->subtype) ! fs_give((void **) &b->subtype); ! b->subtype = nb->subtype; nb->subtype = NULL; ! mail_free_body_parameter(&b->parameter); b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); } ! mail_free_body(&nb); } --- 5382,5431 ---- rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); + /* Topal: We're working on the first + text segment of the message. If + the filter returns something that + isn't TYPETEXT, then we need to + pretend (later on) that this is in + fact a TYPETEXT, because Topal has + already encoded it.... + + Original code path first, then an + alternate path. + */ if(nb->type == TYPETEXT && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ ! if(b->subtype) ! fs_give((void **) &b->subtype); ! ! b->subtype = nb->subtype; ! nb->subtype = NULL; ! ! mail_free_body_parameter(&b->parameter); ! b->parameter = nb->parameter; ! nb->parameter = NULL; ! mail_free_body_parameter(&nb->parameter); ! } ! else if(F_ON(F_ENABLE_TOPAL_HACK, ps_global)){ ! /* Perhaps the type isn't TYPETEXT, ! and the hack is requested. So, ! let's mess with the types. */ ! if(nb->type != TYPETEXT){ ! b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; ! ! dprint((9, "Topal: mangling body!\n")); mail_free_body_parameter(&b->parameter); b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + b->topal_hack = 1; + } } ! /* Topal: end */ mail_free_body(&nb); } diff -cr alpine-2.00.orig/imap/src/c-client/mail.h alpine-2.00.new/imap/src/c-client/mail.h *** alpine-2.00.orig/imap/src/c-client/mail.h 2008-08-08 18:34:22.000000000 +0100 --- alpine-2.00.new/imap/src/c-client/mail.h 2009-05-01 13:40:37.000000000 +0100 *************** *** 775,780 **** --- 775,781 ---- unsigned long bytes; /* size of text in octets */ } size; char *md5; /* MD5 checksum */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ void *sparep; /* spare pointer reserved for main program */ }; diff -cr alpine-2.00.orig/pith/conf.c alpine-2.00.new/pith/conf.c *** alpine-2.00.orig/pith/conf.c 2008-08-23 01:07:05.000000000 +0100 --- alpine-2.00.new/pith/conf.c 2009-05-01 13:40:37.000000000 +0100 *************** *** 2794,2799 **** --- 2794,2801 ---- F_SEND_WO_CONFIRM, h_config_send_wo_confirm, PREF_SEND, 0}, {"strip-whitespace-before-send", "Strip Whitespace Before Sending", F_STRIP_WS_BEFORE_SEND, h_config_strip_ws_before_send, PREF_SEND, 0}, + {"enable-topal-hack", "Enable Topal hack for OpenPGP/MIME messages", + F_ENABLE_TOPAL_HACK, h_config_enable_topal_hack, PREF_HIDDEN, 0}, {"warn-if-blank-fcc", "Warn if Blank Fcc", F_WARN_ABOUT_NO_FCC, h_config_warn_if_fcc_blank, PREF_SEND, 0}, {"warn-if-blank-subject", "Warn if Blank Subject", diff -cr alpine-2.00.orig/pith/conftype.h alpine-2.00.new/pith/conftype.h *** alpine-2.00.orig/pith/conftype.h 2008-08-20 01:27:11.000000000 +0100 --- alpine-2.00.new/pith/conftype.h 2009-05-01 13:40:37.000000000 +0100 *************** *** 503,508 **** --- 503,509 ---- F_MARK_FCC_SEEN, F_MULNEWSRC_HOSTNAMES_AS_TYPED, F_STRIP_WS_BEFORE_SEND, + F_ENABLE_TOPAL_HACK, F_QUELL_FLOWED_TEXT, F_COMPOSE_ALWAYS_DOWNGRADE, F_SORT_DEFAULT_FCC_ALPHA, diff -cr alpine-2.00.orig/pith/pine.hlp alpine-2.00.new/pith/pine.hlp *** alpine-2.00.orig/pith/pine.hlp 2008-08-23 01:07:05.000000000 +0100 --- alpine-2.00.new/pith/pine.hlp 2009-05-01 13:40:37.000000000 +0100 *************** *** 3205,3211 ****

  • FEATURE:
  • FEATURE:
  • FEATURE: !
  • FEATURE:
  • FEATURE:
  • FEATURE:
  • FEATURE: --- 3205,3212 ----
  • FEATURE:
  • FEATURE:
  • FEATURE: !
  • FEATURE: !
  • FEATURE:
  • FEATURE:
  • FEATURE:
  • FEATURE: *************** *** 28297,28302 **** --- 28298,28318 ---- <End of help on this topic> + ====== h_config_enable_topal_hack ===== + + + FEATURE: <!--#echo var="FEAT_enable-topal-hack"--> + + +

    FEATURE:

    +

    + This feature allows Topal (and other sending-filters) to change the + MIME type of the email. This is potentially dangerous because it + pretends that multipart emails are plain emails. +

    + <End of help on this topic> + + ====== h_config_del_from_dot ===== diff -cr alpine-2.00.orig/pith/send.c alpine-2.00.new/pith/send.c *** alpine-2.00.orig/pith/send.c 2008-08-06 19:25:58.000000000 +0100 --- alpine-2.00.new/pith/send.c 2009-05-01 13:40:37.000000000 +0100 *************** *** 107,113 **** int l_flush_net(int); int l_putc(int); int pine_write_header_line(char *, char *, STORE_S *); ! int pine_write_params(PARAMETER *, STORE_S *); char *tidy_smtp_mess(char *, char *, char *, size_t); int lmc_body_header_line(char *, int); int lmc_body_header_finish(void); --- 107,113 ---- int l_flush_net(int); int l_putc(int); int pine_write_header_line(char *, char *, STORE_S *); ! int pine_write_params(PARAMETER *, STORE_S *, BODY *); char *tidy_smtp_mess(char *, char *, char *, size_t); int lmc_body_header_line(char *, int); int lmc_body_header_finish(void); *************** *** 1783,1789 **** --- 1783,1791 ---- /* set up counts and such to keep track sent percentage */ send_bytes_sent = 0; gf_filter_init(); /* zero piped byte count, 'n */ + dprint((1, "Topal: HERE 1!\n")); send_bytes_to_send = send_body_size(body); /* count body bytes */ + dprint((1, "Topal: HERE 2!\n")); ps_global->c_client_error[0] = error_buf[0] = '\0'; we_cancel = busy_cue(_("Sending mail"), send_bytes_to_send ? sent_percent : NULL, 0); *************** *** 1800,1805 **** --- 1802,1810 ---- #endif + dprint((1, "Topal: HERE 3!\n")); + + /* * If the user's asked for it, and we find that the first text * part (attachments all get b64'd) is non-7bit, ask for 8BITMIME. *************** *** 1807,1812 **** --- 1812,1818 ---- if(F_ON(F_ENABLE_8BIT, ps_global) && (bp = first_text_8bit(body))) smtp_opts |= SOP_8BITMIME; + dprint((1, "Topal: HERE 3.1!\n")); #ifdef DEBUG #ifndef DEBUGJOURNAL if(debug > 5 || (flags & CM_VERBOSE)) *************** *** 1870,1886 **** --- 1876,1896 ---- } } + dprint((1, "Topal: HERE 4!\n")); + /* * Install our rfc822 output routine */ sending_hooks.rfc822_out = mail_parameters(NULL, GET_RFC822OUTPUT, NULL); (void)mail_parameters(NULL, SET_RFC822OUTPUT, (void *)post_rfc822_output); + dprint((1, "Topal: HERE 5!\n")); /* * Allow for verbose posting */ (void) mail_parameters(NULL, SET_SMTPVERBOSE, (void *) pine_smtp_verbose_out); + dprint((1, "Topal: HERE 6!\n")); /* * We do this because we want mm_log to put the error message into *************** *** 1924,1929 **** --- 1934,1940 ---- ps_global->noshow_error = 0; + dprint((1, "Topal: HERE 7!\n")); TIME_STAMP("smtp open", 1); if(sending_stream){ unsigned short save_encoding, added_encoding; *************** *** 2504,2512 **** BODY * first_text_8bit(struct mail_bodystruct *body) { ! if(body->type == TYPEMULTIPART) /* advance to first contained part */ body = &body->nested.part->body; return((body->type == TYPETEXT && body->encoding != ENC7BIT) ? body : NULL); } --- 2515,2526 ---- BODY * first_text_8bit(struct mail_bodystruct *body) { ! /* Be careful of Topal changes... */ ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) /* advance to first contained part */ body = &body->nested.part->body; + /* Topal: this bit might not be correct, now. */ return((body->type == TYPETEXT && body->encoding != ENC7BIT) ? body : NULL); } *************** *** 2879,2884 **** --- 2893,2899 ---- char *freethis; case TYPEMULTIPART: /* multi-part */ + if (body->topal_hack != 1) { /* But only if Topal hasn't touched it! */ if(!(freethis=parameter_val(body->parameter, "BOUNDARY"))){ char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ *************** *** 2894,2899 **** --- 2909,2915 ---- part = body->nested.part; /* encode body parts */ do pine_encode_body (&part->body); while ((part = part->next) != NULL); /* until done */ + } break; case TYPETEXT : *************** *** 4252,4258 **** dprint((4, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 4268,4276 ---- dprint((4, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling, ! unless Topal messed with it */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 4342,4351 **** * BEFORE applying any encoding (rfc1341: appendix G)... * NOTE: almost all filters expect CRLF newlines */ ! if(body->type == TYPETEXT ! && body->encoding != ENCBASE64 && !so_attr((STORE_S *) body->contents.text.data, "rawbody", NULL)){ ! gf_link_filter(gf_local_nvtnl, NULL); } switch (body->encoding) { /* all else needs filtering */ --- 4360,4373 ---- * BEFORE applying any encoding (rfc1341: appendix G)... * NOTE: almost all filters expect CRLF newlines */ ! if(((body->type == TYPETEXT ! && body->encoding != ENCBASE64) ! /* Or if Topal mucked with it... */ ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)) && !so_attr((STORE_S *) body->contents.text.data, "rawbody", NULL)){ ! if(body->topal_hack == 1) ! dprint((9, "Topal: Canonical conversion, although Topal has mangled...\n")); ! gf_link_filter(gf_local_nvtnl, NULL); } switch (body->encoding) { /* all else needs filtering */ *************** *** 4447,4453 **** return(pwbh_finish(0, so)); if(body->parameter){ ! if(!pine_write_params(body->parameter, so)) return(pwbh_finish(0, so)); } else if(!so_puts(so, "; CHARSET=US-ASCII")) --- 4469,4475 ---- return(pwbh_finish(0, so)); if(body->parameter){ ! if(!pine_write_params(body->parameter, so, body)) return(pwbh_finish(0, so)); } else if(!so_puts(so, "; CHARSET=US-ASCII")) *************** *** 4526,4532 **** && so_puts(so, body->disposition.type))) return(pwbh_finish(0, so)); ! if(!pine_write_params(body->disposition.parameter, so)) return(pwbh_finish(0, so)); if(!so_puts(so, "\015\012")) --- 4548,4554 ---- && so_puts(so, body->disposition.type))) return(pwbh_finish(0, so)); ! if(!pine_write_params(body->disposition.parameter, so, body)) return(pwbh_finish(0, so)); if(!so_puts(so, "\015\012")) *************** *** 4588,4594 **** * pine_write_param - convert, encode and write MIME header-field parameters */ int ! pine_write_params(PARAMETER *param, STORE_S *so) { for(; param; param = param->next){ int rv; --- 4610,4616 ---- * pine_write_param - convert, encode and write MIME header-field parameters */ int ! pine_write_params(PARAMETER *param, STORE_S *so, BODY *body) { for(; param; param = param->next){ int rv; *************** *** 4597,4605 **** cs = posting_characterset(param->value, NULL, HdrText); cv = utf8_to_charset(param->value, cs, 0); ! rv = (so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! if(cv && cv != param->value) fs_give((void **) &cv); --- 4619,4635 ---- cs = posting_characterset(param->value, NULL, HdrText); cv = utf8_to_charset(param->value, cs, 0); ! if (body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) { ! /* Did Topal introduce more parameters? */ ! dprint((9, "Topal: parameter encoding of protocol, with Topal hack\n")); ! rv = (so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! } ! else ! rv = (so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! if(cv && cv != param->value) fs_give((void **) &cv); *************** *** 4706,4712 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 4736,4744 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling ! but again, be careful of Topal */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); topal-80/configuration.adb0000644000175000017500000010600713434071426014061 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.IO_Exceptions; with Ada.Strings.Fixed; with Ada.Text_IO; with Externals.Simple; with Keys; with Menus; use Menus; with Misc; with Readline; package body Configuration is Binary_Name : constant array(Binaries) of UBS := (Chmod => ToUBS("chmod"), Clear => ToUBS("clear"), Cut => ToUBS("cut"), Date => ToUBS("date"), Diff => ToUBS("diff"), File => ToUBS("file"), Formail => ToUBS("formail"), GPGOP => ToUBS("gpg"), GPGSM => ToUBS("gpgsm"), Grep => ToUBS("grep"), Iconv => ToUBS("iconv"), Less => ToUBS("less"), Locale => ToUBS("locale"), Md5sum => ToUBS("md5sum"), Metamail => ToUBS("metamail"), Mimeconstruct => ToUBS("mimeconstruct"), Mimetool => ToUBS("mimetool"), Mkdir => ToUBS("mkdir"), Mkfifo => ToUBS("mkfifo"), Mv => ToUBS("mv"), Openssl => ToUBS("openssl"), Rm => ToUBS("rm"), Runmailcap => ToUBS("runmailcap"), Scp => ToUBS("scp"), Sed => ToUBS("sed"), Ssh => ToUBS("ssh"), Stty => ToUBS("stty"), Tee => ToUBS("tee"), Test => ToUBS("test")); UBS_Opts_Names : constant array (UBS_Opts_Keys) of UBS := (My_Key => ToUBS("my-key"), GPG_Options=> ToUBS("gpg-options"), GPGSM_Options=> ToUBS("gpgsm-options"), General_Options => ToUBS("general-options"), Receiving_Options=> ToUBS("receiving-options"), Sending_Options => ToUBS("sending-options"), Colour_Menu_Title => ToUBS("colour-menu-title"), Colour_Menu_Key => ToUBS("colour-menu-key"), Colour_Menu_Choice => ToUBS("colour-menu-choice"), Colour_Important => ToUBS("colour-important"), Colour_Banner => ToUBS("colour-banner"), Colour_Info => ToUBS("colour-info"), Decrypt_Prereq => ToUBS("decrypt-prereq")); Positive_Opts_Names : constant array (Positive_Opts_Keys) of UBS := (Decrypt_Not_Cached => ToUBS("decrypt-not-cached"), Decrypt_Not_Cached_Use_Cache => ToUBS("decrypt-not-cached-use-cache"), Decrypt_Cached => ToUBS("decrypt-cached"), Decrypt_Cached_Use_Cache => ToUBS("decrypt-cached-use-cache"), Verify_Not_Cached => ToUBS("verify-not-cached"), Verify_Not_Cached_Use_Cache => ToUBS("verify-not-cached-use-cache"), Verify_Cached => ToUBS("verify-cached"), Verify_Cached_Use_Cache => ToUBS("verify-cached-use-cache"), Mime_Viewer_Decrypt => ToUBS("mime-viewer-decrypt"), Mime_Viewer_Verify => ToUBS("mime-viewer-verify"), Use_Agent => ToUBS("use-agent"), Replace_IDs => ToUBS("replace-ids"), Include_Send_Token => ToUBS("include-send-token")); Boolean_Opts_Names : constant array (Boolean_Opts_Keys) of UBS := (Decrypt_Cached_Fast_Continue => ToUBS("decrypt-cached-fast-continue"), Verify_Cached_Fast_Continue => ToUBS("verify-cached-fast-continue"), Verify_Not_Cached_Fast_Continue => ToUBS("verify-not-cached-fast-continue"), FE_Simple => ToUBS("fe-simple"), Inline_Separate_Output => ToUBS("inline-separate-output"), Omit_Inline_Disposition_Name => ToUBS("omit-inline-disposition-name"), Omit_Inline_Disposition_Header => ToUBS("omit-inline-disposition-header"), Save_On_Send => ToUBS("save-on-send"), ANSI_Terminal => ToUBS("ansi-terminal"), Wait_If_Missing_Keys => ToUBS("wait-if-missing-keys"), Attachment_Trap => ToUBS("attachment-trap"), Fix_Fcc => ToUBS("fix-fcc"), Fix_Bcc => ToUBS("fix-bcc"), Debug => ToUBS("debug"), -- The following ones don't really matter, since they won't be used. No_Clean => ToUBS("no-clean"), All_Headers => ToUBS("all-headers"), Read_From => ToUBS("read-from"), Ask_Charset => ToUBS("ask-charset")); procedure Parse_AKE (KE : in UBS; Key : out UBS; Email : out UBS) is KES : constant String := ToStr(KE); Sep : Natural; begin Sep := Ada.Strings.Fixed.Index(Source => KES, Pattern => ","); Key := ToUBS(KES(KES'First..Sep-1)); Email := ToUBS(KES(Sep+1..KES'Last)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Configuration.Parse_AKE"); raise; end Parse_AKE; procedure Parse_Config_Line (Line : in String; Name : out UBS; Value : out UBS) is Sep : Natural; begin Sep := Ada.Strings.Fixed.Index(Source => Line, Pattern => "="); Name := ToUBS(Line(Line'First..Sep-1)); Value := ToUBS(Line(Sep+1..Line'Last)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Configuration.Parse_Config_Line"); raise; end Parse_Config_Line; function Set_Two_Way (S : String) return Boolean is begin if S = "on" then return True; elsif S = "off" then return False; else raise Switch_Parse_Error; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Configuration.Set_Two_Way"); raise; end Set_Two_Way; function Match_Binary_Path (N : String) return Boolean is begin for I in Binaries loop if ToStr(Binary_Name(I)) & "-binary" = N then return True; end if; end loop; return False; end Match_Binary_Path; No_Binary_Match : exception; function Get_Binary_Path (N : String) return Binaries is begin for I in Binaries loop if ToStr(Binary_Name(I)) & "-binary" = N then return I; end if; end loop; raise No_Binary_Match; end Get_Binary_Path; function Match_UBS_Opts_Key (N : String) return Boolean is begin for I in UBS_Opts_Keys loop if ToStr(UBS_Opts_Names(I)) = N then return True; end if; end loop; return False; end Match_UBS_Opts_Key; No_UBS_Match : exception; function Get_UBS_Opts_Key (N : String) return UBS_Opts_Keys is begin for I in UBS_Opts_Keys loop if ToStr(UBS_Opts_Names(I)) = N then return I; end if; end loop; raise No_UBS_Match; end Get_UBS_Opts_Key; function Match_Positive_Opts_Key (N : String) return Boolean is begin for I in Positive_Opts_Keys loop if ToStr(Positive_Opts_Names(I)) = N then return True; end if; end loop; return False; end Match_Positive_Opts_Key; No_Positive_Match : exception; function Get_Positive_Opts_Key (N : String) return Positive_Opts_Keys is begin for I in Positive_Opts_Keys loop if ToStr(Positive_Opts_Names(I)) = N then return I; end if; end loop; raise No_Positive_Match; end Get_Positive_Opts_Key; function Match_Boolean_Opts_Key (N : String) return Boolean is begin for I in Boolean_Opts_Keys_Save loop if ToStr(Boolean_Opts_Names(I)) = N then return True; end if; end loop; return False; end Match_Boolean_Opts_Key; No_Boolean_Match : exception; function Get_Boolean_Opts_Key (N : String) return Boolean_Opts_Keys is begin for I in Boolean_Opts_Keys_Save loop if ToStr(Boolean_Opts_Names(I)) = N then return I; end if; end loop; raise No_Boolean_Match; end Get_Boolean_Opts_Key; procedure Read_Config_File (Warnings : out Boolean) Is use Ada.Text_IO; use Misc; CF : File_Type; begin Warnings := False; Open(File => CF, Mode => In_File, Name => ToStr(Topal_Directory) & "/config"); Config_Loop: loop begin declare The_Line : constant String := ToStr(Misc.Unbounded_Get_Line(CF)); Name : UBS; Value : UBS; K, E : UBS; begin if The_Line'Length > 0 and then The_Line(The_Line'First) = '#' then -- It's a comment. Ignore it. null; else Parse_Config_Line(The_Line, Name, Value); declare N : constant String := ToStr(Name); V : UBS renames Value; begin if Match_Binary_Path(N) then Config.Binary(Get_Binary_Path(N)) := V; elsif Match_UBS_Opts_Key(N) then Config.UBS_Opts(Get_UBS_Opts_Key(N)) := V; elsif Match_Positive_Opts_Key(N) then Config.Positive_Opts(Get_Positive_Opts_Key(N)) := String_To_Integer(V); elsif Match_Boolean_Opts_Key(N) then Config.Boolean_Opts(Get_Boolean_Opts_Key(N)) := Set_Two_Way(ToStr(V)); elsif N = "ake" then Parse_AKE(V, K, E); Config.AKE.Append(UPC(K, E)); elsif N = "xk" then -- This is a key to be excluded. Config.XK.Append(V); elsif N = "sake" then Parse_AKE(V, K, E); Config.SAKE.Append(UP'(K, E)); elsif N = "sxk" then Config.SXK.Append(V); elsif N = "sd" then Parse_AKE(V, K, E); Config.SD.Append(UP'(K, E)); elsif N = "sc" then Parse_AKE(V, K, E); Config.SC.Append(UP'(K, E)); elsif N = "st" then Parse_AKE(V, K, E); Config.ST.Append(UP'(K, E)); else Put_Line(Ada.Text_IO.Standard_Error, "WARNING: Bogus line in configuration file: " & The_Line); Warnings := True; end if; end; end if; end; exception when Ada.IO_Exceptions.End_Error => exit Config_Loop; end; end loop Config_Loop; Close(CF); exception when Ada.IO_Exceptions.Name_Error => -- Silently ignore the lack of a config file. Close(CF); when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Configuration.Read_Config_File"); raise; end Read_Config_File; -- Given the current value (V) and default config (D), Put_Line if -- different or make it a comment if the same. procedure Dump_Bin (K : in String; V : in UBS; D : in UBS) is use type UBS; begin if V = D then Ada.Text_IO.Put("#"); end if; Ada.Text_IO.Put_Line(K & "-binary=" & ToStr(V)); end Dump_Bin; procedure Dump (Overwrite_Config : in Boolean := False) is use Ada.Text_IO; use Misc; F : File_Type; Default_Config : Config_Record; begin if Overwrite_Config then if Externals.Simple.Test_F(ToStr(Topal_Directory) & "/config") then Externals.Simple.Mv_F(ToStr(Topal_Directory) & "/config", ToStr(Topal_Directory) & "/config.bak"); end if; Create(File => F, Mode => Out_File, Name => ToStr(Topal_Directory) & "/config"); Set_Output(F); end if; Default_Configuration(Default_Config); for I in Binaries loop Dump_Bin(ToStr(Binary_Name(I)), Config.Binary(I), Default_Config.Binary(I)); end loop; for I in UBS_Opts_Keys loop Put_Line(ToStr(UBS_Opts_Names(I)) & "=" & ToStr(Config.UBS_Opts(I))); end loop; for I in Positive_Opts_Keys loop Put_Line(ToStr(Positive_Opts_Names(I)) & "=" & Trim_Leading_Spaces(Integer'Image(Config.Positive_Opts(I)))); end loop; for I in Boolean_Opts_Keys_Save loop Put_Line(ToStr(Boolean_Opts_Names(I)) & "=" & ToStr(Two_Way(Config.Boolean_Opts(I)))); end loop; for I in 1 .. Integer(Config.AKE.Length) loop Put_Line("ake=" & ToStr(Config.AKE.Element(I).Key) & "," & ToStr(Config.AKE.Element(I).Value)); end loop; for I in 1 .. Integer(Config.XK.Length) loop Put_Line("xk=" & ToStr(Config.XK.Element(I))); end loop; for I in 1 .. Integer(Config.SAKE.Length) loop Put_Line("sake=" & ToStr(Config.SAKE.Element(I).Key) & "," & ToStr(Config.SAKE.Element(I).Value)); end loop; for I in 1 .. Integer(Config.SXK.Length) loop Put_Line("sxk=" & ToStr(Config.SXK.Element(I))); end loop; for I in 1 .. Integer(Config.SD.Length) loop Put_Line("sd=" & ToStr(Config.SD.Element(I).Key) & "," & ToStr(Config.SD.Element(I).Value)); end loop; for I in 1 .. Integer(Config.SC.Length) loop Put_Line("sc=" & ToStr(Config.SC.Element(I).Key) & "," & ToStr(Config.SC.Element(I).Value)); end loop; for I in 1 .. Integer(Config.ST.Length) loop Put_Line("st=" & ToStr(Config.ST.Element(I).Key) & "," & ToStr(Config.ST.Element(I).Value)); end loop; if Overwrite_Config then Set_Output(Standard_Output); Close(F); end if; exception when others => Set_Output(Standard_Output); Put_Line("Problem in Configuration.Dump, probably file related"); Close(F); raise; end Dump; procedure Edit_Own_Key(SMIME : in Boolean) is use Ada.Text_IO; begin New_Line(2); Put_Line("Signing key is currently: " & ToStr(Config.UBS_Opts(My_Key))); Put_Line("Do you want to replace this key?"); Put_Line("Answer Yes to replace it; No to keep the current key."); if YN_Menu = Yes then -- Now, find all secret keys and offer them as a `select 1' list. declare SKL : Keys.Key_List; Pattern : UBS; New_Secret_Key : UBS; Use_Old_Key : Boolean; begin Keys.Empty_Keylist(SKL, SMIME); Pattern := ToUBS(Readline.Get_String("Type GPG search pattern: ")); Keys.Add_Secret_Keys(Pattern, SKL, Keys.Any); if Keys.Count(SKL) = 0 then Put_Line("No matching secret keys found!"); else Keys.Select_Key_From_List(SKL, New_Secret_Key, Use_Old_Key); if not Use_Old_Key then Config.UBS_Opts(My_Key) := New_Secret_Key; end if; end if; end; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Configuration.Edit_Own_Key"); raise; end Edit_Own_Key; procedure Edit_Configuration is use Ada.Text_IO; use Misc; Default_Config : Config_Record; Three_Str : constant array (Integer range 1..3) of UBS := (1 => ToUBS("Always"), 2 => ToUBS("Ask"), 3 => ToUBS("Never")); Five_Str : constant array (Integer range 1..5) of UBS := (1 => ToUBS("Use"), 2 => ToUBS("Replace"), 3 => ToUBS("Ask-replace"), 4 => ToUBS("Ignore cache"), 5 => ToUBS("Offer all")); MV_Str : constant array (Integer range 1..5) of UBS := (1 => ToUBS("Ask"), 2 => ToUBS("Metamail"), 3 => ToUBS("Run-Mailcap"), 4 => ToUBS("Save"), 5 => ToUBS("Skip")); UGA_Str: constant array (Integer range 1..3) of UBS := (1 => ToUBS("Never"), 2 => ToUBS("Decrypt only"), 3 => ToUBS("Always")); Three_Values : constant array (Three_Way_Index) of Integer := (Always => 1, Ask => 2, Never => 3); Five_Values : constant array (Five_Way_Index) of Integer := (UUse => 1, Replace => 2, AskReplace => 3, IgnoreCache => 4, OfferAll => 5); Selection : Edit_Index; Selection2O : Options_Index; Selection2S : Settings_Index; begin Default_Configuration(Default_Config); Edit_Loop: loop Ada.Text_IO.New_Line(5); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Menu_Title)) & "** Configuration menu:" & Reset_SGR); Put_Line("Configuration: Debugging currently " & ToStr(Two_Way(Config.Boolean_Opts(Debug)))); Put_Line(" Inline separate output currently " & ToStr(Two_Way(Config.Boolean_Opts(Inline_Separate_Output)))); Put_Line(" Omit inline disposition name currently " & ToStr(Two_Way(Config.Boolean_Opts(Omit_Inline_Disposition_Name)))); Put_Line(" Omit inline disposition header currently " & ToStr(Two_Way(Config.Boolean_Opts(Omit_Inline_Disposition_Header)))); Put_Line(" Save on send currently " & ToStr(Two_Way(Config.Boolean_Opts(Save_On_Send)))); Put_Line(" Wait if missing keys currently " & ToStr(Two_Way(Config.Boolean_Opts(Wait_If_Missing_Keys)))); Put_Line(" MIME viewer for decrypting is " & ToStr(MV_Str(Config.Positive_Opts(MIME_Viewer_Decrypt)))); Put_Line(" MIME viewer for verifying is " & ToStr(MV_Str(Config.Positive_Opts(MIME_Viewer_Verify)))); Put_Line(" Use GPG agent is " & ToStr(UGA_Str(Config.Positive_Opts(Use_Agent)))); Put_Line("Configuration is not saved beyond this session unless explicitly saved"); Selection := Edit_Menu; case Selection is when Quit => -- Quit editing. New_Line(3); exit Edit_Loop; when Save => -- Save changes. Dump(Overwrite_Config => True); Put_Line("Configuration saved"); New_Line(3); when Binary_Paths => -- Binary paths. New_Line(3); Put_Line("Currently not implemented. Use topal -dump, then edit the configuration file."); New_Line(3); when GPG_Options => -- GPG options. Options_Loop: loop Put_Line("Options submenu (all relevant options are concatenated together):"); Put_Line(" GPG options (all GPG operations): " & NL & " " & ToStr(Config.UBS_Opts(GPG_Options))); Put_Line(" General options (send & receive): " & NL & " " & ToStr(Config.UBS_Opts(General_Options))); Put_Line(" Receiving options (receive only): " & NL & " " & ToStr(Config.UBS_Opts(Receiving_Options))); Put_Line(" Sending options (send only): " & NL & " " & ToStr(Config.UBS_Opts(Sending_Options))); Selection2O := Options_Menu; case Selection2O is when Quit => New_Line(3); exit Options_Loop; when Change_General => Readline.Add_History(ToStr(Config.UBS_Opts(General_Options))); Config.UBS_Opts(General_Options) := ToUBS(Readline.Get_String("General options: ")); when Change_GPG => Readline.Add_History(ToStr(Config.UBS_Opts(GPG_Options))); Config.UBS_Opts(GPG_Options) := ToUBS(Readline.Get_String("GPG options: ")); when Change_Receiving => Readline.Add_History(ToStr(Config.UBS_Opts(Receiving_Options))); Config.UBS_Opts(Receiving_Options) := ToUBS(Readline.Get_String("Receiving options: ")); when Change_Sending => Readline.Add_History(ToStr(Config.UBS_Opts(Sending_Options))); Config.UBS_Opts(Sending_Options) := ToUBS(Readline.Get_String("Sending options: ")); when Default_General => Config.UBS_Opts(General_Options) := Default_Config.UBS_Opts(General_Options); when Default_GPG => Config.UBS_Opts(GPG_Options) := Default_Config.UBS_Opts(GPG_Options); when Default_Receiving => Config.UBS_Opts(Receiving_Options) := Default_Config.UBS_Opts(Receiving_Options); when Default_Sending => Config.UBS_Opts(Sending_Options) := Default_Config.UBS_Opts(Sending_Options); when Default_All => Config.UBS_Opts(General_Options) := Default_Config.UBS_Opts(General_Options); Config.UBS_Opts(GPG_Options) := Default_Config.UBS_Opts(GPG_Options); Config.UBS_Opts(Receiving_Options) := Default_Config.UBS_Opts(Receiving_Options); Config.UBS_Opts(Sending_Options) := Default_Config.UBS_Opts(Sending_Options); end case; end loop Options_Loop; when DV_Settings => -- Decrypt/verify settings. Settings_Loop: loop Put_Line("Decrypt/Verify settings submenu:"); Put_Line(" Decrypt/cached: " & ToStr(Three_Str(Config.Positive_Opts(Decrypt_Cached)))); Put_Line(" Decrypt/cached, cache usage: " & ToStr(Five_Str(Config.Positive_Opts(Decrypt_Cached_Use_Cache)))); Put_Line(" Decrypt/not cached: " & ToStr(Three_Str(Config.Positive_Opts(Decrypt_Not_Cached)))); Put_Line(" Decrypt/not cached, cache usage: " & ToStr(Three_Str(Config.Positive_Opts(Decrypt_Not_Cached_Use_Cache)))); Put_Line(" Verify/cached: " & ToStr(Three_Str(Config.Positive_Opts(Verify_Cached)))); Put_Line(" Verify/cached, cache usage: " & ToStr(Five_Str(Config.Positive_Opts(Verify_Cached_Use_Cache)))); Put_Line(" Verify/not cached: " & ToStr(Three_Str(Config.Positive_Opts(Verify_Not_Cached)))); Put_Line(" Verify/not cached, cache usage: " & ToStr(Three_Str(Config.Positive_Opts(Verify_Not_Cached_Use_Cache)))); Put_Line(" Decrypt/cached fast continue: " & ToStr(Two_Way(Config.Boolean_Opts(Decrypt_Cached_Fast_Continue)))); Put_Line(" Verify/cached fast continue: " & ToStr(Two_Way(Config.Boolean_Opts(Verify_Cached_Fast_Continue)))); Put_Line(" Verify/not cached fast continue: " & ToStr(Two_Way(Config.Boolean_Opts(Verify_Not_Cached_Fast_Continue)))); Selection2S := Settings_Menu; case Selection2S is when Decrypt_Cached => Config.Positive_Opts(Decrypt_Cached) := Three_Values(Three_Way_Menu); when Decrypt_Cached_Use => Config.Positive_Opts(Decrypt_Cached_Use_Cache) := Five_Values(Five_Way_Menu); when Decrypt_Not_Cached => Config.Positive_Opts(Decrypt_Not_Cached) := Three_Values(Three_Way_Menu); when Decrypt_Not_Cached_Use => Config.Positive_Opts(Decrypt_Not_Cached_Use_Cache) := Three_Values(Three_Way_Menu); when Verify_Cached => Config.Positive_Opts(Verify_Cached) := Three_Values(Three_Way_Menu); when Verify_Cached_Use => Config.Positive_Opts(Verify_Cached_Use_Cache) := Five_Values(Five_Way_Menu); when Verify_Not_Cached => Config.Positive_Opts(Verify_Not_Cached) := Three_Values(Three_Way_Menu); when Verify_Not_Cached_Use => Config.Positive_Opts(Verify_Not_Cached_Use_Cache) := Three_Values(Three_Way_Menu); when Quit => New_Line(3); exit Settings_Loop; when All_Defaults => Config.Positive_Opts(Decrypt_Cached) := Default_Config.Positive_Opts(Decrypt_Cached); Config.Positive_Opts(Decrypt_Cached_Use_Cache) := Default_Config.Positive_Opts(Decrypt_Cached_Use_Cache); Config.Positive_Opts(Decrypt_Not_Cached) := Default_Config.Positive_Opts(Decrypt_Not_Cached); Config.Positive_Opts(Decrypt_Not_Cached_Use_Cache) := Default_Config.Positive_Opts(Decrypt_Not_Cached_Use_Cache); Config.Positive_Opts(Verify_Cached) := Default_Config.Positive_Opts(Verify_Cached); Config.Positive_Opts(Verify_Cached_Use_Cache) := Default_Config.Positive_Opts(Verify_Cached_Use_Cache); Config.Positive_Opts(Verify_Not_Cached) := Default_Config.Positive_Opts(Verify_Not_Cached); Config.Positive_Opts(Verify_Not_Cached_Use_Cache) := Default_Config.Positive_Opts(Verify_Not_Cached_Use_Cache); when Toggle_Decrypt_Cached_Fast => Config.Boolean_Opts(Decrypt_Cached_Fast_Continue) := not Config.Boolean_Opts(Decrypt_Cached_Fast_Continue); when Toggle_Verify_Cached_Fast => Config.Boolean_Opts(Verify_Cached_Fast_Continue) := not Config.Boolean_Opts(Verify_Cached_Fast_Continue); when Toggle_Verify_Not_Cached_Fast => Config.Boolean_Opts(Verify_Not_Cached_Fast_Continue) := not Config.Boolean_Opts(Verify_Not_Cached_Fast_Continue); end case; end loop Settings_Loop; when Own_Key => -- Own key. Edit_Own_Key(False); -- Only handles OpenPGP key here. when Key_Assoc => -- Key associations. New_Line(3); Put_Line("Currently not implemented. Use topal -dump, then edit the configuration file."); New_Line(3); when Key_Excl => -- Key exclusions. New_Line(3); Put_Line("Currently not implemented. Use topal -dump, then edit the configuration file."); New_Line(3); when Set_Defaults => -- Set all defaults. Copy_Configuration(Config, Default_Config); Put_Line("All configuration settings are now default"); New_Line(3); when Toggle_Debug => -- Toggle debugging. New_Line(3); Config.Boolean_Opts(Debug) := not Config.Boolean_Opts(Debug); when Toggle_ISO => -- Toggle inline separate output. New_Line(3); Config.Boolean_Opts(Inline_Separate_Output) := not Config.Boolean_Opts(Inline_Separate_Output); when MV_D_Setting => -- Change MIME viewer decrypt setting. New_Line(3); Put_Line("MIME viewer for decrypt is set to " & ToStr(MV_Str(Config.Positive_Opts(MIME_Viewer_Decrypt)))); Config.Positive_Opts(MIME_Viewer_Decrypt) := MV_Values(MIME_Viewer_Menu1); when MV_V_Setting => -- Change MIME viewer verify setting. New_Line(3); Put_Line("MIME viewer for verify is set to " & ToStr(MV_Str(Config.Positive_Opts(MIME_Viewer_Verify)))); Config.Positive_Opts(MIME_Viewer_Verify) := MV_Values(MIME_Viewer_Menu1); when UGA_Setting => -- Change use GPG agent setting. New_Line(3); Put_Line("Use GPG agent is set to " & ToStr(UGA_Str(Config.Positive_Opts(Use_Agent)))); Config.Positive_Opts(Use_Agent) := UGA_Values(Use_Agent_Menu); when Toggle_OIDN => -- Toggle omit inline disposition name. New_Line(3); Config.Boolean_Opts(Omit_Inline_Disposition_Name) := not Config.Boolean_Opts(Omit_Inline_Disposition_Name); when Toggle_OIDH => -- Toggle omit inline disposition header. New_Line(3); Config.Boolean_Opts(Omit_Inline_Disposition_Header) := not Config.Boolean_Opts(Omit_Inline_Disposition_Header); when Toggle_SOS => -- Toggle save on send. New_Line(3); Config.Boolean_Opts(Save_On_Send) := not Config.Boolean_Opts(Save_On_Send); when Toggle_WIMS => -- Toggle save on send. New_Line(3); Config.Boolean_Opts(Wait_If_Missing_Keys) := not Config.Boolean_Opts(Wait_If_Missing_Keys); when Reset => -- Restore to current saved file. New_Line(3); Copy_Configuration(Config, Default_Config); declare Warnings : Boolean; begin Read_Config_File(Warnings); end; Put_Line("Read saved configuration"); New_Line(3); end case; end loop Edit_Loop; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Configuration.Edit_Configuration"); raise; end Edit_Configuration; procedure Default_Configuration (C : in out Config_Record) is begin C.UBS_Opts(My_Key) := ToUBS(""); C.Binary(Chmod) := ToUBS("chmod"); C.Binary(Clear) := ToUBS("clear"); C.Binary(Cut) := ToUBS("cut"); C.Binary(Date) := ToUBS("date"); C.Binary(Diff) := ToUBS("diff"); C.Binary(Formail) := ToUBS("formail"); C.Binary(File) := ToUBS("file"); C.Binary(Gpgop) := ToUBS("gpg"); C.Binary(Gpgsm) := ToUBS("gpgsm"); C.Binary(Grep) := ToUBS("grep"); C.Binary(Iconv) := ToUBS("iconv"); C.Binary(Less) := ToUBS("less"); C.Binary(Locale) := ToUBS("locale"); C.Binary(Md5sum) := ToUBS("md5sum"); C.Binary(Metamail) := ToUBS("metamail"); C.Binary(Mimeconstruct) := ToUBS("mime-construct"); C.Binary(Mimetool) := ToUBS("mime-tool"); C.Binary(Mkdir) := ToUBS("mkdir"); C.Binary(Mkfifo) := ToUBS("mkfifo"); C.Binary(Mv) := ToUBS("mv"); C.Binary(openssl) := ToUBS("openssl"); C.Binary(Rm) := ToUBS("rm"); C.Binary(Runmailcap) := ToUBS("run-mailcap"); C.Binary(Scp) := ToUBS("scp"); C.Binary(Sed) := ToUBS("sed"); C.Binary(Ssh) := ToUBS("ssh"); C.Binary(Stty) := ToUBS("stty"); C.Binary(Tee) := ToUBS("tee"); C.Binary(Test) := ToUBS("test"); C.UBS_Opts(GPG_Options) := ToUBS("--no-options"); C.UBS_Opts(GPGSM_Options) := ToUBS("--no-options"); C.UBS_Opts(General_Options) := ToUBS(""); C.UBS_Opts(Receiving_Options) := ToUBS("--keyserver=hkp://subkeys.pgp.net"); C.UBS_Opts(Sending_Options) := ToUBS("--comment ""Topal (https://zircon.org.uk/topal/)"""); C.UBS_Opts(Colour_Menu_Title) := ToUBS("1;45;37"); C.UBS_Opts(Colour_Menu_Key) := ToUBS("0;42;30"); C.UBS_Opts(Colour_Menu_Choice) := ToUBS("0;32;40"); C.UBS_Opts(Colour_Important) := ToUBS("1;41;37"); C.UBS_Opts(Colour_Banner) := ToUBS("1;47;30"); C.UBS_Opts(Colour_Info) := ToUBS("1;40;36"); C.UBS_Opts(Decrypt_Prereq) := ToUBS(""); C.Positive_Opts(Decrypt_Not_Cached) := 2; C.Positive_Opts(Decrypt_Not_Cached_Use_Cache) := 1; C.Positive_Opts(Decrypt_Cached) := 2; C.Positive_Opts(Decrypt_Cached_Use_Cache) := 1; C.Positive_Opts(Verify_Not_Cached) := 1; C.Positive_Opts(Verify_Not_Cached_Use_Cache) := 1; C.Positive_Opts(Verify_Cached) := 1; C.Positive_Opts(Verify_Cached_Use_Cache) := 1; C.Positive_Opts(MIME_Viewer_Decrypt) := 1; C.Positive_Opts(MIME_Viewer_Verify) := 1; C.Positive_Opts(Use_Agent) := 2; C.Positive_Opts(Replace_IDs) := 2; C.Positive_Opts(Include_Send_Token) := 3; C.Boolean_Opts(Decrypt_Cached_Fast_Continue) := False; C.Boolean_Opts(Verify_Cached_Fast_Continue) := True; C.Boolean_Opts(Verify_Not_Cached_Fast_Continue) := False; C.Boolean_Opts(Inline_Separate_Output) := False; C.Boolean_Opts(Omit_Inline_Disposition_Name) := False; C.Boolean_Opts(Omit_Inline_Disposition_Header) := False; C.Boolean_Opts(Save_On_Send) := False; C.Boolean_Opts(ANSI_Terminal) := True; C.Boolean_Opts(Wait_If_Missing_Keys) := True; C.Boolean_Opts(Attachment_Trap) := False; C.Boolean_Opts(FE_Simple) := False; C.Boolean_Opts(No_Clean) := False; C.Boolean_Opts(All_Headers) := False; C.Boolean_Opts(Read_From) := False; C.Boolean_Opts(Ask_Charset) := False; C.Boolean_Opts(Fix_Fcc) := True; C.Boolean_Opts(Fix_Bcc) := True; C.Boolean_Opts(Debug) := False; C.AKE := UPP.Empty_Vector; C.XK := UVP.Empty_Vector; C.SAKE := UPP.Empty_Vector; C.SXK := UVP.Empty_Vector; C.SD := UPP.Empty_Vector; C.SC := UPP.Empty_Vector; C.ST := UPP.Empty_Vector; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Configuration.Default_Configuration"); raise; end Default_Configuration; procedure Copy_Configuration(Left : in out Config_Record; Right : in Config_Record) is begin for I in Binaries loop Left.Binary(I) := Right.Binary(I); end loop; for I in UBS_Opts_Keys loop Left.UBS_Opts(I) := Right.UBS_Opts(I); end loop; for I in Positive_Opts_Keys loop Left.Positive_Opts(I) := Right.Positive_Opts(I); end loop; for I in Boolean_Opts_Keys loop Left.Boolean_Opts(I) := Right.Boolean_Opts(I); end loop; Left.AKE := Right.AKE; Left.XK := Right.XK; Left.SAKE := Right.SAKE; Left.SXK := Right.SXK; Left.SD := Right.SD; Left.SC := Right.SC; Left.ST := Right.ST; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Configuration.Copy_Configuration"); raise; end Copy_Configuration; end Configuration; topal-80/remote_mode.ads0000644000175000017500000000304013434071426013523 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Remote_Mode is procedure Send(Tmpfile : in String; Mime : in Boolean; Mimefile : in String; Recipients : in UBS_Array); procedure Remote_Send(Tmpfile : in String; Resultfile : in String; Mime : in Boolean; Mimefile : in String; Recipients : in UBS_Array); procedure Decrypt(Infile : in String; MIME : in Boolean; Content_Type : in String := ""); procedure Remote_Decrypt(Infile : in String; MIME : in Boolean; Content_Type : in String := ""); -- Content_Type only needed if MIME is True. procedure Server; end Remote_Mode; topal-80/sending.adb0000644000175000017500000013712213434071426012643 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Command_Line; with Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; with Ada.Strings.Unbounded; with Ada.Text_IO; with Configuration; with Attachments; with Externals; use Externals; with Externals.GPG; with Externals.Mail; with Externals.Simple; use Externals.Simple; with Keys; with Menus; use Menus; with Misc; use Misc; with Readline; with Remote_Mode; package body Sending is Send_Modes_Text : constant array (Send_Modes) of String(1..34) := (Encrypt => "Encrypt ", SignEncrypt => "Sign + encrypt ", ClearSign => "Clear sign ", NoGPG => "No GPG ", EncryptPO => "Encrypt (preserve original) ", SignEncryptPO => "Sign + encrypt (preserve original)", ClearSignPO => "Clear sign (preserve original) ", DetachSignPO => "Detached signature "); Mime_Modes_Text : constant array (Mime_Modes) of String(1..22) := (InlinePlain => "Inline plain ", AppPGP => "Application/PGP ", Multipart => "Multipart ", MultipartEncap => "Multipart encapsulated", SMIME => "SMIME CMS (not GPG) "); Exit_Send_Loop : exception; -- Subroutine says `bail out, please'. procedure Key_Preselect (K : in out Keys.Key_List; Recipients : in UBS_Array; Alt_Sign : in String; Missing : out Boolean; SMIME : in Boolean) is begin -- Can we preselect any keys? Keys.Empty_Keylist(K, SMIME); Keys.Use_Keylist(Recipients, K, Missing); -- Add our own key. If Alt_Sign is non-empty, then try and add -- keys for that instead. declare AKL : Keys.Key_List; Found : Boolean := False; KC : Natural; The_Key : UBS; begin if Alt_Sign /= "" then Ada.Text_IO.Put_Line("Looking for signing key for `"&Alt_Sign&"' on SAKE list..."); for J in 1..Integer(Config.SAKE.Length) loop if EqualCI(Config.SAKE.Element(J).Value, Alt_Sign) then Keys.Add_Keys_By_Fingerprint(Key_In => Config.SAKE.Element(J).Key, List => K, Role => Keys.Both, Email => False, Found => Found); if Found then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Added key `"&ToStr(Config.SAKE.Element(J).Key)&"' for signing..." & Reset_SGR); Config.UBS_Opts(My_Key) := Config.SAKE.Element(J).Key; else -- Try again, but only as an encryptor. Keys.Add_Keys_By_Fingerprint(Key_In => Config.SAKE.Element(J).Key, List => K, Role => Keys.Encrypter, Email => False, Found => Found); if Found then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Added own key `"&ToStr(Config.SAKE.Element(J).Key)&"' BUT only as encryptor..." & Reset_SGR); -- We'll not change My_Key here. else Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Couldn't add key `"&ToStr(Config.SAKE.Element(J).Key)&"' for signing..." & Reset_SGR); end if; end if; end if; end loop; end if; if Alt_Sign /= "" and (not Found) then Keys.Empty_Keylist(AKL, SMIME); Ada.Text_IO.Put_Line("Looking for signing key for `"&Alt_Sign&"' via keyring (& XK list)..."); Keys.Add_Secret_Keys(ToUBS(Alt_Sign), AKL, Keys.Both); -- Any keys to remove on the SXK list? for J in 1..Integer(Config.SXK.Length) loop Keys.Remove_Key(Config.SXK.Element(J), AKL); end loop; KC := Keys.Count(AKL); Found := KC > 0; if Found then if KC = 1 then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Added one signing key..." & Reset_SGR); -- Add this one. Keys.First_Key_From_List(AKL, The_Key); Keys.Add_Key(The_Key, K, Keys.Both); Config.UBS_Opts(My_Key) := The_Key; else -- Multiple keys... Ada.Text_IO.Put_Line("Found multiple possible signing keys..."); -- Choose one. If aborted, fall-back to my-key. Keys.Select_Key_From_List(AKL, The_Key, Found); -- Found is not aborted... Found := not Found; if Found then Keys.Add_Key(The_Key, K, Keys.Both); Config.UBS_Opts(My_Key) := The_Key; else Ada.Text_IO.Put_Line("Aborted selection of secret key, will consider my-key instead"); end if; end if; else Ada.Text_IO.Put_Line("Can't find alternative key, trying my-key..."); end if; end if; if Alt_Sign /= "" and (not Found) then Keys.Add_Keys_By_Fingerprint(Key_In => ToUBS(Alt_Sign), List => K, Role => Keys.Encrypter, Email => False, Found => Found); if Found then Ada.Text_IO.Put_Line("Added encryptor key(s) for self"); end if; end if; if (not Found) then if ToStr(Config.UBS_Opts(My_Key)) = "" then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "my-key is empty; not selecting any keys for self" & Reset_SGR); else Keys.Add_Keys_By_Fingerprint(Key_In => Value_Nonempty(Config.UBS_Opts(My_Key)), List => K, Role => Keys.Encrypter, Email => False, Found => Found); if Found then Ada.Text_IO.Put_Line("Added `my-key' key(s) for self"); else Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Warning: my-key=" & ToStr(Config.UBS_Opts(My_key)) & " does not find keys" & Reset_SGR); end if; end if; end if; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Key_Preselect"); raise; end Key_Preselect; procedure Mode_Preselect (K : in Keys.Key_List; Recipients : in UBS_Array; SI : out Send_Modes; MI : out MIME_Modes) is procedure Set_I (S : in UBS) is S2 : constant String := ToStr(S); use Ada.Strings.Fixed; begin if Index(S2, "n") /= 0 then SI := NoGPG; end if; if Index(S2, "e") /= 0 then SI := Encrypt; end if; if Index(S2, "s") /= 0 then SI := SignEncrypt; end if; if Index(S2, "c") /= 0 then SI := ClearSign; end if; if Index(S2, "I") /= 0 then MI := InlinePlain; end if; if Index(S2, "A") /= 0 then MI := AppPGP; end if; if Index(S2, "M") /= 0 then MI := Multipart; end if; if Index(S2, "E") /= 0 then MI := MultipartEncap; end if; if Index(S2, "P") /= 0 then MI := SMIME; end if; end Set_I; use type UBS; begin SI := NoGPG; MI := InlinePlain; -- Consider each SD item. We do them in this order so that -- later overrides earlier. for J in 1..Integer(Config.SD.Length) loop if EqualCI(Config.SD.Element(J).Key, "@ANY@") then -- User default! Set_I(Config.SD.Element(J).Value); elsif Ada.Strings.Fixed.Index(ToStr(Config.SD.Element(J).Key), "@") /= 0 then -- Is it an email address? If so... -- Do any recipients match? for I in Recipients'Range loop if EqualCI(Config.SD.Element(J).Key, Recipients(I)) then Set_I(Config.SD.Element(J).Value); end if; end loop; else -- Do any keys match? if Keys.Contains(K, Config.SD.Element(J).Key) then Set_I(Config.SD.Element(J).Value); end if; end if; end loop; if SI /= NoGPG then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Sending defaults to " & Send_Modes_Text(SI) & Reset_SGR); end if; if MI /= InlinePlain then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Sending defaults to " & Mime_Modes_Text(MI) & Reset_SGR); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Mode_Preselect"); raise; end Mode_Preselect; function The_Content_Type(Hdrfile : in String; Actual_Send : in Boolean) return String is -- What is the content type for outbound messages? (at least, -- the bit we're bothered about) Current_Charset : UBS; begin if Actual_Send then -- Extract if from the Hdrfile. declare CTfile : constant String := Temp_File_Name("hdrct"); begin Mail.Extract_Content_Type_From_Header(Hdrfile, CTfile); declare CT : constant String := ToStr(Read_Fold(CTfile)); begin -- Dump characters 1..14 (as they say "Content-Type: "). return CT(15..CT'Last); end; end; else Current_Charset := ToUBS(Externals.Simple.Get_Charmap); return "text/plain; charset=""" & ToStr(Current_Charset) & """"; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.The_Content_Type"); raise; end The_Content_Type; function Get_Recipients (Tmpfile : String) return UBS_Array_Pointer is Hdrfile : constant String := Temp_File_Name("hdr"); Tofile : constant String := Temp_File_Name("to"); Ccfile : constant String := Temp_File_Name("cc"); Bccfile : constant String := Temp_File_Name("bcc"); R : UVV; procedure Read_Lines (File : in String) is use Ada.Text_IO; F : File_Type; begin Open(File => F, Mode => In_File, Name => File); Read_Loop: loop exit Read_Loop when End_Of_File(F); R.Append(Unbounded_Get_Line(F)); end loop Read_Loop; Close(File => F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Send.Get_Recipients.Read_Lines"); raise; end Read_Lines; begin -- Get the header. Externals.Mail.Extract_Header(Email_Filename => Tmpfile, Target_Filename => Hdrfile); -- Get the To, Cc and Bcc lines. Externals.Mail.Formail_Concat_Extract_InOut("To:", Hdrfile, Tofile); Externals.Mail.Formail_Concat_Extract_InOut("Cc:", Hdrfile, Ccfile); Externals.Mail.Formail_Concat_Extract_InOut("Bcc:", Hdrfile, Bccfile); -- Clean them up. Externals.Mail.Clean_Email_Address(Tofile); Externals.Mail.Clean_Email_Address(Ccfile); Externals.Mail.Clean_Email_Address(Bccfile); -- Read them one line at a time. R := UVP.Empty_Vector; Read_Lines(Tofile); Read_Lines(Ccfile); Read_Lines(Bccfile); -- Now create a suitable array. declare A : UBS_Array_Pointer; begin A := new UBS_Array(1..Integer(R.Length)); for I in 1..Integer(R.Length) loop A(I) := R.Element(I); end loop; return A; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Send.Get_Recipients"); raise; end Get_Recipients; function Check_Send (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean := False; Send_Comment : in String := "") return Boolean is begin if not (Non_Pine or Actual_Send) then if Mime then if Externals.Simple.Test_R(Mimefile) then Ada.Text_IO.Put_Line("The Content-Type being returned is: "); Cat(Mimefile); else Ada.Text_IO.Put_Line("Unchanged Content-Type."); end if; end if; end if; if not Non_Pine then Wait; Pager(Tmpfile); Externals.Simple.Clear; Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Recipients (to, cc, bcc; not lcc): " & Reset_SGR); for I in Recipients'Range loop Ada.Text_IO.Put_Line(" " & ToStr(Recipients(I))); end loop; Ada.Text_IO.New_Line(1); if Actual_Send then Ada.Text_IO.Put_Line(Send_Comment); Ada.Text_IO.New_Line(1); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Topal will send this email without asking Pine! (Sendmail-path mode, -asend)" & Reset_SGR); end if; if YN_Menu(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Okay to send? " & Reset_SGR) = No then -- The exit status tells Pine that it's not to send! Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); -- And this False tells the Actual_Send caller not to send. return False; end if; -- If save on send is set, then we write a copy of Tmpfile. if Config.Boolean_Opts(Save_On_Send) then declare LM : constant String := ToStr(Topal_Directory) & "/lastmail"; begin -- If it's an Actual_Send, we already have a combined email. if Actual_Send then Cat_Out(Tmpfile, LM); -- If the Hdrfile is readable, that first. elsif Hdrfile /= "" and then Test_R(Hdrfile) then Cat_Out(Hdrfile, LM); Echo_Append("", LM); Cat_Append(Tmpfile, LM); else Cat_Out(Tmpfile, LM); end if; end; end if; end if; -- Default, okay to send. return True; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Check_Send (function)"); raise; end Check_Send; procedure Check_Send (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean := False; Send_Comment : in String := "") is RV : Boolean; pragma Unreferenced(RV); begin RV := Check_Send(Tmpfile, Non_Pine, Mime, Mimefile, Hdrfile, Recipients, Actual_Send, Send_Comment); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Check_Send (procedure)"); raise; end Check_Send; procedure Prepare_For_Clearsign (Tmpfile : in String; QP_File : in String; AS_Content_Type : in String) is DTBL_File : constant String := Temp_File_Name("dtbl"); DTBL2_File : constant String := Temp_File_Name("dtbl2"); begin Mail.Delete_Trailing_Blank_Lines(Tmpfile, DTBL_File); -- Then we turn it into quoted printable. -- Also turn it into DOS line endings. -- Some of the code below is redundant: we don't actually need -- it because Alpine appears to do suitable encoding! Aaaargh! if Ada.Strings.Fixed.Index(AS_Content_Type, "multipart/mixed;") /= 0 then -- Alpine will have prepended a prologue of the form -- This message is in MIME format. The first part should be readable text, -- while the remaining parts are likely unreadable without MIME-aware tools. -- We need to delete this and the trailing blank line. This -- is an operation on the DTBL file. -- FIXME: a more robust approach would be to detect the first line -- of the MIME header and delete up to there. Let's hope that -- Alpine remains predictable for now. -- LATER REMARK: Alpine's not generating this message now. So -- Topal needs to do something better. We open the -- DTBL_File and read the first two lines. If they include -- parts of the traditional prologue, then we continue and -- delete the first three lines. Otherwise, we leave it -- alone. declare use Ada.Text_IO; F : File_Type; L1, L2 : UBS; begin Open(File => F, Mode => In_File, Name => DTBL_File); L1 := Unbounded_Get_Line(F); L2 := Unbounded_Get_Line(F); Close(F); declare S1 : constant String := ToStr(L1); S2 : constant String := ToStr(L2); use Ada.Strings.Fixed; begin if Index(S1, "This message is in MIME format.") /= 0 and Index(S2, "MIME-aware tools") /= 0 then Sed_InOut("1,3 d", DTBL_File, DTBL2_File); else Cat_Out(DTBL_File, DTBL2_File); end if; end; end; -- We'll keep ourselves to just Dos2unix'ing the whole thing. -- It also needs the original content-type prepending. -- Certainly don't want any further encoding. Echo_Out("Content-Type: " & AS_Content_Type, QP_File); Echo_Append("", QP_File); Cat_Append(DTBL2_File, QP_File); Dos2Unix_U(QP_File); else Externals.Mail.Mimeconstruct_Subpart(Infile => DTBL_File, Outfile => QP_File, Content_Type => AS_Content_Type, Dos2UnixU => True, Use_Encoding => True, Encoding => "quoted-printable", Attachment_Name => "message.txt", Disposition => Externals.Mail.Inline); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Prepare_For_Clearsign"); raise; end Prepare_For_Clearsign; procedure Encrypt (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Send_Keys : in Keys.Key_List; Selection : in Send_Modes; Mime_Selection : in MIME_Modes; AL : in Attachments.Attachment_List; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean; New_Headers : out UVV) is separate; procedure Sign_Encrypt (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Send_Keys : in Keys.Key_List; Selection : in Send_Modes; Mime_Selection : in MIME_Modes; AL : in Attachments.Attachment_List; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean; New_Headers : out UVV; AS_Content_Type : in String) is separate; procedure Clearsign (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Selection : in Send_Modes; Mime_Selection : in MIME_Modes; AL : in Attachments.Attachment_List; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean; New_Headers : out UVV; AS_Content_Type : in String) is separate; procedure Detached_Sig (Tmpfile : in String) is SFD_File : constant String := Temp_File_Name("sfd"); begin -- Run GPG. -- Not using --textmode here, because it could be a binary file. Externals.GPG.GPG_Wrap(" --detach-sign --armor --local-user " & Value_Nonempty(Config.UBS_Opts(my_key)) & " " & UGA_Str(Signing => True) & " " & " --output " & Tmpfile & ".asc " & Tmpfile, Tmpfile & ".asc", SFD_File); Wait; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Detached_Sig"); raise; end Detached_Sig; procedure Send_Unchanged (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean) is begin if not Actual_Send then Check_Send(Tmpfile, Non_Pine, Mime, Mimefile, Hdrfile, Recipients); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Send_Unchanged"); raise; end Send_Unchanged; -- We want to send a message. procedure Send (Tmpfile : in String; Recipients : in UBS_Array; Remaining : in UBS_Array := UBS_Array'(1..0 => ToUBS("")); Non_Pine : in Boolean := False; Mime : in Boolean := False; Mimefile : in String := ""; Actual_Send : in Boolean := False) is Send_Keys : Keys.Key_List; Selection : SendMime_Index; Send_Mode : Send_Modes; Mime_Mode : MIME_Modes; Originfile : constant String := Temp_File_Name("origin"); Hdrfile : constant String := Temp_File_Name("hdr"); Tmpfile2 : constant String := Temp_File_Name("tmp2"); Fromfile : constant String := Temp_File_Name("from"); Finalfile : constant String := Temp_File_Name("final"); Alt_Sign : UBS; AL : Attachments.Attachment_List; My_Key_View : UBS; Missing : Boolean; Send_Command : UBS; Send_Comment : UBS; New_Headers : UVV; AS_Content_Type : UBS; Aborting : Boolean := False; procedure Set_My_Key_View is begin if ToStr(Config.UBS_Opts(My_Key)) = "" then My_Key_View := ToUBS("(not set)"); else declare KP : Keys.Key_Properties; begin Keys.Process_Key_By_FP(ToStr(Config.UBS_Opts(My_Key)), My_Key_View, KP, Mime_Mode = SMIME); end; end if; end Set_My_Key_View; procedure Initialise_Keys (Do_Mode_Preselect : in Boolean) Is begin if Do_Mode_Preselect then -- Sort out default mode. Do this first so that we can force SMIME mode. Mode_Preselect(Send_Keys, Recipients, Send_Mode, Mime_Mode); end if; -- Sort out the send menus/msgs. Key_Preselect(Send_Keys, Recipients, ToStr(Alt_Sign), Missing, Mime_Mode = SMIME); if Missing and then (Send_Mode = Encrypt or Send_Mode = SignEncrypt) then Ada.Text_IO.New_Line(2); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Sending is *ENCRYPTING* but some recipient keys were *MISSING*." & NL & "Those recipients will not be able to decrypt this message." & Reset_SGR); -- If appropriate, wait for the user to acknowledge. if Config.Boolean_Opts(Wait_If_Missing_Keys) then Wait; end if; end if; -- View of the current key. Set_My_Key_View; end Initialise_Keys; begin Debug("+Send"); if Actual_Send then Ada.Text_IO.New_Line(2); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Info)) & "Running in sendmail-path mode." & Reset_SGR); for I in 1..Recipients'Last loop Ada.Text_IO.Put_Line("Recipient: ‘" & ToStr(Recipients(I)) & "’"); end loop; end if; -- Save the original input. Externals.Simple.Cat_Out(Tmpfile, Originfile); -- If Config.Boolean_Opts(All_Headers) is set, then split -- tmpfile into header and body. But we'll copy the tmpfile -- into another tmp first, then put the body alone back in -- Tmpfile. if Config.Boolean_Opts(All_Headers) or Actual_Send Then Externals.Simple.Mv_F(Tmpfile, Tmpfile2); -- Make sure the line endings are correct. Externals.Simple.Dos2Unix(Tmpfile2); Externals.Mail.Extract_Header(Email_Filename => Tmpfile2, Target_Filename => Hdrfile); Externals.Mail.Extract_Body(Email_Filename => Tmpfile2, Target_Filename => Tmpfile); end if; -- If Config.UBS_Opts(Read_From) is set, then parse the header to find the -- fromline and set my-key appropriately. This implies that -- All_Headers was set, too. if Config.Boolean_Opts(Read_From) or Actual_Send then Externals.Mail.Formail_Concat_Extract_InOut("From:", Hdrfile, Fromfile); Externals.Mail.Clean_Email_Address(Fromfile); Alt_Sign := Read_Fold(Fromfile); end if; -- Initialise keys (preselect, etc.) Initialise_Keys(Do_Mode_Preselect => True); -- Initialise attachments. Attachments.Empty_Attachment_List(AL); -- Show other arguments. for I in Remaining'Range loop Ada.Text_IO.Put_Line("Remaining arg ‘" & ToStr(Remaining(I)) & "’"); end loop; -- If we're running as sendmail-path filter, use Alt_Sign to -- grab the correct filter from sc. if Actual_Send then declare use type UBS; Found : Boolean := False; begin for J in 1..Integer(Config.SC.Length) loop if EqualCI(Config.SC.Element(J).Key, "@ANY@") then -- Default. Use it. Send_Command := Config.SC.Element(J).Value; Send_Comment := ToUBS("Selecting sender ‘") & Send_Command & ToUBS("’ as default match."); Found := True; elsif EqualCI(Config.SC.Element(J).Key, Alt_Sign) then Send_Command := Config.SC.Element(J).Value; Send_Comment := ToUBS("Selecting sender ‘") & Send_Command & ToUBS("’ for match on ‘") & Alt_Sign & ToUBS("’."); Found := True; end if; end loop; if not Found then Error("Didn't find any matches in sc list. Can't send!"); end if; end; -- We also get the content-type (AS_Content_Type) and check -- that we've got compatible selections. AS_Content_Type := ToUBS(The_Content_Type(Hdrfile, Actual_Send)); -- Translate to lower case. AS_Content_Type := Ada.Strings.Unbounded.Translate(AS_Content_Type, Ada.Strings.Maps.Constants.Lower_Case_Map); if Ada.Strings.Unbounded.Index(AS_Content_Type, "multipart/mixed;") /= 0 and then (Mime_Mode = InlinePlain or Mime_Mode = AppPGP) then -- We must return a multipart! So force to multipart. Mime_Mode := Multipart; Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Forced to multipart mode because -asend mode with multipart/mixed input." & Reset_SGR); end if; -- We'll also test for attachments…. if Config.Boolean_Opts(Attachment_Trap) then declare Attachcountfile : constant String := Temp_File_Name("attachc"); Attachment_Warning : Boolean := False; Dummy : Integer; pragma Unreferenced(Dummy); begin if Externals.Simple.Grep_I_InOut("(^[^>].*attach)|(^attach)", Tmpfile, "/dev/null", E => True) = 0 then if Ada.Strings.Unbounded.Index(AS_Content_Type, "multipart/mixed;") = 0 then -- It's not a multipart. So there cannot be any -- attachments. Attachment_Warning := True; else -- It's multipart. We need to count the number -- of content-types. We're only doing this as a -- heuristic, so I'm not too concerned about -- strict correctness (e.g., counting the parts -- properly). Dummy := Externals.Simple.Grep_I_InOut("^content-type:", Tmpfile, Attachcountfile, C => True); Attachment_Warning := String_To_Integer(Read_Fold(Attachcountfile)) = 1; end if; end if; if Attachment_Warning then Ada.Text_IO.New_Line(2); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "This email doesn't have any attachments, but the string “attach” is in" & NL & "the message. Consider quitting to check your attachments." & Reset_SGR); Wait; end if; end; end if; -- Attachment trap. else -- We need to set a content-type. AS_Content_Type := ToUBS(The_Content_Type("", False)); -- Translate to lower case. AS_Content_Type := Ada.Strings.Unbounded.Translate(AS_Content_Type, Ada.Strings.Maps.Constants.Lower_Case_Map); end if; Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Info)) & ToStr(Send_Comment) & Reset_SGR); -- Loop around doingstuff, now. Send_Loop: loop Ada.Text_IO.New_Line(5); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Menu_Title)) & "** Main send menu:" & Reset_SGR); Ada.Text_IO.Put_Line(" Sending mode: " & Do_SGR(Config.UBS_Opts(Colour_Info)) & Send_Modes_Text(Send_Mode) & Reset_SGR); if Mime then Ada.Text_IO.Put(" " & Do_SGR(Config.UBS_Opts(Colour_Info)) & Mime_Modes_Text(Mime_Mode) & Reset_SGR); if Mime_Mode = MultipartEncap and then Send_Mode /= SignEncrypt then Ada.Text_IO.Put(Do_SGR(Config.UBS_Opts(Colour_Important)) & " (will downgrade to Multipart)" & Reset_SGR); end if; Ada.Text_IO.New_Line; end if; Ada.Text_IO.Put_Line(" Signing key: " & Do_SGR(Config.UBS_Opts(Colour_Info)) & ToStr(My_Key_View) & Reset_SGR); Ada.Text_IO.Put(Do_SGR(Config.UBS_Opts(Colour_Info)) & Integer'Image(Keys.Count(Send_Keys)) & " key(s)" & Reset_SGR & " in key list "); if Non_Pine then Ada.Text_IO.New_Line; Selection := Send_Menu_NP; elsif Mime then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Info)) & Integer'Image(Attachments.Count(AL)) & " attachment(s)" & Reset_SGR); Selection := Send_Menu_Pine_Mime; else Ada.Text_IO.New_Line; Selection := Send_Menu_Pine_Plain; end if; begin case Selection is when AAbort => -- Abort Ada.Text_IO.Put_Line("Aborting"); Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); -- Turn off Actual_Send so that we don't go through -- that at the end of this procedure. Aborting := True; exit Send_Loop; when AddOwn => -- Add own key if ToStr(Config.UBS_Opts(My_Key)) = "" then Ada.Text_IO.Put_Line("my-key is empty; not selecting any keys for self"); else Keys.Add_Keys_By_Fingerprint(Key_In => Value_Nonempty(Config.UBS_Opts(My_Key)), List => Send_Keys, Role => Keys.Encrypter); end if; when EditOwn => -- Change own key Configuration.Edit_Own_Key(Mime_Mode = SMIME); -- Reset view of the current key. Set_My_Key_View; when ViewMail => -- View the input email. Pager(Tmpfile); when EditMail => -- Edit the input email. declare Editor_Command : UBS; Dummy : Integer; use Ada.Text_IO; use type UBS; pragma Unreferenced(Dummy); begin New_Line(1); Put_Line("Edit input email:"); Editor_Command := ToUBS(Readline.Get_String("Which editor command? (filename will be appended) ")); if ToStr(Editor_Command)'Length > 0 then Dummy := Externals.Simple.System(Editor_Command & ToUBS(" " & Tmpfile)); end if; end; when AttachEdit => -- Edit the attachment list. Attachments.List(AL); if Attachments.Count(AL) > 0 then if (not Mime) then Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "WARNING: attachments not included in non-MIME emails!" & Reset_SGR); Ada.Text_IO.New_Line; elsif Mime and then not (Mime_Mode = MultipartEncap or Mime_Mode = Multipart or Mime_Mode = SMIME) then Mime_Mode := Multipart; Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Note: Forcing sending mode to multipart/* for attachments" & Reset_SGR); Ada.Text_IO.New_Line; end if; end if; when Configure => -- Configuration Configuration.Edit_Configuration; when ListEdit => -- List keys Keys.List_Keys(Send_Keys); when Remote => -- Run remote connection -- Restore original tmpfile from origin. Externals.Simple.Cat_Out(Originfile, Tmpfile); Remote_Mode.Send(Tmpfile, Mime, Mimefile, Recipients); exit Send_Loop; when Encrypt | SignEncrypt | ClearSign | NoGPG | EncryptPO | SignEncryptPO | ClearSignPO | DetachSignPO => -- Set Send_Mode. Send_Mode := Selection; when InlinePlain | AppPGP | Multipart | MultipartEncap | SMIME => -- Set Mime_Mode. -- We might need to flip the key list! if Actual_Send and then Ada.Strings.Unbounded.Index(AS_Content_Type, "multipart/mixed;") /= 0 and then (Selection = InlinePlain or Selection = AppPGP) then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Info)) & "Ignored request, must use multipart-compatible mode." & Reset_SGR); else declare Old_Mime_Mode_SMIME : constant Boolean := Mime_Mode = SMIME; New_Mime_Mode_SMIME : Boolean; begin Mime_Mode := Selection; New_Mime_Mode_SMIME := Mime_Mode = SMIME; if Old_Mime_Mode_SMIME /= New_Mime_Mode_SMIME then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Info)) & "Resetting key list: changed to " & Mime_Modes_Text(Mime_Mode) & Reset_SGR); Ada.Text_IO.New_Line; Initialise_Keys(Do_Mode_Preselect => False); end if; end; end if; when Go => -- MultipartEncap only applies to SignEncrypt. -- Downgrade to Multipart otherwise. if Mime_Mode = MultipartEncap and then Send_Mode /= SignEncrypt then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "NOTE: replacing MultipartEncap with Multipart for this operation." & Reset_SGR); Mime_Mode := Multipart; end if; -- Need MIME for attachments. if not (Mime and then (Mime_Mode = MultipartEncap or Mime_Mode = Multipart)) then if Attachments.Count(AL) > 0 then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "WARNING: attachments not included in non-MIME emails!" & Reset_SGR); Ada.Text_IO.New_Line; end if; end if; case Send_Mode is when Encrypt | EncryptPO => -- Do GPG: encrypt if Keys.Count(Send_Keys) = 0 then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "No keys are in the key list. Can't encrypt until you select at least one key." & Reset_SGR); else Encrypt(Tmpfile, Non_Pine, Mime, Mimefile, Send_Keys, Send_Mode, Mime_Mode, AL, Hdrfile, Recipients, Actual_Send, New_Headers); exit Send_Loop; end if; when SignEncrypt | SignEncryptPO => -- Do GPG: sign-encrypt if ToStr(Config.UBS_Opts(My_Key)) = "" then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Own key not set! Can't sign until you do this." & Reset_SGR); elsif Keys.Count(Send_Keys) = 0 then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "No keys are in the key list. Can't encrypt until you select at least one key." & Reset_SGR); else Sign_Encrypt(Tmpfile, Non_Pine, Mime, Mimefile, Send_Keys, Send_Mode, Mime_Mode, AL, Hdrfile, Recipients, Actual_Send, New_Headers, ToStr(AS_Content_Type)); exit Send_Loop; end if; when Clearsign | ClearSignPO => -- Do GPG: clearsign if ToStr(Config.UBS_Opts(My_Key)) = "" then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Own key not set! Can't sign until you do this." & Reset_SGR); else Clearsign(Tmpfile, Non_Pine, Mime, Mimefile, Send_Mode, Mime_Mode, AL, Hdrfile, Recipients, Actual_Send, New_Headers, ToStr(AS_Content_Type)); exit Send_Loop; end if; when DetachSignPO => -- Do GPG: create detached signature if ToStr(Config.UBS_Opts(My_Key)) = "" then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Own key not set! Can't sign until you do this." & Reset_SGR); else Detached_Sig(Tmpfile); exit Send_Loop; end if; when NoGPG => -- Pass thu' unchanged. if not Actual_Send then Send_Unchanged(Tmpfile, Non_Pine, Mime, Mimefile, Hdrfile, Recipients, Actual_Send); end if; exit Send_Loop; end case; end case; exception when Exit_Send_Loop => exit Send_Loop; when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Send (Send_Loop)"); raise; end; end loop Send_Loop; if Actual_Send and (not Aborting) then -- Fix up the mail and its headers. -- Each header in New_Headers is used to replace a header in the hdrfile. for I in 1..Integer(New_Headers.Length) loop Externals.Mail.Formail_Replace_Header(Hdrfile, ToStr(New_Headers.Element(I))); end loop; declare E : Integer; Hdrfile2 : constant String := Temp_File_Name("hdr2"); ST_Found : Boolean := False; ST_Token : UBS; begin -- Hdrfile sometimes has a blank trailing line; sometimes -- not. Delete any present, then add one. Externals.Mail.Delete_Trailing_Blank_Lines(Hdrfile, Hdrfile2); -- Do we have a send token for this From address? declare use type UBS; begin Find_Loop: for I in 1..Integer(Config.ST.Length) loop if EqualCI(Alt_Sign, Config.ST.Element(I).Key) then ST_Found := True; ST_Token := Config.ST.Element(I).Value; exit Find_Loop; end if; end loop Find_Loop; end; -- Replace any other headers? case Config.Positive_Opts(Replace_IDs) is when 1 => Externals.Mail.Replace_Message_ID(Hdrfile2, ToStr(Alt_Sign), ST_Found, ToStr(ST_Token)); when 2 => Externals.Mail.Replace_Message_ID(Hdrfile2, ToStr(Alt_Sign), ST_Found, ToStr(ST_Token)); Externals.Mail.Replace_Content_IDs(Hdrfile2, ToStr(Alt_Sign)); Externals.Mail.Replace_Content_IDs(Tmpfile, ToStr(Alt_Sign)); when others => null; end case; -- Combine the message together. Cat_Out(Hdrfile2, Finalfile); -- Append a X-Topal-SPF: Yes marker. Echo_Append("X-Topal-SPF: yes", Finalfile); -- Possibly add a send-token. if ST_Found then declare Include_ST : Boolean := False; begin case Config.Positive_Opts(Include_Send_Token) is -- Ignore case 1, that's false. when 2 => -- Ask. Ada.Text_IO.New_Line(2); Include_ST := YN_Menu(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Include send token? " & Reset_SGR) = Yes; when 3 => Include_ST := True; when others => null; -- Don't care. Don't include the token. end case; if Include_ST then Echo_Append("X-Topal-Send-Token: " & Externals.Mail.Calculate_Send_Token(Hdrfile2, ToStr(ST_Token)), Finalfile); end if; end; -- Similarly, since we have an ST_Token, we can -- consider encrypting any X-Topal-Fcc to -- X-Topal-Fcce. if Config.Boolean_Opts(Fix_Fcc) then Externals.Mail.Replace_Fcc(Finalfile, ToStr(ST_Token)); end if; -- If we see bcc:, add an encrypted X-Topal-Bcc. if Config.Boolean_Opts(Fix_Bcc) then Externals.Mail.Add_Bcc(Finalfile, ToStr(ST_Token)); end if; end if; -- Back to constructing the message. -- Not sure we always need this break. -- Break between header and body. Echo_Append("", Finalfile); Cat_Append(Tmpfile, Finalfile); -- Really send it? if Check_Send(Finalfile, Non_Pine, Mime, "", "", Recipients, True, ToStr(Send_Comment)) then -- Okay, invoke the sendmail-path. E := System_In(ToStr(Send_Command), Finalfile); if E /= 0 then Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); Ada.Text_IO.Put_Line("‘" & ToStr(Send_Command) & "’ returned non-zero."); Wait; end if; end if; end; end if; exception when others => declare use Ada.Text_IO; begin Put_Line(Standard_Error, "Exception raised in Sending.Send"); Put_Line(Standard_Error, "Send_Keys count = " & Integer'Image(Keys.Count(Send_Keys))); Put_Line(Standard_Error, "Send_Mode = " & Send_Modes_Text(Send_Mode)); Put_Line(Standard_Error, "Mime_Mode = " & Mime_Modes_Text(Mime_Mode)); Put_Line(Standard_Error, "My_Key = " & ToStr(My_Key_View)); Put_Line(Standard_Error, "AL count = " & Integer'Image(Attachments.Count(AL))); end; raise; end Send; end Sending; topal-80/externals-mail.ads0000644000175000017500000001451613434071426014163 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . package Externals.Mail is -- Figure out the MIME boundary by heuristic. function Find_Mime_Boundary (Infile : String) return UBS; -- Given an infile, a boundary, and a MIME file that we hope is in two -- parts, split it into the two parts procedure Split_Two_Parts (Infile : in String; Part_One : in String; Part_Two : in String; Boundary : in UBS); -- Given a file, guess the boundary, then eat write the first part -- only into the given target. See detailed notes in .adb file. procedure Get_First_Part (Infile : in String; Prolog : in String; Boundary : out UBS; Part_Hdr : in String; Part_Body : in String; Remainder : in String); -- Extract a content-type from the header of a header-body mail into a -- file. procedure Extract_Content_Type_From_Header (Email_Filename : in String; Target_Filename : in String; Ignore_Missing : in Boolean := False; Substitute : in Boolean := False); -- Ditto, for content-transfer-encoding. procedure Extract_Content_Transfer_Encoding_From_Header (Email_Filename : in String; Target_Filename : in String; Ignore_Missing : in Boolean := False; Substitute : in Boolean := False); -- Get the header from a header-body mail into a file. procedure Extract_Header (Email_Filename : in String; Target_Filename : in String); -- Get the body from a header-body mail into a file. procedure Extract_Body (Email_Filename : in String; Target_Filename : in String); procedure Delete_Trailing_Blank_Lines (Infile : in String; Outfile : in String); -- Clean up an email address in a file. procedure Clean_Email_Address (F : in String); -- Or string-to-string. function Clean_Email_Address (E : in String) return String; procedure Formail_Concat_Extract_InOut (Header : in String; Source : in String; Target : in String); procedure Formail_Drop_InOut (Header : in UBS_Array; Source : in String; Target : in String); -- Equivalent of `formail -s Action'. procedure Formail_Action_InOut (Source : in String; Target : in String; Action : in String); -- Runs formail -I Header procedure Formail_Replace_Header_InOut (Source : in String; Target : in String; Header : in String); procedure Formail_Replace_Header (File : in String; Header : in String); -- Construct a top-level 2 part MIME email. procedure Mimeconstruct2 (Part1_Filename : in String; Part2_Filename : in String; Output_Filename : in String; Content_Type : in String; Prolog : in String := ""); -- Construct a subpart of a MIME email. This is a drop-in -- replacement for an older subroutine. Content-Type is -- explicitly used. Use_Encoding => False forces it to be omitted. type Dispositions is (None, Inline, Attachment); procedure Mimeconstruct_Subpart (Infile : in String; Outfile : in String; Content_Type : in String; Dos2UnixU : in Boolean; Use_Encoding : in Boolean; Disposition : in Dispositions := None; Encoding : in String := ""; Attachment_Name : in String := ""); -- Construct an entire multipart/mixed email. procedure Mimeconstruct_Mixed (Filenames : in UBS_Array; Outfile : in String); -- View a MIME file. procedure View_MIME (F : in String; Decrypt : in Boolean); -- Base 64 decode from infile to outfile. procedure Base64_Decode (Infile, Outfile : in String); -- Quoted-printable decode from infile to outfile. procedure QP_Decode (Infile, Outfile : in String); -- Replace message-id or content-id.... procedure Replace_Message_ID(Hdrfile : in String; Alt_Sign : in String; Encrypt_Message_ID : in Boolean; Encrypt_Key : in String); procedure Replace_Content_IDs(Tmpfile : in String; Alt_Sign : in String); -- Calculate a token for an X-Topal-Send-Token header. function Calculate_Send_Token(Hdrfile : in String; Per_User_Token : in String) return String; -- Filter an email. Write an X-Topal-Check-Send-Token header, Yes or No. -- Only call this if procmail reports that the user matches (in -- From:) and that there is an X-Topal-Send-Token header. procedure Check_Send_Token(Per_User_Token : in String); -- Encrypt any X-Topal-Fcc headers and replace with X-Topal-Fcce procedure Replace_Fcc(Hdrfile : in String; Encrypt_Key : in String); -- Add an encrypted X-Topal-Bcc header if there's a Bcc header. procedure Add_Bcc(Hdrfile : in String; Encrypt_Key : in String); end Externals.Mail; topal-80/char_menus.ads0000644000175000017500000000234013434071426013352 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; generic type Index is (<>); package Char_Menus is Arrays_Not_Matched : exception; type MA is array (Index range <>) of UBS; -- Give a Menu_Array where each item contains the valid characters for -- that option. The appropriate number will be returned. Char_Words -- gives the word to display when that character is accepted. generic Accept_Chars : MA; Char_Words : MA; Default_Prompt : String := ""; function Menu (Prompt : in String := Default_Prompt) return Index; end Char_Menus; topal-80/pine-4.64.patch0000644000175000017500000001743313434071426013113 0ustar pjbpjbdiff -cr OP/pine4.64/imap/src/c-client/mail.h NP/pine4.64/imap/src/c-client/mail.h *** OP/pine4.64/imap/src/c-client/mail.h 2005-02-08 23:44:54.000000000 +0000 --- NP/pine4.64/imap/src/c-client/mail.h 2007-12-28 15:30:39.000000000 +0000 *************** *** 713,718 **** --- 713,719 ---- } size; char *md5; /* MD5 checksum */ void *sparep; /* spare pointer reserved for main program */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ }; diff -cr OP/pine4.64/pine/pine.h NP/pine4.64/pine/pine.h *** OP/pine4.64/pine/pine.h 2005-09-16 01:39:42.000000000 +0100 --- NP/pine4.64/pine/pine.h 2007-12-28 15:32:00.000000000 +0000 *************** *** 63,69 **** #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.64" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" --- 63,69 ---- #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.64T" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" diff -cr OP/pine4.64/pine/send.c NP/pine4.64/pine/send.c *** OP/pine4.64/pine/send.c 2005-09-12 23:04:25.000000000 +0100 --- NP/pine4.64/pine/send.c 2007-12-28 15:34:58.000000000 +0000 *************** *** 5254,5259 **** --- 5254,5269 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) + /* This was a single part message which Topal mangled. */ + (*body)->type = TYPETEXT; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1) + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + (*body)->nested.part->body.type = TYPETEXT; + dprint(4, (debugfile, "=== send returning ===\n")); } *************** *** 6752,6764 **** rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); ! if(nb->type == TYPETEXT ! && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); b->subtype = nb->subtype; nb->subtype = NULL; --- 6762,6774 ---- rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); ! if(nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); + b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; *************** *** 6766,6771 **** --- 6776,6783 ---- b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + if (b->type != TYPETEXT) + b->topal_hack = 1; } mail_free_body(&nb); *************** *** 9411,9427 **** dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),(long) time (0), ! (long) getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. --- 9423,9441 ---- dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (body->topal_hack != 1){ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),(long) time (0), ! (long) getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ ! } break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. *************** *** 9592,9598 **** dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 9606,9613 ---- dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 9652,9658 **** * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT && body->encoding != ENCBASE64){ gf_link_filter(gf_local_nvtnl, NULL); } --- 9667,9674 ---- * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if((body->type == TYPETEXT && body->encoding != ENCBASE64) ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)){ gf_link_filter(gf_local_nvtnl, NULL); } *************** *** 9752,9766 **** ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); --- 9768,9794 ---- ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) ! { ! if(!(so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! else ! { ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); *************** *** 9991,9997 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 10019,10026 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); topal-80/topal.adb0000644000175000017500000002564413434071426012340 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Command_Line; with Ada.Environment_Variables; with Ada.Exceptions; with Ada.Text_IO; with Configuration; with Echo; with Externals; with Externals.Mail; with Externals.Ops; with Externals.Simple; with Invocation; with Globals; use Globals; with Help; with Menus; with Misc; use Misc; with Readline; with Receiving; with Remote_Mode; with Sending; with Workaround; procedure Topal is use Invocation; Config_Warnings : Boolean; procedure Report_Config_Warnings is use Ada.Text_IO; begin if Config_Warnings then New_Line; Put_Line("There were warnings while reading your config file."); New_Line; end if; end Report_Config_Warnings; begin -- Get our PID. Our_PID := Externals.C_Get_Process_ID; -- Set defaults. Topal_Directory := ToUBS(Ada.Environment_Variables.Value("HOME") & "/.topal"); -- Load history and config. Configuration.Default_Configuration(Config); Readline.Load_History; -- .topal had better exist if we are going to read the configuration file. if Externals.Simple.Test_R(ToStr(Topal_Directory) & "/config") then Configuration.Read_Config_File(Config_Warnings); end if; -- If the topal directory exists, we chmod it appropriately. if Externals.Simple.Test_D(ToStr(Topal_Directory)) then Externals.Simple.Chmod("700", ToStr(Topal_Directory)); -- And do the same to the cache directory. if Externals.Simple.Test_D(ToStr(Topal_Directory) & "/cache") then Externals.Simple.Chmod("700", ToStr(Topal_Directory) & "/cache"); end if; end if; -- Sort out the command-line. Parse_Command_Line; case Run_Mode is when Help_Text => Disclaimer; Help.Message; when Inline_Display => Externals.Simple.Clear; Disclaimer; Report_Config_Warnings; Open_Result_File(Resultfile => ToStr(Resultfile)); Receiving.Display(Tmpfile => ToStr(Tmpfile)); when Mime_Display | Pipe_Display => Disclaimer; Receiving.Mime_Display(Infile => ToStr(Infile), Content_Type => ToStr(Content_Type)); when Old_Mime_Display => Disclaimer; Receiving.Mime_Display_APGP(Infile => ToStr(Infile), Content_Type => ToStr(Content_Type)); when Raw_Input => Disclaimer; Receiving.Process_Stdin; when Inline_Send => Externals.Simple.Clear; Disclaimer; Report_Config_Warnings; Open_Result_File(Resultfile => ToStr(Resultfile)); Sending.Send(Tmpfile => ToStr(Tmpfile), Recipients => Recipients.all); when Mime_Send => Externals.Simple.Clear; Disclaimer; Report_Config_Warnings; Open_Result_File(Resultfile => ToStr(Resultfile)); Sending.Send(Tmpfile => ToStr(Tmpfile), Mime => True, Mimefile => ToStr(Mimefile), Recipients => Recipients.all); when Actual_Send => -- Eat the input into a tempfile. declare Stdin_Name : constant String := Temp_File_Name("tmpfile"); Dummy_Mimefile : constant String := Temp_File_Name("mimefile"); begin -- Catch standard input. Externals.Simple.Cat_Stdin_Out(Stdin_Name); -- Figure out the new recipients. Recipients := Sending.Get_Recipients(Stdin_Name); -- Now we want to open /dev/tty and use that as stdin. Externals.Ops.Open_TTY; Echo.Save_Terminal; Echo.Set_Echo; Externals.Simple.Stty_Sane; -- Now show the disclaimer, etc. Externals.Simple.Clear; Disclaimer; Report_Config_Warnings; Sending.Send(Tmpfile => Stdin_Name, Mime => True, Mimefile => Dummy_Mimefile, Recipients => Recipients.all, Remaining => Remaining.all, Actual_Send => True); end; when Nonpine_Send => Disclaimer; -- Does the first object exist as a readable file? if not Externals.Simple.Test_R(ToStr(Tmpfile)) then -- We should be able to guarantee that Tmpfile is at least one -- character long, otherwise it couldn't have been recognised -- as an argument on the command line. if ToStr(Tmpfile)(1) = '-' then -- Perhaps they thought it was a command line option. Ada.Text_IO.Put_Line("`" & ToStr(Tmpfile) & "' is not recognised as either a command-line option nor a readable file."); Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); -- Fall out normally. else Error("File `" & ToStr(Tmpfile) & "' is not a readable file."); end if; else -- The file exists.... if ToStr(Tmpfile)(1) = '-' then -- Perhaps they thought it was a command line option. Ada.Text_IO.Put_Line("`" & ToStr(Tmpfile) & "' is not recognised as a command-line option, but it is a readable file. Proceeding anyway -- select `abort' if that's not what you intended."); Ada.Text_IO.New_Line; end if; Sending.Send(Tmpfile => ToStr(Tmpfile), Recipients => Recipients.all, Non_Pine => True); end if; when Remote_Send => Remote_Mode.Remote_Send(Tmpfile => ToStr(Tmpfile), Resultfile => ToStr(Invocation.Resultfile), MIME => False, Mimefile => "", Recipients => Recipients.all); when Remote_MIME_Send => Remote_Mode.Remote_Send(Tmpfile => ToStr(Tmpfile), Resultfile => ToStr(Invocation.Resultfile), MIME => True, Mimefile => ToStr(Mimefile), Recipients => Recipients.all); when Remote_Decrypt => Remote_Mode.Remote_Decrypt(Infile => ToStr(Infile), MIME => False); when Remote_Mime_Decrypt => Remote_Mode.Remote_Decrypt(Infile => ToStr(Infile), MIME => True, Content_Type => ToStr(Content_Type)); when Clear_Temp => Disclaimer; Ada.Text_IO.Put_Line("Clearing temporary files..."); Externals.Simple.Rm_Tempfiles; when Clear_Cache => Disclaimer; Ada.Text_IO.Put_Line("Clearing cache files..."); Externals.Simple.Rm_Cachefiles; when Clear_All => Disclaimer; Ada.Text_IO.Put_Line("Clearing temporary and cache files..."); Externals.Simple.Rm_Tempfiles; Externals.Simple.Rm_Cachefiles; when Dump_Default_Config => Configuration.Default_Configuration(Config); Configuration.Dump; when Dump_Current_Config => Configuration.Dump; when Interactive_Config => Disclaimer; -- Interactive configuration setting. Configuration.Edit_Configuration; when Fix_Email => Workaround.Fix_Email; when Fix_Folders => Disclaimer; Workaround.Fix_Folders(Folders => Folders.all); when Check_Send_Token => -- This is running as a filter. Externals.Mail.Check_Send_Token(ToStr(CST_Token)); Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success); when Server => Disclaimer; -- Now accept connections.... Remote_Mode.Server; end case; if not Config.Boolean_Opts(No_Clean) then Externals.Simple.Rm_Tempfiles_PID; end if; if Run_Mode /= Fix_Email and Run_Mode /= Check_Send_Token then -- Only do this with a real console. This is nasty. Echo.Set_Echo; if Run_Mode = Actual_Send then Echo.Restore_Terminal; end if; end if; Close_Debug; Readline.Save_History; Close_Result_File; exception when Externals.System_Abort_By_User | Misc.User_Interrupt => -- Just clean up. Close_Debug; Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); Echo.Set_Echo; Externals.Simple.Stty_Sane; if Run_Mode = Actual_Send then Echo.Restore_Terminal; end if; if not Config.Boolean_Opts(No_Clean) then Externals.Simple.Rm_Tempfiles_PID; end if; Readline.Save_History; when The_Exception : others => declare use Ada.Exceptions; use Ada.Text_IO; begin New_Line(3); Put_Line(Standard_Error, Do_SGR(Config.UBS_Opts(Colour_Important)) & "EXCEPTION! Oops." & Reset_SGR); -- Dump info. if Is_Open(Result_File) then Put_Line(Result_File, "Exception raised: " & Exception_Name(The_Exception)); Close(Result_File); end if; Put_Line(Standard_Error, "Exception raised: " & Exception_Name(The_Exception)); Put_Line(Standard_Error, Exception_Information(The_Exception)); New_Line; Put("Command line:"); for I in 1..Ada.Command_Line.Argument_Count loop Put(" " & Ada.Command_Line.Argument(I)); end loop; New_Line(2); Put_Line(Standard_Error, "This is not good: please send a bug report with the information above to " &NL& "p.j.brooke@bcs.org.uk (unless it was caused by ctrl-c when GPG was" &NL& "running). Tell me *exactly* what you were doing when it crashed." &NL& "Thank you!" ); end; Close_Debug; Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); -- Try to pause.... Menus.Wait; -- Clean up terminal settings. Echo.Set_Echo; Externals.Simple.Stty_Sane; if Run_Mode = Actual_Send then Echo.Restore_Terminal; end if; if not Config.Boolean_Opts(No_Clean) then Externals.Simple.Rm_Tempfiles_PID; end if; Readline.Save_History; end Topal; topal-80/sending.ads0000644000175000017500000000333013434071426012655 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Sending is -- We want to send a message. procedure Send (Tmpfile : in String; Recipients : in UBS_Array; Remaining : in UBS_Array := UBS_Array'(1..0 => ToUBS("")); Non_Pine : in Boolean := False; Mime : in Boolean := False; Mimefile : in String := ""; Actual_Send : in Boolean := False); -- Make sure the user really wants to send this. procedure Check_Send (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean := False; Send_Comment : in String := ""); -- Pre-processing for the sendmail-path filter. -- We assume that Tmpfile contains both header & body. function Get_Recipients (Tmpfile : String) return UBS_Array_Pointer; end Sending; topal-80/alpine-2.02.patch-10000644000175000017500000004071713434071426013555 0ustar pjbpjbdiff -cr alpine-2.02-orig/alpine/send.c alpine-2.02-p1/alpine/send.c *** alpine-2.02-orig/alpine/send.c 2010-10-02 09:37:57.000000000 +0100 --- alpine-2.02-p1/alpine/send.c 2011-03-23 21:06:47.000000000 +0000 *************** *** 4039,4044 **** --- 4039,4061 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + /* Topal: Unmangle the body types. */ + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) { + /* This was a single part message which Topal mangled. */ + dprint((9, "Topal: unmangling single part message\n")); + (*body)->type = TYPETEXT; + } + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1 + && (*body)->nested.part->body.type == TYPEMULTIPART + && (*body)->nested.part->body.topal_hack == 1) { + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + dprint((9, "Topal: unmangling first part of multipart message\n")); + (*body)->nested.part->body.type = TYPETEXT; + } + dprint((4, "=== send returning ===\n")); } *************** *** 5365,5386 **** rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); if(nb->type == TYPETEXT && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ ! if(b->subtype) ! fs_give((void **) &b->subtype); ! b->subtype = nb->subtype; nb->subtype = NULL; ! mail_free_body_parameter(&b->parameter); b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); } ! mail_free_body(&nb); } --- 5382,5431 ---- rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); + /* Topal: We're working on the first + text segment of the message. If + the filter returns something that + isn't TYPETEXT, then we need to + pretend (later on) that this is in + fact a TYPETEXT, because Topal has + already encoded it.... + + Original code path first, then an + alternate path. + */ if(nb->type == TYPETEXT && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ ! if(b->subtype) ! fs_give((void **) &b->subtype); ! ! b->subtype = nb->subtype; ! nb->subtype = NULL; ! ! mail_free_body_parameter(&b->parameter); ! b->parameter = nb->parameter; ! nb->parameter = NULL; ! mail_free_body_parameter(&nb->parameter); ! } ! else if(F_ON(F_ENABLE_TOPAL_HACK, ps_global)){ ! /* Perhaps the type isn't TYPETEXT, ! and the hack is requested. So, ! let's mess with the types. */ ! if(nb->type != TYPETEXT){ ! b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; ! ! dprint((9, "Topal: mangling body!\n")); mail_free_body_parameter(&b->parameter); b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + b->topal_hack = 1; + } } ! /* Topal: end */ mail_free_body(&nb); } diff -cr alpine-2.02-orig/imap/src/c-client/mail.h alpine-2.02-p1/imap/src/c-client/mail.h *** alpine-2.02-orig/imap/src/c-client/mail.h 2010-10-02 09:37:57.000000000 +0100 --- alpine-2.02-p1/imap/src/c-client/mail.h 2011-03-23 21:06:47.000000000 +0000 *************** *** 775,780 **** --- 775,781 ---- unsigned long bytes; /* size of text in octets */ } size; char *md5; /* MD5 checksum */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ void *sparep; /* spare pointer reserved for main program */ }; diff -cr alpine-2.02-orig/pith/conf.c alpine-2.02-p1/pith/conf.c *** alpine-2.02-orig/pith/conf.c 2010-10-02 09:37:57.000000000 +0100 --- alpine-2.02-p1/pith/conf.c 2011-03-23 21:06:47.000000000 +0000 *************** *** 2831,2836 **** --- 2831,2838 ---- F_SEND_WO_CONFIRM, h_config_send_wo_confirm, PREF_SEND, 0}, {"strip-whitespace-before-send", "Strip Whitespace Before Sending", F_STRIP_WS_BEFORE_SEND, h_config_strip_ws_before_send, PREF_SEND, 0}, + {"enable-topal-hack", "Enable Topal hack for OpenPGP/MIME messages", + F_ENABLE_TOPAL_HACK, h_config_enable_topal_hack, PREF_HIDDEN, 0}, {"warn-if-blank-fcc", "Warn if Blank Fcc", F_WARN_ABOUT_NO_FCC, h_config_warn_if_fcc_blank, PREF_SEND, 0}, {"warn-if-blank-subject", "Warn if Blank Subject", Only in alpine-2.02-p1/pith: conf.c.orig diff -cr alpine-2.02-orig/pith/conftype.h alpine-2.02-p1/pith/conftype.h *** alpine-2.02-orig/pith/conftype.h 2010-10-02 09:37:57.000000000 +0100 --- alpine-2.02-p1/pith/conftype.h 2011-03-23 21:06:47.000000000 +0000 *************** *** 503,508 **** --- 503,509 ---- F_MARK_FCC_SEEN, F_MULNEWSRC_HOSTNAMES_AS_TYPED, F_STRIP_WS_BEFORE_SEND, + F_ENABLE_TOPAL_HACK, F_QUELL_FLOWED_TEXT, F_COMPOSE_ALWAYS_DOWNGRADE, F_SORT_DEFAULT_FCC_ALPHA, diff -cr alpine-2.02-orig/pith/pine.hlp alpine-2.02-p1/pith/pine.hlp *** alpine-2.02-orig/pith/pine.hlp 2010-10-02 09:37:57.000000000 +0100 --- alpine-2.02-p1/pith/pine.hlp 2011-03-23 21:06:47.000000000 +0000 *************** *** 3285,3291 ****

  • FEATURE:
  • FEATURE:
  • FEATURE: !
  • FEATURE:
  • FEATURE:
  • FEATURE:
  • FEATURE: --- 3285,3292 ----
  • FEATURE:
  • FEATURE:
  • FEATURE: !
  • FEATURE: !
  • FEATURE:
  • FEATURE:
  • FEATURE:
  • FEATURE: *************** *** 28413,28418 **** --- 28414,28434 ----

    <End of help on this topic> + + ====== h_config_enable_topal_hack ===== + + + FEATURE: <!--#echo var="FEAT_enable-topal-hack"--> + + +

    FEATURE:

    +

    + This feature allows Topal (and other sending-filters) to change the + MIME type of the email. This is potentially dangerous because it + pretends that multipart emails are plain emails. +

    + <End of help on this topic> + ====== h_config_del_from_dot ===== Only in alpine-2.02-p1/pith: pine.hlp.orig diff -cr alpine-2.02-orig/pith/send.c alpine-2.02-p1/pith/send.c *** alpine-2.02-orig/pith/send.c 2010-10-02 09:37:57.000000000 +0100 --- alpine-2.02-p1/pith/send.c 2011-03-23 21:06:47.000000000 +0000 *************** *** 107,113 **** int l_flush_net(int); int l_putc(int); int pine_write_header_line(char *, char *, STORE_S *); ! int pine_write_params(PARAMETER *, STORE_S *); char *tidy_smtp_mess(char *, char *, char *, size_t); int lmc_body_header_line(char *, int); int lmc_body_header_finish(void); --- 107,113 ---- int l_flush_net(int); int l_putc(int); int pine_write_header_line(char *, char *, STORE_S *); ! int pine_write_params(PARAMETER *, STORE_S *, BODY *); char *tidy_smtp_mess(char *, char *, char *, size_t); int lmc_body_header_line(char *, int); int lmc_body_header_finish(void); *************** *** 1783,1789 **** --- 1783,1791 ---- /* set up counts and such to keep track sent percentage */ send_bytes_sent = 0; gf_filter_init(); /* zero piped byte count, 'n */ + dprint((1, "Topal: HERE 1!\n")); send_bytes_to_send = send_body_size(body); /* count body bytes */ + dprint((1, "Topal: HERE 2!\n")); ps_global->c_client_error[0] = error_buf[0] = '\0'; we_cancel = busy_cue(_("Sending mail"), send_bytes_to_send ? sent_percent : NULL, 0); *************** *** 1800,1805 **** --- 1802,1810 ---- #endif + dprint((1, "Topal: HERE 3!\n")); + + /* * If the user's asked for it, and we find that the first text * part (attachments all get b64'd) is non-7bit, ask for 8BITMIME. *************** *** 1807,1812 **** --- 1812,1818 ---- if(F_ON(F_ENABLE_8BIT, ps_global) && (bp = first_text_8bit(body))) smtp_opts |= SOP_8BITMIME; + dprint((1, "Topal: HERE 3.1!\n")); #ifdef DEBUG #ifndef DEBUGJOURNAL if(debug > 5 || (flags & CM_VERBOSE)) *************** *** 1870,1886 **** --- 1876,1896 ---- } } + dprint((1, "Topal: HERE 4!\n")); + /* * Install our rfc822 output routine */ sending_hooks.rfc822_out = mail_parameters(NULL, GET_RFC822OUTPUT, NULL); (void)mail_parameters(NULL, SET_RFC822OUTPUT, (void *)post_rfc822_output); + dprint((1, "Topal: HERE 5!\n")); /* * Allow for verbose posting */ (void) mail_parameters(NULL, SET_SMTPVERBOSE, (void *) pine_smtp_verbose_out); + dprint((1, "Topal: HERE 6!\n")); /* * We do this because we want mm_log to put the error message into *************** *** 1924,1929 **** --- 1934,1940 ---- ps_global->noshow_error = 0; + dprint((1, "Topal: HERE 7!\n")); TIME_STAMP("smtp open", 1); if(sending_stream){ unsigned short save_encoding, added_encoding; *************** *** 2505,2513 **** BODY * first_text_8bit(struct mail_bodystruct *body) { ! if(body->type == TYPEMULTIPART) /* advance to first contained part */ body = &body->nested.part->body; return((body->type == TYPETEXT && body->encoding != ENC7BIT) ? body : NULL); } --- 2516,2527 ---- BODY * first_text_8bit(struct mail_bodystruct *body) { ! /* Be careful of Topal changes... */ ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) /* advance to first contained part */ body = &body->nested.part->body; + /* Topal: this bit might not be correct, now. */ return((body->type == TYPETEXT && body->encoding != ENC7BIT) ? body : NULL); } *************** *** 2880,2885 **** --- 2894,2900 ---- char *freethis; case TYPEMULTIPART: /* multi-part */ + if (body->topal_hack != 1) { /* But only if Topal hasn't touched it! */ if(!(freethis=parameter_val(body->parameter, "BOUNDARY"))){ char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ *************** *** 2895,2900 **** --- 2910,2916 ---- part = body->nested.part; /* encode body parts */ do pine_encode_body (&part->body); while ((part = part->next) != NULL); /* until done */ + } break; case TYPETEXT : *************** *** 4253,4259 **** dprint((4, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 4269,4277 ---- dprint((4, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling, ! unless Topal messed with it */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 4343,4352 **** * BEFORE applying any encoding (rfc1341: appendix G)... * NOTE: almost all filters expect CRLF newlines */ ! if(body->type == TYPETEXT ! && body->encoding != ENCBASE64 && !so_attr((STORE_S *) body->contents.text.data, "rawbody", NULL)){ ! gf_link_filter(gf_local_nvtnl, NULL); } switch (body->encoding) { /* all else needs filtering */ --- 4361,4374 ---- * BEFORE applying any encoding (rfc1341: appendix G)... * NOTE: almost all filters expect CRLF newlines */ ! if(((body->type == TYPETEXT ! && body->encoding != ENCBASE64) ! /* Or if Topal mucked with it... */ ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)) && !so_attr((STORE_S *) body->contents.text.data, "rawbody", NULL)){ ! if(body->topal_hack == 1) ! dprint((9, "Topal: Canonical conversion, although Topal has mangled...\n")); ! gf_link_filter(gf_local_nvtnl, NULL); } switch (body->encoding) { /* all else needs filtering */ *************** *** 4448,4454 **** return(pwbh_finish(0, so)); if(body->parameter){ ! if(!pine_write_params(body->parameter, so)) return(pwbh_finish(0, so)); } else if(!so_puts(so, "; CHARSET=US-ASCII")) --- 4470,4476 ---- return(pwbh_finish(0, so)); if(body->parameter){ ! if(!pine_write_params(body->parameter, so, body)) return(pwbh_finish(0, so)); } else if(!so_puts(so, "; CHARSET=US-ASCII")) *************** *** 4527,4533 **** && so_puts(so, body->disposition.type))) return(pwbh_finish(0, so)); ! if(!pine_write_params(body->disposition.parameter, so)) return(pwbh_finish(0, so)); if(!so_puts(so, "\015\012")) --- 4549,4555 ---- && so_puts(so, body->disposition.type))) return(pwbh_finish(0, so)); ! if(!pine_write_params(body->disposition.parameter, so, body)) return(pwbh_finish(0, so)); if(!so_puts(so, "\015\012")) *************** *** 4589,4595 **** * pine_write_param - convert, encode and write MIME header-field parameters */ int ! pine_write_params(PARAMETER *param, STORE_S *so) { for(; param; param = param->next){ int rv; --- 4611,4617 ---- * pine_write_param - convert, encode and write MIME header-field parameters */ int ! pine_write_params(PARAMETER *param, STORE_S *so, BODY *body) { for(; param; param = param->next){ int rv; *************** *** 4598,4606 **** cs = posting_characterset(param->value, NULL, HdrText); cv = utf8_to_charset(param->value, cs, 0); ! rv = (so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! if(cv && cv != param->value) fs_give((void **) &cv); --- 4620,4636 ---- cs = posting_characterset(param->value, NULL, HdrText); cv = utf8_to_charset(param->value, cs, 0); ! if (body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) { ! /* Did Topal introduce more parameters? */ ! dprint((9, "Topal: parameter encoding of protocol, with Topal hack\n")); ! rv = (so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! } ! else ! rv = (so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! if(cv && cv != param->value) fs_give((void **) &cv); *************** *** 4707,4713 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 4737,4745 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling ! but again, be careful of Topal */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); Only in alpine-2.02-p1/pith: send.c.orig topal-80/misc.adb0000644000175000017500000006077413434071426012157 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Characters.Handling; with Ada.Characters.Latin_1; with Ada.Command_Line; with Ada.Directories; with Ada.Integer_Text_IO; with Ada.Interrupts; with Ada.Interrupts.Names; with Ada.IO_Exceptions; with Ada.Strings; with Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; with Externals.Simple; with Help; with Version_ID; package body Misc is -- Two subprograms to make writing strings easier. procedure Character_IO_Put (F : in Character_IO.File_Type; S : in String) is begin for I in S'First..S'Last loop Character_IO.Write(F, S(I)); end loop; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Character_IO_Put"); raise; end Character_IO_Put; -- Two subprograms to make writing strings easier. procedure Character_IO_Put_Line (F : in Character_IO.File_Type; S : in String) is begin Character_IO_Put(F, S); Character_IO.Write(F, Ada.Characters.Latin_1.LF); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Character_IO_Put_Line"); raise; end Character_IO_Put_Line; -- How to handle errors and debugging. procedure Error (The_Error : in String) is begin if Ada.Text_IO.Is_Open(Result_File) then Ada.Text_IO.Put_Line(Result_File, "Topal: Fatal error: " & The_Error); end if; Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, Do_SGR(Config.UBS_Opts(Colour_Important)) & "Topal: Fatal error: " & The_Error & Reset_SGR); raise Panic with The_Error; end Error; procedure ErrorNE (The_Error : in String) is begin if Ada.Text_IO.Is_Open(Result_File) then Ada.Text_IO.Put_Line(Result_File, "Topal: Error: " & The_Error); end if; Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Topal: Error: " & The_Error); end ErrorNE; Debug_File : Ada.Text_IO.File_Type; Dont_Open_Debug : Boolean := False; procedure Debug (Message : in String) is use Ada.Text_IO; Debug_Name : constant String := ToStr(Topal_Directory) & "/debug"; begin if Config.Boolean_Opts(Debug) then if Is_Open(Result_File) then Put_Line(Result_File, "Topal: Debug: " & Message); end if; if not Inhibit_Stderr then Put_Line(Standard_Error, "Topal: Debug: " & Message); end if; -- Is the debugging file open? if (not Is_Open(Debug_File)) and (not Dont_Open_Debug) then if Ada.Directories.Exists(Debug_Name) then Open(File => Debug_File, Mode => Append_File, Name => Debug_Name); else Create(File => Debug_File, Mode => Out_File, Name => Debug_Name); end if; Put_Line(Debug_File, "Starting, PID " & Integer'Image(Our_PID)); end if; if Is_Open(Debug_File) then Put_Line(Debug_File, Message); end if; end if; end Debug; procedure Close_Debug is use Ada.Text_IO; begin Dont_Open_Debug := True; if Is_Open(Debug_File) then Put_Line(Debug_File, "Closing, PID " & Integer'Image(Our_PID)); New_Line(Debug_File); Close(Debug_File); end if; end Close_Debug; -- Strings to integers. function String_To_Integer (S : String) return Integer is use Ada.Integer_Text_IO; use Ada.IO_Exceptions; L : Positive; N : Integer; begin Get(S, N, L); return N; exception when Data_Error => raise String_Not_Integer; when End_Error => raise String_Not_Integer; when others => Ada.Text_IO.Put_Line("*** Problem in String_To_Integer. ***"); raise; end String_To_Integer; function String_To_Integer (S : UBS) return Integer is begin return String_To_Integer(ToStr(S)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.String_To_Integer (B)"); raise; end String_To_Integer; -- Zero pad to a length. function Zero_Pad (S : String; L : Positive) return String is begin if S'Length >= L then return S; else return Ada.Strings.Fixed."*"(L - S'Length, '0') & S; end if; end Zero_Pad; -- Throw away leading blanks from a string. function Trim_Leading_Spaces (S : String) return String is use Ada.Strings.Fixed; begin if S'Length = 0 then return S; else return S(Ada.Strings.Fixed.Index_Non_Blank(S)..S'Last); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Trim_Leading_Spaces"); raise; end Trim_Leading_Spaces; function EqualCI (A, B : String) return Boolean is use Ada.Strings.Fixed, Ada.Strings.Maps.Constants; begin return Translate(A, Lower_Case_Map) = Translate(B, Lower_Case_Map); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.EqualCI (A)"); raise; end EqualCI; function EqualCI (A, B : UBS) return Boolean is begin return EqualCI(ToStr(A), ToStr(B)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.EqualCI (B)"); raise; end EqualCI; function EqualCI (A : String; B : UBS) return Boolean is begin return EqualCI(A, ToStr(B)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.EqualCI (C)"); raise; end EqualCI; function EqualCI (A : UBS; B : String) return Boolean is begin return EqualCI(ToStr(A), B); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.EqualCI (D)"); raise; end EqualCI; -- Create our own temporary file names. To prevent collisions when -- the same Tail is used, we'll also insert a sequence number. Temp_File_Sequence_Number : Natural := 0; function Temp_File_Name (Tail : String; Use_Sequence_Number : Boolean := True) return String is begin -- If Topal_Directory doesn't exist, we'll create it. if not Externals.Simple.Test_D(ToStr(Topal_Directory)) then Externals.Simple.Mkdir_P(ToStr(Topal_Directory)); end if; if Use_Sequence_Number then Temp_File_Sequence_Number := Temp_File_Sequence_Number + 1; return ToStr(Topal_Directory) & "/temp-" & Trim_Leading_Spaces(Integer'Image(Our_PID)) & "-" & Zero_Pad(Trim_Leading_Spaces(Integer'Image(Temp_File_Sequence_Number)), 3) & "-" & Tail; else return ToStr(Topal_Directory) & "/temp-" & Trim_Leading_Spaces(Integer'Image(Our_PID)) & "-" & Tail; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Temp_File_Name"); raise; end Temp_File_Name; -- An `unbounded' Get_Line. function Unbounded_Get_Line (File : in Ada.Text_IO.File_Type) return UBS is use Ada.Text_IO; function More_Input return UBS is Input : String (1 .. 1024); Last : Natural; use type UBS; begin Get_Line(File, Input, Last); if Last < Input'Last then return ToUBS(Input(1..Last)); else return ToUBS(Input(1..Last)) & More_Input; end if; end More_Input; begin return More_Input; exception when Ada.IO_Exceptions.End_Error => -- Just let it through and let the caller sort it out. raise; when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Unbounded_Get_Line (A)"); raise; end Unbounded_Get_Line; function Unbounded_Get_Line return UBS is begin return Unbounded_Get_Line(Ada.Text_IO.Standard_Input); exception when Ada.IO_Exceptions.End_Error => -- Just let it through and let the caller sort it out. raise; when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Unbounded_Get_Line (B)"); raise; end Unbounded_Get_Line; -- Eat and fold an entire file. function Read_Fold (File : in String; Include_LF : in Boolean := False) return UBS is F : Ada.Text_IO.File_Type; U : UBS := NullUBS; Do_LF : Boolean := False; begin Debug("Opening file `" & File & "' for folded read into variable"); Ada.Text_IO.Open(File => F, Mode => Ada.Text_IO.In_File, Name => File); Read_Loop: loop declare use type UBS; begin U := U & Unbounded_Get_Line(F); -- End_Error might kick us out before appending the LF. if Do_LF then U := U & Ada.Characters.Latin_1.LF; Do_LF := False; end if; if Include_LF then Do_LF := True; end if; exception when Ada.IO_Exceptions.End_Error => exit Read_Loop; -- Okay. end; end loop Read_Loop; Ada.Text_IO.Close(File => F); return U; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Read_Fold"); raise; end Read_Fold; -- Open and close the result file. procedure Open_Result_File (Resultfile : in String) is begin Debug("Creating result file with name `" & Resultfile & "'"); Ada.Text_IO.Create(File => Result_File, Mode => Ada.Text_IO.Append_File, Name => Resultfile); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Open_Result_File"); raise; end Open_Result_File; procedure Close_Result_File is begin if Ada.Text_IO.Is_Open(Result_File) then Ada.Text_IO.Close(Result_File); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Close_Result_File"); raise; end Close_Result_File; procedure Disclaimer is use Ada.Text_IO; begin Put_Line(Do_SGR(Config.UBS_Opts(Colour_Banner)) & "Topal " & Version_ID.Release & " (" & Version_ID.Build_Date & ")"); Put_Line("Copyright (C) 2001--2018 Phillip J. Brooke" & Reset_SGR); Help.Disclaimer; New_Line; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Disclaimer"); raise; end Disclaimer; function Value_Nonempty (V : in UBS) return UBS is begin if ToStr(V) = "" then raise Need_Nonempty_String; end if; return V; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Value_Nonempty (A)"); raise; end Value_Nonempty; function Value_Nonempty (V : UBS) return String is begin return ToStr(Value_Nonempty(V)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Value_Nonempty (B)"); raise; end Value_Nonempty; -- Given a string, A, we want to split it up. Really, we would -- like to properly honour bash-style quoting. -- At the moment, we'll simply do a space-separated run. -- Then added `stuffing'. `"' will group things as an argument (i.e., stop the -- search). `"' can be included literally by stuffing: `""'. function Split_Arguments (A : UBS) return UBS_Array is BA : UVV; AS : constant String := ToStr(A); -- Recurse: -- Given a string, extract one token from it. -- Then recurse with the rest of the string. procedure Grab_Next_Token (A : in String) is I : Natural; No_More : Boolean := False; T : UBS; Quoted : Boolean := False; use type UBS; begin Debug("Grab_Next_Token invoked with `" & A & "'"); -- Only do this if we're actually been given something. if A'Length /= 0 then -- Find first non-blank. I := A'First; Start_Loop: loop if A(I) = ' ' then -- Advance. I := I + 1; -- Check for termination without finding new token. if I > A'Last then No_More := True; exit Start_Loop; end if; else -- Start of a new token. exit Start_Loop; end if; end loop Start_Loop; if not No_More then -- Copy character by character until we find a space (unless -- we're quoted!). Copy_Loop: loop if I > A'Last then exit Copy_Loop; elsif (not Quoted) and then A(I) = ' ' then I := I + 1; -- Finished. exit Copy_Loop; elsif A(I) = '"' then -- If the next character is a ", then copy just one. -- Otherwise, toggle Quoted. if I + 1 <= A'Last and then A(I + 1) = '"' then -- Literal copy of ". T := T & '"'; I := I + 2; else I := I + 1; Quoted := not Quoted; end if; else T := T & A(I); I := I + 1; end if; end loop Copy_Loop; -- Trap silliness. if Quoted then Error("Misc.Split_Arguments.Grab_Next_Token: String `" & A & "' ended inside `""'."); end if; -- Finished. BA.Append(T); -- Recurse. Grab_Next_Token(A(I .. A'Last)); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Split_Arguments.Grab_Next_Token"); raise; end Grab_Next_Token; begin Debug("Split_Arguments invoked with `" & AS & "'"); BA := UVP.Empty_Vector; Grab_Next_Token(AS); declare RA : UBS_Array(0..Integer(BA.Length)-1); begin for I in 1 .. Integer(BA.Length) loop RA(I-1) := BA.Element(I); end loop; return RA; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Split_Arguments"); raise; end Split_Arguments; function Split_GPG_Colons (AS : String) return UBS_Array is CC : Natural; use Ada.Strings.Fixed; begin Debug("Split_GPG_Colons invoked with `" & AS & "'"); -- Count the number of colons. CC := Count(AS, ":"); declare RA : UBS_Array(0..CC); L, R : Natural; begin L := AS'First; for I in 0 .. CC loop -- Find the next right point. -- If we're working on the last entry, we don't find a colon. if I = CC then R := AS'Last; else R := Index(AS(L..AS'Last), ":") - 1; end if; -- Copy the entry... RA(I) := ToUBS(AS(L..R)); -- Update L. L := R + 2; end loop; return RA; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Split_GPG_Colons"); raise; end Split_GPG_Colons; function UPC (A, B : String) return UP is begin return UP'(ToUBS(A),ToUBS(B)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.UPC"); raise; end UPC; function UPC (A, B : UBS) return UP is begin return UP'(A, B); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.UPC"); raise; end UPC; -- Get the basename of a filename. function Basename (S : String) return String is -- Index of last (if any) `/'. I : Integer; begin I := Ada.Strings.Fixed.Index(Source => S, Pattern => "/", Going => Ada.Strings.Backward); if I = 0 then -- Already a basename. return S; else return S(I + 1 .. S'Last); end if; end Basename; -- Basename. function Command_Basename return String is begin return Basename(Ada.Command_Line.Command_Name); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Command_Line_Wrapper.Command_Basename"); raise; end Command_Basename; -- Turn hexadecimal string into value. function Hex_Decode (S : in String) return Natural is V : Natural := 0; begin for I in S'Range loop V := V * 16; if S(I) in '0'..'9' then V := V + Character'Pos(S(I)) - Character'Pos('0'); elsif S(I) in 'A' .. 'F' then V := V + Character'Pos(S(I)) - Character'Pos('A') + 10; elsif S(I) in 'a' .. 'f' then V := V + Character'Pos(S(I)) - Character'Pos('a') + 10; else raise Constraint_Error; end if; end loop; return V; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Hex_Decode"); raise; end Hex_Decode; -- Have we got base64 or binary? -- Test if an SMIME input is likely to be base64 or binary. We -- need this because we can't easily pass the correct -- content-transfer-encoding (yet). If Pine receives from -- Thunderbird or Outlook (for example), we are given binary. If -- it's Topal sending, then it's possibly base64. function Guess_SMIME_Encoding(Infile : String) return String is F : Character_IO.File_Type; C : Character; Limit : constant Positive := 1000; N : Natural := 0; AllB64 : Boolean := True; use Ada.Characters.Handling; use Character_IO; begin -- Open the file indicated by Infile. Read the characters. If -- any are outside the usual range for base64, return an empty -- string. If all are in that range, return "--assume-base64". Open(File => F, Mode => In_File, Name => Infile); Read_Loop: loop exit Read_Loop when End_Of_File(F); Read(F, C); N := N + 1; if not (C = ' ' or else C = Ada.Characters.Latin_1.LF or else C = Ada.Characters.Latin_1.CR or else Is_Letter(C) or else Is_Digit(C) or else C = '+' or else C = '/' or else C = '=') then AllB64 := False; exit Read_Loop; end if; exit Read_Loop when N >= Limit; end loop Read_Loop; if AllB64 then return "--assume-base64"; else return ""; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Guess_SMIME_Encoding"); raise; end Guess_SMIME_Encoding; function UGA_Str (Signing : Boolean) return String is T : Positive; begin if Signing then T := 3; else T := 2; end if; if Config.Positive_Opts(Use_Agent) >= T then return "--use-agent"; else return "--no-use-agent"; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.UGA_Str"); raise; end UGA_Str; function Use_ANSI (S : String) return String is begin if Config.Boolean_Opts(ANSI_Terminal) then return S; else return ""; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Use_ANSI"); raise; end Use_ANSI; function Do_SGR (S : String) return String is begin return Use_ANSI(ANSI_CSI & S & ANSI_SGR); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Do_SGR (A)"); raise; end Do_SGR; function Do_SGR (U : UBS) return String is begin return Do_SGR(ToStr(U)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Do_SGR (B)"); raise; end Do_SGR; function Reset_SGR return String is begin return Use_ANSI(ANSI_SGR_Reset); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Reset_SGR"); raise; end Reset_SGR; -- Rewrite a prompt. function Rewrite_Menu_Prompt (S : String) return String is U : UBS; use type UBS; begin for I in S'Range loop if S(I) = '{' then U := U & Do_SGR(Config.UBS_Opts(Colour_Menu_Key)) & "["; elsif S(I) = '}' then U := U & "]" & Reset_SGR; else U := U & S(I); end if; end loop; return ToStr(U); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Rewrite_Menu_Prompt"); raise; end Rewrite_Menu_Prompt; -- Handle signals. Default_Sigint_Handler : Ada.Interrupts.Parameterless_Handler; pragma Unreferenced(Default_Sigint_Handler); protected body Signal_Handlers is procedure Sigint_Handler is begin Ada.Text_IO.Put_Line("User interrupt!"); Sigint_Pending_Flag := True; raise User_Interrupt; end Sigint_Handler; function Sigint_Pending return Boolean is begin return Sigint_Pending_Flag; end Sigint_Pending; end Signal_Handlers; procedure Set_Sigint_Handler is begin Ada.Interrupts.Attach_Handler(Signal_Handlers.Sigint_Handler'Access, Ada.Interrupts.Names.SIGINT); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Misc.Set_Sigint_Handler"); raise; end Set_Sigint_Handler; begin Default_Sigint_Handler := Ada.Interrupts.Current_Handler(Ada.Interrupts.Names.SIGINT); end Misc; topal-80/pine-4.53.patch0000644000175000017500000001716613434071426013114 0ustar pjbpjbOnly in pine4.53: .bld.hlp Only in pine4.53: bin diff -cr OP/pine4.53/imap/src/c-client/mail.h pine4.53/imap/src/c-client/mail.h *** OP/pine4.53/imap/src/c-client/mail.h Tue Jan 7 20:33:50 2003 --- pine4.53/imap/src/c-client/mail.h Sat Feb 15 19:04:55 2003 *************** *** 655,660 **** --- 655,661 ---- unsigned long bytes; /* size of text in octets */ } size; char *md5; /* MD5 checksum */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ }; Only in pine4.53/pine: date.c diff -cr OP/pine4.53/pine/pine.h pine4.53/pine/pine.h *** OP/pine4.53/pine/pine.h Fri Jan 10 23:25:55 2003 --- pine4.53/pine/pine.h Sat Feb 15 19:06:14 2003 *************** *** 63,69 **** #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.53" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" --- 63,69 ---- #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.53T" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" diff -cr OP/pine4.53/pine/send.c pine4.53/pine/send.c *** OP/pine4.53/pine/send.c Tue Jan 14 21:22:59 2003 --- pine4.53/pine/send.c Sat Feb 15 19:04:55 2003 *************** *** 4881,4886 **** --- 4881,4896 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) + /* This was a single part message which Topal mangled. */ + (*body)->type = TYPETEXT; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1) + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + (*body)->nested.part->body.type = TYPETEXT; + dprint(4, (debugfile, "=== send returning ===\n")); } *************** *** 6193,6205 **** ; rfc822_parse_content_header(nb,ucase(buf+8),s); ! if(nb->type == TYPETEXT ! && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); b->subtype = nb->subtype; nb->subtype = NULL; --- 6203,6215 ---- ; rfc822_parse_content_header(nb,ucase(buf+8),s); ! if(nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); + b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; *************** *** 6207,6212 **** --- 6217,6224 ---- b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + if (b->type != TYPETEXT) + b->topal_hack = 1; } mail_free_body(&nb); *************** *** 8721,8737 **** dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. --- 8733,8751 ---- dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (body->topal_hack != 1){ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ ! } break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. *************** *** 8901,8907 **** dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 8915,8922 ---- dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 8961,8967 **** * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT){ gf_link_filter(gf_local_nvtnl, NULL); } --- 8976,8983 ---- * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)){ gf_link_filter(gf_local_nvtnl, NULL); } *************** *** 9070,9084 **** ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); --- 9086,9112 ---- ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) ! { ! if(!(so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! else ! { ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); *************** *** 9336,9342 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 9364,9371 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); topal-80/attachments.ads0000644000175000017500000000407213434071426013545 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Attachments is type Attachment_List is limited private; Attachment_Not_Found : exception; -- Add an attachment to the list.... procedure Add_Attachment (Filename : in UBS; List : in out Attachment_List); -- Remove an attachment. We then shuffle the array down. -- It will only remove the last attachment if there are multiple instances. procedure Remove_Attachment (Filename : in UBS; List : in out Attachment_List); -- List the attachments and edit them as appropriate (include removing an -- attachment or adding a new one. procedure List (List : in out Attachment_List); procedure Empty_Attachment_List (List : in out Attachment_List); function Count (List : in Attachment_List) return Natural; -- This function takes the original Tmpfile, and (in the case of a -- non-empty attachment list) replaces it with a multipart/mixed -- structure. The attachments in List are base64 armoured. We -- assume that Tmpfile has already been appropriately -- processed.... This is safe to call if List is empty. procedure Replace_Tmpfile (Tmpfile : in String; List : in Attachment_List); private type Attachment_List is record AA : UVV; end record; end Attachments; topal-80/externals-gpg.adb0000644000175000017500000006606113434071426013777 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Text_IO; with Externals.Mail; with Externals.Simple; with Menus; with Misc; use Misc; package body Externals.GPG is type G_Modes is (OpenPGP, OPsend, OPreceive, S_MIME); function G_Command(GM : G_Modes) return UBS is begin case GM is when OpenPGP | OPsend | OPreceive => return Value_Nonempty(Config.Binary(GPGOP)); when S_MIME => return Value_Nonempty(Config.Binary(GPGSM)); end case; end G_Command; function G_Command(GM : G_Modes) return String is begin return ToStr(G_Command(GM)); end G_Command; function G_Name(GM : G_Modes) return String is begin case GM is when OpenPGP | OPsend | OPreceive => return "gpg"; when S_MIME => return "gpgsm"; end case; end G_Name; -- No need for the G_Name ... return UBS variant. Omitted. function G_Options(GM : G_Modes) return UBS is use type UBS; begin case GM is when S_MIME => return Config.UBS_Opts(GPGSM_Options); when OpenPGP => return Config.UBS_Opts(Gpg_Options); when OPsend => return Config.UBS_Opts(Sending_Options) & " " & Config.UBS_Opts(General_Options) & " " & Config.UBS_Opts(Gpg_Options); when OPreceive => return Config.UBS_Opts(Receiving_Options) & " " & Config.UBS_Opts(General_Options) & " " & Config.UBS_Opts(Gpg_Options); end case; end G_Options; function G_Options(GM : G_Modes) return String is begin return ToStr(G_Options(GM)); end G_Options; procedure Clean_GPG_Errors (Orig_Err_File : in String; Err_File : in String) is begin -- Clean up the error file to remove -- `gpg: Invalid passphrase; please try again ...' messages. if ForkExec_Out(Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => ToUBS("-v"), 2 => ToUBS("gpg: Invalid passphrase; please try again ..."), 3 => ToUBS(Orig_Err_File)), Err_File) /= 0 then Error("Grep failed! (ff1)"); end if; end Clean_GPG_Errors; function GPG_Tee (Input_File : String; Output_File : String; Err_File : String; Status_Filename : String) return Integer is GPG_Return_Value, Tee_Return_Value : Integer; Orig_Err_File : constant String := Temp_File_Name("origerr"); SFD : Integer; begin SFD := Open_Out(Status_Filename); ForkExec2(G_Command(OPreceive), ToUBS("gpg --status-fd " & Integer'Image(SFD) & " " & G_Options(OPreceive) & " --output " & Output_File & " " & UGA_Str(Signing => False) & " " & Input_File), GPG_Return_Value, Value_Nonempty(Config.Binary(Tee)), ToUBS("tee " & Orig_Err_File), Tee_Return_Value, Merge_StdErr1 => True, Report => True); if Tee_Return_Value /= 0 then Error("Tee failed! (ff1)"); end if; CClose(SFD); Clean_GPG_Errors(Orig_Err_File, Err_File); -- Let the caller sort out the GPG return value. return GPG_Return_Value; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.GPG_Tee"); raise; end GPG_Tee; function GPGSM_Tee (Input_File : String; Output_File : String; Err_File : String; Encoding_Arg : String; Status_Filename : String; Verify : Boolean) return Integer is GPG_Return_Value, Tee_Return_Value : Integer; Orig_Err_File : constant String := Temp_File_Name("origerr"); SFD : Integer; Op_String : constant array (Boolean) of String(1..11) := (True => " --verify ", False => " --decrypt "); begin SFD := Open_Out(Status_Filename); ForkExec2(G_Command(S_MIME), ToUBS("gpgsm --status-fd " & Integer'Image(SFD) & " " & G_Options(S_MIME) & " " & Encoding_Arg -- Not using --assume-base64 because Pine -- appears to unwrap the message into binary. & " --output " & Output_File & Op_String(Verify) & Input_File), GPG_Return_Value, Value_Nonempty(Config.Binary(Tee)), ToUBS("tee " & Orig_Err_File), Tee_Return_Value, Merge_StdErr1 => True, Report => True); if Tee_Return_Value /= 0 then Error("Tee failed! (ff1)"); end if; CClose(SFD); Clean_GPG_Errors(Orig_Err_File, Err_File); -- Let the caller sort out the GPG return value. return GPG_Return_Value; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.GPGSM_Tee"); raise; end GPGSM_Tee; function GPG_Verify_Tee (Input_File : String; Sig_File : String; Output_File : String; Err_File : String; Status_Filename : String) return Integer is GPG_Return_Value, Tee_Return_Value : Integer; Orig_Err_File : constant String := Temp_File_Name("origerr"); SFD : Integer; begin SFD := Open_Out(Status_Filename); ForkExec2(G_Command(OpenPGP), ToUBS("gpg --status-fd " & Integer'Image(SFD) & " " & G_Options(OPreceive) & " --output " & Output_File & " --verify " & Sig_File & " " & Input_File), GPG_Return_Value, Value_Nonempty(Config.Binary(Tee)), ToUBS("tee " & Orig_Err_File), Tee_Return_Value, Merge_StdErr1 => True, Report => True); if Tee_Return_Value /= 0 then Error("Tee failed! (ff1)"); end if; CClose(SFD); Clean_GPG_Errors(Orig_Err_File, Err_File); -- Let the caller sort out the GPG return value. return GPG_Return_Value; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.GPG_Verify_Tee"); raise; end GPG_Verify_Tee; function GPGSM_Verify_Tee (Input_File : String; Sig_File : String; Output_File : String; Err_File : String; Status_Filename : String) return Integer is GPG_Return_Value, Tee_Return_Value : Integer; Orig_Err_File : constant String := Temp_File_Name("origerr"); SFD : Integer; begin SFD := Open_Out(Status_Filename); ForkExec2(G_Command(S_MIME), ToUBS("gpgsm --status-fd " & Integer'Image(SFD) & " " & G_Options(S_MIME) & " --output " & Output_File & " --verify " & Sig_File & " " & Input_File), GPG_Return_Value, Value_Nonempty(Config.Binary(Tee)), ToUBS("tee " & Orig_Err_File), Tee_Return_Value, Merge_StdErr1 => True, Report => True); if Tee_Return_Value /= 0 then Error("Tee failed! (ff1)"); end if; CClose(SFD); Clean_GPG_Errors(Orig_Err_File, Err_File); -- Let the caller sort out the GPG return value. return GPG_Return_Value; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.GPGSM_Verify_Tee"); raise; end GPGSM_Verify_Tee; function Grep_Sigfile_Digest (Sigfile : in String; Number : in String) return Integer is E1, E2 : Integer; begin ForkExec2(Value_Nonempty(Config.Binary(GPGOP)), UBS_Array'(0 => ToUBS("gpg"), 1 => ToUBS("--list-packets"), 2 => ToUBS(Sigfile)), E1, Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => ToUBS("-q"), 2 => ToUBS("digest algo " & Number)), E2); return E2; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.Grep_Sigfile_Digest"); raise; end Grep_Sigfile_Digest; function Micalg_From_Filename (Sigfile : in String) return String is begin -- From RFC2440, we have: -- 9.4. Hash Algorithms -- -- ID Algorithm Text Name -- -- --------- ---- ---- -- 1 - MD5 "MD5" -- 2 - SHA-1 "SHA1" -- 3 - RIPE-MD/160 "RIPEMD160" -- 4 - Reserved for double-width SHA (experimental) -- 5 - MD2 "MD2" -- 6 - Reserved for TIGER/192 "TIGER192" -- 7 - Reserved for HAVAL (5 pass, 160-bit) "HAVAL-5-160" -- 100 to 110 - Private/Experimental algorithm. -- Implementations MUST implement SHA-1. Implementations SHOULD -- implement MD5. -- -- Then from RFC4880, but not in RFC3156 -- 8 - SHA256 [FIPS180] "SHA256" -- 9 - SHA384 [FIPS180] "SHA384" -- 10 - SHA512 [FIPS180] "SHA512" -- 11 - SHA224 [FIPS180] "SHA224" -- -- So we'll use gpg --list-packets Sigfile (we're assuming that this -- is a detached signature) and look for digest algo 1 or 2 and -- return pgp-sha1 or pgp-md5 respectively. -- Look for other numbers as defined in RFC3156. -- If we don't find anything, raise an exception. if Grep_Sigfile_Digest(Sigfile, "0") = 0 then return "pgp-md5"; elsif Grep_Sigfile_Digest(Sigfile, "2") = 0 then return "pgp-sha1"; elsif Grep_Sigfile_Digest(Sigfile, "3") = 0 then return "pgp-ripemd160"; elsif Grep_Sigfile_Digest(Sigfile, "5") = 0 then return "pgp-md2"; elsif Grep_Sigfile_Digest(Sigfile, "6") = 0 then return "pgp-tiger192"; elsif Grep_Sigfile_Digest(Sigfile, "7") = 0 then return "pgp-haval-5-160"; elsif Grep_Sigfile_Digest(Sigfile, "8") = 0 then return "pgp-sha256"; elsif Grep_Sigfile_Digest(Sigfile, "9") = 0 then return "pgp-sha384"; elsif Grep_Sigfile_Digest(Sigfile, "10") = 0 then return "pgp-sha512"; elsif Grep_Sigfile_Digest(Sigfile, "11") = 0 then return "pgp-sha224"; else raise Unrecognised_Micalg; return "unknown"; -- Should never execute. end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.Micalg_From_Filename"); raise; end Micalg_From_Filename; function Micalg_From_Status (Status_Filename : in String) return String is SFDHA_Filename : constant String := Temp_File_Name("sfdha"); S : UBS; E1, E2 : Integer; begin -- Given the status filename, extract the hash algo entry from SIG_CREATED. ForkExec2_InOut(Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => ToUBS("^\[GNUPG:\] SIG_CREATED")), E1, Value_Nonempty(Config.Binary(Cut)), UBS_Array'(0 => ToUBS("cut"), 1 => ToUBS("-d"), 2 => ToUBS(" "), 3 => ToUBS("-f"), 4 => ToUBS("5")), E2, Status_Filename, SFDHA_Filename); S := Misc.Read_Fold(SFDHA_Filename); Debug("Read “" & ToStr(S) & "” for hash algorithm."); declare T : constant String := ToStr(S); begin if T = "0" then return "md5"; elsif T = "2" then return "sha1"; elsif T = "3" then return "ripemd160"; elsif T = "5" then return "md2"; elsif T = "6" then return "tiger192"; elsif T = "7" then return "haval-5-160"; elsif T = "8" then return "sha256"; elsif T = "9" then return "sha384"; elsif T = "10" then return "sha512"; elsif T = "11" then return "sha224"; else raise Unrecognised_Micalg; return "unknown"; -- Should never execute. end if; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.Micalg_From_Status"); raise; end Micalg_From_Status; function Grep_Status (Status_Filename : String; Code : String) return Boolean is E1 : Integer; begin -- Given the status filename, extract the hash algo entry from SIG_CREATED. E1 := ForkExec(Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => ToUBS("-q"), 2 => ToUBS("^\[GNUPG:\] " & Code), 3 => ToUBS(Status_Filename))); return E1 = 0; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.Grep_Status"); raise; end Grep_Status; -- This procedure does something mildly naughty. If the return code -- is 0, we're happy. If it isn't, we see if the file exists, and -- print a warning to be careful if it does. procedure GPG_Wrap (Args : in String; Out_Filename : in String; Status_Filename : in String) is R : Integer; -- The return code from GPG. SFD : Integer; begin SFD := Open_Out(Status_Filename); Ada.Text_IO.Put_Line("About to run ‘gpg --status-fd " & Integer'Image(SFD) & " " & G_Options(OPsend) & " " & Args & "’..."); R := ForkExec(G_Command(OPsend), ToUBS("gpg --status-fd " & Integer'Image(SFD) & " " & G_Options(OPsend) & " " & Args)); CClose(SFD); if R = 0 then Ada.Text_IO.Put_Line("GPG exited successfully..."); else Ada.Text_IO.New_Line(2); Ada.Text_IO.Put_Line("GPG exited with return code " & Trim_Leading_Spaces(Integer'Image(R))); if Externals.Simple.Test_S(Out_Filename) then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "*** WARNING ***"); Ada.Text_IO.Put_Line("However, a non-empty output file was generated, so it might have worked."); Ada.Text_IO.Put_Line("Perhaps some public keys were unusable? (E.g., expired keys?)"); Ada.Text_IO.Put_Line("We will proceed as if everything was okay."); Ada.Text_IO.Put_Line("** You should check the output file.... **"); Ada.Text_IO.Put_Line("*** WARNING ***" & Reset_SGR); Ada.Text_IO.New_Line(2); else raise GPG_Failed; end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.GPG_Wrap"); raise; end GPG_Wrap; procedure GPGSM_Wrap (Args : in String; Out_Filename : in String; Status_Filename : in String; No_Exception : in Boolean := False) is R : Integer; -- The return code from GPG. SFD : Integer; begin SFD := Open_Out(Status_Filename); -- Actually run it. Ada.Text_IO.Put_Line("About to run ‘gpgsm --status-fd " & Integer'Image(SFD) & " " & G_Options(S_MIME) & " " & Args & "’..."); R := ForkExec(G_Command(S_MIME), ToUBS("gpgsm --status-fd " & Integer'Image(SFD) & " " & G_Options(S_MIME) & " " & Args)); CClose(SFD); if R = 0 then Ada.Text_IO.Put_Line("GPGSM exited successfully..."); else Ada.Text_IO.New_Line(2); Ada.Text_IO.Put_Line("GPGSM exited with return code " & Trim_Leading_Spaces(Integer'Image(R))); if Externals.Simple.Test_S(Out_Filename) then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "*** WARNING ***"); Ada.Text_IO.Put_Line("However, a non-empty output file was generated, so it might have worked."); Ada.Text_IO.Put_Line("Perhaps some certificates were unusable? (E.g., expired?)"); Ada.Text_IO.Put_Line("We will proceed as if everything was okay."); Ada.Text_IO.Put_Line("** You should check the output file.... **"); Ada.Text_IO.Put_Line("*** WARNING ***" & Reset_SGR); Ada.Text_IO.New_Line(2); else if No_Exception then null; else raise GPG_Failed; end if; end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.GPGSM_Wrap"); raise; end GPGSM_Wrap; procedure GPGSM_Wrap_Encrypt (Out_Filename : in String; Status_Filename : in String; In_Filename : in String; Send_Keys : in Keys.Key_List) is use type Menus.YN_Index; begin Externals.GPG.GPGSM_Wrap(" --base64 --encrypt --output " & Out_Filename & " " & Keys.Processed_Recipient_List(Send_Keys) & " " & In_Filename, Out_Filename, Status_Filename, True); -- Now, if the status file includes any of -- INV_RECP 3 (Wrong key usage) -- INV_RECP 6 (No CRL known) -- INV_RECP 7 (CRL too old) -- then offer Openssl's version. if Grep_Status(Status_Filename, "INV_RECP 3 ") or Grep_Status(Status_Filename, "INV_RECP 6 ") or Grep_Status(Status_Filename, "INV_RECP 7 ") then Ada.Text_IO.New_Line(2); Ada.Text_IO.Put_Line("GPGSM is complaining about keys and/or CRLs."); Ada.Text_IO.Put_Line("Topal could try again using OpenSSL's smime command."); if Menus.YN_Menu("Reattempt using OpenSSL? ") = Menus.Yes then -- Extract the keys. declare R : Integer; OC : UBS; OSM : constant String := Temp_File_Name("openssl"); use type UBS; begin -- Now we have the key certificates. -- Build a suitable command. OC := ToUBS("openssl smime -encrypt -aes256 -in " & In_Filename & " -out " & OSM & Keys.Processed_Recipient_List_OpenSSL(Send_Keys)); -- Tell us what's happening. Ada.Text_IO.Put_Line("About to run ‘" & ToStr(OC) & "’..."); R := ForkExec(Value_Nonempty(Config.Binary(Openssl)), OC); if R = 0 then -- Sort out the body: we'll re-add our own headers later. Externals.Mail.Extract_Body(OSM, Out_Filename); else raise GPG_Failed; -- Okay, it was OpenSSL…. end if; end; else raise GPG_Failed; end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.GPG.GPGSM_Wrap_Encrypt"); raise; end GPGSM_Wrap_Encrypt; procedure Findkey (Key : in String; Target : in String; SMIME : in Boolean; Email : in Boolean := False; Secret : in Boolean := False) is E1, E2, E3 : Integer; T_Search : UBS; T_Grep : UBS; T_Zero : UBS; T_List : UBS; G_Mode : G_Modes; SFD_File : constant String := Temp_File_Name("sfd"); SFD : Integer; use type UBS; begin Debug("Findkey: " & Key & " Email?" & Boolean'Image(Email) & " SMIME?" & Boolean'Image(SMIME) & " Secret?" & Boolean'Image(Secret) & " Target:" & Target); if SMIME then T_Zero := ToUBS("gpgsm"); G_Mode := S_MIME; else T_Zero := ToUBS("gpg"); G_Mode := OpenPGP; end if; if Email then T_Search := ToUBS("<" & Key & ">"); else T_Search := ToUBS(Key); end if; if Secret then T_List := ToUBS("--list-secret-keys"); if SMIME then T_Grep := ToUBS("^crs:"); else T_Grep := ToUBS("^sec:"); end if; else T_List := ToUBS("--list-keys"); if SMIME then T_Grep := ToUBS("^crt:"); else T_Grep := ToUBS("^pub:"); end if; end if; SFD := Open_Out(SFD_File); ForkExec3_Out(G_Command(G_Mode), T_Zero & ToUBS(" --status-fd " & Integer'Image(SFD) & " " & G_Options(G_Mode) & " --with-colons --with-fingerprint ") & T_List & ' ' & T_Search, E1, Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => ToUBS("-A1"), 2 => T_Grep), E2, Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("/^fpr:/ ! d; s/^fpr:*://; s/:.*$//")), E3, Target => Target); Debug("Add_Keys_By_Fingerprint: Finished exec's"); CClose(SFD); if E1 /= 0 then Debug("gpg failed with exit code " & Integer'Image(E1) & "! (ff1)"); -- Don't care if grep fails. elsif E3 /= 0 then Error("sed failed! (ff3)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Keys.Findkey"); raise; end Findkey; procedure Findkey_Secret (Key : in String; Target : in String; SMIME : in Boolean) is begin Findkey(Key => Key, Target => Target, SMIME => SMIME, Email => False, Secret => True); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Keys.Findkey_Secret"); raise; end Findkey_Secret; procedure Listkey (Key : in String; Target : in String; SMIME : in Boolean) is E1 : Integer; SFD_File : constant String := Temp_File_Name("sfd"); SFD : Integer; begin SFD := Open_Out(SFD_File); if SMIME then E1 := ForkExec_Out(G_Command(S_MIME), ToUBS("gpgsm --status-fd " & Integer'Image(SFD) & " " & G_Options(S_MIME) & " --with-colons --with-fingerprint --list-keys " & Key), Target => Target); else E1 := ForkExec_Out(G_Command(OpenPGP), ToUBS("gpg --status-fd " & Integer'Image(SFD) & " " & G_Options(OpenPGP) & " --with-colons --with-fingerprint --list-keys " & Key), Target => Target); end if; if E1 /= 0 then Error("Problem generating keylist, GPG barfed (ff7a)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Keys.Listkey"); raise; end Listkey; procedure Viewkey (Key : in String; Verbose : in Boolean; SMIME : in Boolean) is E1, E2 : Integer; SFD_File : constant String := Temp_File_Name("sfd"); SFD : Integer; V : UBS; M : G_Modes; begin SFD := Open_Out(SFD_File); if Verbose then V := ToUBS(" --verbose "); end if; if SMIME then M := S_MIME; else M := OpenPGP; end if; ForkExec2(G_Command(M), ToUBS(G_Name(M) & " --status-fd " & Integer'Image(SFD) & " " & G_Options(M) & " --list-keys " & ToStr(V) & Key), E1, Value_Nonempty(Config.Binary(Less)), ToUBS("less"), E2); CClose(SFD); if E1 /= 0 then Error("Problem with GPG! (ff8)"); elsif E2 /= 0 then Error("Problem with less! (ff9)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Keys.Viewkey"); raise; end Viewkey; procedure Brief_View_SMIME_Key (Key : in String; Target : in String) is E1, E2, E3 : Integer; SFD_File : constant String := Temp_File_Name("sfd"); SFD : Integer; begin SFD := Open_Out(SFD_File); ForkExec3_Out(G_Command(S_MIME), ToUBS("gpgsm --status-fd " & Integer'Image(SFD) & " " & G_Options(S_MIME) & " --with-colons --list-keys " & Key), E1, Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => ToUBS("^uid")), E2, Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("s/^uid:*//; s/:*$//; s/$/ /")), E3, Target => Target); Debug("Brief_View_SMIME_Key: Finished exec's"); CClose(SFD); if E1 /= 0 then Debug("gpg failed with exit code " & Integer'Image(E1) & "! (ff1)"); -- Don't care if grep fails. elsif E3 /= 0 then Error("sed failed! (ff3)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Keys.Brief_View_SMIME_Key"); raise; end Brief_View_SMIME_Key; end Externals.GPG; topal-80/externals-c.c0000644000175000017500000000343213434071426013131 0ustar pjbpjb/* Topal: GPG/GnuPG and Alpine/Pine integration Copyright (C) 2001--2008 Phillip J. Brooke This program 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. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include #include #include #include #include #include /* Debian: include errno to stop ld.so whinging. */ #include int errno_wrapper () { return errno; } int waitpid_wrapper (pid_t pid) { int status; int rv; int exitstatus; rv = waitpid(pid, &status, 0); if (rv > 0) { exitstatus = WEXITSTATUS(status); return exitstatus; } else return rv; } int open_append_wrapper (const char *pathname) { return open (pathname, O_CREAT|O_APPEND|O_WRONLY, S_IRUSR|S_IWUSR); } int open_out_wrapper (const char *pathname) { return open (pathname, O_CREAT|O_WRONLY, S_IRUSR|S_IWUSR); } int open_in_wrapper (const char *pathname) { return open (pathname, O_RDONLY); } /* Given a pattern string, glob. This is done as an iterator: it is not thread/task safe! */ glob_t globbuf; int glob_actual (const char *pattern) { glob(pattern, 0, NULL, &globbuf); return globbuf.gl_pathc; } char *glob_text (int index) { if (index >= globbuf.gl_pathc) return NULL; else return globbuf.gl_pathv[index]; } void glob_free () { globfree(&globbuf); } topal-80/keys.ads0000644000175000017500000001135013434071426012202 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Keys is type Key_List is limited private; Key_Not_Found : exception; type Key_Property_Types is (Invalid, Disabled, Revoked, Expired, Encrypter, Signer); type Key_Properties is array(Key_Property_Types) of Boolean; -- Both means Encrypter or Signer. Any means any, even those not -- capable of signing or encrypting. type Key_Roles is (Encrypter, Signer, Both, Any); -- Do the properties and roles match? function Match_PR (KP : Key_Properties; KR : Key_Roles) return Boolean; -- Is the key usable? function Usable (KP : Key_Properties) return Boolean; -- Given a line from Findkey, return a processed version. procedure Process_Key (Key_File_Name : in String; P : out UBS; KP : out Key_Properties); -- Given a fingerprint, return the process key info. procedure Process_Key_By_FP (FP : in String; P : out UBS; KP : out Key_Properties; SMIME : in Boolean); -- Add a key to the list.... procedure Add_Key (Key : in UBS; List : in out Key_List; Role : in Key_Roles); Fingerprint_Expected : exception; -- Remove a key. -- Only deletes one instance. procedure Remove_Key (Key : in UBS; List : in out Key_List; Exception_If_Missing : in Boolean := False); -- Turn the list of keys to send into `-r ' string. function Processed_Recipient_List (List : in Key_List) return String; -- Turn the list of keys to send into a list of filenames and -- create those files. function Processed_Recipient_List_OpenSSL (List : in Key_List) return String; -- Get key fingerprint(s) for a key. Add them. -- The name is a bit odd. Really, they should be `Search_For_Keys' or similar. -- The `By_Fingerprint' bit refers to how the keys are recorded. procedure Add_Keys_By_Fingerprint (Key_In : in UBS; List : in out Key_List; Role : in Key_Roles; Email : in Boolean; Found : out Boolean); procedure Add_Keys_By_Fingerprint (Key_In : in UBS; List : in out Key_List; Role : in Key_Roles; Email : in Boolean := False); -- Add the secret keys to this keylist. procedure Add_Secret_Keys (Key_In : in UBS; List : in out Key_List; Role : in Key_Roles); -- List the keys and edit them as appropriate (include removing a key -- from that list, and adding one from the keyring. procedure List_Keys (List : in out Key_List); -- List the keys. Either return with Aborted true, or -- The_Fingerprint set to the chosen fingerprint. procedure Select_Key_From_List (List : in out Key_List; The_Fingerprint : out UBS; Aborted : out Boolean); procedure First_Key_From_List (List : in out Key_List; The_Fingerprint : out UBS); -- Use keylist. Given a list of recipients, add the keys, returning a -- new key list. procedure Use_Keylist (Recipients : in UBS_Array; List : in out Key_List; Missing : out Boolean); procedure Empty_Keylist (List : in out Key_List; SMIME : in Boolean); function Count (List : in Key_List) return Natural; function Contains (List : in Key_List; Key : in UBS) return Boolean; private type Key_List is record KA : UVV; SMIME : Boolean; -- A flag that changes further internal operations. end record; end Keys; topal-80/ada-readline-c.c0000644000175000017500000000300713434071426013430 0ustar pjbpjb/* Topal: GPG/GnuPG and Alpine/Pine integration Copyright (C) 2001--2008 Phillip J. Brooke This program 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. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include #include #include #include /* A static variable for holding the line. */ static char *line_read = (char *)NULL; /* Read a string, and return a pointer to it. Returns NULL on EOF. */ char * rl_gets (char * prompt) { /* If the buffer has already been allocated, return the memory to the free pool. */ if (line_read) { free (line_read); line_read = (char *)NULL; } /* Get a line from the user. */ line_read = readline (prompt); /* If the line has any text in it, save it on the history. */ if (line_read && *line_read) add_history (line_read); /* printf("Value in result is `%s'\n", line_read); */ return line_read; } void rl_disable_tab_completion () { rl_bind_key ('\t', rl_insert); } void rl_enable_tab_completion () { rl_bind_key ('\t', rl_complete); } topal-80/receiving.adb0000644000175000017500000016564413434071426013201 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Containers.Vectors; with Ada.IO_Exceptions; with Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; with Ada.Text_IO; with Externals; use Externals; with Externals.GPG; with Externals.Mail; with Externals.Ops; with Externals.Simple; use Externals.Simple; with Globals; use Globals; with Menus; use Menus; with Misc; use Misc; with Readline; with Remote_Mode; package body Receiving is -- A local subprogram common to both Display and Mime_Display to sort -- out whether to process the block, and whether to use cache and how. procedure Process_Check (Decrypt : in Boolean; SMIME : in Boolean; Cached : in Boolean; Process_Block : out Boolean; Use_Cache : out Boolean; Write_Cache : out Boolean; Remote_Block : out Boolean) is YNR : YNR_Index; Decrypt_Possible : Boolean := True; begin Debug("+Receiving.Process_Check"); Process_Block := False; Use_Cache := False; Write_Cache := False; Remote_Block := False; if Decrypt then -- Decrypt? if Cached then if Config.Positive_Opts(Decrypt_Cached) = 1 then Ada.Text_IO.Put_Line("Cache file exists, using it instead of decrypting"); Process_Block := True; elsif Config.Positive_Opts(Decrypt_Cached) = 2 then YNR := YNR_Menu("Cache file exists; decrypt? (yes/no/remote) "); Process_Block := YNR = Yes or YNR = Remote; Remote_Block := YNR = Remote; end if; if Process_Block then if Config.Positive_Opts(Decrypt_Cached_Use_Cache) = 1 then Ada.Text_IO.Put_Line("Using existing cache file"); Use_Cache := True; elsif Config.Positive_Opts(Decrypt_Cached_Use_Cache) = 2 then Ada.Text_IO.Put_Line("Replacing existing cache file"); Write_Cache := True; elsif Config.Positive_Opts(Decrypt_Cached_Use_Cache) = 3 then Ada.Text_IO.Put_Line("Replacing existing cache file"); Write_Cache := YN_Menu("Replace existing cache file? ") = Yes; -- Config.Positive_Opts(Decrypt_Cached_Use_Cache) = 4: Change nothing. elsif Config.Positive_Opts(Decrypt_Cached_Use_Cache) = 5 then declare Selection : URI_Index; begin Selection := URI_Menu; if Selection = UUse then Use_Cache := True; elsif Selection = Replace then Write_Cache := True; end if; end; end if; end if; else -- It's not cached. Do we decrypt it? -- First check if decrypt-prereq is set. if ToStr(Config.UBS_Opts(Decrypt_Prereq)) /= "" then -- Run the prereq, collect the return value. If it -- returns 0, good. Anything, else, set the -- Decrypt_Possible flag to false. if Externals.Ops.Test_Decrypt_Prerequisite > 0 then Decrypt_Possible := False; end if; end if; -- FIXME: the next bit is a shortcircuit for SMIME. if SMIME then Decrypt_Possible := True; end if; -- Perhaps ask the user what to do. if Decrypt_Possible then if Config.Positive_Opts(Decrypt_Not_Cached) = 1 then Ada.Text_IO.Put_Line("No cache file exists, decrypting"); Process_Block := True; elsif Config.Positive_Opts(Decrypt_Not_Cached) = 2 then YNR := YNR_Menu("No cache file exists; decrypt? (yes/no/remote) "); Process_Block := YNR = Yes or YNR = Remote; Remote_Block := YNR = Remote; end if; else Ada.Text_IO.Put_Line("Decrypt prerequisite false, not decrypting."); end if; -- If we're processing the block, sort out the cache usage. if Process_Block then if Config.Positive_Opts(Decrypt_Not_Cached_Use_Cache) = 1 then Ada.Text_IO.Put_Line("Will write cache file"); Write_Cache := True; elsif Config.Positive_Opts(Decrypt_Not_Cached_Use_Cache) = 2 then Write_Cache := YN_Menu("Write cache file? ") = Yes; end if; end if; end if; else -- Verify? if Cached then if Config.Positive_Opts(Verify_Cached) = 1 then Ada.Text_IO.Put_Line("Cache file exists, using it instead of verifying"); Process_Block := True; elsif Config.Positive_Opts(Verify_Cached) = 2 then Process_Block := YN_Menu("Cache file exists; verify? ") = Yes; end if; if Process_Block then if Config.Positive_Opts(Verify_Cached_Use_Cache) = 1 then Ada.Text_IO.Put_Line("Using existing cache file"); Use_Cache := True; elsif Config.Positive_Opts(Verify_Cached_Use_Cache) = 2 then Ada.Text_IO.Put_Line("Replacing existing cache file"); Write_Cache := True; elsif Config.Positive_Opts(Verify_Cached_Use_Cache) = 3 then Ada.Text_IO.Put_Line("Replacing existing cache file"); Write_Cache := YN_Menu("Replace existing cache file? ") = Yes; -- Config.Positive_Opts(Verify_Cached_Use_Cache) = 4: Change nothing. elsif Config.Positive_Opts(Verify_Cached_Use_Cache) = 5 then declare Selection : URI_Index; begin Selection := URI_Menu; if Selection = UUse then Use_Cache := True; elsif Selection = Replace then Write_Cache := True; end if; end; end if; end if; else if Config.Positive_Opts(Verify_Not_Cached) = 1 then Ada.Text_IO.Put_Line("No cache file exists, verifying"); Process_Block := True; elsif Config.Positive_Opts(Verify_Not_Cached) = 2 then Process_Block := YN_Menu("No cache file exists; verify? ") = Yes; end if; if Process_Block then if Config.Positive_Opts(Verify_Not_Cached_Use_Cache) = 1 then Ada.Text_IO.Put_Line("Will write cache file"); Write_Cache := True; elsif Config.Positive_Opts(Verify_Not_Cached_Use_Cache) = 2 then Write_Cache := YN_Menu("Write cache file? ") = Yes; end if; end if; end if; end if; Debug("-Receiving.Process_Check"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Receiving.Process_Check"); raise; end Process_Check; type Block_Record is record PGP : Boolean := False; Decrypt : Boolean := False; end record; package BAP is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Block_Record); subtype BAV is BAP.Vector; -- We want to verify or decrypt a message. procedure Display (Tmpfile : in String) is Cache_Dir : constant UBS := ToUBS(ToStr(Topal_Directory) & "/cache"); Originfile : constant String := Temp_File_Name("origin"); -- We are going to break the message up into a sequence of blocks. -- Each block has a record associated with it. Of the three fields, -- Used indicates if that block has, funnily enough, been used. PGP -- is True if we're going to send it to GPG (either decrypt or -- verify). Decrypt True if the message starts -----BEGIN PGP -- MESSAGE----- (i.e., we need to decrypt it) and is False if the -- message starts -----BEGIN PGP SIGNED MESSAGE----- (i.e., we won't -- need a passphrase). Blocks : BAV; -- Flag indicating if we should wait at the end. Do_Wait : Boolean := False; begin Debug("+Receiving.Display"); -- Save the original input. Externals.Simple.Cat_Out(Tmpfile, Originfile); -- Initialize Blocks. Blocks := BAP.Empty_Vector; -- Make sure that the cache directory exists. Mkdir_P(ToStr(Cache_Dir)); -- Turn the received message in Tmpfile into blocks. -- Block names are of the form Temp_File_Name("blocknnn"). declare use Ada.Text_IO; -- The handle for the tmpfile: TF : File_Type; -- The handle for the current block: BF : File_Type; -- The state machine is fairly noddy. type State_Machine_Modes is (Starting, Verbatim, Message, Signed); State : State_Machine_Modes := Starting; -- The strings we're interested in.... Message_Start : constant String := "-----BEGIN PGP MESSAGE-----"; Signed_Start : constant String := "-----BEGIN PGP SIGNED MESSAGE-----"; Message_End : constant String := "-----END PGP MESSAGE-----"; Signed_End : constant String := "-----END PGP SIGNATURE-----"; begin -- Open the file. Let exceptions here propogate. begin Open(File => TF, Mode => In_File, Name => Tmpfile); exception when others => Error("Exception generated while opening input file " & "for receive."); raise; end; Tmp_Read_Loop: loop begin declare The_Line : constant String := ToStr(Unbounded_Get_Line(TF)); function Block_Name return String is begin return Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(Integer(Blocks.Length)+1)), Use_Sequence_Number => False); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Receiving.Display.Block_Name"); raise; end Block_Name; procedure Set_BR (PGP : Boolean := False; Decrypt : Boolean := False) is begin Blocks.Append(Block_Record'(PGP => PGP, Decrypt => Decrypt)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Receiving.Display.Set_BR"); raise; end Set_BR; begin case State is when Starting => if The_Line'Length >= Message_Start'Length and then The_Line(The_Line'First.. The_Line'First+Message_Start'Length-1) = Message_Start then -- This line starts a PGP message. -- Open a new block. begin Create(File => BF, Mode => Out_File, Name => Block_Name); exception when others => Error("Exception generated when opening block" & " to write 1: `" & Block_Name & "'"); end; -- Write this line. Put_Line(BF, The_Line); -- Set the arrays and state appropriately. Set_BR(PGP => True, Decrypt => True); State := Message; elsif The_Line'Length >= Signed_Start'Length and then The_Line(The_Line'First.. The_Line'First+Signed_Start'Length-1) = Signed_Start then -- This line starts a PGP signed message. -- Open a new block. begin Create(File => BF, Mode => Out_File, Name => Block_Name); exception when others => Error("Exception generated when opening block" & " to write 2: `" & Block_Name & "'"); end; -- Write this line. Put_Line(BF, The_Line); -- Set the arrays and state appropriately. Set_BR(PGP => True); State := Signed; else -- This line is verbatim. -- Open a new block. begin Create(File => BF, Mode => Out_File, Name => Block_Name); exception when others => Error("Exception generated when opening block" & " to write 3: `" & Block_Name & "'"); end; -- Write this line. Put_Line(BF, The_Line); -- Set the arrays and state appropriately. Set_BR; State := Verbatim; end if; when Verbatim => if The_Line'Length >= Message_Start'Length and then The_Line(The_Line'First.. The_Line'First+Message_Start'Length-1) = Message_Start then -- This line starts a PGP message. -- Close the existing block. Close(BF); -- Open a new block. begin Create(File => BF, Mode => Out_File, Name => Block_Name); exception when others => Error("Exception generated when opening block" & " to write 4: `" & Block_Name & "'"); end; -- Write this line. Put_Line(BF, The_Line); -- Set the arrays and state appropriately. Set_BR(PGP => True, Decrypt => True); State := Message; elsif The_Line'Length >= Signed_Start'Length and then The_Line(The_Line'First.. The_Line'First+Signed_Start'Length-1) = Signed_Start then -- This line starts a PGP signed message. -- Close the existing block. Close(BF); -- Open a new block. begin Create(File => BF, Mode => Out_File, Name => Block_Name); exception when others => Error("Exception generated when opening block" & " to write 5: `" & Block_Name & "'"); end; -- Write this line. Put_Line(BF, The_Line); -- Set the arrays and state appropriately. Set_BR(PGP => True); State := Signed; else -- This line is verbatim. -- Write it in the current block. -- Write this line. Put_Line(BF, The_Line); end if; when Message => if The_Line'Length >= Message_End'Length and then The_Line(The_Line'First.. The_Line'First+Message_End'Length-1) = Message_End then -- This line ends the current PGP message. -- Write this line. Put_Line(BF, The_Line); -- Close the existing block. Close(BF); -- Set the arrays and state appropriately. State := Starting; else -- Write this into the current block. Put_Line(BF, The_Line); end if; when Signed => if The_Line'Length >= Signed_End'Length and then The_Line(The_Line'First.. The_Line'First+Signed_End'Length-1) = Signed_End then -- This line ends the current PGP message. -- Write this line. Put_Line(BF, The_Line); -- Close the existing block. Close(BF); -- Set the arrays and state appropriately. State := Starting; else -- Write this into the current block. Put_Line(BF, The_Line); end if; end case; end; exception when Ada.IO_Exceptions.End_Error => -- Run out of lines to read. We're done. exit Tmp_Read_Loop; end; end loop Tmp_Read_Loop; -- Tidy up -- close the existing files. if Is_Open(BF) then Close(BF); end if; if Is_Open(TF) then Close(TF); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Receiving.Display (Tmpfile -> Blocks)"); raise; end; -- declare: The Tmpfile -> Blocks bit. -- Delete the Tmpfile. We're going to append to it instead. Rm_File(Tmpfile); -- Now, run through the entire vector. Block_Use_Loop: for I in 1 .. Integer(Blocks.Length) loop if Blocks.Element(I).PGP then declare Process_Block : Boolean; Cached : Boolean; Cached2 : Boolean; Write_Cache : Boolean; Use_Cache : Boolean; Remote_Block : Boolean; This_Block_Wait : Boolean := True; -- Get temp filenames. Com_File : constant String := Temp_File_Name("com" & Trim_Leading_Spaces(Integer'Image(I))); Out_File : constant String := Temp_File_Name("out" & Trim_Leading_Spaces(Integer'Image(I))); Err_File : constant String := Temp_File_Name("err" & Trim_Leading_Spaces(Integer'Image(I))); SFD_File : constant String := Temp_File_Name("sfd" & Trim_Leading_Spaces(Integer'Image(I))); Blk_File : constant String := Temp_File_Name("blk" & Trim_Leading_Spaces(Integer'Image(I))); -- We'll need to read in the cache line. MD5 : UBS; begin -- Is this file cached? -- Get the cache filename. MD5 := Ops.Get_MD5Sum_Of_File(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False)); -- So the cache filename is ToStr(Cache_Dir) & "/" & ToStr(MD5). -- Does it exist? Cached := Test_R(ToStr(Cache_Dir) & "/" & ToStr(MD5)); Cached2 := Test_R(ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out"); if Cached and (not Cached2) then Ada.Text_IO.Put_Line("Hmm. Missing .out file from cache...."); end if; -- At this point, we know whether or not the file is cached -- (Cached) and also if this is a decrypt or verify -- (Block_Decrypt(I)). Now check what we need to do in -- terms of Process_Block, Use_Cache, Write_Cache and Remote_Block. Process_Check(Blocks.Element(I).Decrypt, False, -- Not SMIME. Cached, Process_Block, Use_Cache, Write_Cache, Remote_Block); -- Now we know if we're going to process the block, and -- whether or not we'll read from a cache, or write to a -- cache. if Remote_Block then -- Copy this particular block over to the remote -- server. We know it's a decrypt, because that's -- the only time we set Remote_Block true. Remote_Mode.Decrypt(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False), False); -- Write some text noting that this has been handled remotely. Echo_Append("----- Topal: Remote decryption used here. -----", Tmpfile); elsif Process_Block then -- Run GPG or get stuff from cache.. if Use_Cache then -- It's cached, copy the cache file. -- Append the cache file to the tmpfile. Echo_Append("----- Topal: Using cache file `" & ToStr(Cache_Dir) & "/" & ToStr(MD5) & "'-----", Com_File); Cat_Append(ToStr(Cache_Dir) & "/" & ToStr(MD5), Com_File); if Config.Boolean_Opts(Inline_Separate_Output) then Pager(Com_File); if Cached2 then Cat_Append(ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out", Tmpfile); else Error("Need .out! Have you cleared the cache since upgrading to Topal >=0.7.8??"); end if; else Cat_Append(Com_File, Tmpfile); if Blocks.Element(I).Decrypt then Echo_Append("----- Topal: Decrypted output starts -----", Tmpfile); if Cached2 then Cat_Append(ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out", Tmpfile); else Error("Need .out! Have you cleared the cache since upgrading to Topal >=0.7.8?"); end if; Echo_Append("----- Topal: Decrypted output ends -----", Tmpfile); else Echo_Append("----- Topal: Original message starts -----", Tmpfile); Cat_Append(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False), Tmpfile); Echo_Append("----- Topal: Original message ends -----", Tmpfile); end if; end if; -- Sort out the This_Block_Wait. if Blocks.Element(I).Decrypt then This_Block_Wait := not Config.Boolean_Opts(Decrypt_Cached_Fast_Continue); else This_Block_Wait := not Config.Boolean_Opts(Verify_Cached_Fast_Continue); end if; else -- Run GPG! declare GPG_Return_Value : Integer; GPG_Return_Okay : Boolean := False; Include_Out_File : Boolean := True; begin -- Actually run GPG. GPG_Return_Value := Externals.GPG.GPG_Tee(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False), Out_File, Err_File, SFD_File); if Blocks.Element(I).Decrypt then GPG_Return_Okay := Externals.GPG.Grep_Status(SFD_File, "DECRYPTION_OKAY"); else GPG_Return_Okay := Externals.GPG.Grep_Status(SFD_File, "GOODSIG"); end if; -- Now, according to the GPG man page: ``The -- program returns 0 if everything was fine, -- 1 if at least a signature was bad, and -- other error codes for fatal errors.'' -- So, we're not bothered here about bad -- signatures (it's up to the user to decide -- what to do), but anything else means that -- it's broken and we can't do much else. -- Exception: if the bad signature is due to a -- duff character set, then if -- config.ask_charset is set, then we'll -- offer a conversion and re-run. if (not GPG_Return_Okay) and Externals.GPG.Grep_Status(SFD_File, "BADSIG") and (not Blocks.Element(I).Decrypt) and Config.Boolean_Opts(Ask_Charset) then -- This procedure is dealing with inline -- blocks. These can get messed up by the -- locales. If Config.Boolean_Opts(Ask_Charset) is set, -- then find out the current locale, ask -- the user which is should be, and if -- different, run iconv. declare Current_Charset : UBS; Desired_Charset : UBS; use type UBS; begin Ada.Text_IO.New_Line(5); Ada.Text_IO.Put_Line("GPG's error code suggests that the signature was bad. This could be caused"); Ada.Text_IO.Put_Line("by using the wrong character set."); Current_Charset := ToUBS(Externals.Simple.Get_Charmap); Ada.Text_IO.Put_Line("The current charset is " & ToStr(Current_Charset) & "."); Readline.Add_History(ToStr(Current_Charset)); Desired_Charset := ToUBS(Readline.Get_String("Which charset should we use? (empty means no change) ")); -- If no charset is given, don't convert and don't re-run. if ToStr(Desired_Charset)'Length > 0 -- But with a non-empty response, convert if they're different. and then Current_Charset /= Desired_Charset then Externals.Simple.Convert_Charmap(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False), ToStr(Current_Charset), ToStr(Desired_Charset)); -- Remove the first Out_File. Externals.Simple.Rm_File(Out_File); -- Now, re-run GPG. GPG_Return_Value := Externals.GPG.GPG_Tee(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False), Out_File, Err_File, SFD_File); GPG_Return_Okay := Externals.GPG.Grep_Status(SFD_File, "GOODSIG"); end if; end; end if; if (not GPG_Return_Okay) then -- Certainly don't cache this thing. Write_Cache := False; -- Omit anything that deals with the output file -- (because it probably doesn't exist). Include_Out_File := False; Ada.Text_IO.Put_Line("Topal: GPG return value > 1; was = " & Trim_Leading_Spaces(Integer'Image(GPG_Return_Value)) & "; this is not good -- omitting output."); end if; -- Append GPG's stdout, stderr, some wrappers to block -- result file. Echo_Out_N("----- Topal: Output generated on ", Blk_File); Date_Append(Blk_File); Echo_Append("----- Topal: GPG output starts -----", Blk_File); Cat_Append(Err_File, Blk_File); Echo_Append("----- Topal: GPG output ends -----", Blk_File); -- Copy GPG's block result file and the separate -- output to cache files. -- But only if we really want to. if Write_Cache then Cat_Out(Blk_File, ToStr(Cache_Dir) & "/" & ToStr(MD5)); Cat_Out(Out_File, ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out"); end if; if Config.Boolean_Opts(Inline_Separate_Output) then Pager(Blk_File); Cat_Append(Out_File, Tmpfile); else if Blocks.Element(I).Decrypt and Include_Out_File then -- Copy the processed output with wrappers. Echo_Append("----- Topal: Decrypted output starts -----", Blk_File); Cat_Append(Out_File, Blk_File); Echo_Append("----- Topal: Decrypted output ends -----", Blk_File); else -- Copy the original file, with wrappers. Echo_Append("----- Topal: Original message starts -----", Blk_File); Cat_Append(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False), Blk_File); Echo_Append("----- Topal: Original message ends -----", Blk_File); end if; -- Append block result file to Pine tmpfile.. Cat_Append(Blk_File, Tmpfile); end if; -- Sort out the This_Block_Wait. if not Blocks.Element(I).Decrypt then This_Block_Wait := not Config.Boolean_Opts(Verify_Not_Cached_Fast_Continue); end if; end; end if; else -- Don't process the block; just append it. Cat_Append(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False), Tmpfile); -- Don't wait on non-processed blocks. This_Block_Wait := False; end if; -- Sort out the wait part. Do_Wait := Do_Wait or This_Block_Wait; end; -- Of declare block. else -- Verbatim block; just append it. Cat_Append(Temp_File_Name("block" & Trim_Leading_Spaces(Integer'Image(I)), Use_Sequence_Number => False), Tmpfile); -- Verbatim blocks don't affect the Do_Wait setting. end if; end loop Block_Use_Loop; if Do_Wait then Debug("Receiving.Display: Waiting..."); Wait; else Debug("Receiving.Display: Not waiting..."); end if; Debug("-Receiving.Display"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Receiving.Display"); raise; end Display; procedure Mime_Display (Infile : in String; Content_Type : in String) is Cache_Dir : constant UBS := ToUBS(ToStr(Topal_Directory) & "/cache"); Boundary : UBS; -- If this subprogram has been called, we expect to be decoding a -- MIME RFC2015 message. This will be split into two parts, possibly -- with some junk at the head and tail. We use the boundary to get -- the two parts. -- The temp filenames. Originfile : constant String := Temp_File_Name("origin"); OrigCT : constant String := Temp_File_Name("origct"); Part_One : constant String := Temp_File_Name("part1"); Part_One_Hdr : constant String := Temp_File_Name("part1h"); Part_One_CT : constant String := Temp_File_Name("part1ct"); Part_One_CS : constant String := Temp_File_Name("part1cs"); Part_Two : constant String := Temp_File_Name("part2"); Out_File : constant String := Temp_File_Name("out"); Err_File : constant String := Temp_File_Name("err"); SFD_File : constant String := Temp_File_Name("sfd"); Blk_File : constant String := Temp_File_Name("blk"); P7S : constant String := Temp_File_Name("p7s"); -- Other similar stuff to the previous subprogram. Decrypt : Boolean; Process_Block : Boolean; Cached : Boolean; Write_Cache : Boolean; Use_Cache : Boolean; Remote_Block : Boolean; -- We'll need to read in the cache line. MD5 : UBS; -- Character set horrors. Local_Charset : UBS; Guessed_Charset : UBS; Desired_Charset : UBS; -- Messing with GPG. GPG_Return_Value : Integer; GPG_Return_Okay : Boolean := False; Include_Out_File : Boolean := True; SMIME : Boolean := False; SMIME_Opaque : Boolean := False; Reattempt : Boolean := False; begin Debug("+Receiving.Mime_Display"); Debug("Infile=" & Infile); Debug("Content_Type=" & Content_Type); -- Save the original input and content-type. Externals.Simple.Cat_Out(Infile, Originfile); Externals.Simple.Echo_Out(Content_Type, OrigCT); -- Make sure that the cache directory exists. Mkdir_P(ToStr(Cache_Dir)); -- Is this file cached? -- Get the cache filename. MD5 := Ops.Get_MD5Sum_Of_File(Infile); -- So the cache filename is ToStr(Cache_Dir) & "/" & ToStr(MD5). -- Does it exist? Cached := Test_R(ToStr(Cache_Dir) & "/" & ToStr(MD5)); -- Is this a verify or decrypt? -- Need to use Ada.Strings.Maps.Constants.Lower_Case_Map declare CT : constant String := Ada.Strings.Fixed.Translate(Content_Type, Ada.Strings.Maps.Constants.Lower_Case_Map); begin if (CT'Length >= 16 and then CT(1..16) = "multipart/signed") or (CT'Length >= 26 and then CT(1..26) = "application/x-topal-signed") then Decrypt := False; elsif (CT'Length >= 19 and then CT(1..19) = "multipart/encrypted") or (CT'Length >= 29 and then CT(1..29) = "application/x-topal-encrypted") then Decrypt := True; elsif (CT'Length >= 22 and then CT(1..22) = "application/pkcs7-mime") or (CT'Length >= 24 and then CT(1..24) = "application/x-pkcs7-mime") then SMIME := True; else -- Have no idea what to do -- bail out. Error("Don't know what to do with Content-Type: " & CT); end if; if SMIME then if Ada.Strings.Fixed.Index(CT, "signed-data") /= 0 then Decrypt := False; SMIME_Opaque := True; elsif Ada.Strings.Fixed.Index(CT, "enveloped-data") /= 0 then Decrypt := True; else -- Guess that it's encrypted. Decrypt := True; -- FIXME: the standard also allows for certs-only. end if; end if; end; -- We need to figure out what the boundary is and split the message. -- But not if we're dealing with an SMIME decryption. if not ((Decrypt and SMIME) or SMIME_Opaque) then -- First, figure out what the boundary is. Boundary := Mail.Find_Mime_Boundary(Infile); Debug("Boundary=" & ToStr(Boundary)); -- Get the two parts. Mail.Split_Two_Parts(Infile, Part_One, Part_Two, Boundary); -- Now, we have the two parts. end if; -- We need to check if it is cached (but we'll ignore this for -- now). So, sort out what to do with this block. Process_Check(Decrypt, SMIME, Cached, Process_Block, Use_Cache, Write_Cache, Remote_Block); -- And now we either use the cache, or process the block. if Remote_Block then -- Copy the entire original email over to the remote server. -- We know it's a MIME decrypt, because that's the only time -- we set Remote_Block true here. Remote_Mode.Decrypt(Originfile, True, Content_Type); elsif Process_Block then if Use_Cache then -- It's cached, copy the cache file. -- Append the cache file to the tmpfile. Echo_Append("----- Topal: Using cache file `" & ToStr(Cache_Dir) & "/" & ToStr(MD5) & "'-----", Blk_File); Cat_Append(ToStr(Cache_Dir) & "/" & ToStr(MD5), Blk_File); -- This is MIME, so we also retrieve the out file. -- But verifying a MIME message means we ignore the outfile.... if Decrypt then Cat_Out(ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out", Out_File); else -- Verify case: test and warn. if Test_R(ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out") then Ada.Text_IO.Put_Line("Hmm. Unexpected .out file in cache...."); Cat_Out(ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out", Out_File); end if; end if; else if Decrypt then -- Just pass the second part to GPG (or GPGSM). if SMIME then -- Guess if we've got a base64 (i.e., PEM without -- header lines) or a binary file, and call GPGSM. GPG_Return_Value := Externals.GPG.GPGSM_Tee(Infile, Out_File, Err_File, Misc.Guess_SMIME_Encoding(Infile), SFD_File, False); else GPG_Return_Value := Externals.GPG.GPG_Tee(Part_Two, Out_File, Err_File, SFD_File); end if; GPG_Return_Okay := Externals.GPG.Grep_Status(SFD_File, "DECRYPTION_OKAY"); elsif SMIME_Opaque then -- Caching etc. is stuffed here. Opaque signing is not a good thing. So disable caching. Write_Cache := False; GPG_Return_Value := Externals.GPG.GPGSM_Tee(Infile, Out_File, Err_File, Misc.Guess_SMIME_Encoding(Infile), SFD_File, True); GPG_Return_Okay := Externals.GPG.Grep_Status(SFD_File, "GOODSIG"); if GPG_Return_Okay then -- Put the output where we expect to find it. Externals.Simple.Mv_F(Out_File, Part_One); end if; else -- We're doing verification, so we need to sort out the -- character sets. -- Given the two parts, try and find a header in the first one -- and a charset. Mail.Extract_Header(Part_One, Part_One_Hdr); Mail.Extract_Content_Type_From_Header(Part_One_Hdr, Part_One_CT, Ignore_Missing => True, Substitute => True); Simple.Sed_InOut("/charset/I ! d; s/^.*charset=//i; s/[; ].*$//; s/""//g", Part_One_CT, Part_One_CS); Guessed_Charset := Read_Fold(Part_One_CS); Local_Charset := ToUBS(Externals.Simple.Get_Charmap); if ToStr(Guessed_Charset) = "" then Guessed_Charset := Local_Charset; end if; Debug("Got guessed charset=" & ToStr(Guessed_Charset)); -- We'll use both parts. But we have to turn part one into -- canonical line-end first. Dos2Unix_U(Part_One); -- Convert from the current character set to CS. declare use type UBS; begin if Local_Charset /= Guessed_Charset then Externals.Simple.Convert_Charmap(Part_One, ToStr(Local_Charset), ToStr(Guessed_Charset)); end if; end; -- Use both parts.... -- But first: are we looking at a S/MIME message here? -- Read the first line. If it includes the string ` declare CTF : constant String := Temp_File_Name("ct"); B64 : constant String := Temp_File_Name("b64"); CT : UBS; begin Externals.Mail.Extract_Content_Type_From_Header(Part_Two, CTF, Ignore_Missing => True); CT := Read_Fold(CTF); if Ada.Strings.Fixed.Index(ToStr(CT), "application/x-pkcs7-signature") > 0 or Ada.Strings.Fixed.Index(ToStr(CT), "application/pkcs7-signature") > 0 then SMIME := True; -- Split part two into two further parts. Externals.Mail.Extract_Body(Part_Two, B64); -- Decode the base 64 attachment. Externals.Mail.Base64_Decode(B64, P7S); end if; if SMIME then GPG_Return_Value := Externals.GPG.GPGSM_Verify_Tee(Input_File => Part_One, Sig_File => P7S, Output_File => Out_File, Err_File => Err_File, Status_Filename => SFD_File); else GPG_Return_Value := Externals.GPG.GPG_Verify_Tee(Input_File => Part_One, Sig_File => Part_Two, Output_File => Out_File, Err_File => Err_File, Status_Filename => SFD_File); end if; GPG_Return_Okay := Externals.GPG.Grep_Status(SFD_File, "GOODSIG"); end; end if; -- Now, according to the GPG man page: ``The -- program returns 0 if everything was fine, 1 if -- at least a signature was bad, and other error -- codes for fatal errors.'' -- So, we're not bothered here about bad signatures -- (it's up to the user to decide what to do), but -- anything else means that it's broken and we can't -- do much else. -- Exception: if the bad signature is due to a -- duff character set, then if -- config.ask_charset is set, then we'll -- offer a conversion and re-run. if (not GPG_Return_Okay) and Externals.GPG.Grep_Status(SFD_File, "BADSIG") and Config.Boolean_Opts(Ask_Charset) then -- This procedure is dealing with a MIME input. If -- Config.Boolean_Opts(Ask_Charset) is set, then find out the -- current locale, ask the user which is should be, -- and if different, run iconv. declare use type UBS; begin Ada.Text_IO.New_Line(5); Ada.Text_IO.Put_Line("GPG's error code suggests that the signature was bad. This could be caused"); Ada.Text_IO.Put_Line("by using the wrong character set."); Ada.Text_IO.Put_Line("The current charset is " & ToStr(Guessed_Charset) & "."); Readline.Add_History(ToStr(Guessed_Charset)); Desired_Charset := ToUBS(Readline.Get_String("Which charset should we use? (empty means no change) ")); -- If no charset is given, don't convert and don't re-run. if ToStr(Desired_Charset)'Length > 0 -- But with a non-empty response, convert if they're different. and then Guessed_Charset /= Desired_Charset then Externals.Simple.Convert_Charmap(Part_One, ToStr(Guessed_Charset), ToStr(Desired_Charset)); -- Remove the first Out_File. Externals.Simple.Rm_File(Out_File); -- Now, re-run GPG. if SMIME then GPG_Return_Value := Externals.GPG.GPGSM_Verify_Tee(Input_File => Part_One, Sig_File => P7S, Output_File => Out_File, Err_File => Err_File, Status_Filename => SFD_File); else GPG_Return_Value := Externals.GPG.GPG_Verify_Tee(Input_File => Part_One, Sig_File => Part_Two, Output_File => Out_File, Err_File => Err_File, Status_Filename => SFD_File); end if; GPG_Return_Okay := Externals.GPG.Grep_Status(SFD_File, "GOODSIG"); end if; end; end if; if ((not GPG_Return_Okay ) and SMIME and Decrypt) and then Externals.GPG.Grep_Status(SFD_File, "ERROR decrypt.algorithm") and then Externals.GPG.Grep_Status(SFD_File, "DECRYPTION_FAILED") then -- Reattempt in case it's a signed message. Reattempt := True; Write_Cache := False; declare Dummy : Integer; pragma Unreferenced(Dummy); begin Dummy := Externals.Simple.System("topal -mime " & Infile & " ""application/x-pkcs7-mime; smime-type=signed-data"""); end; elsif not GPG_Return_Okay then -- Certainly don't cache this thing. Write_Cache := False; -- Omit anything that deals with the output file -- (because it probably doesn't exist). Include_Out_File := False; Ada.Text_IO.Put_Line("Topal: GPG return value > 1; was = " & Trim_Leading_Spaces(Integer'Image(GPG_Return_Value)) & "; this is not good -- omitting output."); end if; if not Reattempt then -- Append GPG's stdout, stderr, some wrappers to block -- result file. Echo_Out_N("----- Topal: Output generated on ", Blk_File); Date_Append(Blk_File); Echo_Append("----- Topal: GPG output starts -----", Blk_File); Cat_Append(Err_File, Blk_File); Echo_Append("----- Topal: GPG output ends -----", Blk_File); end if; -- Copy GPG's block result file to cache file. -- But only if we really want to. if Write_Cache then Cat_Out(Blk_File, ToStr(Cache_Dir) & "/" & ToStr(MD5)); -- For MIME decrypt stuff, we also save the `out' file. if Decrypt then Cat_Out(Out_File, ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out"); else -- Check for the existence of an out file for verify.... if Test_R(Out_File) then Ada.Text_IO.Put_Line("Hmm. Unexpected output file exists...."); Cat_Out(Out_File, ToStr(Cache_Dir) & "/" & ToStr(MD5) & ".out"); end if; end if; end if; end if; if not Reattempt then -- Output the results. Pager(Blk_File); -- If we've verified a signature, we need to then show the nice -- version of the file via metamail. If it was decrypted, then we -- show off the Out_File. Note that if the next object in is also -- a MIME object, we might be invoked again. if Decrypt then if Include_Out_File then -- If this was False, then GPG failed. So there's nothing for -- View_MIME to deal with. Dos2Unix(Out_File); Externals.Mail.View_MIME(Out_File, True); end if; else Dos2Unix(Part_One); Externals.Mail.View_MIME(Part_One, False); end if; end if; else -- If we're not to process the block, then just dump out original -- input. Pager(Infile); end if; Debug("-Receiving.Mime_Display"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Receiving.Mime_Display"); raise; end Mime_Display; -- Our approach to displaying application/pgp content-types is to hand -- off the input file to Display and get it to do the work. We simply -- display it. procedure Mime_Display_APGP (Infile : in String; Content_Type : in String) is CT : constant String := Ada.Strings.Fixed.Translate(Content_Type, Ada.Strings.Maps.Constants.Lower_Case_Map); begin Debug("+Receiving.Mime_Display_APGP"); -- Don't save off the original file here: the later call to -- Display will do that. if CT = "application/pgp" then -- We handle all of this nasty, deprecated mode here. declare Tempfile : constant String := Temp_File_Name("apgptemp"); begin -- Copy the input to the temporary file. Cat_Out(Infile, Tempfile); -- Invoke Display on the temporary file. Display(Tempfile); -- Then display it using less. Pager(Tempfile); end; else -- Have no idea what to do -- bail out. Error("Don't know what to do with Content-Type: " & CT); end if; Debug("-Receiving.Mime_Display_APGP"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Receiving.Mime_Display_APGP"); raise; end Mime_Display_APGP; procedure Process_Stdin is In_File : constant String := Temp_File_Name("psstdin"); Header_File : constant String := Temp_File_Name("pshdr"); Body_File : constant String := Temp_File_Name("psbody"); CT_File : constant String := Temp_File_Name("psct"); CT : UBS; Current_Header : UBS := ToUBS(Header_File); Current_Body : UBS := ToUBS(Body_File); begin -- Eat stdin. Cat_Stdin_Out(D => In_File); -- Now we want to open /dev/tty and use that as stdin. Externals.Ops.Open_TTY; -- Split the header and body. Externals.Mail.Extract_Header(Email_Filename => In_File, Target_Filename => Header_File); Externals.Mail.Extract_Body(Email_Filename => In_File, Target_Filename => Body_File); -- We try to work around emails that are a multipart/mixed -- wrapper where the first attachment is multipart/signed. -- Testing suggests that I can't get formail to extract this -- header, so I'll try using grep. -- Does the header include a content-type of multipart/mixed? declare Header_Grep : constant String := Temp_File_Name("pshdrgrep"); Header_File2 : constant String := Temp_File_Name("pshdr2"); Header_File3 : constant String := Temp_File_Name("pshdr3"); Body_File2 : constant String := Temp_File_Name("psbody2"); Body_File3 : constant String := Temp_File_Name("psbody3"); Grep_RV : Integer; Grep_RV2 : Integer; pragma Unreferenced(Grep_RV2); begin -- If so, we'll try to split the body again. Grep_RV := Externals.Simple.Grep_I_InOut (T => "Content-Type: *multipart/mixed", D1 => Header_File, D2 => Header_Grep, E => True); if Grep_RV = 0 then -- It's a multipart/mixed. Ada.Text_IO.New_Line; Ada.Text_IO.Put_Line("This appears to be a multipart/mixed email."); Ada.Text_IO.Put_Line("I'll look for an attachment I can process."); Ada.Text_IO.New_Line; -- We now need to split the body into a second header/body pair. Externals.Mail.Extract_Header(Email_Filename => Body_File, Target_Filename => Header_File2); -- Under the current hypothesis, we'll get some MIME -- boundaries included. Get rid of them. Grep_RV2 := Externals.Simple.Grep_I_InOut (T => "^--.*$", D1 => Header_File2, D2 => Header_File3, E => True, V => True); Externals.Mail.Extract_Body(Email_Filename => Body_File, Target_Filename => Body_File2); -- Similarly, to avoid confusing the boundary detection -- code, we'll blow away the *last* line of the body file -- to avoid getting the last boundary. -- FIXME: This is a horrible hack. It should be replaced -- with proper multipart handling. Simple.Sed_InOut("$ d", Body_File2, Body_File3); Current_Header := ToUBS(Header_File3); Current_Body := ToUBS(Body_File3); end if; end; -- Determine if it's inline or MIME. Mail.Formail_Concat_Extract_InOut(Source => ToStr(Current_Header), Target => CT_File, Header => "Content-Type"); CT := Read_Fold(CT_File); Ada.Text_IO.Put_Line("CT = """ & ToStr(CT) & """"); -- FIXME do we need to guess the character set? Ada.Text_IO.Put_Line("FIXME, do we need to guess the character set?"); declare CT1 : constant String := ToStr(CT); use Ada.Strings.Fixed; CTS : constant String := CT1(Index_Non_Blank(CT1) .. CT1'Last); begin if (Index(CTS, "multipart/signed") > 0) or (Index(CTS, "multipart/encrypted") > 0) or (Index(CTS, "application/x-topal-signed") > 0) or (Index(CTS, "multipart/x-topal-encrypted") > 0) or (Index(CTS, "application/x-topal-encrypted") > 0) or (Index(CTS, "application/pkcs7-mime") > 0) or (Index(CTS, "application/x-pkcs7-mime") > 0) then Ada.Text_IO.Put_Line("Handle as MIME..."); Mime_Display(ToStr(Current_Body), CTS); elsif (Index(CTS, "application/pgp") > 0) then Ada.Text_IO.Put_Line("Handle as application/pgp..."); Mime_Display_APGP(ToStr(Current_Body), CTS); else Ada.Text_IO.Put_Line("Handle as inline..."); Display(ToStr(Current_Body)); Pager(ToStr(Current_Body)); end if; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Receiving.Process_Stdin"); raise; end Process_Stdin; end Receiving; topal-80/externals-simple.adb0000644000175000017500000006616013434071426014513 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Characters.Latin_1; with Ada.IO_Exceptions; with Ada.Text_IO; with Misc; package body Externals.Simple is procedure Cat (D : in String) is use Ada.Text_IO; use Misc; F1 : File_Type; TL : UBS; begin Open(File => F1, Mode => In_File, Name => D); File_Loop: loop begin TL := Unbounded_Get_Line(F1); Put_Line(ToStr(TL)); exception when Ada.IO_Exceptions.End_Error => exit File_Loop; end; end loop File_Loop; Close(F1); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Cat"); raise; end Cat; procedure Cat_Out (D1 : in String; D2 : in String) is use Ada.Text_IO; use Misc; F1, F2 : File_Type; TL : UBS; begin Open(File => F1, Mode => In_File, Name => D1); Create(File => F2, Mode => Out_File, Name => D2); File_Loop: loop begin TL := Unbounded_Get_Line(F1); Put_Line(F2, ToStr(TL)); exception when Ada.IO_Exceptions.End_Error => exit File_Loop; end; end loop File_Loop; Close(F1); Close(F2); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Cat_Out"); raise; end Cat_Out; -- Equivalent of `cat > D'. procedure Cat_Stdin_Out (D : in String) is use Ada.Text_IO; use Misc; F2 : File_Type; TL : UBS; begin Create(File => F2, Mode => Out_File, Name => D); File_Loop: loop begin TL := Unbounded_Get_Line; Put_Line(F2, ToStr(TL)); exception when Ada.IO_Exceptions.End_Error => exit File_Loop; end; end loop File_Loop; Close(F2); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Cat_Stdin_Out"); raise; end Cat_Stdin_Out; procedure Cat_Append (D1 : in String; D2 : in String) is use Ada.Text_IO; use Misc; F1, F2 : File_Type; TL : UBS; begin Open(File => F1, Mode => In_File, Name => D1); begin Open(File => F2, Mode => Append_File, Name => D2); exception when Ada.IO_Exceptions.Name_Error => -- Try again with a create. Create(File => F2, Mode => Append_File, Name => D2); end; File_Loop: loop begin TL := Unbounded_Get_Line(F1); Put_Line(F2, ToStr(TL)); exception when Ada.IO_Exceptions.End_Error => exit File_Loop; end; end loop File_Loop; Close(F1); Close(F2); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Cat_Append("&D1&","&D2&")"); raise; end Cat_Append; procedure Chmod (P : in String; D : in String) is begin if ForkExec(Misc.Value_Nonempty(Config.Binary(Chmod)), UBS_Array'(0 => ToUBS("chmod"), 1 => ToUBS(P), 2 => ToUBS(D))) /= 0 then Misc.Error("`chmod " & P & " " & D & "' failed."); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Chmod"); raise; end Chmod; procedure Clear is begin if ForkExec(Misc.Value_Nonempty(Config.Binary(Clear)), UBS_Array'(0 => ToUBS("clear"))) /= 0 then Misc.Error("`clear' failed."); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Clear"); raise; end Clear; procedure Date_Append (D : in String) is begin if ForkExec_Append(Misc.Value_Nonempty(Config.Binary(Date)), UBS_Array'(0 => ToUBS("date")), D) /= 0 then Misc.Error("`date >> " & D & "' failed."); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Date_Append"); raise; end Date_Append; procedure Date_1_Append (A, D : in String) is begin if ForkExec_Append(Misc.Value_Nonempty(Config.Binary(Date)), UBS_Array'(0 => ToUBS("date"), 1 => ToUBS(A)), D) /= 0 then Misc.Error("`date " & A & " >> " & D & "' failed."); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Date_1_Append"); raise; end Date_1_Append; function Date_String return String is use Ada.Text_IO; use Misc; Target : constant String := Temp_File_Name("thedate"); TL : UBS; F1 : File_Type; begin if ForkExec_Out(Misc.Value_Nonempty(Config.Binary(Date)), UBS_Array'(0 => ToUBS("date"), 1 => ToUBS("+%Y%m%d%H%M%S")), Target) /= 0 then Misc.Error("`date '+%Y%m%d%H%M%S' >" & Target & "' failed."); end if; -- Now, extract that string. Open(File => F1, Mode => In_File, Name => Target); -- There should be exactly one line that has the date in it. TL := Unbounded_Get_Line(F1); Close(F1); -- Return that string. return ToStr(TL); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Date_String"); raise; end Date_String; function Diff_Brief (F1 : in String; F2 : in String) return Boolean is E : Integer; begin E := ForkExec_Out(Misc.Value_Nonempty(Config.Binary(Diff)), UBS_Array'(0 => ToUBS("diff"), 1 => ToUBS("--brief"), 2 => ToUBS(F1), 3 => ToUBS(F2)), Target => "/dev/null"); case E is when 0 => -- No changes. return False; when 1 => -- There are changes. return True; when others => -- There's a problem. Misc.Error("`diff --brief " & F1 & " " & F2 & " >/dev/null' failed."); return False; -- Won't be executed. end case; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Diff_Brief"); raise; end Diff_Brief; procedure Dos2Unix_U (D : in String) is use Misc; F1, F2 : Character_IO.File_Type; D2 : constant String := Temp_File_Name("d2u"); C, CP : Character; begin Character_IO.Open(File => F1, Mode => Character_IO.In_File, Name => D); Character_IO.Create(File => F2, Mode => Character_IO.Out_File, Name => D2); begin -- This one's Unix to DOS. So all \n go to \r\n unless it's -- prefixed already by \r. CP := ' '; Char_Loop: loop Character_IO.Read(F1, C); if C = Ada.Characters.Latin_1.LF then if CP = Ada.Characters.Latin_1.CR then Character_IO.Write(F2, Ada.Characters.Latin_1.LF); else Character_IO.Write(F2, Ada.Characters.Latin_1.CR); Character_IO.Write(F2, Ada.Characters.Latin_1.LF); end if; else Character_IO.Write(F2, C); end if; CP := C; end loop Char_Loop; exception when Ada.IO_Exceptions.End_Error => null; end; Character_IO.Close(File => F1); Character_IO.Close(File => F2); Cat_Out(D2, D); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Dos2Unix_U"); raise; end Dos2Unix_U; procedure Dos2Unix (D : in String) is use Misc; F1, F2 : Character_IO.File_Type; D2 : constant String := Temp_File_Name("d2u"); C : Character; CR : Boolean; -- Flag indicating a pending CR. begin Character_IO.Open(File => F1, Mode => Character_IO.In_File, Name => D); Character_IO.Create(File => F2, Mode => Character_IO.Out_File, Name => D2); begin -- This one's DOS to Unix. So all \r\n pairs go to \n. CR := False; Char_Loop: loop Character_IO.Read(F1, C); if CR then if C /= Ada.Characters.Latin_1.LF then Character_IO.Write(F2, Ada.Characters.Latin_1.CR); end if; CR := False; end if; if C = Ada.Characters.Latin_1.CR then CR := True; else Character_IO.Write(F2, C); end if; end loop Char_Loop; exception when Ada.IO_Exceptions.End_Error => null; end; if CR then -- We've reached the end, but with a pending CR. Character_IO.Write(F2, Ada.Characters.Latin_1.CR); end if; Character_IO.Close(File => F1); Character_IO.Close(File => F2); Cat_Out(D2, D); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Dos2Unix"); raise; end Dos2Unix; procedure Echo_Append (E : in String; D : in String) is use Ada.Text_IO; use Misc; F : File_Type; begin begin Open(File => F, Mode => Append_File, Name => D); exception when Ada.IO_Exceptions.Name_Error => -- Try again with a create. Create(File => F, Mode => Append_File, Name => D); end; Put_Line(F, E); Close(F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Echo_Append"); raise; end Echo_Append; procedure Echo_Append_N (E : in String; D : in String) is use Misc; use Character_IO; F : File_Type; begin begin Open(File => F, Mode => Append_File, Name => D); exception when Ada.IO_Exceptions.Name_Error => -- Try again with a create. Create(File => F, Mode => Append_File, Name => D); end; Character_IO_Put(F, E); Close(F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Echo_Append_N"); raise; end Echo_Append_N; procedure Echo_Out (E : in String; D : in String) is use Ada.Text_IO; use Misc; F : File_Type; begin Create(File => F, Mode => Out_File, Name => D); Put_Line(F, E); Close(F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Echo_Out"); raise; end Echo_Out; procedure Echo_Out_N (E : in String; D : in String) is use Misc; use Character_IO; F : File_Type; begin Create(File => F, Mode => Out_File, Name => D); Character_IO_Put(F, E); Close(F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Echo_Out_N"); raise; end Echo_Out_N; function Grep_I_InOut (T : in String; D1 : in String; D2 : in String; E : in Boolean := False; C : in Boolean := False; V : in Boolean := False) return Integer is F : UBS; begin if E then F := ToUBS("-iE"); else F := ToUBS("-i"); end if; if C then declare use type UBS; begin F := F & 'c'; end; end if; if V then declare use type UBS; begin F := F & 'v'; end; end if; return ForkExec_InOut(Misc.Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => F, 2 => ToUBS(T)), Source => D1, Target => D2); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Grep_I_InOut"); raise; end Grep_I_InOut; procedure Mkdir_P (D : in String) is begin if ForkExec(Misc.Value_Nonempty(Config.Binary(Mkdir)), UBS_Array'(0 => ToUBS("mkdir"), 1 => ToUBS("-p"), 2 => ToUBS(D))) /= 0 then Misc.Error("`mkdir -p " & D & "' failed."); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Mkdir_P"); raise; end Mkdir_P; procedure Mv_F (D1 : in String; D2 : in String) is begin if not Test_F(D1) then Misc.Error("`" & D1 & "' does not exist to be moved!"); end if; if ForkExec(Misc.Value_Nonempty(Config.Binary(Mv)), UBS_Array'(0 => ToUBS("mv"), 1 => ToUBS("-f"), 2 => ToUBS(D1), 3 => ToUBS(D2))) /= 0 then Misc.Error("`mv -f " & D1 & " " & D2 & "' failed."); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Mv_F"); raise; end Mv_F; -- View a file with a pager. procedure Pager (F : in String) is begin if ForkExec(Misc.Value_Nonempty(Config.Binary(Less)), UBS_Array'(0 => ToUBS("less"), 1 => ToUBS(F))) /= 0 then Misc.Error("less failed! (ff4)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Pager"); raise; end Pager; procedure Rm_File (F : in String) is Dummy : Integer; pragma Unreferenced(Dummy); begin -- We ignore Rm's return code. Dummy := ForkExec(Misc.Value_Nonempty(Config.Binary(Rm)), UBS_Array'(0 => ToUBS("rm"), 1 => ToUBS("-f"), 2 => ToUBS(F))); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Rm_File"); raise; end Rm_File; procedure Rm_Glob (Pattern : in String) is Files : constant UBS_Array := Glob(Pattern); Dummy : Integer; pragma Unreferenced(Dummy); begin -- Now, rather than deleting all of these at once, we'll give the list -- to a single instantiation of rm. Misc.Debug("Rm_Glob: start: count of files is " & Integer'Image(Files'Length)); -- Do nothing if there are no files.... if Files'Length /= 0 then -- Construct a suitable array. declare FEA : UBS_Array(0 .. Files'Length + 2); begin FEA(0) := ToUBS("rm"); FEA(1) := ToUBS("-f"); for I in 1 .. Files'Length loop -- When I = 1, we refer to FEA(2 = I + 1) -- and Files(Files'First = Files''First + I - 1). FEA(I + 1) := Files(Files'First + I -1); -- We ignore Rm's return code. Dummy := ForkExec(Misc.Value_Nonempty(Config.Binary(Rm)), FEA); end loop; end; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Rm_Glob"); raise; end Rm_Glob; procedure Rm_Tempfiles is begin -- We ignore Rm's return code. Rm_Glob(ToStr(Topal_Directory) & "/temp*"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Rm_Tempfiles"); raise; end Rm_Tempfiles; procedure Rm_Tempfiles_PID is begin -- We ignore Rm's return code. Rm_Glob(ToStr(Topal_Directory) & "/temp-" & Misc.Trim_Leading_Spaces(Integer'Image(Our_PID)) & "*"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Rm_Tempfiles_PID"); raise; end Rm_Tempfiles_PID; procedure Rm_Cachefiles is begin -- We ignore Rm's return code. Rm_Glob(ToStr(Topal_Directory) & "/cache/*"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Rm_Cachefiles"); raise; end Rm_Cachefiles; -- General sed invocation. Only accepts a SINGLE argument. procedure Sed_InOut (A : in String; Source : in String; Target : in String) is begin if ForkExec_InOut(Misc.Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS(A)), Source => Source, Target => Target) /= 0 then Misc.Error("Sed failed! (ff6)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Sed_InOut"); raise; end Sed_InOut; procedure Stty_Sane is begin if ForkExec(Misc.Value_Nonempty(Config.Binary(Stty)), UBS_Array'(0 => ToUBS("stty"), 1 => ToUBS("sane"))) /= 0 then Misc.Error("`stty sane' failed."); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Stty_Sane"); raise; end; function Test_D (D : in String) return Boolean is begin return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)), UBS_Array'(0 => ToUBS("test"), 1 => ToUBS("-d"), 2 => ToUBS(D))) = 0; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Test_D"); raise; end Test_D; function Test_F (D : in String) return Boolean is begin return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)), UBS_Array'(0 => ToUBS("test"), 1 => ToUBS("-f"), 2 => ToUBS(D))) = 0; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Test_F"); raise; end Test_F; function Test_R (D : in String) return Boolean is begin return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)), UBS_Array'(0 => ToUBS("test"), 1 => ToUBS("-r"), 2 => ToUBS(D))) = 0; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Test_R"); raise; end Test_R; function Test_P (D : in String) return Boolean is begin return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)), UBS_Array'(0 => ToUBS("test"), 1 => ToUBS("-p"), 2 => ToUBS(D))) = 0; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Test_P"); raise; end Test_P; function Test_S (D : in String) return Boolean is begin return ForkExec(Misc.Value_Nonempty(Config.Binary(Test)), UBS_Array'(0 => ToUBS("test"), 1 => ToUBS("-S"), 2 => ToUBS(D))) = 0; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Test_S"); raise; end Test_S; -- Guess content type of F using `file'. function Guess_Content_Type (F : in String) return String is use Misc; E1, E2 : Integer; GCT : constant String := Temp_File_Name("gct"); H : Ada.Text_IO.File_Type; First_Line : UBS; begin ForkExec2_Out(File1 => Value_Nonempty(Config.Binary(File)), Argv1 => UBS_Array'(0 => ToUBS("file"), 1 => ToUBS("-bi"), 2 => ToUBS(F)), Exit1 => E1, File2 => Value_Nonempty(Config.Binary(Sed)), Argv2 => UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("s/,.*//")), Exit2 => E2, Target => GCT); if E1 /= 0 then Error("Problem generating keylist, GPG barfed (ff7a)"); end if; if E2 /= 0 then Error("Problem generating keylist, grep barfed (ff7b)"); end if; Ada.Text_IO.Open(File => H, Mode => Ada.Text_IO.In_File, Name => GCT); First_Line := Unbounded_Get_Line(H); Ada.Text_IO.Close(H); return ToStr(First_Line); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Guess_Content_Type"); raise; end Guess_Content_Type; -- Use locale charmap to get the current keymap. function Get_Charmap return String is use Misc; E : Integer; GCM : constant String := Temp_File_Name("gcm"); H : Ada.Text_IO.File_Type; First_Line : UBS; begin E := ForkExec_Out(File => Value_Nonempty(Config.Binary(Locale)), Argv => ToUBS("locale charmap"), Target => GCM); if E /= 0 then Error("Problem extracting charmap from locale (ff10)"); end if; Ada.Text_IO.Open(File => H, Mode => Ada.Text_IO.In_File, Name => GCM); First_Line := Unbounded_Get_Line(H); Ada.Text_IO.Close(H); return ToStr(First_Line); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Get_Charmap"); raise; end Get_Charmap; -- Convert charmaps within a single file (F) from charset CF to -- charset CT. procedure Convert_Charmap (F, CF, CT : in String) is use Misc; E : Integer; CCM : constant String := Temp_File_Name("ccm"); begin Misc.Debug("Convert_Charmap: attempt conversion of file `" & F & "' from charset `" & CF & "' to `" & CT & "'"); E := ForkExec_InOut(File => Value_Nonempty(Config.Binary(Iconv)), Argv => ToUBS("iconv -f " & CF & " -t " & CT), Source => F, Target => CCM); if E /= 0 then Error("Problem converting file charmap (ff15)"); end if; -- Overwrite F. Mv_F(CCM, F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.Convert_Charmap"); raise; end Convert_Charmap; -- Equivalent of `system'. function System (Argv : UBS) return Integer is A : constant UBS_Array := Misc.Split_Arguments(Argv); begin return ForkExec(ToStr(A(A'First)), Argv); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.System (Argv=`" & ToStr(Argv) & "'"); raise; end System; function System (Argv : String) return Integer is begin return System(ToUBS(Argv)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.System (B)"); raise; end System; function System_In (Argv : String; Source : String) return Integer is A : constant UBS_Array := Misc.Split_Arguments(ToUBS(Argv)); begin return ForkExec_In(ToStr(A(A'First)), A, Source); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Simple.System_In (Argv=‘" & Argv & "’, Source=‘" & Source & "’"); raise; end System_In; end Externals.Simple; topal-80/help.txt0000644000175000017500000000467613434071426012244 0ustar pjbpjbtopal -help | -h | --help | --h | -? | --? Display (this) help message. topal {-s|-nps} [ ...] topal [ ...] This invokes the send menu on the given file. The given file is overwritten with the encrypted/signed message, unless the GPG option chosen is E, S, C or D (i.e., not lower-case). topal -pd This invokes the display/verification on standard input. topal -clear Clears any temp files left by a program fault. topal -clearc Empties the cache. topal -clearall Same as topal -clear; topal -clearc topal -default Dumps the default configuration to standard out. topal -dump Dumps the current configuration to standard out. topal -config Interactive configuration. topal -server Run server for remote connections. Options (general, mostly for debugging): --debug Forces debugging for this instance of Topal. --no-clear Do not remove temporary files when Topal exits. --ask-charset When verifying/decrypting inline PGP messages, ask if the character set should be converted. See notes/locale-problems in the README. Options (--fix-email and --fix-folder; silently ignored otherwise): --simple Change the content-type rather than rewriting the email body. --rewrite Rewrite the email body (duplicating part of the message). topal -display _TMPFILE_ _RESULTFILE_ topal -send _TMPFILE_ _RESULTFILE_ _RECIPIENTS_ topal -sendmime _TMPFILE_ _RESULTFILE_ _MIMETYPE_ _RECIPIENTS_ Intended to be used by Pine.... topal -remotesend _TMPFILE_ _RESULTFILE_ _RECIPIENTS_ topal -remotesendmime _TMPFILE_ _RESULTFILE_ _MIMETYPE_ _RECIPIENTS_ topal -remotedecrypt _INFILE_ topal -remotemimedecrypt _INFILE_ _CONTENT_TYPE_ Used internally by Topal to connect to a server. Options (for -send, -sendmime) --read-from _INCLUDEALLHDRS_ Attempts to guess a suitable signing key. topal -mime INFILE CONTENT_TYPE topal -mimeapgp INFILE CONTENT_TYPE Intended to be used in mailcap files (e.g., for metamail). topal -raw Read an mbox or a single message with headers from stdin. This should process both inline and MIME, both encrypted and signed. All options can be given with one or more `-'. See the file README.html or README.txt for author contact details and more information about Alpine/Pine, procmail, mailcap and Topal configuration. See the file COPYING for licence and warranty information. topal-80/cl_menus.adb0000644000175000017500000001153313434071426013016 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2010 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Strings.Maps; with Ada.Text_IO; with Echo; with Misc; use Misc; package body CL_Menus is function Menu (Numbered_Menu : in MNA; Number_Word : in String := Default_Number_Word; Prompt : in String := Default_Prompt; Number_Trailword : in String := Default_Number_Trailword) return CLM_Return is use Ada.Strings.Maps; use Ada.Text_IO; CL_Menu_Page_Step : constant Natural := 8; C : Character; F : Integer := Numbered_Menu'First; L : Integer := F + CL_Menu_Page_Step; V : Integer; -- Previous values of F and L. PF, PL : Integer; begin Debug("+Menus.CL_Menu"); if Accept_Chars'Length /= Char_Words'Length or Accept_Chars'First /= Char_Words'First then raise Arrays_Not_Matched; end if; if L > Numbered_Menu'Last then L := Numbered_Menu'Last; end if; -- Offset PF and PL so that we draw the choices initially. PF := F + 1; PL := L + 1; Entry_Loop: loop if (PF /= F) or (PL /= L) then Put(Rewrite_Menu_Prompt(Prompt)); Put_Line("Displaying choices " & Trim_Leading_Spaces(Integer'Image(F)) & " to " & Trim_Leading_Spaces(Integer'Image(L)) & " of " & Trim_Leading_Spaces(Integer'Image(Numbered_Menu'First)) & " to " & Trim_Leading_Spaces(Integer'Image(Numbered_Menu'Last)) & " (<,) page up (>.) page down "); for I in F..L loop Put_Line(Do_SGR(Config.UBS_Opts(Colour_Menu_Key)) & Integer'Image(I-F+1) & Reset_SGR & " - " & ToStr(Numbered_Menu(I))); end loop; PF := F; PL := L; end if; Echo.Clear_Echo; Debug("Menus.CL_Menu: About to Get_Immediate"); Get_Immediate(C); Debug("Menus.CL_Menu: Got: `" & C & "'"); Echo.Set_Echo; -- Now, run through the menu of characters. if C = '<' or C = ',' then F := F - CL_Menu_Page_Step; if F < Numbered_Menu'First then F := Numbered_Menu'First; end if; L := F + CL_Menu_Page_Step; if L > Numbered_Menu'Last then L := Numbered_Menu'Last; end if; elsif C = '>' or C = '.' then L := L + CL_Menu_Page_Step; if L > Numbered_Menu'Last then L := Numbered_Menu'Last; end if; F := L - CL_Menu_Page_Step; if F < Numbered_Menu'First then F := Numbered_Menu'First; end if; else begin V := String_To_Integer(C & "") + F - 1; if V >= Numbered_Menu'First and V <= Numbered_Menu'Last then Put(Do_SGR(Config.UBS_Opts(Colour_Menu_Choice)) & Number_Word & ToStr(Numbered_Menu(V)) & Number_Trailword & Reset_SGR); New_Line(2); return CLM_Return'(Is_Num => True, I => Index'First, N => V); end if; exception when String_Not_Integer => -- Silently ignore duff exchanges. null; end; end if; for I in Accept_Chars'Range loop if Is_In(C, To_Set(ToStr(Accept_Chars(I)))) then Put(Do_SGR(Config.UBS_Opts(Colour_Menu_Choice)) & ToStr(Char_Words(I)) & Reset_SGR); New_Line(2); return CLM_Return'(Is_Num => False, I => I, N => 0); end if; end loop; end loop Entry_Loop; exception when others => ErrorNE("Problem in CL_Menu.Menu."); raise; end Menu; end CL_Menus; topal-80/cygwin.patch0000644000175000017500000000761213434071426013065 0ustar pjbpjbdiff -cr topal-63.orig/Makefile topal-63.cyg/Makefile *** topal-63.orig/Makefile Sun Aug 31 16:28:25 2008 --- topal-63.cyg/Makefile Wed Sep 3 08:06:11 2008 *************** *** 83,89 **** ./mkhelp README.txt: README.html ! lynx -dont_wrap_pre -dump README.html > README.txt install: all install -d $(INSTALLPATHBIN) $(INSTALLPATHDOC) $(INSTALLPATHMAN)/man1 $(INSTALLPATHPATCHES) --- 83,89 ---- ./mkhelp README.txt: README.html ! -lynx -dont_wrap_pre -dump README.html > README.txt install: all install -d $(INSTALLPATHBIN) $(INSTALLPATHDOC) $(INSTALLPATHMAN)/man1 $(INSTALLPATHPATCHES) *************** *** 102,107 **** --- 102,108 ---- distclean realclean: clean -rm topal topal.gz topal.gz.asc topal-ps topal-ps.gz topal-ps.gz.asc README.txt topal-package*.{tgz,tgz.sig,tgz.asc} *~ + -rm topal.exe -rm -rf www www.bak make -C MIME-tool realclean diff -cr topal-63.orig/misc.adb topal-63.cyg/misc.adb *** topal-63.orig/misc.adb Sun Aug 31 16:28:25 2008 --- topal-63.cyg/misc.adb Wed Sep 3 07:59:31 2008 *************** *** 16,23 **** with Ada.Characters.Latin_1; with Ada.Command_Line; with Ada.Integer_Text_IO; - with Ada.Interrupts; - with Ada.Interrupts.Names; with Ada.IO_Exceptions; with Ada.Strings; with Ada.Strings.Fixed; --- 16,21 ---- *************** *** 496,523 **** raise; end Hex_Decode; - -- Handle signals. - Default_Sigint_Handler : Ada.Interrupts.Parameterless_Handler; - protected body Signal_Handlers is - - procedure Sigint_Handler is - begin - Ada.Text_IO.Put_Line("User interrupt!"); - Sigint_Pending_Flag := True; - raise User_Interrupt; - end Sigint_Handler; - - function Sigint_Pending return Boolean is - begin - return Sigint_Pending_Flag; - end Sigint_Pending; - - end Signal_Handlers; - procedure Set_Sigint_Handler is begin ! Ada.Interrupts.Attach_Handler(Signal_Handlers.Sigint_Handler'Access, ! Ada.Interrupts.Names.SIGINT); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, --- 494,502 ---- raise; end Hex_Decode; procedure Set_Sigint_Handler is begin ! null; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, *************** *** 525,530 **** raise; end Set_Sigint_Handler; - begin - Default_Sigint_Handler := Ada.Interrupts.Current_Handler(Ada.Interrupts.Names.SIGINT); end Misc; --- 504,507 ---- diff -cr topal-63.orig/misc.ads topal-63.cyg/misc.ads *** topal-63.orig/misc.ads Sun Aug 31 16:28:25 2008 --- topal-63.cyg/misc.ads Wed Sep 3 07:59:42 2008 *************** *** 96,113 **** -- Hexadecimal decoder. function Hex_Decode (S : in String) return Natural; - -- We turn SIGINT into an exception so that we can clean up - -- temporary files. - -- Handle interrupts, SIGINT, etc. - pragma Unreserve_All_Interrupts; - -- because we want to be able to handle ctrl-C. - protected Signal_Handlers is - procedure Sigint_Handler; - function Sigint_Pending return Boolean; - pragma Interrupt_Handler(Sigint_Handler); - private - Sigint_Pending_Flag : Boolean := False; - end Signal_Handlers; -- And a procedure for taking over sigint. procedure Set_Sigint_Handler; --- 96,101 ---- diff -cr topal-63.orig/remote_mode.adb topal-63.cyg/remote_mode.adb *** topal-63.orig/remote_mode.adb Sun Aug 31 16:28:25 2008 --- topal-63.cyg/remote_mode.adb Wed Sep 3 08:02:32 2008 *************** *** 382,388 **** Server_Trigger_Loop: loop exit Server_Trigger_Loop when Test_F(Server_Trigger); - exit Server_Main_Loop when Misc.Signal_Handlers.Sigint_Pending; delay 0.5; end loop Server_Trigger_Loop; delay 0.1; --- 382,387 ---- topal-80/externals-simple.ads0000644000175000017500000001061613434071426014527 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . package Externals.Simple is -- Equivalent of `cat D'. procedure Cat (D : in String); -- Equivalent of `cat D1 > D2'. procedure Cat_Out (D1 : in String; D2 : in String); -- Equivalent of `cat > D'. procedure Cat_Stdin_Out (D : in String); -- Equivalent of `cat D1 >> D2'. procedure Cat_Append (D1 : in String; D2 : in String); -- Equivalent of `chmod P D'. procedure Chmod (P : in String; D : in String); -- Equivalent of `clear'. procedure Clear; -- Equivalent of `date >> D'. procedure Date_Append (D : in String); -- Date string YmdHMS. function Date_String return String; -- date A >> D procedure Date_1_Append(A, D : in String); -- Diff --brief. Returns true for `there are changes', false for -- `no changes'. function Diff_Brief (F1 : in String; F2 : in String) return Boolean; -- Equivalent of `dos2unix -u D'. From Unix to DOS. procedure Dos2Unix_U (D : in String); -- Equivalent of `dos2unix D'. From DOS to Unix. procedure Dos2Unix (D : in String); -- Equivalent of `echo E >> D'. procedure Echo_Append (E : in String; D : in String); -- Equivalent of `echo -n E >> D'. procedure Echo_Append_N (E : in String; D : in String); -- Equivalent of `echo E > D'. procedure Echo_Out (E : in String; D : in String); -- Equivalent of `echo -n E > D'. procedure Echo_Out_N (E : in String; D : in String); -- Equivalent of `grep -i T D2'. -- If E is True, then add -E flag (extended regexp). -- If C is True, then add -c flag (return count). function Grep_I_InOut (T : in String; D1 : in String; D2 : in String; E : in Boolean := False; C : in Boolean := False; V : in Boolean := False) return Integer; -- Equivalent of `mkdir -p D' procedure Mkdir_P (D : in String); -- Equivalent of `mv -f D1 D2' procedure Mv_F (D1 : in String; D2 : in String); -- View a file with a pager. procedure Pager (F : in String); -- Remove a specified file (rm -f F). procedure Rm_File (F : in String); -- Remove all the temporary files. procedure Rm_Tempfiles; -- Remove temporary files for this run. procedure Rm_Tempfiles_PID; -- Remove all the cache files. procedure Rm_Cachefiles; -- General sed invocation. Only accepts a SINGLE argument. procedure Sed_InOut (A : in String; Source : in String; Target : in String); -- Equivalent of `stty sane'. procedure Stty_Sane; -- Equivalent of `system'. -- _In variant sets up stdin from Source. function System (Argv : UBS) return Integer; function System (Argv : String) return Integer; function System_In (Argv : String; Source : String) return Integer; -- Equivalent of `test -d D' function Test_D (D : in String) return Boolean; -- Equivalent of `test -f D' function Test_F (D : in String) return Boolean; -- Equivalent of `test -r D' function Test_R (D : in String) return Boolean; -- Equivalent of `test -p D' function Test_P (D : in String) return Boolean; -- Equivalent of `test -s D' function Test_S (D : in String) return Boolean; -- Guess content type of F using `file'. function Guess_Content_Type (F : in String) return String; -- Use locale charmap to get the current keymap. function Get_Charmap return String; -- Convert charmaps within a single file (F) from charset CF to -- charset CT. procedure Convert_Charmap (F, CF, CT : in String); end Externals.Simple; topal-80/externals-mail.adb0000644000175000017500000015564613434071426014154 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Characters.Latin_1; with Ada.IO_Exceptions; with Ada.Numerics.Discrete_Random; with Ada.Strings.Fixed; with Ada.Strings.Maps.Constants; with Ada.Strings.Unbounded; with Ada.Text_IO; with Externals.Mail; with Externals.Simple; with Menus; use Menus; with Misc; use Misc; package body Externals.Mail is -- We need to figure out what the boundary is. We don't trust Pine -- and the shell to get it for us, so we'll use this heuristic. -- Open Infile, read it in a line at a time. If a line has the -- form `--(some characters)--' then save it. The *last* one is -- assumed to be the correct boundary. Then we just have to slice -- off the leading and trailiing `--'. function Find_Mime_Boundary (Infile : String) return UBS is BF : Ada.Text_IO.File_Type; L2 : UBS; -- the line we've read in. PB : UBS; -- possible boundary begin Debug("+Externals.Mail.Find_Mime_Boundary"); Ada.Text_IO.Open(File => BF, Mode => Ada.Text_IO.In_File, Name => Infile); Boundary_Loop: loop begin L2 := Unbounded_Get_Line(BF); declare L2S : constant String := ToStr(L2); begin Debug("Considering: " & L2S); if L2S'Length > 4 then if L2S(1..2) = "--" and L2S(L2S'Last-1..L2S'Last) = "--" then -- This is a possible boundary. PB := ToUBS(L2S(3..L2S'Last-2)); Debug("Possible boundary: " & ToStr(PB)); end if; end if; end; exception when Ada.IO_Exceptions.End_Error => exit Boundary_Loop; -- Ignore. end; end loop Boundary_Loop; Ada.Text_IO.Close(BF); Debug("-Externals.Mail.Find_Mime_Boundary"); return PB; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Find_Mime_Boundary"); raise; end Find_Mime_Boundary; -- I should really generalise this to n part MIME.... procedure Split_Two_Parts (Infile : in String; Part_One : in String; Part_Two : in String; Boundary : in UBS) is Infile_F : Ada.Text_IO.File_Type; Part_One_F : Character_IO.File_Type; Part_Two_F : Character_IO.File_Type; L1 : UBS; L2 : UBS; BS : constant String := ToStr(Boundary); begin -- Open files.... begin Ada.Text_IO.Open(File => Infile_F, Mode => Ada.Text_IO.In_File, Name => Infile); Character_IO.Create(File => Part_One_F, Mode => Character_IO.Out_File, Name => Part_One); Character_IO.Create(File => Part_Two_F, Mode => Character_IO.Out_File, Name => Part_Two); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Split_Two_Parts (Opening files)"); raise; end; -- Get the two parts. The first part, we want to include the MIME -- headers, but not the boundaries nor the blank line before the next -- part. -- So, first, we walk through infile looking for the boundary. begin Find_First_Boundary: loop L2 := Unbounded_Get_Line(Infile_F); declare L2S : constant String := ToStr(L2); begin exit Find_First_Boundary when L2S = "--" & BS; end; end loop Find_First_Boundary; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Split_Two_Parts (Find_First_Boundary)"); raise; end; -- Now, walk through infile, copying complete lines to Part_One -- until we find a blank line - boundary pair. begin L1 := Unbounded_Get_Line(Infile_F); Find_Second_Boundary: loop L2 := Unbounded_Get_Line(Infile_F); declare L1S : constant String := ToStr(L1); L2S : constant String := ToStr(L2); begin exit Find_Second_Boundary when L1S'Length = 0 and L2S = "--" & BS; -- Trap case where data ends without newline. if L2S = "--" & BS then Character_IO_Put(Part_One_F, L1S); exit Find_Second_Boundary; end if; Character_IO_Put_Line(Part_One_F, L1S); end; L1 := L2; end loop Find_Second_Boundary; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Split_Two_Parts (Find_Second_Boundary)"); raise; end; -- Continue through infile, copying complete lines to Part_Two, -- until we find another blank_line - boundary pair. begin L1 := Unbounded_Get_Line(Infile_F); Find_Third_Boundary: loop L2 := Unbounded_Get_Line(Infile_F); declare L1S : constant String := ToStr(L1); L2S : constant String := ToStr(L2); begin exit Find_Third_Boundary when L1S'Length = 0 and L2S = "--" & BS & "--"; -- Trap case where data ends without newline. if L2S = "--" & BS & "--" then Character_IO_Put(Part_Two_F, L1S); exit Find_Third_Boundary; end if; Character_IO_Put_Line(Part_Two_F, L1S); end; L1 := L2; end loop Find_Third_Boundary; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Split_Two_Parts (Find_Third_Boundary)"); raise; end; -- Close files. begin Ada.Text_IO.Close(Infile_F); Character_IO.Close(Part_One_F); Character_IO.Close(Part_Two_F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Split_Two_Parts (Closing files)"); raise; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Split_Two_Parts"); raise; end Split_Two_Parts; procedure Get_First_Part (-- Input file. Infile : in String; -- Outputs: -- 1. Prolog (file). Prolog : in String; -- 2. Boundary detected (including leading --). Boundary : out UBS; -- 3. Part header (file). Part_Hdr : in String; -- 4. Part body (file). Neither 3 nor 4 includes the blank line separator. Part_Body : in String; -- 5. Rest of file (including boundary between 4 and this) (file). Remainder : in String ) is -- We're expecting a file from DTBL output. -- This is the body of a Pine multipart/mixed. -- We can get the first boundary line by searching for the first -- prefixed line. Infile_F : Ada.Text_IO.File_Type; Out_F1 : Character_IO.File_Type; Out_F3 : Character_IO.File_Type; Out_F4 : Character_IO.File_Type; Out_F5 : Character_IO.File_Type; L : UBS; begin -- Open files.... begin Ada.Text_IO.Open(File => Infile_F, Mode => Ada.Text_IO.In_File, Name => Infile); Character_IO.Create(File => Out_F1, Mode => Character_IO.Out_File, Name => Prolog); Character_IO.Create(File => Out_F3, Mode => Character_IO.Out_File, Name => Part_Hdr); Character_IO.Create(File => Out_F4, Mode => Character_IO.Out_File, Name => Part_Body); Character_IO.Create(File => Out_F5, Mode => Character_IO.Out_File, Name => Remainder); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Get_First_Part (Opening files)"); raise; end; Find_Boundary: loop L := Unbounded_Get_Line(Infile_F); declare L2 : constant String := ToStr(L); begin if L2'Length > 2 and then L2(1..2) = "--" then Boundary := L; exit Find_Boundary; end if; -- Otherwise, it's part of the prolog. Character_IO_Put_Line(Out_F1, ToStr(L)); end; end loop Find_Boundary; -- Write out the boundary we just read to the end of the prolog. Character_IO_Put_Line(Out_F1, ToStr(L)); Character_IO.Close(Out_F1); -- We've now got the boundary. Find a blank line. Find_Blank_Line: loop L := Unbounded_Get_Line(Infile_F); declare L2 : constant String := ToStr(L); begin exit when L2'Length = 0; -- Otherwise, it's part of the part header. Character_IO_Put_Line(Out_F3, ToStr(L)); end; end loop Find_Blank_Line; Character_IO.Close(Out_F3); -- Now we've got a blank line. Everything up to the next -- boundary is the part body. Find_Next_Boundary: loop L := Unbounded_Get_Line(Infile_F); declare L2 : constant String := ToStr(L); begin exit when L2 = ToStr(Boundary); -- Otherwise, it's part of the part header. Character_IO_Put_Line(Out_F4, ToStr(L)); end; end loop Find_Next_Boundary; Character_IO.Close(Out_F4); -- Write out the boundary we just read, and then the rest of the file. Character_IO_Put_Line(Out_F5, ToStr(L)); Eat_Remainder: loop exit when Ada.Text_IO.End_Of_File(Infile_F); L := Unbounded_Get_Line(Infile_F); Character_IO_Put_Line(Out_F5, ToStr(L)); end loop Eat_Remainder; -- Done, close the last files. Character_IO.Close(Out_F5); Ada.Text_IO.Close(Infile_F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Get_First_Part"); raise; end Get_First_Part; procedure Extract_Content_Type_From_Header (Email_Filename : in String; Target_Filename : in String; Ignore_Missing : in Boolean := False; Substitute : in Boolean := False) is E1, E2 : Integer; begin ForkExec2_InOut(Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("1,/^[[:space:]]*$/ ! d")), E1, Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => ToUBS("-i"), 2 => ToUBS("content-type: ")), E2, Source => Email_Filename, Target => Target_Filename); if E1 /= 0 then Error("Problem with sed! (ff2a)"); elsif E2 /= 0 and (not Ignore_Missing) then Error("Problem with grep! (ff2b)"); end if; if E2 /= 0 and Substitute then -- Write the default into Target_Filename. Externals.Simple.Echo_Out("Content-Type: Text/Plain; Charset=US-ASCII", Target_Filename); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Extract_Content_Type_From_Header (Email_Filename=" & Email_Filename & ", Target_Filename=" & Target_Filename & ")"); raise; end Extract_Content_Type_From_Header; procedure Extract_Content_Transfer_Encoding_From_Header (Email_Filename : in String; Target_Filename : in String; Ignore_Missing : in Boolean := False; Substitute : in Boolean := False) is E1, E2 : Integer; begin ForkExec2_InOut(Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("1,/^[[:space:]]*$/ ! d")), E1, Value_Nonempty(Config.Binary(Grep)), UBS_Array'(0 => ToUBS("grep"), 1 => ToUBS("-i"), 2 => ToUBS("content-transfer-encoding: ")), E2, Source => Email_Filename, Target => Target_Filename); if E1 /= 0 then Error("Problem with sed! (ff2aa)"); elsif E2 /= 0 and (not Ignore_Missing) then Error("Problem with grep! (ff2ba)"); end if; if E2 /= 0 and Substitute then -- Write the default into Target_Filename. Externals.Simple.Echo_Out("Content-Transfer-Encoding: 7BIT", Target_Filename); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Extract_Content_Transfer_Encoding_From_Header"); raise; end Extract_Content_Transfer_Encoding_From_Header; -- Get the header from a header-body mail into a file. procedure Extract_Header (Email_Filename : in String; Target_Filename : in String) is begin if ForkExec_InOut(Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("-e"), 2 => ToUBS("1,/^[[:space:]]*$/ ! d"), 3 => ToUBS("-e"), 4 => ToUBS("/^[[:space:]]*$/ d")), Source => Email_Filename, Target => Target_Filename) /= 0 then Error("sed failed! (ff11)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Extract_Header"); raise; end Extract_Header; -- Get the body from a header-body mail into a file. procedure Extract_Body (Email_Filename : in String; Target_Filename : in String) is E1, E2 : Integer; begin ForkExec2_InOut(Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("-e"), 2 => ToUBS("/^[[:space:]]*$/,$ ! d")), E1, Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("-e"), -- Delete all leading blank lines. -- Some systems appear to generate -- multiple blank lines. Hopefully -- deleting more than one line won't -- be a problem.... 2 => ToUBS("/./,$!d")), E2, Source => Email_Filename, Target => Target_Filename); if E1 /= 0 then Error("sed failed! (ff3)"); elsif E2 /= 0 then Error("sed failed! (ff13)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Extract_Body"); raise; end Extract_Body; procedure Delete_Trailing_Blank_Lines (Infile : in String; Outfile : in String) is begin if ForkExec_InOut(Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("-e"), 2 => ToUBS(":a"), 3 => ToUBS("-e"), 4 => ToUBS("/^\n*$/{$d;N;};/\n$/ba")), Source => Infile, Target => Outfile) /= 0 then Error("sed failed! (ff5)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Delete_Trailing_Blank_Lines"); raise; end Delete_Trailing_Blank_Lines; -- A temporary file that we'll re-use for cleaning email addresses. Clean_Email_Tempfile : UBS; procedure Clean_Email_Address (F : in String) is use Ada.Strings.Unbounded; E1, E2 : Integer; begin if Clean_Email_Tempfile = Null_Unbounded_String then Clean_Email_Tempfile := ToUBS(Temp_File_Name("cleane")); end if; ForkExec2_InOut(Misc.Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("s/""[^""]*""//g; s/,/\n/g")), E1, Misc.Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("s/^.*.*$//; s/ *//g; s/,/\n/g")), E2, F, ToStr(Clean_Email_Tempfile)); Externals.Simple.Mv_F(ToStr(Clean_Email_Tempfile), F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Clean_Email_address (procedure)"); raise; end Clean_Email_Address; function Clean_Email_Address (E : in String) return String is L, R : Natural; use Ada.Strings.Fixed; begin L := Index(E, "<"); R := Index(E, ">"); if L = 0 then L := E'First; else L := L + 1; end if; if R = 0 then R := E'Last; else R := R - 1; end if; return E(L..R); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Clean_Email_address (function)"); raise; end Clean_Email_Address; procedure Formail_Concat_Extract_InOut (Header : in String; Source : in String; Target : in String) is E : Integer; pragma Unreferenced(E); begin E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)), UBS_Array'(0 => ToUBS("formail"), 1 => ToUBS("-c"), 2 => ToUBS("-x"), 3 => ToUBS(Header)), Source => Source, Target => Target); -- Ignore the return code of formail. It seems to return 1 a -- lot, and I can't find any documentation telling me what it -- _should_ return. end Formail_Concat_Extract_InOut; procedure Formail_Extract_InOut (Header : in String; Source : in String; Target : in String) is E : Integer; pragma Unreferenced(E); begin E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)), UBS_Array'(0 => ToUBS("formail"), 1 => ToUBS("-x"), 2 => ToUBS(Header)), Source => Source, Target => Target); -- Ignore the return code of formail. It seems to return 1 a -- lot, and I can't find any documentation telling me what it -- _should_ return. end Formail_Extract_InOut; procedure Formail_Drop_InOut (Header : in UBS_Array; Source : in String; Target : in String) is F : UBS_Array(0..(2*Header'Length)+1); E : Integer; pragma Unreferenced(E); begin F(0) := ToUBS("formail"); F(1) := ToUBS("-f"); -- Don't add mbox From line at start. for I in 1..Header'Length loop F(2*I) := ToUBS("-I"); F((2*I)+1) := Header(I+Header'First-1); end loop; E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)), F, Source => Source, Target => Target); -- Ignore the return code of formail. It seems to return 1 a -- lot, and I can't find any documentation telling me what it -- _should_ return. end Formail_Drop_InOut; procedure Formail_Action_InOut (Source : in String; Target : in String; Action : in String) is E : Integer; pragma Unreferenced(E); begin E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)), ToUBS("formail -s " & Action), Source => Source, Target => Target); -- Ignore the return code of formail. It seems to return 1 a -- lot, and I can't find any documentation telling me what it -- _should_ return. exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Formail_Action_InOut"); raise; end Formail_Action_InOut; procedure Formail_Replace_Header_InOut (Source : in String; Target : in String; Header : in String) is E : Integer; pragma Unreferenced(E); begin E := ForkExec_InOut(Value_Nonempty(Config.Binary(Formail)), UBS_Array'(0 => ToUBS("formail"), 1 => ToUBS("-f"), 2 => ToUBS("-I"), 3 => ToUBS(Header)), Source => Source, Target => Target); -- Ignore the return code of formail. It seems to return 1 a -- lot, and I can't find any documentation telling me what it -- _should_ return. exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Formail_Replace_Header_InOut"); raise; end Formail_Replace_Header_InOut; -- A temporary file that we'll re-use for formail_action. Formail_Replace_Header_Tempfile : UBS; procedure Formail_Replace_Header (File : in String; Header : in String) is use Ada.Strings.Unbounded; begin if Formail_Replace_Header_Tempfile = Null_Unbounded_String then Formail_Replace_Header_Tempfile := ToUBS(Temp_File_Name("fa")); end if; Formail_Replace_Header_InOut(File, ToStr(Formail_Replace_Header_Tempfile), Header); Externals.Simple.Cat_Out(ToStr(Formail_Replace_Header_Tempfile), File); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Formail_Replace_Header"); raise; end Formail_Replace_Header; subtype Upper_Letters is Character range 'A'..'Z'; package Random_Letters is new Ada.Numerics.Discrete_Random(Upper_Letters); Random_Letters_Generator : Random_Letters.Generator; function Get_Boundary return String is U : UBS; use type UBS; begin U := ToUBS("MIME_CONTENT_BREAK_" & "=_"); -- Add some random stuff. for I in 1..31 loop U := U & Random_Letters.Random(Random_Letters_Generator); end loop; return ToStr(U); end Get_Boundary; procedure Mimeconstruct2 (Part1_Filename : in String; Part2_Filename : in String; Output_Filename : in String; Content_Type : in String; Prolog : in String := "") is begin if Prolog'Length > 0 then if ForkExec_Out(Value_Nonempty(Config.Binary(Mimetool)), UBS_Array'(0 => ToUBS("mime-tool"), 1 => ToUBS("-P"), 2 => ToUBS(Prolog), 3 => ToUBS("-B"), 4 => ToUBS(Get_Boundary), 5 => ToUBS("-O"), 6 => ToUBS(Content_Type), 7 => ToUBS("-o"), 8 => ToUBS("-p"), 9 => ToUBS(Part1_Filename), 10 => ToUBS("-o"), 11 => ToUBS("-p"), 12 => ToUBS(Part2_Filename)), Output_Filename) /= 0 then Error("mime-tool failed. (mff1a)"); end if; else if ForkExec_Out(Value_Nonempty(Config.Binary(Mimetool)), UBS_Array'(0 => ToUBS("mime-tool"), 1 => ToUBS("-B"), 2 => ToUBS(Get_Boundary), 3 => ToUBS("-O"), 4 => ToUBS(Content_Type), 5 => ToUBS("-o"), 6 => ToUBS("-p"), 7 => ToUBS(Part1_Filename), 8 => ToUBS("-o"), 9 => ToUBS("-p"), 10 => ToUBS(Part2_Filename)), Output_Filename) /= 0 then Error("mime-tool failed. (mff1b)"); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Mimeconstruct2"); raise; end Mimeconstruct2; Disposition_String : constant array (Dispositions) of String(1..2) := (None => "-o", -- No disposition line. Inline => "-i", -- Use inline. Attachment => "-0"); -- No-op -- the default is attachment. procedure Mimeconstruct_Subpart (Infile : in String; Outfile : in String; Content_Type : in String; Dos2UnixU : in Boolean; Use_Encoding : in Boolean; Disposition : in Dispositions := None; Encoding : in String := ""; Attachment_Name : in String := "") is Encode : String(1..2); MC : UBS_Array(0..9); begin MC(0) := ToUBS("mime-tool"); MC(1) := ToUBS("-s"); -- Figure out which encoding to use. if Use_Encoding then if Encoding = "base64" then Encode := "-x"; elsif Encoding = "quoted-printable" then Encode := "-q"; elsif Encoding = "7bit" then Encode := "-7"; elsif Encoding = "8bit" then Encode := "-8"; else Encode := "-x"; end if; MC(2) := ToUBS(Encode); MC(3) := ToUBS("-0"); else -- No encoding requested, so we'll set it to binary and omit -- the content-transfer-encoding. MC(2) := ToUBS("-b"); MC(3) := ToUBS("-m"); end if; if Config.Boolean_Opts(Omit_Inline_Disposition_Header) and Disposition = Inline then -- Override it to None. MC(4) := ToUBS(Disposition_String(None)); else MC(4) := ToUBS(Disposition_String(Disposition)); end if; if Disposition = None or (Config.Boolean_Opts(Omit_Inline_Disposition_Header) and Disposition = Inline) then -- Some no-ops: we weren't going to show a name. MC(5) := ToUBS("-0"); MC(6) := ToUBS("-0"); else if Attachment_Name'Length > 0 then -- Should we use this attachment name? if Disposition = Inline and Config.Boolean_Opts(Omit_Inline_Disposition_Name) then -- We don't want the name. MC(5) := ToUBS("-N"); MC(6) := ToUBS("-0"); else -- Use this name. MC(5) := ToUBS("-n"); MC(6) := ToUBS(Attachment_Name); end if; else -- We don't have an attachment name. Let mime-tool sort it out. MC(5) := ToUBS("-0"); MC(6) := ToUBS("-0"); end if; end if; -- The content-type and the file. MC(7) := ToUBS("-c"); MC(8) := ToUBS(Content_Type); MC(9) := ToUBS(Infile); -- Now actually construct the MIME subpart. if ForkExec_Out(Value_Nonempty(Config.Binary(Mimetool)), MC, Outfile) /= 0 then Error("mime-tool failed. (mff3)"); end if; -- Do we need to convert the file with dos2unix? if Dos2UnixU then Externals.Simple.Dos2Unix_U(Outfile); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Mimeconstruct_Subpart"); raise; end Mimeconstruct_Subpart; -- Construct an entire multipart/mixed email. procedure Mimeconstruct_Mixed (Filenames : in UBS_Array; Outfile : in String) is -- Arg array size is ( 3*num-filenames ) +5, but starting at 0. A : UBS_Array(0 .. (3 * Filenames'Length)+4); begin A(0) := ToUBS("mime-tool"); A(1) := ToUBS("-B"); A(2) := ToUBS(Get_Boundary); A(3) := ToUBS("-O"); A(4) := ToUBS("multipart/mixed"); for I in 1..Filenames'Length loop -- First one should be 5. A((3*I)+2) := ToUBS("-o"); A((3*I)+3) := ToUBS("-p"); A((3*I)+4) := Filenames(I+Filenames'First-1); end loop; if ForkExec_Out(Value_Nonempty(Config.Binary(Mimetool)), A, Outfile) /= 0 then Error("mime-tool failed. (mff2)"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Mimeconstruct_Mixed"); raise; end Mimeconstruct_Mixed; -- From RFC2045: (A good strategy is to choose a boundary that includes -- a character sequence such as "=_" which can never appear in a -- quoted-printable body. See the definition of multipart messages in -- RFC 2046.) -- Because we might build multiple parts, we'll use a boundary of -- MIME_CONTENT_BREAK_=_(partno)=_(random stuff) -- where partno is a per-topal-run counter. (Later: removed partno) -- Note that mime-tool actually uses --=_%s_= as the boundary. -- We don't currently check for boundary collisions in the data. -- We should. -- Then we call out to our patched version of mime-tool -- View a MIME file. procedure View_MIME (F : in String; Decrypt : in Boolean) is Chosen : Positive; MTF : constant String := Temp_File_Name("vmmt"); MTFE : constant String := Temp_File_Name("vmmte"); MT, MTE : UBS; NC : Boolean := False; NTFE : Boolean := False; CT : UBS; CTE : UBS; Dummy : Integer; F2 : constant String := Temp_File_Name("f2"); pragma Unreferenced(Dummy); begin -- Find out the type of MIME file. Externals.Mail.Extract_Content_Type_From_Header(F, MTF, Ignore_Missing => True); MT := Read_Fold(MTF); Externals.Mail.Extract_Content_Transfer_Encoding_From_Header(F, MTFE, Ignore_Missing => True); MTE := Read_Fold(MTFE); Ada.Text_IO.New_Line(5); declare MTFS : constant String := ToStr(MT); MTFES : constant String := ToStr(MTE); I, I2 : Integer; J, J2 : Integer; begin I := Ada.Strings.Fixed.Index(MTFS, ": "); if I = 0 then I := MTFS'First; NC := True; else I := I + 2; end if; I2 := Ada.Strings.Fixed.Index(MTFS, ";"); if I2 = 0 then I2 := MTFS'Last; else I2 := I2 - 1; end if; J := Ada.Strings.Fixed.Index(MTFES, ": "); if J = 0 then J := MTFES'First; NTFE := True; else J := J + 2; end if; J2 := Ada.Strings.Fixed.Index(MTFES, ";"); if J2 = 0 then J2 := MTFES'Last; else J2 := J2 - 1; end if; if NC then Ada.Text_IO.Put_Line("About to view an attachment with " & Do_SGR(Config.UBS_Opts(Colour_Info)) & "no content type" & Reset_SGR); CT := ToUBS("text/plain"); else Ada.Text_IO.Put_Line("About to view an attachment with " & "content type `" & Do_SGR(Config.UBS_Opts(Colour_Info)) & MTFS(I..I2) & Reset_SGR & "'"); CT := ToUBS(MTFS(I..I2)); end if; if NTFE then Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Info)) & "No content transfer encoding" & Reset_SGR); CTE := ToUBS("7bit"); else CTE := ToUBS(Ada.Strings.Fixed.Translate(MTFES(J..J2), Ada.Strings.Maps.Constants.Lower_Case_Map)); Ada.Text_IO.Put_Line("Content transfer encoding is `" & Do_SGR(Config.UBS_Opts(Colour_Info)) & ToStr(CTE) & Reset_SGR & "'"); end if; end; -- Do we have to ask which viewer...? -- We'll short circuit this in the case of application/(x-)pkcs7-mime and smime-type. This information would get lost in the call. if Ada.Strings.Fixed.Index(Ada.Strings.Fixed.Translate(ToStr(MT), Ada.Strings.Maps.Constants.Lower_Case_Map), "smime-type=signed-data") /= 0 then Chosen := 99; elsif Decrypt then Chosen := Config.Positive_Opts(MIME_Viewer_Decrypt); else Chosen := Config.Positive_Opts(MIME_Viewer_Verify); end if; if Chosen = 1 then -- Ask what we should do. Chosen := MV_Values(MIME_Viewer_Menu2); end if; -- Actually execute the chosen viewer method. case Chosen is when 2 => -- Metamail Ada.Text_IO.Put_Line("Viewing attachment with metamail..."); if ForkExec(Misc.Value_Nonempty(Config.Binary(Metamail)), UBS_Array'(0 => ToUBS("metamail"), 1 => ToUBS(F))) /= 0 then Misc.ErrorNE("metamail failed! (ff5)"); end if; when 3 => -- run-mailcap -- FIXME: Deal with multipart nicely. declare B : constant String := Temp_File_Name("vmb"); B2 : constant String := Temp_File_Name("vmb2"); use type UBS; begin if NC then Ada.Text_IO.Put_Line("Hoping that this is text/plain (no content-type!)"); end if; -- Handle the transfer encoding! If it's QP or base64, -- decode it! Externals.Mail.Extract_Body(F, B); if ToStr(CTE) = "quoted-printable" then QP_Decode(B, B2); Externals.Simple.Cat_Out(B2, B); elsif ToStr(CTE) = "base64" then Base64_Decode(B, B2); Externals.Simple.Cat_Out(B2, B); end if; Ada.Text_IO.Put_Line("Viewing attachment with run-mailcap..."); if ForkExec(Misc.Value_Nonempty(Config.Binary(Runmailcap)), UBS_Array'(0 => ToUBS("run-mailcap"), 1 => CT & ToUBS(":" & B))) /= 0 then Misc.ErrorNE("run-mailcap failed! (ff5)"); end if; end; when 4 => -- Save -- Write out the file to a well-known place. declare VMF : constant String := ToStr(Topal_Directory) & "/viewmime"; begin Externals.Simple.Echo_Append_N("From MAILER-DAEMON ", VMF); Externals.Simple.Date_1_Append("+%a %b %e %H:%M:%S %Y", VMF); Externals.Simple.Echo_Append("From: Topal-MIME-view", VMF); Externals.Simple.Echo_Append_N("Date: ", VMF); Externals.Simple.Date_1_Append("--rfc-2822", VMF); Externals.Simple.Echo_Append("MIME-Version: 1.0", VMF); Externals.Simple.Cat_Append(F, VMF); Ada.Text_IO.Put_Line("Appended email to mbox " & VMF); end; when 5 => -- Skip Ada.Text_IO.Put_Line("Skipping attachment..."); when 99 => -- Invoke topal on this attachment. Ada.Text_IO.Put_Line("Should run Topal on this one."); Externals.Mail.Extract_Body(F, F2); Dummy := Externals.Simple.System("topal -mime " & F2 & " ""application/x-pkcs7-mime; smime-type=signed-data"""); when others => Misc.ErrorNE("Bogus value in Externals.Mail.View_MIME"); end case; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.View_MIME"); raise; end View_MIME; -- Base 64 decode from infile to outfile. -- Uses openssl internally. procedure Base64_Decode (Infile, Outfile : in String) is Dummy : Integer; pragma Unreferenced(Dummy); begin Dummy := ForkExec(Value_Nonempty(Config.Binary(Openssl)), UBS_Array'(0 => ToUBS("openssl"), 1 => ToUBS("base64"), 2 => ToUBS("-d"), 3 => ToUBS("-in"), 4 => ToUBS(Infile), 5 => ToUBS("-out"), 6 => ToUBS(Outfile))); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Base64_Decode"); raise; end Base64_Decode; -- Quoted-printable decode from infile to outfile. procedure QP_Decode (Infile, Outfile : in String) is InF : Ada.Text_IO.File_Type; OutF : Character_IO.File_Type; begin -- Read, character by character, until end-of-line. Ada.Text_IO.Open(File => InF, Mode => Ada.Text_IO.In_File, Name => Infile); Character_IO.Create(File => OutF, Mode => Character_IO.Out_File, Name => Outfile); Decode_Loop: loop begin -- Simple copy. declare U : constant UBS := Unbounded_Get_Line(InF); S : constant String := ToStr(U); I : Integer; H : Integer; Need_NL : Boolean := True; begin -- Walk through S. -- If we see `=', then -- (i) it's at the end of a line: it's a soft line break, so don't output even a newline. -- (ii) it should be followed by two hex characters. decode and print. I := S'First; Char_Loop: while I <= S'Last loop if S(I) = '=' then if I = S'Last then -- Soft line break. Need_NL := False; exit Char_Loop; elsif I+2 > S'Last then -- Overrunning the end of a line? Just print it. Character_IO_Put(OutF, S(I..S'Last)); I := S'Last + 1; else -- Decode. begin H := Hex_Decode(S(I+1..I+2)); Character_IO.Write(OutF, Character'Val(H)); I := I + 3; exception when Constraint_Error => -- Not hex? Ignoring it. Character_IO.Write(OutF, S(I)); I := I + 1; end; end if; else Character_IO.Write(OutF, S(I)); I := I + 1; end if; end loop Char_Loop; if Need_NL then Character_IO.Write(OutF, Ada.Characters.Latin_1.LF); end if; end; exception when Ada.IO_Exceptions.End_Error => exit Decode_Loop; end; end loop Decode_Loop; Ada.Text_IO.Close(File => InF); Character_IO.Close(File => OutF); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.QP_Decode"); raise; end QP_Decode; -- Return hash of infile. -- Uses openssl internally. function Hash_File (Infile : in String) return String is Dummy1, Dummy2 : Integer; pragma Unreferenced(Dummy1, Dummy2); F : constant String := Temp_File_Name("hash"); begin ForkExec2_InOut(Value_Nonempty(Config.Binary(Openssl)), UBS_Array'(0 => ToUBS("openssl"), 1 => ToUBS("sha256")), Dummy1, Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("s/(stdin)= //")), Dummy2, Infile, F); return ToStr(Read_Fold(F)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Hash_File"); raise; end Hash_File; procedure Replace_Message_ID(Hdrfile : in String; Alt_Sign : in String; Encrypt_Message_ID : in Boolean; Encrypt_Key : in String) is F : constant String := Temp_File_Name("rmid"); E1 : constant String := Temp_File_Name("emid1"); E2 : constant String := Temp_File_Name("emid2"); E3 : constant String := Temp_File_Name("emid3"); EM : UBS; R : String(1..8); ORV : Integer; begin if Encrypt_Message_ID then -- Copy the message-id. Externals.Mail.Formail_Concat_Extract_InOut("Message-ID:", Hdrfile, E1); -- Make cryptogram. EM := ToUBS(Trim_Leading_Spaces(ToStr(Read_Fold(E1)))); Externals.Simple.Echo_Out(ToStr(EM), E2); ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl))) & " enc -aes-128-cbc -in " & E2 & " -out " & E3 & " -pass pass:" & Encrypt_Key & " -e -a -A -md sha256"); if ORV = 0 then -- Only write it on success. Externals.Simple.Echo_Append("X-Topal-Message-ID: " & Trim_Leading_Spaces(ToStr(Read_Fold(E3))), Hdrfile); end if; end if; -- Munge and randomize the Message-ID (using sed). for I in R'Range loop R(I) := Random_Letters.Random(Random_Letters_Generator); end loop; -- Message-ID used to be something like alpine.lnx. etc. -- Default Alpine 2.21 now has something like -- alpine.DEB.7.76.1703211942350.21297@hostname Externals.Simple.Sed_InOut ("s/^\(Message-ID: \)<\([aA]l\)\?[pP]ine\....\..\...\.\(.*\)@\(.*\)>$/\1<\3." & R & "%" & Alt_Sign & ">/;" & " s/^\(Message-ID: \)<[ACEILNPRVYaceilnprvy]\{4,6\}\.[a-zA-Z0-9\.]\{7,12\}\.\([0-9\.]*\)@\(.*\)>$/\1<" & R & ".\2%" & Alt_Sign & ">/", Hdrfile, F); Externals.Simple.Cat_Out(F, Hdrfile); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Replace_Message_ID"); raise; end Replace_Message_ID; procedure Replace_Content_IDs(Tmpfile : in String; Alt_Sign : in String) is F : constant String := Temp_File_Name("rcid"); begin Externals.Simple.Sed_InOut("s/^\(Content-ID: \)<\([aA]l\)\?[pP]ine\....\..\...\.\(.*\)@\(.*\)>$/\1<\3%" & Alt_Sign & ">/", Tmpfile, F); Externals.Simple.Cat_Out(F, Tmpfile); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Replace_Content_IDs"); raise; end Replace_Content_IDs; -- Calculate a token for an X-Topal-Send-Token header. function Calculate_Send_Token(Hdrfile : in String; Per_User_Token : in String) return String is F_Name : constant String := Temp_File_Name("stf"); M_Name : constant String := Temp_File_Name("stm"); H_Name : constant String := Temp_File_Name("sth"); Token : UBS; use type UBS; begin -- Extract the From and Message-ID lines. Externals.Mail.Formail_Concat_Extract_InOut("From: ", Hdrfile, F_Name); Externals.Mail.Formail_Concat_Extract_InOut("Message-ID: ", Hdrfile, M_Name); -- Concatenate them with the token. Token := ToUBS(Per_User_Token) & ':' & Read_Fold(F_Name) & ':' & Read_Fold(M_Name); -- SHA1. -- Add the new header, X-Topal-Send-Token Externals.Simple.Echo_Out(ToStr(Token), H_Name); -- Return it. return Hash_File(H_Name); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Calculate_Send_Token"); raise; end Calculate_Send_Token; procedure Check_Send_Token(Per_User_Token : in String) is In_F : constant String := Temp_File_Name("in"); T_Name1 : constant String := Temp_File_Name("token1"); T_Name2 : constant String := Temp_File_Name("token2"); T_Name3 : constant String := Temp_File_Name("token3"); T_Name4 : constant String := Temp_File_Name("token4"); Token : UBS; begin Externals.Simple.Cat_Stdin_Out(In_F); -- The token should be this: Token := ToUBS(Calculate_Send_Token(In_F, Per_User_Token)); -- Get the current token. Externals.Mail.Formail_Concat_Extract_InOut("X-Topal-Send-Token:", In_F, T_Name1); -- Do they match? Debug("Token read: " & Trim_Leading_Spaces(ToStr(Read_Fold(T_Name1)))); Debug("Token calculated: " & ToStr(Token)); if Trim_Leading_Spaces(ToStr(Read_Fold(T_Name1))) = ToStr(Token) then Formail_Replace_Header(In_F, "X-Topal-Check-Send-Token: yes"); else Formail_Replace_Header(In_F, "X-Topal-Check-Send-Token: no"); end if; -- Also, if an X-Topal-Message-ID is present, then see if we can -- calculate it as X-Topal-Original_Message-ID. Externals.Mail.Formail_Concat_Extract_InOut("X-Topal-Message-ID:", In_F, T_Name2); -- FIXME: Of course, another way to do this would be to record the original and altered message-ids…. -- Trim the leading space…. declare MID : constant String := Trim_Leading_Spaces(ToStr(Read_Fold(T_Name2))); D1 : constant String := Temp_File_Name("dmid1"); D2 : constant String := Temp_File_Name("dmid2"); ORV : Integer; begin -- So we now have the string. -- If it's non-empty, we'll assume it's worth decrypting. if MID'Length > 0 then Externals.Simple.Echo_Out(MID, D1); ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl))) & " enc -aes-128-cbc -in " & D1 & " -out " & D2 & " -pass pass:" & Per_User_Token & " -d -a -A -md sha256"); if ORV = 0 then -- Success, we'll write a new header. Formail_Replace_Header(In_F, "X-Topal-Original-Message-ID: " & Trim_Leading_Spaces(ToStr(Read_Fold(D2)))); end if; end if; end; -- Also, if an X-Topal-Fcce is present, then see if we can -- calculate it as X-Topal-Fcc. Externals.Mail.Formail_Concat_Extract_InOut("X-Topal-Fcce:", In_F, T_Name3); -- Trim the leading space…. declare MID : constant String := Trim_Leading_Spaces(ToStr(Read_Fold(T_Name3))); D1 : constant String := Temp_File_Name("dmid1"); D2 : constant String := Temp_File_Name("dmid2"); ORV : Integer; begin -- So we now have the string. -- If it's non-empty, we'll assume it's worth decrypting. if MID'Length > 0 then Externals.Simple.Echo_Out(MID, D1); ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl))) & " enc -aes-128-cbc -in " & D1 & " -out " & D2 & " -pass pass:" & Per_User_Token & " -d -a -A -md sha256"); if ORV = 0 then -- Success, we'll write a new header. Formail_Replace_Header(In_F, "X-Topal-Fcc: " & Trim_Leading_Spaces(ToStr(Read_Fold(D2)))); end if; end if; end; -- Also, if an X-Topal-Bcce is present, then see if we can -- calculate it as X-Topal-Bcc. Externals.Mail.Formail_Extract_InOut("X-Topal-Bcce:", In_F, T_Name4); -- Trim the leading space…. declare MID : constant String := Trim_Leading_Spaces(ToStr(Read_Fold(T_Name4, Include_LF => True))); D1 : constant String := Temp_File_Name("dmid1"); D2 : constant String := Temp_File_Name("dmid2"); ORV : Integer; begin -- So we now have the string. -- If it's non-empty, we'll assume it's worth decrypting. if MID'Length > 0 then Externals.Simple.Sed_InOut("s/^ //", T_Name4, D1); ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl))) & " enc -aes-128-cbc -in " & D1 & " -out " & D2 & " -pass pass:" & Per_User_Token & " -d -a -A -md sha256"); if ORV = 0 then -- Success, we'll write a new header. Formail_Replace_Header(In_F, "X-Topal-Bcc: " & Trim_Leading_Spaces(ToStr(Read_Fold(D2, Include_LF => True)))); end if; end if; end; -- Finally, write out the file (we're a filter!). Externals.Simple.Cat(In_F); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Check_Send_Token"); raise; end Check_Send_Token; procedure Replace_Fcc(Hdrfile : in String; Encrypt_Key : in String) is E1 : constant String := Temp_File_Name("efcc1"); E2 : constant String := Temp_File_Name("efcc2"); E3 : constant String := Temp_File_Name("efcc3"); E4 : constant String := Temp_File_Name("efcc4"); EM : UBS; ORV : Integer; begin -- Copy X-Topal-Fcc. Externals.Mail.Formail_Concat_Extract_InOut("X-Topal-Fcc:", Hdrfile, E1); -- Make cryptogram. EM := ToUBS(Trim_Leading_Spaces(ToStr(Read_Fold(E1)))); if Ada.Strings.Unbounded.Length(EM) > 0 then -- Non-empty. Externals.Simple.Echo_Out(ToStr(EM), E2); ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl))) & " enc -aes-128-cbc -in " & E2 & " -out " & E3 & " -pass pass:" & Encrypt_Key & " -e -a -A -md sha256"); if ORV = 0 then -- Only write it on success. Externals.Simple.Echo_Append_N("X-Topal-Fcce: " & Trim_Leading_Spaces(ToStr(Read_Fold(E3))), Hdrfile); -- Remove the old header. Formail_Drop_InOut(UBS_Array'(1 => ToUBS("X-Topal-Fcc:")), Hdrfile, E4); -- This seems to leave a trailing blank line often. We -- need to remove it. Externals.Simple.Rm_File(Hdrfile); Delete_Trailing_Blank_Lines(E4, Hdrfile); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Replace_Fcc"); raise; end Replace_Fcc; procedure Add_Bcc(Hdrfile : in String; Encrypt_Key : in String) is E1 : constant String := Temp_File_Name("ebcc1"); E2 : constant String := Temp_File_Name("ebcc2"); E3 : constant String := Temp_File_Name("ebcc3"); E4 : constant String := Temp_File_Name("ebcc4"); EM : UBS; ORV : Integer; begin -- Copy Bcc. Externals.Mail.Formail_Concat_Extract_InOut("Bcc:", Hdrfile, E1); -- Make cryptogram. EM := ToUBS(Trim_Leading_Spaces(ToStr(Read_Fold(E1)))); if Ada.Strings.Unbounded.Length(EM) > 0 then -- Non-empty. Externals.Simple.Echo_Out(ToStr(EM), E2); ORV := Externals.Simple.System(ToStr(Value_Nonempty(Config.Binary(Openssl))) & " enc -aes-128-cbc -in " & E2 & " -out " & E3 & " -pass pass:" & Encrypt_Key -- Note that we allow folding! -- No -A! & " -e -a -md sha256"); if ORV = 0 then -- Only write it on success. Externals.Simple.Echo_Append_N("X-Topal-Bcce: ", Hdrfile); -- Prefix each line other than the first with a space. Externals.Simple.Sed_InOut("1! s/^/ /", E3, E4); Externals.Simple.Cat_Append(E4, Hdrfile); -- Mustn't remove Bcc! end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Mail.Add_Bcc"); raise; end Add_Bcc; begin Random_Letters.Reset(Random_Letters_Generator); end Externals.Mail; topal-80/command_line_wrapper.ads0000644000175000017500000000304213434071426015413 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Command_Line_Wrapper is Argument_Overrun : exception; -- Three functions for working through the command line. -- The first only advances the pointer if the test was true. -- Two forms, one taking a string, one taking a UBS_Array. function Match (A : in String) return Boolean; function Match (A : in UBS_Array) return Boolean; -- This second function always advances. function Eat return UBS; -- This last function returns true if there is still something to read. function More (Needed : Positive := 1) return Boolean; -- Given J, the index of the first command line argument to drop into an -- array, drop J, J+1, etc. into an array and return it. function Eat_Remaining_Arguments return UBS_Array_Pointer; -- Display the current argument. function Current return String; end Command_Line_Wrapper; topal-80/Features.html0000644000175000017500000000506513434071426013210 0ustar pjbpjb Topal — Features

    Topal — Features

    Copyright © 2001–2018 Phillip J. Brooke

    Topal is a ‘glue’ program that links GnuPG and Pine/Alpine/Re-Alpine. It offers facilities to encrypt, decrypt, sign and verify emails, including inline OpenPGP, MIME/OpenPGP and S/MIME. It can also be used directly from the command-line.

    • Multiple inline PGP blocks can be processed in display filters.
    • Decryption and verification output can be cached to reduce the number of times a passphrase is entered. This also helps when secret keys aren't always available, at the expense of storing decrypted output.
    • MIME/OpenPGP (RFC2015/RFC3156) multipart messages can be sent and received. Depending on configuration, this might involve procmail, using sendmail-path or patching Alpine.
    • The deprecated application/pgp content-type can be sent and received.
    • S/MIME messages can be sent and received if gpgsm is available. (openssl is also used in some circumstances, but gpgsm is still required.)
    • Topal can be used as Alpine's sendmail-path command.
    • Topal has a remote sending mode (a server and a means of accessing the server) for reading email on a distant computer via SSH with secret keys on the local computer.
    • A range of mechanisms for selecting keys for both self and recipients.
    • There is a high level of configurability (although the configuration interface does not expose all of it; you might have to edit .topal/config).

    See the documentation in topal.pdf for further details.

    topal-80/MIME-tool/0000700000175000017500000000000013434071426012226 5ustar pjbpjbtopal-80/MIME-tool/mime-tool.man0000644000175000017500000000745313434071426014650 0ustar pjbpjb.TH "MIME message tool" 1 mime "MIME tool" .SH NAME mime-tool \- a simple program to construct MIME messages with attached files .SH SYNOPSIS .B mime [ .B -dDvV ] [ .B -S subject ] [ .B -F from-address ] [ .B -T to-address ] [ .B -C carbon-copy address ] [ .B -P prolog-text ] [ .B -E epiplogue-text ] [ .B -B boundary ] [ .B -O overall content-type ] { [ .B -78abiquxopm ] [ .B -t content-type ] filename } .SH DESCRIPTION The .B mime program constructs MIME messages with attached files. The user can specify the content type (application/octet-stream, text/plain or a user specified type), content type encoding (7bit, 8bit, binary, base64 and auto-detect), content disposition (attached or inline) and the content boundary string. The user can also specify some mail related options: subject, from-address, to-address, carbon-copy address, prolog-text and epilog-text. The output of the MIME-tool program can be sent directly to the .IR mail ", " mailx " or " sendmail commands (or any other command that accepts RFC-822 formatted messages). .B NOTE: Specifying 7-bit encoding for an attachment that contains 8-bit data will convert any data bytes whose high-bit is set to question marks. .SH OPTIONS .TP .B -7 7-bit ASCII encoding .TP .B -8 8-bit ASCII encoding .TP .B -a application/octet-stream content type .TP .B -b binary encoding .TP .B -d low detail debugging .TP .B -D high detail debugging .TP .B -s write a subpart .TP .B -i disposition: inline (instead of attachment) .TP .B -q quoted-printable encoding .TP .B -c content-type explicit content type .TP .B -t text/plain content type .TP .B -o omit disposition line .TP .B -u unknown encoding, auto-detect .TP .B -v verbose messages .TP .B -V very verbose messages .TP .B -x base64 encoding .TP .B -p copy existing MIME part .TP .B -o omit content-disposition .TP .B -m omit content-transfer-encoding .TP .B -n filename override the filename in the disposition header .TP .B -N don't add a filename parameter in the disposition header .TP .B -0 no-op .SH EXAMPLES Using MIME-tool to write a mail message to a file: .RS mime -S "test message" -F me@foo.net -T someone@somewhere.net file1 > test.msg .RE Using MIME-tool with the .I mail command: .RS mime -S "test message" -F me@foo.net file1 | mail someone@somewhere.net .RE Using MIME-tool with the .I mailx command: .RS mime -S "test message" -F me@foo.net file1 | mailx someone@somewhere.net .RE Using MIME-tool with the .I sendmail command: .RS mime -S "test message" -F me@foo.net file1 | sendmail someone@somewhere.net .RE .SH VERSION This is version 1.5.topal3 from June 2009. .SH KNOWN BUGS Most of the header values are not properly quoted or folded, so long or complex values for these headers may cause problems. Specifically, the from-address, to-address, carbon-copy-address and content-type headers may not be properly quoted or folded. For some reason, certain e-mail clients (espcially from a large software company located in Redmond, Washington) don't seem to recognize file attachments as attachments, but instead displays them as inline attachments. (maybe this isn't MIME-tool's fault, but I've gotten a few e-mails about it, so I'm mentioning it here) .SH AUTHOR .B mime is written by Jeffrey Dutky Oscar Esteban spotted an off-by-one error in the base64 encoding function. Sergey Lapin spotted a bug in the filename header construction. Chris Hemphill noticed that the documentation (this manual page and the README file) didn't include any examples of how to call the program with common mail commands. Some additional fixes and additions by Phil Brooke to support Topal. .SH AVAILABILITY The original MIME-tool package can be downloaded from my web page at http://members.bellatlantic.net/~dutky This modified version is distributed with Topal: http://homepage.ntlworld.com/phil.brooke/topal/ topal-80/MIME-tool/README.txt0000644000175000017500000000676613434071426013755 0ustar pjbpjbI wrote this program when I needed a tool to construct MIME encoded emails with file attachments in job scripts on a production box. Being a production box it didn't have any development tools installed. However, the box DID have a K&R C compiler that appears to be necessary for some administrative task or another (configuring the kernel?). If you tried to compile even fairly simple ANSI/ISO C source the compiler bitched and moaned about all the stuff it didn't support, which will stop most folk (at least those who don't know anything about the history of the C programming language) from building their own binaries. Since I'm old enough to actually have written C code back before we had the ANSI/ISO standard and all the accompanying niceties, I was not stymied by a the lack of ANSI/ISO support. It's really not all that hard to write K&R compliant code, so long as you don't need the compiler to check your function calls for you. For a program this small, however, that's not much of a concern. Since the program is meant to be compiled on systems with minimal support (there is no telling what unrestrained IT staff will decide must be removed in the interest of system security) I didn't bother to include a makefile. On every system I have tried, however, the program compiled with the simple incantation cc -o mime mime.c but your selected target system may require extra special magics. The program supports the basic MIME standard: The caller can select the content type (application/octet-stream, text/plain, or user specified), content type encoding (7bit, 8bit, binary, base64 or auto-detected) and the boundary string (defaults to "=_MIME_CONTENT_BREAK_="). Further, the caller may specify the e-mail subject, to address, from address, carbon copy address and text for a prolog and epilog. The content type and encoding may be specified separately for each attached file. The program's calling format is: mime [-dDvV] [-S subject] [-F from-address] [-T to-address] [-C carbon-copy address] [-P prolog-text] [-E epiplogue-text] [-B boundary] {[-78abqux] [-t content-type] filename} -d low detail debugging -D high detail debugging -v verbose messages -V very verbose messages -7 7-bit ASCII encoding -8 8-bit ASCII encoding -a application/octet-stream content type -b binary encoding -q quoted-printable encoding -t text/plain content type -u unknown encoding, auto-detect -x base64 encoding There's really not much to this program. Once you know how the MIME messages are constructed you could do most of it manually (except for the base64 encoding, which would require a program like this), but if there are any problems with it, I would like to know about them. I can be contacted at dutky@bellatlantic.net The output from MIME-tool is an RFC-822 formatted internet mail message and can be fed into any mail handling program that expects such messages, such as mail, mailx or sendmail. Here are some examples of how to use MIME-tool with these three programs to send a MIME message containing an attached file: mime -S "test message" -F me@foo.net file1 | mail someone@somewhere.net mime -S "test message" -F me@foo.net file1 | mailx someone@somewhere.net mime -S "test message" -F me@foo.net file1 | sendmail someone@somewhere.net In each case the message subject is "test message", the message is sent from me@foo.net, contains the attached file named "file1" and is sent to the email address "someone@somewhere.net". topal-80/MIME-tool/GPL.txt0000644000175000017500000004313113434071426013425 0ustar pjbpjb GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. topal-80/MIME-tool/mime.c0000644000175000017500000005647613434071426013355 0ustar pjbpjb/* Notice of Copyright, License and Warranty ** ** This software is Copyright 2004, 2006 Jeffrey S. Dutky ** Updated February 2005 to fix off-by-one error reported by Oscan Esteban ** Updated May 2006 to restrict byte values in 7-bit endcoded data ** Updated May 2006 to fix filename header contents, thanks to Sergey Lapin ** Updated June 2006 (manpage and README.txt files) for Chris Hemphill ** Updated June 2006 to better handle long filenames (quote and fold) ** Updated July 2008 by Phillip J. Brooke: ** - Minor cleanup (stop warning about err variable) ** - Added Makefile. ** - Corrected docs/info re: -c and -t options. ** - Added -p (copy thru') option (for use by Topal). ** - Boundary option not honoured -- fixed. ** - Added -o to omit disposition line. ** - Added -O to give an overall content type. ** - Added -m to omit content-transfer-encoding. ** - Fixed quoted-printable encoder (at least, to what I ** understand RFC2045 requires). ** - Added subpart (-s) switch. ** - Escape a single `.' on a line, and 'From ' at line-start, as ** suggested by RFC2049. ** Updated April 2009 by Phillip J. Brooke: ** - Correct a typo in comments. ** - Add option to force name in disposition (-n). ** - Add no-op option (-0 -- that's a zero). ** Updated June 2009 by Phillip J. Brooke: ** - Add option to omit disposition name (-N). ** - Man page update. ** - Typo corrections. ** Updated March 2011 by Phillip J. Brooke: ** - Bug fix in base64() where very short files (1 or 2 byte) ** weren't processed. ** Updated September 2019, PJB, applying typo fixes from Nicolas Boulenguez. ** ** This software is licensed for use under the terms of the GNU General ** Public License (also called the GPL), a copy of which must be included ** with any distribution of this software. You may also find a copy of the ** GPL at the Free Software Foundation's web site at http://www.fsf.org/ ** or http://www.gnu.org. ** ** This software is provided "as is" and without any express or implied ** warranties, including, without limitation, the implied waranties of ** merchantability and fitness for a particular purpose. */ #include #include #include #include #define MT_VERSION "1.5.topal3" #define MT_DATE "June 2009" /* ** A simple mime message utility: create MIME encoded messages with attached ** files. The program can be used to construct input to the standard unix ** mail and mailx commands. ** ** mime [-dDvV] [-S subject] [-F from-address] [-T to-address] ** [-C carbon-copy address] [-P prolog-text] [-E epiplogue-text] ** [-O overall content-type] [-B boundary] -s ** {[-78abiquxtpom] [-c content-type] [-n filename] filename} ** ** -d low detail debugging ** -D high detail debugging ** -v verbose messages ** -V very verbose messages ** -s write this as a subpart (makes little sense if more than ** one filename given) ** ** -O overall content-type (e.g., multipart/signed) ** -7 7-bit ASCII encoding ** -8 8-bit ASCII encoding ** -a application/octet-stream content type ** -b binary encoding ** -i disposition: inline (instead of the default of attachment) ** -q quoted-printable encoding ** -t text/plain content type ** -c explicit content-type ** -n override filename in disposition header ** -N don't include the filename parameter in the disposition header ** -u unknown encoding, auto-detect ** -x base64 encoding ** -p copy part already containing relevant headers and encoding ** -o omit disposition ** -m omit content-transfer-encoding ** ** The program will construct a MIME encoded message from a list of filenames ** and other specified values (subject, from address, to address, boundary, ** prolog text, epilog-text, and carbon-copy list). All of the files are ** flagged with type "application/octet-stream" and encoded using base64, ** regardless of actual file contents (unless explicity flagged for another ** encoding using the -7, -8,-b, -q, or -u flags). ** ** The program has been written in K&R C, so that it can be compiled with the ** bundled HP-UX compiler (a limited K&R compiler). The program will, probably, ** compile with similar bundled compilers on other comercial unices. The program ** will also compile using modern ANSI/ISO C compilers (such as gcc). */ /* ** Print the usage message for the MIME-tool program, showing how the program ** should be called and what the command line options and parameters are. */ #ifdef __STDC__ int printusage(FILE *f) #else int printusage(f) FILE *f; #endif { fprintf(f, "\nMIME message utility (ver. %s, %s) - create MIME ", MT_VERSION, MT_DATE); fprintf(f, "email messages \nwith file attachments. The program can "); fprintf(f, "be used to construct input to the \nstandard unix mail and "); fprintf(f, "mailx commands.\n\n"); fprintf(f, "Usage:\n"); fprintf(f, "\tmime [-dDvV] [-S subject] [-F from-address] [-T to-address]\n"); fprintf(f, "\t\t[-C carbon-copy-addresses] [-P prolog-text] [-E epilog-text]\n"); fprintf(f, "\t\t[-B boundary] -s [-O overall content-type]\n"); fprintf(f, "\t\t{[-78abiqtuxo] [-c content-type] [-n filename] filename}\n"); fprintf(f, "\n\t-d debugging (low detail level)\n"); fprintf(f, "\t-D debugging (high detail level)\n"); fprintf(f, "\t-v verbose messages\n"); fprintf(f, "\t-V very verbose messages\n"); fprintf(f, "\t-s subpart mode\n\n"); fprintf(f, "\t-7 7-bit ASCII encoding\n"); fprintf(f, "\t-8 8-bit ASCII encoding\n"); fprintf(f, "\t-a application/octet-stream content\n"); fprintf(f, "\t-b binary encoding\n"); fprintf(f, "\t-i disposition: inline (instead of attachment)\n"); fprintf(f, "\t-q quoted-printable encoding\n"); fprintf(f, "\t-t text/plain content\n"); fprintf(f, "\t-c explicit content-type\n"); fprintf(f, "\t-n override filename in disposition \n"); fprintf(f, "\t-u unknown encoding (auto-detect)\n"); fprintf(f, "\t-x base64 encoding\n"); fprintf(f, "\t-p copy part already containing relevant headers and encoding\n"); fprintf(f, "\t-o omit disposition line\n"); fprintf(f, "\t-m omit content-transfer-encoding\n"); fprintf(f, "\nThis program is free software distributed under the terms"); fprintf(f, "of the GNU General \nPublic License (GPL), and comes with "); fprintf(f, "ABSOLUTELY NO WARRANTY. See the GPL \nfor details. "); fprintf(f, "You should have received a copy of the GPL with this "); fprintf(f, "program, \nif not, you can get a copy at the Free Software "); fprintf(f, "Foundation's website at \n or "); fprintf(f, ".\n"); return 0; } #define ENC_UNKNOWN 0 #define ENC_ASCII7 1 #define ENC_ASCII8 2 #define ENC_BINARY 3 #define ENC_BASE64 4 #define ENC_QUOTED 5 #define ENC_COPYTHRU 6 #define DISP_ATTACHED 0 #define DISP_INLINE 1 #define DISP_OMIT 2 #define MAX_LINE_LENGTH 75 #define DEBUG(X) if(debug){X;} /* ** flags to indicate debugging and verbosity levels */ static int debug=0, verbose=0; /* ** wrapped text buffer, used by wrap() function */ static char *wbuf=NULL; /* ** wrap input text to the specified maximum width */ #ifdef __STDC__ char *wrap(char *text, int max, int margin) #else char *wrap(text, max, margin) char *text; int max, margin; #endif { int width=0, i, j; if(wbuf) free(wbuf); wbuf=malloc(strlen(text)+2+(strlen(text)/max)); if(wbuf==NULL) return NULL; for(i=0, j=0; text[i]; i++) { if(text[i]=='\n') { /* if we see a newline, start a new line */ wbuf[j++]='\n'; width=0; }else if(width>max && !isspace(text[i])) { /* if we have run over the maximum length, put in a newline */ wbuf[j++]='\n'; width=1; wbuf[j++]=text[i]; }else if(width>max-margin && (isspace(text[i]) || !isalnum(text[i]))) { /* if we see a space in the margin, put in a newline */ if(!isspace(text[i])) wbuf[j++]=text[i]; wbuf[j++]='\n'; width=0; }else { /* in allo ther cases, just copy the text to wbuf */ wbuf[j++]=text[i]; width++; } } wbuf[j]='\0'; return wbuf; } /* ** convert the contents of the input file to base64 encoding. */ #ifdef __STDC__ int base64(FILE *f) #else int base64(f) FILE *f; #endif { int i, n; char buf[100]; char *b64="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"; do { /* write out blocks of 4 base64 characters (3 input bytes) */ n=fread(buf, sizeof(char), 57, f); DEBUG(fprintf(stderr, "%d chars read from file\n", n)); for(i=0; i<=n-3; i+=3) { int b0, b1, b2, b3; /* output base64 characters */ b0=(buf[i]>>2)&0x3f; b1=(((buf[i]<<4)&0x30)|((buf[i+1]>>4)&0xf))&0x3f; b2=(((buf[i+1]<<2)&0x3c)|((buf[i+2]>>6)&3))&0x3f; b3=(buf[i+2]&0x3f)&0x3f; printf("%c%c%c%c", b64[b0], b64[b1], b64[b2], b64[b3]); } if(n<57) break; printf("\n"); }while(!feof(f)); if(ferror(f)) { DEBUG(fprintf(stderr, "ferror in base64 encode\n")); return 1; } else { /* handle any trailing input bytes (1 or 2 trailing bytes) */ int b0, b1, b2; /* output base64 characters */ DEBUG(fprintf(stderr, "Handling trailing bytes. n=%d, i=%d\n", n, i)); if(n-i==1) { /* write out a single input byte as 2 base64 characters */ b0=(buf[i]>>2)&0x3f; b1=((buf[i]<<4)&0x30)&0x3f; printf("%c%c==", b64[b0], b64[b1]); } if(n-i==2) { /* write out two input bytes as 3 base64 characters */ b0=(buf[i]>>2)&0x3f; b1=(((buf[i]<<4)&0x30)|((buf[i+1]>>4)&0xf))&0x3f; b2=((buf[i+1]<<2)&0x3c)&0x3f; printf("%c%c%c=", b64[b0], b64[b1], b64[b2]); } } return 0; } /* ** quote the input file, replacing newlines and white space with escape ** sequences. */ #ifdef __STDC__ int quoted(FILE *f) #else int quoted(f) FILE *f; #endif { int width=0, ch; int fstate=0; /* 'From ' state. 0 => Normal 1 => Have read F at start of line 2 => Fr 3 => Fro 4 => From If reading ' ' when in fstate=4, write "=46rom " instead. */ while((ch=fgetc(f))!=EOF) { if (fstate==0 && width==0 && ch=='F') fstate=1; else if (fstate==1) { if (ch=='r') fstate=2; else { printf("F"); width++; fstate=0; } } else if (fstate==2) { if (ch=='o') fstate=3; else { printf("Fr"); width=width+2; fstate=0; } } else if (fstate==3) { if (ch=='m') fstate=4; else { printf("Fro"); width=width+3; fstate=0; } } else if (fstate==4) { if (ch==' ') {printf("=46rom"); width=width+6; fstate=0; } else { printf("From"); width=width+4; fstate=0; } } if (fstate==0) { if(width>MAX_LINE_LENGTH && ch!='\n') { /* soft line break at 75 characters */ printf("=\015\012"); width=0; } else if(ch=='\n') { /* emit this one without problem (as CR LF */ printf("\015\012"); width=0; } else if(ch==' ' || ch=='\t' || (ch=='.' && width==0)) { /* tabs, spaces and full-stops at line-ends are escaped */ /* full-stops only escaped at start of line */ int nextch = fgetc(f); if (nextch != EOF) { ungetc(nextch, f); } if (nextch=='\n') { printf("=%2.2X", ch); width+=3; } else { printf("%c", ch); width++; } } else if((!isprint(ch)) || ch=='=') { /* escape non-printable characters and equal signs (=) */ printf("=%2.2X", ch); width+=3; } else { /* emit all other characters without ado */ printf("%c", ch); width++; } } } if(ferror(f)) return 1; return 0; } /* ** copy the input file without modification */ #ifdef __STDC__ int copy(FILE *f) #else int copy(f) FILE *f; #endif { int ch; while((ch=fgetc(f))!=EOF) printf("%c", ch); if(ferror(f)) return 1; return 0; } /* ** copy the input file, restricting output to 7-bit ASCII */ #ifdef __STDC__ int copy7(FILE *f) #else int copy7(f) FILE *f; #endif { int ch; while((ch=fgetc(f))!=EOF) { if(ch >= 0 && ch < 128) printf("%c", ch); else /* convert 8-bit characters to question marks (?) */ printf("?"); } if(ferror(f)) return 1; return 0; } /* ** detect an appropriate encoding for the input file */ #ifdef __STDC__ int fencode(FILE *f) #else int fencode(f) FILE *f; #endif { int ch, ascii=1, hibit=0, maxline=0, line=0, ctrl=0; /* content flags */ while((ch=fgetc(f))!=EOF) { /* search the file for the follwoing: */ if(!isascii(ch)) /* non-ASCII characters */ ascii=0; if(ch>127 || ch<0) /* 8-bit characters (bit-7 set) */ hibit=1; if(iscntrl(ch) && !isspace(ch)) /* control characters */ ctrl=1; if(ch=='\n') { /* long lines */ if(line>maxline) maxline=line; line=0; }else line++; } if(ferror(f)) return -1; if(fseek(f, 0, SEEK_SET)) return -2; if(maxline>998 || ctrl) return ENC_BASE64; if(hibit) return ENC_ASCII8; if(ascii) return ENC_ASCII7; return ENC_BASE64; } char *qstr = NULL; int qstrlen = 0; /* ** fold and quote the string parameter, given that the parameter starts ** at the nth column. ** ** NOTE: every call to foldquote() overwrites the return value from the ** previous call, so you can't call this function several times in another ** functions argument list or you will get corrupt output. */ #ifdef __STDC__ char *foldquote(char *str, int col, int margin) #else char *foldquote(str, col, margin) char *str; int col, int margin; #endif { int needsquotes = 0; int needsescapes = 0; int needsfolding = 0; int qcol = 0, len = 0, i, j; if(str == NULL) return NULL; /* count chars in str, noticing special chars and fold points */ for(i = 0, qcol = col; str[i] != '\0'; i++) { if(str[i] == '"') needsescapes++, needsquotes = 1; switch(str[i]) /* RFC-822 special characters: "\()[]<>@.,:; */ { case '"': case '\\': case '(': case ')': case '[': case ']': case '<': case '>': case '@': case '.': case ',': case ';': case ':': needsquotes = 1; } if(str[i] == ' ' || str[i] == '\t') /* white space */ needsquotes = 1; if(qcol++ > MAX_LINE_LENGTH) /* line too long, folding needed */ needsfolding++, qcol = 1; len++; } if(needsquotes || needsescapes || needsfolding) { len = len+needsquotes*2+needsescapes+needsfolding*3+1; if(qstrlen < len) { if(qstr != NULL) free(qstr); qstr = (char*)malloc(len); if(qstr == NULL) return NULL; qstrlen = len; } if(qstr == NULL) return NULL; i = j = 0; qcol = col; if(needsquotes) qstr[i++] = '"'; /* copy str into qstr applying quotes, escapes and folding */ while(str[j] != '\0') { if(str[j] == '"') qstr[i++] = '\\'; /* escape quotes */ qstr[i++] = str[j]; if(needsfolding && qcol++ >= MAX_LINE_LENGTH-margin && (str[j] == ' ' || str[j] == '\t')) { /* fold at spaces in the margin */ qstr[i++] = '\n'; qstr[i++] = ' '; qcol = 1; } j++; } if(qstr[0] == '"') qstr[i++] = '"'; qstr[i] = '\0'; return qstr; } return str; } #ifdef __STDC__ int main(int args, char **arg) #else int main(args, arg) int args; char **arg; #endif { FILE *f; int i, err=0, headerneeded=1, encoding=ENC_BASE64, disposition=DISP_ATTACHED, omitCTE=0, subpart=0, omitDisponame=0; char *prolog=NULL, *epilog=NULL, *boundary="MIME_CONTENT_BREAK", *p; char *subject=NULL, *fromaddress=NULL, *toaddress=NULL, *carboncopy=NULL; char *contenttype="application/octet-stream"; char *overallcontenttype="multipart/mixed"; char *disponame=NULL; if(args<2) { printusage(stderr); return 1; } for(i=1; i. separate(Sending) procedure Sign_Encrypt (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Send_Keys : in Keys.Key_List; Selection : in Send_Modes; Mime_Selection : in MIME_Modes; AL : in Attachments.Attachment_List; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean; New_Headers : out UVV; AS_Content_Type : in String) is Out_File : constant String := Temp_File_Name("out"); SFD_File : constant String := Temp_File_Name("sfd"); SFD2_File : constant String := Temp_File_Name("sfd2"); QP_File : constant String := Temp_File_Name("qp"); TDS_File : constant String := Temp_File_Name("tds"); begin -- Run GPG. if Mime and then (Mime_Selection = MultipartEncap or Mime_Selection = SMIME) Then -- We need to do something different with Tmpfile. -- First, we delete all trailing blank lines. begin Prepare_For_Clearsign(Tmpfile, QP_File, AS_Content_Type); -- Call out to attachments in case we have to modify QP_File. Attachments.Replace_Tmpfile(QP_File, AL); -- Then we clearsign it. if Mime_Selection = SMIME then Externals.GPG.GPGSM_Wrap(" --base64 --sign --local-user " & Value_Nonempty(Config.UBS_Opts(my_key)) & " " & " --output " & TDS_File & " " & QP_File, TDS_File, SFD_File); else Externals.GPG.GPG_Wrap(" --detach-sign --textmode --armor --local-user " & Value_Nonempty(Config.UBS_Opts(my_key)) & " " & UGA_Str(Signing => True) & " --output " & TDS_File & " " & QP_File, TDS_File, SFD_File); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Sign_Encrypt (GPG MIME/4 block)"); raise; end; else if Mime and then Mime_Selection = Multipart then -- We need to do something different with Tmpfile. -- First, we delete all trailing blank lines. begin Prepare_For_Clearsign(Tmpfile, QP_File, AS_Content_Type); -- Call out to attachments in case we have to modify QP_File. Attachments.Replace_Tmpfile(QP_File, AL); -- Then rename QP_File to Tmpfile... Mv_F(QP_File, Tmpfile); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Sign_Encrypt (Pre-GPG MIME/3 block)"); raise; end; end if; begin Externals.GPG.GPG_Wrap(" --encrypt --sign --textmode --armor --local-user " & Value_Nonempty(Config.UBS_Opts(my_key)) & " " & UGA_Str(Signing => True) & " --output " & Out_File & " " & Keys.Processed_Recipient_List(Send_Keys) & " " & Tmpfile, Out_File, SFD_File); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Sign_Encrypt (GPG block)"); raise; end; end if; begin if not (Mime and then (Mime_Selection = MultipartEncap or Mime_Selection = SMIME)) then if Selection = SignEncryptPO then -- Rename the file appropriately. Mv_F(Out_File, Tmpfile & ".asc"); else Mv_F(Out_File, Tmpfile); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Sign_Encrypt (MV block)"); raise; end; begin if Mime then case Mime_Selection is when InlinePlain => -- Inline plain text Echo_Out("Content-Type: text/plain", Mimefile); New_Headers.Append(ToUBS("Content-Type: text/plain")); when AppPGP => -- application/pgp Echo_Out("Content-Type: application/pgp; format=text; x-action=encrypt", Mimefile); New_Headers.Append(ToUBS("Content-Type: application/pgp; format=text; x-action=encrypt")); when Multipart => -- RFC2015 multipart -- This is the nasty one. -- We are using the combined method allowed in section 6.2. declare Blk1 : constant String := Temp_File_Name("mp1"); Blk2 : constant String := Temp_File_Name("mp2"); MC : constant String := Temp_File_Name("mc"); begin -- We first create the two blocks. -- The first block is easy: Echo_Out("Content-Type: application/pgp-encrypted", Blk1); Echo_Append("", Blk1); Echo_Append("Version: 1", Blk1); -- The second block starts with a -- content-type, then is the tmpfile we've -- put together. Echo_Out("Content-Type: application/octet-stream", Blk2); Echo_Append("Content-Disposition: attachment; filename=""message.asc""", Blk2); Echo_Append("", Blk2); Cat_Append(Tmpfile, Blk2); -- Now we put them together. Externals.Mail.Mimeconstruct2(Part1_Filename => Blk1, Part2_Filename => Blk2, Output_Filename => MC, Content_Type => "multipart/encrypted; protocol=""application/pgp-encrypted""", Prolog => "This is an OpenPGP/MIME encrypted message (RFC2440, RFC3156)."); -- Now we need to split these up. Mail.Extract_Content_Type_From_Header(MC, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MC, Tmpfile); end; when MultipartEncap => -- RFC2015 multipart encapsulated -- This is the REALLY nasty one. We are -- encapsulating, so we have to sign then -- encrypt. declare Blk1 : constant String := Temp_File_Name("mp1"); Blk2 : constant String := Temp_File_Name("mp2"); MCS : constant String := Temp_File_Name("mcs"); MC : constant String := Temp_File_Name("mc"); begin -- We first create the two blocks. Externals.Mail.Mimeconstruct_Subpart(Infile => TDS_File, Outfile => Blk2, Content_Type => "application/pgp-signature", Dos2UnixU => False, Use_Encoding => False, Attachment_Name => "signature.asc", Disposition => Externals.Mail.Attachment); Externals.Mail.Mimeconstruct2(Part1_Filename => QP_File, Part2_Filename => Blk2, Output_Filename => MCS, Content_Type => "multipart/signed; protocol=""application/pgp-signature""; micalg=""" & Externals.GPG.Micalg_From_Filename(TDS_File) & """", Prolog => "This is an OpenPGP/MIME signed message (RFC2440, RFC3156)."); -- Now the encrypt bit.... Rm_File(Tmpfile); Externals.GPG.GPG_Wrap(" --encrypt --armor " & " " & " --output " & Tmpfile & " " & Keys.Processed_Recipient_List(Send_Keys) & " " & MCS, Tmpfile, SFD_File); -- The first block is easy: Echo_Out("Content-Type: application/pgp-encrypted", Blk1); Echo_Append("", Blk1); Echo_Append("Version: 1", Blk1); -- The second block starts with a -- content-type, then is the tmpfile we've -- put together. Echo_Out("Content-Type: application/octet-stream", Blk2); Echo_Append("Content-Disposition: attachment; filename=""message.asc""", Blk2); Echo_Append("", Blk2); Cat_Append(Tmpfile, Blk2); -- Now we put them together. Externals.Mail.Mimeconstruct2(Part1_Filename => Blk1, Part2_Filename => Blk2, Output_Filename => MC, Content_Type => "multipart/encrypted; protocol=""application/pgp-encrypted""", Prolog => "This is an OpenPGP/MIME encrypted message (RFC2440, RFC3156)."); -- Now we need to split these up. Mail.Extract_Content_Type_From_Header(MC, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MC, Tmpfile); end; when SMIME => -- Similar to RFC2015 multipart encapsulated. declare Blk2 : constant String := Temp_File_Name("mp2"); MM1 : constant String := Temp_File_Name("mm1"); MM2 : constant String := Temp_File_Name("mm2"); MM3 : constant String := Temp_File_Name("mm3"); begin -- We first create the two blocks. Echo_Out("Content-Type: application/pkcs7-mime; smime-type=signed-data; name=""smime.p7s""", Blk2); Echo_Append("Content-Transfer-Encoding: base64", Blk2); Echo_Append("Content-Disposition: attachment; filename=""smime.p7s""", Blk2); Echo_Append("Content-Description: S/MIME Cryptographic Signature", Blk2); Echo_Append("", Blk2); Cat_Append(TDS_File, Blk2); -- Now the encrypt bit.... Rm_File(Tmpfile); Externals.GPG.GPGSM_Wrap_Encrypt(MM1, SFD2_File, Blk2, Send_Keys); if Actual_Send then New_Headers.Append(ToUBS("Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=""smime.p7m""")); New_Headers.Append(ToUBS("Content-Transfer-Encoding: base64")); New_Headers.Append(ToUBS("Content-Disposition: attachment; filename=""smime.p7m""")); Externals.Simple.Mv_F(MM1, Tmpfile); else -- Then concatenate it all together. -- Same workaround as in sending-encrypt.adb. Echo_Out("Content-Type: application/pkcs7-mime; smime-type=enveloped-data; name=""smime.p7m""", MM2); Echo_Append("Content-Transfer-Encoding: base64", MM2); Echo_Append("Content-Disposition: attachment; filename=""smime.p7m""", MM2); Echo_Append("", MM2); Cat_Append(MM1, MM2); Mail.Mimeconstruct_Mixed(UBS_Array'(1 => ToUBS(MM2)), MM3); Mail.Extract_Content_Type_From_Header(MM3, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MM3,Tmpfile); end if; end; end case; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Sign_Encrypt (MIME block 2)"); raise; end; if not Actual_Send then Check_Send(Tmpfile, Non_Pine, Mime, Mimefile, Hdrfile, Recipients); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Sign_Encrypt"); raise; end Sign_Encrypt; topal-80/pine-4.44.patch0000644000175000017500000001726213434071426013111 0ustar pjbpjbOnly in pine4.44: .bld.hlp Only in pine4.44: bin diff -rc OP/pine4.44/imap/src/c-client/mail.h pine4.44/imap/src/c-client/mail.h *** OP/pine4.44/imap/src/c-client/mail.h Tue Nov 13 19:50:10 2001 --- pine4.44/imap/src/c-client/mail.h Thu Apr 11 10:21:36 2002 *************** *** 621,626 **** --- 621,627 ---- unsigned long bytes; /* size of text in octets */ } size; char *md5; /* MD5 checksum */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ }; Only in pine4.44/pine: date.c diff -rc OP/pine4.44/pine/pine.h pine4.44/pine/pine.h *** OP/pine4.44/pine/pine.h Tue Jan 8 20:55:49 2002 --- pine4.44/pine/pine.h Thu Apr 11 10:21:36 2002 *************** *** 63,69 **** #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.44" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" --- 63,69 ---- #ifndef _PINE_INCLUDED #define _PINE_INCLUDED ! #define PINE_VERSION "4.44T" #define PHONE_HOME_VERSION "-count" #define PHONE_HOME_HOST "docserver.cac.washington.edu" diff -rc OP/pine4.44/pine/send.c pine4.44/pine/send.c *** OP/pine4.44/pine/send.c Tue Jan 8 20:59:37 2002 --- pine4.44/pine/send.c Thu Apr 11 11:00:40 2002 *************** *** 4695,4700 **** --- 4695,4710 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) + /* This was a single part message which Topal mangled. */ + (*body)->type = TYPETEXT; + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1) + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + (*body)->nested.part->body.type = TYPETEXT; + dprint(4, (debugfile, "=== send returning ===\n")); } *************** *** 5956,5968 **** ; rfc822_parse_content_header(nb,ucase(buf+8),s); ! if(nb->type == TYPETEXT ! && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); b->subtype = nb->subtype; nb->subtype = NULL; --- 5966,5978 ---- ; rfc822_parse_content_header(nb,ucase(buf+8),s); ! if(nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ if(b->subtype) fs_give((void **) &b->subtype); + b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; *************** *** 5970,5975 **** --- 5980,5987 ---- b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + if (b->type != TYPETEXT) + b->topal_hack = 1; } mail_free_body(&nb); *************** *** 8506,8522 **** dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. --- 8518,8536 ---- dprint(4, (debugfile, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (body->topal_hack != 1){ ! if (!body->parameter) { /* cookie not set up yet? */ ! char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! sprintf (tmp,"%ld-%ld-%ld=:%ld",gethostid (),random (),time (0), ! getpid ()); ! body->parameter = mail_newbody_parameter (); ! body->parameter->attribute = cpystr ("BOUNDARY"); ! body->parameter->value = cpystr (tmp); ! } ! part = body->nested.part; /* encode body parts */ ! do pine_encode_body (&part->body); ! while (part = part->next); /* until done */ ! } break; /* case MESSAGE: */ /* here for documentation */ /* Encapsulated messages are always treated as text objects at this point. *************** *** 8688,8694 **** dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 8702,8709 ---- dprint(4, (debugfile, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 8741,8747 **** * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT){ gf_link_filter(gf_local_nvtnl, NULL); #if defined(DOS) || defined(OS2) --- 8756,8763 ---- * Convert text pieces to canonical form * BEFORE applying any encoding (rfc1341: appendix G)... */ ! if(body->type == TYPETEXT ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)){ gf_link_filter(gf_local_nvtnl, NULL); #if defined(DOS) || defined(OS2) *************** *** 8845,8859 **** ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); --- 8861,8887 ---- ? body->subtype : rfc822_default_subtype (body->type)))) return(pwbh_finish(0, so)); ! if (param){ ! do ! if(body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) ! { ! if(!(so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! else ! { ! if(!(so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, param->value, ! (char *) tspecials, ! ps_global->VAR_CHAR_SET))) ! return(pwbh_finish(0, so)); ! } ! while (param = param->next); } else if(!so_puts(so, "; CHARSET=US-ASCII")) return(pwbh_finish(0, so)); *************** *** 9111,9117 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 9139,9146 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); topal-80/externals-ops.ads0000644000175000017500000000154713434071426014042 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . package Externals.Ops is function Get_MD5Sum_Of_File (Filename : String) return UBS; function Test_Decrypt_Prerequisite return Integer; procedure Open_TTY; end Externals.Ops; topal-80/mkdistrib0000755000175000017500000000557113434071426012464 0ustar pjbpjb#!/bin/sh # Topal: GPG/GnuPG and Alpine/Pine integration # Copyright (C) 2001--2018 Phillip J. Brooke # # This program 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. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . cat > index.html < Topal: GPG/GnuPG and Alpine/Pine integration: Distribution page

    Topal: GPG/GnuPG and Alpine/Pine integration

    Copyright (C) 2001--2018 Phillip J. Brooke

    Topal is a \`glue' program that links GnuPG and Pine/Alpine. It offers facilities to encrypt, decrypt, sign and verify emails.

    Features

    EOF sed '//,// ! d' < ../Features.html >>index.html cat >> index.html < See the included documentation for all the stuff like licensing, recent changes and instructions.

    Release $1

    The current release of Topal is $1. Send email to p.j.brooke@bcs.org.uk if you would like to be notified of new Topal releases by email.

    Files for download

    Most recent changes

    EOF sed '//,// ! d' < ../Changelog.html >>index.html cat >> index.html <

    EOF echo Last generated: $(date) >> index.html cat >> index.html < EOF topal-80/workaround.adb0000644000175000017500000002274713434071426013415 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Command_Line; with Ada.Exceptions; with Ada.Text_IO; with Externals.Mail; with Externals.Simple; with Misc; use Misc; with Version_ID; package body Workaround is -- Read on stdin, write on stdout. -- Take a single email. -- If simple, then simply change the MIME Content-Type. -- If not simple, rewrite it in a multipart/misc wrapper. procedure Fix_Email is Stdin : constant String := Temp_File_Name("wfestdin"); CT : constant String := Temp_File_Name("wfect"); Output : constant String := Temp_File_Name("wfeoutput"); Input2 : constant String := Temp_File_Name("wfeinput"); Header2 : constant String := Temp_File_Name("wfeheader"); Body2 : constant String := Temp_File_Name("wfebody"); Part1A : constant String := Temp_File_Name("wfepart1a"); Part1 : constant String := Temp_File_Name("wfepart1"); Part2 : constant String := Temp_File_Name("wfepart2"); MCO : constant String := Temp_File_Name("wfemco"); MCO2 : constant String := Temp_File_Name("wfemco2"); Mangle : Boolean := False; Encrypted : Boolean := False; begin -- First, save off the standard input into a temp file. Debug("Saving off stdin..."); Externals.Simple.Cat_Stdin_Out(Stdin); Debug("Done save off of stdin."); -- Get the content-type line. Externals.Mail.Formail_Concat_Extract_InOut("Content-Type:", Stdin, CT); -- Sort out the Mangle and Encrypted flags. if Externals.Simple.Grep_I_InOut("multipart/signed", CT, "/dev/null") = 0 then Mangle := True; elsif Externals.Simple.Grep_I_InOut("multipart/encrypted", CT, "/dev/null") = 0 then Mangle := True; Encrypted := True; end if; -- Do we mangle? if Mangle then if Config.Boolean_Opts(FE_Simple) then -- Simple mangling. if Encrypted then Externals.Simple.Sed_InOut("1,/^[[:space:]]*$/ { s!^Content-Type: *multipart/encrypted!Content-Type: application/x-topal-encrypted! ; }", Source => Stdin, Target => Output); Externals.Simple.Cat(Output); else Externals.Simple.Sed_InOut("1,/^[[:space:]]*$/ { s!^Content-Type: *multipart/signed!Content-Type: application/x-topal-signed! ; }", Source => Stdin, Target => Output); Externals.Simple.Cat(Output); end if; else -- Rewrite mangling. -- Drop the content-type header. Externals.Mail.Formail_Drop_InOut(UBS_Array'(1 => ToUBS("Content-Type:"), 2 => ToUBS("Content-Transfer-Encoding:"), 3 => ToUBS("MIME-Version:")), Source => Stdin, Target => Input2); -- Split the header and body apart. Externals.Mail.Extract_Header(Input2, Header2); Externals.Mail.Extract_Body(Input2, Body2); -- Now, create a new email: all the same headers, except the -- removed content-type. The body is a multipart/mixed, -- comprising just the (slightly modified) original body. -- Create a simple body. Externals.Simple.Echo_Out("Multipart email processed by Topal " & Version_ID.Release & ".", Part1A); Externals.Mail.Mimeconstruct_Subpart(Infile => Part1A, Outfile => Part1, Content_Type => "text/plain", Dos2UnixU => True, Use_Encoding => False, Encoding => ""); -- Create this modified body, which is the original email -- with just the content-type header. Externals.Simple.Echo_Out_N("Content-Type: ", Part2); Externals.Simple.Cat_Append(CT, Part2); Externals.Simple.Echo_Append("", Part2); Externals.Simple.Cat_Append(Body2, Part2); Externals.Mail.Mimeconstruct_Mixed(Filenames => UBS_Array'(1 => ToUBS(Part1), 2 => ToUBS(Part2)), Outfile => MCO); Externals.Simple.Cat_Out(Header2, Output); Externals.Simple.Echo_Append("X-Mangled-By: topal " & Version_ID.Release, Output); -- We don't want the first part of the multipart mixed. Externals.Simple.Sed_InOut("5,9 d", MCO, MCO2); Externals.Simple.Cat_Append(MCO2, Output); Externals.Simple.Cat(Output); end if; else -- Just output the original input. Externals.Simple.Cat(Stdin); end if; Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success); exception when The_Exception: others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Workaround.Fix_Email"); -- This is bad news. Write it all out to the emergency log. declare Log : constant String := ToStr(Topal_Directory) & "/workaround-error-log"; use Externals.Simple; begin Echo_Append(Integer'Image(Our_PID) & "Exception raised in Workaround.Fix_Email", Log); Echo_Append(Integer'Image(Our_PID) & "Exception raised: " & Ada.Exceptions.Exception_Name(The_Exception), Log); Echo_Append(Integer'Image(Our_PID) & Ada.Exceptions.Exception_Information(The_Exception), Log); end; -- Dump put the original output. Let's hope that it all works okay. Externals.Simple.Cat(Stdin); raise; end Fix_Email; procedure Fix_Folder (Folder : in String; Topal_Command : in String; The_Date : in String) is Backup_Name : constant String := Folder & ".topal-fix-folder-" & The_Date; New_Name : constant String := Folder & ".topal-new"; begin -- Backup. Ada.Text_IO.Put_Line(" Backup file is `" & Backup_Name & "'"); Externals.Simple.Cat_Out(Folder, Backup_Name); -- Invoke formail on this folder. Externals.Mail.Formail_Action_InOut(Source => Folder, Target => New_Name, Action => Topal_Command & " --fix-email"); -- Do a diff. if Externals.Simple.Diff_Brief(Folder, New_Name) then Ada.Text_IO.Put_Line(" Made some changes!"); -- Overwrite original with mangled version. Externals.Simple.Mv_F(New_Name, Folder); else Ada.Text_IO.Put_Line(" No changes made."); Externals.Simple.Rm_File(New_Name); end if; -- Done. Ada.Text_IO.Put_Line(" Finished with `" & Folder & "'"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Workaround.Fix_Folder"); raise; end Fix_Folder; procedure Fix_Folders (Folders : in UBS_Array) is Topal_Command : constant String := Ada.Command_Line.Command_Name; The_Date : constant String := Externals.Simple.Date_String; begin -- Loop through each folder. for I in Folders'Range loop Ada.Text_IO.Put_Line("Processing folder `" & ToStr(Folders(I)) & "'..."); Fix_Folder(ToStr(Folders(I)), Topal_Command, The_Date); end loop; Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Workaround.Fix_Folders"); raise; end Fix_Folders; end Workaround; topal-80/invocation.ads0000644000175000017500000000330113434071426013375 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Invocation is type Run_Modes is (Help_Text, Inline_Display, Mime_Display, Old_Mime_Display, Pipe_Display, Inline_Send, Mime_Send, Actual_Send, Nonpine_Send, Clear_Temp, Clear_Cache, Clear_All, Dump_Default_Config, Dump_Current_Config, Interactive_Config, Fix_Email, Fix_Folders, Check_Send_Token, Server, Remote_Send, Remote_Mime_Send, Remote_Decrypt, Remote_Mime_Decrypt, Raw_Input ); Run_Mode : Run_Modes := Help_Text; Tmpfile : UBS; Resultfile : UBS; RVfile : UBS; Infile : UBS; Content_Type : UBS; Mimefile : UBS; Recipients : UBS_Array_Pointer; Folders : UBS_Array_Pointer; CST_Token : UBS; Remaining : UBS_Array_Pointer; procedure Parse_Command_Line; end Invocation; topal-80/cl_menus.ads0000644000175000017500000000357513434071426013046 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; generic type Index is (<>); package CL_Menus is Arrays_Not_Matched : exception; type MA is array (Index range <>) of UBS; type MNA is array (Integer range <>) of UBS; -- Give a Menu_Array for the valid characters (Accept_Chars), and a list -- of items (Numbered_Menu) to be selected by number (the menu -- subroutine will offer them up to 9 at a time). Char_Words -- and Number_Word give the string to be displayed when that option is -- selected. Number trailword is displayed after the numbered selection. type CLM_Return is record Is_Num : Boolean; I : Index; N : Integer; end record; generic Accept_Chars : MA; Char_Words : MA; Default_Prompt : String := ""; Default_Number_Word : String := ""; Default_Number_Trailword : String := ""; function Menu (Numbered_Menu : in MNA; Number_Word : in String := Default_Number_Word; Prompt : in String := Default_Prompt; Number_Trailword : in String := Default_Number_Trailword) return CLM_Return; end CL_Menus; topal-80/remote_mode.adb0000644000175000017500000004650013434071426013512 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2009 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Command_Line; with Ada.Text_IO; with Externals.Simple; with Invocation; with Menus; with Misc; with Readline; with Sending; package body Remote_Mode is function Merge_Recipients (Recipients : UBS_Array) return UBS is Recips : UBS := NullUBS; begin for I in Recipients'Range loop declare use type UBS; begin Recips := Recips & Recipients(I); if I /= Recipients'Last then Recips := Recips & ' '; end if; end; end loop; return Recips; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Remote_Mode.Merge_Recipients"); raise; end Merge_Recipients; procedure Get_Host_And_Topal (Host : in out UBS; Topal_Command : in out UBS) is begin Host := ToUBS(Readline.Get_String("Which host? ")); Topal_Command := ToUBS(Readline.Get_String("Which topal (on remote host)? ")); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Remote_Mode.Get_Host_And_Topal"); raise; end Get_Host_And_Topal; procedure Trigger is Server_Trigger : constant String := ToStr(Topal_Directory) & "/server-trigger"; Reply_Trigger : constant String := ToStr(Topal_Directory) & "/reply-trigger"; use Externals.Simple; begin Echo_Out("", Server_Trigger); Ada.Text_IO.Put_Line("Waiting for Topal server..."); Reply_Trigger_Loop: loop exit Reply_Trigger_Loop when Test_F(Reply_Trigger); delay 0.5; end loop Reply_Trigger_Loop; delay 0.1; Rm_File(Reply_Trigger); Ada.Text_IO.Put_Line("Topal server finished..."); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Remote_Mode.Trigger"); raise; end Trigger; procedure Send(Tmpfile : in String; Mime : in Boolean; Mimefile : in String; Recipients : in UBS_Array) is Host : UBS; Topal_Command : UBS; -- What names...? -- FIXME: these should be variable.... R_Tmpfile : constant String := ".topal/server/tmpfile"; R_Resultfile : constant String := ".topal/server/resultfile"; R_Mimefile : constant String := ".topal/server/mimefile"; R_RVfile : constant String := ".topal/server/rvfile"; L_RVfile : constant String := Misc.Temp_File_Name("lrv"); L_Resultfile : constant String := Misc.Temp_File_Name("lrf"); RV : Integer; Dummy : Integer; RF : UBS; Continue : Boolean := True; use Ada.Text_IO; use Externals.Simple; pragma Unreferenced(Dummy); begin Get_Host_And_Topal(Host, Topal_Command); if ToStr(Host)'Length > 0 and ToStr(Topal_Command)'Length > 0 then -- Copy Tmpfile to host. Put_Line("Copying " & Tmpfile & " to " & ToStr(Host) & ":" & R_Tmpfile); Dummy := System(ToStr(Config.Binary(Scp)) & " " & Tmpfile & " " & ToStr(Host) & ":" & R_Tmpfile); if Config.Boolean_Opts(Read_From) then RF := ToUBS(" --read-from "); else RF := NullUBS; end if; -- Run ssh with remotesend(mime). if Mime then Put_Line("Attempting ssh " & ToStr(Host) & " " & ToStr(Topal_Command) & " " & ToStr(RF) & " -remotesendmime " & R_Tmpfile & " " & R_Resultfile & " " & R_RVfile & " " & R_Mimefile & " " & ToStr(Merge_Recipients(Recipients))); Dummy := System(ToStr(Config.Binary(Ssh)) & " " & ToStr(Host) & " " & ToStr(Topal_Command) & " " & ToStr(RF) & " -remotesendmime " & R_Tmpfile & " " & R_Resultfile & " " & R_RVfile & " " & R_Mimefile & " " & ToStr(Merge_Recipients(Recipients))); else Put_Line("Attempting ssh " & ToStr(Host) & " " & ToStr(Topal_Command) & " " & ToStr(RF) & " -remotesend " & R_Tmpfile & " " & R_Resultfile & " " & R_RVfile & " " & ToStr(Merge_Recipients(Recipients))); Dummy := System(ToStr(Config.Binary(Ssh)) & " " & ToStr(Host) & " " & ToStr(Topal_Command) & " " & ToStr(RF) & " -remotesend " & R_Tmpfile & " " & R_Resultfile & " " & R_RVfile & " " & ToStr(Merge_Recipients(Recipients))); end if; Put_Line("Copying " & ToStr(Host) & ":" & R_RVfile & " to " & L_RVfile); Dummy := System(ToStr(Config.Binary(Scp)) & " " & ToStr(Host) & ":" & R_RVfile & " " & L_RVfile); RV := Misc.String_To_Integer(Misc.Read_Fold(L_RVfile)); Put_Line("Read remote RV as " & Integer'Image(RV)); if RV = 0 then Put_Line("Remote topal returned successfully."); Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success); -- Copy Tmpfile, resultfile, perhaps mimefile back. Put_Line("Copying " & ToStr(Host) & ":" & R_Tmpfile & " to " & Tmpfile); Dummy := System(ToStr(Config.Binary(Scp)) & " " & ToStr(Host) & ":" & R_Tmpfile & " " & Tmpfile); if Mime then Put_Line("Copying " & ToStr(Host) & ":" & R_Mimefile & " to " & Mimefile); Dummy := System(ToStr(Config.Binary(Scp)) & " " & ToStr(Host) & ":" & R_Mimefile & " " & Mimefile); end if; else Put_Line("Remote topal failed."); Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); Continue := False; end if; Put_Line("Copying " & ToStr(Host) & ":" & R_Resultfile & " to " & L_Resultfile); Dummy := System(ToStr(Config.Binary(Scp)) & " " & ToStr(Host) & ":" & R_Resultfile & " " & L_Resultfile); -- Append L_Resultfile... Put(Result_File, ToStr(Misc.Read_Fold(L_Resultfile))); -- Clean up. Put_Line("Deleting remote copies of server files..."); Dummy := System(ToStr(Config.Binary(Ssh)) & " " & ToStr(Host) & " rm " & R_Tmpfile & " " & R_Resultfile & " " & R_Mimefile & " " & R_RVfile); -- For some reason, we're getting failures. Perhaps -- from an scp call? Set explicit success, -- although check_send can fail out later. if Continue then Sending.Check_Send(Tmpfile, False, Mime, Mimefile, "", Recipients); else Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); end if; else Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Remote_Mode.Send"); raise; end Send; procedure Remote_Send(Tmpfile : in String; Resultfile : in String; Mime : in Boolean; Mimefile : in String; Recipients : in UBS_Array) is Command_Pipe : constant String := ToStr(Topal_Directory) & "/server-commands"; RV_File : constant String := ToStr(Invocation.RVfile); RF : UBS; RV : Integer; use Externals.Simple; begin -- This procedure is called by ssh. if Config.Boolean_Opts(Read_From) then RF := ToUBS("+"); else RF := NullUBS; end if; if Mime then Echo_Out("remotesendmime" & ToStr(RF) & " " & RV_File & " " & Tmpfile & " " & Resultfile & " " & Mimefile & " " & ToStr(Merge_Recipients(Recipients)), Command_Pipe); else Echo_Out("remotesend" & ToStr(RF) & " " & RV_File & " " & Tmpfile & " " & Resultfile & " " & ToStr(Merge_Recipients(Recipients)), Command_Pipe); end if; Trigger; -- Collect the return value. declare use Misc; begin if Test_F(RV_File) then RV := String_To_Integer(Read_Fold(RV_File)); else RV := 1; end if; Ada.Text_IO.Put_Line("Read remote RV as " & Integer'Image(RV)); if RV = 0 then Ada.Text_IO.Put_Line("Remote send setting success"); Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success); else Ada.Text_IO.Put_Line("Remote send setting failure"); Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Failure); end if; end; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Remote_Mode.Remote_Send"); raise; end Remote_Send; procedure Decrypt(Infile : in String; MIME : in Boolean; Content_Type : in String := "") is Host : UBS; Topal_Command : UBS; -- What names...? -- FIXME: these should be variable.... R_Infile : constant String := ".topal/server/infile"; Dummy : Integer; use Ada.Text_IO; use Externals.Simple; pragma Unreferenced(Dummy); begin Get_Host_And_Topal(Host, Topal_Command); if ToStr(Host)'Length > 0 and ToStr(Topal_Command)'Length > 0 then -- Copy Infile to host. Put_Line("Copying " & Infile & " to " & ToStr(Host) & ":" & R_Infile); Dummy := System(ToStr(Config.Binary(Scp)) & " " & Infile & " " & ToStr(Host) & ":" & R_Infile); -- Run ssh with remotesend(mime). if Mime then Put_Line("Attempting ssh " & ToStr(Host) & " " & ToStr(Topal_Command) & " -remotemimedecrypt " & R_Infile); Dummy := System(ToStr(Config.Binary(Ssh)) & " " & ToStr(Host) & " " & ToStr(Topal_Command) & " -remotemimedecrypt " & R_Infile & " " & Content_Type); else Put_Line("Attempting ssh " & ToStr(Host) & " " & ToStr(Topal_Command) & " -remotedecrypt " & R_Infile); Dummy := System(ToStr(Config.Binary(Ssh)) & " " & ToStr(Host) & " " & ToStr(Topal_Command) & " -remotedecrypt " & R_Infile); end if; -- Clean up. Put_Line("Deleting remote copies of server files..."); Dummy := System(ToStr(Config.Binary(Ssh)) & " " & ToStr(Host) & " rm " & R_Infile); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Remote_Mode.Decrypt"); raise; end Decrypt; procedure Remote_Decrypt(Infile : in String; MIME : in Boolean; Content_Type : in String := "") is Command_Pipe : constant String := ToStr(Topal_Directory) & "/server-commands"; use Externals.Simple; begin -- This procedure is called by ssh. if Mime then Echo_Out("remotemimedecrypt " & Infile & " " & Content_Type, Command_Pipe); else Echo_Out("remotedecrypt " & Infile, Command_Pipe); end if; Trigger; Ada.Text_IO.Put_Line("Remote decrypt finished (setting success)"); Ada.Command_Line.Set_Exit_Status(Ada.Command_Line.Success); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Remote_Mode.Remote_Decrypt"); raise; end Remote_Decrypt; procedure Server is Topal_Command : constant String := Ada.Command_Line.Command_Name; Server_Dir : constant String := ToStr(Topal_Directory) & "/server"; Command_Pipe : constant String := ToStr(Topal_Directory) & "/server-commands"; Server_Trigger : constant String := ToStr(Topal_Directory) & "/server-trigger"; Reply_Trigger : constant String := ToStr(Topal_Directory) & "/reply-trigger"; use Ada.Text_IO; use Externals.Simple; use Menus; F : File_Type; L : UBS; begin Put_Line("Running in server mode."); Put_Line("Will re-dispatch calls to " & Topal_Command); -- Make sure that the server directory still exists. Mkdir_P(Server_Dir); -- We'll deal with SIGINTs. Misc.Set_Sigint_Handler; -- Loop, reading the command-line. Server_Main_Loop: loop -- Triggered by presence of server-trigger file. Server_Trigger_Loop: loop exit Server_Trigger_Loop when Test_F(Server_Trigger); exit Server_Main_Loop when Misc.Signal_Handlers.Sigint_Pending; delay 0.5; end loop Server_Trigger_Loop; delay 0.1; Rm_File(Server_Trigger); -- Open the file to read. Open(File => F, Mode => In_File, Name => Command_Pipe); -- Is this a blocking read? Let's hope so. L := Misc.Unbounded_Get_Line(F); declare A : constant UBS_Array := Misc.Split_Arguments(L); Refuse : Boolean := False; Continue : Boolean := True; RemoteRV : Integer; CL : UBS := NullUBS; Offset : Natural; RemoteD : Boolean := False; Tmpfile : UBS; begin -- Show the user what we propose to do: New_Line(3); Put_Line("Request received: to run `" & Topal_Command & "' with arguments `" & ToStr(L) & "'"); -- Six choices: -- remotesend _RETURNVALUE_ _TMPFILE_ _RESULTFILE_ _RECIPIENTS_ -- remotesendmime _RETURNVALUE_ _TMPFILE_ _RESULTFILE_ _MIMETYPE_ _RECIPIENTS_ -- Then those same two, suffixed `+', e.g., remotesend+. + implies read-from (i.e., config.all_headers, config.read_from) -- remotedecrypt _INFILE_ -- remotedecryptmime _INFILE_ if A'Length >= 5 and then ToStr(A(A'First)) = "remotesend" then CL := ToUBS(Topal_Command & " -send"); Offset := 2; elsif A'Length >= 5 and then ToStr(A(A'First)) = "remotesend+" then CL := ToUBS(Topal_Command & " --read-from -send"); Offset := 2; elsif A'Length >= 6 and then ToStr(A(A'First)) = "remotesendmime" then CL := ToUBS(Topal_Command & " -sendmime"); Offset := 2; elsif A'Length >= 6 and then ToStr(A(A'First)) = "remotesendmime+" then CL := ToUBS(Topal_Command & " --read-from -sendmime"); Offset := 2; elsif A'Length = 2 and then ToStr(A(A'First)) = "remotedecrypt" then CL := ToUBS(Topal_Command & " -display"); Offset := 1; RemoteD := True; elsif A'Length = 3 and then ToStr(A(A'First)) = "remotemimedecrypt" then CL := ToUBS(Topal_Command & " -mime"); Offset := 1; else Put_Line("Bogus!"); Continue := False; end if; if Continue then for I in A'First+Offset..A'Last loop declare use type UBS; begin CL := CL & ' '; CL := CL & A(I); end; end loop; end if; if RemoteD then -- Generate a temporary file. This is a stand-in for -- the result file. Tmpfile := ToUBS(Misc.Temp_File_Name("srdt")); declare use type UBS; begin CL := CL & ' '; CL := CL & Tmpfile; end; end if; Put_Line("Will run `" & ToStr(CL) & "'"); if Continue and then YN_Menu("Proceed? ") = Yes then begin RemoteRV := System(CL); Put_Line("RemoteRV=" & Integer'Image(RemoteRV)); if RemoteD then -- Show the temporary file via the pager. Pager(ToStr(A(A'First+1))); end if; end; else Refuse := True; end if; if Refuse then Put_Line("Refused request; you may have to manually interrupt client."); else -- 2nd argument had better be the return value.... Echo_Out(Misc.Trim_Leading_Spaces(Integer'Image(RemoteRV)), ToStr(A(A'First+1))); end if; end; Close(F); Echo_Out("", Reply_Trigger); Put_Line("Server finished, client can continue."); New_Line(2); end loop Server_Main_Loop; -- Never ends except by sigint. exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Remote_Mode.Server"); raise; end Server; end Remote_Mode; topal-80/ada-echo-c.c0000644000175000017500000000351113434071426012563 0ustar pjbpjb/* Topal: GPG/GnuPG and Alpine/Pine integration Copyright (C) 2001--2018 Phillip J. Brooke This program 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. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see . */ #include #include #include #include int setecho () { struct termios mode; struct termios new_mode; int fd = 0 /* stdin */; memset (&mode, 0, sizeof (mode)); if (tcgetattr (fd, &mode)) exit(1); mode.c_lflag = mode.c_lflag | ECHO; if (tcsetattr (fd, TCSADRAIN, &mode)) exit(2); memset (&new_mode, 0, sizeof (new_mode)); if (tcgetattr (fd, &new_mode)) exit(3); if (memcmp (&mode, &new_mode, sizeof (mode)) != 0) exit(4); return 0; } int noechoT () { struct termios mode; struct termios new_mode; int fd = 0; /* stdin */ memset (&mode, 0, sizeof (mode)); if (tcgetattr (fd, &mode)) exit(1); mode.c_lflag = mode.c_lflag & ~ECHO; if (tcsetattr (fd, TCSADRAIN, &mode)) exit(2); memset (&new_mode, 0, sizeof (new_mode)); if (tcgetattr (fd, &new_mode)) exit(3); if (memcmp (&mode, &new_mode, sizeof (mode)) != 0) exit(4); return 0; } /* Save and restore terminal. */ struct termios term0; struct termios term1; int saveTerminal () { tcgetattr(0, &term0); tcgetattr(1, &term1); return 0; } int restoreTerminal() { tcsetattr(0, TCSANOW, &term0); tcsetattr(1, TCSANOW, &term1); return 0; } topal-80/externals.ads0000644000175000017500000001511513434071426013237 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Externals is -- Get our process ID. function C_Get_Process_ID return Integer; pragma Import (C, C_Get_Process_ID, "getpid"); -- Glob on a filename pattern. function Glob (Pattern : in String) return UBS_Array; -- Exceptions for external calls. System_Abort_By_User : exception; Exec_Failed : exception; Pipe_Failed : exception; Fork_Failed : exception; Dup2_Failed : exception; CClose_Failed : exception; Waitpid_Failed : exception; Open_Append_Failed : exception; Open_Out_Failed : exception; Open_In_Failed : exception; private -- Execute (via execvp) File with argument list Argv. procedure Execvp (File : in String; Argv : in UBS); -- In this next variant, Argv had better be a UBS_Array with -- elements 0, 1, ... procedure Execvp (File : in String; Argv : in UBS_Array); -- Pipe binding. procedure Pipe (Reading : out Integer; Writing : out Integer); -- Fork binding. Returns 0 to child; child_pid to parent. function Fork return Integer; -- Dup2 binding procedure Dup2 (Oldfd, Newfd : in Integer); -- Binding for C Close. We'll need this to tidy up nicely. procedure CClose (FD : in Integer); -- Binding for waitpid. We return the subprocess exit code. function Waitpid (PID : Integer) return Integer; -- Wrappers to open a file and get a file descriptor (e.g., for dup2). function Open_Append (S : String) return Integer; function Open_Out (S : String) return Integer; function Open_In (S : String) return Integer; -- ForkExec: a replacement for System. function ForkExec (File : in String; Argv : in UBS_Array) return Integer; function ForkExec (File : in String; Argv : in UBS) return Integer; -- ForkExec: a replacement for System + append stdout to target. function ForkExec_Append (File : in String; Argv : in UBS_Array; Target : in String) return Integer; -- ForkExec: System with stdin. function ForkExec_In (File : in String; Argv : in UBS_Array; Source : in String) return Integer; -- ForkExec: a replacement for System + output stdout to target. function ForkExec_Out (File : in String; Argv : in UBS_Array; Target : in String) return Integer; function ForkExec_Out (File : in String; Argv : in UBS; Target : in String) return Integer; -- ForkExec: a replacement for System + output stdout to target + input -- from source. function ForkExec_InOut (File : in String; Argv : in UBS_Array; Source : in String; Target : in String) return Integer; function ForkExec_InOut (File : in String; Argv : in UBS; Source : in String; Target : in String) return Integer; -- More ForkExec variants: the number indicates how many processes are -- piped together. `In' means that a file is sent to the first process -- on stdin; `Out' means that the last process sends stdout to a file; -- `Append' is predictable! MergeStdErr => True is the bash-ism 2>&1. procedure ForkExec2 (File1 : in String; Argv1 : in UBS_Array; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; Merge_StdErr1 : in Boolean := False; Report : in Boolean := False); procedure ForkExec2 (File1 : in String; Argv1 : in UBS; Exit1 : out Integer; File2 : in String; Argv2 : in UBS; Exit2 : out Integer; Merge_StdErr1 : in Boolean := False; Report : in Boolean := False); procedure ForkExec2_Out (File1 : in String; Argv1 : in UBS_Array; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; Target : in String); procedure ForkExec2_Out (File1 : in String; Argv1 : in UBS; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; Target : in String); procedure ForkExec2_InOut (File1 : in String; Argv1 : in UBS_Array; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; Source : in String; Target : in String); procedure ForkExec3_Out (File1 : in String; Argv1 : in UBS; Exit1 : out Integer; File2 : in String; Argv2 : in UBS_Array; Exit2 : out Integer; File3 : in String; Argv3 : in UBS_Array; Exit3 : out Integer; Target : in String); end Externals; topal-80/alpine-2.00.patch-20000644000175000017500000000370113434071426013544 0ustar pjbpjbdiff -cr alpine-2.00.orig/imap/src/c-client/mail.c alpine-2.00.new/imap/src/c-client/mail.c *** alpine-2.00.orig/imap/src/c-client/mail.c 2008-06-04 19:39:54.000000000 +0100 --- alpine-2.00.new/imap/src/c-client/mail.c 2009-04-30 22:34:13.000000000 +0100 *************** *** 2712,2717 **** --- 2712,2719 ---- BODY *b = NIL; PART *pt; unsigned long i; + /* Topal hack 2 */ + mail_fetchstructure (stream,msgno,&b); /* make sure have a body */ if (section && *section && mail_fetchstructure (stream,msgno,&b) && b) while (*section) { /* find desired section */ diff -cr alpine-2.00.orig/pith/mailcap.c alpine-2.00.new/pith/mailcap.c *** alpine-2.00.orig/pith/mailcap.c 2008-03-18 17:24:31.000000000 +0000 --- alpine-2.00.new/pith/mailcap.c 2009-04-30 22:35:47.000000000 +0100 *************** *** 582,589 **** * typically two scans through the check_extension * mechanism, the mailcap entry now takes precedence. */ ! if((fname = get_filename_parameter(NULL, 0, body, &e2b.from.ext)) != NULL ! && e2b.from.ext && e2b.from.ext[0]){ if(strlen(e2b.from.ext) < sizeof(tmp_ext) - 2){ strncpy(ext = tmp_ext, e2b.from.ext - 1, sizeof(tmp_ext)); /* remember it */ tmp_ext[sizeof(tmp_ext)-1] = '\0'; --- 582,598 ---- * typically two scans through the check_extension * mechanism, the mailcap entry now takes precedence. */ ! /* Topal hack 2 */ ! fname = get_filename_parameter(NULL, 0, body, &e2b.from.ext); ! if (fname == NULL) { ! if (body->type == TYPEMULTIPART && ! ((body->subtype && !strucmp(body->subtype, "signed")) ! ||(body->subtype && !strucmp(body->subtype, "encrypted")))) ! fname = cpystr("openpgp.msg"); ! } ! ! if(fname != NULL ! && e2b.from.ext && e2b.from.ext[0]){ if(strlen(e2b.from.ext) < sizeof(tmp_ext) - 2){ strncpy(ext = tmp_ext, e2b.from.ext - 1, sizeof(tmp_ext)); /* remember it */ tmp_ext[sizeof(tmp_ext)-1] = '\0'; topal-80/mkhelp0000755000175000017500000000566613434071426011761 0ustar pjbpjb#!/bin/sh # Topal: GPG/GnuPG and Alpine/Pine integration # Copyright (C) 2001--2008 Phillip J. Brooke # # This program 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. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . cat > help.ads <. -- Generated by a script. package Help is procedure Message; procedure Disclaimer; end Help; EOF cat > help.adb <. -- Generated by a script. with Ada.Text_IO; package body Help is procedure Message is use Ada.Text_IO; begin EOF expand help.txt | sed 's/"/""/g' | sed 's/^/ Put_Line("/' | sed 's/$/");/' >> help.adb cat >> help.adb < Put_Line(Standard_Error, "Exception raised in Help.Message"); raise; end Message; procedure Disclaimer is use Ada.Text_IO; begin EOF sed '6,13 ! d; s/#//' < mkhelp | sed 's/^/ Put_Line("/' | sed 's/$/");/' >> help.adb cat >> help.adb < Put_Line(Standard_Error, "Exception raised in Help.Disclaimer"); raise; end Disclaimer; end Help; EOF topal-80/keys.adb0000644000175000017500000007774413434071426012204 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Containers.Vectors; with Ada.IO_Exceptions; with Ada.Strings.Fixed; with Ada.Strings.Maps; with Ada.Strings.Maps.Constants; with Ada.Strings.Unbounded; with Ada.Text_IO; with Externals; use Externals; with Externals.GPG; with Externals.Mail; with Externals.Simple; with Menus; use Menus; with Misc; use Misc; with Readline; package body Keys is Key_Head_Length : constant Positive := 72; subtype Key_Head is String(1..Key_Head_Length); package KHP is new Ada.Containers.Vectors (Index_Type => Positive, Element_Type => Key_Head); subtype KHV is KHP.Vector; type Menu_Array_Ptr is access all Keylist_Menus.MNA; function Last8 (S : UBS) return UBS is S2 : constant String := ToStr(S); begin if S2'Length <= 8 then return S; else return ToUBS(S2(S2'Last-7..S2'Last)); end if; end Last8; function Match_PR (KP : Key_Properties; KR : Key_Roles) return Boolean is begin case KR is when Any => return True; when Encrypter => return KP(Encrypter); when Signer => return KP(Signer); when Both => return KP(Encrypter) and KP(Signer); end case; end Match_PR; -- Is the key usable? function Usable (KP : Key_Properties) return Boolean is begin return not (KP(Invalid) or KP(Disabled) or KP(Revoked) or KP(Expired)); end Usable; -- Given a filename from Listkey, return a processed version. procedure Process_Key (Key_File_Name : in String; P : out UBS; KP : out Key_Properties) is File_Handle : Ada.Text_IO.File_Type; type Scan_States is (Look_For_Key, -- I.e., scan for "pub" or "crt". --Look_For_Fpr, -- Scanning for fingerprint line. Look_For_Uid, -- Scanning for first userid. Build_Output, -- Scanning for first userid. Built_Output); ST : Scan_States := Look_For_Key; SMIME : Boolean := False; -- Set true if we find a crt. pragma Unreferenced(SMIME); P_UN, P_KG : UBS; begin P := NullUBS; KP := Key_Properties'(others => False); P_UN := NullUBS; P_KG := NullUBS; Ada.Text_IO.Open(File => File_Handle, Mode => Ada.Text_IO.In_File, Name => Key_File_Name); while not (Ada.Text_IO.End_Of_File(File_Handle) or ST = Built_Output) loop declare L : constant String := Ada.Text_IO.Get_Line(File_Handle); LS : constant UBS_Array := Split_GPG_Colons(L); use Ada.Strings.Fixed; begin case ST is when Look_For_Key => declare procedure Common is begin ST := Look_For_UID; if LS'Length >= 12 then declare S : constant String := ToStr(LS(LS'First+11)); begin if Count(S, "D") = 1 then KP(Disabled) := True; end if; if Count(S, "E") = 1 then KP(Encrypter) := True; end if; if Count(S, "S") = 1 then KP(Signer) := True; end if; end; end if; if LS'Length >= 2 then declare S : constant String := ToStr(LS(LS'First+1)); begin if Count(S, "i") = 1 then KP(Invalid) := True; end if; if Count(S, "d") = 1 then KP(Disabled) := True; end if; if Count(S, "r") = 1 then KP(Revoked) := True; end if; if Count(S, "e") = 1 then KP(Expired) := True; end if; end; end if; if LS'Length >= 5 then -- Append the last eight characters of the key ID. declare KS : constant String := ToStr(LS(LS'First+4)); F : Integer; begin F := KS'Last - 7; if F < KS'First then F := KS'First; end if; P_KG := ToUBS(KS(F..KS'Last)); end; end if; end Common; begin if LS'Length >= 1 and then ToStr(LS(LS'First)) = "pub" then Common; -- SMIME is already false. elsif LS'Length >= 1 and then ToStr(LS(LS'First)) = "crt" then Common; SMIME := True; end if; end; --when Look_For_Fpr => when Look_For_Uid => if LS'Length >= 10 and then ToStr(LS(LS'First)) = "uid" then -- Append the user name. P_UN := LS(LS'First+9); ST := Build_Output; end if; when Build_Output | Built_Output => null; -- Ignore, we handle these later. end case; end; if ST = Build_Output then declare use type UBS; begin if KP(Invalid) then P := ToUBS("[Invalid]"); end if; if KP(Disabled) then P := P & ToUBS("[Disabled]"); end if; if KP(Revoked) then P := P & ToUBS("[Revoked]"); end if; if KP(Expired) then P := P & ToUBS("[Expired]"); end if; P := P & P_KG & ' ' & P_UN; end; ST := Built_Output; end if; end loop; Ada.Text_IO.Close(File_Handle); if ST /= Built_Output then P := ToUBS("????????"); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Process_Key"); raise; end Process_Key; -- Given a fingerprint, return the process key info. procedure Process_Key_By_FP (FP : in String; P : out UBS; KP : out Key_Properties; SMIME : in Boolean) is Key_Filename : constant String := Temp_File_Name("pkfp"); Key_Filename2 : constant String := Temp_File_Name("pkfps"); begin Externals.GPG.Listkey(Key => FP, Target => Key_Filename, SMIME => SMIME); Process_Key(Key_Filename, P, KP); if SMIME then -- Reuse Key_Filename and get a different view. Externals.GPG.Brief_View_SMIME_Key(Key => FP, Target => Key_Filename2); declare use type UBS; begin P := Last8(ToUBS(FP)) & ' ' & Read_Fold(Key_Filename2); end; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Process_Key_By_FP"); raise; end Process_Key_By_FP; -- Add a key to the list.... procedure Add_Key (Key : in UBS; List : in out Key_List; Role : in Key_Roles) is Match : Boolean := False; Key_Filename : constant String := Temp_File_Name("addkey"); P : UBS; KP : Key_Properties; begin Debug("+Add_Key: `" & ToStr(Key) & "'"); -- Puke if this is not a fingerprint.... declare KS : constant String := ToStr(Key); use Ada.Strings.Maps; begin for I in KS'Range loop if not Is_In(KS(I), Ada.Strings.Maps.Constants.Hexadecimal_Digit_Set) then Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Expected fingerprint, but working on `"& KS &"'"); raise Fingerprint_Expected; end if; end loop; end; -- Is this key usable? Externals.GPG.Listkey(Key => ToStr(Key), Target => Key_Filename, SMIME => List.SMIME); Process_Key(Key_Filename, P, KP); if not Usable(KP) then -- It's not usable! Ada.Text_IO.Put_Line("Key " & ToStr(Key) & " is not usable!"); elsif not Match_PR(KP, Role) then -- Doesn't match role. Ada.Text_IO.Put_Line("Key " & ToStr(Key) & " has wrong role!"); else -- Is it a duplicate? Debug("Add_Key: Checking for duplicates"); declare use type UBS; begin Debug("Add_Key: Approaching duplicates loop"); for I in 1..Integer(List.KA.Length) loop Debug("Add_Key: In duplicates loop"); Match := Match or Key = List.KA.Element(I); end loop; end; if not Match then -- Add the key. Debug("Add_Key: Adding a key"); List.KA.Append(Key); Debug("Add_Key: Done adding a key"); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Add_Key"); raise; end Add_Key; -- Remove a key. -- The nastiness here is that we might be working with short -- fingerprints. So choose the right hand end of the fingerprint. procedure Remove_Key (Key : in UBS; List : in out Key_List; Exception_If_Missing : in Boolean := False) is Key_Num : Integer; Key_Found : Boolean := False; KS : constant String := ToStr(Key); Key_Length : constant Natural := KS'Length; begin for I in 1..Integer(List.KA.Length) loop declare -- Get this string... TK : constant String := ToStr(List.KA.Element(I)); TK_Start : Integer; begin -- Is TK longer? TK_Start := TK'First; if TK'Length > Key_Length then -- Advance TK_Start so that we've got matching lengths. TK_Start := TK'Last - Key_Length + 1; end if; if KS = TK(TK_Start..TK'Last) then Key_Found := True; Key_Num := I; end if; end; end loop; if Key_Found then -- Shuffle the array over it. List.KA.Delete(Key_Num); -- Recurse to blow away duplicates. Remove_Key(Key => Key, List => List, Exception_If_Missing => False); else if Exception_If_Missing then raise Key_Not_Found; end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Remove_Key"); raise; end Remove_Key; -- Turn the list of keys to send into `-r ' string. function Processed_Recipient_List (List : in Key_List) return String is Result : UBS := Ada.Strings.Unbounded.Null_Unbounded_String; use type UBS; begin for I in 1..Integer(List.KA.Length) loop Result := Result & ToUBS(" -r ") & List.KA.Element(I) & ToUBS(" "); end loop; return ToStr(Result); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Processed_Recipient_List"); raise; end Processed_Recipient_List; -- Turn the list of keys to send into `-r ' string. function Processed_Recipient_List_OpenSSL (List : in Key_List) return String is Result : UBS := Ada.Strings.Unbounded.Null_Unbounded_String; Cert_File : constant String := Temp_File_Name("cert"); R : Integer; KC : UBS; pragma Unreferenced(R); use type UBS; begin for I in 1..Integer(List.KA.Length) loop KC := Value_Nonempty(Config.Binary(GPGSM)) & ToStr(Config.UBS_Opts(GPGSM_Options)) & " --armour -o " & Cert_File & Trim_Leading_Spaces(Integer'Image(I)) & " --export " & ToStr(List.KA.Element(I)); R := Externals.Simple.System(KC); -- FIXME: test return value? Result := Result & ' ' & ToUBS(Cert_File & Trim_Leading_Spaces(Integer'Image(I))); end loop; return ToStr(Result); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Processed_Recipient_List_OpenSSL"); raise; end Processed_Recipient_List_OpenSSL; -- Get key fingerprint(s) for a key. Add them. procedure Add_Keys_By_Fingerprint (Key_In : in UBS; List : in out Key_List; Role : in Key_Roles; Email : in Boolean; Found : out Boolean) is K : constant String := ToStr(Key_In); Tempfile : constant String := Temp_File_Name("findkey-akbf"); TFH : Ada.Text_IO.File_Type; L : UBS; Match : Boolean := False; begin Debug("Add_Keys_By_Fingerprint (A): starting..."); -- First, try finding some keys for this Key_In. Externals.GPG.Findkey(Key => K, Target => Tempfile, SMIME => List.SMIME, Email => Email); Debug("Add_Keys_By_Fingerprint (A): Externals.GPG.Findkey returned okay"); -- Now, open the file, and read in each line as a key for Add_Key. Ada.Text_IO.Open(File => TFH, Mode => Ada.Text_IO.In_File, Name => Tempfile); Debug("Add_Keys_By_Fingerprint (A): opened file successfully"); Fingerprint_Loop: loop begin L := Unbounded_Get_Line(TFH); Debug("Add_Keys_By_Fingerprint: Adding " & ToStr(L)); Add_Key(L, List, Role); Match := True; exception when Ada.IO_Exceptions.End_Error => exit Fingerprint_Loop; end; end loop Fingerprint_Loop; Ada.Text_IO.Close(TFH); Found := Match; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Add_Keys_By_Fingerprint (A)"); raise; end Add_Keys_By_Fingerprint; procedure Add_Keys_By_Fingerprint (Key_In : in UBS; List : in out Key_List; Role : in Key_Roles; Email : in Boolean := False) is Found : Boolean; begin Add_Keys_By_Fingerprint(Key_In => Key_In, List => List, Role => Role, Email => Email, Found => Found); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Add_Keys_By_Fingerprint (B)"); raise; end Add_Keys_By_Fingerprint; -- Add the secret keys to this key list. procedure Add_Secret_Keys (Key_In : in UBS; List : in out Key_List; Role : in Key_Roles) is K : constant String := ToStr(Key_In); Tempfile : constant String := Temp_File_Name("findkey-ask"); TFH : Ada.Text_IO.File_Type; L : UBS; begin -- First, try finding some _secret_ keys for this Key_In. Externals.GPG.Findkey_Secret(Key => K, Target => Tempfile, SMIME => List.SMIME); -- Now, open the file, and read in each line as a key for -- Add_Keys_By_Fingerprint (so we don't need to go hunting for the -- long codes. Ada.Text_IO.Open(File => TFH, Mode => Ada.Text_IO.In_File, Name => Tempfile); Fingerprint_Loop: loop begin L := Unbounded_Get_Line(TFH); Debug("Add_Keys_By_Fingerprint: Adding " & ToStr(L)); Add_Keys_By_Fingerprint(Key_In => L, List => List, Role => Role); exception when Ada.IO_Exceptions.End_Error => exit Fingerprint_Loop; end; end loop Fingerprint_Loop; Ada.Text_IO.Close(TFH); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Add_Secret_Keys"); raise; end Add_Secret_Keys; procedure Generate_Key_List (List : in out Key_List; Key_Heads : out KHV; Key_Menu : in out Menu_Array_Ptr) is begin Debug("+Generate_Key_List"); Key_Heads := KHP.Empty_Vector; -- First, we generate a current list of info files for the keys. for I in 1..Integer(List.KA.Length) loop declare Key_File_Name : constant String := Temp_File_Name("key" & Trim_Leading_Spaces(Integer'Image(I))); begin Externals.GPG.Listkey(Key => ToStr(List.KA.Element(I)), Target => Key_File_Name, SMIME => List.SMIME); if List.SMIME then Externals.GPG.Brief_View_SMIME_Key(Key => ToStr(List.KA.Element(I)), Target => Key_File_Name & "-smime"); end if; -- Now, dump into our `head' array the first line of each. declare P : UBS; KP : Key_Properties; begin Process_Key(Key_File_Name, P, KP); if List.SMIME then declare use type UBS; begin P := Last8(List.KA.Element(I)) & ' ' & Read_Fold(Key_File_Name & "-smime"); end; end if; -- if Usable(KP) then declare FL : constant String := ToStr(P); use Ada.Strings.Fixed; begin if FL'Length >= Key_Head_Length then Key_Heads.Append(FL(FL'First.. FL'First+Key_Head_Length-1)); else Key_Heads.Append(FL & (Key_Head_Length - FL'Length) * ' '); end if; end; -- end if; end; end; end loop; -- Now, create a menu with those key_heads. Key_Menu := new Keylist_Menus.MNA(1..Integer(Key_Heads.Length)); for I in 1..Integer(Key_Heads.Length) loop Key_Menu(I) := ToUBS(Key_Heads.Element(I)); end loop; Debug("-Generate_Key_List"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Generate_Key_List"); raise; end Generate_Key_List; -- List the keys and edit them as appropriate (include removing a key -- from that list, and adding one from the keyring. procedure List_Keys (List : in out Key_List) is Key_Heads : KHV; Key_Menu : Menu_Array_Ptr; Selection : Keylist_Menus.CLM_Return; Selected : Integer; SK_Selection : Specific_Key_Index; begin Debug("+List_Keys"); Key_Heads := KHP.Empty_Vector; Generate_Key_List(List, Key_Heads, Key_Menu); List_Keys_Loop: loop Ada.Text_IO.New_Line(5); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Menu_Title)) & "** Key list menu:" & Reset_SGR); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Info)) & Integer'Image(Keys.Count(List)) & " key(s)" & Reset_SGR & " in key list "); Selection := Keylist_Menu(Key_Menu.all); if not Selection.Is_Num then case Selection.I is when Done => exit List_Keys_Loop; when AddPattern => -- Add key from main keyring. declare New_Key : UBS; use Ada.Text_IO; begin New_Line(1); Put_Line("Main key ring access:"); New_Key := ToUBS(Readline.Get_String("Type GPG search pattern: ")); Add_Keys_By_Fingerprint(Key_In => New_Key, List => List, Role => Encrypter); Generate_Key_List(List, Key_Heads, Key_Menu); end; when AddSearch => -- Do a search, then select a key. declare Search_List : Key_List; Pattern : UBS; The_Key : UBS; Aborted : Boolean; begin Empty_Keylist(Search_List, List.SMIME); Pattern := ToUBS(Readline.Get_String("Type GPG search pattern: ")); Add_Keys_By_Fingerprint(Key_In => Pattern, List => Search_List, Role => Encrypter); Select_Key_From_List(Search_List, The_Key, Aborted); if not Aborted then Add_Key(The_Key, List, Encrypter); Generate_Key_List(List, Key_Heads, Key_Menu); end if; end; end case; else -- Selection key menu. Selected := Selection.N; Specific_Key_Loop: loop Ada.Text_IO.New_Line(5); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Menu_Title)) & "** Examining key currently in key list:" & Reset_SGR); SK_Selection := Specific_Key_Menu1("Key: " & Do_SGR(Config.UBS_Opts(Colour_Info)) & ToStr(Key_Menu(Selected)) & Reset_SGR & NL & "{d} Display details of key with less {v} Verbosely" & NL & "{r} Remove key from list {kql} Return to key list " & NL); case SK_Selection is when Done => exit Specific_Key_Loop; when Display => Externals.GPG.Viewkey(ToStr(List.KA.Element(Selected)), Verbose => False, SMIME => List.SMIME); when DisplayVerbose => Externals.GPG.Viewkey(ToStr(List.KA.Element(Selected)), Verbose => True, SMIME => List.SMIME); when Remove => Remove_Key(List.KA.Element(Selected), List); Generate_Key_List(List, Key_Heads, Key_Menu); exit Specific_Key_Loop; when SSelect => Error("Menu should not have allowed SSelect here"); end case; end loop Specific_Key_Loop; end if; end loop List_Keys_Loop; Debug("-List_Keys"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.List_Keys"); raise; end List_Keys; -- List the keys. Either return with Aborted true, or -- The_Fingerprint set to the chosen fingerprint. procedure Select_Key_From_List (List : in out Key_List; The_Fingerprint : out UBS; Aborted : out Boolean) is Key_Heads : KHV; Key_Menu : Menu_Array_Ptr; Selection : Keylist_Menus.CLM_Return; Selected : Integer; SK_Selection : Specific_Key_Index; Abort_Real : Boolean := False; Fingerprint_Real : UBS; begin Debug("+List_Keys"); Generate_Key_List(List, Key_Heads, Key_Menu); List_Keys_Loop: loop Selection := Keylist_Menu2(Key_Menu.all); if not Selection.Is_Num then case Selection.I is when Done => Abort_Real := True; exit List_Keys_Loop; when AddPattern => Error("Menu should not have allowed AddPattern here"); when AddSearch => Error("Menu should not have allowed AddSearch here"); end case; else -- Selection key menu. Selected := Selection.N; Specific_Key_Loop: loop Ada.Text_IO.New_Line(5); Ada.Text_IO.Put_Line(Do_SGR(Config.UBS_Opts(Colour_Menu_Title)) & "** Examining key found in search results:" & Reset_SGR); SK_Selection := Specific_Key_Menu2("Key: " & Do_SGR(Config.UBS_Opts(Colour_Info)) & ToStr(Key_Menu(Selected)) & Reset_SGR & NL & "{d} Display details of key with less {v} Verbosely" & NL & "{s} Select this key {kql} Return to key list " & NL); case SK_Selection is when Done => exit Specific_Key_Loop; when Display => Externals.GPG.Viewkey(ToStr(List.KA.Element(Selected)), Verbose => False, SMIME => List.SMIME); when DisplayVerbose => Externals.GPG.Viewkey(ToStr(List.KA.Element(Selected)), Verbose => True, SMIME => List.SMIME); when SSelect => Fingerprint_Real := List.KA.Element(Selected); exit List_Keys_Loop; when Remove => Error("Menu should not have allowed Remove here"); end case; end loop Specific_Key_Loop; end if; end loop List_Keys_Loop; The_Fingerprint := Fingerprint_Real; Aborted := Abort_Real; Debug("-List_Keys"); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Select_Key_From_List"); raise; end Select_Key_From_List; procedure First_Key_From_List (List : in out Key_List; The_Fingerprint : out UBS) is begin The_Fingerprint := List.KA.Element(1); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.First_Key_From_List"); raise; end First_Key_From_List; -- Use keylist. procedure Use_Keylist (Recipients : in UBS_Array; List : in out Key_List; Missing : out Boolean) is use Ada.Text_IO; Found_Key : array (Recipients'Range) of Boolean := (others => False); begin Debug("+Use_Keylist"); Missing := False; -- New key list. -- Do something with the keylist. Given a list of email addresses, -- open the relevant file (er, look in the array), and keep those key -- ids. for J in 1..Integer(Config.AKE.Length) loop for I in Recipients'Range loop declare use type UBS; Found : Boolean; begin if EqualCI(Config.AKE.Element(J).Value, Externals.Mail.Clean_Email_Address(ToStr(Recipients(I)))) then Add_Keys_By_Fingerprint(Key_In => Config.AKE.Element(J).Key, List => List, Role => Encrypter, Found => Found, Email => False); Found_Key(I) := Found_Key(I) or Found; end if; end; end loop; end loop; -- Now, run through the recipients that we _haven't_ found a key for. for I in Recipients'Range loop if Found_Key(I) then Put_Line("Info: Added keylist key(s) for recipient: `" & ToStr(Recipients(I)) & "'"); else declare Search_List : Key_List; use type UBS; begin Empty_Keylist(Search_List, List.SMIME); Add_Keys_By_Fingerprint(Key_In => ToUBS(Externals.Mail.Clean_Email_Address(ToStr(Recipients(I)))), List => Search_List, Role => Encrypter, Email => True); -- Remove any on the XK list. Dead easy: simply run -- through the entire XK list saying `Remove Key'. for J in 1 .. Integer(Config.XK.Length) loop Remove_Key(Config.XK.Element(J), Search_List); end loop; if Count(Search_List) > 0 then Put_Line("Info: Adding non-keylist key(s) for recipient: `" & ToStr(Recipients(I)) & "'"); -- Add the keys in Search_List to List. for J in 1 .. Integer(Search_List.KA.Length) loop Add_Key(Search_List.KA.Element(J), List, Encrypter); end loop; else Put_Line(Do_SGR(Config.UBS_Opts(Colour_Important)) & "Warning: Cannot find key for recipient: `" & ToStr(Recipients(I)) & "'" & Reset_SGR); Missing := True; end if; end; end if; end loop; Debug("-Use_Keylist"); exception when Ada.IO_Exceptions.Name_Error => Put_Line("Warning: Can't open keylist file"); when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Use_Keylist"); raise; end Use_Keylist; procedure Empty_Keylist (List : in out Key_List; SMIME : in Boolean) is begin List.KA := UVP.Empty_Vector; List.SMIME := SMIME; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Empty_Keylist"); raise; end; function Count (List : in Key_List) return Natural is begin return Natural(List.KA.Length); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Count"); raise; end Count; function Contains (List : in Key_List; Key : in UBS) return Boolean is K1 : constant String := ToStr(Key); begin if Integer(List.KA.Length) = 0 then return False; else for I in 1..Integer(List.KA.Length) loop declare K2 : constant String := ToStr(List.KA.Element(I)); L : Integer; begin -- Get the minimum length. L := K1'Length; if K2'Length < L then L := K2'Length; end if; -- Check the last L characters of each. if L > 0 and then K1(K1'Last-L+1..K1'Last) = K2(K2'Last-L+1..K2'Last) then return True; end if; end; end loop; return False; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Keys.Contains"); raise; end Contains; end Keys; topal-80/alpine-1.10.patch0000644000175000017500000004213113434071426013405 0ustar pjbpjbdiff -cr alpine.orig/alpine-1.10/alpine/send.c alpine.new/alpine-1.10/alpine/send.c *** alpine.orig/alpine-1.10/alpine/send.c 2008-02-08 17:43:23.000000000 +0000 --- alpine.new/alpine-1.10/alpine/send.c 2008-06-19 09:24:42.000000000 +0100 *************** *** 4039,4044 **** --- 4039,4061 ---- pbf = save_previous_pbuf; g_rolenick = NULL; + /* Topal: Unmangle the body types. */ + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack == 1) { + /* This was a single part message which Topal mangled. */ + dprint((9, "Topal: unmangling single part message\n")); + (*body)->type = TYPETEXT; + } + if ((*body)->type == TYPEMULTIPART + && (*body)->topal_hack != 1 + && (*body)->nested.part->body.type == TYPEMULTIPART + && (*body)->nested.part->body.topal_hack == 1) { + /* Topal mangled a multipart message. So the first nested part + is really TYPETEXT. */ + dprint((9, "Topal: unmangling first part of multipart message\n")); + (*body)->nested.part->body.type = TYPETEXT; + } + dprint((4, "=== send returning ===\n")); } *************** *** 5302,5323 **** rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); if(nb->type == TYPETEXT && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ ! if(b->subtype) ! fs_give((void **) &b->subtype); ! b->subtype = nb->subtype; nb->subtype = NULL; ! mail_free_body_parameter(&b->parameter); b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); } ! mail_free_body(&nb); } --- 5319,5368 ---- rfc822_parse_content_header(nb, (char *) ucase((unsigned char *) buf+8),s); + /* Topal: We're working on the first + text segment of the message. If + the filter returns something that + isn't TYPETEXT, then we need to + pretend (later on) that this is in + fact a TYPETEXT, because Topal has + already encoded it.... + + Original code path first, then an + alternate path. + */ if(nb->type == TYPETEXT && nb->subtype && (!b->subtype || strucmp(b->subtype, nb->subtype))){ ! if(b->subtype) ! fs_give((void **) &b->subtype); ! ! b->subtype = nb->subtype; ! nb->subtype = NULL; ! ! mail_free_body_parameter(&b->parameter); ! b->parameter = nb->parameter; ! nb->parameter = NULL; ! mail_free_body_parameter(&nb->parameter); ! } ! else if(F_ON(F_ENABLE_TOPAL_HACK, ps_global)){ ! /* Perhaps the type isn't TYPETEXT, ! and the hack is requested. So, ! let's mess with the types. */ ! if(nb->type != TYPETEXT){ ! b->type = nb->type; b->subtype = nb->subtype; nb->subtype = NULL; ! ! dprint((9, "Topal: mangling body!\n")); mail_free_body_parameter(&b->parameter); b->parameter = nb->parameter; nb->parameter = NULL; mail_free_body_parameter(&nb->parameter); + b->topal_hack = 1; + } } ! /* Topal: end */ mail_free_body(&nb); } Only in alpine.new/alpine-1.10/alpine: send.c.orig diff -cr alpine.orig/alpine-1.10/imap/src/c-client/mail.h alpine.new/alpine-1.10/imap/src/c-client/mail.h *** alpine.orig/alpine-1.10/imap/src/c-client/mail.h 2008-02-15 19:04:45.000000000 +0000 --- alpine.new/alpine-1.10/imap/src/c-client/mail.h 2008-06-19 09:24:42.000000000 +0100 *************** *** 775,780 **** --- 775,781 ---- unsigned long bytes; /* size of text in octets */ } size; char *md5; /* MD5 checksum */ + unsigned short topal_hack; /* set to 1 if topal has wrecked the sending */ void *sparep; /* spare pointer reserved for main program */ }; diff -cr alpine.orig/alpine-1.10/pith/conf.c alpine.new/alpine-1.10/pith/conf.c *** alpine.orig/alpine-1.10/pith/conf.c 2008-03-14 18:15:38.000000000 +0000 --- alpine.new/alpine-1.10/pith/conf.c 2008-06-19 09:26:41.000000000 +0100 *************** *** 2739,2744 **** --- 2739,2746 ---- F_SEND_WO_CONFIRM, h_config_send_wo_confirm, PREF_SEND, 0}, {"strip-whitespace-before-send", "Strip Whitespace Before Sending", F_STRIP_WS_BEFORE_SEND, h_config_strip_ws_before_send, PREF_SEND, 0}, + {"enable-topal-hack", "Enable Topal hack for OpenPGP/MIME messages", + F_ENABLE_TOPAL_HACK, h_config_enable_topal_hack, PREF_HIDDEN, 0}, {"warn-if-blank-fcc", "Warn if Blank Fcc", F_WARN_ABOUT_NO_FCC, h_config_warn_if_fcc_blank, PREF_SEND, 0}, {"warn-if-blank-subject", "Warn if Blank Subject", Only in alpine.new/alpine-1.10/pith: conf.c.orig diff -cr alpine.orig/alpine-1.10/pith/conftype.h alpine.new/alpine-1.10/pith/conftype.h *** alpine.orig/alpine-1.10/pith/conftype.h 2008-03-14 18:15:38.000000000 +0000 --- alpine.new/alpine-1.10/pith/conftype.h 2008-06-19 09:24:42.000000000 +0100 *************** *** 492,497 **** --- 492,498 ---- F_MARK_FCC_SEEN, F_MULNEWSRC_HOSTNAMES_AS_TYPED, F_STRIP_WS_BEFORE_SEND, + F_ENABLE_TOPAL_HACK, F_QUELL_FLOWED_TEXT, F_COMPOSE_ALWAYS_DOWNGRADE, F_SORT_DEFAULT_FCC_ALPHA, Only in alpine.new/alpine-1.10/pith: conftype.h.orig diff -cr alpine.orig/alpine-1.10/pith/pine.hlp alpine.new/alpine-1.10/pith/pine.hlp *** alpine.orig/alpine-1.10/pith/pine.hlp 2008-03-14 18:34:08.000000000 +0000 --- alpine.new/alpine-1.10/pith/pine.hlp 2008-06-19 09:24:42.000000000 +0100 *************** *** 3133,3138 **** --- 3133,3139 ----

  • FEATURE:
  • FEATURE:
  • FEATURE: +
  • FEATURE:
  • FEATURE:
  • FEATURE:
  • FEATURE: *************** *** 28175,28180 **** --- 28176,28196 ---- <End of help on this topic> + ====== h_config_enable_topal_hack ===== + + + FEATURE: <!--#echo var="FEAT_enable-topal-hack"--> + + +

    FEATURE:

    +

    + This feature allows Topal (and other sending-filters) to change the + MIME type of the email. This is potentially dangerous because it + pretends that multipart emails are plain emails. +

    + <End of help on this topic> + + ====== h_config_del_from_dot ===== Only in alpine.new/alpine-1.10/pith: pine.hlp.orig diff -cr alpine.orig/alpine-1.10/pith/send.c alpine.new/alpine-1.10/pith/send.c *** alpine.orig/alpine-1.10/pith/send.c 2008-02-15 02:11:48.000000000 +0000 --- alpine.new/alpine-1.10/pith/send.c 2008-06-19 09:24:42.000000000 +0100 *************** *** 108,114 **** long pine_rfc822_output_body(BODY *,soutr_t,TCPSTREAM *); int pine_write_body_header(BODY *, soutr_t, TCPSTREAM *); int pine_write_header_line(char *, char *, STORE_S *); ! int pine_write_params(PARAMETER *, STORE_S *); char *tidy_smtp_mess(char *, char *, char *, size_t); int lmc_body_header_line(char *, int); int lmc_body_header_finish(void); --- 108,114 ---- long pine_rfc822_output_body(BODY *,soutr_t,TCPSTREAM *); int pine_write_body_header(BODY *, soutr_t, TCPSTREAM *); int pine_write_header_line(char *, char *, STORE_S *); ! int pine_write_params(PARAMETER *, STORE_S *, BODY *); char *tidy_smtp_mess(char *, char *, char *, size_t); int lmc_body_header_line(char *, int); int lmc_body_header_finish(void); *************** *** 1750,1756 **** --- 1750,1758 ---- /* set up counts and such to keep track sent percentage */ send_bytes_sent = 0; gf_filter_init(); /* zero piped byte count, 'n */ + dprint((1, "Topal: HERE 1!\n")); send_bytes_to_send = send_body_size(body); /* count body bytes */ + dprint((1, "Topal: HERE 2!\n")); ps_global->c_client_error[0] = error_buf[0] = '\0'; we_cancel = busy_cue(_("Sending mail"), send_bytes_to_send ? sent_percent : NULL, 0); *************** *** 1767,1772 **** --- 1769,1777 ---- #endif + dprint((1, "Topal: HERE 3!\n")); + + /* * If the user's asked for it, and we find that the first text * part (attachments all get b64'd) is non-7bit, ask for 8BITMIME. *************** *** 1774,1779 **** --- 1779,1785 ---- if(F_ON(F_ENABLE_8BIT, ps_global) && (bp = first_text_8bit(body))) smtp_opts |= SOP_8BITMIME; + dprint((1, "Topal: HERE 3.1!\n")); #ifdef DEBUG #ifndef DEBUGJOURNAL if(debug > 5 || (flags & CM_VERBOSE)) *************** *** 1837,1853 **** --- 1843,1863 ---- } } + dprint((1, "Topal: HERE 4!\n")); + /* * Install our rfc822 output routine */ sending_hooks.rfc822_out = mail_parameters(NULL, GET_RFC822OUTPUT, NULL); (void)mail_parameters(NULL, SET_RFC822OUTPUT, (void *)post_rfc822_output); + dprint((1, "Topal: HERE 5!\n")); /* * Allow for verbose posting */ (void) mail_parameters(NULL, SET_SMTPVERBOSE, (void *) pine_smtp_verbose_out); + dprint((1, "Topal: HERE 6!\n")); /* * We do this because we want mm_log to put the error message into *************** *** 1891,1896 **** --- 1901,1907 ---- ps_global->noshow_error = 0; + dprint((1, "Topal: HERE 7!\n")); TIME_STAMP("smtp open", 1); if(sending_stream){ unsigned short save_encoding, added_encoding; *************** *** 2453,2461 **** BODY * first_text_8bit(struct mail_bodystruct *body) { ! if(body->type == TYPEMULTIPART) /* advance to first contained part */ body = &body->nested.part->body; return((body->type == TYPETEXT && body->encoding != ENC7BIT) ? body : NULL); } --- 2464,2475 ---- BODY * first_text_8bit(struct mail_bodystruct *body) { ! /* Be careful of Topal changes... */ ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) /* advance to first contained part */ body = &body->nested.part->body; + /* Topal: this bit might not be correct, now. */ return((body->type == TYPETEXT && body->encoding != ENC7BIT) ? body : NULL); } *************** *** 2826,2844 **** dprint((4, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (!body->parameter) { /* cookie not set up yet? */ char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! snprintf (tmp,sizeof(tmp),"%ld-%ld-%ld=:%ld",gethostid (),random (),(long) time (0), (long) getpid ()); tmp[sizeof(tmp)-1] = '\0'; set_parameter(&body->parameter, "BOUNDARY", tmp); } - part = body->nested.part; /* encode body parts */ - do pine_encode_body (&part->body); - while ((part = part->next) != NULL); /* until done */ break; ! case TYPETEXT : /* * If the part is text we edited, then it is UTF-8. --- 2840,2860 ---- dprint((4, "-- pine_encode_body: %d\n", body ? body->type : 0)); if (body) switch (body->type) { case TYPEMULTIPART: /* multi-part */ ! if (body->topal_hack != 1) { /* But only if Topal hasn't touched it! */ ! if (!body->parameter) { /* cookie not set up yet? */ char tmp[MAILTMPLEN]; /* make cookie not in BASE64 or QUOTEPRINT*/ ! snprintf (tmp,sizeof(tmp),"%ld-%ld-%ld=:%ld",gethostid (),random (),(long) time (0), (long) getpid ()); tmp[sizeof(tmp)-1] = '\0'; set_parameter(&body->parameter, "BOUNDARY", tmp); + } + part = body->nested.part; /* encode body parts */ + do pine_encode_body (&part->body); + while ((part = part->next) != NULL); /* until done */ } break; ! case TYPETEXT : /* * If the part is text we edited, then it is UTF-8. *************** *** 4195,4201 **** dprint((4, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) --- 4211,4219 ---- dprint((4, "-- pine_rfc822_output_body: %d\n", body ? body->type : 0)); ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling, ! unless Topal messed with it */ part = body->nested.part; /* first body part */ /* find cookie */ for (param = body->parameter; param && !cookie; param = param->next) *************** *** 4285,4294 **** * BEFORE applying any encoding (rfc1341: appendix G)... * NOTE: almost all filters expect CRLF newlines */ ! if(body->type == TYPETEXT ! && body->encoding != ENCBASE64 && !so_attr((STORE_S *) body->contents.text.data, "rawbody", NULL)){ ! gf_link_filter(gf_local_nvtnl, NULL); } switch (body->encoding) { /* all else needs filtering */ --- 4303,4316 ---- * BEFORE applying any encoding (rfc1341: appendix G)... * NOTE: almost all filters expect CRLF newlines */ ! if(((body->type == TYPETEXT ! && body->encoding != ENCBASE64) ! /* Or if Topal mucked with it... */ ! | (body->type == TYPEMULTIPART && body->topal_hack == 1)) && !so_attr((STORE_S *) body->contents.text.data, "rawbody", NULL)){ ! if(body->topal_hack == 1) ! dprint((9, "Topal: Canonical conversion, although Topal has mangled...\n")); ! gf_link_filter(gf_local_nvtnl, NULL); } switch (body->encoding) { /* all else needs filtering */ *************** *** 4390,4396 **** return(pwbh_finish(0, so)); if(body->parameter){ ! if(!pine_write_params(body->parameter, so)) return(pwbh_finish(0, so)); } else if(!so_puts(so, "; CHARSET=US-ASCII")) --- 4412,4418 ---- return(pwbh_finish(0, so)); if(body->parameter){ ! if(!pine_write_params(body->parameter, so, body)) return(pwbh_finish(0, so)); } else if(!so_puts(so, "; CHARSET=US-ASCII")) *************** *** 4469,4475 **** && so_puts(so, body->disposition.type))) return(pwbh_finish(0, so)); ! if(!pine_write_params(body->disposition.parameter, so)) return(pwbh_finish(0, so)); if(!so_puts(so, "\015\012")) --- 4491,4497 ---- && so_puts(so, body->disposition.type))) return(pwbh_finish(0, so)); ! if(!pine_write_params(body->disposition.parameter, so, body)) return(pwbh_finish(0, so)); if(!so_puts(so, "\015\012")) *************** *** 4531,4537 **** * pine_write_param - convert, encode and write MIME header-field parameters */ int ! pine_write_params(PARAMETER *param, STORE_S *so) { for(; param; param = param->next){ int rv; --- 4553,4559 ---- * pine_write_param - convert, encode and write MIME header-field parameters */ int ! pine_write_params(PARAMETER *param, STORE_S *so, BODY *body) { for(; param; param = param->next){ int rv; *************** *** 4540,4548 **** cs = posting_characterset(param->value, NULL, HdrText); cv = utf8_to_charset(param->value, cs, 0); ! rv = (so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! if(cv && cv != param->value) fs_give((void **) &cv); --- 4562,4578 ---- cs = posting_characterset(param->value, NULL, HdrText); cv = utf8_to_charset(param->value, cs, 0); ! if (body->topal_hack == 1 ! && !struncmp(param->attribute, "protocol", 9)) { ! /* Did Topal introduce more parameters? */ ! dprint((9, "Topal: parameter encoding of protocol, with Topal hack\n")); ! rv = (so_puts(so, "; \015\012\011") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! } ! else ! rv = (so_puts(so, "; ") ! && rfc2231_output(so, param->attribute, cv, (char *) tspecials, cs)); ! if(cv && cv != param->value) fs_give((void **) &cv); *************** *** 4649,4655 **** long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART) { /* multipart gets special handling */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); --- 4679,4687 ---- long l = 0L; PART *part; ! if(body->type == TYPEMULTIPART ! && body->topal_hack != 1) { /* multipart gets special handling ! but again, be careful of Topal */ part = body->nested.part; /* first body part */ do /* for each part */ l += send_body_size(&part->body); Only in alpine.new/alpine-1.10/pith: send.c.orig Only in alpine.new/alpine-1.10/web/src/alpined.d: compilation.orig topal-80/Makefile0000644000175000017500000001154613434071426012205 0ustar pjbpjb# Topal: GPG/GnuPG and Alpine/Pine integration # Copyright (C) 2001--2018 Phillip J. Brooke # # This program 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. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . .PHONY: all binary doc clean realclean distclean package tarball install distrib all2 FORCE RELEASECODE=$(shell grep '^

    ' Changelog.html | tail -1 | sed 's/.* release //; sx.*$$xx') ifdef SOURCE_DATE_EPOCH BUILDDATE := $(shell date '+%Y-%m-%dT%H%M%S%Z' -d @$(SOURCE_DATE_EPOCH)) else BUILDDATE := $(shell date '+%Y-%m-%dT%H%M%S%Z') endif # If you intend to redistribute this package, you will obviously need # to substitute your own key id here. MYKEY=0x47DC67A1 include Buildflags.mk GENFILES=$(addprefix ./,version_id.adb help.ads help.adb b~topal.ads b~topal.adb) CFILES=$(shell find . -maxdepth 1 -name \*.c) ADSFILES=$(filter-out $(GENFILES),$(shell find . -maxdepth 1 -name \*.ads)) ADBFILES=$(filter-out $(GENFILES),$(shell find . -maxdepth 1 -name \*.adb)) OTHERFILES=Makefile Buildflags.mk Changelog.html Features.html topal.tex topal.man COPYING mkversionid mkversionidtex mkhelp help.txt mkdistrib cygwin.patch $(shell find . -maxdepth 1 -name pine-\*.patch) $(shell find . -maxdepth 1 -name alpine-\*.patch) $(shell find . -maxdepth 1 -name alpine-\*.patch-\*) c_objects := $(CFILES:c=o) TOPALDEPS=$(c_objects) version_id.adb help.ads help.adb $(ADSFILES) $(ADBFILES) DESTDIR ?= prefix ?= /usr INSTALLPATH ?= $(DESTDIR)$(prefix) INSTALLPATHBIN ?= $(INSTALLPATH)/bin INSTALLPATHMAN ?= $(INSTALLPATH)/share/man INSTALLPATHDOC ?= $(INSTALLPATH)/share/doc/topal INSTALLPATHPATCHES ?= $(INSTALLPATH)/share/topal/patches # Set this to "true" to keep debugging symbols. strip ?= strip # The default action. all: binary topal.pdf binary: topal mime-tool all2: package distrib $(c_objects): %.o: %.c $(CC) -c $(default_CFLAGS) $(CFLAGS) $(CPPFLAGS) $< -o $@ mime-tool: make -C MIME-tool topal: $(TOPALDEPS) gnatmake $(gnatmake_options) topal.adb \ -cargs $(default_ADAFLAGS) $(ADAFLAGS) \ -largs $(default_LDFLAGS) $(LDFLAGS) \ # FORCE, because BUILDDATE changes each time.... version_id.adb: mkversionid FORCE ./mkversionid $(RELEASECODE) $(BUILDDATE) versionid.tex: mkversionidtex FORCE ./mkversionidtex $(RELEASECODE) $(BUILDDATE) help.ads help.adb: mkhelp help.txt ./mkhelp doc: topal.pdf topal.pdf: topal.tex versionid.tex pdflatex topal.tex && pdflatex topal.tex install: all install -d $(INSTALLPATHBIN) $(INSTALLPATHDOC) $(INSTALLPATHMAN)/man1 $(INSTALLPATHPATCHES) install -m 755 -s --strip-program=$(strip) topal $(INSTALLPATHBIN) install -m 644 Features.html Changelog.html topal.pdf COPYING $(INSTALLPATHDOC) install -m 644 topal.man $(INSTALLPATHMAN)/man1/topal.1 install -m 644 pine-*.patch alpine-*.patch alpine-*.patch-* $(INSTALLPATHPATCHES) install -m 755 -s --strip-program=$(strip) MIME-tool/mime-tool $(INSTALLPATHBIN) install -m 644 MIME-tool/mime-tool.man $(INSTALLPATHMAN)/man1/mime-tool.1 clean: $(RM) *.o *.ali $(GENFILES) # Clean LaTeX stuff. $(RM) $(addprefix topal.,toc out log aux) # Clean packaging directories. -$(RM) -r topal-[0-9]* make -C MIME-tool clean distclean realclean: clean $(RM) topal README.txt *~ \ $(addprefix topal,.gz .gz.asc -ps -ps.gz -ps.gz.asc) \ $(addprefix topal-package*,.tgz .tgz.sig .tgz.asc) -$(RM) -r www www.bak make -C MIME-tool realclean package: topal-package-$(RELEASECODE).tgz topal-package-$(RELEASECODE).tgz.asc tarball: topal-package-$(RELEASECODE).tgz topal-package-$(RELEASECODE).tgz: $(CFILES) $(ADSFILES) $(ADBFILES) $(OTHERFILES) -$(RM) -r topal-$(RELEASECODE) mkdir -p topal-$(RELEASECODE)/MIME-tool cp -r $(CFILES) $(ADSFILES) $(ADBFILES) $(OTHERFILES) screens topal-$(RELEASECODE) cp -r $(filter-out MIME-tool/mime-tool,$(wildcard MIME-tool/*)) topal-$(RELEASECODE)/MIME-tool find topal-$(RELEASECODE) -type f | xargs chmod 644 find topal-$(RELEASECODE) -type f -name mk\* | xargs chmod 755 chmod 755 topal-$(RELEASECODE) tar cvzf topal-package-$(RELEASECODE).tgz topal-$(RELEASECODE) topal-package-$(RELEASECODE).tgz.asc: topal-package-$(RELEASECODE).tgz $(RM) topal-package-$(RELEASECODE).tgz.asc -gpg --detach-sign --armor --local-user=$(MYKEY) --use-agent topal-package-$(RELEASECODE).tgz distrib: topal-package-$(RELEASECODE).tgz.asc mkdistrib -$(RM) -r www mkdir www cp topal-package-$(RELEASECODE).tgz topal-package-$(RELEASECODE).tgz.asc topal.pdf Changelog.html COPYING www cd www && ../mkdistrib $(RELEASECODE) FORCE: topal-80/externals-ops.adb0000644000175000017500000000572013434071426014016 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Text_IO; with Misc; use Misc; package body Externals.Ops is function Get_MD5Sum_Of_File (Filename : String) return UBS is CH : Ada.Text_IO.File_Type; MD5 : UBS; Cache_File : constant String := Temp_File_Name("cachename"); E1, E2 : Integer; begin ForkExec2_Out(Value_Nonempty(Config.Binary(Md5sum)), UBS_Array'(0 => ToUBS("md5sum"), 1 => ToUBS(Filename)), E1, Value_Nonempty(Config.Binary(Sed)), UBS_Array'(0 => ToUBS("sed"), 1 => ToUBS("s/ .*//")), E2, Target => Cache_File); if E1 /= 0 then Error("md5sum failed! (ff8)"); elsif E2 /= 0 then Error("sed failed! (ff9)"); end if; Ada.Text_IO.Open(File => CH, Mode => Ada.Text_IO.In_File, Name => Cache_File); MD5 := Unbounded_Get_Line(CH); Ada.Text_IO.Close(CH); return MD5; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Ops.Get_MD5Sum_Of_File"); raise; end Get_MD5Sum_Of_File; function Test_Decrypt_Prerequisite return Integer is begin return ForkExec(ToStr(Config.UBS_Opts(Decrypt_Prereq)), Config.UBS_Opts(Decrypt_Prereq)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Ops.Test_Decrypt_Prequisite"); raise; end Test_Decrypt_Prerequisite; procedure Open_TTY is TTY_FD : Integer; begin CClose(0); CClose(1); -- We're about to close stderr, so don't bother writing any more -- debugging to it. Misc.Inhibit_Stderr := True; CClose(2); TTY_FD := Open_In("/dev/tty"); Dup2(TTY_FD, 0); TTY_FD := Open_Out("/dev/tty"); Dup2(TTY_FD, 1); Dup2(TTY_FD, 2); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Externals.Ops.Open_TTY"); raise; end Open_TTY; end Externals.Ops; topal-80/version_id.ads0000644000175000017500000000150013434071426013364 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . package Version_ID is -- Release code. function Release return String; -- Build date. function Build_Date return String; end Version_ID; topal-80/topal.tex0000644000175000017500000013521313434071426012404 0ustar pjbpjb% Topal: GPG/GnuPG and Alpine/Pine integration % Copyright (C) 2001--2018 Phillip J. Brooke % % This program 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. % % This program is distributed in the hope that it will be useful, % but WITHOUT ANY WARRANTY; without even the implied warranty of % MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the % GNU General Public License for more details. % % You should have received a copy of the GNU General Public License % along with this program. If not, see . \documentclass[a4paper,twoside,12pt,openright]{report} \usepackage[utf8]{inputenc} \usepackage{palatino,fancyhdr,amssymb,textcomp,txfonts,paralist} \newcommand{\eg}{\textit{e.g.}} \newcommand{\etc}{\textit{etc.}} \newcommand{\ie}{\textit{i.e.}} \newcommand{\vv}{\textit{vice versa}} \usepackage[hyphens]{url} \usepackage{hyphenat} \usepackage{graphicx} \renewcommand\familydefault{\sfdefault} \usepackage{listings} \lstset{language=,columns=fullflexible,escapechar=\%,keepspaces=true} \lstset{basicstyle=\small\ttfamily} \lstdefinestyle{type}{backgroundcolor=\color{green},showspaces=true} \lstdefinestyle{response}{backgroundcolor=\color{yellow}} \input{versionid.tex} % Don't like Courier. \usepackage[T1]{fontenc} \usepackage{textcomp} \usepackage{beramono} \newcommand{\vefill}{\vspace*{\fill}} \newcounter{saveenumi} \newcommand{\saveenumi}{\setcounter{saveenumi}{\theenumi}} \newcommand{\restoreenumi}{\setcounter{enumi}{\thesaveenumi}} \newenvironment{enumerateleg}{\begin{enumerate}[(a)]}{\end{enumerate}} \newlength{\Oldparindent} \setlength{\Oldparindent}{\parindent} % Maxwidth, from http://www.tex.ac.uk/cgi-bin/texfaq2html?label=grmaxwidth \makeatletter \def\maxwidth{% \ifdim\Gin@nat@width>0.9\linewidth 0.9\linewidth \else \Gin@nat@width \fi } \makeatother % Screenshot figures. The filename and the caption. \newcommand{\SSF}[2]{ \begin{figure}[htp!] \centering \fbox{\parbox{0.9\linewidth}{ \centering \includegraphics[width=\maxwidth]{screens/#1} \caption{#2}\label{fig:#1}}} \end{figure} (figure~\ref{fig:#1})} \usepackage[bookmarksopen=true,bookmarksopenlevel=1, bookmarksnumbered=true, colorlinks=true, urlcolor=blue, breaklinks=true, pdftitle={Topal manual}, pdfauthor={Phil Brooke}, pdfsubject={Topal}, pdfkeywords={Topal, Pine, Alpine, OpenPGP, SMIME, GnuPG} ]{hyperref} % Footing. \fancyfoot{} \fancyfoot[RO,LE]{\thepage} \begin{document} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Title page/front cover %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagestyle{empty} \begin{titlepage} \pdfbookmark[1]{Title page}{pdf:titlePage} \setlength{\parindent}{0pt} \raggedright {\Huge\bf\scshape Topal\\\bigskip\large GPG/GnuPG and Alpine/Pine integration}\\[10ex] {\Large Phil Brooke } \vfill Release~\TopalRelease\\ \TopalBuildDate \setlength{\parindent}{\Oldparindent} \end{titlepage} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Inside front cover. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \vefill \setlength{\parindent}{0pt} { Topal: GPG/GnuPG and Alpine/Pine integration Copyright \copyright~ 2001--2018 Phillip J. Brooke This program 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. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see \url{http://www.gnu.org/licenses/}. } \setlength{\parindent}{\Oldparindent} \cleardoublepage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Front matter, ToC, LoF, ... %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagestyle{fancy} \renewcommand{\headrulewidth}{0pt} \fancyhead{} \pagenumbering{roman} \setcounter{page}{1} \pdfbookmark[1]{Table of contents}{pdf:TOC} \tableofcontents \cleardoublepage %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Main matter. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% \pagenumbering{arabic} \setcounter{page}{1} \chapter{Introduction \& features} Topal is a ‘glue’ program that links \href{http://www.gnupg.org}{GnuPG} and \href{http://www.washington.edu/pine/}{Pine}/% \href{http://www.washington.edu/alpine/}{Alpine}/% \href{http://sourceforge.net/projects/re-alpine/}{``Re-Alpine'' (from Sourceforge)}. It offers facilities to encrypt, decrypt, sign and verify emails, including inline OpenPGP, MIME/OpenPGP and S/MIME. It can also be used directly from the command-line. \section{Features} \begin{itemize} \item Multiple inline PGP blocks can be processed in display filters. \item Decryption and verification output can be cached to reduce the number of times a passphrase is entered\footnote{Note that you should also consider the use of \texttt{gpg-agent}.}. This also helps when secret keys aren't always available, at the expense of storing decrypted output. \item MIME/OpenPGP (RFC2015/RFC3156) multipart messages can be sent and received. Depending on configuration, this might involve procmail, using \verb|sendmail-path| or patching Alpine. \item The deprecated application/pgp content-type can be sent and received. \item S/MIME messages can be sent and received if \verb|gpgsm| is available. (\verb|openssl| is also used in some circumstances, but \verb|gpgsm| is still required.) \item Topal can be used as Alpine's \verb|sendmail-path| command. \item Topal has a remote sending mode (a server and a means of accessing the server) for reading email on a distant computer via SSH with secret keys on the local computer. \item A range of mechanisms for selecting keys for both self and recipients. \item There is a high level of configurability (although the configuration interface does not expose all of it; you may have to edit \verb|.topal/config|). \end{itemize} \section{Terminology} We use Pine and Alpine interchangably in this manual. The earliest version of Pine that Topal supported was 4.44. When referring to Thunderbird and Enigmail together, we sometimes just say Thunderbird. Similarly, we often use GnuPG, GPG and sometimes OpenPGP and PGP interchangably. \section{Version numbering} Recent stable releases have been numbered 55, 56, \ldots. Prior to release 55, the stable releases were 0.7.2, 0.7.8, 0.7.9 and 0.7.13.6. \chapter{Important changes from previous stable versions} \section{Important changes in release 70} The \verb|use-agent| option sets GPG's \verb|--use-agent| option as needed. Don't set it in any other way or it might be confusing\ldots. \section{Important changes in release 68} \begin{itemize}\item The sending interface has changed. Selecting (for example) ‘e’ for encrypt no longer immediately operates. Instead, the desired operation is chosen, and then ‘g’ for ‘Go!’ is used. This allows defaults to be associated with keys and email addresses in a sensible way. \item The MIME viewer setting \verb|mime-viewer| has been replaced by two new settings, one for decrypting and one for verifying. You should set these to suit your preferences. (The redundant line will be dropped the next time you save your configuration inside Topal.) \end{itemize} \section{Important changes in release 65} An additional patch has been added. This should make the procmail recipe redundant. More testing is required: it may have broken other Alpine features. \section{Important changes in release 60} MIME sending now requires MIME-tool; mime-construct is no longer used. See the compilation and installation instructions. \section{Important changes in release 58} The default configuration no longer uses absolute paths. \section{Important changes in release 55} \begin{itemize}\item If you use a non-English locale, please check that Topal still works as expected (I replaced code that fixed some locale problems). \item The Alpine patch is based off my old Pine patches, but does a little more. You will need to set the \begin{quote} \verb|Enable Topal hack for OpenPGP/MIME messages| \end{quote} option in the hidden configuration list. Bug reports welcome. \item The \verb|--fix-email| wrapper no longer creates a multipart/alternative: it creates a multipart/misc wrapper instead. Please check that your procmail recipe includes a suitable backup in case this doesn't work for you. \end{itemize} \section{Important changes in version 0.7.10} The recommended procmail recipe has been changed. \section{Important changes in version 0.7.8} \verb|topal-fix-email| and \verb|topal-fix-folder| have been replaced by the main topal binary. Change \verb|topal-fix-email| in your .procmailrc to be \verb|topal --fix-email|. (Or add symlinks: the binary checks what it has been called as.) You \emph{must} clear your cache otherwise the changes made for\linebreak \verb|inline-separate-output| \marginpar{New in version~0.7.8.} will break (this occurs regardless of whether the option is on or off). This new feature shows the GnuPG/Topal output separately, then hands back the decrypted or verified output without any wrappers. This makes it more suitable for dealing with attachments (but you need to set it manually via \verb|topal -config|). Finally, the send menu has a new option: ‘Pass through unchanged’. This does nothing to the message so, you can always have Topal invoked as a filter for sending. \chapter{Installation and configuration} \marginpar{As of version 76, the two Alpine patches are deprecated.} \section{Options} Topal supports a range of options depending on your preferences; some have particular requirements: the following table summarises them. \newcommand{\colh}[1]{\rotatebox{89}{\parbox{5cm}{\raggedright #1}}} \noindent\begin{tabular}{|l|ccc|cccc|} \hline &\multicolumn{3}{c|}{Sending}&\multicolumn{4}{c|}{Receiving}\\ \hline & \colh{Configure Alpine's \texttt{sending-filters}} & \colh{Configure Alpine's \texttt{sendmail-path}} & \colh{Apply patch \texttt{-1} to Alpine} & \colh{Configure Alpine's \texttt{display-filters}} & \colh{Pipe entire message to \texttt{topal -raw}} & \colh{Configure \texttt{.procmail} or run \texttt{topal --fix-email}} & \colh{Apply patch \texttt{-2} to Alpine and configure \texttt{.mailcap}} \\ \hline Encrypt/sign inline OpenPGP &$\star$&$\star$&&&&&\\ Decrypt/verify inline OpenPGP &&&&$\star$&$\star$&&\\ \hline Encrypt/sign MIME/OpenPGP &&$\star$&$\downarrow$&&&&\\ Decrypt/verify MIME/OpenPGP &&&&&$\star$&\textopenbullet&$\downarrow$\\ \hline Encrypt/sign S/MIME &&$\star$&$\downarrow$&&&&\\ Decrypt/verify S/MIME &&&&&$\star$&\textopenbullet&$\downarrow$\\ \hline \end{tabular}\bigskip \noindent Key: \begin{tabular}[t]{cl} \hline $\star$&This is a preferred option, but there may be an alternative (\textopenbullet).\\ \textopenbullet&This is a possible option, but there is a better option ($\star$).\\ $\downarrow$&Deprecated.\\ \hline \end{tabular}\bigskip \pagebreak Inline OpenPGP can be processed via Alpine's sending and display filters. So you need to configure this within Alpine. MIME messages are more complicated. MIME/OpenPGP messages can be sent if the deprecated patch 1 is applied to Alpine. However, although the corresponding S/MIME messages appear to be correctly formed, use of patch 1 requires that the message is embedded within a multipart/mixed message --- and other mail clients (such as Mozilla Thunderbird and MS Outlook) will not handle them properly. So for MIME sending, you are strongly recommended to use Topal as a \verb|sendmail-path| for Alpine. Receipt of MIME messages (both OpenPGP and S/MIME) is best handled via piping the whole message to \verb|topal -raw|; make sure you set \verb|Raw text| (\verb|^W|) and \verb|Free output| (\verb|^Y|). This also works for inline messages. An alternative is to invoke Topal's \verb|--fix-email| mode via \verb|.procmail| which rewrites the top-level cryptographic message into a multipart/mixed message that can be more easily processed by Alpine. The final option is to use Alpine with patch 2; this is deprecated. This will cause Alpine to crash if your \verb|.mailcap| is not properly configured to handled the cryptography multipart/* types. \section{Compilation and installation} To compile Topal, you need \begin{compactitem}\item a working C compiler, \item the GNU Ada Compiler (GNAT), and \item some common libraries, including \verb|readline| (e.g., the package \linebreak\verb|libreadline6-dev| on Debian). \end{compactitem} There is a makefile: simply type \verb|make|. My normal environment is Debian; I've put some code in \verb|Buildflags.mk| to handle missing \verb|dpkg-buildflags|, but it may not work. Bug reports and patches are welcome. Type \verb|make install| to actually install. The default location is \verb|/usr|, so you'll need to be root to install. Alternatively, use \linebreak\verb|make install INSTALLPATH=/usr/local| to install into \verb|/usr/local|. (Or use the more specific variables \verb|INSTALLPATHBIN|, \verb|INSTALLPATHMAN|, \verb|INSTALLPATHDOC| and \verb|INSTALLPATHPATCHES|.) \subsection{Cygwin} Before using the makefile, please apply the patch \verb|cygwin.patch|. I haven't recently tested this\ldots. \subsection{MIME-tool} MIME sending requires the Topal version of Jeffrey S.~Dutky's \verb|mime-tool|. This is included with the Topal sources, and is compiled and installed at the same time using the Makefile. \subsection{MIME viewing} MIME viewing can be handled via \begin{compactenum}\item metamail, \item run-mailcap, or \item by saving to a file (mbox format) in the \verb|~/.topal| directory and viewing with Alpine. \end{compactenum} If you are using patch~2 (see ``Alpine patches'' below), then depending on your Alpine configuration, Alpine might say something like \begin{quote} \verb|Attachment SIGNED unrecognized. Try opening anyway?| \end{quote} --- you should say \verb|yes| in that case. \subsection{GNU sed} GNU sed is required. I only discovered this when using Topal on Mac OS X\ldots. \section{Alpine patches} There are two patches, for a range of versions of Pine and Alpine. Patch 1 deals with sending MIME messages (\verb|-sendmime|); patch 2 with receiving them. \begin{centering} \begin{tabular}{lcc} \hline &Patch 1&Patch 2\\ \hline Pine 4.44&\checkmark&\\ Pine 4.50&\checkmark&\\ Pine 4.53&\checkmark&\\ Pine 4.58&\checkmark&\\ Pine 4.60&\checkmark&\\ Pine 4.64&\checkmark&\\ Alpine 1.00&\checkmark&\\ Alpine 2.00&\checkmark&\checkmark\\ Alpine 2.02&\checkmark&\checkmark\\ \hline \end{tabular} \end{centering} \bigskip To apply these patches, \verb|cd| into the Pine or Alpine source directory and use the \verb|patch| command, \eg, \verb|patch -p1 < -2.02.patch-1|. Please note that the Alpine patches also modify Alpine's configuration. There is a hidden preference ‘enable Topal hack’ (\verb|enable-topal-hack|) that you need to enable. % It doesn't seem to have broken anything else.... It seems to work for % sending via an SMTP server - it might break for sending via % /usr/lib/sendmail (if it does, please send me a debug trace by % invoking pine with ‘\verb|-d 9|’). \section{Alpine filter configuration}\label{sec:filter-conf} Assuming that the topal binary is installed in \verb|/usr/bin|, set up the Alpine sending and display filters as follows: \begin{lstlisting} display-filters=_BEGINNING("-----BEGIN PGP ")_ /usr/bin/topal -display _TMPFILE_ _RESULTFILE_ sending-filters=/usr/bin/topal --read-from _INCLUDEALLHDRS_ -send _TMPFILE_ _RESULTFILE_ _RECIPIENTS_, /usr/bin/topal --read-from _INCLUDEALLHDRS_ -sendmime _TMPFILE_ _RESULTFILE_ _MIMETYPE_ _RECIPIENTS_ \end{lstlisting} You can choose either or both of the sending filters. The \verb|-sendmime| option allows the user to choose the MIME type of the outbound email. (Legacy fixes are in place that make \verb|-decrypt| and \verb|-verify| behave the same as \verb|-display|.) Note that \verb|_RECIPIENTS_| must be last. The \verb|--read-from _INCLUDEALLHDRS_|\label{pg:readFrom} text makes Topal attempt to guess a suitable key for signing and self-encryption. If multiple possible keys match, then you'll be offered a menu of the keys. Use of this option is strongly recommended (but can be omitted). \section{Alpine sendmail-path configuration}\label{sec:sendmail-path-conf} As an alternative (or addition!) to setting filters (above), you can set \begin{lstlisting} sendmail-path="/usr/bin/topal -asend" \end{lstlisting} Also see section~\ref{sec:smp-config} for more details on configuring this mode. This option allows Topal to handle attachments added within Alpine, whereas sending using patch 1 requires that attachments are added via Topal's interface (otherwise the attachments aren't covered by encryption or signing). \section{Alpine fcc --- warning} When sending encrypted messages, then ---depending on how you invoke Topal--- the message saved by Alpine into your file carbon copy folder may not be encrypted. This applies primarily to the \verb|sendmail-path| usage, where from Alpine's viewpoint, the message is sent by handing it to Topal. In this mode, I set \verb|fcc| to be empty (for Alpine) and ensure that Topal uses \verb|msmtp| to save an extra bcc copy to me (see section~\ref{sec:msmtp-bcc}). Also see the remarks on save-on-send in section~\ref{sec:save-on-send}. \section{Mailcap configuration} To decode MIME RFC2015/3156 multipart/signed and /encrypted messages requires help via the ``mailcap'' system. Add in either the user mailcap configuration (\verb|.mailcap|) or the system configuration (\verb|/etc/mailcap|) the lines \begin{lstlisting} multipart/signed; /usr/bin/topal -mime '%\%%s' '%\%%t'; needsterminal multipart/encrypted; /usr/bin/topal -mime '%\%%s' '%\%%t'; needsterminal application/pgp; /usr/bin/topal -mimeapgp '%\%%s' '%\%%t'; needsterminal \end{lstlisting} Note that Alpine has been known to crash if you compile it with the second patch, but do not set up your mailcap file to handle these multipart types. \section{Procmail configuration}\label{sec:procmail-configuration} From Topal version 65, this recipe is no longer needed if you are using patch~2. If you prefer to modify inbound multipart messages rather than use patch~2, you should add this recipe to your \verb|.procmailrc|: \begin{lstlisting} :0fw | /usr/bin/topal --fix-email \end{lstlisting} This causes Topal to examine all inbound emails. Those with top-level multipart/signed or multipart/encrypted MIME types are modified to add a multipart/misc wrapper so that Alpine can hand it off to Topal. All other emails are left unchanged. I strongly advise that you also use one of the backup recipes from the procmail manual. \section{Topal configuration} Create a directory called ‘\verb|${HOME}/.topal|’. This is currently hard-coded into Topal. Create the basic configuration file by running topal with the \verb|-dump| or \verb|-default| options. This file should be named ‘\verb|config|’. All \verb|.topal| files are silently ignored if they cannot be found. Comments begin with a \verb|#| in the first column, and run to the end of a line. They are totally ignored and are not currently preserved. Parsing errors cause an exception. If you want to include strings with spaces, you'll need to quote them with double-quotes (\verb|"|). Double-quotes themselves can be included by ‘stuffing’ (\verb|""|). \chapter{Usage} \section{Help!} \verb|-help| as the first argument dumps a help message. The help message is derived from the \verb|help.txt| file in the source distribution. See \verb|help.txt| for information on non-Pine use of Topal (section~\ref{sec:nonpine}). Send \href{mailto:p.j.brooke@bcs.org.uk}{email to me} if you're really stuck. \section{Configuration} \verb|-config| as the first argument brings up the configuration menu. This menu is also available when sending (so that the signing key can be changed). However, not all features can be configured via the menus. In some cases, you'll need to edit \verb|.topal/config|. Later sections in this manual give specific instructions for particular features. If you want to change the comment mentioning Topal when sending messages (\ie, the bit saying \verb|Topal (https://zircon.org.uk/topal/)|) then modify \verb|sending-options| (via the configuration menu or the \verb|config| file). Colours were introduced in release 71. If you want to turn them off, set \verb|ansi-terminal=off| in the \verb|config| file. You can change the colours by setting \verb|colour-menu-title|, \verb|colour-menu-key|, \verb|colour-menu-choice|, \verb|colour-important|, \verb|colour-banner| and \verb|colour-info|. The codes are the escape codes (see, for example, colour table in the \url{http://en.wikipedia.org/wiki/ANSI_escape_code} Wikipedia article on ANSI escape codes). \section{Decryption/verification} The recommended invocation for Topal from inside Alpine is via Alpine's \verb|display-filters| (see section~\ref{sec:filter-conf}) for inline messages, and for any message type, via piping (Alpine command \verb/|/) with the \verb|Raw text| (\verb|^W|) and \verb|Free output| (\verb|^Y|) options set. Depending on configuration, Topal will either ignore the file altogether, ask you what you want to do with it, or proceed to process the file automatically. GPG will ask you for your passphrase when it needs it. Caching is in place; the results of decryption and verification are (subject to configuration) saved in \verb|~/.topal/cache|. The results of caching mean that you won't be repeatedly asked for your passphrase, at the expense of storing decrypts in the clear. Be warned: Topal often invokes \verb|less| to view something. So you'll need to use \verb|q| to get out of it. \verb|metamail| or \verb|run-mailcap| may be called for anything after MIME processing. A new option \marginpar{New in version~0.7.8.} called \verb|inline-separate-output| concerns inlined (\ie, not MIME) messages. If the option is on, then the Topal/GnuPG output will be shown to you by \verb|less|. Then the decrypted or verified output will be handed back to Pine/Alpine. This is the way to approach attachments. However, you will normally want to keep this option off, because if you're reading (for example) BugTraq mailings, then it will want you to hit \verb|q| an awful lot\ldots. \section{Sending} The recommended invocation for Topal from inside Alpine is via \verb|sendmail-path| (see section~\ref{sec:sendmail-path-conf}). \subsection{Main send menu} Topal initially displays some chatter about selecting keys, including (if possible) a key for the sending user. After that, you will be presented with the sending main menu~\SSF{mainSendMenu.png}{Main sending menu}. Some options (\eg, those relating to MIME features) will not be offered unless you use the \verb|-sendmime| option. ‘Abort’ tells Pine/Alpine you don't want Topal to process the email anymore. ‘Pass through unchanged’ does nothing to the message. This means that you can always have Topal invoked for sending. ‘Add own key’ adds an ‘encrypt to self’ key. (It is added by default, but if you remove it, this is a quick way to restore it.) When you select ‘Go!’ you will be asked to confirm the command-line, and after processing, \verb|less| is invoked to visually check that the desired result has been achieved. Again, a confirmation is asked for. Topal can offer a choice of three MIME types. Don't use (2 --- app/pgp) unless you really know what you're doing. (4 --- multipart encap) is only relevant if you are signing and encrypting: this encapsulates a MIME signed message inside an encrypted message (but Thunderbird doesn't seem to process the signature on these). Otherwise, we do both operations at once. (If you choose ‘clearsign’ and ‘multipart/*’, then all trailing blank lines will be deleted. Note also that Pine/Alpine appears to delete trailing whitespace in trailing blank lines.) ‘Configuration’ offers the same menu that is available from the \verb|-config| option. \subsection{List current recipient keys} ‘List current recipient keys’ offers a list of recipients~\SSF{keyListMenu.png}{Key list menu}. ‘Quit and return to main send menu’ sends you back to the first menu. ‘Add key from main keyring’ prompts you for a search pattern. It will do a general search on your GPG keyring \emph{and add} all matching keys. Beware of just pressing enter --- it will select \emph{all} keys on your keyring. A better alternative is to use the ‘select after search’ option. This also does a search on your GPG keyring, but then you must select one key to be added to your list of recipients. \subsection{Examine key menu} Selecting a key will offer a third menu (a similar menu is offered when selecting a single key)~\SSF{examineKeyMenu.png}{Single key menu}. ‘Return to key list’ takes you back to the second menu. ‘Display details of key (less)’ simply uses GPG to list the key details via \verb|less|. You'll need to use \verb|q| to get out of \verb|less|. ‘Verbose details of key (less)’ pipes verbose output from GPG for this key into gpg. Again, you'll need to use \verb|q| to get out of \verb|less|. ‘Remove key from list’ removes the key from this recipient list. \section{Command-line usage}\label{sec:nonpine} \subsection{Sending (\texttt{-nps})} If you invoke Topal on the command-line with a filename as an argument, it will offer the sending functions on that file~\SSF{npsSendMenu.png}{Non-pine sending menu}. It doesn't actually send anything: instead it allows you to encrypt, sign, \etc\ the message. {\em You have a choice of overwriting or preserving the original file (this bit is case-sensitive).} So \verb|e|, \verb|s| and \verb|c| are different from \verb|E|, \verb|S| and \verb|C| respectively. The main purpose of this mode is for encrypting or signing attachments before they are attached to the message in Pine/Alpine. Beware that Pine/Alpine does not feed the attachments to a sending filter. Or you could use the attachments option when using Pine with MIME emails. MIME functions are not available in this mode. \subsection{Receiving (\texttt{-pd})} \marginpar{New in release~71.} Invoking Topal with only \verb|-pd| as an argument causes it to read a message from standard input and attempt to decrypt/verify it. This is useful for piping MIME messages from other applications. \section{Remote and server mode} Suppose you are reading your email on a remote host via \verb|ssh| (as I often do). You now want to compose an email and sign it, but your secret key is only accessible on the local computer. Topal has rudimentary support for this (primarily to support my style of working). This comes in two parts: a ‘server’ mode to run on the local computer (with access to the secret key) and a remote option in the sending menu. The server mode (on the local host) is started by running \verb|topal -server|. This is where GPG requests for signing are made. When sending, you can choose ‘remote’. This prompts for the host to connect to using \verb|ssh|/\verb|scp|: this host should be running the ‘server’. The files are sent to the local server, processed by the server, then the results are copied back. \verb|ssh| and \verb|scp| are both used: because they're used repeatedly, you might want to use key-based authentication and have the key added to a current \verb|ssh-agent|. There is also a remote mode for receiving, with a similar behaviour as for sending. Alternatively could use something like unison (or some other file synchroniser or a simple scp) to move the email(s) concerned, then view them on the local computer. A generally better alternative is to process your email locally by using IMAPS and SMTPS to remotely access the mail server. \section{Fixing multipart emails} Two scripts used to be included with topal (long ago): \verb|topal-fix-email| and \verb|topal-fix-folder|. They have been replaced by the \verb|--fix-email| and \verb|--fix-folder| command-line options to the main binary. \verb|topal --fix-email| modifies any email that is (at the top level) a multipart/signed or multipart/encrypted message. It creates a multipart/misc message instead: this revised message is simply a wrapped version of the original message so that Pine/Alpine can pass the signed or encrypted part to Topal. Usage: \begin{itemize}\item \verb|topal --fix-folder ...| fixes the named email folders. \item \verb|topal --fix-email| takes no arguments; it accepts a single email on stdin. Ideally, it should be invoked by procmail (see section~\ref{sec:procmail-configuration}). \end{itemize} \verb|topal --fix-email| has a simpler mode (\verb|--simple|) where it pretends that there are two MIME content types: ‘application/x-topal-encrypted’ and ‘application/x-topal-signed’. You might prefer using this. These effectively rename the multipart email instead of wrapping it. Why do we need this? If we just set the \verb|.mailcap| file for, say, multipart/signed, then Alpine (at least version 1.00) is unable to handle a top-level multipart/signed email: an error message starting \begin{quote} \verb|Can't find body for requested message| \end{quote} is seen. But multipart/signed inside a multipart/mixed (or multipart/alternative, \etc) can be successfully handed-off to Topal. Replying to such messages is a pain: you'll have to save off the actual message and read it in. Suggestions on fixing this are welcome\ldots. See \verb|Workaround.Fix_Email| in the sources for more details. \chapter{Notes} This chapter includes a number of notes, explanations and further details. \section{The Pine/Alpine patches, and sending other attachments} What does the (first) patch to Alpine do? It removes some of the safety checking when changing the content-type (\verb|_MIMETYPE_|) in a filter. Normally, if the returned content-type is not text/*, then the entire content-type is dropped by Alpine. The patch instead adds a flag, ‘\verb|topal_hack|’, and sets this if the returned content-type is not text. From time-to-time, we pretend that the body is normal text. We take a little care to check if this message is already a multipart message, so hopefully, the normal sending of attachments still works. However, these attachments are \emph{not} encrypted or signed by Topal. You will need to separately process them before attaching them in Alpine (\eg, using the command-line mode described in section~\ref{sec:nonpine}) or add them using Topal's attachment menu (if you are using Topal's MIME sending features). The second patch file \marginpar{New from Topal release~65 for Alpine~2.00.} slightly modifies some of the mail reading code to allow .mailcap settings to act directly on top-level multipart messages. But see section~\ref{sec:crash-second-patch} if you find Alpine crashes when this patch is used. \section{Key IDs and keylists} Topal internally lists keys by their fingerprint. It uses GPG to look up key fingerprints by using whatever GPG can cope with. Duplicate keys are silently suppressed. Removing a key only removes one instance, so if somehow you've coerced Topal to list duplicates (which is quite easy, since adding a key with its short key ID, and the same key with its fingerprint will add two identical keys). The way that Topal chooses the keys is as follows: \begin{itemize}\item For each recipient email address (supplied by Pine) \begin{enumerate}\item For each matching line in keylist, use the key ID to get a fingerprint, and add the key to the list. \item If there are no matching lines in keylist, try to get a fingerprint via just that email address (but exclude \verb|xk| configuration entries). \end{enumerate} \end{itemize} The keylist is a way to say, ‘for this particular email address, use this particular key’. In your \verb|config| file, include lines such as \begin{lstlisting} ake=50973B91,philb@soc.plym.ac.uk ake=50973B91,p.j.brooke@bcs.org.uk \end{lstlisting} These mean ‘use key 50973B91 for the given email addresses’. Similarly, \begin{lstlisting} xk=50973B91 \end{lstlisting} means ‘don't use key 50973B91’. There are also similar \verb|sake| and \verb|sxk| options for selection of secret keys via the (recommended) \verb|--read-from| option (page~\pageref{pg:readFrom}). For S/MIME, the same lists are used. If a key isn't relevant (an S/MIME key when using OpenPGP or \vv) it is ignored. Importantly, you need to use \verb|sake|/\verb|sxk| to give the signing key for S/MIME, as \verb|my-key| only applies to OpenPGP usage. \section{Sending defaults} \marginpar{New in release~68.} \verb|sd| lines in your \verb|config| file can assign a default to a key ID or email address. The special string \verb|@ANY@| matches any email address (or key). The \emph{last matching} \verb|sd| expression applies, so use \verb|@ANY@| first. The individual letters mean\\ \begin{centering} \begin{tabular}[t]{ll} \verb|n|&no GPG\\ \verb|e|&encrypt\\ \verb|s|&sign and encrypt\\ \verb|c|&clearsign\\ \end{tabular} \begin{tabular}[t]{ll} \verb|I|&inline plain\\ \verb|A|&app pgp\\ \verb|M|&multipart\\ \verb|E|&multipart encapsulated\\ \verb|P|&S/MIME (not OpenPGP)\\ \end{tabular} \end{centering} \begin{samepage} \noindent Example: \begin{quote} \verb|sd=p.j.brooke@bcs.org.uk,eI| \end{quote} means that the default settings for the given address are encryption and inline plain. \end{samepage} Topal will warn you if you are sending to multiple recipients, \verb|sd| has selected encryption, and not all of the recipients have keys. However, it won't stop you continuing and sending an email that some recipients can't read. \section{Sendmail-path configuration}\label{sec:smp-config} \marginpar{New in release~73.} \verb|sc| lines in your \verb|config| file assign a \verb|sendmail-path| command to the ‘from’ (sending) email address. Again, the special expression \verb|@ANY@| matches any email address (but not key id's) and the last matching \verb|sd| expression applies. Example: \begin{quote} \verb|sc=p.j.brooke@bcs.org.uk,mstmp -a default| \end{quote} means that emails sent using that address will actually be sent using the (external) \verb|msmtp| program. If you are using Topal as a \verb|sendmail-path|, you must ensure that there is a suitable \verb|sc| line, as Topal does not actually know how to send email. \subsection{Additional (bcc) recipients}\label{sec:msmtp-bcc} Note that \verb|msmtp| can add additional recipients, \eg, \begin{quote} \verb|mstmp -a default -- p.j.brooke@bcs.org.uk| \end{quote} \subsection{Message-ID munging} The \verb|sendmail-path| mode can also modify Message-IDs and Content-IDs. The configuration option \verb|replace-ids| controls this. If set to 0, nothing is changed; 1 causes the Message-ID to be altered; and 2 (the default) alters both Message-ID and Content-IDs (of attachments). The Message-ID is altered from the standard Alpine form of \begin{quote} \verb|| \end{quote} to \begin{quote} \verb|<1103063481092.1140.NCYBIHRU%user@somehost.org>| \end{quote} The email address used in the replacement is based on the From line. \subsection{Send tokens} The \verb|sendmail-path| mode also enables the \verb|st| (send token) lines in the \verb|config| file. These lines have the form \begin{quote} \verb|st=user@example.org,somepasswordstring| \end{quote} If the Message-ID is altered and there is a matching send token, the original Message-ID is encrypted and stored in the headers. Additionally, a header is added based on this token, the Message-ID and From line. This can be used to match inbound emails (self blind copies) via procmail, \eg, \begin{lstlisting} :0fw * ^From: .*\$ | /usr/local/bin/topal --check-send-token somepasswordstring :0: * ^X-Topal-Check-Send-Token: yes$ .topal-cc/ \end{lstlisting} This causes emails apparently from \verb|user@example.org| to be passed to Topal, which checks the headers. If the header token matches for that password, a new header, \verb|Topal-Check-Send-Token: yes| is added. Then procmail can filter on the basis of this header. \subsection{Missing attachments trap} \marginpar{New in Topal 73.} If set, the configuration line \verb|attachment-trap=on| causes Topal to complain if the message contains the string “attach” but it does not have any attachments. This is only effective if Topal is running as a \verb|sendmail-path|. \section{Errors} Bad things happening should result in Topal setting its exit status to ‘failed’, so Pine should detect this and not send your email. Bug reports are welcome: send them by email to me (contact details in section~\ref{sec:author}). \section{Saving encrypted attachments} If an attachment is a plaintext PGP ASCII-armoured message, then Topal will be invoked by Pine. You probably want to say ‘no’ when asked here (beware of your configuration options here). Otherwise, you'll get a decrypted file with the original attachment filename, plus the various Topal headers. \section{Locale problems} GPG does not do any encoding of input data. This means that the encoding is dependent on Pine/Alpine and Topal. If a message is sent with one encoding and received by a user running in a different locale, then we might end up with a good message not verifying (\ie, bad signature). I currently have no way to automatically fix this. However, the \verb|--ask-charset| option will ask if you want to change the encoding. If you know that the message was written by a UTF-8 user (and you're in a different locale), this might help. (This only happens if a bad signature is returned.) I know it's a kludge. I'd be interested to hear success and failure reports. \section{``\texttt{Cancelled by user}'' and \texttt{GPG\_TTY}} When reading an email from stdin, Topal sometimes confuses subsequent calls to GPG/Pinentry. Make sure that your environment (\eg, \verb|.bashrc|) includes something like \begin{quote} \verb|export GPG_TTY=$(tty)| \end{quote} \section{“\texttt{Couldn't find certificate needed to sign.}”} A regular query (for both Topal and other OpenPGP filters) concerns the message “\texttt{Couldn't find certificate needed to sign.}” This message is part of Alpine's S/MIME support: it is nothing to do with Topal. One option is to turn off the internal S/ MIME support via the (hidden) config option ("\verb|S/MIME -- Turn off S/ MIME|"). \section{Cleaning up the cache} You might want to run something like \begin{quote} \verb|find ${HOME}/.topal/cache -mtime +7 | xargs rm| \end{quote} to remove all the cache files that are a bit old (in this example, 7 days old or older). \section{Save-on-send}\label{sec:save-on-send} If \verb|save-on-send| is set, then the last email sent will be written into \verb|lastmail| in your \verb|.topal| directory. If the email was to be encrypted, then so will the contents of \verb|lastmail|. This setting can be adjusted via \verb|topal -config|. \section{Remote and server mode} When remote is invoked in a sending menu: \begin{itemize} \item The host has to be chosen for \verb|ssh|/\verb|scp|. \item Because Topal might be outside the normal path, you'll be asked for that too. \item The sender \verb|scp|s the relevant files into \verb|.topal/server|. \item The sender calls \begin{quote} \verb|ssh (server) -remotesend ...| \end{quote} or \begin{quote} \verb|ssh (server) -remotesendmime ...|\end{quote} . \item The invocation of \verb|-remotesend| or \verb|-remotesendmime| triggers the server to run a new instance of Topal on the local computer. \item When that instance is finished, the relevant files are copied back, along with the return value. \end{itemize} For receiving: if decrypt-not-cached/decrypt-cached are set to 2 (ask), then as well as offering to decrypt (yes or no), it will also offer remote decryption. The caching settings are irrelevant at this point. \section{Working with GPG Agent} The \verb|use-agent| configuration option has three values: (1) never use an agent, (2) only use it for decryption and (3) always use it. Don't put GPG's \verb|--[no-]use-agent| options in any other configuration options. Notes: \begin{enumerate}\item \verb|--no-use-agent| is deprecated in some versions of GPG. \item If you change \verb|trustlist.txt| (when using \verb|gpgsm|, \ie, GnuPG for S/MIME) then remember to send the \verb|HUP| signal to your current GPG agent. \end{enumerate} \section{Decryption prerequisite} This relates to the configuration option \verb|decrypt-prereq|. If empty (the default), this is ignored. Otherwise, if decryption is required (\ie, a non-cached encrypted block is found) it will run the command stated (this should be just the command name, with no arguments). If the command's exit status is 0, then decryption continues. If not, then no decryption is attempted. I've introduced this for the case where decryption keys are not always available. It is a nuisance for Topal to offer to decrypt when it cannot. Example: the secret key ring is kept on removable media. Then set \begin{quote} \verb|decrypt-prereq=/path/to/topal-decrypt-prereq| \end{quote} The executable file \verb|/path/to/topal-decrypt-prereq| contains something like \begin{quote} \verb|mount grep /path/of/keyring > /dev/null| \end{quote} This returns 0 if that path is found, and 1 otherwise. \section{Crash with second patch when reading multipart messages}\label{sec:crash-second-patch} Some Alpine crashes have been traced to the second Topal patch. This occurs when you have compiled Alpine using this patch, but not set up your \verb|.mailcap| configuration appropriately. \section{Threats} I should document a proper threat model for Topal. For now, I make the following remarks. I assume that the local machine is secure, \ie, it is safe to store decrypted content on the machine. For my purposes, this is a reasonable assumption: if my machine's compromised, then I have other, bigger problems --- and the attacker can read my plaintext messages as I write or view them. However, it does increase the time of exposure, for example, caching plaintexts means that later compromise could reveal them. This is a trade-off against repeatedly decrypting my GPG keys. If that doesn't fit your threat model, then Topal's probably not the tool for you. \section{New releases} To be notified of new releases of Topal, send an email to me. \section{Interoperability} I have tested Topal's interoperability with MS Outlook (both IMAP and Exchange) and Thunderbird. It works in all tested cases, except as follows. \begin{itemize} \item At least one instance of MS Exchange rewrites the content-* headers of inbound clearsigned messages with attachments, which results in the signature failing to verify. This also affects messages sent from Thunderbird and MS Outlook. However, it does not apply to all MS Exchange systems. \item MS Outlook and Thunderbird do not handle clearsigned messages properly when the clearsigned message is itself part of a multipart/mixed message. The only way to reliably send messages to users of these systems is via the \verb|sendmail-path| mode. \end{itemize} \section{Hints} \begin{itemize}\item Consider using GPG's \verb|--trusted-key| option in Topal's \verb|gpg-options| configuration setting. This is useful if you keep your secret keys offline. \item Use the \verb|--read-from| option (page~\pageref{pg:readFrom}), especially if you use multiple roles rather than setting \verb|my-key|. \end{itemize} \chapter{Author}\label{sec:author} Phil Brooke wrote this, partially out of boredom, but mostly because he wanted a GPG/Pine add-on to do exactly what he wants. There are many similar programs. If you like this program, please tell me. If you'd like it better with changes, please tell me what changes you want. If particular items on the ‘To do’ list are important to you, let me know. In particular, if you find bugs, feel free to tell me the details by email. I can be emailed on \href{mailto:p.j.brooke@bcs.org.uk}{\tt p.j.brooke@bcs.org.uk}. My key ID is 0x47DC67A1; the key is available from web pages and public key servers. If you want to send snailmail to me, email me for my (physical) address. \chapter{Licence} This program 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. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program. If not, see \url{http://www.gnu.org/licenses/}. (See the file \verb|COPYING|.) \chapter{To do} \begin{itemize}\item Planned releases: \begin{itemize}\item Improve attachments code (and add some documentation). \end{itemize} \item Better error handling, particularly when missing dependencies such as mime-construct or metamail. \item Add signal handlers. \item Catch GPG keyboard interrupt. \item Should we check that the infile matches the cache file even if the MD5 hash matches? (We'd need to store the infile in the cache as well.) \item Check through code: all external calls should check return values. \item Refactor code. \item Add interrupt option at very beginning of execution? (which would bring up the configuration menu?) \item Associate extra options with particular keys? \item Configuration routine for managing keys/config/keylist? \item Implement rest of configuration menu. \item Make a much nicer interface all round.... \item Separate out all the constant strings -- so that we can have internationalization. \item Context-sensitive help throughout (modify mkhelp to create multiple procedures, or do it by number?); add COPYING option? \item More receiving/decrypt options: include both plaintext and ciphertext. \item Add periodic cache cleanup when Topal is invoked? \item Add logging for workaround mode (report time of email processing (include PID); indicate if the file was changed or not)? \end{itemize} \chapter{Change log} The change log is kept in a separate file, \url{Changelog.html}. \end{document} topal-80/command_line_wrapper.adb0000644000175000017500000001261113434071426015374 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Command_Line; use Ada.Command_Line; with Ada.Text_IO; package body Command_Line_Wrapper is J : Integer := 1; -- A pointer into the argument list. -- This deals with leading hyphens. As long as both have at least -- one leading hyphen, then the leading hyphens will be treated as -- the same. function Compare (A, B : String) return Boolean is -- Do A and B have hyphens? AH, BH : Boolean := False; -- Start points for A and B. AS, BS : Integer; begin -- Get the start point, check for leading hyphen, advance past them. AS := A'First; AH := A(AS) = '-'; while A(AS) = '-' and AS <= A'Last loop AS := AS + 1; end loop; -- Get the start point, check for leading hyphen, advance past them. BS := B'First; BH := B(BS) = '-'; while B(BS) = '-' and BS <= B'Last loop BS := BS + 1; end loop; -- Now we can compare the remains.... return (AH = BH) and (A(AS..A'Last) = B(BS..B'Last)); end Compare; -- Three functions for working through the command line. -- The first only advances the pointer if the test was true. -- Two forms, one taking a string, one taking a UBS_Array. function Match (A : in String) return Boolean is begin if J <= Argument_Count then if Compare(A, Argument(J)) then J := J + 1; return True; else return False; end if; else raise Argument_Overrun; return False; -- Never reached. end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Command_Line_Wrapper.Match (A)"); raise; end Match; function Match (A : in UBS_Array) return Boolean is A_Match : Boolean := False; begin if J <= Argument_Count then for I in A'First .. A'Last loop A_Match := A_Match or Compare(ToStr(A(I)), Argument(J)); end loop; if A_Match then J := J + 1; return True; else return False; end if; else raise Argument_Overrun; return False; -- Never reached. end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Command_Line_Wrapper.Match (B)"); raise; end Match; -- This second function always advances. function Eat return UBS is R : UBS; begin if J <= Argument_Count then R := ToUBS(Argument(J)); J := J + 1; return R; else raise Argument_Overrun; return ToUBS(""); -- Never reached. end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Command_Line_Wrapper.Eat"); raise; end Eat; -- This last function returns true if there is still something to read. function More (Needed : Positive := 1) return Boolean is begin return J + Needed - 1 <= Argument_Count; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Command_Line_Wrapper.More"); raise; end More; -- Given J, the index of the first command line argument to drop into an -- array, drop J, J+1, etc. into an array and return it. function Eat_Remaining_Arguments return UBS_Array_Pointer is -- The array we return starts at 1. -- Command line index: J, J+1, ..., Argument_Count -- Returned array index: 1, 2, ..., Argument_Count - J + 1 -- If I is the index into the return array index, then -- I + J - 1 is the index into the command line index. A : UBS_Array_Pointer; begin A := new UBS_Array(1..Argument_Count - J + 1); for I in 1 .. Argument_Count - J + 1 loop A(I) := ToUBS(Argument(I + J - 1)); end loop; J := Argument_Count + 1; return A; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Command_Line_Wrapper.Eat_Remaining_Arguments"); raise; end Eat_Remaining_Arguments; -- Display the current argument. function Current return String is begin if J <= Argument_Count then return Argument(J); else raise Argument_Overrun; return ""; -- Never reached. end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Command_Line_Wrapper.Current"); raise; end Current; end Command_Line_Wrapper; topal-80/alpine-2.02.patch-20000644000175000017500000000367513434071426013560 0ustar pjbpjbdiff -cr alpine-2.02-orig/imap/src/c-client/mail.c alpine-2.02-p2/imap/src/c-client/mail.c *** alpine-2.02-orig/imap/src/c-client/mail.c 2010-10-02 09:37:57.000000000 +0100 --- alpine-2.02-p2/imap/src/c-client/mail.c 2011-03-23 21:07:05.000000000 +0000 *************** *** 2712,2717 **** --- 2712,2719 ---- BODY *b = NIL; PART *pt; unsigned long i; + /* Topal hack 2 */ + mail_fetchstructure (stream,msgno,&b); /* make sure have a body */ if (section && *section && mail_fetchstructure (stream,msgno,&b) && b) while (*section) { /* find desired section */ diff -cr alpine-2.02-orig/pith/mailcap.c alpine-2.02-p2/pith/mailcap.c *** alpine-2.02-orig/pith/mailcap.c 2010-10-02 09:37:57.000000000 +0100 --- alpine-2.02-p2/pith/mailcap.c 2011-03-23 21:07:05.000000000 +0000 *************** *** 582,589 **** * typically two scans through the check_extension * mechanism, the mailcap entry now takes precedence. */ ! if((fname = get_filename_parameter(NULL, 0, body, &e2b.from.ext)) != NULL ! && e2b.from.ext && e2b.from.ext[0]){ if(strlen(e2b.from.ext) < sizeof(tmp_ext) - 2){ strncpy(ext = tmp_ext, e2b.from.ext - 1, sizeof(tmp_ext)); /* remember it */ tmp_ext[sizeof(tmp_ext)-1] = '\0'; --- 582,598 ---- * typically two scans through the check_extension * mechanism, the mailcap entry now takes precedence. */ ! /* Topal hack 2 */ ! fname = get_filename_parameter(NULL, 0, body, &e2b.from.ext); ! if (fname == NULL) { ! if (body->type == TYPEMULTIPART && ! ((body->subtype && !strucmp(body->subtype, "signed")) ! ||(body->subtype && !strucmp(body->subtype, "encrypted")))) ! fname = cpystr("openpgp.msg"); ! } ! ! if(fname != NULL ! && e2b.from.ext && e2b.from.ext[0]){ if(strlen(e2b.from.ext) < sizeof(tmp_ext) - 2){ strncpy(ext = tmp_ext, e2b.from.ext - 1, sizeof(tmp_ext)); /* remember it */ tmp_ext[sizeof(tmp_ext)-1] = '\0'; topal-80/sending-clearsign.adb0000644000175000017500000002217713434071426014613 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . separate(Sending) procedure Clearsign (Tmpfile : in String; Non_Pine : in Boolean; Mime : in Boolean; Mimefile : in String; Selection : in Send_Modes; Mime_Selection : in MIME_Modes; AL : in Attachments.Attachment_List; Hdrfile : in String; Recipients : in UBS_Array; Actual_Send : in Boolean; New_Headers : out UVV; AS_Content_Type : in String) is Out_File : constant String := Temp_File_Name("out"); SFD_File : constant String := Temp_File_Name("sfd"); QP_File : constant String := Temp_File_Name("qp"); TDS_File : constant String := Temp_File_Name("tds"); SMIME_Opaque : YN_Index; begin -- Run GPG. if Mime and then (Mime_Selection = Multipart or Mime_Selection = SMIME) then -- We need to do something different with Tmpfile. -- First, we delete all trailing blank lines. begin Prepare_For_Clearsign(Tmpfile, QP_File, AS_Content_Type); -- Call out to attachments in case we have to modify QP_File. Attachments.Replace_Tmpfile(QP_File, AL); -- Then we clearsign it. if Mime_Selection = SMIME then -- Offer to do this opaquely. Note that there isn't an -- analogue of this for OpenPGP/MIME. Ada.Text_IO.New_Line(3); Ada.Text_IO.Put_Line("Some mail servers mangle clearsigned messages. Instead, you could"); Ada.Text_IO.Put_Line("send this message as an opaque signed message. However, if you send"); Ada.Text_IO.Put_Line("an opaque signed message, the recipient will need an S/MIME capable"); Ada.Text_IO.Put_Line("mail user agent to read it."); Ada.Text_IO.New_Line; SMIME_Opaque := YN_Menu("Send this as an opaque message? (Answer ‘n’ to send clearsigned.) "); if SMIME_Opaque = Yes then Externals.GPG.GPGSM_Wrap(" --base64 --sign --local-user " & Value_Nonempty(Config.UBS_Opts(my_key)) & " " & " --output " & TDS_File & " " & QP_File, TDS_File, SFD_File); else Externals.GPG.GPGSM_Wrap(" --base64 --detach-sign --local-user " & Value_Nonempty(Config.UBS_Opts(my_key)) & " " & " --output " & TDS_File & " " & QP_File, TDS_File, SFD_File); end if; else Externals.GPG.GPG_Wrap(" --detach-sign --textmode --armor --local-user " & Value_Nonempty(Config.UBS_Opts(my_key)) & " " & UGA_Str(Signing => True) & " " & " --output " & TDS_File & " " & QP_File, TDS_File, SFD_File); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Clearsign (GPG MIME/3 block 1)"); raise; end; else begin Externals.GPG.GPG_Wrap(" --clearsign --textmode --local-user " & Value_Nonempty(Config.UBS_Opts(my_key)) & " " & UGA_Str(Signing => True) & " --output " & Out_File & " " & Tmpfile, Out_File, SFD_File); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Clearsign (GPG block)"); raise; end; end if; begin if not (Mime and then (Mime_Selection = Multipart or Mime_Selection = SMIME)) then if Selection = ClearsignPO then -- Rename the file appropriately. Mv_F(Out_File, Tmpfile & ".asc"); else Mv_F(Out_File, Tmpfile); end if; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Clearsign (MV block)"); raise; end; begin if Mime then case Mime_Selection is when InlinePlain => -- Inline plain text Echo_Out("Content-Type: text/plain", Mimefile); New_Headers.Append(ToUBS("Content-Type: text/plain")); when AppPGP => -- application/pgp Echo_Out("Content-Type: application/pgp; format=text; x-action=sign", Mimefile); New_Headers.Append(ToUBS("Content-Type: application/pgp; format=text; x-action=sign")); when Multipart => -- RFC2015 multipart -- This is the _really_ nasty one. -- At this point, we have QP_File, the quoted-printable, and TDS_File, then detached signature. declare Blk2 : constant String := Temp_File_Name("mp2"); MC : constant String := Temp_File_Name("mc"); begin Externals.Mail.Mimeconstruct_Subpart(Infile => TDS_File, Outfile => Blk2, Content_Type => "application/pgp-signature", Dos2UnixU => False, Use_Encoding => False, Attachment_Name => "signature.asc", Disposition => Externals.Mail.Attachment); Externals.Mail.Mimeconstruct2(Part1_Filename => QP_File, Part2_Filename => Blk2, Output_Filename => MC, Content_Type => "multipart/signed; protocol=""application/pgp-signature""; micalg=""" & Externals.GPG.Micalg_From_Filename(TDS_File) & """", Prolog => "This is an OpenPGP/MIME signed message (RFC2440, RFC3156)."); -- Now we need to split these up. Mail.Extract_Content_Type_From_Header(MC, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MC, Tmpfile); end; when MultipartEncap => Error("Menu should not have allowed MultipartEncap here"); when SMIME => if SMIME_Opaque = Yes then declare MM : constant String := Temp_File_Name("mm"); MM2 : constant String := Temp_File_Name("mm2"); begin -- Write an opaque signed message. -- We've got TDS file which is just a base64 blob. if Actual_Send then New_Headers.Append(ToUBS("Content-Type: application/pkcs7-mime; smime-type=signed-data; name=""smime.p7s""")); New_Headers.Append(ToUBS("Content-Transfer-Encoding: base64")); New_Headers.Append(ToUBS("Content-Disposition: attachment; filename=""smime.p7s""")); New_Headers.Append(ToUBS("Content-Description: S/MIME cryptographically signed message")); Externals.Simple.Mv_F(TDS_File, Tmpfile); else Echo_Out("Content-Type: application/pkcs7-mime; smime-type=signed-data; name=""smime.p7s""", MM); Echo_Append("Content-Transfer-Encoding: base64", MM); Echo_Append("Content-Disposition: attachment; filename=""smime.p7s""", MM); Echo_Append("Content-Description: S/MIME cryptographically signed message", MM); Echo_Append("", MM); Cat_Append(TDS_File, MM); Mail.Mimeconstruct_Mixed(UBS_Array'(1 => ToUBS(MM)), MM2); Mail.Extract_Content_Type_From_Header(MM2, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MM2, Tmpfile); end if; end; else -- Similar to RFC2015 multipart. -- At this point, we have QP_File, the quoted-printable, and TDS_File, then detached signature. declare Blk2 : constant String := Temp_File_Name("mp2"); MC : constant String := Temp_File_Name("mc"); begin Echo_Out("Content-Type: application/pkcs7-signature; name=""smime.p7s""", Blk2); Echo_Append("Content-Transfer-Encoding: base64", Blk2); Echo_Append("Content-Disposition: attachment; filename=""smime.p7s""", Blk2); Echo_Append("Content-Description: S/MIME Cryptographic Signature", Blk2); Echo_Append("", Blk2); Cat_Append(TDS_File, Blk2); Externals.Mail.Mimeconstruct2(Part1_Filename => QP_File, Part2_Filename => Blk2, Output_Filename => MC, Content_Type => "multipart/signed; protocol=""application/pkcs7-signature""; micalg=""" & Externals.GPG.Micalg_From_Status(SFD_File) & """", Prolog => "This is an S/MIME clearsigned message."); -- Now we need to split these up. Mail.Extract_Content_Type_From_Header(MC, Mimefile); New_Headers.Append(Read_Fold(Mimefile)); Mail.Extract_Body(MC, Tmpfile); end; end if; end case; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Clearsign (MIME block 2)"); raise; end; if not Actual_Send then Check_Send(Tmpfile, Non_Pine, Mime, Mimefile, Hdrfile, Recipients); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Sending.Clearsign"); raise; end Clearsign; topal-80/readline.adb0000644000175000017500000000670113434071426012775 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Text_IO; with Externals.Simple; with Globals; with Interfaces.C; with Interfaces.C.Strings; package body Readline is pragma Linker_Options("ada-readline-c.o"); pragma Linker_Options("-lreadline"); function C_Get_String (Prompt : in Interfaces.C.Char_Array) return Interfaces.C.Strings.Chars_Ptr; pragma Import(C, C_Get_String, "rl_gets"); procedure C_Add_History (History : in Interfaces.C.Char_Array); pragma Import(C, C_Add_History, "add_history"); procedure C_Disable_Tab_Completion; pragma Import(C, C_Disable_Tab_Completion, "rl_disable_tab_completion"); procedure C_Enable_Tab_Completion; pragma Import(C, C_Enable_Tab_Completion, "rl_enable_tab_completion"); procedure C_Read_History(F : in Interfaces.C.Char_Array); pragma Import(C, C_Read_History, "read_history"); procedure C_Write_History(F : in Interfaces.C.Char_Array); pragma Import(C, C_Write_History, "write_history"); function Get_String (Prompt : String := ""; Enable_Tab_Completion : Boolean := False) return String is use Interfaces.C; use Interfaces.C.Strings; C_Result : Chars_Ptr; begin if Enable_Tab_Completion then C_Enable_Tab_Completion; else C_Disable_Tab_Completion; end if; C_Result := C_Get_String(To_C(Prompt)); return To_Ada(Value(C_Result)); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Readline.Get_String"); raise; end Get_String; procedure Add_History (History : in String; Remove_Empty : in Boolean := True) is begin if not (Remove_Empty and History = "") then C_Add_History(Interfaces.C.To_C(History)); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Readline.Add_History"); raise; end Add_History; procedure Save_History is begin C_Write_History(Interfaces.C.To_C(Globals.ToStr(Globals.Topal_Directory) & "/history")); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Readline.Save_History"); raise; end Save_History; procedure Load_History is H : constant String := Globals.ToStr(Globals.Topal_Directory) & "/history"; begin if Externals.Simple.Test_R(H) then C_Read_History(Interfaces.C.To_C(H)); end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Readline.Load_History"); raise; end Load_History; end Readline; topal-80/echo.adb0000644000175000017500000000553713434071426012136 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Text_IO; with Interfaces.C; with Misc; use Misc; package body Echo is pragma Linker_Options("ada-echo-c.o"); function C_Set_Echo return Interfaces.C.int; pragma Import(C, C_Set_Echo, "setecho"); function C_No_Echo return Interfaces.C.int; pragma Import(C, C_No_Echo, "noechoT"); procedure Set_Echo is Result : Interfaces.C.Int; use type Interfaces.C.Int; begin Debug("Setting echo; input will be echoed"); Result := C_Set_Echo; if Result /= 0 then raise Operation_Failed; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Echo.Set_Echo"); raise; end Set_Echo; procedure Clear_Echo is Result : Interfaces.C.Int; use type Interfaces.C.Int; begin Debug("Clearing echo; no input will be echoed"); Result := C_No_Echo; if Result /= 0 then raise Operation_Failed; end if; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Echo.Clear_Echo"); raise; end Clear_Echo; function C_Save_Terminal return Interfaces.C.int; pragma Import(C, C_Save_Terminal, "saveTerminal"); function C_Restore_Terminal return Interfaces.C.int; pragma Import(C, C_Restore_Terminal, "restoreTerminal"); procedure Save_Terminal is Result : Interfaces.C.Int; pragma Unreferenced(Result); use type Interfaces.C.Int; begin Result := C_Save_Terminal; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Echo.Save_Terminal"); raise; end Save_Terminal; procedure Restore_Terminal is Result : Interfaces.C.Int; pragma Unreferenced(Result); use type Interfaces.C.Int; begin Result := C_Restore_Terminal; exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Echo.Restore_Terminal"); raise; end Restore_Terminal; end Echo; topal-80/invocation.adb0000644000175000017500000002240713434071426013364 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2018 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Ada.Text_IO; with Command_Line_Wrapper; use Command_Line_Wrapper; with Externals.Mail; with Externals.Simple; with Misc; use Misc; package body Invocation is procedure Parse_Options (Parse_All : Boolean) is begin loop exit when not More; if Match(UBS_Array'(1 => ToUBS("-debug"), 2 => ToUBS("-d"), 3 => ToUBS("--debug"), 4 => ToUBS("--d"))) then Config.Boolean_Opts(Debug) := True; elsif Match("--simple") then Config.Boolean_Opts(FE_Simple) := True; elsif Match("--rewrite") then Config.Boolean_Opts(FE_Simple) := False; elsif Match("--no-clear") then Config.Boolean_Opts(No_Clean) := True; elsif Match("--read-from") then -- The user had better set _INCLUDEALLHDRS_... Config.Boolean_Opts(All_Headers) := True; Config.Boolean_Opts(Read_From) := True; elsif Match("--ask-charset") then Config.Boolean_Opts(Ask_Charset) := True; else -- We haven't got an options match. if Parse_All then Error("Option `" & Current & "' not recognised."); else -- Don't care. exit; end if; end if; end loop; end Parse_Options; procedure Parse_Command_Line is begin -- Sort out the command-line. Debug("Examining command-line options..."); -- Eat up some options. Parse_Options(Parse_All => False); if not More then Run_Mode := Help_Text; else if Match(UBS_Array'(1 => ToUBS("-help"), 2 => ToUBS("-h"), 3 => ToUBS("--help"), 4 => ToUBS("--h"), 5 => ToUBS("-?"), 6 => ToUBS("--?"))) then Run_Mode := Help_Text; Parse_Options(Parse_All => True); elsif Match(UBS_Array'(1 => ToUBS("-display"), 2 => ToUBS("-decrypt"), 3 => ToUBS("-verify"))) then -- -decrypt and -verify are legacy for release 0.4.5 to 0.5.0. if not More(Needed => 2) then Error("-display, -decrypt and -verify need two arguments: _TMPFILE_ _RESULTFILE_"); else Run_Mode := Inline_Display; Tmpfile := Eat; Resultfile := Eat; end if; elsif Match("-pd") then declare Stdin : constant String := Temp_File_Name("pdin"); PDCT : constant String := Temp_File_Name("pdct"); PDCT2 : constant String := Temp_File_Name("pdct2"); begin Run_Mode := Pipe_Display; Infile := ToUBS(Stdin); Externals.Simple.Cat_Stdin_Out(Stdin); Externals.Mail.Extract_Content_Type_From_Header(Stdin, PDCT, Ignore_Missing => True, Substitute => True); Externals.Simple.Sed_InOut("s/^.*: //; s/\;.*//", PDCT, PDCT2); Content_Type := Read_Fold(PDCT2); end; elsif Match("-raw") then Run_Mode := Raw_Input; elsif Match("-mime") then if not More(Needed => 2) then Error("-mime needs two arguments: INFILE CONTENT-TYPE"); else Run_Mode := Mime_Display; Infile := Eat; Content_Type := Eat; end if; elsif Match("-mimeapgp") then if not More(Needed => 2) then Error("-mimeapgp needs two arguments: INFILE CONTENT-TYPE"); else Run_Mode := Old_Mime_Display; Infile := Eat; Content_Type := Eat; end if; elsif Match("-send") then if not More(Needed => 2) then Error("-send needs at least two arguments: _TMPFILE_ _RESULTFILE_" & ", then _RECIPIENTS_"); else Run_Mode := Inline_Send; Tmpfile := Eat; Resultfile := Eat; Recipients := Eat_Remaining_Arguments; end if; elsif Match("-sendmime") then if not More(Needed => 3) then Error("-sendmime needs at least three arguments: _TMPFILE_ _RESULTFILE_ _MIMETYPE_" & ", then _RECIPIENTS_"); else Run_Mode := Mime_Send; Tmpfile := Eat; Resultfile := Eat; Mimefile := Eat; Recipients := Eat_Remaining_Arguments; end if; elsif Match("-asend") then Run_Mode := Actual_Send; Remaining := Eat_Remaining_Arguments; elsif Match("-remotesend") then if not More(Needed => 3) then Error("-remotesend needs at least three arguments: _TMPFILE_ _RESULTFILE_ _RVFILE_" & ", then _RECIPIENTS_"); else Run_Mode := Remote_Send; Tmpfile := Eat; Resultfile := Eat; RVfile := Eat; Recipients := Eat_Remaining_Arguments; end if; elsif Match("-remotesendmime") then if not More(Needed => 4) then Error("-remotesendmime needs at least four arguments: _TMPFILE_ _RESULTFILE_ _RVFILE_ _MIMETYPE_" & ", then _RECIPIENTS_"); else Run_Mode := Remote_Mime_Send; Tmpfile := Eat; Resultfile := Eat; RVfile := Eat; Mimefile := Eat; Recipients := Eat_Remaining_Arguments; end if; elsif Match("-remotedecrypt") then if not More(Needed => 1) then Error("-remotedecrypt needs at least one argument: _INFILE_"); else Run_Mode := Remote_Decrypt; Infile := Eat; end if; elsif Match("-remotemimedecrypt") then if not More(Needed => 2) then Error("-remotemimedecrypt needs at least one argument: _INFILE_ _CONTENT_TYPE_"); else Run_Mode := Remote_MIME_Decrypt; Infile := Eat; Content_Type := Eat; end if; elsif Match("-server") then Run_Mode := Server; elsif Match("-clear") then Run_Mode := Clear_Temp; elsif Match("-clearc") then Run_Mode := Clear_Cache; elsif Match("-clearall") then Run_Mode := Clear_All; elsif Match("-default") then Run_Mode := Dump_Default_Config; elsif Match("-dump") then Run_Mode := Dump_Current_Config; elsif Match("-config") then Run_Mode := Interactive_Config; elsif Match(UBS_Array'(1 => ToUBS("--fix-email"), 2 => ToUBS("-fe"))) or Command_Basename = "topal-fix-email" then Run_Mode := Fix_Email; elsif Match(UBS_Array'(1 => ToUBS("--fix-folder"), 2 => ToUBS("-ff"))) or Command_Basename = "topal-fix-folder" then Run_Mode := Fix_Folders; Folders := Eat_Remaining_Arguments; elsif Match(UBS_Array'(1 => ToUBS("--check-send-token"), 2 => ToUBS("-cst"))) then Run_Mode := Check_Send_Token; CST_Token := Eat; elsif Match(UBS_Array'(1 => ToUBS("-nps"), 2 => ToUBS("-s"))) then if not More then Error("-nps (-s) needs at least one argument: _THEFILE_" & ", then _RECIPIENTS_"); else Run_Mode := Nonpine_Send; Tmpfile := Eat; Recipients := Eat_Remaining_Arguments; end if; else -- Assume we meant topal -s arg1 arg2 ... Run_Mode := Nonpine_Send; Tmpfile := Eat; Recipients := Eat_Remaining_Arguments; end if; end if; -- Eat any remaining arguments; let's hope they're options. Parse_Options(Parse_All => True); exception when others => Ada.Text_IO.Put_Line(Ada.Text_IO.Standard_Error, "Exception raised in Invocation.Parse_Command_Line"); raise; end Parse_Command_Line; end Invocation; topal-80/workaround.ads0000644000175000017500000000147013434071426013424 0ustar pjbpjb-- Topal: GPG/GnuPG and Alpine/Pine integration -- Copyright (C) 2001--2008 Phillip J. Brooke -- -- This program 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. -- -- This program is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -- GNU General Public License for more details. -- -- You should have received a copy of the GNU General Public License -- along with this program. If not, see . with Globals; use Globals; package Workaround is procedure Fix_Email; procedure Fix_Folders (Folders : in UBS_Array); end Workaround;