$large Kermit: do; /* * K e r m i t File Transfer Utility * * iRMX-86 Kermit, Version 2.3 * by Albert J. Goodman, Grinnell College * * Copyright (C), Grinnell College * All Rights Reserved * * The Kermit protocol is copyrighted by Columbia University and * probably Frank da Cruz. We like his approach to publicly * available programs. * * This version of Kermit may be used or modified by anyone who * wishes to do so, as long as a profit by the sale or lease of * this program. I think you understand the intent, please don't * work around it with some legal mumbo-jumbo. Please send any * changes to the following address: * * Computer Services * Noyce Computer Center * Grinnell College * Grinnell, IA 50112 * * This program was developed on an Intel System 86/380 which was * donated by the Intel Corporation. Their generosity is greatly * appreciated. * * Main module, containg the main program and all commands. * * Version: Date: Reason (Programmer) * 2.3 02-Jun-85 Original. (Albert J. Goodman) */ declare /* CONSTANTS */ /* Useful text substitutions */ boolean literally 'byte', /* define a new type */ TRUE literally '0FFh', /* and constants */ FALSE literally '000h', /* of that type */ forever literally 'while TRUE', /* a WHILE condition */ /* ASCII control character constants */ NUL literally '00h', /* null */ SOH literally '01h', /* start-of-header */ CTRL$C literally '03h', /* CTRL/C */ BEL literally '07h', /* bell (beep) */ BS literally '08h', /* backspace */ HT literally '09h', /* horizontal tab */ LF literally '0Ah', /* line-feed */ CR literally '0Dh', /* carriage-return */ CTRL$R$BRAK literally '1Dh', /* CTRL/] */ DEL literally '7Fh', /* delete (rubout) */ /* String constants */ sign$on(*) byte data( 47, 'iRMX-86 Kermit, Version 2.3 (AJG, 2-June-85)',CR,LF ), prompt(*) byte data( 16, 'iRMX-86 Kermit> ' ), dots$string(*) byte data( 7, ' . . . ' ), ok$string(*) byte data( 2, 'Ok' ), currently$string(*) byte data( 14, ' is currently ' ), /* Defaults for various Kermit parameters */ def$esc$char literally 'CTRL$R$BRAK', def$max$retry literally '10', def$packet$len literally '80', def$time$limit literally '10', def$num$pad literally '0', def$pad$char literally 'NUL', def$eol literally 'CR', def$quote literally '''#''', /* GET$CONSOLE$CHAR return codes (see KERMIT$SYS) */ TIMEOUT literally '0FFFFh', /* Time limit expired */ BREAK literally '08000h', /* Break key */ /* Other constants */ MAX$PACKET$LEN literally '94', CONNECT$ESC$TIME$LIMIT literally '5', /* GLOBAL VARIABLES */ /* Kermit parameters */ beep boolean, /* Whether to beep when finished */ debug boolean public, /* Whether we're debugging the program */ max$retry byte public, /* Maximum number of times to retry a packet */ packet$len byte public, /* The maximum length packet to send */ time$limit byte public, /* Seconds to time out if nothing received */ num$pad byte public, /* The number of padding characters to send */ pad$char byte public, /* The padding character to send */ eol byte public, /* The EOL (end-of-line) character to send */ quote byte public, /* The control-quote character to be used */ esc$char byte, /* The "escape" character for CONNECT */ /* Other Kermit variables */ state byte public, /* Current state (see Kermit Protocol Manual) */ seq byte public, /* The current sequence number (0 to 63) */ tries byte public, /* Number of times current packet retried */ /* Buffers */ info structure( /* Buffer for the contents of a packet */ len byte, ch(MAX$PACKET$LEN) byte), info2 structure( /* Another packet buffer */ len byte, ch(MAX$PACKET$LEN) byte), /* Possible command keywords */ q$mark(*) byte data( 1, '?' ), exit$string(*) byte data( 4, 'EXIT' ), help$string(*) byte data( 4, 'HELP' ), send$string(*) byte data( 4, 'SEND' ), receive$string(*) byte data( 7, 'RECEIVE' ), get$string(*) byte data( 3, 'GET' ), connect$string(*) byte data( 7, 'CONNECT' ), bye$string(*) byte data( 3, 'BYE' ), logout$string(*) byte data( 6, 'LOGOUT' ), finish$string(*) byte data( 6, 'FINISH' ), set$string(*) byte data( 3, 'SET' ), show$string(*) byte data( 4, 'SHOW' ), beep$string(*) byte data( 4, 'BEEP' ), debug$string(*) byte data( 5, 'DEBUG' ), on$string(*) byte data( 2, 'ON' ), off$string(*) byte data( 3, 'OFF' ), escape$string(*) byte data( 6, 'ESCAPE' ), retry$string(*) byte data( 5, 'RETRY' ), packet$len$string(*) byte data( 13, 'PACKET-LENGTH' ), timeout$string(*) byte data( 7, 'TIMEOUT' ), padding$string(*) byte data( 7, 'PADDING' ), padchar$string(*) byte data( 7, 'PADCHAR' ), end$of$line$string(*) byte data( 11, 'END-OF-LINE' ), quote$string(*) byte data( 5, 'QUOTE' ), version$string(*) byte data( 7, 'VERSION' ), all$string(*) byte data( 3, 'ALL' ), /* Command and parameter lists */ command$list(*) pointer data( @exit$string, @send$string, @receive$string, @get$string, @connect$string, @bye$string, @logout$string, @finish$string, @set$string, @show$string, @help$string ), set$param$list(*) pointer data( @beep$string, @debug$string, @escape$string, @retry$string, @packet$len$string, @timeout$string, @padding$string, @padchar$string, @end$of$line$string, @quote$string ), show$param$list(*) pointer data( @version$string, @beep$string, @debug$string, @escape$string, @retry$string, @packet$len$string, @timeout$string, @padding$string, @padchar$string, @end$of$line$string, @quote$string, @all$string ), on$off$list(*) pointer data( @on$string, @off$string ), /* Comand parsing information (defined in KERMIT$UTIL) */ num$keywords byte external; /* Number of keywords found */ /* External procedures defined in KERMIT$SYS */ get$console$char: procedure( time$limit ) word external; declare time$limit word; end get$console$char; xmit$console$char: procedure( ch ) external; declare ch byte; end xmit$console$char; get$remote$char: procedure( time$limit ) word external; declare time$limit word; end get$remote$char; xmit$remote$char: procedure( ch ) external; declare ch byte; end xmit$remote$char; xmit$break: procedure external; end xmit$break; print: procedure( string$ptr ) external; declare string$ptr pointer; end print; new$line: procedure external; end new$line; exit$program: procedure external; end exit$program; setup: procedure external; end setup; setup$for$communication: procedure external; end setup$for$communication; finish$communication: procedure external; end finish$communication; get$first$file$name: procedure( keyword$num, info$ptr ) external; declare keyword$num byte, info$ptr pointer; end get$first$file$name; get$next$file$name: procedure( info$ptr ) external; declare info$ptr pointer; end get$next$file$name; prepare$file$name: procedure( info$ptr ) external; declare info$ptr pointer; end prepare$file$name; open$file: procedure( name$ptr ) boolean external; declare name$ptr pointer; end open$file; create$file: procedure( name$ptr ) boolean external; declare name$ptr pointer; end create$file; close$file: procedure external; end close$file; get$command$line: procedure( prompt$ptr ) external; declare prompt$ptr pointer; end get$command$line; do$help: procedure( num$params ) external; declare num$params byte; end do$help; /* External procedures defined in KERMIT$UTIL */ upcase: procedure( x ) byte external; declare x byte; end upcase; next$seq: procedure( seq$num ) byte external; declare seq$num byte; end next$seq; previous$seq: procedure( seq$num ) byte external; declare seq$num byte; end previous$seq; show$char: procedure( ch ) external; declare ch byte; end show$char; show$dec$num: procedure( num ) external; declare num word; end show$dec$num; show$flag: procedure( flag ) external; declare flag boolean; end show$flag; send$packet: procedure( type, num, info$ptr ) external; declare ( type, num ) byte, info$ptr pointer; end send$packet; receive$packet: procedure( num$ptr, info$ptr ) byte external; declare ( num$ptr, info$ptr ) pointer; end receive$packet; send$kermit$params: procedure( info$ptr ) external; declare info$ptr pointer; end send$kermit$params; get$kermit$params: procedure( info$ptr ) external; declare info$ptr pointer; end get$kermit$params; read$packet$from$file: procedure( info$ptr ) external; declare info$ptr pointer; end read$packet$from$file; write$packet$to$file: procedure( info$ptr ) external; declare info$ptr pointer; end write$packet$to$file; error$msg: procedure( msg$ptr ) external; declare msg$ptr pointer; end error$msg; unknown$packet$type: procedure( type, packet$ptr ) external; declare type byte, packet$ptr pointer; end unknown$packet$type; too$many$retries: procedure external; end too$many$retries; wrong$number: procedure external; end wrong$number; parse$command: procedure external; end parse$command; parse$dec$num: procedure( keyword$num, num$ptr ) boolean external; declare keyword$num byte, num$ptr pointer; end parse$dec$num; show$command: procedure( kp1, kp2, kp3 ) external; declare ( kp1, kp2, kp3 ) pointer; end show$command; too$few$params: procedure( kp1, kp2, kp3 ) external; declare ( kp1, kp2, kp3 ) pointer; end too$few$params; too$many$params: procedure( kp1, kp2, kp3 ) external; declare ( kp1, kp2, kp3 ) pointer; end too$many$params; extra$params: procedure( kp1, kp2, kp3 ) external; declare ( kp1, kp2, kp3 ) pointer; end extra$params; invalid$param: procedure( k$num, kp1, kp2, kp3 ) external; declare k$num byte, ( kp1, kp2, kp3 ) pointer; end invalid$param; keyword$match: procedure( keyword$num, keyword$ptr, min$len ) boolean external; declare ( keyword$num, min$len ) byte, keyword$ptr pointer; end keyword$match; list$choices: procedure( kp1, kp2, kp3, list$ptr, list$last ) external; declare ( kp1, kp2, kp3, list$ptr ) pointer, list$last byte; end list$choices; get$filespec: procedure( keyword$num, info$ptr ) external; declare keyword$num byte, info$ptr pointer; end get$filespec; send$generic$command: procedure( info$ptr, info2$ptr ) boolean external; declare ( info$ptr, info2$ptr ) pointer; end send$generic$command; /* * * Command implementation procedures * */ exit: procedure; /* * Implement the EXIT command. */ if ( num$keywords > 1 ) then /* a parameter followed EXIT */ call too$many$params( @exit$string, 0, 0 ); else call exit$program; end exit; connect: procedure; /* * Implement the CONNECT command by performing as a virtual * terminal to the remote system. Everything coming from the * remote computer is sent out to the console screen, and * everything typed on the console keyboard, except for the * "escape" character, is passed through to the remote system. * Even the break key may be pressed on the console terminal * and a break signal will be sent to the remote system. * The escape character is by default; it can be * set by the SET ESCAPE command. * If the escape character is followed by "C" (in upper or * lower case) the connection is closed and you are returned to * the local Kermit's command level. * If the escape character is followed by itself (i.e. it * is typed twice) it will be sent (once) to the remote system, * since this is the only way to send the escape character to * the remote system in CONNECT. * If the escape character is followed by anything else, or * if nothing is typed on the console within CONNECT$ESC$TIME$LIMIT * seconds after the escape character, a message will be displayed * explaining the options and the connection will be continued. */ declare keep$connected boolean, ch word; /* Current character (or TIMEOUT) */ if ( num$keywords > 1 ) then /* a parameter followed CONNECT */ call too$many$params( @connect$string, 0, 0 ); else do; call setup$for$communication; /* Prepare to communicate */ /* Keep the user informed of what we're doing */ call print( @( 37,'[ Connecting to remote system; type "' ) ); call show$char( esc$char ); call print( @( 31,'C" to return to local Kermit. ]' ) ); call new$line; call new$line; /* Leave a blank line */ /* begin the virtual terminal loop */ keep$connected = TRUE; do while ( keep$connected ); /* Get the next character (if any) from the remote system */ ch = get$remote$char( 0 ); /* don't wait */ if ( ch <> TIMEOUT ) then /* we got a character */ call xmit$console$char( ch ); /* so print it on the console */ /* Get the next character (if any) from the console */ ch = get$console$char( 0 ); /* don't wait */ if ( ch <> TIMEOUT ) then /* we got a character */ do; /* Handle the console character */ if ( ch = esc$char ) then /* we got the escape character */ do; /* Handle the escape sequence */ /* Get the next character from the console */ ch = get$console$char( CONNECT$ESC$TIME$LIMIT ); if ( upcase( ch ) = 'C' ) then /* If it was C */ keep$connected = FALSE; /* Close the connection */ else if ( ch = esc$char ) then /* They typed it twice */ /* Send the escape character to the remote system */ call xmit$remote$char( esc$char ); else /* Otherwise tell them what's going on */ do; call new$line; call print( @( 19,'[ You are connected' ) ); call print( @( 22,' to the remote system.' ) ); call new$line; call print( @( 8,' Type "' ) ); call show$char( esc$char ); call print( @( 25,'C" to return to the local' ) ); call print( @( 24,' Kermit''s command level.' ) ); call new$line; call print( @( 8,' Type "' ) ); call show$char( esc$char ); call show$char( esc$char ); call print( @( 12,'" to send a ' ) ); call show$char( esc$char ); call print( @( 22,' to the remote system.' ) ); call new$line; call print( @( 8,' Type "' ) ); call show$char( esc$char ); call print( @( 23,'?" to see this message.' ) ); call new$line; call print( @( 26,' Connection continuing. ]' ) ); call new$line; end; /* else */ end; /* if ( ch = esc$char ) */ else if ( ch = BREAK ) then /* we got the break key */ call xmit$break; /* so send a break signal out */ else /* we got an ordinary character from the console */ call xmit$remote$char( ch ); /* Send it to remote system */ end; /* if ( ch <> TIMEOUT ) */ end; /* do while ( keep$connected ) */ /* Keep the user informed */ call new$line; call print( @( 21,'[ Connection closed, ' ) ); call print( @( 23,'back at local Kermit. ]' ) ); call finish$communication; /* And restore everything */ end; /* else -- no parameter */ end connect; bye: procedure; /* * Implement the BYE command. */ if ( num$keywords > 1 ) then /* a parameter followed BYE */ call too$many$params( @bye$string, 0, 0 ); else do; /* Perform the BYE command */ call setup$for$communication; /* Send Generic Kermit Logout/bye command */ if send$generic$command( @( 1,'L' ), @info2 ) then call exit$program; /* ACK'd O.K., so exit the program--bye! */ call finish$communication; call new$line; call error$msg( @( 15,'Command failed.' ) ); end; /* else */ end bye; finish: procedure; /* * Implement the FINISH command. */ if ( num$keywords > 1 ) then call too$many$params( @finish$string, 0, 0 ); else do; call setup$for$communication; /* Send Generic Kermit Finish command */ if send$generic$command( @( 1,'F' ), @info2 ) then call print( @ok$string ); /* tell them it went O.K. */ else do; call new$line; call error$msg( @( 15,'Command failed.' ) ); end; call finish$communication; end; /* else */ end finish; logout: procedure; /* * Implement the LOGOUT command. */ if ( num$keywords > 1 ) then call too$many$params( @logout$string, 0, 0 ); else do; call setup$for$communication; /* Send the Generic Kermit Logout command */ if send$generic$command( @( 1,'L' ), @info2 ) then call print( @ok$string ); /* tell them it went O.K. */ else do; call new$line; call error$msg( @( 15,'Command failed.' ) ); end; call finish$communication; end; /* else */ end logout; help: procedure; /* * Implement the HELP command. */ /* Invoke the HELP program */ call do$help( num$keywords - 1 ); end help; set: procedure; /* * Implement the SET command by dispatching to the appropriate * routine based on the second keyword (the parameter following SET). */ set$flag: procedure( kp2, flag$ptr ); /* * SET a flag. KP2 points to the flag's name and * FLAG$PTR points the the boolean variable to be set. * ON means set the flag TRUE, OFF means FALSE. */ declare ( kp2, flag$ptr ) pointer, flag based flag$ptr boolean; if ( num$keywords < 3 ) then call too$few$params( @set$string, kp2, 0 ); else if ( num$keywords > 3 ) then call extra$params( @set$string, kp2, 0 ); else if keyword$match( 2, @q$mark, 1 ) then call list$choices( @set$string, kp2, 0, @on$off$list, last( on$off$list ) ); else if keyword$match( 2, @on$string, 2 ) then do; flag = TRUE; call print( @ok$string ); end; else if keyword$match( 2, @off$string, 2 ) then do; flag = FALSE; call print( @ok$string ); end; else call invalid$param( 2, @set$string, kp2, 0 ); end set$flag; set$byte: procedure( kp2, byte$ptr ); /* * SET a byte variable. KP2 points to its name, BYTE$PTR * points to the byte variable. A decimal number is used. */ declare ( kp2, byte$ptr ) pointer, num based byte$ptr byte, new$num word; if ( num$keywords < 3 ) then call too$few$params( @set$string, kp2, 0 ); else if ( num$keywords > 3 ) then call extra$params( @set$string, kp2, 0 ); else if keyword$match( 2, @q$mark, 1 ) then do; call show$command( @set$string, kp2, 0 ); call print( @( 38,' must be followed by a decimal number.' ) ); end; /* if keyword$match( 2, @q$mark, 1 ) */ else do; if ( parse$dec$num( 2, @new$num ) ) then do; num = new$num; call print( @ok$string ); end; /* if -- valid number */ else call invalid$param( 2, @set$string, kp2, 0 ); end; /* else */ end set$byte; /* begin SET */ if ( num$keywords < 2 ) then /* there was no second keyword */ call too$few$params( @set$string, 0, 0 ); else if keyword$match( 1, @q$mark, 1 ) then call list$choices( @set$string, 0, 0, @set$param$list, last( set$param$list ) ); else if keyword$match( 1, @escape$string, 2 ) then call set$byte( @escape$string, @esc$char ); else if keyword$match( 1, @beep$string, 1 ) then call set$flag( @beep$string, @beep ); else if keyword$match( 1, @debug$string, 1 ) then call set$flag( @debug$string, @debug ); else if keyword$match( 1, @retry$string, 1 ) then call set$byte( @retry$string, @max$retry ); else if keyword$match( 1, @packet$len$string, 3 ) then call set$byte( @packet$len$string, @packet$len ); else if keyword$match( 1, @timeout$string, 1 ) then call set$byte( @timeout$string, @time$limit ); else if keyword$match( 1, @padding$string, 4 ) then call set$byte( @padding$string, @num$pad ); else if keyword$match( 1, @padchar$string, 4 ) then call set$byte( @padchar$string, @pad$char ); else if keyword$match( 1, @end$of$line$string, 2 ) then call set$byte( @end$of$line$string, @eol ); else if keyword$match( 1, @quote$string, 1 ) then call set$byte( @quote$string, @quote ); else /* unknown parameter */ call invalid$param( 1, @set$string, 0, 0 ); end set; show: procedure; /* * Implement the SHOW command by dispatching to the appropriate * routine based on the second keyword (the parameter after SHOW). */ show$version: procedure; /* Implement the SHOW VERSION command */ if ( num$keywords > 2 ) then call too$many$params( @show$string, @version$string, 0 ); else do; call print( @( 8,'This is ' ) ); call print( @sign$on ); end; end show$version; show$flag$value: procedure( kp2, flag$ptr ); /* * Show the value of a flag. KP2 points to its name, * and FLAG$PTR points to the boolean variable. */ declare ( kp2, flag$ptr ) pointer, flag based flag$ptr boolean; if ( num$keywords > 2 ) then call too$many$params( @show$string, kp2, 0 ); else do; call print( kp2 ); call print( @currently$string ); call show$flag( flag ); call new$line; end; /* else */ end show$flag$value; show$byte: procedure( kp2, byte$ptr, char$flag, msg$ptr ); /* * SHOW a byte variable. KP2 points to its keyword name, * BYTE$PTR points to the byte itself, MSG$PTR points to * the message to be displayed before its value, and * CHAR$FLAG is TRUE if it is a character. */ declare ( kp2, byte$ptr, msg$ptr ) pointer, char$flag boolean, num based byte$ptr byte; if ( num$keywords > 2 ) then call too$many$params( @show$string, kp2, 0 ); else do; call print( msg$ptr ); call print( @currently$string ); if ( char$flag ) then do; call show$char( num ); call print( @( 8,', ASCII ' ) ); end; /* if ( char$flag ) */ call show$dec$num( num ); call print( @( 10,' (decimal)' ) ); call new$line; end; /* else */ end show$byte; show$all: procedure; /* Implement the SHOW ALL command. */ if ( num$keywords > 2 ) then call too$many$params( @show$string, @all$string, 0 ); else do; /* show all the things we can show */ call show$version; call show$flag$value( @beep$string, @beep ); call show$flag$value( @debug$string, @debug ); call show$byte( @escape$string, @esc$char, TRUE, @( 34,'The "escape" character for CONNECT' ) ); call show$byte( @retry$string, @max$retry, FALSE, @( 31,'Maximum times to retry a packet' ) ); call show$byte( @packet$len$string, @packet$len, FALSE, @( 29,'Maximum length packet to send' ) ); call show$byte( @timeout$string, @time$limit, FALSE, @( 37,'Seconds to wait for receive character' ) ); call show$byte( @padding$string, @num$pad, FALSE, @( 36,'Number of padding characters to send' ) ); call show$byte( @padchar$string, @pad$char, TRUE, @( 25,'Padding character to send' ) ); call show$byte( @end$of$line$string, @eol, TRUE, @( 29,'End-of-line character to send' ) ); call show$byte( @quote$string, @quote, TRUE, @( 25,'Control-quoting character' ) ); end; /* else -- no extra parameter */ end show$all; /* begin SHOW */ if ( num$keywords < 2 ) then /* there was no second keyword */ call too$few$params( @show$string, 0, 0 ); else if keyword$match( 1, @q$mark, 1 ) then call list$choices( @show$string, 0, 0, @show$param$list, last( show$param$list ) ); else if keyword$match( 1, @version$string, 1 ) then call show$version; else if keyword$match( 1, @beep$string, 1 ) then call show$flag$value( @beep$string, @beep ); else if keyword$match( 1, @debug$string, 1 ) then call show$flag$value( @debug$string, @debug ); else if keyword$match( 1, @escape$string, 2 ) then call show$byte( @escape$string, @esc$char, TRUE, @( 34,'The "escape" character for CONNECT' ) ); else if keyword$match( 1, @retry$string, 1 ) then call show$byte( @retry$string, @max$retry, FALSE, @( 31,'Maximum times to retry a packet' ) ); else if keyword$match( 1, @packet$len$string, 3 ) then call show$byte( @packet$len$string, @packet$len, FALSE, @( 29,'Maximum length packet to send' ) ); else if keyword$match( 1, @timeout$string, 1 ) then call show$byte( @timeout$string, @time$limit, FALSE, @( 37,'Seconds to wait for receive character' ) ); else if keyword$match( 1, @padding$string, 4 ) then call show$byte( @padding$string, @num$pad, FALSE, @( 36,'Number of padding characters to send' ) ); else if keyword$match( 1, @padchar$string, 4 ) then call show$byte( @padchar$string, @pad$char, TRUE, @( 25,'Padding character to send' ) ); else if keyword$match( 1, @end$of$line$string, 2 ) then call show$byte( @end$of$line$string, @eol, TRUE, @( 29,'End-of-line character to send' ) ); else if keyword$match( 1, @quote$string, 1 ) then call show$byte( @quote$string, @quote, TRUE, @( 25,'Control-quoting character' ) ); else if keyword$match( 1, @all$string, 1 ) then call show$all; else call invalid$param( 1, @show$string, 0, 0 ); end show; send: procedure; /* * Implement the SEND command. */ send$init: procedure; /* Implement the Send-initiate state. */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; /* Send a Send-init packet */ /* We would now flush the input buffer if we were using one */ call send$kermit$params( @info2 ); /* Load our parameters */ call send$packet( 'S', seq, @info2 ); /* Send-initiate */ type = receive$packet( @num, @info2 ); /* Get the response */ /* If we got an acknowledgement with the proper number */ if ( ( type = 'Y' ) and ( num = seq ) ) then do; call get$kermit$params( @info2 ); /* Extract their params */ tries = 0; /* reset try count */ seq = next$seq( seq ); /* bump sequence number */ if ( open$file( @info ) ) then /* open the file to be sent */ do; /* it was successfully opened */ /* Keep the user informed of our progress */ call print( @( 13,'Sending file ' ) ); call print( @info ); call print( @dots$string ); call prepare$file$name( @info ); state = 'F'; /* go to send-file state */ end; /* if ( open$file( @info ) ) */ else /* couldn't open file */ state = 'A'; /* abort--error message already given */ end; /* if ( ( type = 'Y' ) and ( num = seq ) ) */ else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( ( type <> 'Y' ) and ( type <> 'N' ) and ( type <> 0 ) ) then /* got wrong type packet */ call unknown$packet$type( type, @info2 ); /* abort */ /* Don't change state if got NAK, bad ACK, or nothing at all */ end; /* else -- send send-init */ end send$init; send$file$data: procedure; /* Implement the Send File-header and Send file-Data states */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; /* Send packet (file-name or data) */ call send$packet( state, seq, @info ); type = receive$packet( @num, @info2 ); /* get reply */ /* If got ACK for this packet or NAK for next one */ if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or ( ( type = 'Y' ) and ( num = seq ) ) ) then do; tries = 0; /* reset try count */ seq = next$seq( seq ); /* bump sequence number */ call read$packet$from$file( @info ); /* Load data packet */ if ( info.len = 0 ) then /* end-of-file */ state = 'Z'; /* so go to end-of-file state */ else /* data ready to be sent */ state = 'D'; /* go to (or stay in) send-Data state */ end; /* if ... */ else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( ( type <> 'Y' ) and ( type <> 'N' ) and ( type <> 0 ) ) then call unknown$packet$type( type, @info2 ); /* abort */ /* If get NAK, bad ACK, or nothing at all, state doesn't change */ end; /* else -- send packet */ end send$file$data; send$eof: procedure; /* Implement the Send-end-of-file state */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; /* Send EOF packet */ call send$packet( 'Z', seq, 0 ); type = receive$packet( @num, @info2 ); /* Get reply */ /* If got ACK for this packet or NAK for next one */ if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or ( ( type = 'Y' ) and ( num = seq ) ) ) then do; call close$file; /* close the file we're done sending */ call print( @ok$string ); /* terminate the */ call new$line; /* "Sending file..." message */ tries = 0; /* reset try count */ seq = next$seq( seq ); /* bump packet sequence number */ call get$next$file$name( @info ); /* Get next file to send */ if ( info.len = 0 ) then /* no more files */ state = 'B'; /* go to Break-transmission state */ else /* Another file to be sent */ do; if ( open$file( @info ) ) then /* open next file */ do; /* it was successfully opened */ /* Keep the user informed of our progress */ call print( @( 13,'Sending file ' ) ); call print( @info ); call print( @dots$string ); call prepare$file$name( @info ); state = 'F'; /* go to send-file state */ end; /* if ( open$file( @info ) ) */ else /* couldn't open file, so abort */ state = 'A'; /* error message already given */ end; /* else -- another file to be sent */ end; /* if ... */ else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( ( type <> 'Y' ) and ( type <> 'N' ) and ( type <> 0 ) ) then call unknown$packet$type( type, @info2 ); /* abort */ /* If get NAK, bad ACK, or nothing at all, state doesn't change */ end; /* else -- send EOF packet */ end send$eof; send$break: procedure; /* Implement the Send-Break (End-of-Transmission) state */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; /* send the break (or EOT) packet */ call send$packet( 'B', seq, 0 ); type = receive$packet( @num, @info2 ); /* Get reply */ /* If got ACK for this packet or NAK for next one */ if ( ( ( type = 'N' ) and ( num = next$seq( seq ) ) ) or ( ( type = 'Y' ) and ( num = seq ) ) ) then do; tries = 0; /* reset try count */ seq = next$seq( seq ); /* bump packet sequence number */ state = 'C'; /* and go to state Complete */ end; /* if ... */ else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( ( type <> 'Y' ) and ( type <> 'N' ) and ( type <> 0 ) ) then call unknown$packet$type( type, @info2 ); /* abort */ /* If get NAK, bad ACK, or nothing at all, state doesn't change */ end; /* else -- send break packet */ end send$break; /* begin SEND */ if ( num$keywords < 2 ) then do; /* tell them what kind of parameter is required */ call print( @send$string ); call print( @( 33,' must be followed by the filespec' ) ); call print( @( 28,' for the file(s) to be sent.' ) ); end; /* if ( num$keywords < 2 ) */ else if ( num$keywords > 2 ) then call extra$params( @send$string, 0, 0 ); else /* We have one parameter, the filespec */ do; /* perform the SEND command */ /* Get first filename to send, using second keyword as filespec */ call get$first$file$name( 1, @info ); if ( info.len > 0 ) then /* we got a valid filespec */ do; /* Implement the Send state-table switcher */ call setup$for$communication; state = 'S'; /* Start with Send-init state */ seq = 0; /* Initialize the packet sequence numbers */ tries = 0; /* no retries yet */ /* do this as long as we're in a valid send state */ do while ( ( state = 'S' ) or ( state = 'F' ) or ( state = 'D' ) or ( state = 'Z' ) or ( state = 'B' ) ); /* Dispatch to appropriate routine (they switch the state) */ if ( state = 'S' ) then call send$init; else if ( ( state = 'F' ) or ( state = 'D' ) ) then call send$file$data; /* two states share one routine */ else if ( state = 'Z' ) then call send$eof; else /* state must be B */ call send$break; end; /* do while ... */ if ( beep ) then /* Alert them that we finished */ call xmit$console$char( BEL ); if ( state = 'C' ) then /* proper completion */ call print( @( 14,'Send complete.' ) ); else do; call new$line; if ( state = 0FFh ) then /* it was because of CTRL/C */ call error$msg( @( 23,'Send aborted by CTRL/C.' ) ); else call error$msg( @( 12, 'Send failed.' ) ); end; call finish$communication; end; /* if ( info.len > 0 ) */ else /* invalid filespec */ call print( @( 29,'Bad filespec, send cancelled.' ) ); end; /* else -- we have one parameter */ end send; do$receive: procedure( get ); /* * Perform the RECEIVE (if GET is FALSE) * or GET (if GET is TRUE) command. */ declare get boolean, oldtries byte; /* tries for previous packet */ receive$init: procedure; /* Implement the Receive Send-init state */ declare type byte; /* Incoming packet type */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many tries */ call too$many$retries; /* give up--go to Abort state */ else do; /* try to receive a Send-init packet */ /* Get a packet, and set our sequence number to match its */ type = receive$packet( @seq, @info2 ); if ( type = 'S' ) then /* we got one */ do; call get$kermit$params( @info2 ); /* extract their params */ call send$kermit$params( @info2 ); /* and load ours */ call send$packet( 'Y', seq, @info2 ); /* send ACK */ oldtries = tries; /* save number of init tries */ tries = 0; /* Reset try counter for next packet */ seq = next$seq( seq ); /* Go to next sequence number */ state = 'F'; /* And enter Receive-file state */ end; /* if ( type = 'S' ) */ else if ( get and ( type = 'N' ) ) then /* Got NAK to our Receive-init, so send it again */ call send$packet( 'R', seq, @info ); else if ( type = 0FFh ) then /* CTRL/C abort */ state = 0FFh; else if ( type = 0 ) then /* got bad packet or none at all */ call send$packet( 'N', seq, 0 ); /* send NAK */ /* And will try again to receive--state didn't change */ else /* we got a packet, but wrong type */ call unknown$packet$type( type, @info2 ); /* abort */ end; /* else -- not too many tries yet */ end receive$init; receive$file: procedure; /* Implement the Receive-file state */ declare ( type, num ) byte; /* Incoming packet type, sequence num */ tries = ( tries + 1 ); /* count a try */ if ( tries > max$retry ) then /* too many tries */ call too$many$retries; /* abort */ else /* get a packet */ do; type = receive$packet( @num, @info ); if ( type = 'S' ) then /* it was a Send-init */ do; oldtries = ( oldtries + 1 ); /* Increment its tries */ if ( oldtries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else if ( num = previous$seq( seq ) ) then do; /* It was the previous packet, so our ACK was lost */ call send$kermit$params( @info2 ); /* reload our params */ call send$packet( 'Y', num, @info2 ); /* previous ACK */ tries = 0; /* reset tries for file-header packet */ /* state and seq don't change, already updated */ end; else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'S' ) */ else if ( type = 'Z' ) then /* it was end-of-file */ do; oldtries = ( oldtries + 1 ); /* Increment its tries */ if ( oldtries > max$retry ) then /* too many tries */ call too$many$retries; /* abort */ else if ( num = previous$seq( seq ) ) then do; /* It was the previous packet, so our ACK was lost */ call send$packet( 'Y', num, 0 ); /* resend that ACK */ tries = 0; /* reset tries for file-header */ /* state and seq don't change */ end; else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'Z' ) */ else if ( type = 'B' ) then /* got Break */ do; if ( num = seq ) then /* got right number */ do; call send$packet( 'Y', seq, 0 ); /* ACK it */ state = 'C'; /* and go to complete state */ end; /* if ( num = seq ) */ else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'B' ) */ else if ( type = 'F' ) then /* got File header */ do; if ( num = seq ) then /* got right number */ do; if ( create$file( @info ) ) then /* create the file */ do; /* file successfully created */ /* Keep the user informed of our progress */ call print( @( 15,'Receiving file ' ) ); call print( @info ); /* file name */ call print( @dots$string ); call send$packet( 'Y', seq, 0 ); /* ACK */ oldtries = tries; /* save previous tries */ tries = 0; /* and init new packet tries */ seq = next$seq( seq ); /* go to next packet number */ state = 'D'; /* and enter Receive-data state */ end; /* if ( create$file( @info ) ) */ else /* a problem creating the file, so abort */ state = 'A'; /* error message already given */ end; /* if ( num = seq ) */ else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'F' ) */ else if ( type = 0FFh ) then /* got CTRL/C */ state = 0FFh; /* signal CTRL/C abort */ else if ( type = 0 ) then /* got bad packet or none at all */ call send$packet( 'N', seq, 0 ); /* send NAK */ /* And will try again to receive--state didn't change */ else /* we got a packet, but wrong type */ call unknown$packet$type( type, @info ); /* abort */ end; /* else -- not too many tries */ end receive$file; receive$data: procedure; /* Implement the Receive-data state */ declare ( type, num ) byte; /* Incoming packet type, number */ tries = ( tries + 1 ); /* count another try */ if ( tries > max$retry ) then /* too many */ call too$many$retries; /* abort */ else do; type = receive$packet( @num, @info ); /* get a packet */ if ( type = 'D' ) then /* got Data packet */ do; if ( num = seq ) then /* right number */ do; call write$packet$to$file( @info ); call send$packet( 'Y', seq, 0 ); /* ACK it */ oldtries = tries; /* save old try count */ tries = 0; /* and start a new one */ seq = next$seq( seq ); /* go to next packet number */ /* Remain in Receive-Data state */ end; /* if ( num = seq ) */ else /* wrong number */ do; oldtries = ( oldtries + 1 ); if ( oldtries > max$retry ) then call too$many$retries; /* too many tries, abort */ else if ( num = previous$seq( seq ) ) then do; /* got previous packet again */ call send$packet( 'Y', num, 0 ); /* ACK again */ tries = 0; /* reset tries for this one */ /* Stay in D state */ end; /* if ( num = previous$seq( seq ) ) */ else /* totally wrong number */ call wrong$number; /* abort */ end; /* else -- wrong number */ end; /* if ( type = 'D' ) */ else if ( type = 'F' ) then /* got file-header */ do; oldtries = ( oldtries + 1 ); if ( oldtries > max$retry ) then call too$many$retries; /* abort */ else if ( num = previous$seq( seq ) ) then do; /* Got previous packet again */ call send$packet( 'Y', num, 0 ); /* ACK again */ tries = 0; /* reset tries for this one */ /* State doesn't change */ end; /* if ( num = previous$seq( seq ) ) */ else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'F' ) */ else if ( type = 'Z' ) then /* got end-of-file */ do; if ( num = seq ) then /* right number */ do; call close$file; /* close the output file */ call print( @ok$string ); /* terminate the */ call new$line; /* "Receiving file..." message */ call send$packet( 'Y', seq, 0 ); /* ACK */ oldtries = tries; /* save old try count */ tries = 0; /* and init a new one */ seq = next$seq( seq ); /* go to next packet number */ state = 'F'; /* and go to Receive-File state */ end; /* if ( num = seq ) */ else /* wrong number */ call wrong$number; /* abort */ end; /* if ( type = 'Z' ) */ else if ( type = 0FFh ) then state = 0FFh; /* signal CTRL/C abort */ else if ( type = 0 ) then /* got bad packet or none at all */ call send$packet( 'N', seq, 0 ); /* send NAK */ /* And will try again to receive--state didn't change */ else /* we got a packet, but wrong type */ call unknown$packet$type( type, @info ); /* abort */ end; /* else -- not too many tries */ end receive$data; /* begin DO$RECEIVE */ call setup$for$communication; state = 'R'; /* Start with receive-init state */ seq = 0; /* initialize packet sequence number */ tries = 0; /* no retries yet */ if ( get ) then do; /* Request the file(s) from the server */ call get$filespec( 1, @info ); /* get second keyword into INFO */ call send$packet( 'R', seq, @info ); /* send Receive-initiate */ /* And fall through to normal RECEIVE */ end; /* if ( get ) */ /* Implement the Receive state-table switcher */ /* do this as long as we're in a valid receive state */ do while ( ( state = 'R' ) or ( state = 'F' ) or ( state = 'D' ) ); /* Dispatch to appropriate routine (they switch the state) */ if ( state = 'R' ) then call receive$init; else if ( state = 'F' ) then call receive$file; else /* state must be D */ call receive$data; end; /* do while ... */ if ( beep ) then /* Alert them that we finished */ call xmit$console$char( BEL ); if ( state = 'C' ) then /* proper completion */ call print( @( 17,'Receive complete.' ) ); else do; call new$line; if ( state = 0FFh ) then /* it was because of CTRL/C */ call error$msg( @( 26,'Receive aborted by CTRL/C.' ) ); else call error$msg( @( 15,'Receive failed.' ) ); end; call finish$communication; end do$receive; receive: procedure; /* * Implement the RECEIVE command. */ if ( num$keywords > 1 ) then /* a parameter followed RECEIVE */ call too$many$params( @receive$string, 0, 0 ); else /* Perform the RECEIVE command */ call do$receive( FALSE ); end receive; get: procedure; /* * Implement the GET command. */ if ( num$keywords < 2 ) then do; /* tell them what kind of parameter is required */ call print( @get$string ); call print( @( 33,' must be followed by the filespec' ) ); call print( @( 30,' for the file(s) to be gotten.' ) ); end; /* if ( num$keywords < 2 ) */ else if ( num$keywords > 2 ) then call extra$params( @get$string, 0, 0 ); else /* We have one parameter, the filespec */ call do$receive( TRUE ); /* perform the GET command */ end get; execute$command: procedure; /* * Execute the command specified by the first keyword parsed * from the command line. If it is not a valid command, issue * an appropriate error message to the console. */ if keyword$match( 0, @q$mark, 1 ) then call list$choices( 0, 0, 0, @command$list, last( command$list ) ); else if keyword$match( 0, @exit$string, 1 ) then call exit; else if keyword$match( 0, @help$string, 1 ) then call help; else if keyword$match( 0, @send$string, 3 ) then call send; else if keyword$match( 0, @receive$string, 1 ) then call receive; else if keyword$match( 0, @get$string, 1 ) then call get; else if keyword$match( 0, @connect$string, 1 ) then call connect; else if keyword$match( 0, @bye$string, 1 ) then call bye; else if keyword$match( 0, @logout$string, 1 ) then call logout; else if keyword$match( 0, @finish$string, 1 ) then call finish; else if keyword$match( 0, @set$string, 3 ) then call set; else if keyword$match( 0, @show$string, 2 ) then call show; else call invalid$param( 0, 0, 0, 0 ); call new$line; /* Make sure the next prompt starts on a new line */ end execute$command; /* * * Main program -- Kermit * */ /* begin KERMIT */ call new$line; call print( @sign$on ); /* Identify who and what we are */ call new$line; call setup; /* Do system-dependent setup */ /* Initialize our parameters to their defaults */ beep = TRUE; /* Beep unless told to shut up */ debug = FALSE; /* We hope it doesn't need any more debugging... */ esc$char = def$esc$char; max$retry = def$max$retry; packet$len = def$packet$len; time$limit = def$time$limit; num$pad = def$num$pad; pad$char = def$pad$char; eol = def$eol; quote = def$quote; /* Begin the main command line loop */ do forever; /* Do this until some command exits the program */ call get$command$line( @prompt ); /* Get a command line */ call parse$command; /* Parse the command line */ if ( num$keywords > 0 ) then /* If we got at least one keyword */ call execute$command; /* perform the command requested */ end; /* do forever */ end Kermit;