home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
archives
/
ucsdpecan.tar.gz
/
ucsdpecan.tar
/
kermit.text
< prev
next >
Wrap
Text File
|
1990-08-05
|
9KB
|
230 lines
program kermit;
(* $R-*) (* turn range checking off *)
(* $L+*)
USES {$u kermglob.code} kermglob,
{$U kermutil.code} kermutil,
{$U parser.code} parser,
{$U helper.code} helper,
{$U sender.code} sender,
{$U receiver.code} receiver,
{$U client.code} client;
const
my_version = 'Kermit-UCSD V1.1, 13 May 89';
{Change log:
13 May 89, V1.1: Fixed "lost debug file" bug RTC
30 Apr 89, V1.1: Moved set/show & connect procedures to kermutil RTC
30 Apr 89, V1.1: Added KERMENUS unit RTC
26 Apr 89, V1.1: Fixed "chained TAKE commands" bug RTC
19 Apr 89, V1.1: minor cleanups RTC
16 Apr 89, V1.1: Added BYE & FINISH commands RTC
15 Apr 89, V1.1: Added GET and PUT commands RTC
13 Apr 89, V1.1: Began work on new Version RTC
17 Aug 88: Misc. cleanup and bug fixes in LOG command RTC
14 Aug 88: Added LOG and CLOSE commands RTC
31 Jul 88: Modified for variable system_id RTC
02 Jul 88: Added Binary transfers & TAKE command RTC
29 Jun 88: Fixed Assorted Bugs in "connect" escape functions RTC
Modifications by SP, 25 Oct 1983: adapt to IBM Version IV.1
Delete keyboard and serial buffering: provided by system already.
Additional mods by SP, 18 Mar 1984: make all strings 255 chars long
13 May 84: Incorporate screen control through syscom record entries
for portability
}
var
taking_commands : boolean;
procedure initialize;
var ch: char;
begin
ker_version := my_version;
writeln(ker_version);
writeln(
' This program uses Library Units (c) 1986 Pecan Software Systems, Inc.');
writeln(
' This program may be freely distributed for non-commercial purposes.');
writeln;
timint := mytime;
pad := mypad;
padchar := chr(mypchar);
xeol := chr(my_eol);
esc_char := chr(my_esc);
quote := my_quote;
ctlset := [chr(0)..chr(31),chr(del),quote];
half_duplex := false;
debug := false;
{$I-}
rewrite(debf,'CONSOLE:');
{$I+}
emulating := false;
f_is_binary := false;
lit_names := false;
fwarn := false;
spsiz := max_pack;
rpsiz := max_pack;
n := 0;
parity := nopar;
initvocab;
fill_parity_array;
ibm := false;
xon := chr(17);
bufpos := 1;
bufend := 0;
baud := defaultbaud;
system_id := 'UNKNOWN';
if setup_comm then {baud was ok};
{$I-}
reset(cmd_file,'*kermitinfo.text');
taking_commands := io_result = 0;
if ioresult <> 0 then close(cmd_file)
{$I+}
end; (* initialize *)
procedure closeup;
begin
close(debf,lock);
page( output )
end; (* closeup *)
begin (* main kermit program *)
initialize;
repeat
write('Kermit-UCSD> ');
if taking_commands
then
begin
readln(cmd_file,line);
writeln(line);
if eof(cmd_file) then
begin
close(cmd_file);
taking_commands := false
end
end
else readstr(keyport,line);
case parse of
unconfirmed: writeln('Unconfirmed');
parm_expected: writeln('Parameter expected');
ambiguous: writeln('Ambiguous');
unrec: writeln('Unrecognized command');
fn_expected: writeln('File name expected');
ch_expected: writeln('Single character expected');
null: case verb of
consym: connect;
helpsym: help;
logsym: begin
{$I-}
case adj of
debugsym:
begin
close(debf,lock);
rewrite(debf,xfilename)
end;
end {case adj};
if ioresult <> 0 then
begin
writeln('Unable to open ',xfilename);
case adj of
debugsym:
begin
close(debf);
rewrite(debf,'CONSOLE:')
end;
end {case adj};
end
else {$I+}
case adj of
debugsym: write(debf,
ker_version,' -- Debug log...');
end
end;
closesym: begin
{$I-}
case adj of
debugsym: close(debf,lock);
end {case adj};
if ioresult <> 0 then
begin
writeln('Unable to close file');
end;
case adj of
debugsym: rewrite(debf,'CONSOLE:');
end {case adj};
{$I+}
end;
takesym : begin
{$I-}
if taking_commands
then close(cmd_file);
reset(cmd_file,xfilename);
taking_commands := io_result = 0;
if ioresult <> 0 then close(cmd_file)
{$I+}
end;
getsym, recsym: begin
recsw(rec_ok,verb = getsym);
gotoxy(0,debugline);
write(chr(bell));
if rec_ok then
writeln('successful receive')
else
writeln('unsuccessful receive');
(*$I-*) (* set i/o checking off *)
if f_is_binary
then close(b_file)
else close(t_file);
(*$I+*) (* set i/o checking back on *)
gotoxy(0,promptline);
end; (* recsym *)
putsym, sendsym: begin
uppercase(xfilename);
sendsw(send_ok);
gotoxy(0,debugline);
write(chr(bell));
if send_ok then
writeln('successful send')
else
writeln('unsuccessful send');
(*$I-*) (* set i/o checking off *)
if f_is_binary
then close(b_file)
else close(t_file);
(*$I+*) (* set i/o checking back on *)
gotoxy(0,promptline);
end; (* sendsym *)
finsym,byesym: begin
case verb of
finsym: line := 'F';
byesym: line := 'L';
end {case};
clientsw(send_ok,'G',line);
gotoxy(0,debugline);
write(chr(bell));
if send_ok then
writeln('successful transaction')
else
writeln('unsuccessful transaction');
(*$I-*) (* set i/o checking off *)
close(t_file);
(*$I+*) (* set i/o checking back on *)
gotoxy(0,promptline);
end; {generic server command}
setsym: set_parms;
show_sym: show_parms;
end; (* case verb *)
end; (* case parse *)
until (verb = exitsym) or (verb = quitsym);
closeup
end. (* kermit *)