MODULE KERMIT (IDENT = '3.3.128', MAIN = MAIN_ROUTINE, ADDRESSING_MODE(EXTERNAL = GENERAL, NONEXTERNAL = GENERAL) ) = BEGIN BIND IDENT_STRING = %ASCID'VMS Kermit-32 version 3.3.128'; ! Ident message !++ ! FACILITY: ! KERMIT-32 ! ! ABSTRACT: ! KERMIT-32 is an implementation of the KERMIT protocal to allow the ! transfer of files from micro computers to the DECsystem-10, DECSYSTEM-20 ! and now the VAX/VMS systems. ! ! ENVIRONMENT: ! User mode ! ! AUTHOR: Robert C. McQueen, CREATION DATE: 24-January-1983 ! ! MODIFIED BY: ! !-- %SBTTL 'Table of Contents' %SBTTL 'Revision History' !++ ! Start of version 1. ! ! 1.0.000 By: Robert C. McQueen On: 4-Jan-1983 ! Create this program. ! ! 1.0.001 By: Robert C. McQueen On: 4-May-1983 ! Allow RECEIVE without a file specification to mean ! use what ever the remote says. ! ! 1.1.002 By: W. Hom On: 6-July-1983 ! Implement CONNECT command. ! ! 1.2.003 By: Robert C. McQueen On: 15-Aug-1983 ! Add SET PARITY command and SHOW PARITY to support ! eight bit quoting. ! ! 1.2.004 By: Robert C. McQueen On: 23-August-1983 ! Add dummy routine SY_TIME. ! ! 1.2.005 By: Robert C. McQueen On: 23-August-1983 ! Add SET [SEND | RECEIVE] EIGHT-BIT-QUOTE ! command. Add message for SHOW RECEIVE and SHOW SEND parameters ! ! 1.2.006 By: Robert C. McQueen On: 26-August-1983 ! Add BYE, FINISH and LOGOUT commands. These commands call ! DO_GENERIC to send generic functions to remote servers. ! ! 1.2.007 By: Robert C. McQueen On: 16-September-1983 ! Implement SY_TIME, and XFR_STATUS routines. ! Add more stat type out. ! ! 1.2.008 By: Robert C. McQueen On: 19-September-1983 ! Add the SET RETRY command and the SHOW RETRY command. ! ! 1.2.009 By: Robert C. McQueen On: 20-September-1983 ! Add CRCCLC routine for calculating CRC-CCITT. ! Set SET BLOCK_CHECK_TYPE and SHOW BLOCK_CHECK_TYPE commands. ! ! 1.2.010 By: Nick Bush On: 3-October-1983 ! SERVER (in KERMSG) actually returns a value. If it ! is "ABORTED", then we should prompt again. This allows ! a ^Y typed to the server to put it back into command ! level. (If you want to type out statistics or whatever). ! ! 2.0.011 Release VAX/VMS Kermit-32 version 2.0 ! ! 2.0.012 By: Nick Bush On: 10-Nov-1983 ! Add type out of version number. Also fix some ! problems with IBM mode and local echo. ! ! 2.0.013 By: Nick Bush On: 11-Nov-1983 ! Change how debugging output is done so that it ! can be redirected to the logical device KER$DEBUG. ! If the logical name is defined to be something other ! that SYS$OUTPUT, KERMIT will send any debugging output ! there. ! ! 2.0.014 By: Robert C. McQueen On: 16-Nov-1983 ! Make sure all message number checks are mod 64. There ! were four that weren't. ! ! 2.0.015 By: Nick Bush On: 17-Nov-1983 ! Always clear purge typeahead when posting receive QIO. ! Also, clear any typeahead just before sending a packet. ! ! 2.0.016 By: Nick Bush On: 4-Dec-1983 ! Change how binary files are written to (hopefully) improve ! the performance. We will now use 510 records and only ! write out the record when it is filled (instead of writing ! one record per packet). This should cut down on the overhead ! substantially. ! ! 2.0.017 By: Nick Bush On: 9-Dec-1983 ! Fix processing for VFC format files. Also fix GET_ASCII ! for PRN and FTN record types. Change GET_ASCII so that ! 'normal' CR records get sent with trailing CRLF's instead ! of record. That was confusing too many people. ! ! 2.0.020 By: Nick Bush On: 9-Dec-1983 ! Only abort (when remote) if we seen two control-Y's in ! succession. This way a single glitch does not kill us. ! ! 2.0.021 By: Nick Bush On: 12-Dec-1983 ! Add status type-out character (^A), debug toggle ! character (^D), and force timeout character (^M) ! to those accepted during a transfer when we are remote. ! ! 2.0.022 By: Nick Bush On: 15-Dec-1983 ! Add Fixed record size (512 byte) format for writing files. ! This can be used for .EXE files. Also clean up writing ! ASCII files so that we don't lose any characters. ! ! 2.0.023 By: Nick Bush On: 16-Dec-1983 ! Add a default terminal name for the communications line. ! If KER$COMM is defined, that will be the default. ! ! 2.0.025 By: Robert C. McQueen On: 22-Dec-1983 ! Use RMSG_COUNT and SMSG_COUNT now. ! ! 2.0.026 By: Nick Bush On: 3-Jan-1984 ! Add options for format of file specification to be ! sent in file header packets. Also type out full file ! specification being sent/received instead of just ! the name we are telling the other end to use. ! ! 2.0.027 By: Nick Bush On: 20-Jan-1984 ! Fix reset of parity to use the correct field in the ! IO status block from the IO$_SENSEMODE. It was using ! the LF fill count instead. ! ! 2.0.030 By: Nick Bush On: 3-Feb-1984 ! Add the capability of receiving a file with a different ! name than given by KERMSG. The RECEIVE and GET commands ! now really are different. ! ! 2.0.031 By: Nick Bush On: 4-Feb-1984 ! Change connect code to improve response (hopefully ! without worsening throughput or runtime requirements). ! When either terminal is idle we will be waiting for ! a single character with a larger buffered read queued ! up immediately after it. ! ! 2.0.032 By: Nick Bush On: 25-Feb-1984 ! Add code for LOCAL and REMOTE commands. These depend ! upon support in KERMSG and KERSYS. ! ! 2.0.033 By: Nick Bush On: 6-March-1984 ! Change command input and terminal processing so that ! we will always have SYS$OUTPUT and SYS$COMMAND open ! when they are terminals, and will also always have ! the transfer terminal line open. This makes it ! unnecessary for the user to allocate a dialup line ! in order to go between CONNECT and a transfer command, ! and keep anyone else from grabbing the line between ! commands. ! Also add the command parsing for the rest of the LOCAL/REMOTE ! commands. This makes use of the fact that we have ! SYS$COMMAND open to allow us to read passwords without echo. ! Commands which should only be done when Kermit is local ! (GET, BYE, etc.) will now give an error if the transfer ! line is the same as the controlling terminal. ! SEND will now check for the files existance before calling ! KERMSG to send it. ! ! 2.0.034 By: Nick Bush On: 7-March-1984 ! Default the parity type to be that of the default transfer ! line. This should make things simpler for systems which use ! parity by default. ! ! 2.0.035 By: Nick Bush On: 8-March-1984 ! Add LOG SESSION command to set a log file for CONNECT. ! While we are doing so, clean up the command parsing a little ! so that we don't have as many COPY_xxx routines. ! ! 2.0.036 By: Nick Bush On: 15-March-1984 ! Fix PUT_FILE to correctly handle carriage returns which are ! not followed by line feeds. Count was being decremented ! Instead of incremented. ! ! 2.0.037 By: Robert C. McQueen On: 20-March-1984 ! Fix call to LOG_OPEN for debug log file. ! Module: KERTRM. ! ! 2.0.040 By: Nick Bush On: 22-March-1984 ! Fix processing of FORTRAN carriage control to handle lines ! which do not contain the carriage control character (i.e., zero ! length records). Previously, this type of record was sending ! infinite nulls. ! ! 2.0.041 By: Nick Bush On: 26-March-1984 ! Add SET PROMPT command. ! ! 2.0.042 By: Nick Bush On: 26-March-1984 ! Fix connect processing to make it easy to type messages ! on the user's terminal while connected. Use this ! to type messages when log file stopped and started. ! Include the node name in the messages to keep ! users who are running through multiple Kermit's from ! getting confused. ! ! 2.0.043 By: Nick Bush On: 28-March-1984 ! Fix SET PARITY ODD to work. Somehow, the table entry ! had PR_NONE instead of PR_ODD. Also add status type ! out and help message to connect command. ! ! 2.0.044 By: Nick Bush On: 28-March-1984 ! Fix SET SEND START_OF_PACKET to store in SND_SOH instead ! of RCV_SOH. Also, set TY_FIL false before calling FILE_OPEN ! to check for existence of send files. ! ! 3.0.045 Start of version 3. ! ! 3.0.046 By: Nick Bush On: 29-March-1984 ! Fix debugging log file to correctly set/clear file open ! flag. Also make log files default to .LOG. ! ! 3.0.047 By: Nick Bush On: 30-March-1984 ! Fix SEND command processing to save and restore the file ! specification over the call to FILE_OPEN, since FILE_OPEN ! rewrites it with the resulting file name, losing any ! wild-cards. ! ! 3.0.050 By: Nick Bush On: 2-April-1984 ! Add SET SERVER_TIMER to determine period between idle naks. ! Also allow for a routine to process file specs before ! FILE_OPEN uses them. This allows individual sites to ! restrict the format of file specifications used by Kermit. ! ! 3.0.051 By: Nick Bush On: 2-April-1984 ! Fix command scanning to correctly exit after performing ! a single command when entered with a command present. ! ! 3.1.052 By: Nick Bush On: 3-July-1984 ! Fix KERCOM's definition of MAX_MSG to allow for all characters ! of packet to fit into buffers, not just the counted ones. ! ! 3.1.053 By: Robert C. McQueen On: 9-July-1984 ! Fix FORTRAN carriage control processing to pass along ! any character from the carriage control column that is ! not really carriage control. ! ! 3.1.054 By: Nick Bush On: 13-July-1984 ! Change TERM_OPEN to take an argument which determines ! whether it should post any QIO's. This makes it unnecessary ! for TERM_CONNECT to cancel the QIO's, and avoids problems ! with DECnet remote terminals. ! ! 3.1.055 By: Nick Bush On: 27-August-1984 ! Clear out FILE_SIZE before processing a RECEIVE command to ! ensure that KERMSG doesn't perform a GET. ! ! 3.1.056 By: Nick Bush On: 28-August-1984 ! Add a TAKE (or @) command. Also perform an initialization ! file on startup. This file is either VMSKERMIT.INI or ! whatever file is pointed to by the logical name VMSKERMIT. ! ! 3.1.057 By: Nick Bush On: 21-Feb-1985 ! Determine VMS version on startup and remember for later ! use. Use it in KERSYS to determine whether we will need ! to force an end-of-file on the mailbox when the subprocess ! on the other end goes away. ! ! 3.1.060 By: Nick Bush On: 16-March-1985 ! Increase size of terminal name buffers to account for large ! unit numbers (most likely seen with VTA's). ! ! 3.1.061 By: Nick Bush On: 16-March-1985 ! Only attempt to set parity back when closing terminal. ! ! 3.1.062 By: Nick Bush On: 16-March-1985 ! Previous edit broke remote commands - must post QIO's ! when opening terminals for these. ! ! 3.1.063 By: Nick Bush On: 16-March-1985 ! Fix status command to output right headers over data. ! ! 3.1.064 By: Nick Bush On: 30-March-1985 ! Fix LIB$SPAWN call to set SYS$INPUT for the subprocess ! to be NLA0: so that it doesn't try to input from the ! terminal. ! ! 3.1.065 By: Nick Bush On: 10-April-1985 ! Split IBM handshaking from parity and local echo. Allow ! link time setting of IBM_MODE defaults by defining symbols: ! ! IBM_MODE_CHARACTER = character value of handshake character ! IBM_MODE_ECHO = 1 for local echo, 2 for no local echo ! IBM_MODE_PARITY = (0 = none), (1 = mark), (2 = even), ! (3 = odd), (4 = space). ! ! If not specified, Kermit will continue to use DC1, local echo ! and odd parity for IBM_MODE. ! ! 3.1.066 By: Nick Bush On: 22-April-1985 ! Don't use NLA0: as SYS$INPUT when spawning things under VMS 3. ! ! ! Start version 3.2 on 8-May-1985 ! ! 3.2.067 By: Robert McQueen On: 8-May-1985 ! Use $GETJPIW and $GETDVIW instead of $GETJPI and $GETDVI. ! Module: KERTRM, KERFIL ! ! 3.2.070 By: Robert McQueen On: 17-Dec-1985 ! Fix a problem with CRC calculations when 8 bit data and not ! 8 bit quoting. ! ! 3.2.071 By: Robert McQueen On: 11-March-1986 ! Fix a problem were KERMSG didn't allow for a line termination ! character in the buffer. ! ! 3.2.072 By: Robert McQueen On: 11-March-1986 ! Allow 0 as a valid value for SET SEND PADDING command. ! ! 3.2.073 By: Robert McQueen On: 11-March-1986 ! Fix a problem restoring the terminal characteristics under ! VMS 4.x ! ! 3.2.074 By: Robert McQueen On: 11-March-1986 ! Put MAX_MSG back the way it was and fix the problem correctly ! in KERMSG. ! ! 3.2.075 By: Robert McQueen On: 8-April-1986 ! Change how the FINISH command works. Cause it to go back to ! the Kermit-32 prompt, not exit. ! ! 3.2.076 By: Robert McQueen On: 17-April-1986 ! Set PASSTHRU in addition to everything else we change in VMSTRM. ! ! 3.2.077 By: Robert McQueen On: 8-May-1986 ! FIX FORTRAN CC!! (Once and for all I hope) ! ! 3.2.100 By: Gregory P. Welsh On: 1-June-1986 ! Add TRANSMIT command along with set SET/SHOW TRANSMIT ECHO ! and DELAY commands. ! ! Start of version 3.3 ! ! 3.3.101 By: Robert C. McQueen On: 2-July-1986 ! Change $TRNLOG system service calls to LIB$SYS_TRNLOG library ! routine. Handle no translation properly in VMSTRM.BLI. ! ! 3.3.102 By: Robert McQueen On: 5-July-1986 ! Add changes/fixes suggested by Art Guion and David Deley for ! VMSTRM.BLI ! - Turn off FALLBACK terminal characteristics for eightbit ! operations. ! - Decrease IBM timeouts when waiting for a handshake. ! ! 3.3.103 By: Robert McQueen On: 5-July-1986 ! Add changes/fixes suggested by David Deley for VMSMIT.BLI ! - Problem with an infinite loop getting a command. ! ! 3.3.104 By: Robert McQueen On: 5-July-1986 ! Add changes/fixes suggested by Art Guion and David Deley for ! KERMSG.BLI. ! - Always attempt a handshake in IBM mode. Failing to handshake ! may cause 3704/5 style controller to hang a VM system. ! - Don't lose the last character in a buffer. BFR_FILL logic ! forgets to send the last cahracters of a file when it doesn't ! fit into the current packet. ! ! 3.3.105 By: Robert McQueen On: 8-July-1986 ! Attempt to fix the truncation errors that we now get from ! LINK with BLISS-32 v4.2. Also do code clean up in VMSTRM and ! VMSFIL. ! ! 3.3.106 By: Robert McQueen On: 8-July-1986 ! Fix problem of closing a fixed file and losing data. ! ! 3.3.107 By: Antonino N. Mione On: 8-Sep-1986 ! Do not abort on ERROR packet while in SERVER mode. Instead, ! return to SERVER IDLE mode. ! ! 3.3.110 By: Antonino N. Mione On: 8-Sep-1986 ! Make KERMIT-32 close the terminal (so the terminal ! parameters are appropriately reset) upon reciept of ! a GENERIC LOGOUT packet. ! ! 3.3.111 By: Robert McQueen On: 2-Oct-1986 ! Make Kermit-32 not eat the parity from a CR if a LF doesn't ! follow it when writing an ASCII file. ! ! 3.3.112 JHW0001 Jonathan H. Welch, 28-Apr-1988 12:11 ! Fix the message generated in NEXT_FILE so that the ! filenames displayed (i.e. Sending: foo.bar;1 as foo.bar) ! are always terminated by a null (ASCIZ). ! ! 3.3.113 JHW0002 Jonathan H. Welch, 5-May-1988 11:48 ! Modified SY_TIME to use $GETTIM as opposed to the LIB$timer ! routines (which broke when their method of calculating ! time differences changed in V4.4?). ! ! Removed the call to LIB$INIT_TIMER in SY_INIT. ! ! 3.3.114 JHW003 Jonathan H. Welch, 6-May-1988 9:41 ! Modified MAIN_ROUTINE to return the status code from ! COMND when exiting. ! ! Note: The error message codes returned are internal ! Kermit-32 error codes. ! ! 3.3.115 JHW004 Jonathan H. Welch, 9-May-1988 ! Added the ability to send a break character to ! the outgoing terminal session using the sequence ! esc-chr B. The break will be sent after the next ! character arrives. This is because there must be ! no outstanding I/O on a channel in order to modify ! terminal characteristics (necessary to send a break). ! ! 3.3.116 JHW005 Jonathan H. Welch, 12-May-1988 8:35 ! Modified COMND_HELP to look for the kermit help ! file called KERMIT_HELP or pointed to by the logical ! name KERMIT_HELP. Thus if a user wants to have the ! kermit help file in a directory other than SYS$HELP ! it is not necessary to define the logical name KERMIT ! (which causes problems: i.e. RUN KERMIT will fail). ! ! 3.3.117 JHW006 Jonathan H. Welch, 12-May-1988 ! Calls to LIB$SIGNAL with multiple arguments were ! not coded correctly. For calls with multiple arguments ! an argument count was added. ! Minor changes to KERM_HANDLER to make use of the changed ! argument passing method. ! ! 3.3.118 By: Burt Johnson On: 1-Feb-1990 ! Added support for Extended Length packets; ! ! 3.3.119 JHW007 Jonathan H. Welch, 4-Apr-1990 7:47 ! Modified Final_Status to have an initial value of SS$_NORMAL. ! Previously, if all kermit operations were successful a ! return status of 0 was generated. ! ! Added a compile-time test for BLISS32 systems in the three ! generic bliss files (GLB, MSG, TT) which didn't have this ! declaration so that references to data use longword offsets. ! Burt Johnson's solution (PSECT PLIT = $CODE$) was generating ! many link-time errors. ! ! 3.3.120 JHW008 Jonathan H. Welch, 5-Apr-1990 10:57 ! Modified the call to NORMALIZE_FILE in routine REC_FILE ! to adjust file name and type lengths downwards to 39 ! characters each as opposed to the pre-VMS 4 format of ! 9 for the name and 3 for the type. ! ! 3.3.121 JHW009 Jonathan H. Welch, 12-Apr-1990 12:20 ! Added and modified routines in vmstrm.bli to notify the ! user if SS$_HANGUP occurs on the outgoing terminal line. ! If the outgoing line is serviced by a decserver (LTA type ! terminal) the user must issue a CONNECT LTAnnn command ! to reestablish a LAT link to the decserver. ! ! 3.3.122 JHW010 Jonathan H. Welch, 23-Apr-1990 09:42 ! Added SET FILE BLOCKSIZE nnn (where nnn is the record size ! in bytes) command for incoming BINARY and FIXED file transfers. ! If no blocksize has been specified the old behavior (510 byte ! records plus 2 bytes (for CR/LF) for BINARY files and 512 ! byte records for FIXED files will be used. ! Also modified SHOW FILE to display record size when appropriate. ! ! 3.3.123 JHW011 Jonathan H. Welch, 17-May-1990 9:06 ! Modified a miscoded call to send_packet in routine ! send_gencmd to correctly specify the length of the ! response packet to transmit. This miscoding only ! affected long packet support, in particular, when ! GETting files standard length packets were being used ! when long packet support was available in both kermit ! programs. ! ! 3.3.124 JHW012 Jonathan H. Welch, 18-May-1990 7:56 ! Modified asn_wth_mbx to obtain the master PID in the ! process tree before asking for JPI$_TERMINAL. $GETJPI ! was returning a null string for this item when called ! from a subprocess resulting in a "No default terminal ! line for transfers" message. ! ! 3.3.125 JHW013 Jonathan H. Welch, 18-May-1990 13:00 ! Extended the buffer size for terminal names from 20 ! characters to 255 to make sure any terminal name can ! be accomodated. ! ! 3.3.126 JHW014 Jonathan H. Welch, 5-Jun-1990 12:38 ! Modified asn_wth_mbx to add a ':' to the end of the ! terminal name is one is not returned by VMS. ! This will keep LIB$GETDVI from failing with an ! "invalid device name" which results in the kermit ! error "no default terminal line for transfers." ! ! 3.3.127 JHW015 Jonathan H. Welch, 16-Jul-1990 15:30 ! Fixed the logic in GET_ASCII which was causing an infinite ! loop for files with print file carriage control. ! ! 3.3.128 JHW016 Jonathan H. Welch, 17-Oct-1990 9:42 ! Modified asn_wth_mbx to work properly in non-interactive mode. !-- %SBTTL 'Routine definitions -- Forwards' ! ! ! Forward definitions ! ! Command processing routines FORWARD ROUTINE COMND, ! Process a command COMND_ERROR : NOVALUE, ! Give error for command COMND_FILE, ! Process command file DO_COMND, ! Parse and dispatch one command COMND_HELP : NOVALUE, ! Process the HELP command COMND_SHOW : NOVALUE, ! Process the SHOW command COMND_STATUS : NOVALUE, ! Process the STATUS command COMND_REMOTE : NOVALUE, ! Process the REMOTE command COMND_LOCAL : NOVALUE, ! Process the LOCAL commands GET_REM_ARGS, ! Get arguments for REMOTE/LOCAL commands STORE_TEXT, ! Routine to store a file name COPY_TERM_NAME, ! Copy device name (TERM_xxxx) COPY_DESC, ! Copy file name (FILE_xxx) COPY_ALT_FILE, ! Copy to alternate file name (ALT_FILE_xxx) COPY_GEN_1DATA, ! Copy to GEN_1DATA (generic command argument) STORE_BLOCKSIZE, ! Store the blocksize value STORE_DEBUG, ! Store the debuging flag STORE_TR_ECHO, ! Store the transmit echo flag [078] STORE_TR_DELAY, ! Store the transmit delay [078] STORE_FTP, ! Store the file type STORE_FNM, ! Store the file name form STORE_ECHO, ! Store the local echo flag STORE_PARITY, ! Store the parity type STORE_CHK, ! This routine will store the checksum type. STORE_ABT, ! This routine will store the aborted file disposition STORE_IBM, ! Store IBM flag STORE_MSG_FIL, ! Store TY_FIL STORE_MSG_PKT, ! Store TY_PKT CHECK_PACKET_LEN, ! Validate PACKET length given CHECK_NPAD, ! Validate the number of pad characters CHECK_PAD_CHAR, ! Validate the padding character being set CHECK_EOL, ! Validate EOL character given. CHECK_QUOTE, ! Validate quoting character CHECK_SOH, ! Validate the start of packet character given KEY_ERROR; ! Return correct keyword error value ! ! Error handling routines ! FORWARD ROUTINE KERM_HANDLER; ! Condition handler %SBTTL 'Include files' ! ! INCLUDE FILES: ! LIBRARY 'SYS$LIBRARY:STARLET'; LIBRARY 'SYS$LIBRARY:TPAMAC'; REQUIRE 'KERCOM'; ! Common definitions REQUIRE 'KERERR'; ! Error message symbol definitions %SBTTL 'Macro definitions' ! ! MACROS: ! MACRO TPARSE_ARGS = BUILTIN AP; MAP AP : REF BLOCK [,BYTE]; %; ! ! Macro to initialize a string descriptor ! MACRO INIT_STR_DESC (DESC, BUFFER, SIZE) = BEGIN ! MAP ! DESC : BLOCK [8, BYTE]; DESC [DSC$B_CLASS] = DSC$K_CLASS_S; DESC [DSC$B_DTYPE] = DSC$K_DTYPE_T; DESC [DSC$W_LENGTH] = SIZE; DESC [DSC$A_POINTER] = BUFFER; END %; %SBTTL 'Equated symbols -- Command types' ! ! EQUATED SYMBOLS: ! ! Command offsets LITERAL CMD_MIN = 1, ! Minimum value CMD_CONN = 1, ! Connect command CMD_EXIT = 2, ! Exit command CMD_HELP = 3, ! Help command CMD_RECEIVE = 4, ! Receive command CMD_SET = 5, ! Set command CMD_SEND = 6, ! Send command CMD_SHOW = 7, ! Show command CMD_SERVER = 8, ! SERVER command CMD_STATUS = 9, ! STATUS command CMD_LOGOUT = 10, ! Generic LOGOUT command CMD_BYE = 11, ! Generic LOGOUT command and EXIT CMD_FINISH = 12, ! Generic EXIT command CMD_GET = 13, ! Get command CMD_REMOTE = 14, ! Remote command CMD_LOCAL = 15, ! Local command CMD_PUSH = 16, ! PUSH command (spawn new DCL) CMD_NULL = 17, ! Any command which is done ! totally by the LIB$TPARSE call CMD_TAKE = 18, ! Take command CMD_TRANSMIT = 19, ! Transmit command [078] CMD_MAX = 19; ! Maximum command value [078] ! Items to show LITERAL SHOW_ALL = 1, ! Show everything SHOW_DEB = 2, ! Show debugging flag SHOW_DEL = 3, ! Show delay SHOW_ESC = 4, ! Show ESCAPE character SHOW_TIM = 5, ! Show random timing SHOW_LIN = 6, ! Show the line we are using SHOW_ECH = 7, ! Show the echo flag SHOW_SEN = 8, ! Show send parameters SHOW_REC = 9, ! Show the receive parameters SHOW_PAR = 10, ! Show the parity setting SHOW_RTY = 11, ! Show retry counters SHOW_CHK = 12, ! Show block-check-type SHOW_ABT = 13, ! Show aborted file disposition SHOW_FIL = 14, ! Show file parameters SHOW_PAC = 15, ! Show packet parameters SHOW_COM = 16, ! Show communications parameters SHOW_VER = 17, ! Show version SHOW_TRN = 18; ! Show transmit delay and echo %SBTTL 'Equated symbols -- Constants' ! Constants LITERAL CMD_BFR_LENGTH = 132, ! Command buffer length OUT_BFR_LENGTH = 80, ! Output buffer length (SHOW cmd) HELP_LENGTH = 132, ! Length of the help buffer TEMP_LENGTH = 132; ! Length of the temporary area ! ! The default prompt ! BIND DEFAULT_PROMPT = %ASCID'Kermit-32>'; MAP DEFAULT_PROMPT : BLOCK [8, BYTE]; ! This is a descriptor %SBTTL 'Storage -- Global' ! ! ! GLOBAL STORAGE: ! GLOBAL TRANSACTION_DESC : BLOCK [8, BYTE], ! Descriptor for transaction log file TRANSACTION_OPEN, ! File open flag TRANSACTION_FAB : $FAB_DECL, ! Transaction file FAB TRANSACTION_RAB : $RAB_DECL, ! Transaction file RAB ESCAPE_CHR, ! Escape character for CONNECT ALT_FILE_SIZE, ! Number of characters in FILE_NAME ALT_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)]; ! Storage %SBTTL 'Storage -- Local' ! ! OWN STORAGE: ! OWN ! Command scanning information TPARSE_BLOCK : BLOCK [TPA$K_LENGTH0, BYTE] INITIAL (TPA$K_COUNT0, ! Longword count TPA$M_ABBREV), ! Allow abbreviations BAD_CMD_DESC : BLOCK [8, BYTE], ! Descriptor for bad command field COMMAND, ! Type of command we are doing SHOW_TYPE, ! Type of show command REM_TYPE, ! Type of REMOTE command TAKE_DISPLAY, ! Display commands being TAKEn ! ! Output data area ! OUTPUT_LINE : VECTOR [OUT_BFR_LENGTH, BYTE, UNSIGNED], OUTPUT_DESC : BLOCK [8, BYTE], OUTPUT_SIZE : WORD UNSIGNED, ! Misc constants. Final_Status : LONG UNSIGNED INITIAL(SS$_NORMAL), ! Status from within condition handler routine. TRANSACTION_NAME : VECTOR [CH$ALLOCATION(MAX_FILE_NAME)], PROMPT_DESC : BLOCK [8, BYTE], ! Descriptor for prompt PROMPT_TEXT : VECTOR [CH$ALLOCATION(TEMP_LENGTH)], ! Storage for prompt CRC_TABLE : BLOCK [16, LONG], ! CRC-CCITT table TAK_FIL_DESC : BLOCK [8, BYTE], ! Take file descriptor TAK_FIL_NAME : BLOCK [CH$ALLOCATION(MAX_FILE_NAME)], TEMP_DESC : BLOCK [8, BYTE], ! Temporary descriptor TEMP_NAME : VECTOR [CH$ALLOCATION(TEMP_LENGTH)]; ! %SBTTL 'External routines' ! ! EXTERNAL REFERENCES: ! EXTERNAL ROUTINE ! ! Library routines ! LIB$GET_INPUT : ADDRESSING_MODE (GENERAL), LIB$PUT_OUTPUT : ADDRESSING_MODE (GENERAL), LIB$TPARSE : ADDRESSING_MODE (GENERAL), LIB$CRC_TABLE : ADDRESSING_MODE (GENERAL), LIB$CRC : ADDRESSING_MODE (GENERAL), LIB$SIGNAL : ADDRESSING_MODE (GENERAL) NOVALUE, LIB$ESTABLISH : ADDRESSING_MODE (GENERAL), LIB$ATTACH : ADDRESSING_MODE (GENERAL), LIB$SPAWN : ADDRESSING_MODE (GENERAL), ! ! KERMSG - KERMIT Message processing routines ! SEND_SWITCH, ! Send a file REC_SWITCH, ! Receive a file DO_GENERIC, ! Send generic functions SERVER, ! Server mode processing SND_ERROR : NOVALUE, ! Send E packet to remote MSG_INIT : NOVALUE, ! Initialization routine ! ! KERFIL - File processing. ! FILE_INIT : NOVALUE, ! Initialization routine ! ! KERSYS - System subroutines for KERMSG ! SY_INIT : NOVALUE, ! Initialization routine ! ! KERTRM - Terminal processing. ! TERM_INIT : NOVALUE, ! Initialize the terminal processing TERM_OPEN, ! Open the terminal line TERM_CLOSE, ! Close the terminal line TERM_CONNECT, ! Impliments CONNECT command SET_TRANS_TERM, ! Set new transfer terminal COMND_TRANSMIT, ! Transmit command code in module KERTRM ! ! KERTT - Text processing ! TT_INIT : NOVALUE, ! Initialization routine TT_TEXT : NOVALUE, ! Output a text string TT_NUMBER : NOVALUE, ! Output a number TT_CHAR : NOVALUE, ! Output a single character TT_OUTPUT : NOVALUE, ! Routine to dump the current ! text line. TT_CRLF : NOVALUE; ! Output the line %SBTTL 'External storage' ! ! EXTERNAL Storage: ! EXTERNAL ! ! KERMSG storage ! ! Receive parameters RCV_PKT_SIZE, ! Receive packet size RCV_NPAD, ! Padding length RCV_PADCHAR, ! Padding character RCV_TIMEOUT, ! Time out RCV_EOL, ! EOL character RCV_QUOTE_CHR, ! Quote character RCV_8QUOTE_CHR, ! 8-bit quoting character RCV_SOH, ! Start of packet header ! ! Send parameters ! SND_PKT_SIZE, ! Send packet size SND_NPAD, ! Padding length SND_PADCHAR, ! Padding character SND_TIMEOUT, ! Time out SND_EOL, ! EOL character SND_QUOTE_CHR, ! Quote character SND_SOH, ! Packet start of header ! ! Server parameters ! SRV_TIMEOUT, ! Time between idle naks in server ! ! Misc. packet parameters ! SET_REPT_CHR, ! Desired repeat character ! ! Statistics ! SND_TOTAL_CHARS, ! Total characters sent RCV_TOTAL_CHARS, ! Total characters received SND_DATA_CHARS, ! Total number of data characters sent RCV_DATA_CHARS, ! Total number of data characters received SMSG_TOTAL_CHARS, ! Total chars sent this file xfer RMSG_TOTAL_CHARS, ! Total chars rcvd this file xfer SMSG_DATA_CHARS, ! Total data chars this file xfer RMSG_DATA_CHARS, ! Total data chars this file xfer RCV_NAKS, ! Total number of NAKs received SND_NAKS, ! Total number of NAKs sent RMSG_NAKS, ! Number of NAKs received SMSG_NAKS, ! Number of NAKs sent RCV_COUNT, ! Total number of packets received SND_COUNT, ! Total number of packets sent RMSG_COUNT, ! Number of packets received SMSG_COUNT, ! Number of packets sent XFR_TIME, ! Amount of time the last transfer took TOTAL_TIME, ! Total time the transfers have taken LAST_ERROR : VECTOR [CH$ALLOCATION (MAX_MSG + 1)], ! Last error message TY_PKT, ! Flag that packet numbers should be typed TY_FIL, ! Flag that file names should be typed GEN_1DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Data for generic command GEN_1SIZE, ! Size of data in GEN_1DATA GEN_2DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Second argument for generic command GEN_2SIZE, ! Size of data in GEN_2DATA GEN_3DATA : VECTOR [CH$ALLOCATION (MAX_MSG)], ! Third arg for generic command GEN_3SIZE, ! Size of data in GEN_3DATA ! ! Misc constants. ! FILE_SIZE, ! Number of characters in FILE_NAME FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], SI_RETRIES, ! Initial connection max retries PKT_RETRIES, ! Packet max retries DELAY, ! Amount of time to delay DEBUG_FLAG, ! Debugging mode on/off CHKTYPE, ! Type of block-check-type wanted ABT_FLAG, ! Aborted file disposition ! IBM_FLAG, ! IBM mode flag IBM_CHAR, ! Handshaking character WARN_FLAG, ! File warning flag FIL_NORMAL_FORM, ! File name type to send PARITY_TYPE, ! Type of parity we are using ECHO_FLAG, ! Local echo flag CONNECT_FLAG; ! True if SYS$OUTPUT and line ! xfering over are the same. ! ! KERFIL storage ! EXTERNAL file_blocksize, ! Blocksize for FIXED files file_blocksize_set, ! Flag indicating a blocksize has been specified by the user. FILE_TYPE, ! Type of file being processed FILE_DESC : BLOCK [8, BYTE]; ! Descriptor for the file name ! ! KERTRM storage ! EXTERNAL SESSION_DESC : BLOCK [8, BYTE], ! Session log file name DEBUG_DESC : BLOCK [8, BYTE], ! Debugging log file name TERM_DESC : BLOCK [8, BYTE], ! Terminal name descriptor TRANS_ECHO_FLAG, ! Transmit echo on/off TRANS_DELAY, ! Transmit delay TERM_FLAG; ! Terminal open flag %SBTTL 'Command parsing tables' ! !++ ! !The following are the command state tables for the KERMIT-32 !command processing. ! !-- $INIT_STATE (KERMIT_STATE, KERMIT_KEY); $STATE (START, ('BYE', DONE_STATE, , CMD_BYE, COMMAND), ('CONNECT', CONN_STATE, , CMD_CONN, COMMAND), ('EXIT', DONE_STATE, , CMD_EXIT, COMMAND), ('FINISH', DONE_STATE, , CMD_FINISH, COMMAND), ('GET', GET_STATE, , CMD_GET, COMMAND), ('HELP', HELP_STATE, , CMD_HELP, COMMAND), ('LOCAL', REM_STATE, , CMD_LOCAL, COMMAND), ('LOG', LOG_STATE, , CMD_NULL, COMMAND), ('LOGOUT', DONE_STATE, , CMD_LOGOUT, COMMAND), ('PUSH', DONE_STATE, , CMD_PUSH, COMMAND), ('QUIT', DONE_STATE, , CMD_EXIT, COMMAND), ('RECEIVE', REC_STATE, , CMD_RECEIVE, COMMAND), ('REMOTE', REM_STATE, , CMD_REMOTE, COMMAND), ('SET', SET_STATE, , CMD_SET, COMMAND), ('SEND', SEND_STATE, , CMD_SEND, COMMAND), ('SERVER', DONE_STATE, , CMD_SERVER, COMMAND), ('SHOW', SHOW_STATE, , CMD_SHOW, COMMAND), ('STATUS', DONE_STATE, , CMD_STATUS, COMMAND), ('TAKE', TAKE_STATE, , CMD_TAKE, COMMAND), ('@', TAKE_STATE, , CMD_TAKE, COMMAND), ('TRANSMIT', TRANSMIT_STATE, , CMD_TRANSMIT, COMMAND), ! (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! CONNECT command. Format is: ! ! Kermit-32>CONNECT device ! ! Where: ! Device - Terminal line to connect to ! !-- $STATE (CONN_STATE, (TPA$_EOS, DONE_STATE), (TPA$_LAMBDA, SET_LIN_STATE) ) !++ ! EXIT command. Format is: ! ! Kermit-32>EXIT ! ! Just exit back to VMS. ! !-- !++ ! HELP command. Format is: ! ! Kermit-32>HELP ! ! Do HELP processing for KERMIT-32. ! !-- $STATE (HELP_STATE, (TPA$_ANY, HELP_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE) ) %SBTTL 'QUIT command table' !++ ! QUIT command. Format is: ! ! Kermit-32>QUIT ! ! This command will just exit back to VMS. ! !-- %SBTTL 'GET command table' !++ ! GET command. Format is: ! ! Kermit-32>GET file-specification ! ! This command will cause KERMIT to get a file from the micro. ! It will assume that it is to used what ever line it currently is ! associated with (CONNECT or SET LINE). ! !-- $STATE (GET_STATE, (TPA$_ANY, GET_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_DESC, , ,FILE_DESC) ) %SBTTL 'RECEIVE command table' !++ ! RECEIVE command. Format is: ! ! Kermit-32>RECEIVE file-specification ! ! This command will cause KERMIT to receive a file from the micro. ! It will assume that it is to used what ever line it currently is ! associated with (CONNECT or SET LINE). ! !-- $STATE (REC_STATE, (TPA$_ANY, REC1_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE) ) $STATE (REC1_STATE, (TPA$_ANY, REC1_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_ALT_FILE) ) %SBTTL 'REMOTE command tables' !++ ! REMOTE command. This command will allow the local Kermit user to ! request the server Kermit to perform some action. ! ! Kermit-32>REMOTE keyword arguments ! ! Where: ! ! Keyword is one of: ! DELETE ! DIRECTORY ! DISK_USAGE ! HELP ! SPACE ! TYPE !-- $STATE (REM_STATE, ('COPY', REM2_STATE, ,GC_COPY, REM_TYPE), ('CWD', REM1_STATE, ,GC_CONNECT, REM_TYPE), ('DELETE', REM2_STATE, ,GC_DELETE, REM_TYPE), ('DIRECTORY', REM1_STATE, ,GC_DIRECTORY, REM_TYPE), ('DISK_USAGE', REM1_STATE, ,GC_DISK_USAGE, REM_TYPE), ('EXIT', DONE_STATE, ,GC_EXIT, REM_TYPE), ('HELP', REM1_STATE, ,GC_HELP, REM_TYPE), ('HOST', REM2_STATE, ,GC_COMMAND, REM_TYPE), ('LOGIN', REM2_STATE, ,GC_LGN, REM_TYPE), ('LOGOUT', DONE_STATE, ,GC_LOGOUT, REM_TYPE), ('RENAME', REM2_STATE, ,GC_RENAME, REM_TYPE), ('SEND_MESSAGE',REM2_STATE, ,GC_SEND_MSG, REM_TYPE), ('SPACE', REM1_STATE, ,GC_DISK_USAGE, REM_TYPE), ('STATUS', DONE_STATE, ,GC_STATUS, REM_TYPE), ('TYPE', REM2_STATE, ,GC_TYPE, REM_TYPE), ('WHO', REM1_STATE, ,GC_WHO, REM_TYPE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) ! State to allow for either no arguments or a text string $STATE (REM1_STATE, (TPA$_ANY, REM2_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE) ) ! State to require a text string argument $STATE (REM2_STATE, (TPA$_ANY, REM2_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_GEN_1DATA) ) %SBTTL 'SET command tables' !++ ! SET command. Format is: ! ! Kermit-32>SET parameter ! ! Where: ! Parameter - One of many keywords ! !-- $STATE (SET_STATE, ('BLOCK_CHECK_TYPE', SET_CHK_STATE), ('DEBUGGING', SET_DEB_STATE), ('DELAY', SET_DEL_STATE), ('ESCAPE', SET_ESC_STATE), ('FILE', SET_FIL_STATE), ('HANDSHAKE', SET_HAN_STATE), ('IBM_MODE', SET_IBM_STATE), ('INCOMPLETE_FILE_DISPOSITION', SET_ABT_STATE), ('LINE', SET_LIN_STATE), ('LOCAL_ECHO', SET_ECH_STATE), ('MESSAGE', SET_MSG_STATE), ('PARITY', SET_PAR_STATE), ('PROMPT', SET_PMT_STATE), ('RECEIVE', SET_REC_STATE), ('REPEAT_QUOTE',SET_RPT_STATE), ('RETRY', SET_RTY_STATE), ('SEND', SET_SND_STATE), ('SERVER_TIMER',SET_SRV_STATE), ('TRANSMIT', SET_TRN_STATE), ! (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET INCOMPLETE_FILE [disposition] command. The possible arguments are ! KEEP or DISCARD. ! !-- $STATE (SET_ABT_STATE, ('DISCARD', DONE_STATE, STORE_ABT,, ,TRUE), ('KEEP', DONE_STATE, STORE_ABT,, ,FALSE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET BLOCK_CHECK_TYPE [type] command. The format is: ! ! Kermit-32>SET BLOCK_CHECK_TYPE [1_CHARACTER_CHECKSUM | ....] ! !-- $STATE (SET_CHK_STATE, ('1_CHARACTER_CHECKSUM', DONE_STATE, STORE_CHK,, ,CHK_1CHAR), ('2_CHARACTER_CHECKSUM', DONE_STATE, STORE_CHK,, ,CHK_2CHAR), ('3_CHARACTER_CRC_CCITT', DONE_STATE, STORE_CHK,, ,CHK_CRC), ('ONE_CHARACTER_CHECKSUM', DONE_STATE, STORE_CHK,, ,CHK_1CHAR), ('THREE_CHARACTER_CRC_CCITT', DONE_STATE, STORE_CHK,, ,CHK_CRC), ('TWO_CHARACTER_CHECKSUM', DONE_STATE, STORE_CHK,, ,CHK_2CHAR), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET DEBUGGING command. The format is: ! ! Kermit-32>SET DEBUGGING (on/off) ! ! Where: ! on/off is either the ON or OFF keyword. ! !-- $STATE (SET_DEB_STATE, ('OFF', DONE_STATE, STORE_DEBUG, , ,FALSE), ('ON', DONE_STATE, STORE_DEBUG, , ,TRUE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET IBM_MODE command. The format is: ! ! Kermit-32>SET IBM_MODE (on/off) ! ! Where: ! on/off is either the ON or OFF keyword. ! !-- $STATE (SET_IBM_STATE, ('OFF', DONE_STATE, STORE_IBM, , ,FALSE), ('ON', DONE_STATE, STORE_IBM, , ,TRUE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET HANDSHAKE command. The format is: ! ! Kermit-32>SET HANDSHAKE ! ! Where: ! is the octal number representing the handshake character ! for file transfers. ! ! Negative values indicate no handshaking. !-- $STATE (SET_HAN_STATE, ('NONE', DONE_STATE, , -1 ,IBM_CHAR), (TPA$_OCTAL, DONE_STATE, , ,IBM_CHAR) ) !++ ! ! SET DELAY command. The format is: ! ! Kermit-32>SET DELAY ! ! Where: ! is the number of seconds to delay before sending the ! SEND-INIT packet. !-- $STATE (SET_DEL_STATE, (TPA$_DECIMAL, DONE_STATE, , ,DELAY) ) !++ ! ! SET FILE BLOCKSIZE command. The format is: ! ! Kermit-32>SET FILE BLOCKSIZE ! ! Where: ! is the number of bytes per fixed-length record for BINARY ! and FIXED files. !-- $STATE (SET_BLK_STATE, (TPA$_DECIMAL, DONE_STATE, store_blocksize, , file_blocksize) ) !++ ! ! SET ESCAPE command. The format is: ! ! Kermit-32>SET ESCAPE ! ! Where: ! is the octal number representing the escape character ! for the CONNECT command processing. The default escape character ! is Control-]. !-- $STATE (SET_ESC_STATE, (TPA$_OCTAL, DONE_STATE, , ,ESCAPE_CHR) ) !++ ! ! SET FILE xxx command. The format is: ! ! Kermit-32>SET FILE ! ! Where: ! is one of: ! NAMING - Type of file name to send ! TYPE - Type of file to create on receive (or send in certain cases) ! BLOCKSIZE - Size of blocks (in bytes) for (FIXED and BINARY ! type) output files. ! !-- $STATE (SET_FIL_STATE, ('NAMING', SET_FNM_STATE), ('TYPE', SET_FTP_STATE), ('BLOCKSIZE', SET_BLK_STATE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET FILE NAMING command. The format is: ! ! Kermit-32>SET FILE NAMING ! ! Where: ! is one of: ! FULL - Send complete file specification, including device and ! directory ! NORMAL_FORM - Send only name.type ! UNTRANSLATED - Send name.type, but don't do any fixups on it !-- $STATE (SET_FNM_STATE, ('FULL', DONE_STATE, STORE_FNM, , ,FNM_FULL), ('NORMAL_FORM', DONE_STATE, STORE_FNM, , ,FNM_NORMAL), ('UNTRANSLATED',DONE_STATE, STORE_FNM, , ,FNM_UNTRAN), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET FILE TYPE command. The format is: ! ! Kermit-32>SET FILE TYPE ! ! Where: ! is one of the following: ! ASCII - Normal ASCII file (stream ascii) ! BINARY - Micro binary file. !-- $STATE (SET_FTP_STATE, ('ASCII', DONE_STATE, STORE_FTP, , ,FILE_ASC), ('BINARY', DONE_STATE, STORE_FTP, , ,FILE_BIN), ('BLOCK', DONE_STATE, STORE_FTP, , ,FILE_BLK), ('FIXED', DONE_STATE, STORE_FTP, , ,FILE_FIX), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! SET LINE command. Format is: ! ! Kermit-32>SET LINE terminal-device: ! ! Where: ! Terminal-device: is the terminal line to use to the transfer of ! the data and to use in the CONNECT command. ! !-- $STATE (SET_LIN_STATE, (TPA$_ANY, SET_LIN_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_TERM_NAME) ) !++ ! SET LOCAL-ECHO command. Format is: ! ! Kermit-32>SET LOCAL-ECHO state ! ! Where: ! STATE is either the keyword ON or OFF. ! !- $STATE (SET_ECH_STATE, ('OFF', DONE_STATE, STORE_ECHO, , ,FALSE), ('ON', DONE_STATE, STORE_ECHO, , ,TRUE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! SET MESSAGE command. Format is: ! ! Kermit-32>SET MESSAGE ! ! Where the keyword is: ! ! FILE_NAMES - Type out file names being transferred ! PACKET_NUMBERS - Type out packet counts !-- $STATE (SET_MSG_STATE, ('FILE_NAMES', SET_MSG_FIL_STATE), ('PACKET_NUMBERS', SET_MSG_PKT_STATE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) $STATE (SET_MSG_FIL_STATE, ('OFF', DONE_STATE, STORE_MSG_FIL, , ,FALSE), ('ON', DONE_STATE, STORE_MSG_FIL, , ,TRUE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) $STATE (SET_MSG_PKT_STATE, ('OFF', DONE_STATE, STORE_MSG_PKT, , ,FALSE), ('ON', DONE_STATE, STORE_MSG_PKT, , ,TRUE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! SET PROMPT command. ! ! Kermit-32>SET PROMPT new-prompt-text ! !-- $STATE (SET_PMT_STATE, (TPA$_ANY, SET_PMT_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_DESC, , ,PROMPT_DESC) ) !++ ! SET REPEAT_QUOTE command. Format is: ! ! Kermit-32>SET REPEAT_QUOTE ! !-- $STATE (SET_RPT_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_QUOTE, ,SET_REPT_CHR) ) !++ ! SET RETRY command. Format is: ! ! Kermit-32>SET RETRY ! ! Where the keyword is: ! ! INITIAL_CONNECTION - set number of initial connection retries. ! PACKET - set the number of packet retries. !-- $STATE (SET_RTY_STATE, ('INITIAL_CONNECTION', SET_RTY_INI_STATE), ('PACKET', SET_RTY_PKT_STATE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) $STATE (SET_RTY_INI_STATE, (TPA$_DECIMAL, DONE_STATE, , ,SI_RETRIES) ) $STATE (SET_RTY_PKT_STATE, (TPA$_DECIMAL, DONE_STATE, , ,PKT_RETRIES) ) %SBTTL 'SET PARITY type' !++ ! SET PARITY command. Format is: ! ! Kermit-32>SET PARITY type ! ! The type can be: ! ! NONE - No parity processing ! MARK - Mark parity ! SPACE - Space parity ! EVEN - Even parity ! ODD - Odd parity ! !-- $STATE (SET_PAR_STATE, ('EVEN', DONE_STATE, STORE_PARITY, , ,PR_EVEN), ('MARK', DONE_STATE, STORE_PARITY, , ,PR_MARK), ('NONE', DONE_STATE, STORE_PARITY, , ,PR_NONE), ('ODD', DONE_STATE, STORE_PARITY, , ,PR_ODD), ('SPACE', DONE_STATE, STORE_PARITY, , ,PR_SPACE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) %SBTTL 'SET RECEIVE table' !++ ! SET RECEIVE command. Format is: ! ! Kermit-32>SET RECEIVE item ! ! Where: ! Item - One of the following: ! PACKET-LENGTH ! PADDING ! PADCHAR ! TIMEOUT ! END-OF-LINE ! QUOTE ! !-- $STATE (SET_REC_STATE, ('EIGHT-BIT-QUOTE', SR_8QU_STATE), ('END_OF_LINE', SR_EOL_STATE), ('PACKET_LENGTH', SR_PKT_STATE), ('PADCHAR', SR_PDC_STATE), ('PADDING', SR_PAD_STATE), ('QUOTE', SR_QUO_STATE), ('START_OF_PACKET', SR_SOH_STATE), ('TIMEOUT', SR_TIM_STATE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET RECEIVE PACKET-LENGTH command. Format is: ! ! Kermit-32>SET RECEIVE PACKET-LENGTH ! ! Where: ! is a decimal number that specifies the length of a ! receive packet. ! !-- $STATE (SR_PKT_STATE, (TPA$_DECIMAL, DONE_STATE, CHECK_PACKET_LEN, ,RCV_PKT_SIZE) ) !++ ! ! SET RECEIVE PADDING command. The format of this command is: ! ! Kermit-32>SET RECEIVE PADDING ! ! Where: ! is the decimal number of padding characters to output. ! !-- $STATE (SR_PAD_STATE, (TPA$_DECIMAL, DONE_STATE, CHECK_NPAD, ,RCV_NPAD) ) !++ ! ! SET RECEIVE PADCHAR command. Format is: ! ! Kermit-32>SET RECEIVE PADCHAR ! ! Where: ! is the octal representation of the padding character ! that is to be used. ! !-- $STATE (SR_PDC_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_PAD_CHAR, ,RCV_PADCHAR) ) !++ ! ! SET RECEIVE START_OF_PACKET command. Format is: ! ! Kermit-32>SET RECEIVE START_OF_PACKET ! ! Where: ! is the octal representation of the padding character ! that is to be used. ! !-- $STATE (SR_SOH_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_SOH, ,RCV_SOH) ) !++ ! ! SET RECEIVE TIMEOUT command. The format is: ! ! Kermit-32>SET RECEIVE TIMEOUT ! ! Where: ! is the number of seconds before KERMIT-32 should time out ! attempting to receive a correct message. ! !-- $STATE (SR_TIM_STATE, (TPA$_DECIMAL, DONE_STATE, , ,RCV_TIMEOUT) ) !++ ! SET END-OF-LINE command. Format is: ! ! Kermit-32>SET RECEIVE END-OF-LINE ! ! Where: ! is the octal number representation of the character ! that is the end of line character. ! !-- $STATE (SR_EOL_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_EOL, ,RCV_EOL) ) !++ ! SET RECEIVE QUOTE command. The format is: ! ! Kermit-32>SET RECEIVE QUOTE ! ! Where: ! is the octal number representing the quoting character. ! !-- $STATE (SR_QUO_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_QUOTE, ,RCV_QUOTE_CHR) ) %SBTTL 'SET RECEIVE EIGHT-BIT-QUOTE' !++ ! This routine will handle the setting of the eight bit quoting character. ! ! Kermit-32>SET RECEIVE EIGHT-BIT-QUOTE ! ! Where: ! is the octal number representing the quoting character. ! !-- $STATE (SR_8QU_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_QUOTE, ,RCV_8QUOTE_CHR) ) %SBTTL 'SET SEND tables' !++ ! SET SEND command. Format is: ! ! Kermit-32>SET SEND item ! ! Where: ! Item - One of the following: ! PACKET-LENGTH ! PADDING ! PADCHAR ! TIMEOUT ! END-OF-LINE ! QUOTE ! !-- $STATE (SET_SND_STATE, ('END_OF_LINE', SS_EOL_STATE), ('PACKET_LENGTH', SS_PKT_STATE), ('PADCHAR', SS_PDC_STATE), ('PADDING', SS_PAD_STATE), ('QUOTE', SS_QUO_STATE), ('START_OF_PACKET', SS_SOH_STATE), ('TIMEOUT', SS_TIM_STATE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) !++ ! ! SET SEND PACKET-LENGTH command. Format is: ! ! Kermit-32>SET SEND PACKET-LENGTH ! ! Where: ! is a decimal number that specifies the length of a ! receive packet. ! !-- $STATE (SS_PKT_STATE, (TPA$_DECIMAL, DONE_STATE, CHECK_PACKET_LEN, ,SND_PKT_SIZE) ) !++ ! ! SET SEND PADDING command. The format of this command is: ! ! Kermit-32>SET SEND PADDING ! ! Where: ! is the decimal number of padding characters to output. ! !-- $STATE (SS_PAD_STATE, (TPA$_DECIMAL, DONE_STATE, CHECK_NPAD, ,SND_NPAD) ) !++ ! ! SET SEND PADCHAR command. Format is: ! ! Kermit-32>SET SEND PADCHAR ! ! Where: ! is the octal representation of the padding character ! that is to be used. ! !-- $STATE (SS_PDC_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_PAD_CHAR, ,SND_PADCHAR) ) !++ ! ! SET RECEIVE START_OF_PACKET command. Format is: ! ! Kermit-32>SET RECEIVE START_OF_PACKET ! ! Where: ! is the octal representation of the padding character ! that is to be used. ! !-- $STATE (SS_SOH_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_SOH, ,SND_SOH) ) !++ ! ! SET SEND TIMEOUT command. The format is: ! ! Kermit-32>SET SEND TIMEOUT ! ! Where: ! is the number of seconds before KERMIT-32 should time out ! attempting to receive a correct message. ! !-- $STATE (SS_TIM_STATE, (TPA$_DECIMAL, DONE_STATE, , ,SND_TIMEOUT) ) !++ ! SET SEND END-OF-LINE command. Format is: ! ! Kermit-32>SET SEND END-OF-LINE ! ! Where: ! is the octal number representation of the character ! that is the end of line character. ! !-- $STATE (SS_EOL_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_EOL, ,SND_EOL) ) !++ ! SET SEND QUOTA command. The format is: ! ! Kermit-32>SET SEND QUOTA ! ! Where: ! is the octal number representing the quoting character. ! !-- $STATE (SS_QUO_STATE, (TPA$_OCTAL, DONE_STATE, CHECK_QUOTE, ,SND_QUOTE_CHR) ) !++ ! SET SERVER_TIMER command. ! ! This sets the time between naks send when server is idle. !-- $STATE (SET_SRV_STATE, (TPA$_DECIMAL, DONE_STATE, , ,SRV_TIMEOUT) ) !++ ! ! SET TRANSMIT xxx command. The format is: ! and below ! ! Kermit-32>SET TRANSMIT ! ! Where: ! is one of: ! DELAY - Time to delay after each carriage return ! ECHO - Echo from terminal line or just print line numbers ! !-- $STATE (SET_TRN_STATE, ! ('DELAY', SET_TRD_STATE), ! ('ECHO', SET_TRE_STATE), ! (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ! ) ! !++ ! ! SET TRANSMIT DELAY command. Format is: ! and below ! ! Kermit-32>SET TRANSMIT DELAY ! ! Where: ! is a decimal digit that specifies the length of time in ! tenths of a second to delay after transmitting a carriage return. ! !-- $STATE (SET_TRD_STATE, ! (TPA$_DIGIT, DONE_STATE, STORE_TR_DELAY, ,TRANS_DELAY) ! ) ! !++ ! ! SET TRANSMIT ECHO command. The format is: ! and below ! ! Kermit-32>SET TRANSMIT ECHO (on/off) ! ! Where: ! on/off is either the ON or OFF keyword. ! !-- $STATE (SET_TRE_STATE, ! ('ON', DONE_STATE, STORE_TR_ECHO, , ,TRUE), ! ('OFF', DONE_STATE, STORE_TR_ECHO, , ,FALSE),! (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ! ) ! %SBTTL 'SEND command' !++ ! SEND command. The format is: ! ! Kermit-32>SEND file-specification ! ! Where: ! FILE-SPECIFICATION is any valid VAX/VMS file specification. ! !-- $STATE (SEND_STATE, (TPA$_ANY, SEND_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_DESC, , ,FILE_DESC) ) %SBTTL 'SHOW command' !++ ! SHOW command. The format is: ! ! Kermit-32>SHOW ! ! Where: ! is one of the following: ! SEND - Send parameters ! RECEIVE - Receive parameters ! DEBUGGING - State of the debugging flag ! FILE-TYPE - Type of the file ! LOCAL-ECHO - Local echo flag ! LINE - Current line associated ! ESCAPE - Current escape character ! DELAY - Delay parameter. ! !-- $STATE (SHOW_STATE, ('ALL', DONE_STATE, ,SHOW_ALL, SHOW_TYPE), ('BLOCK_CHECK_TYPE', DONE_STATE, ,SHOW_CHK, SHOW_TYPE), ('COMMUNICATIONS', DONE_STATE, ,SHOW_COM, SHOW_TYPE), ('DEBUGGING', DONE_STATE, ,SHOW_DEB, SHOW_TYPE), ('DELAY', DONE_STATE, ,SHOW_DEL, SHOW_TYPE), ('ESCAPE', DONE_STATE, ,SHOW_ESC, SHOW_TYPE), ('FILE_PARAMETERS', DONE_STATE, ,SHOW_FIL, SHOW_TYPE), ('INCOMPLETE_FILE_DISPOSITION',DONE_STATE, ,SHOW_ABT, SHOW_TYPE), ('LINE', DONE_STATE, ,SHOW_LIN, SHOW_TYPE), ('LOCAL_ECHO', DONE_STATE, ,SHOW_ECH, SHOW_TYPE), ('PACKET', DONE_STATE, ,SHOW_PAC, SHOW_TYPE), ('PARITY', DONE_STATE, ,SHOW_PAR, SHOW_TYPE), ('SEND', DONE_STATE, ,SHOW_SEN, SHOW_TYPE), ('TIMING', DONE_STATE, ,SHOW_TIM, SHOW_TYPE), ('RECEIVE', DONE_STATE, ,SHOW_REC, SHOW_TYPE), ('RETRY', DONE_STATE, ,SHOW_RTY, SHOW_TYPE), ('VERSION', DONE_STATE, ,SHOW_VER, SHOW_TYPE), ('TRANSMIT', DONE_STATE, ,SHOW_TRN, SHOW_TYPE), ! (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) %SBTTL 'LOG command' !++ ! The LOG command allows the specification of a session or transaction !log file. !-- $STATE (LOG_STATE, ('DEBUGGING', DBG_STATE), ('SESSION', SES_STATE), ('TRANSACTIONS',TRN_STATE), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) $STATE (DBG_STATE, (TPA$_ANY, DBG_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_DESC, , ,DEBUG_DESC) ) $STATE (SES_STATE, (TPA$_ANY, SES_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_DESC, , ,SESSION_DESC) ) $STATE (TRN_STATE, (TPA$_ANY, TRN_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_DESC, , ,TRANSACTION_DESC) ) %SBTTL 'Take command tables' !++ ! The following describes the TAKE (or @) command. !-- $STATE (TAKE_STATE, ('/', TAK_SWT_STATE, COPY_DESC, , ,TAK_FIL_DESC), (TPA$_ANY, TAKE_STATE, STORE_TEXT), (TPA$_LAMBDA, DONE_STATE, COPY_DESC, , ,TAK_FIL_DESC) ) $STATE (TAK_SWT_STATE, ('DISPLAY', DONE_STATE, ,TRUE, TAKE_DISPLAY), (TPA$_SYMBOL, TPA$_FAIL, KEY_ERROR) ) %SBTTL 'TRANSMIT command' ! ! !++ ! ! TRANSMIT command. The format is: ! ! ! ! Kermit-32>TRANSMIT file-specification ! ! ! ! Where: ! ! FILE-SPECIFICATION is any valid VAX/VMS file specification. ! ! ! !-- ! ! $STATE (TRANSMIT_STATE, ! (TPA$_ANY, TRANSMIT_STATE, STORE_TEXT), ! (TPA$_LAMBDA, DONE_STATE, COPY_DESC, , ,FILE_DESC) ! ) ! %SBTTL 'Done state' !++ ! This is the single state that is the required CONFIRM for the end ! of the commands. !-- $STATE (DONE_STATE, (TPA$_EOS, TPA$_EXIT) ) !++ ! ! End of the KERMIT-32 command definitions ! !-- PSECT OWN = $OWN$; PSECT GLOBAL = $GLOBAL$; ! ROUTINE MAIN_ROUTINE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This is the main routine for KERMIT-32. This routine will ! initialize the various parameters and then call the command ! scanner to process commands. ! ! FORMAL PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! ROUTINE VALUE and ! COMPLETION CODES: ! ! Return status from last command. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS, ! Returned status CRC_BIT_MASK, ! Bit mask for CRC initialization LOOP_FLAG; ! ! Initialize some variables ! STATUS = LIB$PUT_OUTPUT (IDENT_STRING); ! Say who we are MSG_INIT (); ! Initialize message processing TERM_INIT (); ! Init terminal processing TT_INIT (); ! Init text processing FILE_INIT (); ! Init file processing SY_INIT (); ! Init system routines ESCAPE_CHR = CHR_ESCAPE; ! ! Initialize some VAX/VMS interface items ! CRC_BIT_MASK = %O'102010'; ! CRC bit mask LIB$CRC_TABLE (CRC_BIT_MASK, CRC_TABLE); LIB$ESTABLISH (KERM_HANDLER); ! ! Initialize transaction log file descriptor ! INIT_STR_DESC (TRANSACTION_DESC, TRANSACTION_NAME, 0); ! ! Initialize take file descriptor ! INIT_STR_DESC (TAK_FIL_DESC, TAK_FIL_NAME, 0); ! ! Initialize prompt descriptor ! INIT_STR_DESC (PROMPT_DESC, PROMPT_TEXT, 0); ! ! Take initialization file ! COMND_FILE (%ASCID'VMSKERMIT', %ASCID'.INI;0', TRUE, FALSE); ! ! Main command loop ! Status = COMND (); RETURN .Final_Status OR STS$M_INHIB_MSG; END; ! end of routine MAIN_ROUTINE %SBTTL 'COMND' ROUTINE COMND = !++ ! FUNCTIONAL DESCRIPTION: ! This routine will do the command scanning for KERMIT-32. It ! will call the correct routines to process the commands. ! ! CALLING SEQUENCE: ! ! COMND(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! Return status from last command. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL ROUTINE GET_COMMAND, ! Get line from SYS$COMMAND LIB$GET_FOREIGN : ADDRESSING_MODE (GENERAL); ! Get command which started program LOCAL DESC : BLOCK [8, BYTE], CMD_BUF : VECTOR [80, BYTE, UNSIGNED], CMD_SIZE : UNSIGNED WORD, ONE_COMMAND, ! Only do one command STATUS : UNSIGNED LONG; ONE_COMMAND = FALSE; ! And many commands ! ! Initialize the command string descriptor ! INIT_STR_DESC (DESC, CMD_BUF, 80); ! ! Get the first command string. If we get something, then we will only ! want to perform one command, then exit. Otherwise, we will do commands ! until something one tells us to exit. ! STATUS = LIB$GET_FOREIGN (DESC, 0, CMD_SIZE, 0); IF .STATUS EQL RMS$_EOF THEN RETURN SS$_NORMAL; IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); RETURN .STATUS; END; IF .CMD_SIZE GTR 0 THEN ONE_COMMAND = TRUE; WHILE TRUE DO BEGIN IF .CMD_SIZE GTR 0 THEN BEGIN DESC [DSC$W_LENGTH] = .CMD_SIZE; IF .STATUS THEN STATUS = DO_COMND (DESC); IF .STATUS EQL KER_EXIT THEN RETURN SS$_NORMAL; IF NOT .STATUS AND .STATUS NEQ KER_TAKE_ERROR THEN COMND_ERROR (.STATUS); END; ! ! If we were given command when run, just exit after doing it ! IF .ONE_COMMAND THEN RETURN SS$_NORMAL; ! ! Initialize prompt if null ! IF .PROMPT_DESC [DSC$W_LENGTH] LEQ 0 THEN BEGIN CH$COPY (.DEFAULT_PROMPT [DSC$W_LENGTH], CH$PTR (.DEFAULT_PROMPT [DSC$A_POINTER]), 0, TEMP_LENGTH, CH$PTR (PROMPT_TEXT)); PROMPT_DESC = .DEFAULT_PROMPT [DSC$W_LENGTH]; END; DESC [DSC$W_LENGTH] = 80; ! Reset length STATUS = GET_COMMAND (DESC, PROMPT_DESC, CMD_SIZE, TRUE); IF .STATUS EQL RMS$_EOF THEN RETURN SS$_NORMAL; ! ! If there was an error then return the error code to the upper level ! IF NOT .STATUS ! Failing status? THEN RETURN .STATUS; ! Yes, return it END; ! End of WHILE TRUE DO BEGIN RETURN SS$_NORMAL; END; ! End of COMND %SBTTL 'COMND_FILE - Perform take (indirect) file' ROUTINE COMND_FILE (TAKE_DESC, DEFAULT_DESC, OK_NONE, DISPLAY_FLAG) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will read a file of commands and perform them. If any ! error occurs, it will abort the command processing. ! ! CALLING SEQUENCE: ! ! STATUS = COMND_FILE (TAKE_DESC, DEFAULT_DESC, OK_NONE, DISPLAY_FLAG) ! ! INPUT PARAMETERS: ! ! TAKE_DESC - String descriptor of file specification ! DEFAULT_DESC - Default file specification ! OK_NONE - If true, return EOF if file does not exist, otherwise ! return error if file does not exist. ! DISPLAY_FLAG - If true display commands being executed ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! Standard status values ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL ROUTINE STR$UPCASE : ADDRESSING_MODE (GENERAL), ! Upcase a string LIB$GET_VM : ADDRESSING_MODE (GENERAL) NOVALUE, LIB$FREE_VM : ADDRESSING_MODE (GENERAL) NOVALUE; MAP TAKE_DESC : REF BLOCK [8, BYTE], DEFAULT_DESC : REF BLOCK [8, BYTE]; ! The args are descriptors LOCAL TAKE_FILE_DESC : BLOCK [8, BYTE], ! Descriptor for take file TAKE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], ! Name of take file TAKE_FILE_FAB : $FAB_DECL, ! FAB for take file TAKE_FILE_RAB : $RAB_DECL, ! RAB for take file TAKE_FILE_XABFHC : $XABFHC_DECL, ! XAB for file header items TAKE_FILE_BADR, ! Address of take file buffer TAKE_FILE_BSIZ, ! Size of take file buffer TAKE_FILE_FADR, ! Address of fixed header buffer TAKE_FILE_FSIZ, ! size of fixed header buffer STATUS, ! Random status values CMD_DESC : BLOCK [8, BYTE]; ! Descriptor for command CH$COPY (.TAKE_DESC [DSC$W_LENGTH], CH$PTR (.TAKE_DESC [DSC$A_POINTER]), 0, MAX_FILE_NAME, CH$PTR (TAKE_FILE_NAME)); INIT_STR_DESC (TAKE_FILE_DESC, TAKE_FILE_NAME, .TAKE_DESC [DSC$W_LENGTH]); $FAB_INIT (FAB = TAKE_FILE_FAB, FNA = TAKE_FILE_NAME, FNS = .TAKE_FILE_DESC [DSC$W_LENGTH], FAC = GET, XAB = TAKE_FILE_XABFHC, DNA = .DEFAULT_DESC [DSC$A_POINTER], DNS = .DEFAULT_DESC [DSC$W_LENGTH]); $XABFHC_INIT (XAB = TAKE_FILE_XABFHC); STATUS = $OPEN (FAB = TAKE_FILE_FAB); IF NOT .STATUS THEN BEGIN IF .STATUS EQL RMS$_FNF AND .OK_NONE THEN RETURN KER_TAKE_EOF; LIB$SIGNAL (.STATUS); RETURN KER_TAKE_ERROR; END; ! ! Allocate a buffer ! TAKE_FILE_BSIZ = .TAKE_FILE_XABFHC [XAB$W_LRL]; IF .TAKE_FILE_BSIZ EQL 0 THEN TAKE_FILE_BSIZ = MAX_REC_LENGTH; LIB$GET_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR); INIT_STR_DESC (CMD_DESC, .TAKE_FILE_BADR, .TAKE_FILE_BSIZ); ! ! Determine if we need a buffer for the fixed control area ! TAKE_FILE_FSIZ = .TAKE_FILE_FAB [FAB$B_FSZ]; IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$GET_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR); ! ! Initialize the RAB for the $CONNECT RMS call ! $RAB_INIT (RAB = TAKE_FILE_RAB, FAB = TAKE_FILE_FAB, RAC = SEQ, ROP = NLK, UBF = .TAKE_FILE_BADR, USZ = .TAKE_FILE_BSIZ); IF .TAKE_FILE_FSIZ NEQ 0 THEN TAKE_FILE_RAB [RAB$L_RHB] = .TAKE_FILE_FADR; STATUS = $CONNECT (RAB = TAKE_FILE_RAB); IF NOT .STATUS THEN BEGIN LIB$SIGNAL (.STATUS); LIB$FREE_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR); IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$FREE_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR); RETURN KER_TAKE_ERROR; END; WHILE (STATUS = $GET (RAB = TAKE_FILE_RAB)) DO BEGIN IF .TAKE_FILE_RAB [RAB$W_RSZ] GTR 0 THEN BEGIN CMD_DESC [DSC$W_LENGTH] = .TAKE_FILE_RAB [RAB$W_RSZ]; STATUS = STR$UPCASE (CMD_DESC, CMD_DESC); IF .DISPLAY_FLAG THEN LIB$PUT_OUTPUT (CMD_DESC); STATUS = DO_COMND (CMD_DESC); IF NOT .STATUS THEN BEGIN IF .STATUS NEQ KER_TAKE_ERROR THEN BEGIN COMND_ERROR (.STATUS); LIB$PUT_OUTPUT (CMD_DESC); STATUS = KER_TAKE_ERROR; ! Indicate we should abort back END; EXITLOOP; END; END; END; ! End of WHILE TRUE DO BEGIN ! ! When the loop exits, we got some kind of error. Complain unless end of file. ! IF .STATUS EQL RMS$_EOF THEN STATUS = KER_TAKE_EOF; IF .STATUS NEQ KER_EXIT AND .STATUS NEQ KER_TAKE_EOF AND .STATUS NEQ KER_TAKE_ERROR THEN LIB$SIGNAL (.STATUS); ! ! Close the file ! $DISCONNECT (RAB = TAKE_FILE_RAB); $CLOSE (FAB = TAKE_FILE_FAB); ! ! Return any buffers ! LIB$FREE_VM (TAKE_FILE_BSIZ, TAKE_FILE_BADR); IF .TAKE_FILE_FSIZ NEQ 0 THEN LIB$FREE_VM (TAKE_FILE_FSIZ, TAKE_FILE_FADR); RETURN .STATUS; END; ! End of COMND_FILE %SBTTL 'COMND_ERROR - Give error message for command' ROUTINE COMND_ERROR (STATUS) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will issue an error message for a command parsing error. ! ! CALLING SEQUENCE: ! ! COMND_ERROR (.STATUS); ! ! INPUT PARAMETERS: ! ! STATUS - The status value returned from DO_COMND ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN IF .STATUS EQL KER_AMBIGKEY OR .STATUS EQL KER_UNKNOWKEY THEN LIB$SIGNAL (.STATUS, 1, TPARSE_BLOCK [TPA$L_TOKENCNT]) ELSE BEGIN EXTERNAL LITERAL LIB$_SYNTAXERR; IF .STATUS EQL LIB$_SYNTAXERR THEN LIB$SIGNAL (KER_CMDERR, 1, TPARSE_BLOCK [TPA$L_STRINGCNT]) ELSE LIB$SIGNAL (.STATUS); END; END; ! End of COMND_ERROR %SBTTL 'DO_COMND' ROUTINE DO_COMND (CMD_DESC) = !++ ! FUNCTIONAL DESCRIPTION: ! This routine will parse and process one Kermit command. ! ! CALLING SEQUENCE: ! ! STATUS = DO_COMND(CMD_DESC); ! ! INPUT PARAMETERS: ! ! CMD_DESC - Descriptor of command string ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND SERVER_TEXT = %ASCID'Kermit Server running on VAX/VMS host. Please type your escape sequence to', SERVER_TEXT_1 = %ASCID' return to your local machine. Shut down the server by typing the Kermit BYE', SERVER_TEXT_2 = %ASCID' command on your local machine.', PUSH_TEXT = %ASCID' Type LOGOUT to return to VMS Kermit'; MAP CMD_DESC : REF BLOCK [8, BYTE]; ! Descriptor for command LOCAL STATUS : UNSIGNED LONG; ! Initialize some per-command data areas. INIT_STR_DESC (TEMP_DESC, TEMP_NAME, 0); COMMAND = 0; SHOW_TYPE = 0; REM_TYPE = 0; FILE_SIZE = 0; ALT_FILE_SIZE = 0; GEN_1SIZE = 0; GEN_2SIZE = 0; GEN_3SIZE = 0; CONNECT_FLAG = FALSE; ! Assume not connected TAKE_DISPLAY = 0; TPARSE_BLOCK [TPA$L_STRINGCNT] = .CMD_DESC [DSC$W_LENGTH]; TPARSE_BLOCK [TPA$L_STRINGPTR] = .CMD_DESC [DSC$A_POINTER]; TPARSE_BLOCK [TPA$V_BLANKS] = 0; ! Ignore blanks STATUS = LIB$TPARSE (TPARSE_BLOCK, KERMIT_STATE, KERMIT_KEY); IF .STATUS THEN BEGIN FILE_SIZE = .FILE_DESC [DSC$W_LENGTH]; ! Copy length in case needed CASE .COMMAND FROM CMD_MIN TO CMD_MAX OF SET [CMD_BYE] : BEGIN IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal THEN BEGIN IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_LOGOUT) ELSE STATUS = KER_LOCONLY; TERM_CLOSE () END; IF NOT .STATUS THEN RETURN .STATUS ELSE RETURN KER_EXIT; END; [CMD_CONN] : TERM_CONNECT (); [CMD_EXIT] : RETURN KER_EXIT; [CMD_FINISH] : IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal THEN BEGIN IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_EXIT) ELSE STATUS = KER_LOCONLY; TERM_CLOSE () END; [CMD_GET] : IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal THEN BEGIN IF NOT .CONNECT_FLAG THEN REC_SWITCH () ELSE STATUS = KER_LOCONLY; TERM_CLOSE (); END; [CMD_HELP] : COMND_HELP (); [CMD_LOGOUT] : IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal THEN BEGIN IF NOT .CONNECT_FLAG THEN DO_GENERIC (GC_LOGOUT) ELSE STATUS = KER_LOCONLY; TERM_CLOSE () END; [CMD_RECEIVE] : IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal THEN BEGIN FILE_SIZE = 0; ! No file to request REC_SWITCH (); TERM_CLOSE (); END; [CMD_REMOTE] : COMND_REMOTE (); [CMD_LOCAL] : COMND_LOCAL (); [CMD_PUSH] : BEGIN OWN PID : INITIAL (0); LIB$PUT_OUTPUT (PUSH_TEXT); IF .PID NEQ 0 THEN BEGIN STATUS = LIB$ATTACH (PID); IF NOT .STATUS THEN PID = 0; END; IF .PID EQL 0 THEN STATUS = LIB$SPAWN (0, 0, 0, 0, 0, PID); ! Just spawn a DCL END; [CMD_SEND] : BEGIN EXTERNAL ROUTINE FILE_OPEN, ! Open file routine FILE_CLOSE; ! Close file routine LOCAL SAVE_FILE_NAME : VECTOR [CH$ALLOCATION (MAX_FILE_NAME)], SAVE_FILE_SIZE, SAVE_TY_FIL; SAVE_TY_FIL = .TY_FIL; ! Save current type out flag TY_FIL = FALSE; ! Suppress type out of names SAVE_FILE_SIZE = .FILE_SIZE; ! Save the file name size CH$MOVE((.FILE_SIZE),CH$PTR(FILE_NAME), CH$PTR(SAVE_FILE_NAME)); IF FILE_OPEN (FNC_READ) THEN BEGIN FILE_SIZE = .SAVE_FILE_SIZE; ! Reset the file name size CH$MOVE(.FILE_SIZE,CH$PTR(SAVE_FILE_NAME), CH$PTR(FILE_NAME)); FILE_CLOSE (FALSE); TY_FIL = .SAVE_TY_FIL; ! Reset type out flag IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal THEN BEGIN SEND_SWITCH (); TERM_CLOSE (); END; END ELSE TY_FIL = .SAVE_TY_FIL; ! Reset type out flag END; [CMD_SERVER] : BEGIN LIB$PUT_OUTPUT (SERVER_TEXT); LIB$PUT_OUTPUT (SERVER_TEXT_1); LIB$PUT_OUTPUT (SERVER_TEXT_2); IF (STATUS = TERM_OPEN (TRUE)) ! Open the terminal THEN BEGIN STATUS = SERVER (); TERM_CLOSE (); RETURN KER_NORMAL; END; END; [CMD_SHOW] : COMND_SHOW (); [CMD_STATUS] : COMND_STATUS (); [CMD_TAKE] : STATUS = COMND_FILE (TAK_FIL_DESC, %ASCID'.COM;0', FALSE, .TAKE_DISPLAY); [CMD_TRANSMIT]: ! COMND_TRANSMIT (); ! [INRANGE] : TES; END; RETURN .STATUS; END; ! End of DO_COMND %SBTTL 'Command execution -- COMND_HELP' ROUTINE COMND_HELP : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will do the HELP command processing for KERMIT. It ! will call the library routines. ! ! CALLING SEQUENCE: ! ! COMND_HELP(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL Help_File : VECTOR [2], STATUS : UNSIGNED LONG; EXTERNAL ROUTINE LBR$OUTPUT_HELP : ADDRESSING_MODE (GENERAL); ! ! Do the help processing. ! Status = $TRNLNM(TABNAM = %ASCID 'LNM$FILE_DEV', LOGNAM = %ASCID 'KERMIT_HELP'); IF .Status THEN BEGIN Help_File [0] = %CHARCOUNT(%ASCII 'KERMIT_HELP'); Help_File [1] = UPLIT BYTE(%ASCII 'KERMIT_HELP'); STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT, 0, TEMP_DESC, %ASCID'KERMIT_HELP', UPLIT (HLP$M_PROMPT + HLP$M_PROCESS + HLP$M_GROUP + HLP$M_SYSTEM), LIB$GET_INPUT); END ELSE BEGIN Help_File [0] = %CHARCOUNT(%ASCII 'KERMIT_HELP'); Help_File [1] = UPLIT BYTE(%ASCII 'KERMIT_HELP'); STATUS = LBR$OUTPUT_HELP (LIB$PUT_OUTPUT, 0, TEMP_DESC, %ASCID'KERMIT', UPLIT (HLP$M_PROMPT + HLP$M_PROCESS + HLP$M_GROUP + HLP$M_SYSTEM), LIB$GET_INPUT); END; IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); END; %SBTTL 'Command execution -- Support routines -- OUTPUT_LONG_WORD' ROUTINE OUTPUT_LONG_WORD (MSG_ADDR, LONG_VALUE) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! This routine is used to output the various long word parameters ! that are shown by the SHOW command. All text is defined in the level ! 0 of this program. ! ! CALLING SEQUENCE: ! ! OUTPUT_LONG_WORD( MSG_ASCID, LONG_WORD_VALUE_TO_OUTPUT); ! ! INPUT PARAMETERS: ! ! MSG_ASCID - %ASCID of the text to use for the $FAO call. ! ! LONG_WORD_VALUE_TO_OUTPUT - Value of the long word to pass to the $FAO. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN MAP LONG_VALUE : LONG UNSIGNED, MSG_ADDR : LONG UNSIGNED; LOCAL STATUS : UNSIGNED; ! Status return by LIB$xxx INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); $FAO (.MSG_ADDR, OUTPUT_SIZE, OUTPUT_DESC, .LONG_VALUE); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; %SBTTL 'Command Execution -- COMND_REMOTE' ROUTINE COMND_REMOTE : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the REMOTE commands. It will call KERMSG !to perform the command. ! ! CALLING SEQUENCE: ! ! COMND_REMOTE (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! REM_TYPE - type of command to be executed ! GEN_xDATA/GEN_xSIZE - arguments for the commands ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN IF GET_REM_ARGS (FALSE) THEN IF TERM_OPEN (TRUE) ! Open the terminal to determine if local THEN BEGIN IF NOT .CONNECT_FLAG THEN DO_GENERIC (.REM_TYPE) ELSE LIB$SIGNAL (KER_LOCONLY); TERM_CLOSE (); END; END; ! End of COMND_REMOTE %SBTTL 'Command Execution -- COMND_LOCAL' ROUTINE COMND_LOCAL : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will handle the LOCAL commands. It will call the generic !command processor to perform the command, and type the result. ! ! CALLING SEQUENCE: ! ! COMND_LOCAL (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! REM_TYPE - type of command to be executed ! GEN_xDATA/GEN_xSIZE - arguments for the commands ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL SAVED_TY_FIL, ! Saved value from TY_FIL STATUS, ! Status values FILE_FLAG, ! Flag whether file is open CHARACTER, ! Character from get-a-char routine STR_LENGTH, ! Length of string STR_ADDRESS, ! Address of string GET_CHR_RTN; ! Address of routine to get a character EXTERNAL ROUTINE SY_GENERIC, ! Do a generic command GET_FILE, ! Get a character from a file FILE_OPEN, ! Open a file FILE_CLOSE; ! Close a file ! ! First get any extra arguments needed ! STATUS = GET_REM_ARGS (TRUE); IF NOT .STATUS THEN RETURN; ! ! Initialize arguments for SY_GENERIC ! GET_CHR_RTN = 0; ! No routine STR_LENGTH = 0; ! No length STR_ADDRESS = 0; ! No address ! ! Have generic routine do the command ! STATUS = SY_GENERIC (.REM_TYPE, STR_ADDRESS, STR_LENGTH, GET_CHR_RTN); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS) ELSE BEGIN ! ! If we got a string, type it out ! IF .STR_LENGTH NEQ 0 THEN BEGIN LOCAL POINTER; POINTER = CH$PTR (.STR_ADDRESS); DECR I FROM .STR_LENGTH TO 1 DO TT_CHAR (CH$RCHAR_A (POINTER)); TT_CRLF (); ! Make sure it gets dumped END ELSE ! ! Here if we didn't get a string. Either we need to call the supplied routine ! or open a file and call GET_FILE for each character. ! BEGIN IF .GET_CHR_RTN NEQ 0 THEN FILE_FLAG = FALSE ! No file open ELSE BEGIN FILE_FLAG = TRUE; ! Have a file GET_CHR_RTN = GET_FILE; ! This is our get-a-char routine SAVED_TY_FIL = .TY_FIL; ! Save current type out flag TY_FIL = FALSE; ! Make sure we don't have name typed STATUS = FILE_OPEN (FNC_READ); ! Open the file TY_FIL = .SAVED_TY_FIL; ! Restore type out value IF NOT .STATUS ! If we couldn't open the file THEN RETURN; ! Just return, (FILE_OPEN reported it) END; DO BEGIN STATUS = (.GET_CHR_RTN) (CHARACTER); ! Get a character IF .STATUS AND NOT .STATUS EQL KER_EOF ! Did we get one? THEN TT_CHAR (.CHARACTER) ! Yes, type it ELSE ! ! If no character returned, check for EOF and close file if we opened it ! IF .STATUS EQL KER_EOF AND .FILE_FLAG THEN FILE_CLOSE (); END UNTIL NOT .STATUS OR .STATUS EQL KER_EOF; ! Loop until we are done TT_OUTPUT (); ! Force out last buffer END; END; END; ! End of COMND_LOCAL %SBTTL 'Command execution -- COMND_SHOW' ROUTINE COMND_SHOW : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will process the SHOW command. This routine ! expects that the command has already been processed and that ! the type of SHOW command is stored in SHOW_TYPE. ! ! CALLING SEQUENCE: ! ! COMND_SHOW(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS : WORD; ! Status returned ! Bind some addresses to text BIND OFF_TEXT = %ASCID'OFF', ! Item is off ON_TEXT = %ASCID'ON', ! Item is on SHOW_ABT_MSG = %ASCID' Incomplete file disposition !AS', ABT_DISCARD = %ASCID'Discard', ABT_KEEP = %ASCID'Keep', SHOW_CHK_MSG = %ASCID' Block check type !AS', CHK_1CHAR_MSG = %ASCID'One character checksum', CHK_2CHAR_MSG = %ASCID'Two character checksum', CHK_CRC_MSG = %ASCID'Three character CRC-CCITT', SHOW_DEB_MSG = %ASCID' Debugging !AS', SHOW_DEL_MSG = %ASCID' Delay !ZL (sec)', SHOW_SRV_MSG = %ASCID' Server sends NAKs every !ZL seconds while waiting for a command', SHOW_ESC_MSG = %ASCID' Escape character !3OL (octal)', SHOW_FTP_MSG = %ASCID' File type !AS', SHOW_BLK_MSG = %ASCID' BINARY and FIXED record size !UL (bytes)', FTP_ASCII = %ASCID'ASCII', FTP_BINARY = %ASCID'BINARY', FTP_BLOCK = %ASCID'BLOCK', FTP_FIXED = %ASCID'FIXED', SHOW_FNM_MSG = %ASCID' File naming !AS', FNM_MSG_FULL = %ASCID'Full file specifcation', FNM_MSG_NORMAL = %ASCID'Normal form', FNM_MSG_UNTRAN = %ASCID'Untranslated', ! SHOW_IBM_MSG = %ASCID' IBM mode !AS', SHOW_HAN_MSG = %ASCID' Handshaking character !3OL (octal)', SHOW_HAN_MSG_NONE = %ASCID' Handshaking character None', SHOW_LIN_MSG = %ASCID' Line used !AS', SHOW_ECH_MSG = %ASCID' Local echo !AS', SHOW_PAR_MSG = %ASCID' Parity type !AS', PAR_EVEN = %ASCID'Even', PAR_ODD = %ASCID'Odd', PAR_MARK = %ASCID'Mark', PAR_SPACE = %ASCID'Space', PAR_NONE = %ASCID'None', SHOW_RTY_HDR = %ASCID' Retry maximums', SHOW_RTY_INI_MSG = %ASCID' Initial connection !ZL (dec)', SHOW_RTY_PKT_MSG = %ASCID' Sending a packet !ZL (dec)', SHOW_REC_HDR = %ASCID' Receive parameters', SHOW_SND_HDR = %ASCID' Send parameters', SHOW_PKT_MSG = %ASCID' Packet length !ZL (dec)', SHOW_PAD_MSG = %ASCID' Padding length !ZL (dec)', SHOW_PDC_MSG = %ASCID' Padding character !3OL (octal)', SHOW_TIM_MSG = %ASCID' Time out !ZL (sec)', SHOW_EOL_MSG = %ASCID' End of line character !3OL (octal)', SHOW_QUO_MSG = %ASCID' Quoting character !3OL (octal)', SHOW_SOH_MSG = %ASCID' Start of packet !3OL (octal)', SHOW_8QU_MSG = %ASCID' 8-bit quoting character !3OL (octal)', SHOW_TRN_HDR = %ASCID' Transmit parameters', ! SHOW_TRD_MSG = %ASCID' Delay 0.!AD (sec)', ! SHOW_TRE_MSG = %ASCID' Echo !AS', ! SHOW_RPT_MSG = %ASCID' Repeat quoting character !3OL (octal)'; !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is used to output the keywords TRUE or FALSE. ! All text that this routine uses is defined in the level 0 BEGIN/END ! of the program. ! ! CALLING SEQUENCE: ! ! OUTPUT_TRUE_FALSE( MSG_ASCID, FLAG_WORD); ! ! INPUT PARAMETERS: ! ! MSG_ASCID - %ASCID of the text to use for the $FAO call. ! ! FLAG_WORD - Long word containing the value of either TRUE or FALSE. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- ROUTINE OUTPUT_TRUE_FALSE (MSG_ADDR, FLAG_ADDR) : NOVALUE = BEGIN MAP FLAG_ADDR : LONG UNSIGNED, MSG_ADDR : LONG UNSIGNED; LOCAL STATUS : UNSIGNED; ! Status return by LIB$xxx INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); $FAO (.MSG_ADDR, OUTPUT_SIZE, OUTPUT_DESC, (SELECTONE ..FLAG_ADDR OF SET [TRUE] : ON_TEXT; [FALSE] : OFF_TEXT; TES)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; SELECT .SHOW_TYPE OF SET ! ! Show version ! [SHOW_ALL, SHOW_VER] : STATUS = LIB$PUT_OUTPUT (IDENT_STRING); ! Type our name and version [SHOW_ALL, SHOW_CHK, SHOW_PAC] : BEGIN INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); $FAO (SHOW_CHK_MSG, OUTPUT_SIZE, OUTPUT_DESC, (SELECTONE .CHKTYPE OF SET [CHK_1CHAR] : CHK_1CHAR_MSG; [CHK_2CHAR] : CHK_2CHAR_MSG; [CHK_CRC] : CHK_CRC_MSG; TES)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; [SHOW_ALL, SHOW_DEB] : OUTPUT_TRUE_FALSE (SHOW_DEB_MSG, DEBUG_FLAG); [SHOW_ALL, SHOW_DEL, SHOW_COM, SHOW_TIM] : OUTPUT_LONG_WORD (SHOW_DEL_MSG, .DELAY); [SHOW_ALL, SHOW_TIM] : OUTPUT_LONG_WORD (SHOW_SRV_MSG, .SRV_TIMEOUT); [SHOW_ALL, SHOW_ESC, SHOW_COM] : OUTPUT_LONG_WORD (SHOW_ESC_MSG, .ESCAPE_CHR); [SHOW_ALL, SHOW_FIL] : ! BEGIN INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); $FAO (SHOW_FTP_MSG, OUTPUT_SIZE, OUTPUT_DESC, (SELECTONE .FILE_TYPE OF SET [FILE_ASC] : FTP_ASCII; [FILE_BIN] : FTP_BINARY; [FILE_FIX] : FTP_FIXED; [FILE_BLK] : FTP_BLOCK; TES)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); ! ! Display the file name format ! INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); $FAO (SHOW_FNM_MSG, OUTPUT_SIZE, OUTPUT_DESC, (SELECTONE .FIL_NORMAL_FORM OF SET [FNM_FULL] : FNM_MSG_FULL; [FNM_NORMAL] : FNM_MSG_NORMAL; [FNM_UNTRAN] : FNM_MSG_UNTRAN; TES)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); ! Display file block size INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); $FAO(SHOW_BLK_MSG, OUTPUT_SIZE, OUTPUT_DESC, .file_blocksize); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; [SHOW_ALL, SHOW_COM] : IF .IBM_CHAR GEQ 0 THEN OUTPUT_LONG_WORD (SHOW_HAN_MSG, .IBM_CHAR) ELSE STATUS = LIB$PUT_OUTPUT (SHOW_HAN_MSG_NONE); [SHOW_ALL, SHOW_ABT, SHOW_FIL] : BEGIN INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); $FAO (SHOW_ABT_MSG, OUTPUT_SIZE, OUTPUT_DESC, (IF .ABT_FLAG THEN ABT_DISCARD ELSE ABT_KEEP)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; [SHOW_ALL, SHOW_LIN, SHOW_COM] : BEGIN INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); IF .TERM_DESC [DSC$W_LENGTH] GTR 0 THEN $FAO (SHOW_LIN_MSG, OUTPUT_SIZE, OUTPUT_DESC, TERM_DESC) ELSE $FAO (SHOW_LIN_MSG, OUTPUT_SIZE, OUTPUT_DESC, %ASCID'none'); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; [SHOW_ALL, SHOW_ECH, SHOW_COM] : OUTPUT_TRUE_FALSE (SHOW_ECH_MSG, ECHO_FLAG); [SHOW_ALL, SHOW_PAR, SHOW_COM] : BEGIN INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); $FAO (SHOW_PAR_MSG, OUTPUT_SIZE, OUTPUT_DESC, (SELECTONE .PARITY_TYPE OF SET [PR_EVEN] : PAR_EVEN; [PR_ODD] : PAR_ODD; [PR_NONE] : PAR_NONE; [PR_MARK] : PAR_MARK; [PR_SPACE] : PAR_SPACE; TES)); OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); END; [SHOW_ALL, SHOW_RTY, SHOW_PAC] : BEGIN STATUS = LIB$PUT_OUTPUT (SHOW_RTY_HDR); OUTPUT_LONG_WORD (SHOW_RTY_INI_MSG, .SI_RETRIES); OUTPUT_LONG_WORD (SHOW_RTY_PKT_MSG, .PKT_RETRIES); END; [SHOW_ALL, SHOW_SEN, SHOW_PAC] : BEGIN STATUS = LIB$PUT_OUTPUT (SHOW_SND_HDR); OUTPUT_LONG_WORD (SHOW_PKT_MSG, ABS (.SND_PKT_SIZE)); OUTPUT_LONG_WORD (SHOW_PAD_MSG, ABS (.SND_NPAD)); OUTPUT_LONG_WORD (SHOW_PDC_MSG, ABS (.SND_PADCHAR)); OUTPUT_LONG_WORD (SHOW_TIM_MSG, ABS (.SND_TIMEOUT)); OUTPUT_LONG_WORD (SHOW_EOL_MSG, ABS (.SND_EOL)); OUTPUT_LONG_WORD (SHOW_QUO_MSG, ABS (.SND_QUOTE_CHR)); OUTPUT_LONG_WORD (SHOW_SOH_MSG, ABS (.SND_SOH)); END; [SHOW_ALL, SHOW_REC, SHOW_PAC] : BEGIN STATUS = LIB$PUT_OUTPUT (SHOW_REC_HDR); OUTPUT_LONG_WORD (SHOW_PKT_MSG, .RCV_PKT_SIZE); OUTPUT_LONG_WORD (SHOW_PAD_MSG, .RCV_NPAD); OUTPUT_LONG_WORD (SHOW_PDC_MSG, .RCV_PADCHAR); OUTPUT_LONG_WORD (SHOW_TIM_MSG, .RCV_TIMEOUT); OUTPUT_LONG_WORD (SHOW_EOL_MSG, .RCV_EOL); OUTPUT_LONG_WORD (SHOW_QUO_MSG, .RCV_QUOTE_CHR); OUTPUT_LONG_WORD (SHOW_8QU_MSG, .RCV_8QUOTE_CHR); OUTPUT_LONG_WORD (SHOW_SOH_MSG, .RCV_SOH); END; [SHOW_ALL, SHOW_TRN] : ! BEGIN ! STATUS = LIB$PUT_OUTPUT (SHOW_TRN_HDR); ! INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); ! $FAO (SHOW_TRD_MSG, OUTPUT_SIZE, OUTPUT_DESC, 1, TRANS_DELAY); ! OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; ! STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); ! OUTPUT_TRUE_FALSE (SHOW_TRE_MSG, TRANS_ECHO_FLAG); ! END; ! [SHOW_ALL, SHOW_PAC] : BEGIN OUTPUT_LONG_WORD (SHOW_RPT_MSG, .SET_REPT_CHR); END; TES; END; ! End of COMND_SHOW %SBTTL 'Command execution -- COMND_STATUS' ROUTINE COMND_STATUS : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will display the status of Kermit-32. ! ! CALLING SEQUENCE: ! ! COMND_STATUS (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL STATUS, ! Status returned by system call POINTER, ! Pointer to the LAST_ERROR text CHAR_COUNT; ! Character count BIND TEXT_CR = %ASCID'', TEXT_BAUD = %ASCID' Effective data rate !ZL baud', TEXT_NAKS_SENT = %ASCID' NAKs received !ZL', TEXT_NAKS_RCV = %ASCID' NAKs sent !ZL', TEXT_PKTS_SENT = %ASCID' Packets sent !ZL', TEXT_PKTS_RCV = %ASCID' Packets received !ZL', TEXT_CHR_SENT = %ASCID' Characters sent !ZL', TEXT_DATA_CHAR_SENT = %ASCID' Data characters sent !ZL', TEXT_DATA_CHAR_RCV = %ASCID' Data characters received !ZL', TEXT_CHR_RCV = %ASCID' Characters received !ZL', TEXT_TOTAL_HDR = %ASCID'Totals since Kermit was started', TEXT_XFR_HDR = %ASCID'Totals for the last transfer'; STATUS = LIB$PUT_OUTPUT (TEXT_CR); STATUS = LIB$PUT_OUTPUT (TEXT_XFR_HDR); OUTPUT_LONG_WORD (TEXT_CHR_SENT, .SMSG_TOTAL_CHARS); OUTPUT_LONG_WORD (TEXT_DATA_CHAR_SENT, .SMSG_DATA_CHARS); OUTPUT_LONG_WORD (TEXT_NAKS_SENT, .SMSG_NAKS); OUTPUT_LONG_WORD (TEXT_PKTS_SENT, .SMSG_COUNT); OUTPUT_LONG_WORD (TEXT_CHR_RCV, .RMSG_TOTAL_CHARS); OUTPUT_LONG_WORD (TEXT_DATA_CHAR_RCV, .RMSG_DATA_CHARS); OUTPUT_LONG_WORD (TEXT_NAKS_RCV, .RMSG_NAKS); OUTPUT_LONG_WORD (TEXT_PKTS_RCV, .RMSG_COUNT); IF .XFR_TIME NEQ 0 THEN BEGIN LOCAL Data_Chars, Baud_Rate; IF .RMSG_DATA_CHARS LEQ .SMSG_DATA_CHARS THEN Data_Chars = .SMSG_DATA_CHARS ELSE Data_Chars = .RMSG_DATA_CHARS; Baud_Rate = .Data_Chars * 10 / ((.Xfr_Time + 500) / 1000); OUTPUT_LONG_WORD (TEXT_BAUD, .Baud_Rate); END; ! OUTPUT_LONG_WORD (TEXT_BAUD, .Baud_Rate); ! (((IF .RMSG_DATA_CHARS LEQ .SMSG_DATA_CHARS THEN .SMSG_DATA_CHARS ELSE .RMSG_DATA_CHARS)*10)/(( ! .XFR_TIME + 500)/1000))); STATUS = LIB$PUT_OUTPUT (TEXT_CR); STATUS = LIB$PUT_OUTPUT (TEXT_TOTAL_HDR); OUTPUT_LONG_WORD (TEXT_CHR_SENT, .SND_TOTAL_CHARS); OUTPUT_LONG_WORD (TEXT_DATA_CHAR_SENT, .SND_DATA_CHARS); OUTPUT_LONG_WORD (TEXT_NAKS_SENT, .SND_NAKS); OUTPUT_LONG_WORD (TEXT_PKTS_SENT, .SND_COUNT); OUTPUT_LONG_WORD (TEXT_CHR_RCV, .RCV_TOTAL_CHARS); OUTPUT_LONG_WORD (TEXT_DATA_CHAR_RCV, .RCV_DATA_CHARS); OUTPUT_LONG_WORD (TEXT_NAKS_RCV, .RCV_NAKS); OUTPUT_LONG_WORD (TEXT_PKTS_RCV, .RCV_COUNT); IF .TOTAL_TIME NEQ 0 THEN OUTPUT_LONG_WORD (TEXT_BAUD, (((.RCV_DATA_CHARS + .SND_DATA_CHARS)*10)/((.TOTAL_TIME + 500)/1000))); ! ! Output the error text if there is any ! POINTER = CH$PTR (LAST_ERROR); CHAR_COUNT = 0; WHILE CH$RCHAR_A (POINTER) NEQ CHR_NUL DO CHAR_COUNT = .CHAR_COUNT + 1; IF .CHAR_COUNT NEQ 0 THEN BEGIN INIT_STR_DESC (OUTPUT_DESC, OUTPUT_LINE, OUT_BFR_LENGTH); STATUS = $FAO (%ASCID'Last error: !AD', OUTPUT_SIZE, OUTPUT_DESC, .CHAR_COUNT, LAST_ERROR); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS) ELSE BEGIN OUTPUT_DESC [DSC$W_LENGTH] = .OUTPUT_SIZE; STATUS = LIB$PUT_OUTPUT (OUTPUT_DESC); IF NOT .STATUS THEN LIB$SIGNAL (.STATUS); END; END; END; ! End of SHOW_STATUS %SBTTL 'GET_REM_ARGS - Get extra arguments for remote commands' ROUTINE GET_REM_ARGS (LOCAL_FLAG) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will get any extra arguments required for remote commands. !It will prompt the user and get the input from SYS$COMMAND:. ! ! CALLING SEQUENCE: ! ! STATUS = GET_REM_ARGS (LOCAL_FLAG); ! ! INPUT PARAMETERS: ! ! LOCAL_FLAG - If true, this is for a LOCAL xxx command. Only get the ! arguments we know we need for local commands. Otherwise ! get all possible arguments. ! ! IMPLICIT INPUTS: ! ! REM_TYPE - Type of remote command to get arguments for. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! GEN_xDATA, GEN_xSIZE - Text and sizes of arguments ! ! COMPLETION CODES: ! ! Status values from subroutines called if in error. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL ROUTINE GET_COMMAND; ! Get line from SYS$COMMAND: LOCAL GEN_2DESC : BLOCK [8, BYTE], ! Descriptor for second argument GEN_3DESC : BLOCK [8, BYTE], ! Descriptor for third argument STATUS; ! Random status values ! ! Set up descriptors for second and third arguments ! INIT_STR_DESC (GEN_2DESC, GEN_2DATA, MAX_MSG); INIT_STR_DESC (GEN_3DESC, GEN_3DATA, MAX_MSG); SELECTONE .REM_TYPE OF SET [GC_CONNECT] : IF NOT .LOCAL_FLAG AND .GEN_1SIZE GTR 0 THEN RETURN GET_COMMAND (GEN_2DESC, %ASCID'Password: ', GEN_2SIZE, FALSE); [GC_COPY, GC_RENAME] : WHILE TRUE DO BEGIN STATUS = GET_COMMAND (GEN_2DESC, %ASCID'New file: ', GEN_2SIZE, TRUE); IF NOT .STATUS OR .GEN_2SIZE NEQ 0 THEN RETURN .STATUS; END; [GC_LGN] : BEGIN STATUS = GET_COMMAND (GEN_3DESC, %ASCID'Account: ', GEN_3SIZE, TRUE); IF NOT .STATUS THEN RETURN .STATUS; RETURN GET_COMMAND (GEN_2DESC, %ASCID'Password: ', GEN_2SIZE, FALSE); END; [GC_SEND_MSG] : RETURN GET_COMMAND (GEN_2DESC, %ASCID'Message: ', GEN_2SIZE, TRUE); [GC_WHO] : IF NOT .LOCAL_FLAG THEN RETURN GET_COMMAND (GEN_2DESC, %ASCID'Options: ', GEN_2SIZE, TRUE); TES; ! ! If we fall out of the SELECT, we don't need any arguments ! RETURN TRUE; END; ! End of GET_REM_ARGS %SBTTL 'TPARSE support -- STORE_BLOCKSIZE' ROUTINE STORE_BLOCKSIZE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the blocksize to be used when creating ! BINARY and FIXED files. ! ! CALLING SEQUENCE: ! ! Standard LIB$TPARSE routine call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; ! file_blocksize = .AP [TPA$L_PARAM]; file_blocksize_set = 1; RETURN SS$_NORMAL; END; ! End of STORE_BLOCKSIZE %SBTTL 'TPARSE support -- STORE_DEBUG' ROUTINE STORE_DEBUG = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the debug flag into the DEBUG_FLAG ! location. ! ! CALLING SEQUENCE: ! ! Standard LIB$TPARSE routine call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; DEBUG_FLAG = .AP [TPA$L_PARAM]; RETURN SS$_NORMAL; END; ! End of STORE_DEBUG %SBTTL 'TPARSE support -- STORE_TR_DELAY' ROUTINE STORE_TR_DELAY = ! and below !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the transmit delay into the ! TRANS_DELAY location. ! ! CALLING SEQUENCE: ! ! Standard LIB$TPARSE routine call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! TPARSE_ARGS; ! TRANS_DELAY = .AP [TPA$L_PARAM]; ! RETURN SS$_NORMAL; ! END; ! End of STORE_TR_DELAY %SBTTL 'TPARSE support -- STORE_TR_ECHO' ROUTINE STORE_TR_ECHO = ! and below !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the transmit echo flag into the ! TRANS_ECHO_FLAG location. ! ! CALLING SEQUENCE: ! ! Standard LIB$TPARSE routine call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ! TPARSE_ARGS; ! TRANS_ECHO_FLAG = .AP [TPA$L_PARAM]; ! RETURN SS$_NORMAL; ! END; ! End of STORE_TR_ECHO %SBTTL 'TPARSE support -- STORE_IBM' ROUTINE STORE_IBM = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the IBM flag into the IBM_FLAG ! location. ! ! CALLING SEQUENCE: ! ! Standard LIB$TPARSE routine call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL LITERAL IBM_MODE_ECHO : WEAK, ! IBM mode echo value IBM_MODE_PARITY : WEAK, ! Default parity IBM_MODE_CHARACTER : WEAK; ! And handshake character for ! IBM mode TPARSE_ARGS; IF .AP [TPA$L_PARAM] THEN BEGIN IBM_CHAR = (IF IBM_MODE_CHARACTER NEQ 0 THEN IBM_MODE_CHARACTER ELSE CHR_DC1); PARITY_TYPE = (IF IBM_MODE_PARITY NEQ 0 THEN IBM_MODE_PARITY ELSE PR_MARK); ECHO_FLAG = (IF IBM_MODE_ECHO NEQ 0 THEN IBM_MODE_ECHO ELSE TRUE); END ELSE BEGIN IBM_CHAR = -1; ! Turn IBM mode off ECHO_FLAG = FALSE; ! No local echo PARITY_TYPE = PR_NONE; ! and no parity END; RETURN SS$_NORMAL; END; ! End of STORE_IBM %SBTTL 'TPARSE support -- STORE_ABT' ROUTINE STORE_ABT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the aborted file disposition into ABT_FLAG ! ! CALLING SEQUENCE: ! ! Standard LIB$TPARSE routine call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; ABT_FLAG = .AP [TPA$L_PARAM]; RETURN SS$_NORMAL; END; ! End of STORE_ABT %SBTTL 'TPARSE support -- STORE_CHK' ROUTINE STORE_CHK = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the block check type into XXXX ! location. ! ! CALLING SEQUENCE: ! ! Standard LIB$TPARSE routine call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; CHKTYPE = .AP [TPA$L_PARAM]; RETURN SS$_NORMAL; END; ! End of STORE_CHK %SBTTL 'TPARSE support -- STORE_FTP - Store file type' ROUTINE STORE_FTP = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the file type that was specified by the ! user for the KERFIL processing. ! ! CALLING SEQUENCE: ! ! Standard call from LIB$TPARSE. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; FILE_TYPE = .AP [TPA$L_PARAM]; IF (.FILE_TYPE EQL FILE_FIX) OR (.FILE_TYPE EQL FILE_BIN) THEN BEGIN TT_TEXT(UPLIT('Current block size for file transfer is ', 0)); TT_NUMBER(.file_blocksize); TT_CRLF(); END; RETURN SS$_NORMAL; END; ! End of STORE_FTP %SBTTL 'TPARSE support -- STORE_FNM - Store file type' ROUTINE STORE_FNM = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the file type that was specified by the ! user for the KERFIL processing. ! ! CALLING SEQUENCE: ! ! Standard call from LIB$TPARSE. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; FIL_NORMAL_FORM = .AP [TPA$L_PARAM]; RETURN SS$_NORMAL; END; ! End of STORE_FNM %SBTTL 'TPARSE support -- STORE_PARITY - Store file type' ROUTINE STORE_PARITY = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the type of parity to use for the transfer. ! If a parity type of other than NONE is specified then we will use ! eight-bit quoting to support the transfer. ! ! CALLING SEQUENCE: ! ! Standard call from LIB$TPARSE. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; PARITY_TYPE = .AP [TPA$L_PARAM]; RETURN SS$_NORMAL; END; ! End of STORE_PARITY %SBTTL 'TPARSE support -- STORE_ECHO - Store local echo flag' ROUTINE STORE_ECHO = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the state of the local echo flag as the ! user set it. ! ! CALLING SEQUENCE: ! ! Standard TPARSE argument call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; ECHO_FLAG = .AP [TPA$L_PARAM]; RETURN SS$_NORMAL; END; ! End of STORE_ECHO %SBTTL 'TPARSE support -- STORE_MSG_FIL - Store file name typeout flag' ROUTINE STORE_MSG_FIL = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the state of the file name typeout flag as the ! user set it. ! ! CALLING SEQUENCE: ! ! Standard TPARSE argument call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; TY_FIL = .AP [TPA$L_PARAM]; RETURN SS$_NORMAL; END; ! End of STORE_MSG_FIL %SBTTL 'TPARSE support -- STORE_MSG_PKT - Store packet number typeout flag' ROUTINE STORE_MSG_PKT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store the state of the packet number flag as the ! user set it. ! ! CALLING SEQUENCE: ! ! Standard TPARSE argument call. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; TY_PKT = .AP [TPA$L_PARAM]; RETURN SS$_NORMAL; END; ! End of STORE_MSG_PKT %SBTTL 'TPARSE support -- CHECK_EOL' ROUTINE CHECK_EOL = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will valid the SEND and RECEIVE eol character that ! is being set by the user. ! ! CALLING SEQUENCE: ! ! Standard TPARSE routine calling sequence. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF (.AP [TPA$L_NUMBER] LSS %C' ') AND (.AP [TPA$L_NUMBER] GTR 0) THEN RETURN SS$_NORMAL ELSE RETURN KER_ILLEOL; END; ! End of CHECK_EOL %SBTTL 'TPARSE support -- CHECK_QUOTE' ROUTINE CHECK_QUOTE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will validate the SEND and RECEIVE quoting character that ! is being set by the user. ! ! CALLING SEQUENCE: ! ! Standard TPARSE routine calling sequence. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! Error code or true value ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF (.AP [TPA$L_NUMBER] GEQ %C' ' AND .AP [TPA$L_NUMBER] LSS %C'?') OR (.AP [TPA$L_NUMBER] GEQ %C'`' AND .AP [TPA$L_NUMBER] LSS CHR_DEL) THEN RETURN SS$_NORMAL ELSE RETURN KER_ILLQUO; END; ! End of CHECK_QUO %SBTTL 'TPARSE support -- CHECK_SOH' ROUTINE CHECK_SOH = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will valid the SEND and RECEIVE START_OF_PACKET ! character that is being set by the user. ! ! CALLING SEQUENCE: ! ! Standard TPARSE routine calling sequence. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF (.AP [TPA$L_NUMBER] LSS %C' ') AND (.AP [TPA$L_NUMBER] GTR 0) THEN RETURN SS$_NORMAL ELSE RETURN KER_ILLSOH; END; ! End of CHECK_SOH %SBTTL 'TPARSE support -- CHECK_PAD_CHAR' ROUTINE CHECK_PAD_CHAR = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will valid the SEND and RECEIVE eol character that ! is being set by the user. ! ! CALLING SEQUENCE: ! ! Standard TPARSE routine calling sequence. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF .AP [TPA$L_NUMBER] LSS %C' ' OR .AP [TPA$L_NUMBER] EQL CHR_DEL THEN RETURN SS$_NORMAL ELSE RETURN KER_ILLPADCHR; END; ! End of CHECK_PAD_CHAR %SBTTL 'TPARSE support -- CHECK_NPAD' ROUTINE CHECK_NPAD = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will determine if the padding character specified by the ! user is valid. ! ! CALLING SEQUENCE: ! ! Standard TPARSE calling sequence. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF .AP [TPA$L_NUMBER] LSS 0 THEN RETURN KER_ILLNPAD ELSE RETURN SS$_NORMAL; END; ! End of CHECK_NPAD %SBTTL 'TPARSE support -- CHECK_PACKET_LEN' ROUTINE CHECK_PACKET_LEN = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will determine if the packet length specified by the ! user is valid. ! ! CALLING SEQUENCE: ! ! Standard TPARSE calling sequence. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF .AP [TPA$L_NUMBER] LSS 10 OR .AP [TPA$L_NUMBER] GTR (MAX_MSG - 2) THEN RETURN KER_ILLPKTLEN ELSE RETURN SS$_NORMAL; END; ! End of CHECK_PACKET_LEN %SBTTL 'STORE_TEXT' ROUTINE STORE_TEXT = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will store a single character of the file specification ! that the user gives to the SEND and RECEIVE commands. ! ! FORMAL PARAMETERS: ! ! Character that was parsed. ! ! IMPLICIT INPUTS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! Character stored into the file specification vector. ! ! ROUTINE VALUE and ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF (TEMP_DESC [DSC$W_LENGTH] = .TEMP_DESC [DSC$W_LENGTH] + 1) LSS TEMP_LENGTH THEN BEGIN CH$WCHAR (.AP [TPA$B_CHAR], CH$PTR (TEMP_NAME, .TEMP_DESC [DSC$W_LENGTH] - 1)); AP [TPA$V_BLANKS] = 1; ! Blanks are significant RETURN SS$_NORMAL; END ELSE RETURN KER_LINTOOLNG; END; ! End of STORE_TEXT %SBTTL 'TPARSE support -- COPY_DESC - Copy string to a descriptor' ROUTINE COPY_DESC = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will copy a string to the descriptor passed in the TPARSE ! argument. ! ! CALLING SEQUENCE: ! ! COPY_FILE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TEMP_DESC and TEMP_NAME set up with the device name and length ! in the descriptor. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! Descriptor fields set up. ! TEMP_DESC. ! ! COMPLETION CODES: ! ! 0 - Failure. ! 1 - Success. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; LOCAL DESC_ADDR; DESC_ADDR = .AP [TPA$L_PARAM]; BEGIN MAP DESC_ADDR : REF BLOCK [8, BYTE]; DESC_ADDR [DSC$W_LENGTH] = .TEMP_DESC [DSC$W_LENGTH]; CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1, CH$PTR (.DESC_ADDR [DSC$A_POINTER])); END; RETURN SS$_NORMAL; END; ! End of COPY_FILE %SBTTL 'TPARSE support -- COPY_ALT_FILE - Copy file specification' ROUTINE COPY_ALT_FILE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will copy the file name from the temporary ! descriptor to the descriptor that is used for the file name. ! (ALT_FILE_NAME). ! This is for use by the RECEIVE command so that the user may ! specify an alternate file name for the received file. ! ! CALLING SEQUENCE: ! ! COPY_ALT_FILE(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TEMP_DESC and TEMP_NAME set up with the device name and length ! in the descriptor. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! ALT_FILE_NAME set up with what was in TEMP_NAME and ! TEMP_DESC. ! ! COMPLETION CODES: ! ! 0 - Failure. ! 1 - Success. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN ALT_FILE_SIZE = .TEMP_DESC [DSC$W_LENGTH]; CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1, CH$PTR (ALT_FILE_NAME)); RETURN SS$_NORMAL; END; ! End of COPY_ALT_FILE %SBTTL 'TPARSE support -- COPY_GEN_1DATA - Copy generic command argument' ROUTINE COPY_GEN_1DATA = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will copy the generic command argument from the ! temporary descriptor to the global storage for the argument ! (GEN_1DATA). ! ! CALLING SEQUENCE: ! ! COPY_GEN_1DATA(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TEMP_DESC and TEMP_NAME set up with the device name and length ! in the descriptor. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! GEN_1DATA and GEN_1SIZE set up with what was in TEMP_NAME and ! TEMP_DESC. ! ! COMPLETION CODES: ! ! 0 - Failure. ! 1 - Success. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN GEN_1SIZE = .TEMP_DESC [DSC$W_LENGTH]; CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1, CH$PTR (GEN_1DATA)); RETURN SS$_NORMAL; END; ! End of COPY_GEN_1DATA %SBTTL 'TPARSE support -- COPY_GEN_2DATA - Copy generic command argument' ROUTINE COPY_GEN_2DATA = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will copy the generic command argument from the ! temporary descriptor to the global storage for the argument ! (GEN_2DATA). ! ! CALLING SEQUENCE: ! ! COPY_GEN_2DATA(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TEMP_DESC and TEMP_NAME set up with the device name and length ! in the descriptor. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! GEN_2DATA and GEN_2SIZE set up with what was in TEMP_NAME and ! TEMP_DESC. ! ! COMPLETION CODES: ! ! 0 - Failure. ! 1 - Success. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN GEN_2SIZE = .TEMP_DESC [DSC$W_LENGTH]; CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1, CH$PTR (GEN_2DATA)); RETURN SS$_NORMAL; END; ! End of COPY_GEN_2DATA %SBTTL 'TPARSE support -- COPY_GEN_3DATA - Copy generic command argument' ROUTINE COPY_GEN_3DATA = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will copy the generic command argument from the ! temporary descriptor to the global storage for the argument ! (GEN_3DATA). ! ! CALLING SEQUENCE: ! ! COPY_GEN_3DATA(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TEMP_DESC and TEMP_NAME set up with the device name and length ! in the descriptor. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! GEN_3DATA and GEN_3SIZE set up with what was in TEMP_NAME and ! TEMP_DESC. ! ! COMPLETION CODES: ! ! 0 - Failure. ! 1 - Success. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN GEN_3SIZE = .TEMP_DESC [DSC$W_LENGTH]; CH$COPY (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (TEMP_NAME), 0, .TEMP_DESC [DSC$W_LENGTH] + 1, CH$PTR (GEN_3DATA)); RETURN SS$_NORMAL; END; ! End of COPY_GEN_3DATA %SBTTL 'COPY_TERM_NAME' ROUTINE COPY_TERM_NAME = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will copy the device name from the temporary ! descriptor to the descriptor that is used for the terminal name. ! (TERM_NAME and TERM_DESC). ! It will call KERTRM to validate the name as a usuable terminal. ! ! CALLING SEQUENCE: ! ! COPY_TERM_NAME(); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! TEMP_DESC and TEMP_NAME set up with the device name and length ! in the descriptor. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! TERM_NAME and TERM_DESC set up with what was in TEMP_NAME and ! TEMP_DESC. ! ! COMPLETION CODES: ! ! 0 - Failure. ! 1 - Success. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL JOB_TERM_DESC : BLOCK [8, BYTE]; ! Descriptor for jobs contolling terminal IF NOT CH$FAIL (CH$FIND_NOT_CH (.TEMP_DESC [DSC$W_LENGTH], CH$PTR (.TEMP_DESC [DSC$A_POINTER]), %C' ')) THEN RETURN SET_TRANS_TERM (TEMP_DESC) ELSE IF NOT SET_TRANS_TERM (%ASCID'KER$COMM') THEN IF NOT SET_TRANS_TERM (%ASCID'SYS$INPUT') THEN IF NOT SET_TRANS_TERM (%ASCID'SYS$OUTPUT') THEN IF NOT SET_TRANS_TERM (%ASCID'SYS$COMMAND') THEN RETURN SET_TRANS_TERM (JOB_TERM_DESC); RETURN SS$_NORMAL; END; ! End of COPY_TERM_NAME %SBTTL 'KEY_ERROR - Handle keyword errors' ROUTINE KEY_ERROR = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called from the command parser (LIB$TPARSE) when a keyword ! does not match. It will just return the correct error code. ! ! CALLING SEQUENCE: ! ! STATUS = KEY_ERROR (); ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN TPARSE_ARGS; IF .AP [TPA$V_AMBIG] THEN RETURN KER_AMBIGKEY ELSE RETURN KER_UNKNOWKEY; END; ! End of KEY_ERROR %SBTTL 'XFR_STATUS - Return the transfer status' GLOBAL ROUTINE XFR_STATUS (TYPE, SUB_TYPE) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine is called after either a packet has been received ! correctly at the receive level, a packet has been sent, or ! either a NAK has been sent or received. ! ! CALLING SEQUENCE: ! ! XFR_STATUS (Type); ! ! INPUT PARAMETERS: ! ! Type - ASCII Characters describing the type of transfer ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN EXTERNAL ROUTINE LOG_FAOL; ! ! If we have a journal file (transaction log), then say what we are doing. ! IF .TRANSACTION_OPEN AND .TYPE EQL %C'F' THEN BEGIN FILE_DESC [DSC$W_LENGTH] = .FILE_SIZE; ! Make sure size is right SELECTONE .SUB_TYPE OF SET [%C'S'] : LOG_FAOL (%ASCID'!%T!_Sending file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB); [%C'R'] : LOG_FAOL (%ASCID'!%T!_Receiving file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB); [%C'C'] : LOG_FAOL (%ASCID'!%T!_Closing file !AS!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB); [%C'X'] : LOG_FAOL (%ASCID'!%T!_Aborting file !AS by user request!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB); [%C'Z'] : LOG_FAOL (%ASCID'!%T!_Aborting file group !AS by user request!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB); [%C'D'] : LOG_FAOL (%ASCID'!%T!_Aborting file !AS, partial file saved!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB); [%C'A'] : LOG_FAOL (%ASCID'!%T!_Aborting file !AS due to protocol error!/', UPLIT (0, FILE_DESC), TRANSACTION_RAB); TES; END; IF .TY_PKT THEN BEGIN SELECTONE .TYPE OF SET [%ASCII'R'] : BEGIN IF .SUB_TYPE EQL %C'P' THEN BEGIN TT_TEXT (UPLIT (%ASCIZ' R')); TT_NUMBER (.RMSG_COUNT); END; IF .SUB_TYPE EQL %C'N' THEN BEGIN TT_TEXT (UPLIT (%ASCIZ' R%')); TT_NUMBER (.RMSG_NAKS); END; END; [%ASCII'S'] : BEGIN IF .SUB_TYPE EQL %C'P' THEN BEGIN TT_TEXT (UPLIT (%ASCIZ' S')); TT_NUMBER (.SMSG_COUNT); END; IF .SUB_TYPE EQL %C'N' THEN BEGIN TT_TEXT (UPLIT (%ASCIZ' S%')); TT_NUMBER (.SMSG_NAKS); END; END; TES; TT_OUTPUT (); END; END; ! End of XFR_STATUS %SBTTL 'CRCCLC - Calculate the CRC-CCITT for a message' GLOBAL ROUTINE CRCCLC (POINTER, SIZE) = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will calculate the CRC for a message. It will use ! the VAX LIB$ routine to do all the work. ! ! CALLING SEQUENCE: ! ! CRC = CRCCLC(Pointer, Size) ! ! INPUT PARAMETERS: ! ! Pointer - Character pointer to the message. ! Size - Length of the message. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUPTUT PARAMETERS: ! ! CRC for the message. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LOCAL TEMP_DESC : BLOCK [8, BYTE], ! Temporary descriptor CRC_INITIAL; ! Initial CRC value CRC_INITIAL = 0; ! Set the initial value INIT_STR_DESC (TEMP_DESC, .POINTER, .SIZE); RETURN LIB$CRC (CRC_TABLE, CRC_INITIAL, TEMP_DESC); END; ! End of CRCCLC %SBTTL 'KRM_ERROR - Issue an error message given error code' GLOBAL ROUTINE KRM_ERROR (ERROR_CODE) : NOVALUE = !++ ! FUNCTIONAL DESCRIPTION: ! ! This routine will cause an error message to be issued to the ! user's terminal and/or a message to be sent to the remote KERMIT. ! ! CALLING SEQUENCE: ! ! KRM_ERROR(KER_xxxxxx); ! ! INPUT PARAMETERS: ! ! KER_xxxxxx - Error code from KERERR.REQ ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN LIB$SIGNAL (.ERROR_CODE); END; ! End of KRM_ERROR %SBTTL 'KERM_HANDLER - Condition handler' ROUTINE KERM_HANDLER = !++ ! FUNCTIONAL DESCRIPTION: ! ! This is the condition handler for KERMIT-32. ! ! CALLING SEQUENCE: ! ! Called via LIB$SIGNAL. ! ! INPUT PARAMETERS: ! ! None. ! ! IMPLICIT INPUTS: ! ! None. ! ! OUTPUT PARAMETERS: ! ! None. ! ! IMPLICIT OUTPUTS: ! ! None. ! ! COMPLETION CODES: ! ! None. ! ! SIDE EFFECTS: ! ! None. ! !-- BEGIN BIND FACILITY_DESC = %ASCID'KERMIT32'; BUILTIN AP; LOCAL PUTMSG_VECTOR : VECTOR [10, LONG], SIGARGLST; ! Address of the signal argument list MAP AP : REF BLOCK [, BYTE], SIGARGLST : REF BLOCK [, BYTE]; !++ ! ! Routine to do the actual output of the error message ! !-- ROUTINE HANDLE_MSG = BEGIN EXTERNAL ROUTINE LOG_FAOL; BUILTIN AP; LOCAL ERR_DESC, ! Address of the error descriptor POINTER; ! Pointer to get characters MAP ERR_DESC : REF BLOCK [8, BYTE], AP : REF BLOCK [, BYTE]; ERR_DESC = .AP [4, 0, 32, 0]; IF .TERM_FLAG THEN SND_ERROR (.ERR_DESC [DSC$W_LENGTH], .ERR_DESC [DSC$A_POINTER]); IF .TRANSACTION_OPEN THEN BEGIN OWN TMP_DESC : BLOCK [8, BYTE]; INIT_STR_DESC (TMP_DESC, .ERR_DESC [DSC$A_POINTER], .ERR_DESC [DSC$W_LENGTH]); LOG_FAOL (%ASCID'!%T!_!AS!/', UPLIT (0, TMP_DESC), TRANSACTION_RAB); END; IF NOT .CONNECT_FLAG THEN BEGIN TT_CRLF (); POINTER = CH$PTR (.ERR_DESC [DSC$A_POINTER]); INCR I FROM 1 TO .ERR_DESC [DSC$W_LENGTH] DO TT_CHAR (CH$RCHAR_A (POINTER)); TT_CRLF (); END; RETURN 0; END; SIGARGLST = .AP [CHF$L_SIGARGLST]; IF .SIGARGLST [CHF$L_SIG_NAME] GEQ %X'400' AND .SIGARGLST [CHF$L_SIG_NAME] LEQ %X'5FF' THEN RETURN SS$_RESIGNAL; PUTMSG_VECTOR [0] = .SIGARGLST [CHF$L_SIG_ARGS] - 2; ! No PC and PSL PUTMSG_VECTOR [1] = .SIGARGLST [CHF$L_SIG_NAME]; ! PUTMSG_VECTOR [2] = .SIGARGLST [CHF$L_SIG_ARGS] - 3; ! INCR I FROM 0 TO .SIGARGLST [CHF$L_SIG_ARGS] - 4 DO INCR I FROM 0 TO .SIGARGLST [CHF$L_SIG_ARGS] - 2 DO PUTMSG_VECTOR [.I + 2] = .(SIGARGLST [CHF$L_SIG_ARG1] + (.I*4)); Final_Status = .Putmsg_Vector [1]; $PUTMSG (MSGVEC = PUTMSG_VECTOR, ACTRTN = HANDLE_MSG, FACNAM = FACILITY_DESC); RETURN SS$_CONTINUE; END; ! End of KERM_HANDLER %SBTTL 'End of KERMIT.B32' END ! End of module ELUDOM