-- 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;