|
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: 16299 (0x3fab)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─ ⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦this⟧
with Log;
with Machine;
with Byte_Defs;
with Transport;
with Transport_Defs;
with Transport_Name;
with String_Utilities;
with Device_Independent_Io;
procedure Os2000_Transfer
(Local_File : String;
Remote_File : String;
Transliterate : Boolean;
Transfer_Type : Os2000_Transfer_Utilities.Transfer_Type;
Remote_Machine : String;
Response : Profile.Response_Profile) is
subtype Byte is Byte_Defs.Byte;
subtype Byte_String is Byte_Defs.Byte_String;
function "=" (L, R : Byte) return Boolean renames Byte_Defs."=";
package Tp renames Transport;
package Tn renames Transport_Name;
package Td renames Transport_Defs;
package Util renames Os2000_Transfer_Utilities;
package Dio renames Device_Independent_Io;
Handshake_Socket : constant Transport_Defs.Socket_Id := (1, 13);
-- This is the socket on which the OS2000 server will
-- wait for commands. Sockets less than (4,0) are
-- treated as privileged by OS2000 TCP/IP implementation.
--
Long_Time : constant Duration := 300.0; -- 5 minutes
Primary : Tp.Connection_Id;
Secondary : Tp.Connection_Id;
Status : Td.Status_Code;
Count : Natural;
Debug : constant Boolean := Util.Debug;
task Transceiver is
entry Start (Network : Td.Network_Name);
entry Wait_For_Connection;
entry Finish;
end Transceiver;
procedure Put_Debug (Msg : String) is
begin
Log.Put_Line (Msg, Kind => Profile.Debug_Msg, Response => Response);
end Put_Debug;
function Setup_Ax25_Port
(Host : Td.Host_Id; Network : Td.Network_Name) return String is
-- The_Job : constant String := Long_Integer'Image
-- (Long_Integer (Machine.Get_Task_Id));
-- Disable : constant String :=
-- Transport.Set_Options
-- (Network,
-- -- for Ax25 the port number is first byte of host id
-- Context => Integer'Image (Integer (Host (Host'First))),
-- Options => "ENABLED => FALSE");
begin
return Transport.Set_Options
(Network,
-- for Ax25 the port number is first byte of host id
Context => Integer'Image (Integer (Host (Host'First))),
Options => "ENABLED => TRUE," & "PROTOCOL_HALF => DCE");
-- "LEVEL_0 => (TASK =>" & The_Job & ")," &
-- "LEVEL_2 => (MONITOR => TRUE)," &
-- "LEVEL_3 => (MONITOR => TRUE)");
end Setup_Ax25_Port;
-- function Disable_Ax25_Port
-- (Host : Td.Host_Id; Network : Td.Network_Name) return String is
-- begin
-- return Transport.Set_Options
-- (Network,
-- -- for Ax25 the port number is first byte of host id
-- Context => Integer'Image (Integer (Host (Host'First))),
-- Options => "ENABLED => FALSE");
-- end Disable_Ax25_Port;
procedure Transmit (Connection : Tp.Connection_Id; Data : Byte_String) is
Status : Td.Status_Code;
Total : Natural;
Count : Natural;
begin
Tp.Transmit (Connection, Status, Data, Total);
Util.Check_Transmit (Status, Response);
while Total < Data'Length loop
Tp.Transmit (Connection, Status,
Data (Data'First + Total .. Data'Last), Count);
Util.Check_Transmit (Status, Response);
Total := Total + Count;
end loop;
end Transmit;
task body Transceiver is
Status : Td.Status_Code;
Count : Natural;
Total : Natural := 0;
File : Dio.File_Type;
Rws : Natural;
procedure Process_Output_Buffer
(S : in out Byte_String; Count : Natural) is
-- change Lf to Cr on output
begin
for I in S'First .. S'First + Count - 1 loop
if S (I) = Character'Pos (Ascii.Lf) then
S (I) := Character'Pos (Ascii.Cr);
end if;
end loop;
end Process_Output_Buffer;
procedure Process_Input_Buffer
(S : in out Byte_String; Count : Natural) is
-- change Cr to Lf on input
begin
for I in S'First .. S'First + Count - 1 loop
if S (I) = Character'Pos (Ascii.Cr) then
S (I) := Character'Pos (Ascii.Lf);
end if;
end loop;
end Process_Input_Buffer;
begin
begin
accept Start (Network : Td.Network_Name) do
Tp.Open (Secondary, Status, Network);
Util.Check_Open (Status, Response);
if Debug then
Put_Debug ("Transceiver opened.");
end if;
end Start;
if Debug then
Put_Debug ("Transceiver connecting ...");
end if;
Tp.Connect (Secondary, Status);
if Debug then
Put_Debug ("Transceiver connected.");
end if;
accept Wait_For_Connection do
Util.Check_Connect (Status, Response);
end Wait_For_Connection;
exception
when Util.Check_Failed =>
Log.Put_Line
("Transceiver terminating due to Open or Connect failure",
Kind => Profile.Negative_Msg,
Response => Response);
raise;
end;
declare
S : Byte_String (1 .. 1024);
Rf_Status : Util.Remote_File_Status;
begin
Tp.Receive (Secondary, Status, S, Count, Long_Time);
Util.Check_Receive (Status, Response);
Rf_Status := Util.Extract_Status (S (1 .. Count));
case Rf_Status is
when Util.Success =>
null;
when others =>
Log.Put_Line ("OS2000 unable to open file due to " &
Util.Remote_File_Status'Image (Rf_Status),
Kind => Profile.Error_Msg,
Response => Response);
raise Util.No_Remote_File;
end case;
begin
case Transfer_Type is
when Util.Put_Exe | Util.Put_File =>
Dio.Open (File, Dio.In_File, Local_File);
Log.Put_Line ("Opened R1000 file " & Local_File,
Kind => Profile.Positive_Msg,
Response => Response);
when Util.Get_File =>
Dio.Create (File, Dio.Out_File, Local_File);
Log.Put_Line ("Created R1000 file " & Local_File,
Kind => Profile.Positive_Msg,
Response => Response);
end case;
exception
when others =>
Log.Put_Line ("Couldn't open R1000 file " & Local_File,
Kind => Profile.Error_Msg,
Response => Response);
raise Util.No_Local_File;
end;
Rws := 0;
case Transfer_Type is
when Util.Put_Exe | Util.Put_File =>
Count := 0;
while not Dio.End_Of_File (File) loop
Dio.Read (File, S, Count);
if Debug then
Put_Debug ("Number of bytes read: " &
Integer'Image (Count));
end if;
if Transliterate then
Process_Output_Buffer (S, Count);
end if;
if Count = S'Length then
Transmit (Secondary, S);
Rws := Rws + 1;
elsif Count > 0 then
Transmit (Secondary, S (1 .. Count));
Rws := Rws + 1;
else
exit;
end if;
Total := Total + Count;
end loop;
if Transliterate and then (Count > 0) and then
(S (Count) /= Character'Pos (Ascii.Cr)) then
S (S'First) := Character'Pos (Ascii.Cr);
Transmit (Secondary, S (1 .. 1));
Rws := Rws + 1;
end if;
when Util.Get_File =>
loop
Tp.Receive (Secondary, Status, S, Count, Long_Time);
if Count > 0 then
Util.Check_Receive (Status, Response);
if Transliterate then
Process_Input_Buffer (S, Count);
end if;
if Count = S'Length then
Dio.Write (File, S);
else
Dio.Write (File, S (1 .. Count));
end if;
Total := Total + Count;
else
exit;
end if;
end loop;
declare
Excess : Byte_String (1 .. 1);
begin
loop
Tp.Receive (Secondary, Status, Excess, Count);
if Count > 0 then
Log.Put_Line ("Excess data received: " &
Character'Val (Excess (1)),
Kind => Profile.Warning_Msg,
Response => Response);
end if;
exit when not Tp.Is_Connected (Secondary);
end loop;
end;
end case;
if Debug then
Put_Debug ("Number of read/writes: " & Integer'Image (Rws));
end if;
Log.Put_Line ("Number of bytes transferred = " &
Integer'Image (Total),
Kind => Profile.Positive_Msg,
Response => Response);
Dio.Close (File);
Log.Put_Line ("Closed file " & Local_File,
Kind => Profile.Positive_Msg,
Response => Response);
exception
when Util.No_Remote_File | Util.No_Local_File =>
Log.Put_Line ("Transceiver not attempting transfer",
Kind => Profile.Negative_Msg,
Response => Response);
when others =>
Log.Put_Line
("Transceiver got an unexpected exception in transfer.",
Kind => Profile.Exception_Msg,
Response => Response);
end;
Tp.Disconnect (Secondary);
Tp.Close (Secondary);
accept Finish;
exception
when Util.Check_Failed =>
null;
when others =>
Log.Put_Line ("Transceiver got an unexpected exception.",
Kind => Profile.Exception_Msg,
Response => Response);
end Transceiver;
procedure Connect (Connection : Tp.Connection_Id;
Host : Td.Host_Id;
Socket : Td.Socket_Id) is
Retries : constant := 20;
Backoff : constant Duration := 3.0;
Status : Td.Status_Code;
begin
for I in 1 .. Retries loop
Tp.Connect (Connection, Status, Host, Socket);
case Status is
when Td.Not_Initialized | Td.Connection_Refused =>
delay Backoff;
when others =>
exit;
end case;
end loop;
Util.Check_Connect (Status, Response);
end Connect;
begin
declare
Machine : constant String :=
Util.Remote_Machine (Remote_Machine, Response);
Network : constant Td.Network_Name := Util.Network (Machine, Response);
Host : constant Td.Host_Id := Util.Host (Machine, Response);
Is_Ax25 : constant Boolean :=
String_Utilities.Equal
(String (Network), "AX25", Ignore_Case => True);
begin
Log.Put_Line ("Initiating OS2000 transfer to remote machine " &
String_Utilities.Upper_Case (Machine),
Kind => Profile.Positive_Msg,
Response => Response);
if Is_Ax25 then
declare
Result : constant String := Setup_Ax25_Port (Host, Network);
begin
if Result'Length > 0 then
Log.Put_Line ("Ax25 Options rejected: " & Result,
Kind => Profile.Negative_Msg,
Response => Response);
end if;
end;
end if;
begin
Tp.Open (Primary, Status, Network);
Util.Check_Open (Status, Response);
Connect (Primary, Host, Handshake_Socket);
Transceiver.Start (Network);
while not Tp.Is_Connecting_Passive (Secondary) loop
delay 0.5;
end loop;
exception
when Util.Check_Failed =>
Log.Put_Line
("Aborting transfer because Open or Connect failed.",
Kind => Profile.Negative_Msg,
Response => Response);
raise;
when others =>
Log.Put_Line
("Unexpected exception in OS2000 transfer initialization",
Kind => Profile.Exception_Msg,
Response => Response);
raise;
end;
declare
My_Socket : constant Td.Socket_Id := Tp.Local_Socket (Secondary);
begin
if Debug then
Put_Debug ("Secondary local socket = ");
for I in My_Socket'Range loop
Put_Debug (Integer'Image (Integer (My_Socket (I))));
end loop;
end if;
end;
Transmit (Primary, Util.Make_Command
(Tp.Local_Socket (Secondary), Transfer_Type));
if Debug then
Put_Debug ("***TRANSMIT status => " & Td.Image (Status));
end if;
Transceiver.Wait_For_Connection;
declare
Send_Name : Byte_String (Remote_File'First .. Remote_File'Last);
begin
Log.Put_Line ("Requesting OS2000 to open file " &
String_Utilities.Upper_Case (Remote_File),
Kind => Profile.Positive_Msg,
Response => Response);
for I in Remote_File'Range loop
Send_Name (I) := Character'Pos (Remote_File (I));
end loop;
Transmit (Primary, Send_Name);
end;
Transceiver.Finish;
Tp.Disconnect (Primary);
Tp.Close (Primary);
Log.Put_Line ("[OS2000 transfer complete]",
Kind => Profile.Auxiliary_Msg,
Response => Response);
end;
exception
when Util.Remote_Machine_Unknown =>
Log.Put_Line ("Aborting transfer because remote machine unknown",
Kind => Profile.Negative_Msg,
Response => Response);
abort Transceiver;
when Util.Check_Failed =>
abort Transceiver;
when others =>
Log.Put_Line ("Unexpected exception in OS2000 transfer.",
Kind => Profile.Exception_Msg,
Response => Response);
abort Transceiver;
raise;
end Os2000_Transfer;