home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / c / pq2glo.pas < prev    next >
Pascal/Delphi Source File  |  2020-01-01  |  16KB  |  525 lines
  1. Module KermitGlobals;                   
  2.  
  3. { This module contains global protocol definitions (packet types, generic
  4. { command codes, protocol states), character conversion functions,
  5. { error handling and some other global definitions. }
  6.  
  7. {===============================} Exports {===================================}
  8.  
  9. Imports Perq_String from Perq_String;
  10.  
  11. CONST
  12.  
  13.     KermitMessage = 'NTH Kermit for 3RC/ICL Perq - V2.2';
  14.     AbortedByCtlC = 'Transfer aborted by control C';
  15.  
  16.     GCLogin     = 'I';      { Generic commands }
  17.     GCConnect   = 'C';
  18.     GCLogout    = 'L';
  19.     GCFinish    = 'F';
  20.     GCDirectory = 'D';
  21.     GCDiskUsage = 'U';
  22.     GCErase     = 'E';
  23.     GCTypeFile  = 'T';
  24.     GCSubmit    = 'S';
  25.     GCPrint     = 'P';
  26.     GCWhoIsOn   = 'W';
  27.     GCSendMess  = 'M';
  28.     GCHelp      = 'H';
  29.     GCStatusQ   = 'Q';
  30.  
  31.     OldFile     =  FALSE;
  32.     NewFile     =  TRUE;
  33.  
  34.     NULL        =  chr(0);
  35.     CR          =  chr(13);
  36.     LF          =  chr(10);
  37.     FF          =  chr(12);
  38.     BS          =  chr(8);
  39.     CtlZ        =  chr( ord('Z') mod #40 );
  40.     ESC         =  chr( ord('[') mod #40 );
  41.     Xon         =  chr( ord('Q') mod #40 );
  42.     Xoff        =  chr( ord('S') mod #40 );
  43.     BreakKey    =  chr(255);
  44.  
  45.     MaxString   =   100;
  46.  
  47.     ProgressLines=5;
  48.     
  49. TYPE
  50.     KermitStates=   (   FileData,
  51.                         Init,
  52.                         Break,
  53.                         FileHeader,
  54.                         RemoteReply,
  55.                         EOFile,
  56.                         Complete,
  57.                         Abort1,
  58.                         AbortCtlC,
  59.                         AbortAll );
  60.  
  61.     StringType      =   array [ 1 .. MaxString ] of char;
  62.  
  63.     FNameType       =   PString;
  64.  
  65.     PacketType  =   (   DataPack,
  66.                         ACKPack,
  67.                         NAKPack,
  68.                         SinitPack,
  69.                         BrkPack,
  70.                         FHeadPack,
  71.                         EOFPack,
  72.                         ErrPack,
  73.                         RinitPack,
  74.                         CommPack,
  75.                         GCommPack,
  76.                         THeadPack,
  77.                         NoChangePack,   { for internal use }
  78.                         TimOutPack,     {     -  "  -      }
  79.                         IllPack,        {     -  "  -      }
  80.                         ChkIllPack);    {     -  "  -      }
  81.  
  82.     Packet      =   record
  83.                         mark    :   char;   { SOH character }
  84.                         count   :   char;   { # bytes following this field }
  85.                         seq     :   char;   { sequence number mod 64 }
  86.                         ptype   :   char;   { packet-type }
  87.                         data    :   String[MaxString]; { the data }
  88.                         { checksum is last of data }
  89.                     end;
  90.  
  91. VAR
  92.  
  93. { Protocol state variables }
  94.  
  95.     N,NN                    : Integer;      { Current packet seq. number }
  96.     OldTry,NumTry,TotTry    : Integer;      { Packet retry counts  }
  97.     CurrState               : KermitStates; { the current state of Kermit }
  98.  
  99.     LastNAK                 : Integer;      { if previous packet was NAK:
  100.                                               Seq.no of last NAK, else -1 }
  101.  
  102.     function    ToChar ( ch : char ): char;
  103.     function    UnChar ( ch : char ): char;
  104.     function    Ctl ( ch : char ): char;
  105.     function    MakeCheck ( chksum : integer ): char;
  106.     function    Prev ( n : integer ):integer;
  107.  
  108.     function    PackToCh ( pType : PacketType ): char;
  109.  
  110.     function    ChToPack( ch : char ): PacketType;
  111.  
  112.     procedure   Succeeded;
  113.     procedure   SendACK ( num : integer );
  114.     procedure   SendBrk;
  115.     procedure   SendNAK ( num : integer );
  116.     procedure   SendErrPack( Mess : String );
  117.     procedure   TreatErrPack( VAR EPack : Packet; Num : integer );
  118.  
  119.     procedure   LocalError( EMess : PString );
  120.  
  121.     function SendGComm( Cmd : char;  CmdParam    : String ) : boolean;
  122.  
  123.     procedure   DbgNL;
  124.     procedure   DbgInt        (     n       : integer );
  125.     procedure   DbgChar       (     ch      : char );
  126.     procedure   DbgWrite      (     Str     : String );
  127.     procedure   DbgState      (     S       : KermitStates );
  128.     procedure   DbgPacket     (     Pack    : Packet );
  129.     procedure   DbgShowPacket ( VAR Pack    : Packet);
  130.     procedure   DbgFileName   ( VAR FileN   : FNameType );
  131.  
  132. Imports KermitScreen from KermitScreen;
  133.     
  134. {==========================} private  {=======================================}
  135.  
  136. Imports Perq_String from Perq_String;
  137. imports KermitLineIO from KermitLineIO;
  138. imports KermitParameters from KermitParameters;
  139. imports KermitRead from KermitRead;
  140.  
  141. {-----------------------------------------------------------------------------}
  142. {==================== Kermit basic operations ================================}
  143. {-----------------------------------------------------------------------------}
  144.  
  145. function    ToChar ( ch : char ): char;
  146. begin
  147.     { make sure not a control character }
  148.     ToChar := chr( ord ( ch ) + ord ( ' ' ) );
  149. end;
  150.  
  151. {-----------------------------------------------------------------------------}
  152.  
  153. function    UnChar ( ch : char ): char;
  154. begin
  155.     { undoes ToChar }
  156.     UnChar := chr ( ord ( ch ) - ord ( ' ' ) );
  157. end;
  158.  
  159. {-----------------------------------------------------------------------------}
  160.  
  161. function    Ctl ( ch : char ): char;
  162. begin
  163.     { toggle control bit }
  164.     Ctl := chr( lxor ( ord( ch ), 64 ) );
  165. end;
  166.  
  167. {-----------------------------------------------------------------------------}
  168.  
  169. function    MakeCheck ( chksum : integer ): char;
  170. begin
  171.     MakeCheck := ToChar (
  172.                           chr (
  173.                                 ( chksum +
  174.                                 Land ( chksum , 192 ) div 64 )
  175.                                       mod 64
  176.                               )
  177.                         );
  178. end;
  179.  
  180. {-----------------------------------------------------------------------------}
  181.  
  182.  
  183. function Prev ( n : integer ):integer;
  184. begin
  185.     if n = 0 then
  186.         Prev := 63
  187.     else
  188.         Prev := n - 1;
  189. end;
  190.  
  191. {-----------------------------------------------------------------------------}
  192.  
  193.  
  194. function    PackToCh ( pType : PacketType ): char;
  195. var     RetVal : char;
  196. begin
  197.     case pType of
  198.         DataPack    :   RetVal := 'D';
  199.         ACKPack     :   RetVal := 'Y';
  200.         NAKPack     :   RetVal := 'N';
  201.         SInitPack   :   RetVal := 'S';
  202.         BrkPack     :   RetVal := 'B';
  203.         FHeadPack   :   RetVal := 'F';
  204.         EOFPack     :   RetVal := 'Z';
  205.         ErrPack     :   RetVal := 'E';
  206.         RinitPack   :   RetVal := 'R';
  207.         CommPack    :   RetVal := 'C';
  208.         GCommPack   :   RetVal := 'G';
  209.         THeadPack   :   RetVal := 'X';
  210.         NoChangePack,
  211.         TimOutPack,
  212.         IllPack,
  213.         ChkIllPack  :   RetVal := ' ';
  214.     end;
  215.     PackToCh := RetVal;
  216. end;
  217.  
  218. {-----------------------------------------------------------------------------}
  219.  
  220. function  ChToPack( ch : char ): PacketType;
  221. begin
  222.     if not ( ch in LegalPackets ) then
  223.     begin
  224.         if Debug then begin
  225.             DbgWrite ( 'Illegal packet type : ' );
  226.             DbgChar ( ch );
  227.             DbgNL;
  228.         end;
  229.         ChToPack := IllPack;
  230.     end
  231.     else
  232.     begin
  233.         case ch of
  234.             'D' :   ChToPack := DataPack;
  235.             'Y' :   ChToPack := AckPack;
  236.             'N' :   ChToPack := NakPack;
  237.             'S' :   ChToPack := SinitPack;
  238.             'B' :   ChToPack := BrkPack;
  239.             'F' :   ChToPack := FHeadPack;
  240.             'Z' :   ChToPack := EOFPack;
  241.             'E' :   ChToPack := ErrPack;
  242.             'R' :   ChToPack := RinitPack;
  243.             'C' :   ChToPack := CommPack;
  244.             'G' :   ChToPack := GCommPack;
  245.             'X' :   ChToPack := THeadPack;
  246.         end;
  247.     end;
  248. end;
  249.  
  250.  
  251. {-----------------------------------------------------------------------------}
  252. {===================== Debugging output routines =============================}
  253. {-----------------------------------------------------------------------------}
  254.  
  255.  
  256. { Perq Kermit is always Local, so use standard output for debug info }
  257. procedure   DbgNL;
  258. {  Globals     :   Debug   ( read )
  259.     SideEffects :   Finishes current line on debug-file
  260. }
  261. begin
  262.     if Debug then writeln;
  263. end;
  264.  
  265. {-----------------------------------------------------------------------------}
  266.  
  267. procedure   DbgInt( n : integer );
  268. {  Globals     :   Debug ( read )
  269.     SideEffects :   Writes an integer on DbgOut with default field width
  270. }
  271. begin
  272.     if Debug then write( n );
  273. end;
  274.  
  275. {-----------------------------------------------------------------------------}
  276.  
  277. procedure PrintChar( ch : char );
  278. begin
  279.     if ch IN [' '..'~'] then
  280.         write( ch )
  281.     else
  282.         if ch='/' then 
  283.             write( '//' )
  284.         else
  285.             write( '/', ord( ch ):3:-8, '/' );
  286. end;
  287.  
  288. {-----------------------------------------------------------------------------}
  289.  
  290. procedure   DbgChar( ch : char );
  291. {  Globals     :   Debug ( read )
  292.     SideEffects :   Outputs a character on DbgOut.
  293. }
  294. begin
  295.     if Debug then
  296.         PrintChar(ch);
  297. end;
  298.  
  299. {-----------------------------------------------------------------------------}
  300.  
  301. procedure   DbgWrite( Str : String );
  302. {  Abstract    :   Outputs a string to Debug-file.
  303.     Globals     :   Debug   ( read )
  304.     SideEffects :   Writes a string on DbgOut
  305.     Input Params:   Str - String to be written
  306. }
  307. var     i : integer;
  308. begin
  309.     if Debug then
  310.         for i := 1 to Length( Str ) do
  311.             PrintChar( Str[i] );
  312. end;
  313.  
  314. {-----------------------------------------------------------------------------}
  315.  
  316. procedure   DbgState( S : KermitStates );
  317. begin
  318.     if Debug then
  319.         case S of
  320.             FileData    :   Write( 'FileData   ');
  321.             Init        :   Write( 'Init       ');
  322.             Break       :   Write( 'Break      ');
  323.             FileHeader  :   Write( 'FileHeader ');
  324.             RemoteReply :   Write( 'RemoteReply');
  325.             EOFile      :   Write( 'EOFile     ');
  326.             Complete    :   Write( 'Complete   ');
  327.             Abort1      :   Write( 'Abort1     ');
  328.             AbortCtlC   :   Write( 'AbortCtlC  ');
  329.             AbortAll    :   Write( 'AbortAll   ');
  330.         end;
  331. end;
  332.  
  333. {-----------------------------------------------------------------------------}
  334.  
  335. procedure   DbgPacket ( Pack : Packet );
  336. {  Abstract    :   Outputs a packet on debug-file.
  337.                     Does a Writeln on debug-file.
  338.     Globals     :   Debug   ( read )
  339.     InputParams :   Pack  - Packet to be written on DbgOut.
  340.     SideEffects :   Outputs packet and "NewLine" to DbgOut.
  341.     Uses        :   UnChar
  342. }
  343. var     i : integer;
  344. begin
  345.     if Debug then
  346.     begin
  347.         with Pack do
  348.         if PType IN LegalPackets then
  349.         begin
  350.             write( 'Packet: ' );
  351.             PrintChar( count );
  352.             PrintChar( seq );
  353.             PrintChar( pType );
  354.             if count < ' ' then
  355.                 write( '/////// Bad count field in packet! //////' )
  356.             else
  357.                 for i := 1 to ord( UnChar ( count ) ) - 2 do
  358.                     PrintChar( Data[i] );
  359.         end else
  360.         begin
  361.             write( ' DbgPacket: Invalid packet type ');
  362.         end;
  363.         writeln;
  364.     end;
  365. end;
  366.  
  367. {-----------------------------------------------------------------------------}
  368.  
  369. procedure   DbgFileName(VAR FileN:FNameType );
  370. begin
  371.     if Debug then
  372.         write( FileN );
  373. end;
  374.  
  375. {-----------------------------------------------------------------------------}
  376.  
  377. procedure DbgShowPacket(VAR Pack:Packet);
  378. {  Abstract        :   Writes a packet to the Debug file
  379.                         as DbgPacket, but in greater detail }
  380.  
  381. var     i,packlen : integer;
  382. begin
  383.     if Debug then
  384.     with Pack do begin
  385.         write( 'DbgShowPacket: ' );
  386.         if not ( Mark in [ SendSOH, RecSOH ] ) then begin
  387.             writeln( ' *** Bad StartOfHeader character: / ',
  388.                 ord(Mark):3:-8,'/'  );
  389.         end;
  390.         write( '  Seq =' );
  391.         if seq<' ' then 
  392.             write( ' BAD' )
  393.         else
  394.             write( ord(UnChar(seq)):4:8 );
  395.         if count<' ' then
  396.             writeln( '  *** Bad Packet Lenght *** ')
  397.         else begin
  398.             PackLen := ord( UnChar(count) );
  399.             write( '  Count = ',PackLen:3 );
  400.             write( '  PType = ');
  401.             PrintChar( PType );
  402.             Writeln;
  403.             if PackLen>MaxString - 2 then PackLen := MaxString - 2;
  404.             for i:=1 to PackLen-2 do
  405.                 PrintChar( data[i] );
  406.             writeln;
  407.         end;                       
  408.     end { with };
  409. end;
  410.  
  411. {-----------------------------------------------------------------------------}
  412. {======================= Packet utilities ====================================}
  413. {-----------------------------------------------------------------------------}
  414.  
  415. procedure SendACK( num : integer );
  416. VAR dummy : Packet;
  417. begin
  418.     SendPacket( ACKPack,
  419.                 num,
  420.                 0,
  421.                 dummy );
  422. end;
  423.  
  424. {-----------------------------------------------------------------------------}
  425.  
  426. procedure SendNAK( num : integer );
  427. VAR dummy : Packet;
  428. begin
  429.     SendPacket( NAKPack,
  430.                 num,
  431.                 0,
  432.                 dummy );
  433. end;
  434.  
  435. {-----------------------------------------------------------------------------}
  436.  
  437. procedure SendBrk;
  438. VAR dummy : Packet;
  439. begin
  440.     SendPacket( BrkPack,
  441.                 0,
  442.                 0,
  443.                 dummy );
  444. end;
  445.  
  446. {-----------------------------------------------------------------------------}
  447.  
  448. procedure Succeeded; 
  449. { -- Update sequence number, a packet has been received OK }
  450. begin
  451.     OldTry := NumTry;           { Number of retries for previous packet }
  452.     NumTry := 0;                { Number of retries for next packet }
  453.     n :=  ( n + 1 ) mod 64;     { Update packet sequence number (mod 64) }
  454.     nn := nn + 1;               { Total packet count }
  455. end;
  456.  
  457. {-----------------------------------------------------------------------------}
  458. {======================== Error handling =====================================}
  459. {-----------------------------------------------------------------------------}
  460.  
  461. procedure LocalError( EMess : PString );
  462. var OldWin : WinType;
  463. { For use when fatal error:  
  464. {   Write an error message to the screen, and send an error packet to remote }
  465. begin
  466.     CurrentWindow( OldWin );
  467.     SwitchWindow( MainWindow );
  468.     SendErrPack( EMess );
  469.     writeln( EMess );
  470.     SwitchWindow( OldWin );
  471. end;
  472.  
  473. {-----------------------------------------------------------------------------}
  474.  
  475. procedure TreatErrPack( VAR Epack : Packet; Num : integer );
  476. VAR EMess       : PString;
  477.     OldWin      : WinType;
  478. begin
  479.     SendAck( Num );   { Ack the error packet anyway }
  480.     CurrentWindow( OldWin );
  481.     SwitchWindow( TermWindow );   { Or main window ? }
  482.     writeln;
  483.        { Error packet should step packet seq. numbers forward?? }
  484.     if  (( (N+1) MOD 64 )<>Num ) and Debug then
  485.         writeln( 'Bad number field in error packet!' );
  486.     
  487.     EMess := Substr( Epack.data, 1, length( Epack.data )-1 );
  488.     writeln( EMess );
  489.     SwitchWindow( OldWin ); 
  490. end;
  491.  
  492. {-----------------------------------------------------------------------------}
  493.  
  494. procedure   SendErrPack( Mess : String );
  495. Var EPack : Packet;
  496. begin
  497.     EPack.Data := Mess;
  498.     SendPacket( ErrPack, N, Length( Mess ), EPack );
  499.         { Should one wait for ACK or not?? }
  500. end;
  501.  
  502. {-----------------------------------------------------------------------------}
  503. {===================== Generic and host commands =============================}
  504. {-----------------------------------------------------------------------------}
  505.  
  506. function SendGComm( Cmd : char;  CmdParam : String ) : boolean;
  507.  
  508. VAR LPack, RPack    : Packet;
  509.     Num, Len, Size  : integer;
  510.     PackType        : PacketType;
  511.     CmdS            : String[1];
  512. begin
  513.     FlushBuffer( Idev );     { don't let us be led astray by pending ACK's }
  514.     Adjust( CmdS, 1 );
  515.     CmdS[1] := Cmd;
  516.     LPack.data := Concat( CmdS, CmdParam );
  517.     Size := Length( CmdParam ) + 1;
  518.  
  519.     NumTry := 0;
  520.     SendPacket( GCommPack, 0, Size, LPack );    { Send command }
  521.     CurrState := RemoteReply;
  522.     SendGComm := Complete = ReadSwitch;         { Read reply }
  523.  
  524. end.
  525.