|
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 - metrics - downloadIndex: B T
Length: 7584 (0x1da0)
Types: TextFile
Names: »B«
└─⟦afbc8121e⟧ Bits:30000532 8mm tape, Rational 1000, MC68020_OS2000 7_2_2
└─⟦77aa8350c⟧ »DATA«
└─⟦f794ecd1d⟧
└─⟦this⟧
with Log;
with Profile;
with Ftp_Profile;
with Transport_Name;
with String_Utilities;
package body Os2000_Transfer_Utilities is
type Transport_Service is (Open, Connect, Transmit, Receive);
function "=" (X, Y : Byte_Defs.Byte) return Boolean renames Byte_Defs."=";
function "=" (X, Y : Transport_Defs.Status_Code) return Boolean
renames Transport_Defs."=";
function Network (Remote_Machine : String;
Response : Profile.Response_Profile)
return Transport_Defs.Network_Name is
begin
return Transport_Name.Host_To_Network_Name (Remote_Machine);
exception
when Transport_Name.Undefined =>
Log.Put_Line (Message =>
Remote_Machine & " is not a defined machine name.",
Kind => Profile.Error_Msg,
Response => Response);
raise Remote_Machine_Unknown;
end Network;
function Host (Remote_Machine : String; Response : Profile.Response_Profile)
return Transport_Defs.Host_Id is
begin
return Transport_Name.Host_To_Host_Id (Remote_Machine);
exception
when Transport_Name.Undefined =>
Log.Put_Line (Message =>
Remote_Machine & " is not a defined machine name.",
Kind => Profile.Error_Msg,
Response => Response);
raise Remote_Machine_Unknown;
end Host;
procedure Report_Failure (Proc : Transport_Service;
Status : Transport_Defs.Status_Code;
Response : Profile.Response_Profile) is
begin
Log.Put_Line ("Transport." & Transport_Service'Image (Proc) &
" returned status " & Transport_Defs.Image (Status),
Kind => Profile.Error_Msg,
Response => Response);
Log.Put_Line ("Possible causes for the failure include:",
Kind => Profile.Note_Msg,
Response => Response);
case Proc is
when Open =>
Log.Put_Line (" The remote machine is not running.",
Kind => Profile.Note_Msg,
Response => Response);
Log.Put_Line (" The network has a hardware problem.",
Kind => Profile.Note_Msg,
Response => Response);
when Connect =>
Log.Put_Line
(" The server is not running on the remote machine.",
Kind => Profile.Note_Msg,
Response => Response);
Log.Put_Line (" Another transfer is currently in progress.",
Kind => Profile.Note_Msg,
Response => Response);
when Transmit | Receive =>
Log.Put_Line (" The remote server has failed.",
Kind => Profile.Note_Msg,
Response => Response);
Log.Put_Line (" The network has a hardware problem.",
Kind => Profile.Note_Msg,
Response => Response);
end case;
Log.Put_Line ("", Kind => Profile.Note_Msg, Response => Response);
end Report_Failure;
procedure Check_Open (Status : Transport_Defs.Status_Code;
Response : Profile.Response_Profile) is
begin
if Status /= Transport_Defs.Ok then
Report_Failure (Open, Status, Response);
raise Check_Failed;
end if;
end Check_Open;
procedure Check_Connect (Status : Transport_Defs.Status_Code;
Response : Profile.Response_Profile) is
begin
if Status /= Transport_Defs.Ok then
Report_Failure (Connect, Status, Response);
raise Check_Failed;
end if;
end Check_Connect;
procedure Check_Transmit (Status : Transport_Defs.Status_Code;
Response : Profile.Response_Profile) is
begin
if Status /= Transport_Defs.Ok then
Report_Failure (Transmit, Status, Response);
raise Check_Failed;
end if;
end Check_Transmit;
procedure Check_Receive (Status : Transport_Defs.Status_Code;
Response : Profile.Response_Profile) is
begin
if Status /= Transport_Defs.Ok then
Report_Failure (Receive, Status, Response);
raise Check_Failed;
end if;
end Check_Receive;
function Translate (Transfer : Transfer_Type) return Byte is
begin
case Transfer is
when Put_Exe =>
return Byte (Character'Pos ('E'));
when Put_File =>
return Byte (Character'Pos ('F'));
when Get_File =>
return Byte (Character'Pos ('G'));
end case;
end Translate;
function Make_Command (Socket : Transport_Defs.Socket_Id;
Transfer : Transfer_Type) return Byte_String is
Result : Byte_String (1 .. Socket'Length + 1);
Index : Natural := 1;
begin
for I in Socket'Range loop
Result (Index) := Socket (I);
Index := Index + 1;
end loop;
Result (Index) := Translate (Transfer);
return Result;
end Make_Command;
function Extract_Status (S : Byte_String) return Remote_File_Status is
begin
if S'Length /= 2 or else S (S'First) /= Byte (Character'Pos ('?')) then
return Unknown_Status;
else
case Character'Val (S (S'Last)) is
when 'S' =>
return Success;
when 'N' =>
return Name_Error;
when 'U' =>
return Use_Error;
when 'D' =>
return Device_Error;
when 'O' =>
return Other_Error;
when others =>
return Unknown_Status;
end case;
end if;
end Extract_Status;
function Remote_Path (File : String;
Directory : String;
Response : Profile.Response_Profile) return String is
begin
if String_Utilities.Upper_Case (Directory) = "<DEFAULT>" then
return Remote_Path (File, Ftp_Profile.Remote_Directory, Response);
else
if File'Length > 0 then
if File (File'First) = '/' then
return File;
else
return Directory & '/' & File;
end if;
else
Log.Put_Line
(Message =>
"The name provided for the Remote_File was empty",
Kind => Profile.Error_Msg,
Response => Response);
raise No_Remote_File;
end if;
end if;
end Remote_Path;
function Remote_Machine (Name : String; Response : Profile.Response_Profile)
return String is
begin
if String_Utilities.Upper_Case (Name) = "<DEFAULT>" then
return Ftp_Profile.Remote_Machine;
else
return Name;
end if;
end Remote_Machine;
function Debug return Boolean is
begin
return False;
end Debug;
end Os2000_Transfer_Utilities;