|
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: 6253 (0x186d)
Types: TextFile
Names: »B«
└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
└─⟦5cb1d1d7f⟧ »DATA«
└─⟦3b1ee7bd8⟧
└─⟦this⟧
with Log, Text_Io, Byte_Defs, Transport_Defs,
Transport, Tftp_Utilities, Scheduler, System;
procedure Tftp_Server is
type Transfer_Direction is (Receive, Send);
task type Transfer_Worker is
entry Transfer (File : String;
Direction : Transfer_Direction;
Mode : Tftp_Utilities.Transfer_Mode;
Host : Transport_Defs.Host_Id;
Socket : Transport_Defs.Socket_Id;
Slot : Positive);
end Transfer_Worker;
type Worker_Ptr is access Transfer_Worker;
type Worker_Entry is
record
Is_Elaborated : Boolean := False;
Is_Active : Boolean := False;
Ptr : Worker_Ptr;
end record;
Max_Concurrent_Transfers : constant := 25;
Worker_Array : array (1 .. Max_Concurrent_Transfers) of Worker_Entry;
Current_Connection : Transport.Connection_Id;
Connection_Status : Transport_Defs.Status_Code;
Tftp_Server_Socket : Transport_Defs.Socket_Id (1 .. 2) := (0, 69);
Request_Buffer : Byte_Defs.Byte_String (1 .. 1008);
Request_Length : Natural;
Read_Request : constant Byte_Defs.Byte := 1;
Write_Request : constant Byte_Defs.Byte := 2;
Fatal_Error_Seen : Boolean := False;
task body Transfer_Worker is separate;
procedure Allocate_Worker;
procedure Allocate_Worker is
Slot_Found : Boolean := False;
Slot_Ptr : Positive;
Direction : Transfer_Direction;
Filename_Text : String (1 .. 1000);
End_Of_Filename : Natural;
Mode_Text : String (1 .. 8);
End_Of_Mode : Natural;
Mode : Tftp_Utilities.Transfer_Mode;
begin
if Request_Length > 8 and then Byte_Defs."="
(Request_Buffer (1), 0) and then
(Byte_Defs."=" (Request_Buffer (2), Read_Request) or
Byte_Defs."=" (Request_Buffer (2), Write_Request)) then
for I in Worker_Array'Range loop
if not Worker_Array (I).Is_Active then
if not Worker_Array (I).Is_Elaborated then
Worker_Array (I).Ptr := new Transfer_Worker;
Worker_Array (I).Is_Elaborated := True;
end if;
Worker_Array (I).Is_Active := True;
Slot_Ptr := I;
Slot_Found := True;
exit;
end if;
end loop;
if Slot_Found then
Tftp_Utilities.Extract_String
(Request_Buffer (3 .. Request_Length),
Filename_Text, End_Of_Filename);
Tftp_Utilities.Extract_String
(Request_Buffer (3 + End_Of_Filename + 1 .. Request_Length),
Mode_Text, End_Of_Mode);
if Mode_Text (1 .. End_Of_Mode) = "MAIL" then
Mode := Tftp_Utilities.Mail;
elsif Mode_Text (1 .. End_Of_Mode) = "BINARY" or else
Mode_Text (1 .. End_Of_Mode) = "OCTET" then
Mode := Tftp_Utilities.Binary;
elsif Mode_Text (1 .. End_Of_Mode) = "NETASCII" then
Mode := Tftp_Utilities.Text;
else
Tftp_Utilities.Send_Error
(Current_Connection, Tftp_Utilities.Illegal_Operation,
"Invalid mode => " & Mode_Text (1 .. End_Of_Mode));
return;
end if;
if Byte_Defs."=" (Request_Buffer (2), Read_Request) then
Direction := Send;
else
Direction := Receive;
end if;
Worker_Array (Slot_Ptr).Ptr.Transfer
(Filename_Text (1 .. End_Of_Filename), Direction,
Mode, Transport.Remote_Host (Current_Connection),
Transport.Remote_Socket (Current_Connection), Slot_Ptr);
else
Tftp_Utilities.Send_Error (Current_Connection,
Tftp_Utilities.Not_Defined,
"Server is busy. Try again later");
end if;
else
Tftp_Utilities.Send_Error (Current_Connection,
Tftp_Utilities.Illegal_Operation,
"Illegal packet type received.");
end if;
end Allocate_Worker;
begin
Scheduler.Set_Job_Attribute (System.Current_Vp, Value => "Server");
Log.Set_Output ("!Machine.Error_Logs.Tftp_Log");
while not Fatal_Error_Seen loop
Transport.Open (Current_Connection, Connection_Status,
"UDP/IP", Tftp_Server_Socket);
if Transport_Defs."=" (Connection_Status, Transport_Defs.Ok) then
Transport.Connect (Current_Connection, Connection_Status);
if Transport_Defs."=" (Connection_Status, Transport_Defs.Ok) then
Transport.Receive (Current_Connection, Connection_Status,
Request_Buffer, Request_Length);
if Transport_Defs."=" (Connection_Status,
Transport_Defs.Ok) then
Allocate_Worker;
else
if not Transport_Defs."=" (Connection_Status,
Transport_Defs.Timed_Out) then
Log.Put_Line ("Receive failed. Status => " &
Transport_Defs.Image (Connection_Status));
end if;
end if;
Transport.Disconnect (Current_Connection);
Transport.Close (Current_Connection);
else
Transport.Close (Current_Connection);
Log.Put_Line ("Connect failed. Status => " &
Transport_Defs.Image (Connection_Status));
end if;
else
Log.Put_Line ("Open failed. Status => " &
Transport_Defs.Image (Connection_Status));
end if;
delay 5.0;
end loop;
Log.Reset_Output;
end Tftp_Server;