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 *)