::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*KERMIT.COMP.COMI*/ /* KERMIT.COMP.COMI /* /* This command input file compiles the Kermit-R19 source code. /* /* It must be run in a ufd that contains the source modules under a /* subufd named SOURCE, and include files under subufds named INCLUDE /* and PROCS. It puts the object code (.BIN files) under a ufd named OBJ. /* COMO KERMIT.COMP.COMO PLP *>SOURCE>MAIN.PLP -B *>OBJ>MAIN.BIN PLP *>SOURCE>COMND.PLP -B *>OBJ>COMND.BIN PLP *>SOURCE>TYPE.PLP -B *>OBJ>TYPE.BIN PLP *>SOURCE>A2B.PLP -B *>OBJ>A2B.BIN PLP *>SOURCE>B2A.PLP -B *>OBJ>B2A.BIN PLP *>SOURCE>BFR_EMPTY.PLP -B *>OBJ>BFR_EMPTY.BIN PLP *>SOURCE>BFR_FILL.PLP -B *>OBJ>BFR_FILL.BIN PLP *>SOURCE>CHAR.PLP -B *>OBJ>CHAR.BIN PLP *>SOURCE>CHR$.PLP -B *>OBJ>CHR$.BIN PLP *>SOURCE>CTL.PLP -B *>OBJ>CTL.BIN PLP *>SOURCE>MSG_INIT.PLP -B *>OBJ>MSG_INIT.BIN PLP *>SOURCE>PRS_SEND_INIT.PLP -B *>OBJ>PRS_SEND_INIT.BIN PLP *>SOURCE>REC_DATA.PLP -B *>OBJ>REC_DATA.BIN PLP *>SOURCE>REC_FILE.PLP -B *>OBJ>REC_FILE.BIN PLP *>SOURCE>REC_INIT.PLP -B *>OBJ>REC_INIT.BIN PLP *>SOURCE>REC_MESSAGE.PLP -B *>OBJ>REC_MESSAGE.BIN PLP *>SOURCE>REC_PACKET.PLP -B *>OBJ>REC_PACKET.BIN PLP *>SOURCE>REC_WORKER_SWITCH.PLP -B *>OBJ>REC_WORKER_SWITCH.BIN PLP *>SOURCE>SEND_BREAK.PLP -B *>OBJ>SEND_BREAK.BIN PLP *>SOURCE>SEND_DATA.PLP -B *>OBJ>SEND_DATA.BIN PLP *>SOURCE>SEND_EOF.PLP -B *>OBJ>SEND_EOF.BIN PLP *>SOURCE>SEND_FILE.PLP -B *>OBJ>SEND_FILE.BIN PLP *>SOURCE>SEND_INIT.PLP -B *>OBJ>SEND_INIT.BIN PLP *>SOURCE>SEND_PACKET.PLP -B *>OBJ>SEND_PACKET.BIN PLP *>SOURCE>SEND_SWITCH.PLP -B *>OBJ>SEND_SWITCH.BIN PLP *>SOURCE>SERVER.PLP -B *>OBJ>SERVER.BIN PLP *>SOURCE>SET_SEND_INIT.PLP -B *>OBJ>SET_SEND_INIT.BIN PLP *>SOURCE>UNCHAR.PLP -B *>OBJ>UNCHAR.BIN PLP *>SOURCE>CHKS.PLP -B *>OBJ>CHKS.BIN PLP *>SOURCE>FILE_INIT.PLP -B *>OBJ>FILE_INIT.BIN PLP *>SOURCE>LN$PAR.PLP -B *>OBJ>LN$PAR.BIN PLP *>SOURCE>FILE_CLOSE.PLP -B *>OBJ>FILE_CLOSE.BIN PLP *>SOURCE>FILE_OPEN.PLP -B *>OBJ>FILE_OPEN.BIN PLP *>SOURCE>NEXT_FILE.PLP -B *>OBJ>NEXT_FILE.BIN PLP *>SOURCE>BK_HNDLR.PLP -B *>OBJ>BK_HNDLR.BIN PLP *>SOURCE>TIMEOUT_HNDLR.PLP -B *>OBJ>TIMEOUT_HNDLR.BIN PMA *>SOURCE>CHAR_OCT -B *>OBJ>CHAR_OCT.BIN -L NO PMA *>SOURCE>MOD_64 -B *>OBJ>MOD_64.BIN -L NO PMA *>SOURCE>SHIFT -B *>OBJ>SHIFT.BIN -L NO PMA *>SOURCE>WILD$_DYNT -B *>OBJ>WILD$_DYNT.BIN -L NO PMA *>SOURCE>LIMIT$_DYNT -B *>OBJ>LIMIT$_DYNT.BIN -L NO FTN *>SOURCE>KERTRN -B *>OBJ>KERTRN.BIN -64V ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*KERMIT.BUILD.COMI*/ /* KERMIT.BUILD.COMI /* /* This command input file will link the Kermit-R19 object code, to /* create a KERMIT.SEG file. /* /* A subufd named OBJ must exist that contains all of the object code /* modules (.BIN files). /* /* To compile the source code in preparation, use KERMIT.COMP.COMI. COMO KERMIT.BUILD.COMO SEG VL KERMIT.SEG LO *>OBJ>MAIN LO *>OBJ>COMND LO *>OBJ>CHAR_OCT LO *>OBJ>MOD_64 LO *>OBJ>SHIFT LO *>OBJ>TYPE LO *>OBJ>A2B LO *>OBJ>B2A LO *>OBJ>BFR_EMPTY LO *>OBJ>BFR_FILL LO *>OBJ>CHAR LO *>OBJ>CHR$ LO *>OBJ>CTL LO *>OBJ>KERTRN LO *>OBJ>MSG_INIT LO *>OBJ>PRS_SEND_INIT LO *>OBJ>REC_DATA LO *>OBJ>REC_FILE LO *>OBJ>REC_INIT LO *>OBJ>REC_MESSAGE LO *>OBJ>REC_PACKET LO *>OBJ>REC_WORKER_SWITCH LO *>OBJ>SEND_BREAK LO *>OBJ>SEND_DATA LO *>OBJ>SEND_EOF LO *>OBJ>SEND_FILE LO *>OBJ>SEND_INIT LO *>OBJ>SEND_PACKET LO *>OBJ>CHKS LO *>OBJ>SEND_SWITCH LO *>OBJ>SERVER LO *>OBJ>SET_SEND_INIT LO *>OBJ>UNCHAR LO *>OBJ>FILE_INIT LO *>OBJ>LN$PAR LO *>OBJ>FILE_CLOSE LO *>OBJ>FILE_OPEN LO *>OBJ>NEXT_FILE LO *>OBJ>LIMIT$_DYNT LO *>OBJ>WILD$_DYNT LO *>OBJ>BK_HNDLR LO *>OBJ>TIMEOUT_HNDLR LI VAPPLB LI MAP KERMIT.MAP SAVE Q ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*KERMIT.TREE.CREATE.CPL*/ /* KERMIT.TREE.CREATE.CPL /* /* CPL program to transform a "flat" ufd containing Kermit code /* into a structured ufd, ready to have the code compiled. /* /* This program is to be run in a ufd containing all the files /* taken from the Kermit-R19 magnetic tape. /* /* It creates sub-ufds named: /* /* SOURCE INCLUDE PROCS OBJ /* /* It copies files from the home ufd to the subufd under which /* they belong, deleting the original. /* /* Some files will be left in the home ufd, namely /* /* #READ_ME /* KERMIT.COMP.COMI /* KERMIT.BUILD.COMI /* KERMIT.TREE.CREATE.CPL /* KERMIT.TREE.REV18.CPL /* /* After this program has run, invoke KERMIT.COMP.COMI to compile /* all source code, and then KERMIT.BUILD.COMI to link together the /* Kermit-R19 program. /* /* Good Luck! CREATE SOURCE &S UNIT := 0 &DO F &ITEMS [WILD SOURCE#@@ -FILES -SINGLE UNIT] &S G := [AFTER %F% 'SOURCE#'] COPY %F% *>SOURCE>%G% -RPT -DL -NQ &END CREATE PROCS &S UNIT := 0 &DO F &ITEMS [WILD PROCS#@@ -FILES -SINGLE UNIT] &S G := [AFTER %F% 'PROCS#'] COPY %F% *>PROCS>%G% -RPT -DL -NQ &END CREATE INCLUDE &S UNIT := 0 &DO F &ITEMS [WILD INCLUDE#@@ -FILES -SINGLE UNIT] &S G := [AFTER %F% 'INCLUDE#'] COPY %F% *>INCLUDE>%G% -RPT -DL -NQ &END CREATE OBJ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*KERMIT.TREE.REV18.CPL*/ /* KERMIT.TREE.REV18.CPL /* /* CPL program to transform a "flat" ufd containing Kermit code /* into a structured ufd, ready to have the code compiled. /* /* This program is to be run in a ufd containing all the files /* taken from the Kermit-R19 magnetic tape. /* /* It creates sub-ufds named: /* /* SOURCE INCLUDE PROCS OBJ /* /* It copies files from the home ufd to the subufd under which /* they belong, deleting the original. /* /* Some files will be left in the home ufd, namely /* /* #READ_ME /* KERMIT.COMP.COMI /* KERMIT.BUILD.COMI /* KERMIT.TREE.REV18.CPL /* KERMIT.TREE.CREATE.CPL /* /* After this program has run, invoke KERMIT.COMP.COMI to compile /* all source code, and then KERMIT.BUILD.COMI to link together the /* Kermit-R19 program. /* /* Good Luck! &DATA FUTIL CREATE SOURCE CREATE PROCS CREATE INCLUDE CREATE OBJ FROM * TO *>SOURCE &S UNIT := 0 &DO F &ITEMS [WILD SOURCE#@@ -FILES -SINGLE UNIT] &S G := [AFTER %F% 'SOURCE#'] COPY %F% %G% DELETE %F% &END TO *>PROCS &S UNIT := 0 &DO F &ITEMS [WILD PROCS#@@ -FILES -SINGLE UNIT] &S G := [AFTER %F% 'PROCS#'] COPY %F% %G% DELETE %F% &END TO *>INCLUDE &S UNIT := 0 &DO F &ITEMS [WILD INCLUDE#@@ -FILES -SINGLE UNIT] &S G := [AFTER %F% 'INCLUDE#'] COPY %F% %G% DELETE %F% &END QUIT &END &RETURN ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*KERMIT.DOC*/ 1Contents i - CONTENTS +CONTENTS - 0Transferring files between the Prime and your PC . . . . . 1 +Transferring files between the Prime and your PC 1 01 Running Kermit on the Prime . . . . . . . . . . . . . 1 2 File Naming Conventions . . . . . . . . . . . . 3 3 Default Kermit-R19 SET Parameters . . . . . . . 3 4 Kermit Commands Available for the Prime . . . . . . . 3 5 SERVER Command . . . . . . . . . . . . . . . . 3 6 INIT Command . . . . . . . . . . . . . . . . . 4 7 PORTFILE Routine . . . . . . . . . . . . . . . 4 8 Sample Session . . . . . . . . . . . . . . . . 5 1ii 1Contents 1 - TRANSFERRING FILES BETWEEN THE PRIME AND YOUR PC +TRANSFERRING FILES BETWEEN THE PRIME AND YOUR PC - - 0Normally, when you use your PC, you are "talking" directly to it; your commands are interpreted directly by the operating system or by some program, such as an editor, a text formatter, or SPSS/PC. Kermit is a means for connecting two computers through their terminal (TTY) ports, tricking one computer (or both) into acting as though the other is a terminal. Once two computers are connected in this way, cooperating programs can be run on each computer to achieve the desired communications by means of a communication protocol. 0 Kermit embodies a set of rules for transferring files reliably between computers. In general, one computer is a large system (the mainframe Prime acts as a host, and contains many terminals) and the other is a personal computer (PC). The host believes that the PC is an ordinary terminal. In order for the Kermit protocol to occur, a Kermit program must be running on each end of the communication line--one on the Prime as host, one on the PC. 0 This documentation supplements the documentation in SPSS/PC. You should read that documentation first. +_______ 0 Tranfer of SPSS portable system files requires the use of the PORTFILE command described below. -1 Running Kermit on the Prime +1 Running Kermit on the Prime 0The Prime version of Kermit was developed under Prime REV19 and issues the prompt KERMIT-R19>. It has run successfully under REV18, also. Kermit-R19 does not accept any abbreviations for commands; you must type command names in full. It does not give guide words or respond to ? with information on what may be done next. Kermit-R19 does not accept tree names. It searches for and places files in the currently attached directory. If you want to send or receive files from another directory, exit from Kermit, attach to the desired UFD, and restart Kermit-R19. 0 Kermit lets you use your PC as a remote Prime terminal, where you issue PRIMOS commands; as a "dumb" terminal which accepts Kermit-R19 and Kermit-PC commands; and as a regular PC. You can always verify which operating system or Kermit you are at by typing a carriage return and examining the prompt. The PRIMOS prompt does not appear when you transfer from the PC to PRIMOS. 12 - 1 First you start Kermit on the PC by typing + 1 0 KERMIT 0 Once you have activated PC Kermit, use the STATUS command to make sure that parity is set to "MARK," the back-arrow is set to "backspace," and that the baud rate is correct for the modem. If these parameters have to be changed, use the Kermit-PC SET command. 0 2 Dial the number required to activate a port on the + 2 mainframe Prime. Connect the link by typing "C" (for CONNECT) on the PC. Now the PC is functioning like a remote terminal. 0 3 Login normally to the Prime. You may have to hit the + 3 carriage return a couple of times to get "LOGIN PLEASE" message. 0 4 Check to make sure your kill character is a non-printing + 4 character. (On the Prime, the kill character indicates a line delete.) You must change the default kill character from a question mark (?) to some non-printing character (such as CTRL-X), so that Kermit does not interpret it as a signal to erase the line. 0 5 Attach to the directory in which you want to send or + 5 receive files. If you are sending SPSS portable files, they must be processed with PORTFILE prior to sending them to the PC. 0 6 Start-up Prime Kermit. At some sites this is done with + 6 the command 0 KERMIT 0 Check with your local systems staff to see how this is done at your site. 0 7 Set up the Prime Kermit environment and perform file + 7 transfers using the commands listed in the PC Kermit Documentation or use the SERVER command described below. 0 8 If you have sent SPSS portable files from the PC to the + 8 Prime, be sure to run them through PORTFILE prior to reading them with the SPSS-X IMPORT command. PORTFILE is run on Prime Kermit. 0 9 Exit from Prime Kermit. + 9 010 LOGOUT from Prime. +10 011 Exit from PC Kermit +11 1Contents 3 - 2 File Naming Conventions +2 File Naming Conventions 0Kermit makes every attempt to retain the names of transferred files. The file naming conventions on the PC allow filenames of eight characters followed by a three character extension. PRIMOS uses filenames of up to 32 characters, including suffixes. When you send files "down" to the PC or "up" to the Prime, some file names or extensions may be truncated if the names are too long or changed by Kermit to prevent filename conflicts and conform to naming conventions. Check your directory or UFD to see if any names have changed. -3 Default Kermit-R19 SET Parameters +3 Default Kermit-R19 SET Parameters 0The default SET parameters for Kermit-R19 (shown with the SHOW ALL command) are 0 Delay (seconds) before sending 1st packet........ 5 File Type to send/receive........................ASCII Number pad chars to send......................... 0 Pad character to send............................200 (octal) Quote character to receive.......................'#' 8-bit Quoting character desired (good only if the file type is BINARY).................'N' 0These parameters can be changed using the SET command, described in the SPSS/PC Kermit documentation. You do not have to make any changes to transfer portable files. Portable files must be sent as ASCII files. 0 The Kermit-PC STATUS command lists other available options, including the baud rate and parity settings. -4 Kermit Commands Available for the Prime +4 Kermit Commands Available for the Prime 0Kermit on the Prime always issues the prompt, KERMIT-R19>. In response to this prompt, you can issue commands which give help, show current parameter settings, and transfer files. These commands are described in the SPSS/PC Kermit Documentation. 0 The Prime implementation of Kermit supports the use of the SERVER command and allows you to set parameters from an external file with the INIT command. -5 SERVER Command +5 SERVER Command 0The SERVER command saves you from moving back and forth between Kermit-PC and Kermit-R19. Once you have established the connection between your PC and the Prime, you type SERVER at Kermit-R19, reconnect to Kermit-PC and then issue commands that transfer files. 14 - 1 Follow steps 1 through 7 above. + 1 0 2 Issue the SERVER command by typing SERVER. + 2 0 3 Reconnect to Kermit-PC by typing CTRL-] c + 3 0 4 Issue commands recognized by the server described below. + 4 0The available commands for the SERVER are 0SEND transfers files from the current PC directory to the +SEND currently attached Prime directory. SEND takes a filename as the argument or you can send groups of files using the PC wildcard conventions. 0RECEIVE transfers files from the currently attached Prime +RECEIVE directory to the current PC directory. RECEIVE takes a filename as the argument or you can receive groups of files using Prime wildcard conventions. 0FINISH exits from Kermit-R19 and returns control to PRIMOS. +FINISH You should re-connect to the Prime and perform additional operations or LOGOUT. 0BYE (alias LOGOUT) exits from Kermit-R19 and LOGOUT from +BYE Prime. -6 INIT Command +6 INIT Command 0The INIT command uses a file containing SET parameters to establish the Kermit environment. You build this file on the Prime using an editor. The file serves a command input (COMI) file. The INIT command is used at the Kermit-R19 level and executes the SET commands contained in the file. The INIT command takes the following form 0 INIT filename 0The file contains commands that are available for Kermit-R19. After establishing the Kermit-R19 environment with SET commands, you can issue PORTFILE (with the appropriate responses), SHOW, or HELP commands. If you issue the SERVER, SEND or RECEIVE command, it must be the last command in the INIT file. The first SERVER, SEND, or RECEIVE command encountered is executed and expects a response from Kermit-PC. -7 PORTFILE Routine +7 PORTFILE Routine 0The PORTFILE routine run within Kermit-R19 is used to translate characters contained in SPSS portable files transferred by Kermit between your PC and the Prime. The current portable file configuration forces Kermit to replace some characters which are not interpreted by IMPORT and 1Contents 5 - EXPORT. The PORTFILE routine takes care of any problematic characters. PORTFILE is run on the Prime prior to sending a portable file to the PC or after receiving a portable file from the PC. You must not run data or command files through the PORTFILE routine. 0 PORTFILE is an interactive routine which prompts you for the type of file, the name of the input file, and a name for the translated file. PORTFILE queries you until it has all the information it needs to perform the translation. If one of the file names already exists, PORTFILE asks if you want to overwrite the file. You cannot use the same name for the input file and the converted version. A run to translate a portable file received from the PC looks like 0 Are you converting a file to send to a PC? NO Are you converting a file received from a PC? YES Name of file to convert: almanac.ker Name for converted file: almanac.kermxfil File already exists. Do you wish to overwrite? NO Name for converted file: almanac.kxfil 0The file is then converted and both files appear in the current Prime directory. -8 Sample Session +8 Sample Session 0In this sample session, a portable file is being sent from the PC to the Prime using the SERVER command and then translating the file using the PORTFILE command. Assume that steps one through six have been followed and that the Kermit-R19 environment has been established. 0 At Kermit-R19 level, type 0 SERVER 0To return to Kermit-PC, type 0 CTRL-] C 0Now you issue one of the commands available with the server to send or receive files. To send the portable file, type 0 SEND ALMANAC.KER 0You do not have to receive the file. The SERVER operates at the Kermit-R19 level and receives the file. You can send groups of files using PC-DOS wildcard conventions. To exit from the SERVER, type 0 FINISH 16 - The FINISH command exits from Kermit-R19. To reconnect to PRIMOS, type 0 C 0Now your PC is acting as a terminal connected to the Prime. Since a portable file has been sent, the Kermit-R19 PORTFILE routine must be executed. To enter Kermit-R19, type 0 KERMIT 0To get to the translation routine, type 0 PORTFILE 0The PORTFILE routine asks questions about the type of conversion, the name of the input file, and the name of the output file. You must answer each question. 0 Are you converting a file to send to a PC? n Are you converting a file received from a PC? y Name of file to convert: almanac.ker Name for converted file: almanac.kxfil 0When you use SPSS-X IMPORT commmand, the converted file, almanac.kxfil, is used. 0To leave Kermit-R19, type 0 EXIT 0You can continue to use your PC as a remote terminal to the Prime or logout by typing 0 LOGOUT 0To return to Kermit-PC, type 0 CTRL-] C 0To exit from Kermit-PC and return control to DOS, type 0 EXIT ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERCOM.REQ*/ %nolist; /**************************************************** * FACILITY: * KERMIT-R19 * * ABSTRACT: * This file contains the common definitions for KERMIT-R19. * * ENVIRONMENT: * User mode * * AUTHOR: Timothy P. Sabin, The SOURCE Telecomputing * CREATION DATE: 08-July-1983 * * MODIFIED BY: * ****************************************************/ /* * EQUATED SYMBOLS: * * Function types passed to FILE_OPEN routine. */ %replace FNC_READ by 0, /* Open for reading */ FNC_WRITE by 1; /* Open for writing */ /* * File types used */ %replace FILE_ASC by 1, /* ASCII files (SEVEN-BIT) */ FILE_BIN by 2; /* Binary files */ /* * Character definitions */ %replace CHR_NUL by '80'B4, /* Null (tape feed character, fill charac */ CHR_SOH by '81'B4, /* Start of header */ CHR_STX by '82'B4, /* Start of text */ CHR_ETX by '83'B4, /* End of text */ CHR_EOT by '84'B4, /* End of transmission */ CHR_ENQ by '85'B4, /* Enquiry (WRU "Who are you?") */ CHR_ACK by '86'B4, /* Acknowledge */ CHR_BEL by '87'B4, /* Bell */ CHR_BS by '88'B4, /* Backspace */ CHR_TAB by '89'B4, /* Horizontal tab */ CHR_LFD by '8A'B4, /* Line feed */ CHR_VTB by '8B'B4, /* Vertical tab */ CHR_FFD by '8C'B4, /* Form feed */ CHR_CRT by '8D'B4, /* Carriage return */ CHR_SO by '8E'B4, /* Shift out */ CHR_SI by '8F'B4, /* Shift in */ CHR_DLE by '90'B4, /* Data link escape */ CHR_DC1 by '91'B4, /* Device control 1 (also XON) */ CHR_DC2 by '92'B4, /* Device control 2 (also TAPE or AUX ON) */ CHR_DC3 by '93'B4, /* Device control 3 (also XOFF) */ CHR_DC4 by '94'B4, /* Device control 4 (also AUX OFF) */ CHR_NAK by '95'B4, /* Negative acknowledge */ CHR_SYN by '96'B4, /* Synchronous idle (SYNC) */ CHR_ETB by '97'B4, /* End of transmission block */ CHR_CAN by '98'B4, /* Cancel */ CHR_EM by '99'B4, /* End of medium */ CHR_SUB by '9A'B4, /* Substitute */ CHR_ESC by '9B'B4, /* Escape */ CHR_FS by '9C'B4, /* File separator */ CHR_GS by '9D'B4, /* Group separator */ CHR_RS by '9E'B4, /* Record separator */ CHR_US by '9F'B4, /* Unit separator */ CHR_CTL_A by '81'B4, /* Control-A */ CHR_CTL_B by '82'B4, /* Control-B */ CHR_CTL_C by '83'B4, /* Control-C */ CHR_CTL_D by '84'B4, /* Control-D */ CHR_CTL_E by '85'B4, /* Control-E */ CHR_CTL_F by '86'B4, /* Control-F */ CHR_CTL_G by '87'B4, /* Control-G */ CHR_CTL_H by '88'B4, /* Control-H */ CHR_CTL_I by '89'B4, /* Control-I */ CHR_CTL_J by '8A'B4, /* Control-J */ CHR_CTL_K by '8B'B4, /* Control-K */ CHR_CTL_L by '8C'B4, /* Control-L */ CHR_CTL_M by '8D'B4, /* Control-M */ CHR_CTL_N by '8E'B4, /* Control-N */ CHR_CTL_O by '8F'B4, /* Control-O */ CHR_CTL_P by '90'B4, /* Control-P */ CHR_CTL_Q by '91'B4, /* Control-Q */ CHR_CTL_R by '92'B4, /* Control-R */ CHR_CTL_S by '93'B4, /* Control-S */ CHR_CTL_T by '94'B4, /* Control-T */ CHR_CTL_U by '95'B4, /* Control-U */ CHR_CTL_V by '96'B4, /* Control-V */ CHR_CTL_W by '97'B4, /* Control-W */ CHR_CTL_X by '98'B4, /* Control-X */ CHR_CTL_Y by '99'B4, /* Control-Y */ CHR_CTL_Z by '9A'B4, /* Control-Z */ CHR_DEL by 'FF'B4, /* Delete */ CHR_ESCAPE by '9D'B4; /* Connect escape character */ /* * Constants */ %replace TRUE by 1, /* Value of true */ FALSE by 0, /* Value of FALSE. */ INIT_DELAY by 5, /* Initial delay time */ MAX_RETRIES by 30, /* Maximum number of retries */ MAX_MSG by 96; /* Maximum message length */ /* KEY FOR THE CHECK ROUTINES */ % REPLACE CHECK_SERVER BY 1, CHECK_INIT BY 2, CHECK_FILE BY 3, CHECK_DATA BY 4; declare tnou entry (char (*),fixed); declare tnoua entry (char (*),fixed); declare todec entry (fixed); %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERERR.REQ*/ %nolist; %replace /* * GENERAL MESSAGES AND ERRORS */ KER_NORMAL by 0, KER_INTERNALERR by 1, /* * FILE PROCESSING ERROR MESSAGES AND WARNINGS. */ KER_EOF by 2, KER_NOMORFILES by 3, KER_ILLFILTYP by 4, /* * MESSAGE LEVEL PROCESSING ERROR MESSAGES AND WARNINGS. */ KER_EXIT by 5, KER_UNIMPLGEN by 6, KER_PROTOERR by 7, /* * TERMINAL LEVEL PROCESSING MESSAGES */ KER_TIMEOUT by 8; %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERFIL_EQUS.PLP*/ /* * EQUATED SYMBOLS: * * Various states for reading the data from the file */ %replace F_STATE_PRE by 0, /* Prefix state */ F_STATE_PRE1 by 1, /* Other prefix state */ F_STATE_DATA by 2, /* Data processing state */ F_STATE_POST by 3, /* Postfix processing state */ F_STATE_POST1 by 4, /* Secondary postfix processing state */ F_STATE_MIN by 0, /* Min state number */ F_STATE_MAX by 4; /* Max state number */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERFIL_GLOBAL.PLP*/ /* * Global storage: */ declare FILE_TYPE fixed bin external; /* Type of file being xfered */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERFIL_LOCAL.PLP*/ /* * OWN STORAGE: */ declare UNIT fixed bin external; /* File unit being used */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERMIT_LOCAL.PLP*/ %nolist; /* KERMIT Local storage */ declare show_type fixed bin external; /* Type of SHOW subcommand */ %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERMSG_GLOBAL.PLP*/ %nolist; declare /* * Receive parameters */ RCV_PKT_SIZE fixed bin external, /* Receive packet size */ RCV_NPAD fixed bin external, /* Padding length */ RCV_PADCHAR char(1) aligned external, /* Padding character */ RCV_TIMEOUT fixed bin external, /* Time out */ RCV_EOL char(1) aligned external, /* EOL character */ RCV_QUOTE_CHR char(1) aligned external, /* Quote character */ RCV_8QUOTE_CHR char(1) aligned external, /* 8-bit quoting character */ /* * Send parameters */ SND_PKT_SIZE fixed bin external, /* Send packet size */ SND_NPAD fixed bin external, /* Padding length */ SND_PADCHAR char(1) aligned external, /* Padding character */ SND_TIMEOUT fixed bin external, /* Time out */ SND_EOL char(1) aligned external, /* EOL character */ SND_QUOTE_CHR char(1) aligned external, /* Quote character */ SND_8QUOTE_CHR char(1) aligned external, /* 8-bit quoting character */ /* * Misc constants */ FILE_NAME char(64) var external, DELAY fixed bin external; /* Amount of time to delay */ %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERMSG_LOCAL.PLP*/ %nolist; /* * LOCAL OWN STORAGE: */ declare STATE fixed bin external, /* Current state */ OLD_RETRIES fixed bin external, /* Saved number of retries done */ NUM_RETRIES fixed bin external, /* Number of retries */ MSG_NUMBER fixed bin external, /* Current message number */ REC_SEQ fixed bin external, /* Sequence number of msg */ REC_LENGTH fixed bin external, /* Length of the message recv'd */ REC_TYPE char(1) aligned external, /* Type of the message received */ REC_MSG char(MAX_MSG) var external, /* Message received */ SND_MSG char(MAX_MSG) var external, /* Message sent */ int_buffer char(260) external, /* Intermediate file buffer */ int_buf_ptr fixed bin external, /* Pointer into int_buffer */ OPEN_FLAG bit(1) aligned external, /* File is opened */ matches(50) char(32) var external; /* Multiple File (send) List */ %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#MSG_TYPES.PLP*/ %nolist; /************************************************** * The MESSAGE-DEPENDENT information field of the message contains at * least one part That is the type of message The remainder of the message * MESSAGE-DEPENDENT field is different depending on the message * * * * * The type defines the type of message that is being processed * *****************************************************/ /* Protocol version 10 message types */ %replace MSG_DATA by 'D', /* Data packet */ MSG_ACK by 'Y', /* Acknowledgement */ MSG_NAK by 'N', /* Negative acknowledgement */ MSG_SND_INIT by 'S', /* Send initiate */ MSG_BREAK by 'B', /* Break transmission */ MSG_FILE by 'F', /* File header */ MSG_EOF by 'Z', /* End of file (EOF) */ MSG_ERROR by 'E'; /* Error */ /* Protocol version 20 message types */ %replace MSG_RCV_INIT by 'R', /* Receive initiate */ MSG_COMMAND by 'C', /* Host command */ MSG_TEXT by 'X', /* Plain Text */ MSG_KERMIT by 'G'; /* Generic KERMIT command */ /************************************************** * Generic KERMIT commands *****************************************************/ %replace MSG_GEN_LOGIN by 'I', /* Login */ MSG_GEN_EXIT by 'F', /* Finish (exit to OS) */ MSG_GEN_CONNECT by 'C', /* Connect to a directory */ MSG_GEN_LOGOUT by 'L', /* Logout */ MSG_GEN_DIRECTORY by 'D', /* Directory */ MSG_GEN_DISK_USAGE by 'U', /* Disk usage */ MSG_GEN_DELETE by 'E', /* Delete a file */ MSG_GEN_TYPE by 'T', /* Type a file specification */ MSG_GEN_SUBMIT by 'S', /* Submit */ MSG_GEN_PRINT by 'P', /* Print */ MSG_GEN_WHO by 'W', /* Who's logged in */ MSG_GEN_SEND by 'M', /* Send a message to a user */ MSG_GEN_HELP by 'H', /* Help */ MSG_GEN_QUERY by 'Q'; /* Query status */ %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#PACKET_DEFS.PLP*/ %nolist; /************************************************** * The following define the various offsets of the standard KERMIT * packets *****************************************************/ %replace PKT_COUNT by 2, /* */ PKT_SEQ by 3, /* */ PKT_TYPE by 4, /* */ PKT_MSG by 5, /* * <8-bit-quote> * * BUFSIZ * Sending Kermit's maximum buffer size * * Timeout * Number of seconds after which the sending Kermit wishes to be timed out * * Npad * Number of padding caracters the sending Kermit needs preceding each * packet * * PAD * Padding character * * EOL * A line terminator required on all packets set by the receiving * Kermit * * Quote * The printable ASCII characer the sending Kermit will use when quoting * the control cahracters Default is "#" * * 8-bit-quote * Specify quoting mecanism for 8-bit quantities A quoting mecanism is * mecessary when sending to hosts which prevent the use of the 8th bit * for data When elected, the quoting mechanism will be used by both * hosts, and the quote character must be in the range of 41-76 or 140-176 * octal, but different from the control-quoting character This field is * interpreted as follows: * * "Y" - I agree to 8-bit quoting if you request it * "N" - I will not do 8-bit quoting * "&" - (or any other character in the range of 41-76 or 140-176) I want * to do 8-bit quoting using this character (it will be done if the * other Kermit puts a "Y" in this field * Anything else: Quoting will not be done * * Fields 8 to 11 reserved *****************************************************/ %replace P_SI_BUFSIZ by 0, /* Buffersize */ MY_PKT_SIZE by 94, /* My packet size */ P_SI_TIMOUT by 1, /* Time out */ MY_TIME_OUT by 15, /* My time out */ P_SI_NPAD by 2, /* Number of padding characters */ MY_NPAD by 0, /* Amount of padding I require */ P_SI_PAD by 3, /* Padding character */ MY_PAD_CHAR by '80'B4, /* My pad character */ P_SI_EOL by 4, /* End of line character */ MY_EOL_CHAR by '8D'B4, /* My EOL cahracter */ P_SI_QUOTE by 5, /* Quote character */ MY_QUOTE_CHAR by '#', /* My quoting character */ P_SI_8QUOTE by 6, /* 8-bit quote */ MY_8BIT_QUOTE by 'N', /* Don't do it */ P_SI_LENGTH by 7; /* Length of the message */ %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#STATES.PLP*/ %nolist; /************************************************** * The following are the various states that KERMIT can be in * The state transitions are defined in the KERMIT Protocol manual *****************************************************/ %replace STATE_S by 1, /* Send init state */ STATE_SF by 2, /* Send file header */ STATE_SD by 3, /* Send file data packet */ STATE_SZ by 4, /* Send EOF packet */ STATE_SB by 5, /* Send break */ STATE_R by 6, /* Receive state (wait for send-i) */ STATE_RF by 7, /* Receive file header packet */ STATE_RD by 8, /* Receive file data packet */ STATE_X by 9, /* Text send init */ STATE_XF by 10, /* Text header */ STATE_C by 11, /* Send complete */ STATE_A by 12; /* Abort */ %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*INCLUDE#KERMIT_EQUS.PLP*/ %nolist; /********************************************************* * * Equates for module KERMIT * ********************************************************/ /* Command EQU's: */ %replace cmd_exit by 2, /* Exit command */ cmd_help by 3, /* Help command */ cmd_quit by 4, /* Quit command */ cmd_rece by 5, /* Receive command */ cmd_set by 6, /* Set command */ cmd_send by 7, /* Send command */ cmd_server by 8, /* Server command */ cmd_show by 9, /* Show command */ cmd_port by 10, /* SPSS portable file conversion */ cmd_init by 11; /* Initialize command */ /* SHOW subcommand EQU's: */ %replace show_all by 1, /* Show all info available */ show_delay by 2, /* Show delay in seconds */ show_file_type by 3, /* Show file type */ show_npad by 4, /* Show number pad chars to send */ show_padchar by 5, /* Show padding character */ show_quote by 6, /* Show quote character to receive */ show_8quote by 7; /* Show 8-bit quote character desired */ %list; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#A2B.EXT*/ declare a2b entry (char(*),fixed bin) returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#B2A.EXT*/ declare b2a entry (fixed bin) returns(char(1)); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#BFR_EMPTY.EXT*/ declare bfr_empty entry (fixed) returns(fixed); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#BFR_FILL.EXT*/ declare bfr_fill entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#CHAR.EXT*/ declare char entry (char(*),fixed bin) returns(char(1)); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#CHR$.EXT*/ declare chr$ entry ( bit(8) ) returns ( char(1) ); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#COMND.EXT*/ declare comnd entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#CTL.EXT*/ declare ctl entry (char(*),fixed bin) returns(char(1)); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#DBG_SEND.EXT*/ declare dbg_send entry (char(*) var); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#FILE_CLOSE.EXT*/ declare file_close entry (fixed bin) returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#FILE_DUMP.EXT*/ declare file_dump entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#FILE_INIT.EXT*/ declare file_init entry; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#FILE_OPEN.EXT*/ declare file_open entry (fixed bin) returns(bit(1)); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#KRM_ERROR.EXT*/ declare krm_error entry (fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#MOD_64.EXT*/ declare mod_64 entry (fixed bin) returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#MSG_INIT.EXT*/ declare msg_init entry; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#NEXT_FILE.EXT*/ declare next_file entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#PRS_SEND_INIT.EXT*/ declare prs_send_init entry (fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#PUT_FILE.EXT*/ declare put_file entry (char(1)) returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#REC_DATA.EXT*/ declare rec_data entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#REC_FILE.EXT*/ declare rec_file entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#REC_INIT.EXT*/ declare rec_init entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#REC_MESSAGE.EXT*/ declare rec_message entry (fixed) returns (bit(1)); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#REC_PACKET.EXT*/ declare rec_packet entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#REC_WORKER_SWITCH.EXT*/ declare rec_worker_switch entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SEND_BREAK.EXT*/ declare send_break entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SEND_DATA.EXT*/ declare send_data entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SEND_EOF.EXT*/ declare send_eof entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SEND_FILE.EXT*/ declare send_file entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SEND_INIT.EXT*/ declare send_init entry returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SEND_PACKET.EXT*/ declare send_packet entry (char(1),fixed bin,fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SEND_SWITCH.EXT*/ declare send_switch entry (fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SERVER.EXT*/ declare server entry; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SET_SEND_INIT.EXT*/ declare set_send_init entry (fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#SHIFT.EXT*/ declare shift entry (fixed bin) returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#TYPE.EXT*/ declare type entry (char(*) var,pointer,fixed bin) returns(fixed bin); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*PROCS#UNCHAR.EXT*/ declare unchar entry (char(*),fixed bin) returns(char(1)); ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#A2B.PLP*/ a2b: procedure(char_str,pos) returns(fixed bin); /* Proc to take a character and put in the low order byte of a fixed bin variable */ declare char_str char(80), /* String to get character from */ pos fixed bin; /* Position of character in string */ declare char2 char(2), c_ptr pointer, c_bin fixed bin based; /* Overlay bin over char(2) variable */ /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); c_ptr = addr(char2); c_ptr->c_bin = 0; /* Initialize output to 0 */ substr(char2,2,1) = substr(char_str,pos,1); /* Now get the character */ return(c_ptr->c_bin); end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#B2A.PLP*/ b2a: procedure(fixed_bin) returns(char(1)); /* Proc to turn the lower byte of a fixed bin variable to a single character */ declare fixed_bin fixed bin, fb_char char(2) based; /* Overlays fixed_bin */ declare temp char(1); /* Returned character */ /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); temp = substr(addr(fixed_bin)->fb_char,2,1); /* Get low order byte (char) */ return(temp); end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#BFR_EMPTY.PLP*/ bfr_empty: procedure(key) returns(fixed); /* Key = 0 except if file_type is binary and this is the last time */ declare key fixed bin; /*********************************************** * FUNCTIONAL DESCRIPTION: * * This routine will empty the data from the REC_MSG message buffer * to the file It will process quoting characters * * CALLING SEQUENCE: * * Flag = BFR_EMPTY(key); * * OUTPUT PARAMETERS: * * True - No problems writing the file * False - I/O error writing the file **************************************************/ $Include syscom>keys.ins.pl1 $Include syscom>errd.ins.pl1 $Include *>include>kererr.req $Include *>include>packet_defs.plp $Include *>include>kermsg_global.plp $Include *>include>kercom.req $Include *>include>kermsg_local.plp $Include *>include>snd_init.plp $Include *>include>kerfil_global.plp $Include *>include>kerfil_local.plp $Include *>include>msg_types.plp $Include *>procs>ctl.ext $Include *>procs>shift.ext $Include *>procs>b2a.ext $Include *>procs>a2b.ext $Include *>procs>send_packet.ext declare wtlin$ entry (fixed bin,char(*),fixed bin,fixed bin), chr$ entry (bit(8)) returns(char(1)), prwf$$ entry (bin,bin,pointer,bin,bin(31),bin,bin), mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); /* mkonu$ and bk_hndlr added 04-24-84 by C. Devine at SPSS, Inc. * to handle QUIT$ condition properly */ declare nw fixed bin, parity fixed bin, /* Parity bit determined by 8 bit quoting */ eol_flag fixed bin static initial(0), /* To find CR/LF sequence */ buffer char(256) var static initial (''), status fixed bin, buf_fix char(256), 1 char_var based, 2 len fixed bin, 2 data char(80), COUNTER fixed bin, /* Count of the characters left */ CHARACTER char(1); /* Character we are processing */ call mkonu$('QUIT$',bk_hndlr); if key = 0 then do; /* Indicates a normal call */ rec_msg = substr(rec_msg,PKT_MSG,length(rec_msg) - 5); do counter = 1 to length(rec_msg); character = substr(rec_msg,counter,1); if file_type = FILE_BIN then do; parity = 0; if rcv_8quote_chr ^= MY_8BIT_QUOTE then do; if character = rcv_8quote_chr then do; parity = 128; counter = counter + 1; character = substr(rec_msg,counter,1); end; end; end; if character = rcv_quote_chr then do; counter = counter + 1; character = substr(rec_msg,counter,1); if character >= '?' then character = ctl(character,1); END; if file_type = FILE_BIN then do; character = b2a(a2b(character,1) - 128 + parity); end; if file_type = FILE_ASC then select (character); when (chr$(CHR_CRT)) eol_flag = 1; when (chr$(CHR_LFD)) eol_flag = eol_flag + 1; otherwise eol_flag = 0; end; if (file_type = FILE_ASC) & (eol_flag = 2) then do; substr(buffer,length(buffer),1) = ' '; nw = shift(length(buffer)); call wtlin$(unit,addr(buffer)->char_var.data,nw,status); buffer = ''; if status = E$DKFL then do; snd_msg = 'Disk on remote system full, transfer aborted'; call send_packet(MSG_ERROR,length(snd_msg),msg_number); return(status); end; else if status ^= 0 then do; snd_msg = 'Error on remote, file transfer terminated'; call send_packet(MSG_ERROR,length(snd_msg),msg_number); return(status); end; end; else buffer = buffer || character; END; end; if (file_type = FILE_BIN) & (length(buffer) ^= 0) then do; /* Only if last time, count odd */ if key = 1 then buffer = buffer || chr$('00'B4); buf_fix = buffer; call prwf$$(K$WRIT,unit,addr(buf_fix),shift(length(buffer)),0,nw,status); if status = E$DKFL then do; snd_msg = 'Disk on remote system full, transfer aborted'; call send_packet(MSG_ERROR,length(snd_msg),msg_number); return(status); end; else if status ^= 0 then do; snd_msg = 'Error on remote, file transfer terminated'; call send_packet(MSG_ERROR,length(snd_msg),msg_number); return(status); end; if (length(buffer) & '00001'B3) ^= 0 then buffer = substr(buffer,length(buffer),1); else buffer = ''; end; RETURN(KER_NORMAL); END; /* End of BFR_EMPTY */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#BFR_FILL.PLP*/ bfr_fill: procedure returns(fixed bin); /*********************************************** * FUNCTIONAL DESCRIPTION: * * This routine will fill the buffer with data from the file It * will do all the quoting that is required * * CALLING SEQUENCE: * * EOF_FLAG = BFR_FILL(); * * OUTPUT PARAMETERS: * * True - Buffer filled may be at end of file * False - At end of file * * IMPLICIT OUTPUTS: * * Number of characters stored in the buffer **************************************************/ $Include syscom>keys.ins.pl1 $Include syscom>errd.ins.pl1 $Include *>include>kercom.req $Include *>include>kerfil_global.plp $Include *>include>kerfil_local.plp $Include *>include>kererr.req $Include *>include>packet_defs.plp $Include *>include>kermsg_global.plp $Include *>include>kermsg_local.plp $Include *>include>msg_types.plp $Include *>procs>a2b.ext $Include *>procs>b2a.ext $Include *>procs>ctl.ext $Include *>procs>send_packet.ext declare chr$ entry (bit(8)) returns(char(1)), rdlin$ entry (fixed bin,char(*),fixed bin,fixed bin), prwf$$ entry (bin,bin,pointer,bin,bin(31),bin,bin), nlen$a entry (char(*),fixed bin) returns(fixed bin), mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); /* mkonu$ and bk_hndlr added 04-24-84 by C. Devine at SPSS, Inc. * to handle QUIT$ condition properly */ declare char_bin fixed bin, size fixed bin static, CHARACTER char(1), /* Character read from the file */ code fixed bin, /* Status from disk routines */ char_len fixed bin static, /* Character length of int_buffer */ rnw fixed bin; /* Number of words read (prwf$$) */ call mkonu$('QUIT$',bk_hndlr); snd_msg = ''; /* Clear sending buffer */ loop: do size = 1 to (snd_pkt_size - PKT_TOT_OVR_HEAD - 2); if int_buf_ptr = 1 then do; if file_type = FILE_ASC then do; call rdlin$(unit,int_buffer,128,code); char_len = nlen$a(int_buffer,256); end; else if file_type = FILE_BIN then do; call prwf$$(K$READ,unit,addr(int_buffer),128,0,rnw,code); char_len = rnw * 2; if char_len ^= 0 then code = 0; end; else return(KER_ILLFILTYP); if(code = E$EOF) & (size = 1) then return(KER_EOF); end; else code = 0; character = substr(int_buffer,int_buf_ptr,1); if int_buf_ptr <= char_len then int_buf_ptr = int_buf_ptr + 1; else if code ^= 0 then leave loop; else int_buf_ptr = 1; /* * Determine if this is a character that must be quoted */ if int_buf_ptr ^= 1 then do; char_bin = a2b(character,1); if (file_type = FILE_ASC) & (char_bin >= 128) then char_bin = char_bin - 128; if (snd_8quote_chr ^= 'N') & (char_bin >= 128) then do; snd_msg = snd_msg || snd_8quote_chr; size = size + 1; char_bin = char_bin - 128; end; char_bin = char_bin + 128; character = b2a(char_bin); if (char_bin < 160) /* 160 is ASCII space with parity on */ | (character = chr$(CHR_DEL)) | (character = SND_QUOTE_CHR) | ((character = snd_8quote_chr) & (snd_8quote_chr ^= 'N')) then do; snd_msg = snd_msg || snd_quote_chr; size = size + 1; if (character ^= SND_QUOTE_CHR) & (character ^= snd_8quote_chr) then character = ctl(character,1); end; /* * Now write the character into the buffer */ snd_msg = snd_msg || character; end; else do; if file_type = FILE_ASC then do; if (size - 3) < snd_pkt_size then do; snd_msg = snd_msg || snd_quote_chr || 'M' || snd_quote_chr || 'J'; size = size + 3; end; else do; int_buf_ptr = 2; /* Make a buffer with only. */ char_len = 3; int_buffer = ' ' || chr$(CHR_CRT) || chr$(CHR_LFD); leave loop; end; end; end; END; if (code ^= 0) & (code ^= E$EOF) then do; snd_msg = 'Error on remote, file transfer terminated'; call send_packet(MSG_ERROR,length(snd_msg),msg_number); return(KER_INTERNALERR); end; return(KER_NORMAL); END; /* End of BFR_FILL */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#BK_HNDLR.PLP*/ bk_hndlr: procedure(point); /* Handle QUIT condition for KERMIT */ /* set_time_limit added by C. Devine at SPSS, Inc. to turn off timeout in case of break. Also added tnou call */ declare point fixed bin; $Include syscom>keys.ins.pl1 $Include *>include>kermsg_global.plp $Include *>include>kerfil_local.plp declare my_duplex bit(16) aligned external initial('0000'B4); declare duplx$ entry (bit(16)), srch$$ entry (fixed,char(*),fixed,fixed,fixed,fixed), tnou entry (char(*),fixed), exit entry; declare 1 char_var based, 2 len fixed bin, 2 data char(128), type fixed bin, code fixed bin; if my_duplex ^= 0 then do; call duplx$(my_duplex); call srch$$(K$CLOS,addr(file_name)->char_var.data,length(file_name), unit,type,code); end; call set_time_limit(0); call tnou('Exiting from Kermit-R19',23); call exit; /**************************************************************************/ /* * SET_TIME_LIMIT sets the real time watchdog timer. * The ALARM$ condition will be raised after minutes. */ set_time_limit: proc( mins ); dcl mins fixed bin(31); dcl code fixed bin; dcl limit$ entry( bin, bin(31), bin, bin ) external; call limit$( '0602'b4, mins, 0, code ); end; end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#CHAR.PLP*/ char: procedure(char_str,pos) returns(char(1)); /* Make character printable */ declare char_str char(80), pos fixed bin; /* Character position w/in char_str */ declare fixed_bin fixed bin, /* To do arithmetic on character */ c2 char(2) based, /* Overlays fixed_bin */ c1 char(1); /* Return value */ /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); fixed_bin = 0; /* Init so things turn out as expected */ substr(addr(fixed_bin)->c2,2,1) = substr(char_str,pos,1); /* Xfer input to low order byte of fixed_bin */ fixed_bin = fixed_bin + 32; /* Turn on "printable" bit */ c1 = substr(addr(fixed_bin)->c2,2,1); return(c1); end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#CHAR_OCT.PMA*/ * CHAR_OCT.PMA, KERMIT>SOURCE, T. SABIN, SOURCE, 08/05/83 * TYPE OUT CHAR(1) IN OCTAL * * OUTPUT OCTAL NUMBER * * * SUBR CH_OCT,ECB * SEG RLIT * CH_OCT ARGT XFER ARG PTR LDA ARG1,* GET WORD LRL 1 IAB LDX M3 =-3 TOOL CAR GET DIGIT, LLR 3 ADD AZERO CONVERT TO ASCII, CALL T1OB AND OUTPUT. IRX JMP TOOL PRTN RETURN * * DATA * M3 DEC -3 AZERO OCT 260 ='0' * FIN * * DYNM ARG1(3) * LINK ECB ECB CH_OCT,,ARG1,1 * END ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#CHKS.PLP*/ /* * CHKS -- Subroutine to compute Kermit checksum */ chks: proc( c ) returns( bin ); dcl c char(96) var, /* Char string to be processed (input) */ tot fixed bin, /* Sum of char values of c */ topbyte bit(1) aligned, /* Flag indicating high order byte of word */ i fixed bin, /* Word index into char string */ ci fixed bin; /* Loop counter */ /* Bit configuration for computing tot from char string */ dcl 1 a(50) based, 2 a1skip bit(1), 2 a1 bit(7), 2 a2skip bit(1), 2 a2 bit(7); /* Bit configuration for computing checksum from tot value */ dcl 1 s based, 2 s1 bit(8), 2 s2 bit(2), 2 s3 bit(6); /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); topbyte = '0'b; /* Skip first char (mark), so take low order byte */ i = 2; /* Word index into char var string (skip first word) */ tot = 0; /* Initialize total count */ /* Loop once for each character in the string */ do ci = 2 to length(c); if topbyte then do; i = i + 1; tot = tot + addr(c)->a1(i); end; else do; tot = tot + addr(c)->a2(i); end; topbyte = ^topbyte; end; /* Compute checksum from total of character values */ /* (Add bits 6-7 to bits 0-5 then return 6-bit value) */ tot = tot + addr(tot)->s2; tot = addr(tot)->s3; return( tot ); end; /* chks */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#CHR$.PLP*/ Chr$: PROCEDURE (C) RETURNS(CHAR(1)); /* next 3 lines added 05-08-84 by C. Devine at SPSS, Inc. to handle break properly */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); DCL C BIT(8) aligned; DCL B CHAR(1) BASED; RETURN (ADDR(C)->B); END; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#COMND.PLP*/ comnd: procedure returns(fixed bin); /************************************************************* * FUNCTIONAL DESCRIPTION: * This routine will do the command scanning for KERMIT-R19. It * will call the correct routines to process the commands. * * CALLING SEQUENCE: * * status = comnd(); *************************************************************/ $Include syscom>errd.ins.pl1 $Include *>include>kererr.req $Include *>include>kermit_local.plp $Include *>include>kermit_equs.plp $Include *>include>kercom.req $Include *>include>kermsg_global.plp $Include *>include>kermsg_local.plp $Include *>include>kerfil_global.plp $Include *>include>states.plp $Include *>procs>type.ext $Include *>procs>server.ext $Include *>procs>b2a.ext $Include *>procs>send_switch.ext $Include *>procs>rec_worker_switch.ext declare cl$get entry (char(*) var,fixed bin,fixed bin), duplx$ entry (bit(16)) returns(bit(16)), comi$$ entry (char(*),fixed bin,fixed bin,fixed bin), ln$par entry ((100) char(32) var,fixed bin,char(*) var,fixed bin), tonl entry, kertrn entry, mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); /* mkonu$ and bk_hndlr added 04-24-84 by C. Devine at SPSS, Inc. * to handle QUIT$ condition properly */ /*********************************************************** * *The following are the command state tables for the KERMIT-R19 *command processing. * *************************************************************/ %replace KERMIT_LEN by 11; declare kermit_state (KERMIT_LEN) char(26) var static initial ('CONNECT', 'EXIT', 'HELP', 'QUIT', 'RECEIVE', 'SET', 'SEND', 'SERVER', 'SHOW', 'PORTFILE', 'INIT'); /* Table for SET command */ %replace STATE_LEN by 6; declare set_state (STATE_LEN) char(26) var static initial ('DELAY', 'FILE_TYPE', 'NPAD', 'PADCHAR', 'QUOTE', '8-BIT-QUOTE'); %replace SET_DELAY by 1, SET_FILE_TYPE by 2, SET_NPAD by 3, SET_PADCHAR by 4, SET_QUOTE by 5, SET_8QUOTE by 6; /* Table for SHOW command */ %replace SHOW_LEN by 7; declare show_state (SHOW_LEN) char(26) var static initial ('ALL', 'DELAY', 'FILE_TYPE', 'NPAD', 'PADCHAR', 'QUOTE', '8-BIT-QUOTE'); declare server_text char(80) var static initial ('[Kermit Server running on Prime host. Please type your escape sequence to'), server_text_1 char(80) var static initial ('return to your local machine. Shut down the server by typing the Kermit'), server_text_2 char(80) var static initial ('BYE command on your local machine.]'), error_text char(80) var static initial ('Error: Unrecognized/Unimplemented Command'), token (100) char(32) var static, 1 char_var based, 2 len fixed bin, 2 data char(80), command fixed bin; declare num_tok fixed bin, CMD_BUF char(80) var, my_duplex bit(16) aligned external, STATUS fixed bin; declare ch_oct entry(char(1)); comnd_help: procedure; /*************************************************************** * * COMND_HELP: Display available commands * Calling sequence: call comnd_help; * ***************************************************************/ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); call tonl; call tonl; call tnou(' Kermit-R19 Available Commands',40); call tnou(' -----------------------------',40); call tonl; call tnou('EXIT back to operating system (PRIMOS)',38); call tnou('INIT: Initialize parameters thru a file',39); call tnou('QUIT back to operating system (PRIMOS)',38); call tnou('RECEIVE a file',14); call tnou('SEND a file',11); call tnou('SERVER: invoke Kermit server',28); call tnou('SET a parameter. Available parameters are:',43); call tnou(' DELAY: Time to delay before sending',38); call tnou(' FILE_TYPE: Type of file to transfer (BINARY or ASCII)',56); call tnou(' NPAD: Number of pad characters to send',41); call tnou(' PADCHAR: Padding character to send (in octal)',48); call tnou(' QUOTE: Set the quote character to receive',44); call tnou(' (default is ''#'')',26); call tnou(' 8-BIT-QUOTE: Set the 8-bit quote character you would',55); call tnou(' like to have ( default is ''&'')',46); call tnou('SHOW a parameter. Available parameters are:',44); call tnou(' ALL: Show all available parameters',38); call tnou(' DELAY: Time to delay before sending',39); call tnou(' FILE_TYPE: Type of file to transfer',39); call tnou(' NPAD: Number of pad characters to send',42); call tnou(' PADCHAR: Padding character to send (in octal)',49); call tnou(' QUOTE: Show the quoting character to receive',48); call tnou(' 8-BIT-QUOTE: Show the 8-bit quote character',47); call tnou(' you would like to have',39); call tnou('PORTFILE: convert an PORTFILE portable file',43); call tnou('HELP: Display this help file',28); call tonl; call tonl; return; end; /**************************************************************************/ comnd_show: procedure(option); declare option fixed bin; /* Tells what to show */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); select (option); when (SHOW_ALL) do; call comnd_show(SHOW_DELAY); call comnd_show(SHOW_FILE_TYPE); call comnd_show(SHOW_NPAD); call comnd_show(SHOW_PADCHAR); call comnd_show(SHOW_QUOTE); call comnd_show(SHOW_8QUOTE); end; when (SHOW_FILE_TYPE) do; call tnoua('File Type to send/receive.........................',50); if file_type = FILE_ASC then call tnou('ASCII',5); else call tnou('BINARY',6); end; when (SHOW_DELAY) do; call tnoua('Delay (seconds) before sending 1st packet.........',50); call todec(delay); call tonl; end; when (SHOW_NPAD) do; call tnoua('Number pad chars to send..........................',50); call todec(snd_npad); call tonl; end; when (SHOW_PADCHAR) do; call tnoua('Pad character to send.............................',50); call ch_oct(snd_padchar); call tnou(' (octal)',8); end; when (SHOW_QUOTE) do; call tnoua('Quote character to receive........................',50); call tnou(''''||rcv_quote_chr||'''',3); end; when (SHOW_8QUOTE) do; call tnou('8-Bit Quoting character desired (good',37); call tnoua('only if the file type is BINARY)..................',50); call tnou(''''||rcv_8quote_chr||'''',3); end; otherwise call tnou('Unrecognized/unimplemented SHOW command, re-enter',49); end; return; end; /**************************************************************************/ comnd_set: procedure; $Include syscom>a$keys.ins.pl1 declare type$a entry (fixed bin,char(*),fixed bin) returns(fixed bin), cnva$a entry (fixed bin,char(*),fixed bin,fixed bin(31)); declare long_int fixed bin(31); declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); command = type(token(2),addr(set_state),STATE_LEN); select (command); when (SET_FILE_TYPE) do; select (token(3)); when ('ASCII') do; file_type = FILE_ASC; rcv_8quote_chr = 'N'; /* ASCII files are 7 bits, no need */ end; when ('BINARY') do; file_type = FILE_BIN; rcv_8quote_chr = '&'; /* Binary files need 8-bit quoting */ end; otherwise call tnou('Improper setting - ASCII or BINARY only',39); end; end; when (SET_DELAY) do; if type$a(A$DEC,addr(token(3))->char_var.data,length(token(3))) = FALSE then do; call tnou('SET DELAY: Non-decimal number entered',37); return; end; call cnva$a(A$DEC,addr(token(3))->char_var.data,length(token(3)), long_int); delay = long_int; end; when (SET_NPAD) do; if (type$a(A$DEC,addr(token(3))->char_var.data, length(token(3))) = FALSE) then do; call tnou('SET NPAD: Non-decimal number entered',36); return; end; call cnva$a(A$DEC,addr(token(3))->char_var.data, length(token(3)),long_int); snd_npad = long_int; end; when (SET_PADCHAR) do; if (type$a(A$OCT,addr(token(3))->char_var.data, length(token(3))) = FALSE) then do; call tnou('SET PADCHAR: Non-octal number entered',37); return; end; call cnva$a(A$OCT,addr(token(3))->char_var.data, length(token(3)),long_int); if long_int > 255 then do; call tnou('SET PADCHAR: Character won''t fit in 8 bits',42); return; end; status = long_int; snd_padchar = b2a(status); end; when (SET_QUOTE) do; if (length(token(3)) ^= 1) | (token(3) >= '?') then do; call tnou( 'SET QUOTE: A single punctuation character must be entered',57); return; end; rcv_quote_chr = token(3); end; when (SET_8QUOTE) do; if (length(token(3)) ^= 1) | (token(3) >= '?') then do; call tnou( 'SET 8-BIT-QUOTE: A single punctuation character must be',55); call tnou( 'entered, and it must be different from the quote character',58); return; end; rcv_8quote_chr = token(3); end; otherwise call tnou('Unrecognized/unimplemented SET command, re-enter',48); end; end; /**************************************************************************/ /* MAIN COMND LOOP */ /**************************************************************************/ call mkonu$('QUIT$',bk_hndlr); do while (1); /* Initialize some per-command data areas. */ SHOW_TYPE = 0; /* Get user command */ do until((length(cmd_buf) ^= 0) | (status ^= 0)); call tnoua('Kermit-R19> ',12); call cl$get(cmd_buf,80,status); end; /* Check for end of command file */ IF status = E$EOF then return(KER_NORMAL); if status = 0 then do; call ln$par(token,num_tok,cmd_buf,status); if status ^= 0 then return(KER_INTERNALERR); command = type(token(1),addr(kermit_state),KERMIT_LEN); select(command); when (0) call tnou(addr(error_text)->char_var.data,length(error_text)); when (CMD_EXIT) return(KER_NORMAL); /* Go back to PRIMOS */ when (CMD_INIT) do; /* INIT typed in */ call comi$$(addr(token(2))->char_var.data,length(token(2)),6,status); if status ^= 0 then do; call tnou('Cannot open file '||token(2),17+length(token(2))); end; end; when (CMD_QUIT) return(KER_NORMAL); /* Go back to PRIMOS */ when (CMD_HELP) call comnd_help; /* Display HELP info */ when (CMD_SERVER) do; /* SERVER typed in */ call tnou(addr(server_text)->char_var.data,length(server_text)); call tnou(addr(server_text_1)->char_var.data,length(server_text_1)); call tnou(addr(server_text_2)->char_var.data,length(server_text_2)); call server; return(KER_NORMAL); end; when (CMD_SHOW) do; /* SHOW typed in */ command = type(token(2),addr(show_state),SHOW_LEN); call comnd_show(command); end; when (CMD_SET) call comnd_set; /* SET typed in */ when (CMD_SEND) do; /* SEND typed in */ my_duplex = duplx$('FFFF'B4); status = duplx$('A000'B4); file_name = token(2); call send_switch(STATE_S); status = duplx$(my_duplex); end; when (CMD_RECE) do; /* RECEIVE typed in */ my_duplex = duplx$('FFFF'B4); status = duplx$('A000'B4); state = STATE_R; status = rec_worker_switch(); status = duplx$(my_duplex); end; when (CMD_PORT) do; call kertrn(); end; end; /* select */ end; else return(status); end; /* do while */ end;/* COMND */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#CTL.PLP*/ /* * CTL: Toggle character's "ctl" bit. */ ctl: procedure(char_str,pos) returns(char(1)); declare char_str char(80), pos fixed bin; /* Character position w/in char_str */ declare fixed_bin bit(8), /* To do arithmetic on character */ c1 char(1) based; /* Return value */ /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /* Xfer input to working storage */ addr(fixed_bin)->c1 = substr(char_str,pos,1); /* Toggle character's "control" bit */ if (fixed_bin & '40'B4) = 0 then fixed_bin = fixed_bin | '40'B4; else fixed_bin = fixed_bin & 'BF'B4; return(addr(fixed_bin)->c1); end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#FILE_CLOSE.PLP*/ FILE_CLOSE: PROCEDURE(c) returns(fixed bin); declare c fixed bin; $Include syscom>keys.ins.pl1 $Include *>include>kercom.req $Include *>include>kermsg_global.plp $Include *>include>kermsg_local.plp $Include *>include>msg_types.plp $Include *>include>kerfil_local.plp $Include *>include>kerfil_global.plp $Include *>procs>send_packet.ext $Include *>procs>bfr_empty.ext /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); declare srch$$ entry (bin,char(*),bin,bin,bin,bin), trnc$a entry (fixed bin); declare temporary fixed bin external; declare (type,code) fixed bin, 1 char_var based, 2 len fixed bin, 2 data char(80); call mkonu$('QUIT$',bk_hndlr); if (file_type = FILE_BIN) & (c = FNC_WRITE) then do; code = bfr_empty(1); /* This is a last call */ call trnc$a(unit); end; call srch$$(K$CLOS,addr(file_name)->char_var.data,length(file_name), unit,type,code); if temporary = 1 then do; call srch$$(K$DELE,addr(file_name)->char_var.data,length(file_name), unit,type,code); temporary = 0; end; if code ^= 0 then do; snd_msg = 'Error on remote, file transfer terminated'; call send_packet(MSG_ERROR,length(snd_msg),msg_number); end; return(code); END; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#FILE_INIT.PLP*/ file_init: procedure; /******************************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will initialize some of the storage in the file processing * module. *******************************************************************/ $Include *>include>kercom.req $Include *>include>kerfil_global.plp /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); FILE_TYPE = FILE_ASC; END; /* End of FILE_INIT */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#FILE_OPEN.PLP*/ file_open: procedure(c) returns(bit(1)); declare c fixed bin; $Include syscom>keys.ins.pl1 $Include *>include>kermsg_global.plp $Include *>include>kercom.req $Include *>include>kerfil_local.plp /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); declare srch$$ entry (bin,char(*),bin,bin,bin,bin); declare keys fixed bin, type fixed bin, 1 char_var based, 2 len fixed bin, 2 data char(80), code fixed bin, count fixed bin, lcnt fixed bin, slen fixed bin, orig_name char(32), suffix char(4); call mkonu$('QUIT$',bk_hndlr); if c = FNC_READ then keys = K$READ + K$GETU; else if c = FNC_WRITE then do; /* * setting of file write parameters rewritten by C. Devine at SPSS, Inc. * 11 May 84. Now attempt to open a file under new file name if original * exists by adding suffix '.Knn' where nn ranges from 1 to 99. If the * length of file_name is greater than 28, truncate and then add suffix. * If after 99 tries, can't find unused file name, reset file name to * original and return error */ keys = K$WRIT + K$GETU; orig_name = file_name; count = 0; code = 0; do while (code = 0); call srch$$(K$EXST,addr(file_name)->char_var.data, length(file_name),0,type,code); if (code = 0) then do; count = count + 1; if (count > 99) then do; file_name = orig_name; return('0'B); end; if (count < 10) then lcnt = 1; else lcnt = 2; suffix = '.K'||character(count,lcnt); slen = index(orig_name,' '); if ( slen = 0 | slen > 28 ) then slen = 28; else slen = slen - 1; file_name = substr(orig_name,1,slen)||suffix; end; end; end; else return('0'B); call srch$$(keys,addr(file_name)->char_var.data,length(file_name), unit,type,code); if code = 0 then return('1'B); else return('0'B); end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#KSEND.F77*/ C This Fortran program should be run on the mainframe in conjunction C with a Basic program on the IBM PC to transfer Kermit.Fix to the PC. C Daphne Tzoar, January 1983 C Columbia University Center for Computing Activities integer a(64) open(7,file='HELP**>K>KERMIT>KERMIT.FIX',STATUS='OLD') write(1,50) 50 format('Ready to transfer data......') C Get terminal handshake 100 read (1,10,end=35)x 10 format(a1) C Get line from file 35 read (7,20,end=90)a 20 format(64a1) C Write to tty write (1,25)a 25 format(64a1,';') goto 100 90 continue C Get final handshake write (1,30) 30 format(65('@')) return end ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#LIMIT$_DYNT.PMA*/ SEG DYNT LIMIT$ END ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#LN$PAR.PLP*/ /*ln$par.plp This program takes a line of input and passes back an array of tokens. It converts all to upcase. */ /* 08/04/83 Make correction to accept final 1-character tokens. TPS */ ln$par: proc(token,numtok,buff,code); declare token (100) char (32) var, snap entry(char (*) , fixed bin), todec entry(fixed bin), /* tnou entry (char (*),fixed bin),*/ numtok fixed bin, buff char (160) var, code fixed bin, uppercase char (27) static init ('ABCDEFGHIJKLMNOPQRSTUVWXYZ '), lowercase char (27) static init ('abcdefghijklmnopqrstuvwxyz,'), char char (1), (i,n,k,l) fixed bin; /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /*call tnou('in ln$par$',10);*/ buff = translate(buff,uppercase,lowercase); /*call tnou(buff,length(buff));*/ /*call tnou('line 1',6);*/ l = 1; n = 1; i= 1; buff=trim(buff,'11'b); do until (n > length(buff)); /*call tnou('line2 ',6);*/ do while (substr(buff,n,1) ^=' ' & n <= length(buff)); /*call snap(n,1);*/ /*call tnou(char ,length(char));*/ /*call tnou('line 3',6);*/ n = n + 1; end; /*call tnou('line 4',6);*/ /*call snap(i,1);*/ /*call snap(l,1);*/ token(l) = substr(buff,i,(n-i)); /*call tnou('token',5);*/ /*call tnou(token(l),length(token(l)));*/ l = l + 1; /*call tnou('line 5',6);*/ do while ( substr(buff,n,1) =' ' & n <= length(buff)); n = n + 1; end; i = n ; if length(token(1))<=0 then i=9999; end; numtok = l-1; end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#MAIN.PLP*/ main: procedure; /*************************************************************** * FUNCTIONAL DESCRIPTION: * * This is the main routine for KERMIT-R19. This routine will * initialize the various parameters and then call the command * scanner to process commands. ***********************************************************/ $Include *>procs>msg_init.ext $Include *>procs>file_init.ext $Include *>procs>comnd.ext declare bk_hndlr entry (fixed bin), timeout_hndlr entry( pointer ), mkonu$ entry (char(*) var,entry) options(shortcall(20)); declare status fixed bin; /* Initialize some variables */ call msg_init; call file_init; /* Create on_units for break handling and line timeout handling */ call mkonu$('QUIT$',bk_hndlr); call mkonu$('ALARM$',timeout_hndlr); /* Main command loop */ status = comnd(); END; /* end of routine MAIN */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#MOD_64.PMA*/ ENT MOD_64,MODECB * SEG * MOD_64 EQU * ARGT ARGUMENT TRANSFER LDA =63 WE'LL AND ARGUMENT WITH X'3F' ANA LEN,* PRTN RETURN TO CALLER * DYNM LEN(3) * LINK * MODECB ECB MOD_64,,LEN,1 * END ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#MSG_INIT.PLP*/ msg_init: procedure; /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will initialize the message processing for * KERMIT-R19 * * CALLING SEQUENCE: * * MSG_INIT(); *****************************************************/ $Include *>include>kercom.req $Include *>include>snd_init.plp $Include *>include>kermsg_global.plp $Include *>include>kermsg_local.plp declare chr$ entry (bit(8)) returns(char(1)); /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /* * Receive parameters first */ RCV_PKT_SIZE = MY_PKT_SIZE; RCV_NPAD = MY_NPAD; RCV_PADCHAR = chr$(MY_PAD_CHAR); RCV_TIMEOUT = MY_TIME_OUT; RCV_EOL = chr$(MY_EOL_CHAR); RCV_QUOTE_CHR = MY_QUOTE_CHAR; RCV_8QUOTE_CHR = MY_8BIT_QUOTE; /* * Send parameters */ SND_PKT_SIZE = MY_PKT_SIZE; SND_NPAD = MY_NPAD; SND_PADCHAR = chr$(MY_PAD_CHAR); SND_TIMEOUT = MY_TIME_OUT*10; SND_EOL = chr$(MY_EOL_CHAR); SND_QUOTE_CHR = MY_QUOTE_CHAR; SND_8QUOTE_CHR = 'N'; /* 09 MAY 84 SND_8QUOTE_CHR CHANGED FROM & TO N BY C. DEVINE AT SPSS, INC * IF OTHER KERMIT DOES NOT DO 8 BIT QUOTING, & CHARACTER IS NOT * CODED PROPERLY */ /* * Other random parameters */ DELAY = INIT_DELAY; OPEN_FLAG = '0'B; rec_seq = 0; msg_number = 0; END; /* End of MSG_INIT */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#NEXT_FILE.PLP*/ NEXT_FILE: PROCEDURE returns(fixed bin); /*********************************************************** * * PROCEDURE TO FETCH THE NEXT FILE FROM A MULTIPLE FILE * SPECIFICATION * ************************************************************/ $Include *>include>kercom.req $Include *>include>kererr.req $Include *>include>kermsg_local.plp $Include *>include>kermsg_global.plp $Include *>procs>file_open.ext declare i fixed bin static initial(2); /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); file_name = matches(i); /* Get next file name */ if ^file_open(FNC_READ) then do; i = 2; /* Finished, reset index */ return(KER_NOMORFILES); end; i = i + 1; /* Point to next file name */ return(KER_NORMAL); END; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#PRS_SEND_INIT.PLP*/ prs_send_init: procedure (order); declare order fixed bin; /*********************************************** * FUNCTIONAL DESCRIPTION: * * This routine will parse the SEND_INIT parameters that were sent by * the remote Kermit The items will be stored into the low segment * * CALLING SEQUENCE: * * PRS_SEND_INIT (); * * IMPLICIT INPUTS: * * Message stored in REC_MSG **************************************************/ /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); $Include *>include>packet_defs.plp $Include *>include>snd_init.plp $Include *>include>kermsg_global.plp $Include *>include>kercom.req $Include *>include>kermsg_local.plp $Include *>include>kerfil_global.plp $Include *>procs>a2b.ext $Include *>procs>unchar.ext $Include *>procs>ctl.ext declare 1 char_var based, 2 len fixed bin, 2 data char(80); call mkonu$('QUIT$',bk_hndlr); select(length(rec_msg)); when (P_SI_BUFSIZ + 6) go to pkt_lbl; when (P_SI_TIMOUT + 6) go to to_lbl; when (P_SI_NPAD + 6) go to np_lbl; when (P_SI_PAD + 6) go to pc_lbl; when (P_SI_EOL + 6) go to eol_lbl; when (P_SI_QUOTE + 6) go to qc_lbl; when (P_SI_8QUOTE + 6) go to ebqc_lbl; end; ebqc_lbl: snd_8quote_chr = substr(rec_msg,PKT_MSG + P_SI_8QUOTE); select (order); when (1) do; /* Remote sent send init */ if (file_type = FILE_BIN) & (snd_8quote_chr = 'Y') then do; snd_8quote_chr = '&'; rcv_8quote_chr = '&'; end; else if (file_type = FILE_BIN) & (snd_8quote_chr < '?') then rcv_8quote_chr = 'Y'; else do; snd_8quote_chr = 'N'; rcv_8quote_chr = 'N'; end; end; when (2) do; /* We sent send init, this is ACK */ if snd_8quote_chr = 'Y' then snd_8quote_chr = rcv_8quote_chr; else rcv_8quote_chr = 'N'; end; end; qc_lbl: snd_quote_chr = substr(rec_msg,PKT_MSG + P_SI_QUOTE); eol_lbl: snd_eol = unchar(addr(rec_msg)->char_var.data,PKT_MSG + P_SI_EOL); pc_lbl: snd_padchar = ctl(addr(rec_msg)->char_var.data,PKT_MSG + P_SI_PAD); np_lbl: snd_npad = a2b(unchar(addr(rec_msg)->char_var.data, PKT_MSG + P_SI_NPAD),1) - 128; to_lbl: snd_timeout = (a2b(unchar(addr(rec_msg)->char_var.data, PKT_MSG + P_SI_TIMOUT),1) - 128)*10; pkt_lbl: snd_pkt_size = a2b(unchar(addr(rec_msg)->char_var.data, PKT_MSG + P_SI_BUFSIZ),1) - 128; END; /* End of PRS_SEND_INIT */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#REC_DATA.PLP*/ rec_data: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will accept data messages and write them to disk * It will also accept MSG_FILE and MSG_EOF messages * * CALLING SEQUENCE: * * STATE = REC_DATA(); * * OUTPUT PARAMETERS: * * New state for the finite state machine **************************************************/ $Include *>include>kercom.req $Include *>include>msg_types.plp $Include *>include>states.plp $Include *>include>kermsg_local.plp $Include *>procs>rec_message.ext $Include *>procs>mod_64.ext $Include *>procs>send_packet.ext $Include *>procs>bfr_empty.ext $Include *>procs>file_close.ext /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /* Get input */ if ^rec_message(check_data) then return(STATE_A); /* Process based on message type */ select (rec_type); when (MSG_DATA) do; /* Out of sequence messages */ if msg_number ^= rec_seq then do; if old_retries > MAX_RETRIES then return(STATE_A); OLD_RETRIES = OLD_RETRIES + 1; if mod_64(msg_number - 1) = rec_seq then do; call send_packet(MSG_ACK,0,rec_seq); NUM_RETRIES = 0; return(state); end; else return(STATE_A); end; /* Good message. Empty buffer to file */ if bfr_empty(0) ^= 0 then return(STATE_A); call send_packet(MSG_ACK,0,rec_seq); OLD_RETRIES = NUM_RETRIES; NUM_RETRIES = 0; msg_number = mod_64(msg_number + 1); return(STATE_RD); end; when (MSG_EOF) do; if msg_number ^= rec_seq then return(STATE_A); call send_packet(MSG_ACK,0,rec_seq); OPEN_FLAG = FALSE; if file_close(FNC_WRITE) ^= 0 then return(STATE_A); msg_number = mod_64(msg_number + 1); return(STATE_RF); end; otherwise return(STATE_A); end; /* select */ END; /* End of REC_DATA */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#REC_FILE.PLP*/ rec_file: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine expects to receive an MSG_FILE packet from the remote * KERMIT If the message is correct this routine will change the state * to STATE_RD * * This routine also expects MSG_SND_INIT, MSG_EOF, or MSG_BREAK * * CALLING SEQUENCE: * * STATE = REC_FILE(); * * OUTPUT PARAMETERS: * * New state *****************************************************/ /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); $Include *>include>kercom.req $Include *>include>packet_defs.plp $Include *>include>msg_types.plp $Include *>include>snd_init.plp $Include *>include>states.plp $Include *>include>kermsg_local.plp $Include *>include>kermsg_global.plp $Include *>procs>rec_message.ext $Include *>procs>mod_64.ext $Include *>procs>set_send_init.ext $Include *>procs>send_packet.ext $Include *>procs>file_open.ext call mkonu$('QUIT$',bk_hndlr); if ^rec_message(check_file) then return(STATE_A); select (rec_type); when (MSG_SND_INIT) do; if old_retries > MAX_RETRIES then return(STATE_A); old_retries = old_retries + 1; if mod_64(msg_number - 1) = rec_seq then do; call set_send_init(1); call send_packet(MSG_ACK,P_SI_LENGTH,msg_number); NUM_RETRIES = 0; return(state); end; else return(STATE_A); end; when (MSG_EOF) do; if old_retries > MAX_RETRIES then return(STATE_A); old_retries = old_retries + 1; if mod_64(msg_number - 1) = rec_seq then do; call send_packet(MSG_ACK,0,rec_seq); NUM_RETRIES = 0; return(state); end; else return(STATE_A); end; when (MSG_FILE) do; if msg_number ^= rec_seq then return(STATE_A); file_name = substr(rec_msg,PKT_MSG,length(rec_msg) - 5);; if file_open(FNC_WRITE) ^= '1'b then return(STATE_A); OPEN_FLAG = TRUE; call SEND_PACKET (MSG_ACK, 0, MSG_NUMBER); old_retries = num_retries; NUM_RETRIES = 0; msg_number = mod_64(msg_number + 1); return(STATE_RD); end; when (MSG_BREAK) do; if msg_number ^= rec_seq then return(STATE_A); call send_packet(MSG_ACK,0,rec_seq); return(STATE_C); end; otherwise return(STATE_A); end; END; /* End of REC_FILE ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#REC_INIT.PLP*/ rec_init: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will process an initialization message received from * the remote KERMIT * * CALLING SEQUENCE: * * STATE = REC_INIT(); * * OUTPUT PARAMETERS: * * New machine state *****************************************************/ $Include *>include>msg_types.plp $Include *>include>snd_init.plp $Include *>include>states.plp $Include *>include>kercom.req $Include *>include>kermsg_local.plp $Include *>procs>rec_message.ext $Include *>procs>mod_64.ext $Include *>procs>prs_send_init.ext $Include *>procs>set_send_init.ext $Include *>procs>send_packet.ext /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); if ^rec_message(check_init) then return(STATE_A); MSG_NUMBER = REC_SEQ; call prs_send_init(1); call set_send_init(1); call send_packet(MSG_ACK,P_SI_LENGTH,msg_number); OLD_RETRIES = NUM_RETRIES; NUM_RETRIES = 0; msg_number = mod_64(msg_number + 1); return(STATE_RF); /* Ready to receive file info */ END; /* End of REC_INIT */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#REC_MESSAGE.PLP*/ rec_message: procedure(chk_routine) returns(bit(1)); dcl chk_routine fixed bin; /*********************************************** * FUNCTIONAL DESCRIPTION: * * This routine will handle the retry processing for the * various messages that can be received. * * CALLING SEQUENCE: * * status = rec_message(chk_routine); * * COMPLETION CODES: * * '0'b - Error: max retry exceeded * '1'b - Good return * **************************************************/ $Include *>include>kercom.req $Include *>include>kererr.req $Include *>include>msg_types.plp $Include *>include>kermsg_local.plp $Include *>procs>rec_packet.ext $Include *>procs>mod_64.ext $Include *>procs>send_packet.ext declare status fixed bin; /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit*/ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); do while (1); /* Keep count of number of retries */ if num_retries > MAX_RETRIES then return('0'B); num_retries = num_retries + 1; /* Get the next packet */ status = rec_packet(); if status ^= 0 then do; call send_packet(MSG_NAK,0,mod_64(rec_seq - 1)); end; else do; /* Process based on chk_routine parameter */ select(chk_routine); when(check_data) select(rec_type); when(msg_data, msg_eof) return( '1'b ); end; when(check_file) select(rec_type); when(msg_snd_init, msg_file, msg_eof, msg_break) return( '1'b ); end; when(check_server) select(rec_type); when(msg_snd_init, msg_kermit, msg_rcv_init) return( '1'b ); end; when(check_init) select(rec_type); when(msg_snd_init) return ('1'b ); end; otherwise return( '0'b ); end; /* select */ call send_packet( MSG_NAK, 0, rec_seq ); end; end; /* do while */ END; /* End of REC_MESSAGE */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#REC_PACKET.PLP*/ rec_packet: procedure returns(fixed bin); /*********************************************** * FUNCTIONAL DESCRIPTION: * * This routine will do the oppoiste of SEND_PACKET It will wait * for the message to be read from the remote and then it will * check the message for validity * * CALLING SEQUENCE: * * Flag = REC_PACKET(); * * IMPLICIT OUTPUTS: * * REC_MSG - Contains the message received * * COMPLETION CODES: * * True - Packet receive ok * False - Problem occured during the receiving of the packet **************************************************/ $Include *>include>kercom.req $Include *>include>kererr.req $Include *>include>packet_defs.plp $Include *>include>msg_types.plp $Include *>include>kermsg_global.plp $Include *>include>kermsg_local.plp $Include *>procs>a2b.ext $Include *>procs>chr$.ext $Include *>procs>unchar.ext $Include *>procs>send_packet.ext declare chks entry (char(*) var) returns(fixed bin), c1in entry (bin), cl$get entry ( char(*) var, bin, bin ), mkonu$ entry (char(32) var, entry) options(shortcall(20)), timeout_hndlr entry( pointer ), bk_hndlr entry (fixed bin); /* bk_hndlr added 04-24-84 by C. Devine at SPSS, Inc. for QUIT$ cond. */ declare 1 char_var based, 2 len fixed bin, 2 data char(80), alarm_cond char(32) var, timeout label external, on_unit_made bit(1) aligned static init( '0'b ), c fixed bin, ctrl_a fixed bin static initial(129), ctrl_a_char char(1) static initial(''), line char(max_msg) var, code fixed bin, chksum fixed bin; /* Checksum of the message */ call mkonu$('QUIT$',bk_hndlr); /* Put local label in external variable (for timeout condition) */ timeout = bad_return; /* Set 2 minute timeout */ input: call set_time_limit( 2 ); /* Scan input for CTRL-A character */ do until( c = ctrl_a ); call c1in( c ); end; /* Get rest of message */ call cl$get( line, MAX_MSG, code ); call set_time_limit( 0 ); /* Turn off watchdog */ if code ^= 0 then return(KER_TIMEOUT); /* any error */ rec_msg = ctrl_a_char || line; /* * Setup msg_type and chksum (the computed checksum) */ rec_type = substr(rec_msg,PKT_TYPE,1); chksum = chks(substr(rec_msg,1,length(rec_msg) - 1)); /* * Compare computed checksum with received checksum */ rec_length = a2b(unchar(addr(rec_msg)->char_var.data,PKT_COUNT),1) + 2 - 128; if chksum ^= (a2b(unchar(addr(rec_msg)->char_var.data,rec_length),1) - 128) then do; call send_packet(MSG_NAK,0,rec_seq); goto input; /* retry */ end; /* Setup sequence number */ rec_seq = a2b(unchar(addr(rec_msg)->char_var.data,PKT_SEQ),1) - 128; /* Good return */ return(KER_NORMAL); /* * Bad return (timeout condition raised) * We come here from the timeout_hndlr on-unit. */ bad_return: return( KER_TIMEOUT ); /**************************************************************************/ /* * SET_TIME_LIMIT sets the real time watchdog timer. * The ALARM$ condition will be raised after minutes. */ set_time_limit: proc( mins ); dcl mins fixed bin(31); dcl code fixed bin; dcl limit$ entry( bin, bin(31), bin, bin ) external; call limit$( '0602'b4, mins, 0, code ); end; END; /* End of REC_PACKET */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#REC_WORKER_SWITCH.PLP*/ rec_worker_switch: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This is the worker routine for either REC_SWITCH or SERVER. * This routine will be called with the STATE variable set to the * correct state for either the SERVER or the REC_SWITCH routine * * CALLING SEQUENCE: * * Status = REC_SWITCH_WORKER(); *****************************************************/ $Include *>include>kercom.req $Include *>include>states.plp $Include *>include>kermsg_local.plp $Include *>procs>rec_data.ext $Include *>procs>rec_file.ext $Include *>procs>rec_init.ext $Include *>procs>file_close.ext /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); declare return_value fixed bin, status fixed bin; call mkonu$('QUIT$',bk_hndlr); num_retries = 0; /* Initialize the number of retries */ do while (TRUE); select (state); /* * Receiving of the data and the end of file message */ when (STATE_RD) state = rec_data(); /* * Receiving the FILE information of the break to end the transfer of * one or more files */ when (STATE_RF) state = rec_file(); /* * Initialization for the receiving of a file */ when (STATE_R) state = rec_init(); /* * Here if we have completed the receiving of the file */ when (STATE_C) return(TRUE); /* * Here if we aborted the transfer or we have gotten into some random * state (internal KERMSG problem) */ otherwise do; /* Includes STATE_A */ if open_flag then do; open_flag = '0'B; status = file_close(FNC_WRITE); end; return(FALSE); end; end; /* select */ end; end; /* End of REC_WORKER_SWITCH */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SEND_BREAK.PLP*/ send_break: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will send the break (end of transmission) message * to the remote KERMIT On an ACK the state becomes STATE_C * * CALLING SEQUENCE: * * STATE = SEND_BREAK(); * * OUTPUT PARAMETERS: * * New state for the finite state machine *****************************************************/ $Include *>include>kercom.req $Include *>include>msg_types.plp $Include *>include>states.plp $Include *>include>kermsg_local.plp $Include *>procs>send_packet.ext $Include *>procs>mod_64.ext $Include *>procs>rec_packet.ext /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /* * First determine if we have exceed the number of retries that are * allowed to attempt to send this message */ IF NUM_RETRIES > MAX_RETRIES THEN RETURN( STATE_A); /* * The number of retries are not exceeded. Increment the number and then * attempt to send the packet again */ NUM_RETRIES = NUM_RETRIES + 1; call send_packet(MSG_BREAK,0,msg_number); /* * Now get the responce from the remote KERMIT */ IF REC_PACKET() ^= 0 THEN RETURN( STATE_A); /* * Determine if the packet is good */ IF ^ (REC_TYPE = MSG_ACK | REC_TYPE = MSG_NAK) THEN RETURN( STATE_A); /* * If this is a NAK and the message number is not the one we just send * treat this like an ACK, otherwise resend the last packet */ IF REC_TYPE = MSG_NAK & REC_SEQ ^= mod_64(msg_number + 1) then return(STATE_SF); IF REC_SEQ ^= MSG_NUMBER THEN RETURN( STATE); /* * Here to determine if there is another file to send */ NUM_RETRIES = 0; MSG_NUMBER = mod_64(msg_number + 1); RETURN( STATE_C); END; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SEND_DATA.PLP*/ send_data: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will send a data message to the remote KERMIT * * CALLING SEQUENCE: * * STATE = SEND_DATA(); * * OUTPUT PARAMETERS: * * New state to change the finite state machine to *****************************************************/ declare status fixed bin; $Include *>include>kercom.req $Include *>include>kererr.req $Include *>include>msg_types.plp $Include *>include>states.plp $Include *>include>kermsg_local.plp $Include *>procs>send_packet.ext $Include *>procs>mod_64.ext $Include *>procs>rec_packet.ext $Include *>procs>bfr_fill.ext $Include *>procs>file_close.ext /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /* * Check to see if the number of retries have been exceeded */ if num_retries > MAX_RETRIES then return(STATE_A); /* * Not exceeded yet Increment the number of retries we have attempted * on this message */ NUM_RETRIES = NUM_RETRIES + 1; /* * Send the packet */ call send_packet(MSG_DATA,length(snd_msg),msg_number); /* * Attempt to receive a message from the remote KERMIT */ if rec_packet() ^= 0 then return(STATE_A); /* * Determine if the message is a NAK and the NAK is for the message number * that we are current working on If the NAK is for the next packet then * ignore the NAK */ if (rec_type = MSG_NAK) & (rec_seq ^= mod_64(msg_number + 1)) then return(STATE_SD); /* * Make sure we have a NAK or ACK */ if(rec_type = MSG_ACK) | (rec_type = MSG_NAK) then do; /* * Is this for this message? */ if rec_seq ^= msg_number then return(state); /* * It was Set up for sending the next data message to the remote KERMIT * and return */ NUM_RETRIES = 0; msg_number = mod_64(msg_number + 1); status = bfr_fill(); if status = KER_NORMAL then return(STATE_SD); else if status ^= KER_EOF then return(STATE_A); ELSE do; status = file_close(FNC_READ); OPEN_FLAG = FALSE; RETURN(STATE_SZ); END; end; else do; /* * Not an ACK or NAK, abort */ RETURN(STATE_A); end; END; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SEND_EOF.PLP*/ send_eof: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will send the end of file message to the remote * KERMIT It will then determine if there are more files to * send to the remote * * CALLING SEQUENCE: * * STATE = SEND_EOF(); * * OUTPUT PARAMETERS: * * New state to change the finite state machine to * * SIDE EFFECTS: * * Sets up for the next file to be processed if there is one * *****************************************************/ declare STATUS fixed bin; /* Local status of routine */ $Include *>include>kercom.req $Include *>include>kererr.req $Include *>include>msg_types.plp $Include *>include>states.plp $Include *>include>kermsg_local.plp $Include *>procs>send_packet.ext $Include *>procs>mod_64.ext $Include *>procs>rec_packet.ext $Include *>procs>next_file.ext /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /* * First determine if we have exceed the number of retries that are * allowed to attempt to send this message */ IF NUM_RETRIES > MAX_RETRIES THEN RETURN( STATE_A); /* * The number of retries are not exceeded Increment the number and then * attempt to send the packet again */ NUM_RETRIES = NUM_RETRIES + 1; call SEND_PACKET (MSG_EOF, 0, MSG_NUMBER); /* * Now get the responce from the remote KERMIT */ IF REC_PACKET() ^= 0 THEN RETURN( STATE_A); /* * Determine if the packet is good */ IF ^ (REC_TYPE = MSG_ACK | REC_TYPE = MSG_NAK) THEN RETURN( STATE_A); /* * If this is a NAK and the message number is not the one we just send * treat this like an ACK, otherwise resend the last packet */ IF REC_TYPE = MSG_NAK & REC_SEQ ^= mod_64(msg_number + 1) THEN return(STATE_SZ); IF REC_SEQ ^= MSG_NUMBER THEN RETURN( STATE); /* * Here to determine if there is another file to send */ NUM_RETRIES = 0; MSG_NUMBER = mod_64(msg_number + 1); STATUS = NEXT_FILE (); IF (status ^= 0) | (STATUS = KER_NOMORFILES) THEN RETURN(STATE_SB); ELSE RETURN(STATE_SF); END; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SEND_FILE.PLP*/ send_file: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will send the file specification that is being * transfered * * CALLING SEQUENCE: * * STATE = SEND_FILE(); * * OUTPUT PARAMETERS: * * New state to change the finite state machine to *****************************************************/ $Include *>include>kercom.req $Include *>include>kererr.req $Include *>include>msg_types.plp $Include *>include>states.plp $Include *>include>kermsg_global.plp $Include *>include>kermsg_local.plp $Include *>include>kerfil_local.plp $Include *>procs>rec_packet.ext $Include *>procs>mod_64.ext $Include *>procs>send_packet.ext $Include *>procs>bfr_fill.ext declare rwnd$a entry (fixed bin); /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /* * First determine if we have exceed the number of retries that are * allowed to attempt to send this message */ if num_retries > max_retries then return(STATE_A); /* * The number of retries are not exceeded Increment the number and then * attempt to send the packet again */ NUM_RETRIES = NUM_RETRIES + 1; if state = STATE_SF then do; /* Do for file transfers */ IF length(file_name) ^= 0 then snd_msg = file_name; call SEND_PACKET (MSG_FILE, length(file_name), MSG_NUMBER); end; else do; call send_packet(MSG_TEXT,0,msg_number); call rwnd$a(unit); end; /* * Now get the responce from the remote KERMIT */ IF REC_PACKET() ^= 0 THEN RETURN(STATE_A); /* * Determine if the packet is good */ IF ^ (REC_TYPE = MSG_ACK | REC_TYPE = MSG_NAK) THEN RETURN(STATE_A); /* * If this is a NAK and the message number is not the one we just send * treat this like an ACK, otherwise resend the last packet */ if (rec_type = msg_nak) & (rec_seq ^= mod_64(msg_number + 1)) then return(STATE); IF REC_SEQ ^= MSG_NUMBER THEN RETURN(state); /* * Here to send the file name to the other end */ NUM_RETRIES = 0; MSG_NUMBER = mod_64(msg_number + 1); IF BFR_FILL() = KER_NORMAL THEN RETURN(STATE_SD); ELSE RETURN(STATE_A); END; /* End of SEND_FILE */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SEND_INIT.PLP*/ send_init: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will send the initialization packet to the remote * KERMIT The message type sent is S * * CALLING SEQUENCE: * * STATE = SEND_INIT(); * * OUTPUT PARAMETERS: * * New state to change the finite state machine to *****************************************************/ $Include *>include>kercom.req $Include *>include>kererr.req $Include syscom>a$keys.ins.pl1 $Include *>include>msg_types.plp $Include *>include>snd_init.plp $Include *>include>states.plp $Include *>include>kermsg_local.plp $Include *>include>kermsg_global.plp $Include *>procs>set_send_init.ext $Include *>procs>mod_64.ext $Include *>procs>rec_packet.ext $Include *>procs>prs_send_init.ext $Include *>procs>file_open.ext $Include *>procs>send_packet.ext $Include *>procs>a2b.ext declare tscn$a entry (fixed bin,fixed bin,char(*),fixed bin,fixed bin, fixed bin,fixed bin,fixed bin) returns(fixed bin), nlen$a entry (char(*),fixed bin) returns(fixed bin), wild$ entry (char(*) var,char(*) var,bin) returns(bit(1) aligned); /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); declare lev fixed bin, log fixed bin, num fixed bin, code fixed bin, entry char(48), entry_var char(32) var, i fixed bin; call mkonu$('QUIT$',bk_hndlr); int_buf_ptr = 1; call SET_SEND_INIT(2); IF NUM_RETRIES > MAX_RETRIES THEN RETURN( STATE_A); call send_packet(MSG_SND_INIT,P_SI_LENGTH,msg_number); code = rec_packet(); if code = KER_TIMEOUT then return(state); if code ^= KER_NORMAL then return(STATE_A); /* * Determine if the packet is good */ IF ^ (REC_TYPE = MSG_ACK | REC_TYPE = MSG_NAK) THEN RETURN( STATE_A); /* * If this is a NAK and the message number is not the one we just send * treat this like an ACK, otherwise resend the last packet */ IF REC_TYPE = MSG_NAK & REC_SEQ ^= mod_64(msg_number + 1) then return(STATE); IF REC_SEQ ^= MSG_NUMBER THEN RETURN( STATE); /* * Here if we have an ACK for the initialization message that was just sent * to the remote KERMIT */ call PRS_SEND_INIT(2); NUM_RETRIES = 0; MSG_NUMBER = mod_64(msg_number + 1); matches(2) = ''; if state = STATE_S then do; /* Do only on file transfer */ if file_open(FNC_READ) then do; /* Try plain open first */ open_flag = TRUE; return(STATE_SF); end; else do; file_name = translate(file_name,'ABCDEFGHIJKLMNOPQRSTUVWXYZ', 'abcdefghijklmnopqrstuvwxyz'); lev = 0; /* TSCN$A requires we initialize the level */ i = 1; matches(1) = ''; do until (code ^= 0); entry = ' '; log = tscn$a(A$CUFD,100,entry,24,num,1,lev,code); if code = 0 then do; entry_var = substr(entry,3,nlen$a(entry,34) - 2); if(wild$(file_name,entry_var,code) & (a2b(entry,40) ^= 4)) then do; matches(i) = entry_var; i = i + 1; matches(i) = ''; end; end; end; snd_msg = 'Error: File does not exist on Remote System ('||file_name||')'; file_name = matches(1); IF ^ FILE_OPEN (FNC_READ) then do; call send_packet(MSG_ERROR,length(snd_msg),msg_number); return(STATE_A); end; ELSE do; OPEN_FLAG = TRUE; RETURN( STATE_SF); END; end; end; else return(STATE_XF); END; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SEND_PACKET.PLP*/ send_packet: procedure(type,len,mn); declare type char(1), /* Type of packet to send */ len fixed bin, /* Length of packet to send */ mn fixed bin; /*********************************************** * FUNCTIONAL DESCRIPTION: * * This routine will cause a packet to be sent over the line * that has been opened by OPEN_TERMINAL * * CALLING SEQUENCE: * * SEND_PACKET(Type, Length); * * INPUT PARAMETERS: * * TYPE - Type of packet to send * * LENGTH - Length of the packet being sent **************************************************/ $Include *>include>packet_defs.plp $Include *>include>kermsg_global.plp $Include *>include>kercom.req $Include *>include>kermsg_local.plp $Include *>procs>char.ext $Include *>procs>b2a.ext $Include *>procs>a2b.ext declare fill$a entry (char(*),fixed bin,fixed bin); declare chks entry (char(*) var) returns(fixed bin); /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); declare filler char(MAX_MSG), msg char(MAX_MSG) var, 1 char_var based, 2 len fixed bin, 2 data char(80), i fixed bin, chksum fixed bin, /* Checksum */ ptr pointer; /* Pointer to information */ call mkonu$('QUIT$',bk_hndlr); /* * Do any filler processing that the remote KERMIT requires */ if snd_npad ^= 0 then do; /* Fill only npad characters */ call fill$a(filler,snd_npad,a2b(snd_padchar,1)); call tnoua(filler,snd_npad); end; /* * Store the header information into the message */ msg=''!!char(b2a(len+pkt_ovr_head),1)!!char(b2a(mn),1)!!type; if len ^= 0 then msg = msg || snd_msg; /* * Do the initial checksum calculation and set up the pointer to read * characters from the message dependent part of the message */ chksum = chks(msg); /* * Store the checksum into the message */ msg = msg!! char(b2a(chksum),1); /* * Now call the O/S routine to send the message out to the remote KERMIT */ call tnou(addr(msg)->char_var.data,length(msg)); return; END; /* End of SEND_PACKET */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SEND_SWITCH.PLP*/ send_switch: procedure(init_state) returns(bit(1)); declare init_state fixed bin; /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine is the state table switcher for sending files It * loops until either it is finished or an error is encountered The * routines called by SEND_SWITCH are responsible for changing the state * * CALLING SEQUENCE: * * SEND_SWITCH(); * * OUTPUT PARAMETERS: * * Returns: * TRUE - File sent correctly * FALSE - Aborted sending the file *****************************************************/ $Include *>include>kercom.req $Include *>include>states.plp $Include *>include>kermsg_global.plp $Include *>include>kermsg_local.plp $Include *>include>kerfil_global.plp $Include *>procs>send_data.ext $Include *>procs>send_file.ext $Include *>procs>send_eof.ext $Include *>procs>send_init.ext $Include *>procs>send_break.ext $Include *>procs>file_close.ext declare sleep$ entry (fixed bin(31)); /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); declare status fixed bin, save_8quote char(1), save_file fixed bin, VAL_RETURN fixed bin, FINISHED fixed bin; call mkonu$('QUIT$',bk_hndlr); STATE = init_state; /* Initial state setup */ NUM_RETRIES = 0; /* Initialize number of retries */ MSG_NUMBER = 0; /* Initial message number */ /* Sleep if the user wanted us to */ if delay ^= 0 then call sleep$(1000 * delay); FINISHED = FALSE; do until(finished = TRUE); select (state); when (STATE_SD) state = send_data(); when (STATE_SF,STATE_XF) state = send_file(); when (STATE_SZ) state = send_eof(); when (STATE_S) do; save_file = file_type; save_8quote = rcv_8quote_chr; state = send_init(); end; when (STATE_X) do; save_file = file_type; file_type = FILE_ASC; save_8quote = rcv_8quote_chr; rcv_8quote_chr = 'N'; /* 8-bit-quoting off for text */ state = send_init(); end; when (STATE_SB) state = send_break(); when (STATE_C) do; FINISHED = TRUE; VAL_RETURN = TRUE; END; when (STATE_A) do; if open_flag then do; status = file_close(FNC_READ); OPEN_FLAG = FALSE; END; FINISHED = TRUE; VAL_RETURN = FALSE; END; otherwise do; FINISHED = TRUE; VAL_RETURN = FALSE; END; end; end; file_type = save_file; rcv_8quote_chr = save_8quote; RETURN (VAL_RETURN); END; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SET_SEND_INIT.PLP*/ set_send_init: procedure(order); declare order fixed bin; /*********************************************** * FUNCTIONAL DESCRIPTION: * * This routine will initialize the various parameters for the * MSG_SND_INIT message * * CALLING SEQUENCE: * * SET_SEND_INIT(); * * IMPLICIT OUTPUTS: * * SND_MSG parameters set up **************************************************/ $Include *>include>kermsg_global.plp $Include *>include>kercom.req $Include *>include>kermsg_local.plp $Include *>include>kerfil_global.plp $Include *>procs>char.ext $Include *>procs>b2a.ext $Include *>procs>ctl.ext /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); if order = 2 then do; /* We're sending send init */ if file_type ^= FILE_BIN then rcv_8quote_chr = 'N'; end; snd_msg = char(b2a(rcv_pkt_size),1)||char(b2a(rcv_timeout),1)|| char(b2a(rcv_npad),1)||ctl(rcv_padchar,1)||char(rcv_eol,1)|| rcv_quote_chr||rcv_8quote_chr; if order = 1 then do; /* Remote sent send init, this is ACK */ if snd_8quote_chr = 'Y' then snd_8quote_chr = rcv_8quote_chr; else if rcv_8quote_chr = 'Y' then rcv_8quote_chr = snd_8quote_chr; end; END; /* End of SET_SEND_INIT */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SHIFT.PMA*/ ENT SHIFT,SHFECB ENTRY POINTS SEG * SHIFT EQU * ARGT ARGUMENT TRANSFER LDA LEN,* PLACE ARGUMENT (INTEGER*16) IN REG A ARL 1 SHIFT RIGHT 1 PLACE (DIVIDE BY 2) PRTN RETURN TO CALLER * DYNM LEN(3) * SHFECB ECB SHIFT,,LEN,1 * END ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#TIMEOUT_HNDLR.PLP*/ /* TIMEOUT_HNDLR : on_unit for receive timeout (ALARM$ condition) */ timeout_hndlr: proc( dummy ); dcl dummy pointer; dcl timeout label external; goto timeout; end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#TYPE.PLP*/ type: procedure(token,table_ptr,table_len) returns(fixed bin); declare token char(32) var, /* Token number in token array */ table_len fixed bin, /* Number of strings in parsing table */ table_ptr pointer, table (5) char(26) var based; /* Parsing table */ $Include *>include>kermit_local.plp declare i fixed bin; /* next 3 lines added 05-08-84 by C. Devine at SPSS, Inc. to handle break properly */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); do i = 1 to table_len; if table_ptr->table(i) = token then return(i); end; return(0); end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#UNCHAR.PLP*/ /* * UNCHAR: Make character unprintable. */ unchar: procedure(char_str,pos) returns(char(1)); declare char_str char(80), pos fixed bin; /* Character position w/in char_str */ declare fixed_bin fixed bin, /* To do arithmetic on character */ c2 char(2) based, /* Overlays fixed_bin */ c1 char(1); /* Return value */ /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); fixed_bin = 0; /* Init so things turn out as expected */ substr(addr(fixed_bin)->c2,2,1) = substr(char_str,pos,1); /* Xfer input to low order byte of fixed_bin */ fixed_bin = fixed_bin - 32; /* Turn off "printable" bit */ c1 = substr(addr(fixed_bin)->c2,2,1); return(c1); end; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#WILD$_DYNT.PMA*/ SEG DYNT WILD$ END ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#SERVER.PLP*/ server: procedure; $Include *>include>kercom.req $Include *>include>kererr.req $Include *>include>packet_defs.plp $Include *>include>msg_types.plp $Include *>include>snd_init.plp $Include *>include>states.plp $Include *>include>kermsg_global.plp $Include *>include>kermsg_local.plp $Include *>procs>prs_send_init.ext $Include *>procs>mod_64.ext $Include *>procs>set_send_init.ext $Include *>procs>send_packet.ext $Include *>procs>rec_worker_switch.ext $Include *>procs>send_switch.ext $Include *>procs>rec_message.ext declare duplx$ entry (bit(16)) returns(bit(16)), temp$a entry (fixed bin,char(*),fixed bin,fixed bin), wtlin$ entry (fixed bin,char(*),fixed bin,fixed bin), tscn$a entry (fixed,fixed,char(*),fixed,fixed,fixed,fixed,fixed), nlen$a entry (char(*),fixed bin) returns(fixed bin); /* next section added 25 Apr 84 by C. Devine at SPSS, Inc. to correctly handle QUIT$ on-unit */ declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); declare status_bit bit(1) aligned, text char(96) var, status fixed bin, code fixed bin, num fixed bin, lev fixed bin, entry char(48), 1 char_var based, 2 len fixed bin, 2 data char(80), my_duplex bit(16) aligned external; call mkonu$('QUIT$',bk_hndlr); server_generic: procedure returns(fixed bin); /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will handle the generic server messages * The generic server messages include FINISH, LOGOUT, * CONNECT (ATTACH), DELETE, DIRECTORY * * CALLING SEQUENCE: * * SERVER_GENERIC(); * * IMPLICIT INPUTS: * * Generic message receive in REC_MESSAGE * *****************************************************/ $Include syscom>errd.ins.pl1 $Include syscom>keys.ins.pl1 $Include syscom>a$keys.ins.pl1 $Include *>include>kerfil_local.plp $Include *>procs>shift.ext declare temporary fixed bin external init(0); declare at$ entry (fixed bin,char(*) var,fixed bin), srch$$ entry (fixed,char(*),fixed,fixed,fixed,fixed), logo$$ entry (fixed,fixed,char(*),fixed,fixed bin(31),fixed); declare treename char(96) var, fname char(6), type fixed bin; declare mkonu$ entry (char(32) var, entry) options(shortcall(20)), bk_hndlr entry (fixed bin); call mkonu$('QUIT$',bk_hndlr); /* Process based on message type */ select(substr(rec_msg,PKT_MSG,1)); when (MSG_GEN_CONNECT) do; treename = substr(rec_msg,6,length(rec_msg) - 6); call at$(K$SETH,treename,code); select (code); when (0) do; call temp$a(A$SAMF+A$GETU,fname,6,unit); file_name = substr(fname,1,6); temporary = 1; /* Working with TEMP file */ call wtlin$(unit,'Now in directory '||treename||' ', shift(length(treename)+18),code); call send_switch(STATE_X); end; when (E$ITRE) text = 'Illegal treename'; when (E$FNTF) text = 'Some part of the treename does not exist'; when (E$NRIT) text = 'Insufficient access rights'; otherwise text = 'Bad error, call STC at once!'; end; if code ^= 0 then do; snd_msg = text; call send_packet(MSG_ERROR,length(snd_msg),msg_number); end; end; when (MSG_GEN_EXIT) do; call send_packet(MSG_ACK,0,rec_seq); code = duplx$(my_duplex); RETURN( KER_EXIT); end; when (MSG_GEN_LOGOUT) do; call send_packet(MSG_ACK,0,rec_seq); code = duplx$(my_duplex); call logo$$(0,0,' ',0,0,code); end; when (MSG_GEN_DELETE) do; treename = substr(rec_msg,6,length(rec_msg) - 6); call srch$$(K$DELE,addr(treename)->char_var.data,length(treename), unit,type,code); if code ^= 0 then do; snd_msg = 'File delete unsuccessful'; call send_packet(MSG_ERROR,length(snd_msg),msg_number); end; else do; call temp$a(A$SAMF+A$GETU,fname,6,unit); file_name = substr(fname,1,6); temporary = 1; /* Working with TEMP file */ call wtlin$(unit,'File Deleted',6,code); call send_switch(STATE_X); end; end; when (MSG_GEN_DIRECTORY) do; call temp$a(A$SAMF+A$GETU,fname,6,unit); file_name = substr(fname,1,6); temporary = 1; /* Working with TEMP file */ call wtlin$(unit,'Beginning of Directory Listing',15,code); lev = 0; do until (code ^= 0); text = (76) ' '; call tscn$a(A$CUFD,100,entry,24,num,1,lev,code); if code = 0 then do; substr(text,1,nlen$a(entry,34) - 2) = substr(entry,3,nlen$a(entry,34) - 2); call tscn$a(A$CUFD,100,entry,24,num,1,lev,code); if code = 0 then do; substr(text,36,nlen$a(entry,34)-2) = substr(entry,3,nlen$a(entry,34)-2); end; call wtlin$(unit,addr(text)->char_var.data,35,num); end; end; call wtlin$(unit,'End of Directory Listing',12,code); call send_switch(STATE_X); end; otherwise do; snd_msg = 'Unimplemented command; try again!'; call send_packet(MSG_ERROR,length(snd_msg),msg_number); return( KER_UNIMPLGEN); end; end; /* select */ return(KER_NORMAL); end; /* End of SERVER_GENERIC */ /************************************************** * FUNCTIONAL DESCRIPTION: * * This routine will handle the server function in the v20 protocol * for KERMIT. This routine by it's nature will call various operating * system routines to do things like logging off the system * * CALLING SEQUENCE: * * EXIT_FLAG = SERVER(); *****************************************************/ /* Set the terminal line so echo is off */ my_duplex = duplx$('FFFF'B4); code = duplx$('A000'B4); /* Initialize retry count */ num_retries = 0; /* Main server loop */ do while(1); /* Get input from line */ status_bit = REC_MESSAGE (CHECK_SERVER); /* Process based on message type */ select (rec_type); when (MSG_SND_INIT) do; msg_number = mod_64(rec_seq + 1); call PRS_SEND_INIT(1); call SET_SEND_INIT(1); call send_packet(MSG_ACK,P_SI_LENGTH,rec_seq); STATE = STATE_RF; code = REC_WORKER_SWITCH (); end; when (MSG_RCV_INIT) do; MSG_NUMBER = REC_SEQ; IF REC_LENGTH > 0 then do; file_name = substr(rec_msg,PKT_MSG,rec_length - pkt_msg); END; DELAY = 0; call SEND_SWITCH(STATE_S); end; when (MSG_KERMIT) do; /* Generic Kermit Commands */ status = SERVER_GENERIC (); if status = KER_EXIT then return; end; end; /* select */ end; /* Reset user terminal characteristics (e.g. turn echo on) */ code = duplx$(my_duplex); END; /* End of GLOBAL ROUTINE SERVER */ ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: /*SOURCE#KERTRN.FTN*/ SUBROUTINE KERTRN C ********************************************************************* C ********************************************************************* C ** ** C ** ** C ** KERTRN.FTN TRANSLATION PROGRAM FOR SPSS-X PORTABLE FILES ** C ** ALLOWS TRANSFER OF FILES BETWEEN PRIME AND IBM PC ** C ** ** C ** ** C ********************************************************************* C ********************************************************************* C C *** M O D I F I C A T I O N H I S T O R Y *** C C 04 MAY 84 - C. DEVINE - ORIGINAL VERSION C 08 MAY 84 - C. DEVINE - STRIP LENGTH INDICATORS FROM DAM FILES C GOING TO PC; ADD THEM COMING FROM PC C $INSERT SYSCOM>KEYS.F $INSERT SYSCOM>ERRD.F $INSERT SYSCOM>A$KEYS.INS.FTN C ALL WORK VARIABLE USED FOR BIT ROTATION INTEGER*4 ALL C ALPHA AREA TO PLACE TRANSLATED BUFFER. HOLDS 80 CHARACTERS INTEGER*4 ALPHA(20) C BUFFER AREA FOR PRWF$$ READS. HOLDS 80 CHARACTERS INTEGER*4 BUFFER(20) C CHAR CHARACTER COUNT TO LOCATE TRANSLATION TABLE INTEGER*2 CHAR C CNT NUMBER OF ARRAY ELEMENTS FILLED BY PRWF$$ (RNW/2 + 1) INTEGER*2 CNT C CODE RETURNED ERROR CODE IN PRWF$$ CALLS INTEGER*2 CODE C DUMMY READ OUT DAM FILE LENGTH INDICATORS INTEGER*2 DUMMY C FLAG FLAG FOR TRANSLATION TYPE INTEGER*2 FLAG C I INDEX FOR LOOP INTEGER*2 I C IC1 ERROR CODE FOR INPUT FILE SRCH$$ CALL INTEGER*2 IC1 C IC2 ERROR CODE FOR OUTPUT FILE SRCH$$ CALL INTEGER*2 IC2 C INAME INPUT FILE NAME. MAXIMUM OF 32 CHARACTERS INTEGER*4 INAME(8) C IT1 TYPE CODE FOR INPUT FILE SRCH$$ CALL INTEGER*2 IT1 C IT2 TYPE CODE FOR OUTPUT FILE SRCH$$ CALL INTEGER*2 IT2 C J INDEX FOR LOOP INTEGER*2 J C KEY KEY = K$NSAM FOR PC-BOUND FILES; K$NDAM PRIMEWARD INTEGER*2 KEY C N(4) WORK VECTOR TO HOLD SHIFTED BITS INTEGER*4 N(4) C NW NUMBER OF WORDS FOR PRWF$$ CALL INTEGER*2 NW C POS MARKER FOR POSITION IN ALPHA VECTOR INTEGER*2 POS C RNW RETURNED NUMBER OF WORD FROM PRWF$$ CALL INTEGER*2 RNW C UNITI RETURNED FILE UNIT NUMBER FOR INPUT FILE INTEGER*2 UNITI C UNITO RETURNED FILE UNIT NUMBER FOR OUTPUT FILE INTEGER*2 UNITO C ONAME OUTPUT FILE NAME. MAXIMUM OF 32 CHARACTERS INTEGER*4 ONAME(8) C C ** SET UP COMMON BLOCK FOR BREAK C ** HANDLER COMMON /BRKCOM/ UNITI,UNITO,ONAME EXTERNAL BRKCLN CALL MKON$F('QUIT$',5,BRKCLN) C C ** SET THE FLAG FOR CONVERSION TYPE C ** FLAG=1 FORMAT FOR PC FROM PRIME C ** FLAG=-1 FORMAT FOR PRIME FROM PC C UNITI = 0 UNITO = 0 FLAG = 0 KEY = 0 10 CONTINUE IF (.NOT. YSNO$A('Are you converting a file to send to a PC',41, + A$NDEF)) GOTO 15 FLAG = 1 KEY = K$NSAM GOTO 20 15 CONTINUE IF (.NOT. YSNO$A('Are you converting a file received from a PC', + 44,A$NDEF)) GOTO 10 FLAG = -1 KEY = K$NDAM C C ** GET INPUT AND OUTPUT FILE NAMES C ** CHECK EXISTENCE OF OUTPUT FILE C ** AND VERIFY ANY OVERWRITE C 20 CONTINUE CALL FILL$A(INAME,32,' ') CALL TNOUA('Name of file to convert: ',25) READ(1,8010,ERR=20)INAME 8010 FORMAT (8A4) CALL SRCH$$(K$READ+K$GETU,INAME,32,UNITI,IT1,IC1) IF (IC1 .NE. 0) GOTO 20 30 CONTINUE CALL FILL$A(ONAME,32,' ') CALL TNOUA('Name for converted file: ',25) READ(1,8010,ERR=30)ONAME CALL SRCH$$(K$EXST,ONAME,32,0,IT2,IC2) IF (IC2 .EQ. E$FNTF) GOTO 35 IF (.NOT. YSNO$A('File already exists. Do you wish to overwrite' + ,45,A$NDEF)) GOTO 30 CALL SRCH$$(K$DELE+K$GETU,ONAME,32,UNITO,IT2,IC2) 35 CONTINUE CALL SRCH$$(K$WRIT+KEY+K$GETU,ONAME,32,UNITO,IT2,IC2) IF (IC2 .NE. 0) GOTO 30 C C ** CONVERT PRIME PORTABLE FILE FOR PC C ** REMOVE CONTROL CHARACTERS FROM C ** TRANSLATION TABLES AND WRITE TO FILE C ** WITH CARRIAGE RETURN/LINE FEED C IF (FLAG .NE. 1) GOTO 300 CHAR = 0 100 CONTINUE DO 110 I=1,20 ALPHA(I) = INTL(0) BUFFER(I) = INTL(0) 110 CONTINUE NW = 1 CALL PRWF$$(K$READ,UNITI,LOC(DUMMY),NW,INTL(0),RNW,CODE) IF (RNW .EQ. 0) GOTO 1000 NW = 40 CALL PRWF$$(K$READ,UNITI,LOC(BUFFER(1)),NW,INTL(0),RNW,CODE) IF (RNW .EQ. 0) GOTO 1000 CNT = (RNW/2) + 1 IF (CNT .GT. 20) CNT = 20 DO 175 I=1,CNT ALL = BUFFER(I) DO 150 J=1,4 CHAR = CHAR + 1 POS = (I-1)*4 + J N(J) = LT(ALL,8) N(J) = RS(N(J),24) ALL = LS(ALL,8) IF (CHAR .GT. 456) GOTO 140 IF (N(J) .GE. 32 .AND. N(J) .LT. 127) GOTO 140 IF (N(J) .GE. 160 .AND. N(J) .LT. 255) GOTO 140 CALL MCHR$A(ALPHA,POS,'0',1) GOTO 150 140 CONTINUE CALL MCHR$A(ALPHA,POS,N(J),4) 150 CONTINUE 175 CONTINUE CALL O$AD08(UNITO,ALPHA,NW,0) GOTO 100 C C ** CONVERT PC FORM TO PRIME FORM C ** REMOVE CR/LF FROM RECORD C 300 CONTINUE IF (FLAG .NE. -1) GOTO 500 DUMMY = 40 310 CONTINUE NW = 40 CALL RDLIN$(UNITI,BUFFER,NW,CODE) IF (CODE .NE. 0) GOTO 1000 CALL PRWF$$(K$WRIT,UNITO,LOC(DUMMY),1,INTL(0),RNW,CODE) CALL PRWF$$(K$WRIT,UNITO,LOC(BUFFER(1)),NW,INTL(0),RNW,CODE) GOTO 310 C C ** FLAG IS INVALID C ** THIS SHOULD NEVER OCCUR C 500 CONTINUE CALL TNOU('Invalid conversion selected') C C ** CLOSE FILES AND EXIT C 1000 CONTINUE CALL SRCH$$(K$CLOS,0,0,UNITI,IT1,IC1) CALL SRCH$$(K$CLOS,0,0,UNITO,IT2,IC2) RETURN END C C BRKCLN - THE BREAK HANDLING ROUTINE C SUBROUTINE BRKCLN $INSERT SYSCOM>KEYS.F INTEGER*2 ITYPE,ICODE INTEGER*2 UNITI INTEGER*2 UNITO INTEGER*4 ONAME(8) COMMON /BRKCOM/ UNITI,UNITO,ONAME CALL TONL IF (UNITI .NE. 0) CALL SRCH$$(K$CLOS,0,0,UNITI,ITYPE,ICODE) IF (UNITO .EQ. 0) GOTO 10 CALL TNOU('Converted file deleted on QUIT condition',40) CALL SRCH$$(K$CLOS,0,0,UNITO,ITYPE,ICODE) CALL SRCH$$(K$DELE,ONAME,32,UNITO,ITYPE,ICODE) 10 CONTINUE CALL TNOU('Exiting from Kermit-R19',23) CALL EXIT END :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::