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