home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
intel86
/
kermit.p86
< prev
next >
Wrap
Text File
|
2020-01-01
|
56KB
|
1,477 lines
$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 <Ctrl-]> 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;
