home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / ucsdpecan / kermit.text < prev    next >
Text File  |  1990-08-04  |  9KB  |  230 lines
  1. program kermit;
  2.  
  3. (* $R-*) (* turn range checking off *)
  4. (* $L+*)
  5.  
  6. USES {$u kermglob.code} kermglob,
  7.      {$U kermutil.code} kermutil,
  8.      {$U parser.code}   parser,
  9.      {$U helper.code}   helper,
  10.      {$U sender.code}   sender,
  11.      {$U receiver.code} receiver,
  12.      {$U client.code}   client;
  13.  
  14. const
  15.   my_version = 'Kermit-UCSD V1.1, 13 May 89';
  16.  
  17. {Change log:
  18.   13 May 89, V1.1: Fixed "lost debug file" bug   RTC
  19.   30 Apr 89, V1.1: Moved set/show & connect procedures to kermutil   RTC
  20.   30 Apr 89, V1.1: Added KERMENUS unit   RTC
  21.   26 Apr 89, V1.1: Fixed "chained TAKE commands" bug     RTC
  22.   19 Apr 89, V1.1: minor cleanups   RTC
  23.   16 Apr 89, V1.1: Added BYE & FINISH commands       RTC
  24.   15 Apr 89, V1.1: Added GET and PUT commands       RTC
  25.   13 Apr 89, V1.1: Began work on new Version   RTC
  26.   17 Aug 88: Misc. cleanup and bug fixes in LOG command      RTC
  27.   14 Aug 88: Added LOG and CLOSE commands         RTC
  28.   31 Jul 88: Modified for variable system_id       RTC
  29.   02 Jul 88: Added Binary transfers & TAKE command     RTC
  30.   29 Jun 88: Fixed Assorted Bugs in "connect" escape functions  RTC
  31.   Modifications by SP, 25 Oct 1983: adapt to IBM Version IV.1
  32.   Delete keyboard and serial buffering: provided by system already.
  33.  
  34.   Additional mods by SP, 18 Mar 1984: make all strings 255 chars long
  35.  
  36.   13 May 84: Incorporate screen control through syscom record entries
  37.              for portability
  38. }
  39.  
  40. var
  41.   taking_commands : boolean;
  42.  
  43. procedure initialize;
  44.  
  45. var ch: char;
  46.  
  47.   begin
  48.     ker_version := my_version;
  49.     writeln(ker_version);
  50.     writeln(
  51. '   This program uses Library Units (c) 1986 Pecan Software Systems, Inc.');
  52.     writeln(
  53. '   This program may be freely distributed for non-commercial purposes.');
  54.     writeln;
  55.     timint := mytime;
  56.     pad := mypad;
  57.     padchar := chr(mypchar);
  58.     xeol := chr(my_eol);
  59.     esc_char := chr(my_esc);
  60.     quote := my_quote;
  61.     ctlset := [chr(0)..chr(31),chr(del),quote];
  62.     half_duplex := false;
  63.     debug := false;
  64.     {$I-}
  65.     rewrite(debf,'CONSOLE:');
  66.     {$I+}
  67.     emulating := false;
  68.     f_is_binary := false;
  69.     lit_names := false;
  70.     fwarn := false;
  71.     spsiz := max_pack;
  72.     rpsiz := max_pack;
  73.     n := 0;
  74.     parity := nopar;
  75.     initvocab;
  76.     fill_parity_array;
  77.     ibm := false;
  78.     xon := chr(17);
  79.     bufpos := 1;
  80.     bufend := 0;
  81.     baud := defaultbaud;
  82.     system_id := 'UNKNOWN';
  83.     if setup_comm then {baud was ok};
  84.     {$I-}
  85.     reset(cmd_file,'*kermitinfo.text');
  86.     taking_commands := io_result = 0;
  87.     if ioresult <> 0 then close(cmd_file)
  88.     {$I+}
  89.   end; (* initialize *)
  90.  
  91.  
  92. procedure closeup;
  93.  
  94.   begin
  95.     close(debf,lock);
  96.     page( output )
  97.   end; (* closeup *)
  98.  
  99.  
  100.   begin (* main kermit program *)
  101.     initialize;
  102.     repeat
  103.         write('Kermit-UCSD> ');
  104.         if taking_commands
  105.           then
  106.             begin
  107.               readln(cmd_file,line);
  108.               writeln(line);
  109.               if eof(cmd_file) then
  110.                 begin
  111.                   close(cmd_file);
  112.                   taking_commands := false
  113.                 end
  114.             end
  115.           else readstr(keyport,line);
  116.         case parse of
  117.             unconfirmed: writeln('Unconfirmed');
  118.             parm_expected: writeln('Parameter expected');
  119.             ambiguous: writeln('Ambiguous');
  120.             unrec: writeln('Unrecognized command');
  121.             fn_expected: writeln('File name expected');
  122.             ch_expected: writeln('Single character expected');
  123.             null: case verb of
  124.                       consym: connect;
  125.                       helpsym: help;
  126.                       logsym:   begin
  127.                                   {$I-}
  128.                                   case adj of
  129.                                     debugsym:
  130.                                       begin
  131.                                         close(debf,lock);
  132.                                         rewrite(debf,xfilename)
  133.                                       end;
  134.                                   end {case adj};
  135.                                   if ioresult <> 0 then
  136.                                     begin
  137.                                       writeln('Unable to open ',xfilename);
  138.                                       case adj of
  139.                                         debugsym:
  140.                                           begin
  141.                                             close(debf);
  142.                                             rewrite(debf,'CONSOLE:')
  143.                                           end;
  144.                                       end {case adj};
  145.                                     end
  146.                                   else {$I+}
  147.                                     case adj of
  148.                                       debugsym: write(debf,
  149.                                           ker_version,' -- Debug log...');
  150.                                     end
  151.                                 end;
  152.                       closesym: begin
  153.                                   {$I-}
  154.                                   case adj of
  155.                                     debugsym: close(debf,lock);
  156.                                   end {case adj};
  157.                                   if ioresult <> 0 then
  158.                                     begin
  159.                                       writeln('Unable to close file');
  160.                                     end;
  161.                                   case adj of
  162.                                     debugsym: rewrite(debf,'CONSOLE:');
  163.                                   end {case adj};
  164.                                   {$I+}
  165.                                 end;
  166.                       takesym : begin
  167.                                   {$I-}
  168.                                   if taking_commands
  169.                                     then close(cmd_file);
  170.                                   reset(cmd_file,xfilename);
  171.                                   taking_commands := io_result = 0;
  172.                                   if ioresult <> 0 then close(cmd_file)
  173.                                   {$I+}
  174.                                 end;
  175.                       getsym, recsym: begin
  176.                           recsw(rec_ok,verb = getsym);
  177.                           gotoxy(0,debugline);
  178.                           write(chr(bell));
  179.                           if rec_ok then
  180.                               writeln('successful receive')
  181.                           else
  182.                               writeln('unsuccessful receive');
  183.                           (*$I-*) (* set i/o checking off *)
  184.                           if f_is_binary
  185.                             then close(b_file)
  186.                             else close(t_file);
  187.                           (*$I+*) (* set i/o checking back on *)
  188.                           gotoxy(0,promptline);
  189.                         end; (* recsym *)
  190.                       putsym, sendsym: begin
  191.                           uppercase(xfilename);
  192.                           sendsw(send_ok);
  193.                           gotoxy(0,debugline);
  194.                           write(chr(bell));
  195.                           if send_ok then
  196.                               writeln('successful send')
  197.                           else
  198.                               writeln('unsuccessful send');
  199.                           (*$I-*) (* set i/o checking off *)
  200.                           if f_is_binary
  201.                             then close(b_file)
  202.                             else close(t_file);
  203.                           (*$I+*) (* set i/o checking back on *)
  204.                           gotoxy(0,promptline);
  205.                         end; (* sendsym *)
  206.                       finsym,byesym: begin
  207.                           case verb of
  208.                             finsym: line := 'F';
  209.                             byesym: line := 'L';
  210.                           end {case};
  211.                           clientsw(send_ok,'G',line);
  212.                           gotoxy(0,debugline);
  213.                           write(chr(bell));
  214.                           if send_ok then
  215.                               writeln('successful transaction')
  216.                           else
  217.                               writeln('unsuccessful transaction');
  218.                           (*$I-*) (* set i/o checking off *)
  219.                           close(t_file);
  220.                           (*$I+*) (* set i/o checking back on *)
  221.                           gotoxy(0,promptline);
  222.                         end; {generic server command}
  223.                       setsym: set_parms;
  224.                       show_sym: show_parms;
  225.                   end; (* case verb *)
  226.         end; (* case parse *)
  227.      until (verb = exitsym) or (verb = quitsym);
  228.      closeup
  229.    end. (* kermit *)
  230.