with TEXT_IO; with UTILITY; with CALENDAR; with UNCHECKED_CONVERSION; package body USER_PKG is --==================================================================== -- = -- ABSTRACT USER_PKG = -- This package provides the functions required by USERMAIN to = -- parse the command input line, create a request block, send the = -- request to the Command Execution Task (CET), send and receive = -- files, and request and list status (including files available). = -- Intertask communication is handled by calls to routines in = -- package OS_DEPEND. = -- KEYWORDS USER_PKG = -- SFTP, Secure File Transfer, Communication, Security, = -- User Interface = -- CONTENTS USER_PKG = -- = -- CREATION DATE. = -- 03/30/88 = -- AUTHOR. = -- Paul Sands, The BDM Corporation, Albuquerque = -- REVISION HISTORY. = -- NONE = -- UNIT PURPOSE. = -- Provide interface between User and COMMAND_TASK. = -- UNIT FUNCTION. = -- Parse the user command line, create a request block, read files,= -- write files, intertask communication. = -- EXTERNAL ADA UNITS ACCESSED. = -- SFTP_DEFINITIONS = -- OS_DEPEND = -- UTILITY = -- TEXT_IO = -- CALENDAR = -- UNCHECKED_CONVERSION = -- EXCEPTIONS RAISED. = -- NO_COMM_TASK - unable to establish a connection. = -- INVALID_ARGUMENTS - error in input arguments. = -- PROGRAM_LOGIC_ERROR - program logic error detected. = -- USER_NOT_AUTHORIZED - request rejected by COMMAND_TASK = -- RESOURCE_UNAVAILABLE - unable to obtain required OS services. = -- INPUT/OUTPUT. = -- NONE = -- MACHINE DEPENDENCIES. = -- The intertask communication in ESTABLISH_INTERTASK_COMMUNICATION= -- and TALK_TO_COMMAND is OS and machine dependent. = -- COMPILER DEPENDENCIES. = -- NONE = -- = --==================================================================== procedure PARSE_ARGUMENTS (ARGUMENTS : in OS_DEPEND.ARGUMENT_TYPE; REQUEST : out REQUEST_TYPE; USER_TO_FROM : out USER_NAME_TYPE; COMPUTER : out COMPUTER_NAME_TYPE; REMOTE_FILE_NAME : out FILE_NAME_TYPE; LOCAL_FILE_NAME : out FILE_NAME_TYPE) is -- define command line, broken into words MAX_ARGV : constant := 32; subtype ARGV_TYPE is STRING (1 .. MAX_ARGV); ARGV : ARGV_TYPE; -- a single argument word ARG_NDX : NATURAL; -- index into ARGUMENTS ; W_REQUEST : REQUEST_TYPE; -- working REQUEST W_LOCAL_FILE_NAME : FILE_NAME_TYPE; W_REMOTE_FILE_NAME : FILE_NAME_TYPE; -- GET_QUALIFIER is called when an argument which requires a qualifier -- is encountered. The original argument may (or may not) be followed -- by a blank. procedure GET_QUALIFIER (ORIGINAL_ARG : in STRING; STR_OUT : out STRING) is ORIG_NDX : INTEGER := 3; -- where to start on original argument WORK : ARGV_TYPE := (others => ' '); begin if ORIGINAL_ARG (3) = ' ' then -- original argument was followed by blank. get next word. UTILITY.GET_WORD (ARGUMENTS, ARG_NDX, WORK); if WORK (1) = '-' or ARG_NDX > ARGUMENTS'LAST then -- the required qualifier for the previous argument is missing raise INVALID_ARGUMENTS; else STR_OUT := WORK (1 .. STR_OUT'LAST); end if; else -- the qualifier is part of the original argument UTILITY.GET_WORD (ORIGINAL_ARG, ORIG_NDX, STR_OUT); end if; end GET_QUALIFIER; begin -- break up the command line into the various arguments -- on error, raise INVALID_ARGUMENTS -- the command line is "UNIX" style, as follows -- -, exactly one of the following: -- -i inquire Do I have any files to receive? -- -I same plus status of files sent. -- -l list list files available to receive. -- -r receive a file (must specify -u, -c, -f, and l_f_n) -- -s send a file (must specify -u, -c, and l_f_n) -- -u , is the other user (sender or receiver) -- depending on the command. -- -c , is the other computer (sending -- or receiving) depending on the command. -- -f , the name by which the file was described -- by the other system. (obtained by -l). -- [-n] A local file name. The current name of the file -- for a send, or the destination name for a receive. -- If -n is omitted, this argument must be last. -- if command line is blank, raise INVALID_ARGUMENTS if ARGUMENTS (1) = ' ' then raise INVALID_ARGUMENTS; end if; -- clear all of the strings returned UTILITY.BLANK_STRING (USER_TO_FROM); UTILITY.BLANK_STRING (COMPUTER); UTILITY.BLANK_STRING (W_REMOTE_FILE_NAME); UTILITY.BLANK_STRING (W_LOCAL_FILE_NAME); -- initialize request and argument index W_REQUEST := REQUEST_NOT_SPECIFIED; ARG_NDX := 1; -- process the command line while ARG_NDX <= ARGUMENTS'LAST loop UTILITY.GET_WORD (ARGUMENTS, ARG_NDX, ARGV); if ARGV (1) = ' ' then null; elsif ARGV (1) = '-' then case ARGV (2) is when 'i' | 'I' | 'l' | 'L' | 'd' | 'D' | 'r' | 'R' | 's' | 'S' | 'q' | 'Q' => if W_REQUEST = REQUEST_NOT_SPECIFIED then -- translate the request code case ARGV (2) is when 'i' | 'I' => W_REQUEST := REQUEST_INQUIRE_SHORT; when 'q' | 'Q' => W_REQUEST := REQUEST_INQUIRE_STATUS; when 'l' | 'L' => W_REQUEST := REQUEST_INQUIRE_LIST; when 'd' | 'D' => W_REQUEST := REQUEST_DELETE; when 'r' | 'R' => W_REQUEST := REQUEST_RECEIVE; when 's' | 'S' => W_REQUEST := REQUEST_SEND; when others => -- not possible raise PROGRAM_LOGIC_ERROR; end case; else -- more than one action requested TEXT_IO.PUT_LINE ("SFTP: More than one action requested"); raise INVALID_ARGUMENTS; end if; when 'u' | 'U' => GET_QUALIFIER (ARGV, USER_TO_FROM); when 'c' | 'C' => GET_QUALIFIER (ARGV, COMPUTER); when 'f' | 'F' => GET_QUALIFIER (ARGV, W_REMOTE_FILE_NAME); -- allow -f for local file name (unless specified) if W_LOCAL_FILE_NAME (1) = ' ' then W_LOCAL_FILE_NAME := W_REMOTE_FILE_NAME; end if; when 'n' => GET_QUALIFIER (ARGV, W_LOCAL_FILE_NAME); when others => TEXT_IO.PUT_LINE ("SFTP: Unsupported argument: " & ARGV); raise INVALID_ARGUMENTS; end case; else -- without '-' must be the last argument (file name) W_LOCAL_FILE_NAME := ARGV (1 .. 16); UTILITY.GET_WORD (ARGUMENTS, ARG_NDX, ARGV); if ARG_NDX <= ARGUMENTS'LAST then TEXT_IO.PUT_LINE ("SFTP: Argument not preceeded by '-' must be last."); raise INVALID_ARGUMENTS; else -- allow this to be the remote file name (unless specified) if W_REMOTE_FILE_NAME (1) = ' ' then W_REMOTE_FILE_NAME := W_LOCAL_FILE_NAME; end if; end if; end if; end loop; -- while ARG_NDX <= ARGUMENTS'LAST -- assign working values to out arguments REQUEST := W_REQUEST; LOCAL_FILE_NAME := W_LOCAL_FILE_NAME; REMOTE_FILE_NAME := W_REMOTE_FILE_NAME; end PARSE_ARGUMENTS; -- used to generate a unique name for an intertask communication label -- pads the username with '_' if needed to make a length of 8 -- converts the duration to an integer and adds to the username procedure GET_MBX_NAME (USER_NAME : USER_NAME_TYPE; MBX_NAME : in out STRING) is CUR_TIME : DURATION; INT_TIME : INTEGER; LEN_INT_TIME : INTEGER; START_INT_TIME : INTEGER; YEAR, MONTH, DATE : INTEGER; function DUR2INT is new UNCHECKED_CONVERSION (DURATION, INTEGER); begin CALENDAR.SPLIT (CALENDAR.CLOCK, YEAR, MONTH, DATE, CUR_TIME); INT_TIME := DUR2INT (CUR_TIME); LEN_INT_TIME := INTEGER'IMAGE (INT_TIME)'LENGTH; START_INT_TIME := LEN_INT_TIME - 7; for I in 1 .. 8 loop if USER_NAME (I) /= ' ' then MBX_NAME (I) := USER_NAME (I); else MBX_NAME (I) := '_'; end if; end loop; MBX_NAME (9 .. 9 + LEN_INT_TIME - START_INT_TIME) := INTEGER'IMAGE (INT_TIME) (START_INT_TIME .. LEN_INT_TIME); end GET_MBX_NAME; -- formats the incoming inquire data records procedure DO_INQUIRE_SHORT (MBX : in OS_DEPEND.TASK_COMM_TYPE) is INQ_DATA : OS_DEPEND.INQUIRY_DATA_TYPE; COUNT : INTEGER := 0; begin loop -- files to be received OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); exit when INQ_DATA.NUMBER = 0; COUNT := COUNT + 1; end loop; if COUNT /= 0 then TEXT_IO.PUT_LINE ("SFTP: You have" & INTEGER'IMAGE (COUNT) & " files to receive"); else TEXT_IO.PUT_LINE ("SFTP: You have no files to receive"); end if; -- even though status is not specified we need to read in this data loop -- files currently being sent to tcp OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); exit when INQ_DATA.NUMBER = 0; end loop; end DO_INQUIRE_SHORT; -- formats the incoming inquire data records procedure DO_INQUIRE_LIST (MBX : in OS_DEPEND.TASK_COMM_TYPE) is INQ_DATA : OS_DEPEND.INQUIRY_DATA_TYPE; COUNT : INTEGER := 0; begin OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); if INQ_DATA.NUMBER = 0 then TEXT_IO.PUT_LINE ("SFTP: You have no files to receive"); else COUNT := 1; TEXT_IO.PUT_LINE (" Filename Sender Computer " & " When received Security"); loop -- FILES TO BE RECEIVED TEXT_IO.PUT_LINE (" " & INQ_DATA.FILE_NAME & " " & INQ_DATA.USER_FROM & INQ_DATA.COMP_FROM & UTILITY.FORMAT_TIME (INQ_DATA.ENTRY_TIME) & " " & OS_DEPEND.SECURITY_LEVEL_TYPE'IMAGE ( INQ_DATA.SECURITY.SI_SECURITY_LEVEL)); OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); exit when INQ_DATA.NUMBER = 0; COUNT := COUNT + 1; end loop; TEXT_IO.PUT ("SFTP: Total of" & INTEGER'IMAGE (COUNT)); if COUNT = 1 then TEXT_IO.PUT_LINE (" file."); else TEXT_IO.PUT_LINE (" files."); end if; end if; -- even though status was not requested we need to read in this data loop -- files currently being sent to tcp OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); exit when INQ_DATA.NUMBER = 0; end loop; end DO_INQUIRE_LIST; -- formats the incoming inquire data records procedure DO_INQUIRE_STATUS (MBX : in OS_DEPEND.TASK_COMM_TYPE) is INQ_DATA : OS_DEPEND.INQUIRY_DATA_TYPE; COUNT : INTEGER := 0; begin OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); if INQ_DATA.NUMBER = 0 then TEXT_IO.PUT_LINE ("SFTP: You have no files to receive"); else COUNT := 1; TEXT_IO.PUT_LINE (" Filename Sender Computer " & " When received Security"); loop -- files to be received TEXT_IO.PUT_LINE (" " & INQ_DATA.FILE_NAME & " " & INQ_DATA.USER_FROM & INQ_DATA.COMP_FROM & UTILITY.FORMAT_TIME (INQ_DATA.ENTRY_TIME) & " " & OS_DEPEND.SECURITY_LEVEL_TYPE'IMAGE ( INQ_DATA.SECURITY.SI_SECURITY_LEVEL)); OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); exit when INQ_DATA.NUMBER = 0; COUNT := COUNT + 1; end loop; TEXT_IO.PUT ("SFTP: Total of" & INTEGER'IMAGE (COUNT)); if COUNT = 1 then TEXT_IO.PUT_LINE (" file."); else TEXT_IO.PUT_LINE (" files."); end if; end if; COUNT := 0; OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); if INQ_DATA.NUMBER = 0 then TEXT_IO.PUT_LINE ("SFTP: You have no files waiting to be sent"); else COUNT := 1; TEXT_IO.PUT_LINE ("SFTP: Status of files waiting to be sent"); TEXT_IO.PUT_LINE (" Filename To Computer " & " When queued Security"); loop -- files currently being sent to tcp TEXT_IO.PUT_LINE (" " & INQ_DATA.FILE_NAME & " " & INQ_DATA.USER_FROM & INQ_DATA.COMP_FROM & UTILITY.FORMAT_TIME (INQ_DATA.ENTRY_TIME) & " " & OS_DEPEND.SECURITY_LEVEL_TYPE'IMAGE ( INQ_DATA.SECURITY.SI_SECURITY_LEVEL)); OS_DEPEND.RECEIVE_INQUIRY_DATA (MBX, INQ_DATA); exit when INQ_DATA.NUMBER = 0; COUNT := COUNT + 1; end loop; TEXT_IO.PUT ("SFTP: Total of" & INTEGER'IMAGE (COUNT)); if COUNT = 1 then TEXT_IO.PUT_LINE (" file."); else TEXT_IO.PUT_LINE (" files."); end if; end if; end DO_INQUIRE_STATUS; -- handles reply from cet and calls appropriate format routine procedure DO_INQUIRE (MAILBOX : in OS_DEPEND.TASK_COMM_TYPE; REQUEST : in REQUEST_TYPE; REPLY : in REPLY_MSG_TYPE) is MSG : OS_DEPEND.REQUEST_MSG_TYPE; begin case REPLY is when NOT_AUTHORIZED => raise USER_NOT_AUTHORIZED; when FILE_LIST_FOLLOWS => case REQUEST is when REQUEST_INQUIRE_SHORT => DO_INQUIRE_SHORT (MAILBOX); when REQUEST_INQUIRE_LIST => DO_INQUIRE_LIST (MAILBOX); when REQUEST_INQUIRE_STATUS => DO_INQUIRE_STATUS (MAILBOX); when others => TEXT_IO.PUT_LINE ("SFTP: Bad request in DO_INQUIRE"); raise PROGRAM_LOGIC_ERROR; end case; when others => TEXT_IO.PUT_LINE ("SFTP: BAD REPLY FROM CET"); end case; end DO_INQUIRE; -- handles reply from CET procedure DO_DELETE (REPLY : in REPLY_MSG_TYPE) is begin -- tell user whether request was granted case REPLY is when NOT_AUTHORIZED => raise USER_NOT_AUTHORIZED; when FILE_NOT_FOUND => TEXT_IO.PUT_LINE ("SFTP: File not found"); when FILE_DELETED => TEXT_IO.PUT_LINE ("SFTP: File deleted"); when others => TEXT_IO.PUT_LINE ("SFTP: BAD REPLY FROM CET"); end case; end DO_DELETE; -- handles reply from CET -- if allowed, sends file through intertask communication procedure DO_SEND (MAILBOX : in OS_DEPEND.TASK_COMM_TYPE; LOCAL_FILE_NAME : in FILE_NAME_TYPE; REPLY : in REPLY_MSG_TYPE) is begin case REPLY is when NOT_AUTHORIZED => raise USER_NOT_AUTHORIZED; when OK_TO_SEND => OS_DEPEND.SEND_FILE (MAILBOX, LOCAL_FILE_NAME); TEXT_IO.PUT_LINE ("SFTP: SENT " & LOCAL_FILE_NAME); when others => TEXT_IO.PUT_LINE ("SFTP: BAD REPLY FROM CET"); end case; end DO_SEND; -- handles reply from CET -- if allowed, receives file through intertask communication procedure DO_RECEIVE (MAILBOX : in OS_DEPEND.TASK_COMM_TYPE; LOCAL_FILE_NAME : in FILE_NAME_TYPE; REPLY : in REPLY_MSG_TYPE) is begin case REPLY is when NOT_AUTHORIZED => raise USER_NOT_AUTHORIZED; when FILE_NOT_FOUND => TEXT_IO.PUT_LINE ("SFTP: File not found"); when OK_TO_RECEIVE => OS_DEPEND.RECEIVE_FILE (MAILBOX, LOCAL_FILE_NAME); TEXT_IO.PUT_LINE ("SFTP: RECEIVED " & LOCAL_FILE_NAME); when others => TEXT_IO.PUT_LINE ("SFTP: BAD REPLY FROM CET"); end case; end DO_RECEIVE; -- sends request to CET -- connects to uit and reply mailboxes -- sends request to CET and receives reply -- calls individual routines to handle reply for each request type procedure DO_REQUEST (CET_MBX : in OS_DEPEND.TASK_COMM_TYPE; USER_INFO : in OS_DEPEND.USER_INFO_TYPE; REQUEST : in REQUEST_TYPE; USER_TO_FROM : in USER_NAME_TYPE; COMPUTER : in COMPUTER_NAME_TYPE; REMOTE_FILE_NAME : in FILE_NAME_TYPE; LOCAL_FILE_NAME : in FILE_NAME_TYPE) is MESSAGE : OS_DEPEND.REQUEST_MSG_TYPE; REPLY : REPLY_MSG_TYPE; UIT_MBX : OS_DEPEND.TASK_COMM_TYPE; REPLY_MBX : OS_DEPEND.TASK_COMM_TYPE; CONNECTED : BOOLEAN; begin GET_MBX_NAME (USER_INFO.UI_USER_NAME, UIT_MBX.TC_MAILBOX_ID); MESSAGE.RM_TASK_COMM := UIT_MBX; MESSAGE.RM_REQUEST_DATA.RD_REQUEST := REQUEST; MESSAGE.RM_REQUEST_DATA.RD_USER := USER_TO_FROM; MESSAGE.RM_REQUEST_DATA.RD_COMPUTER := COMPUTER; MESSAGE.RM_REQUEST_DATA.RD_FILE_NAME := REMOTE_FILE_NAME; MESSAGE.RM_USER_INFO := USER_INFO; -- inform cet of request and mailbox names OS_DEPEND.SEND_REQUEST (CET_MBX, MESSAGE); delay 2.0; --give cet time to create mailboxes OS_DEPEND.CONNECT_INTERTASK_COMMUNICATION (UIT_MBX, CONNECTED); if not CONNECTED then TEXT_IO.PUT_LINE ("SFTP: Failed to connect to uit mailbox"); raise RESOURCE_UNAVAILABLE; end if; REPLY_MBX.TC_MAILBOX_ID := UIT_MBX.TC_MAILBOX_ID (1 .. 15) & 'R'; OS_DEPEND.CONNECT_INTERTASK_COMMUNICATION (REPLY_MBX, CONNECTED); if not CONNECTED then TEXT_IO.PUT_LINE ("SFTP: Failed to connect to reply mailbox"); raise RESOURCE_UNAVAILABLE; end if; -- receive reply from cet OS_DEPEND.RECEIVE_REPLY (REPLY_MBX, REPLY); case REQUEST is when REQUEST_INQUIRE_SHORT | REQUEST_INQUIRE_STATUS | REQUEST_INQUIRE_LIST => DO_INQUIRE (UIT_MBX, REQUEST, REPLY); when REQUEST_SEND => DO_SEND (UIT_MBX, LOCAL_FILE_NAME, REPLY); when REQUEST_RECEIVE => DO_RECEIVE (UIT_MBX, LOCAL_FILE_NAME, REPLY); when REQUEST_DELETE => DO_DELETE (REPLY); when REQUEST_NOT_SPECIFIED => TEXT_IO.PUT_LINE ("SFTP: No action specified in request."); raise INVALID_ARGUMENTS; when others => raise PROGRAM_LOGIC_ERROR; end case; end DO_REQUEST; end USER_PKG;