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;