|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 35635 (0x8b33)
Types: TextFile
Names: »B«
└─⟦d10a02448⟧ Bits:30000409 8mm tape, Rational 1000, ENVIRONMENT, D_12_7_3
└─ ⟦fc9b38f02⟧ »DATA«
└─⟦8e9e227a9⟧
└─⟦this⟧
with Archive;
with Byte_Defs;
with Common;
with Compilation;
with Debug_Tools;
with Directory_Tools;
with Editor;
with Enable_Product_Keymaps;
with File_Transfer;
with Ftp_Defs;
with Ftp_Profile;
with Io;
with Library;
with Log;
with Profile;
with Release;
with Rxi_String;
use Rxi_String;
with String_Utilities;
with Switches;
with Table_Sort_Generic;
with Transport;
with Transport_Defs;
with Transport_Name;
package body Rxi_Install is
------------------------------------------------------------------------------
-- Imported Renames
------------------------------------------------------------------------------
function "=" (A, B : Ftp_Defs.Status_Code) return Boolean
renames Ftp_Defs."=";
function "=" (A, B : Transport_Defs.Status_Code) return Boolean
renames Transport_Defs."=";
------------------------------------------------------------------------------
-- Exceptions
------------------------------------------------------------------------------
I_Am_Confused : exception;
----I give up. Some assumption of the code has changed and the code wasn't
-- changed to reflect it.
Quit : exception;
----Raised when we want to give up on something.
--\f
function Hs (Str : String) return Heap_String is
begin
return new String'(Str);
end Hs;
--\f
function Release_From_Here return String is
Rel : constant String := Release.Info.R1000_Release;
Wrk : constant String := Release.Info.R1000_Working;
Here : constant String := Directory_Tools.Naming.Full_Name
(Directory_Tools.Naming.Resolution ("$"));
begin
if Here'Length >= Rel'Length - 1 and then
Here (Here'First .. Here'First + Rel'Length - 2) =
String_Utilities.Upper_Case (Rel (Rel'First .. Rel'Last - 1)) then
----Doing a normal install.
return Rel;
elsif Here'Length >= Wrk'Length - 1 and then
Here (Here'First .. Here'First + Wrk'Length - 2) =
String_Utilities.Upper_Case
(Wrk (Wrk'First .. Wrk'Last - 1)) then
----Doing a test install from development area
return Release.Info.R1000_Working;
else
Log.Put_Line ("Please connect to: ", Profile.Error_Msg);
Log.Put_Line (" " & Rel, Profile.Error_Msg);
Log.Put_Line (" or to:", Profile.Error_Msg);
Log.Put_Line (" " & Wrk, Profile.Error_Msg);
Log.Put_Line (" and try this command again.", Profile.Error_Msg);
Log.Put_Line ("Cannot run this command from " & Here,
Profile.Exception_Msg);
raise I_Am_Confused;
end if;
end Release_From_Here;
--\f
function Ada_Files_Generate (Keyboard : Terminal_Type;
Suppress_Rxi_Files : Boolean) return String is
------------------------------------------------------------------------------
-- Returns the name(s) of the files in the Editor_Data area to
-- compile/transfer for this Keyboard type.
------------------------------------------------------------------------------
Base : constant String :=
Release.Supported_Keyboards (Keyboard).Name.all & "_@";
begin
if Suppress_Rxi_Files then
return Base;
else
return "[" & Base & ",RXI_@]";
end if;
end Ada_Files_Generate;
--\f
procedure Machine_Editor_Data_Files
(Keyboard : Terminal_Type;
Suppress_Rxi_Files : Boolean := False;
Overrides : String := "foo=>FALSE,bar=>true") is
------------------------------------------------------------------------------
-- Keyboard - Specifies the RXI-based terminal type being installed.
-- Suppress_Rxi_Files - Specifies TRUE if the RXI files are not to be
-- included in the installation; perhaps they are already there.
------------------------------------------------------------------------------
Ada_Files : constant String := Ada_Files_Generate (Keyboard,
Suppress_Rxi_Files);
Body_Files : constant String := Ada_Files & "'Body";
Non_Body_Files : constant String := Ada_Files & "['c(File),'Spec]";
Med : constant String := "!Machine.Editor_Data.";
Tt_Filename : constant String := Med & "Terminal_Types";
Tr_Filename : constant String := Med & "Terminal_Recognition";
Tt_File : Io.File_Type;
Tr_File : Io.File_Type;
begin
----Say Hello.
Log.Put_Line ("[Install.Machine_Editor_Data_Files(" &
Terminal_Type'Image (Keyboard) & "," &
Boolean'Image (Suppress_Rxi_Files) & ")]",
Profile.Auxiliary_Msg, Profile.Verbose);
Log.Put_Line (Release_From_Here,
Profile.Auxiliary_Msg, Profile.Verbose);
----Try to open the TT file for append. Errors probably indicate non-existence.
Log.Put_Line ("Modify the " & Tt_Filename,
Profile.Auxiliary_Msg, Profile.Verbose);
begin
Io.Append (Tt_File, Tt_Filename);
exception
when Io.Name_Error =>
----Try to create the presumably non-existent file. We give up on errors.
begin
Io.Create (Tt_File, Io.Out_File, Tt_Filename);
exception
when others =>
Log.Put_Line
("Unexpected exception creating " &
Tt_Filename & ":" &
Debug_Tools.Get_Exception_Name (True, True),
Profile.Error_Msg,
Profile.Verbose);
return;
end;
----Other errors cause us to give up.
when others =>
Log.Put_Line ("Unexpected exception opening " &
Tt_Filename & ":" &
Debug_Tools.Get_Exception_Name (True, True),
Profile.Error_Msg,
Profile.Verbose);
return;
end;
----Install our one-liner describing the terminal type.
Io.Put (Tt_File, Release.Supported_Keyboards (Keyboard).Name.all);
Io.Put (Tt_File, " XRTERM ");
Io.Put (Tt_File, Release.Supported_Keyboards (Keyboard).Lines);
Io.Put (Tt_File, ' ');
Io.Put (Tt_File, Release.Supported_Keyboards (Keyboard).Columns);
Io.New_Line (Tt_File);
----Add any extra information that may be required.
if Release.Supported_Keyboards (Keyboard).Tt_Extra /= null then
Io.Put_Line (Tt_File,
Release.Supported_Keyboards (Keyboard).Tt_Extra.all);
end if;
----Close the file.
Io.Close (Tt_File);
----Try to open the TR file for append. Errors probably indicate non-existence.
Log.Put_Line ("Modify the " & Tr_Filename,
Profile.Auxiliary_Msg, Profile.Verbose);
begin
Io.Append (Tr_File, Tr_Filename);
exception
when Io.Name_Error =>
----Try to create the presumably non-existent file. We give up on errors.
begin
Io.Create (Tr_File, Io.Out_File, Tr_Filename);
exception
when others =>
Log.Put_Line
("Unexpected exception creating " &
Tr_Filename & ":" &
Debug_Tools.Get_Exception_Name (True, True),
Profile.Error_Msg,
Profile.Verbose);
return;
end;
----Other errors cause us to give up.
when others =>
Log.Put_Line ("Unexpected exception opening " &
Tr_Filename & ":" &
Debug_Tools.Get_Exception_Name (True, True),
Profile.Error_Msg,
Profile.Verbose);
return;
end;
----Install the one-liner and close the file.
declare
Id : constant String :=
Natural'Image
(Release.Supported_Keyboards (Keyboard).Id * 8 + 2);
----Id # as a string with a leading space because it is positive.
Id_No : constant String := Id (Id'First + 1 .. Id'Last);
----Id # as a string with no leading space.
begin
Io.Put (Tr_File, Release.Supported_Keyboards (Keyboard).Name.all);
Io.Put (Tr_File, " " & Ascii.Esc & "[?1;");
Io.Put (Tr_File, Id_No);
Io.Put (Tr_File, 'c');
Io.New_Line (Tr_File);
end;
Io.Close (Tr_File);
----Make sure that any 'Body's that we may be overwriting in !Machine.
-- Editor_Data are in the Source state so that we don't waste time promoting
-- the 'Body's twice. (Once in the Archive.Copy step and once in the
-- Enable_Product_Keymaps step.)
Log.Put_Line ("Install the keymap files.",
Profile.Auxiliary_Msg, Profile.Verbose);
begin
----See if any of the objects exist.
Library.Resolve (Name_Of => "!Machine.Editor_Data." & Body_Files,
Response => "<Quiet> Raise_Error");
----Demote existing objects.
Compilation.Demote (Unit => "!Machine.Editor_Data." & Body_Files,
Goal => Compilation.Source,
Limit => "<ALL_WORLDS>",
Effort_Only => False,
Response => "<Verbose> Persevere");
exception
----None of the objects exist.
when Library.Error =>
null;
end;
----Use Archive.Copy to create/replace the !Machine.Editor_Data files and to
-- guarantee that they end up Source (if new) or Installed/Coded (if replacing
-- old ones that were Installed/Coded).
Archive.Copy (Objects => Release_From_Here & "Editor_Data." &
Non_Body_Files,
Use_Prefix => "!Machine.Editor_Data",
For_Prefix => Release_From_Here & "Editor_Data",
Options => "ALL_OBJECTS,REPLACE,REMAKE",
Response => "<Verbose> Raise_Error");
Archive.Copy (Objects => Release_From_Here & "Editor_Data." &
Body_Files,
Use_Prefix => "!Machine.Editor_Data",
For_Prefix => Release_From_Here & "Editor_Data",
Options => "ALL_OBJECTS,SOURCE",
Response => "<Verbose> Raise_Error");
----Copy the Enable_Product_Keymaps procedure if it is newer than any existing
-- such procedure.
-- Since this Copy operation is copying a Load_Proc, and since we run the
-- Code-Generator in other steps of this procedure, and since there is a bug
-- in pre-Delta-3 Environments, we will run this Copy as a separate task
-- as a work-around for the bug.
declare
Library : constant String := "!Machine.Editor_Data";
Switch_File : constant String := Library & ".Library_Switches";
Assoc : constant String := Switches.Associated (Library => Library);
task Bug_Fix is
end Bug_Fix;
task body Bug_Fix is
begin
if Assoc = "" or else
Assoc (Assoc'First .. Assoc'First - 1 + Library'Length) /=
Library then
Switches.Create (File => Switch_File, Category => 'L');
Switches.Associate (File => Switch_File,
Library => Library);
Switches.Set
(Spec => "R1000_Cg.Retain_Delta1_Compatibility := False",
File => Switch_File);
else
Switches.Set
(Spec => "R1000_Cg.Retain_Delta1_Compatibility := False",
File => Assoc);
end if;
Archive.Copy (Objects => Release_From_Here & "Editor_Data" &
".Enable_Product_Keymaps",
Use_Prefix => "!Machine.Editor_Data",
For_Prefix => Release_From_Here & "Editor_Data",
Options => "CHANGED_OBJECTS,REPLACE,REMAKE",
Response => "<Verbose> Raise_Error");
end Bug_Fix;
begin
null; -- Wait for task to complete.
end;
----Turn on/off any product bindings and put the Editor_Data at least in
-- the installed state.
Log.Put_Line ("Enable product keys in keymaps.",
Profile.Auxiliary_Msg, Profile.Verbose);
Enable_Product_Keymaps (Keymap => "!Machine.Editor_Data." & Body_Files,
Response => "<Verbose> Raise_Error",
Overrides => Overrides);
----All Done.
Log.Put_Line ("[end of Install.Machine_Editor_Data_Files(" &
Terminal_Type'Image (Keyboard) & "," &
Boolean'Image (Suppress_Rxi_Files) & ")]",
Profile.Auxiliary_Msg, Profile.Verbose);
end Machine_Editor_Data_Files;
--\f
function Get_Host_Id (Name : String) return Transport_Defs.Host_Id is
------------------------------------------------------------------------------
-- Name - Specifies the name of some remote host
-- Returns the Host_Id of this host or else returns an empty Host_Id if the
-- name isn't known.
------------------------------------------------------------------------------
begin
return Transport_Name.Host_To_Host_Id (Name);
exception
when Transport_Name.Undefined =>
return (1 .. 0 => 0);
end Get_Host_Id;
--\f
procedure Status_Ok (Status : Transport_Defs.Status_Code) is
------------------------------------------------------------------------------
-- Status - Specifies a status to check
-- Complains and raises Quit if the Status != Ok.
------------------------------------------------------------------------------
begin
if Status /= Transport_Defs.Ok then
Log.Put_Line ("Error in Rxi_Install: " &
Transport_Defs.Image (Status),
Profile.Error_Msg,
Profile.Verbose);
raise Quit;
end if;
end Status_Ok;
--\f
procedure Status_Ok (Status : Ftp_Defs.Status_Code) is
------------------------------------------------------------------------------
-- Status - Specifies a status to check
-- Complains and raises Quit if the Status != Successful
------------------------------------------------------------------------------
begin
if Status /= Ftp_Defs.Successful then
Log.Put_Line ("Error in Rxi_Install: " &
Ftp_Defs.Status_Code'Image (Status),
Profile.Error_Msg,
Profile.Verbose);
raise Quit;
end if;
end Status_Ok;
--\f
procedure Response (Connection : File_Transfer.Connect_Id) is
------------------------------------------------------------------------------
-- Conection - Specifies the connection to check
-- Called to read any and all Response text that has been received from the
-- On_Machine host in response to any FTP command. The response text is
-- send to the Log.
------------------------------------------------------------------------------
Str : String (1 .. 1000);
Len : Natural;
begin
while not File_Transfer.End_Of_Response (Connection) loop
File_Transfer.Read_Response (Connection, Str, Len);
Log.Put_Line ("Ftp: " & Str (1 .. Len),
Profile.Note_Msg,
Profile.Verbose);
end loop;
end Response;
--\f
function Natural_Image (Val : Natural) return String is
------------------------------------------------------------------------------
-- Val - Specifies the value
-- Turn a natural into a string with no leading blanks.
------------------------------------------------------------------------------
Str : constant String := Natural'Image (Val);
begin
return Str (Str'First + 1 .. Str'Last);
end Natural_Image;
--\f
function Duration_Image (Time : Duration) return String is
------------------------------------------------------------------------------
-- Time - Specifies the duration
-- Ada doesn't give us a nice way to turn a Fixed quantity into a string so
-- we must hack one up.
------------------------------------------------------------------------------
Val : Integer := Integer (Time * Duration (1000.0));
Valsub : Natural := (abs Val) rem 1000;
begin
if Valsub < 10 then
return Natural_Image (Val / 1000) & ".00" & Natural_Image (Valsub);
elsif Valsub < 100 then
return Natural_Image (Val / 1000) & ".0" & Natural_Image (Valsub);
else
return Natural_Image (Val / 1000) & "." & Natural_Image (Valsub);
end if;
end Duration_Image;
--\f
procedure Store (Connection : File_Transfer.Connect_Id;
Local : String;
Remote : String) is
------------------------------------------------------------------------------
-- Conection - Specifies the connection to use
-- Local - Specifies the name of an existing local object
-- Remote - Specifies the name of a remote object to be created/written
-- Called to perform (and check) the transfer of one file from the R1000 to
-- the On_Machine host.
------------------------------------------------------------------------------
Ftp_Status : Ftp_Defs.Status_Code;
begin
----Inform the log of the impending transfer.
Log.Put_Line
("--------------------------------------------------------",
Profile.Note_Msg,
Profile.Verbose);
Log.Put_Line ("Transfer: " & Local & " => " & Remote,
Profile.Note_Msg,
Profile.Verbose);
----Set up a new socket connection for the actual transfer.
File_Transfer.Send_Data_Port (Connection,
Transport_Defs.Null_Host_Id,
Transport_Defs.Null_Socket_Id);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
----Begin the transfer and wait for it to end.
File_Transfer.Start_Store (Connection,
Local_Filename => Local,
Remote_Filename => Remote,
Append => False);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
if Ftp_Status /= Ftp_Defs.Transfer_Complete then
Status_Ok (Ftp_Status);
end if;
----Inform the log of a successful transfer.
Log.Put_Line
("Done, bytes: " &
Natural_Image (File_Transfer.Last_Transfer_Length (Connection)) &
", seconds: " &
Duration_Image (File_Transfer.Last_Transfer_Time (Connection)),
Profile.Note_Msg,
Profile.Verbose);
Log.Put_Line ("--------------------------------------------------",
Profile.Note_Msg,
Profile.Verbose);
end Store;
--\f
procedure Disconnect (Connection : in out File_Transfer.Connect_Id) is
------------------------------------------------------------------------------
-- Connection - Specifies the connection to destroy
-- Called (at any time, in any state) when we must get rid of a connection.
-- We try to do it nicely but we are prepared to ignore any errors and to
-- simply drop the connection at the worst.
------------------------------------------------------------------------------
Ftp_Status : Ftp_Defs.Status_Code;
begin
----If the Connection isn't "open" (really means allocated) then we have nothing
-- to do.
if not File_Transfer.Is_Open (Connection) then
return;
end if;
----If there is an actual connection then we must try to Quit out of it.
if File_Transfer.Is_Connected (Connection) then
begin
begin
File_Transfer.Send_Quit (Connection);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
----If the Quit fails then report that but also continue.
exception
when others =>
Log.Put_Line
("Unexpected exception during File_Transfer.Send_Quit:" &
Debug_Tools.Get_Exception_Name (True, True),
Profile.Error_Msg,
Profile.Verbose);
end;
----Try to disconnect from the remote server.
File_Transfer.Disconnect (Connection);
exception
when others =>
Log.Put_Line
("Unexpected exception during File_Transfer.Disconnect:" &
Debug_Tools.Get_Exception_Name (True, True),
Profile.Error_Msg,
Profile.Verbose);
end;
end if;
----Finally we close (deallocate) the socket.
File_Transfer.Close (Connection);
end Disconnect;
--\f
function R1000_Form (Old_Namelc : String) return String is
------------------------------------------------------------------------------
-- Old_Namelc - Specifies a name usable by some OS other than the R1000
--
-- Called to convert a non-R1000 name into a name the R1000 can handle.
-- We return the converted name. Typically we just convert "strange"
-- characters into underscores ("_"). When this is a problem; at the
-- beginning of a name, the end of a name, or next to another "_"; we use
-- a semi-random letter; actually "A", "B", or "C".
------------------------------------------------------------------------------
Old_Name : constant String := String_Utilities.Upper_Case (Old_Namelc);
New_Name : String (1 .. Old_Name'Length + 2);
Oldi : Natural := Old_Name'First;
Newi : Natural := New_Name'First;
begin
----See if the name begins with an underscore. Prepend an A if necessary.
if Old_Name (Oldi) not in 'A' .. 'Z' and then
Old_Name (Oldi) not in '0' .. '9' then
New_Name (Newi) := 'A';
Newi := Newi + 1;
end if;
----Convert all non-letters to underscores. If this would lead to having
-- two underscores adjacent then convert every 2nd underscore to a B.
while Oldi <= Old_Name'Last loop
if Old_Name (Oldi) not in 'A' .. 'Z' and then
Old_Name (Oldi) not in '0' .. '9' then
if New_Name (Newi - 1) = '_' then
New_Name (Newi) := 'B';
else
New_Name (Newi) := '_';
end if;
else
New_Name (Newi) := Old_Name (Oldi);
end if;
Newi := Newi + 1;
Oldi := Oldi + 1;
end loop;
----See if the name ends in an underscore. Append a C if necessary.
if New_Name (Newi - 1) not in 'A' .. 'Z' and then
New_Name (Newi - 1) not in '0' .. '9' then
New_Name (Newi) := 'C';
return New_Name (New_Name'First .. Newi);
else
return New_Name (New_Name'First .. Newi - 1);
end if;
end R1000_Form;
--\f
procedure Workstation_Files
(Keyboard : Terminal_Type;
On_Machine : String := Ftp_Profile.Remote_Machine;
Username : String := Ftp_Profile.Username;
Password : String := Ftp_Profile.Password;
Account : String := Ftp_Profile.Account;
Rxi_Source_Directory : String :=
">/src/x/mit/clients/rxi<") is
------------------------------------------------------------------------------
-- Keyboard - Specifies the RXI-based terminal type being installed.
-- On_Machine - Specifies the name of the workstation
-- Username - Specifies a username valid on the workstation
-- Password - Specifies the password for the username
-- Account - Specifies the account to use on the workstation
-- Rxi_Source_Directory- Specifies the directory to contain the RXI C source
-- code
------------------------------------------------------------------------------
Connection : File_Transfer.Connect_Id;
Td_Status : Transport_Defs.Status_Code;
Ftp_Status : Ftp_Defs.Status_Code;
Host_Id : constant Transport_Defs.Host_Id := Get_Host_Id (On_Machine);
Ascii_Mode : Boolean;
----All of the RXI files will be located in this directory on the R1000.
Local_Dir : constant String :=
Release_From_Here
& '.'
& Release.Supported_Keyboards (Keyboard).R1000_Dir.all
& '.';
----Names for recognition.h
Recog_H : constant Release.File_Info :=
Release.Recognition_File (Keyboard);
R1000_Recog_H : constant String :=
Local_Dir
& R1000_Form (Release.Supported_Keyboards (Keyboard).Name.all
& Recog_H.Master_File.all);
Ws_Recog_H : constant String :=
Recog_H.Install_File.all (Recog_H.Install_File'First + 1 ..
Recog_H.Install_File'Last) & "h";
Ttws_Recog_H : constant String :=
Release.Supported_Keyboards (Keyboard).Name.all
& Recog_H.Install_File.all & "h";
procedure Tcp_Port_Numbers_Bug_Workaround is
----HP has a silly bug that we have to get-around.
-- Assign port numbers until port numbers reach at least 1024.
-- The R1000 assigns successive numbers starting at around 511.
-- HP and apparently some others cannot accept any number less
-- than 1024. Silly bug.
C : Transport.Connection_Id;
Status : Transport_Defs.Status_Code;
Done : Boolean := False;
begin
while not Done loop
Transport.Open (C, Status, "TCP/IP");
exit when Transport_Defs."/=" (Status, Transport_Defs.Ok);
declare
Port : constant Transport_Defs.Socket_Id :=
Transport.Local_Socket (C);
begin
Done := Byte_Defs.">=" (Port (Port'First), 4);
end;
Transport.Close (C);
end loop;
end Tcp_Port_Numbers_Bug_Workaround;
begin
----Make sure that the On_Machine host is known to the R1000.
Log.Put_Line ("[Rxi_Install.Workstation_Files(" &
Terminal_Type'Image (Keyboard) & ',' & On_Machine & ',' &
Username & ',' & Rxi_Source_Directory & ")]",
Profile.Auxiliary_Msg, Profile.Verbose);
Log.Put_Line (Release_From_Here,
Profile.Auxiliary_Msg, Profile.Verbose);
if Host_Id'Length = 0 then
Log.Put_Line
("Host name [" & On_Machine &
"] is not in the Transport_Name_Map (Host name undefined).",
Profile.Error_Msg,
Profile.Verbose);
return;
end if;
----Try to get a socket for our use.
Log.Put_Line ("Get network socket.", Profile.Note_Msg, Profile.Verbose);
Tcp_Port_Numbers_Bug_Workaround;
File_Transfer.Open (Connection, Td_Status);
Status_Ok (Td_Status);
----Try to call up the On_Machine and see if it will talk to us at all.
Log.Put_Line ("Connect to " & On_Machine,
Profile.Note_Msg, Profile.Verbose);
File_Transfer.Connect (Connection, Host_Id);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
----Try to log in as the Username/Password that was given to us.
Log.Put_Line ("Send username.", Profile.Note_Msg, Profile.Verbose);
File_Transfer.Send_Username (Connection, Username);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
if Ftp_Status = Ftp_Defs.Not_Logged_In then
Log.Put_Line ("Username " & Username &
" invalid on workstation " & On_Machine,
Profile.Error_Msg,
Profile.Verbose);
raise Quit;
elsif Ftp_Status = Ftp_Defs.Need_Password then
Log.Put_Line ("Send password.", Profile.Note_Msg, Profile.Verbose);
File_Transfer.Send_Password (Connection, Password);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
end if;
if Ftp_Status = Ftp_Defs.Not_Logged_In then
Log.Put_Line ("Password invalid for username " &
Username & " on workstation " & On_Machine,
Profile.Error_Msg,
Profile.Verbose);
raise Quit;
end if;
Status_Ok (Ftp_Status);
----Set the account for the logged-in job On_Machine.
if Account /= "" and then
Account /= " " then
Log.Put_Line ("Send account.", Profile.Note_Msg, Profile.Verbose);
File_Transfer.Send_Account (Connection, Account);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
if Ftp_Status /= Ftp_Defs.Command_Not_Implemented then
Status_Ok (Ftp_Status);
end if;
end if;
----Connect to the Rxi_Source_Directory.
Log.Put_Line ("Connect to " & Rxi_Source_Directory,
Profile.Note_Msg, Profile.Verbose);
File_Transfer.Send_Cwd (Connection, Rxi_Source_Directory);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
----We will be working in Stream mode, sending Ascii data, and working in
-- units of Files. These should work on all FTP implementations.
Log.Put_Line ("Set transfer modes (Stream,Ascii,File).",
Profile.Note_Msg, Profile.Verbose);
File_Transfer.Set_Mode (Connection, Ftp_Defs.Stream);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
Ascii_Mode := True;
File_Transfer.Set_Type (Connection, Ftp_Defs.Ascii);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
File_Transfer.Set_Structure (Connection, Ftp_Defs.File);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
----Send all of the various files.
for I in 1 .. Release.Install_Length (Keyboard) loop
case Release.Install (Keyboard, I).File_Type is
when Release.Text =>
if not Ascii_Mode then
Log.Put_Line
("Set transmission modes (Stream,Ascii,File).",
Profile.Note_Msg, Profile.Verbose);
Ascii_Mode := True;
File_Transfer.Set_Type (Connection, Ftp_Defs.Ascii);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
end if;
Store (Connection,
Local_Dir & R1000_Form
(Release.Install (Keyboard, I).
Master_File.all),
Release.Install (Keyboard, I).Install_File.all);
when Release.Binary =>
if Ascii_Mode then
Log.Put_Line
("Set transmission modes (Stream,Image,File).",
Profile.Note_Msg, Profile.Verbose);
Ascii_Mode := False;
File_Transfer.Set_Type (Connection, Ftp_Defs.Image);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
end if;
Store (Connection,
Local_Dir & R1000_Form
(Release.Install (Keyboard, I).
Master_File.all),
Release.Install (Keyboard, I).Install_File.all);
end case;
end loop;
if not Ascii_Mode then
Log.Put_Line ("Set transmission modes (Stream,Ascii,File).",
Profile.Note_Msg, Profile.Verbose);
Ascii_Mode := True;
File_Transfer.Set_Type (Connection, Ftp_Defs.Ascii);
Response (Connection);
File_Transfer.Command_Status (Connection, Ftp_Status);
Status_Ok (Ftp_Status);
end if;
Store (Connection, R1000_Recog_H, Ws_Recog_H);
Store (Connection, R1000_Recog_H, Ttws_Recog_H);
----We are all done; say "bye", disconnect, and free up the socket.
Log.Put_Line ("Disconnect.", Profile.Note_Msg, Profile.Verbose);
Disconnect (Connection);
Log.Put_Line ("[end of Rxi_Install.Workstation_Files(" &
Terminal_Type'Image (Keyboard) & ',' & On_Machine & ',' &
Username & ',' & Rxi_Source_Directory & ")]",
Profile.Auxiliary_Msg, Profile.Verbose);
exception
----When we Quit we simply disconnect; error messages have already gone out.
when Quit =>
Disconnect (Connection);
raise Library.Error;
----Anything else is simply unexpected.
when others =>
Log.Put_Line ("Unexpected exception during Rxi_Install script:" &
Debug_Tools.Get_Exception_Name (True, True),
Profile.Error_Msg,
Profile.Verbose);
Disconnect (Connection);
end Workstation_Files;
--\f
end Rxi_Install;