home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / pibterm / pibt41s2.arc / KSEND.MOD < prev    next >
Encoding:
Text File  |  1988-01-05  |  32.1 KB  |  809 lines
  1. (*----------------------------------------------------------------------*)
  2. (*         Check_Init  --- Check initialization packet from host        *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Check_Init( VAR Check_OK : BOOLEAN );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*     Procedure:  Check_Init                                           *)
  10. (*                                                                      *)
  11. (*     Purpose:    Interprets initialization packet from host           *)
  12. (*                                                                      *)
  13. (*     Calling Sequence:                                                *)
  14. (*                                                                      *)
  15. (*        Check_Init( VAR Check_OK : BOOLEAN );                         *)
  16. (*                                                                      *)
  17. (*           Check_OK --- If initialization packet was OK               *)
  18. (*                                                                      *)
  19. (*     Remarks:                                                         *)
  20. (*                                                                      *)
  21. (*        The initialization packet interpreted here has the following  *)
  22. (*        entries:                                                      *)
  23. (*                                                                      *)
  24. (*        Byte        Contents                                          *)
  25. (*        ----   ---------------------------------                      *)
  26. (*          1     Maximum packet size in bytes                          *)
  27. (*          2     Time out value in seconds                             *)
  28. (*          3     Number of pad characters                              *)
  29. (*          4     Padding character                                     *)
  30. (*          5     End of line character                                 *)
  31. (*          6     Control-quoting character                             *)
  32. (*          7     8th bit quote character                               *)
  33. (*          8     Block check type                                      *)
  34. (*          9     Repeat quote character                                *)
  35. (*         10     Facilities flag                                       *)
  36. (*         11     Window size (sliding windows)                         *)
  37. (*         12     Extended packet length                                *)
  38. (*         13     Extended packet length                                *)
  39. (*                                                                      *)
  40. (*----------------------------------------------------------------------*)
  41.  
  42. VAR
  43.    Packet_Length : INTEGER;
  44.    Quote_8       : CHAR;
  45.    Capabilities  : INTEGER;
  46.    IPack         : INTEGER;
  47.  
  48. BEGIN (* Check_Init *)
  49.                                    (* Check that packet number is OK *)
  50.  
  51.    IF Rec_Packet_Num = ( Packet_Num MOD 64 ) THEN
  52.       Check_OK := TRUE;
  53.  
  54.                                    (* Check packet length *)
  55.    IF Rec_Packet_Length >= 1 THEN
  56.       IF ( Rec_Packet_Ptr^[1] <> ' ' ) THEN
  57.          IF ( ORD( Rec_Packet_Ptr^[1] ) - 32 ) IN [4..94] THEN
  58.             Kermit_Packet_Size := ORD( Rec_Packet_Ptr^[1] ) - 32
  59.          ELSE
  60.             Check_OK := FALSE;
  61.                                    (* Determine what other Kermit *)
  62.                                    (* wants.                      *)
  63.    IF Check_OK THEN
  64.       BEGIN (* Check_OK *)
  65.                                    (* TimeOut value *)
  66.  
  67.          IF Rec_Packet_Length >= 2 THEN
  68.             IF Rec_Packet_Ptr^[2] <> ' ' THEN
  69.                His_TimeOut := ORD( Rec_Packet_Ptr^[2] ) - 32;
  70.  
  71.                                    (* Number of pad characters    *)
  72.  
  73.          IF Rec_Packet_Length >= 3 THEN
  74.             IF Rec_Packet_Ptr^[3] <> ' ' THEN
  75.                My_Pad_Num := ORD( Rec_Packet_Ptr^[3] ) - 32
  76.             ELSE
  77.                My_Pad_Num := Kermit_Npad;
  78.  
  79.                                    (* Padding character         *)
  80.  
  81.          IF Rec_Packet_Length >= 4 THEN
  82.             IF Rec_Packet_Ptr^[4] <> ' ' THEN
  83.                My_Pad_Char := CHR( ORD( Rec_Packet_Ptr^[4] ) XOR $40 )
  84.             ELSE
  85.                My_Pad_Char := Kermit_Pad_Char;
  86.  
  87.                                    (* End-of-line character     *)
  88.  
  89.          IF Rec_Packet_Length >= 5 THEN
  90.             IF Rec_Packet_Ptr^[5] <> ' ' THEN
  91.                Send_EOL := ORD( Rec_Packet_Ptr^[5] ) - 32
  92.             ELSE
  93.                Send_EOL := ORD( Kermit_EOL );
  94.  
  95.                                    (* Control-quoting character *)
  96.  
  97.          IF Rec_Packet_Length >= 6 THEN
  98.             BEGIN
  99.                IF ( Rec_Packet_Ptr^[6] = ' ' ) THEN
  100.                   His_Quote_Char := Kermit_Quote_Char
  101.                ELSE
  102.                   His_Quote_Char := Rec_Packet_Ptr^[6];
  103.             END
  104.          ELSE
  105.             His_Quote_Char := Kermit_Quote_Char;
  106.  
  107.                                    (* 8th-bit quoting character *)
  108.  
  109.          IF ( Rec_Packet_Length >= 7 ) THEN
  110.             CASE Rec_Packet_Ptr^[7] OF
  111.                                    (* Not quoting *)
  112.  
  113.                'N' : Quoting := FALSE;
  114.  
  115.                                    (* Willing to quote but won't *)
  116.  
  117.                'Y', ' ' : ;
  118.  
  119.                                    (* Use specified quoting character *)
  120.  
  121.                '!'..'>','`'..'~' : BEGIN
  122.                                       Quoting := TRUE;
  123.                                       His_Quote_8_Char := Rec_Packet_Ptr^[7];
  124.                                    END;
  125.  
  126.                                    (* Valid quote char not received *)
  127.  
  128.                ELSE
  129.                   Check_OK := FALSE;
  130.  
  131.             END (* CASE *)
  132.                                    (* Remote system not acknowledging *)
  133.                                    (* quoting.                        *)
  134.          ELSE
  135.             IF Quoting THEN
  136.                Check_OK := FALSE;
  137.  
  138.                                    (* Block check type *)
  139.  
  140.          IF Rec_Packet_Length >= 8 THEN
  141.             IF Rec_Packet_Ptr^[8] <> ' ' THEN
  142.                IF ( Rec_Packet_Ptr^[8] IN ['1','2','3'] ) THEN
  143.                   His_Chk_Type := Rec_Packet_Ptr^[8]
  144.                ELSE
  145.                   His_Chk_Type := '1'
  146.             ELSE
  147.                His_Chk_Type := '1';
  148.  
  149.                                    (* Repeat quote character *)
  150.  
  151.          IF Rec_Packet_Length >= 9 THEN
  152.             IF Rec_Packet_Ptr^[9] <> ' ' THEN
  153.                IF ( Kermit_Repeat_Char <> ' ' ) THEN
  154.                   BEGIN
  155.                      His_Repeat_Char := Rec_Packet_Ptr^[9];
  156.                      Repeating := ( His_Repeat_Char <> ' ' );
  157.                   END;
  158.                                    (* Capabilities flags *)
  159.  
  160.          Capabilities           := 0;
  161.          Kermit_Attributes      := FALSE;
  162.          His_Kermit_Window_Size := 0;
  163.          His_Kermit_MaxLX1      := 0;
  164.          His_Kermit_MaxLX2      := 0;
  165.  
  166.          IF Rec_Packet_Length >= 10 THEN
  167.             IF Rec_Packet_Ptr^[10] <> ' ' THEN
  168.                BEGIN
  169.                   Capabilities          := ORD( Rec_Packet_Ptr^[10] ) - 32;
  170.                   Kermit_Attributes     := ( ( Capabilities AND 8 ) <> 0 );
  171.                   Kermit_Do_Sliding_Win := ( ( Capabilities AND 4 ) <> 0 );
  172.                   Kermit_Do_Long_Blocks := ( ( Capabilities AND 2 ) <> 0 );
  173.                END;
  174.  
  175.          IF ( Capabilities <> 0 ) THEN
  176.             BEGIN (* Capabilities <> 0 *)
  177.  
  178.                                             (* Skip unused capacity bytes *)
  179.                IPack := 10;
  180.  
  181.                WHILE( ( Capabilities AND 1 ) <> 0 ) DO
  182.                   BEGIN
  183.                      IPack := SUCC( IPack );
  184.                      IF ( IPack <= Rec_Packet_Length ) THEN
  185.                         Capabilities := ORD( Rec_Packet_Ptr^[IPack] ) - 32
  186.                      ELSE
  187.                         Capabilities := 1;
  188.                   END;
  189.                                             (* Get sliding windows size *)
  190.                IPack := SUCC( IPack );
  191.  
  192.                IF Rec_Packet_Length >= IPack THEN
  193.                   IF Rec_Packet_Ptr^[IPack] <> ' ' THEN
  194.                      His_Kermit_Window_Size := MIN( ORD( Rec_Packet_Ptr^[IPack] ) - 32 ,
  195.                                                     Kermit_Window_Size );
  196.  
  197.                                             (* Get long packets length  *)
  198.                IPack := SUCC( IPack );
  199.  
  200.                His_Kermit_MaxLX1 := Kermit_Extended_Block DIV 95;
  201.                His_Kermit_MaxLX2 := Kermit_Extended_Block MOD 95;
  202.  
  203.                IF Rec_Packet_Length >= IPack THEN
  204.                   IF Rec_Packet_Ptr^[IPack] <> ' ' THEN
  205.                      His_Kermit_MaxLX1 := ORD( Rec_Packet_Ptr^[IPack] ) - 32
  206.                   ELSE
  207.                      His_Kermit_MaxLX1 := 0;
  208.  
  209.                IPack := SUCC( IPack );
  210.  
  211.                IF Rec_Packet_Length >= IPack THEN
  212.                   IF Rec_Packet_Ptr^[IPack] <> ' ' THEN
  213.                      His_Kermit_MaxLX2 := ORD( Rec_Packet_Ptr^[IPack] ) - 32
  214.                   ELSE
  215.                      His_Kermit_MaxLX2 := 0;
  216.  
  217.             END (* Capabilities <> 0 *);
  218.  
  219.                                    (* Turn on sliding windows *)
  220.  
  221.          Kermit_Do_Sliding_Win := Kermit_Do_Sliding_Win          AND
  222.                                   ( His_Kermit_Window_Size > 0 ) AND
  223.                                   ( Kermit_Window_Size     > 0 );
  224.  
  225.                                    (* Sliding windows takes precedence over *)
  226.                                    (* long blocks.                          *)
  227.  
  228.          Packet_Length := 95 * His_Kermit_MaxLX1 + His_Kermit_MaxLX2;
  229.  
  230.          Kermit_Do_Long_Blocks := Kermit_Do_Long_Blocks          AND
  231.                                   ( ( Packet_Length > 94 ) OR
  232.                                     ( Packet_Length = 0  )     ) AND
  233.                                   ( NOT Kermit_Do_Sliding_Win  ) AND
  234.                                   ( Kermit_Extended_Block > 94 );
  235.  
  236.                                    (* Adjust long block size if necessary   *)
  237.                                    (* to be less than our maximum           *)
  238.  
  239.          IF Kermit_Do_Long_Blocks THEN
  240.             IF ( Packet_Length > MaxLongPacketLength ) THEN
  241.                BEGIN
  242.                   His_Kermit_MaxLX1 := MaxLongPacketLength DIV 95;
  243.                   His_Kermit_MaxLX2 := MaxLongPacketLength MOD 95;
  244.                END
  245.             ELSE IF ( Packet_Length = 0 ) THEN
  246.                BEGIN
  247.                   His_Kermit_MaxLX1 := 500 DIV 95;
  248.                   His_Kermit_MaxLX2 := 500 MOD 95;
  249.                END;
  250.                                    (* Display the parameter values *)
  251.  
  252.          Display_Kermit_Init_Params;
  253.  
  254.       END (* IF Check_OK *);
  255. {
  256.    IF Kermit_Debug THEN
  257.       BEGIN
  258.          Kermit_Debug_Write_String ('--- Check_Init Start ---', '' );
  259.          Kermit_Debug_Write_Char   ('His_Quote_Char   = ',His_Quote_Char);
  260.          Kermit_Debug_Write_Boolean('Quoting          = ',Quoting);
  261.          Kermit_Debug_Write_Char   ('His_Quote_8_Char = ',His_Quote_8_Char);
  262.          Kermit_Debug_Write_Boolean('Repeating        = ',Repeating);
  263.          Kermit_Debug_Write_Char   ('His_Repeat_Char  = ',His_Repeat_Char);
  264.          Kermit_Debug_Write_Boolean('Attributes       = ',Kermit_Attributes);
  265.          Kermit_Debug_Write_Boolean('Sliding windows  = ',Kermit_Do_Sliding_Win);
  266.          Kermit_Debug_Write_Boolean('Long blocks      = ',Kermit_Do_Long_Blocks);
  267.          Kermit_Debug_Write_Integer('Packet length    = ',Packet_Length );
  268.          Kermit_Debug_Write_Integer('MaxLx1           = ',His_Kermit_MaxLx1);
  269.          Kermit_Debug_Write_Integer('MaxLx2           = ',His_Kermit_MaxLx2);
  270.          Kermit_Debug_Write_String ('--- Check_Init End   ---', '' );
  271.       END;
  272. }
  273. END    (* Check_Init *);
  274.  
  275. (*----------------------------------------------------------------------*)
  276. (*           Check_ACK  --- Check ACK State for most packets            *)
  277. (*----------------------------------------------------------------------*)
  278.  
  279. PROCEDURE Check_ACK;
  280.  
  281. (*----------------------------------------------------------------------*)
  282. (*                                                                      *)
  283. (*     Procedure:  Check_ACK                                            *)
  284. (*                                                                      *)
  285. (*     Purpose:    Checks ACK status for most packets                   *)
  286. (*                                                                      *)
  287. (*     Calling Sequence:                                                *)
  288. (*                                                                      *)
  289. (*        Check_ACK;                                                    *)
  290. (*                                                                      *)
  291. (*----------------------------------------------------------------------*)
  292.  
  293. VAR
  294.    A_Ch: CHAR;
  295.  
  296. (*----------------------------------------------------------------------*)
  297.  
  298. PROCEDURE Handle_ACK;
  299.  
  300. BEGIN (* Handle_ACK *)
  301.                                    (* Make sure ACK is for correct block. *)
  302.                                    (* Also check for interruption flags   *)
  303.                                    (* in data field:                      *)
  304.                                    (* 'X' = quit sending current file;    *)
  305.                                    (* 'Y' = quit batch of files.          *)
  306.  
  307.    IF ( Rec_Packet_Num = ( Packet_Num MOD 64 ) ) THEN
  308.       BEGIN
  309.          ACK_OK := TRUE;
  310.          IF ( Rec_Packet_Length > 0 ) THEN
  311.             CASE Rec_Packet_Ptr^[1] OF
  312.                'X': BEGIN
  313.                        Display_Kermit_Message_2('Cancelling transfer of current file.');
  314.                        Kermit_Abort       := TRUE;
  315.                        Kermit_Abort_Level := One_File;
  316.                     END;
  317.                'Y': BEGIN
  318.                        Display_Kermit_Message_2('Cancelling transfer of all files.');
  319.                        Kermit_Abort       := TRUE;
  320.                        Kermit_Abort_Level := All_Files;
  321.                     END;
  322.                ELSE;
  323.             END (* CASE *);
  324.       END;
  325.  
  326. END   (* Handle_ACK *);
  327.  
  328. (*----------------------------------------------------------------------*)
  329.  
  330. PROCEDURE Handle_NAK;
  331.  
  332. BEGIN (* Handle_NAK *)
  333.  
  334.    IF ( Rec_Packet_Num = 0 ) THEN
  335.       Rec_Packet_Num := 63
  336.    ELSE
  337.       Rec_Packet_Num := PRED( Rec_Packet_Num );
  338.  
  339.                                    (* NAK for next is ACK for present *)
  340.  
  341.    IF ( Rec_Packet_Num = ( Packet_Num MOD 64 ) ) THEN
  342.       ACK_OK := TRUE;
  343.  
  344.    Display_Kermit_Message('NAK for packet ' + IToS( Rec_Packet_Num ) +
  345.                           ' received.');
  346.  
  347. END   (* Handle_NAK *);
  348.  
  349. (*----------------------------------------------------------------------*)
  350.  
  351. PROCEDURE Handle_Error;
  352.  
  353. BEGIN (* Handle_Error *)
  354.  
  355.    Display_Kermit_Message  ('Error from remote Kermit:');
  356.    Display_Kermit_Message_2( COPY( Rec_Packet_Ptr^, 1, Rec_Packet_Length ) );
  357.  
  358.    Kermit_Abort := TRUE;
  359.  
  360.    IF ( Attended_Mode AND ( NOT Script_File_Mode ) ) THEN
  361.       BEGIN
  362.          GoToXY( 2 , Kermit_Mess3_Line );
  363.          WRITE('Hit any key to continue ... ');
  364.          Read_Kbd( A_Ch );
  365.          IF ( ORD( A_Ch ) = ESC ) AND PibTerm_KeyPressed THEN
  366.             Read_Kbd( A_Ch );
  367.       END;
  368.  
  369. END   (* Handle_Error *);
  370.  
  371. (*----------------------------------------------------------------------*)
  372.  
  373. BEGIN (* Check_ACK *)
  374.                                    (* Assume bad packet to start *)
  375.    ACK_OK := FALSE;
  376.                                    (* Pick up a packet           *)
  377.    IF Kermit_Abort THEN
  378.       EXIT;
  379.  
  380.    Receive_Packet;
  381. {
  382.    IF Kermit_Debug THEN
  383.       BEGIN
  384.  
  385.          Write_Log('---Check-Ack---', FALSE, FALSE);
  386.  
  387.          CASE Kermit_Packet_Type OF
  388.             ACK_Pack  : Write_Log('ACK received', FALSE, FALSE);
  389.             NAK_Pack  : Write_Log('NAK received', FALSE, FALSE);
  390.             Error_Pack: Write_Log('Error received', FALSE, FALSE);
  391.             ELSE        Write_Log('Unknown received', FALSE, FALSE);
  392.          END (* CASE *);
  393.  
  394.          Write_Log('Rec_Packet_Num = ' + IToS( Rec_Packet_Num ), FALSE, FALSE);
  395.  
  396.          IF Packet_OK THEN
  397.             Write_Log('Packet_OK = TRUE', FALSE, FALSE)
  398.          ELSE
  399.             Write_Log('Packet_OK = FALSE', FALSE, FALSE);
  400.  
  401.       END;
  402. }
  403.    IF Packet_OK AND ( NOT Kermit_Abort ) THEN
  404.       BEGIN
  405.                                    (* Check if ACK or NAK packet received. *)
  406.                                    (* May also be error packet.            *)
  407.  
  408.          CASE Kermit_Packet_Type OF
  409.  
  410.  
  411.             ACK_Pack  : Handle_ACK;
  412.             NAK_Pack  : Handle_NAK;
  413.             Error_Pack: Handle_Error;
  414.  
  415.                                    (* Something else -- don't ACK it *)
  416.             ELSE        BEGIN
  417.                            ACK_OK := FALSE;
  418.                            Display_Kermit_Message('Garbage packet received.');
  419.                         END;
  420.  
  421.          END (* CASE *)
  422.  
  423.       END
  424.    ELSE
  425.       ACK_OK := FALSE;
  426.  
  427.    IF ( NOT ACK_OK ) THEN
  428.       BEGIN
  429.          Packets_Bad := Packets_Bad + 1;
  430.          Update_Kermit_Display;
  431.       END;
  432.  
  433. END    (* Check_ACK *);
  434.  
  435. (*----------------------------------------------------------------------*)
  436. (*                   Send_Packet --- send a packet                      *)
  437. (*----------------------------------------------------------------------*)
  438.  
  439. PROCEDURE Send_Packet;
  440.  
  441. (*----------------------------------------------------------------------*)
  442. (*                                                                      *)
  443. (*     Procedure:  Send_Packet                                          *)
  444. (*                                                                      *)
  445. (*     Purpose:    Sends a Kermit packet to remote host                 *)
  446. (*                                                                      *)
  447. (*     Calling Sequence:                                                *)
  448. (*                                                                      *)
  449. (*        Send_Packet;                                                  *)
  450. (*                                                                      *)
  451. (*     Remarks:                                                         *)
  452. (*                                                                      *)
  453. (*        The packet to be sent is in Send_Packet_Ptr^.                 *)
  454. (*                                                                      *)
  455. (*----------------------------------------------------------------------*)
  456.  
  457. VAR
  458.    Count : INTEGER;
  459.    Ch    : CHAR;
  460.    StrNum: STRING[3];
  461.    H_Char: INTEGER;
  462.  
  463. BEGIN (* Send_Packet *)
  464.                                    (* Wait for handshake character   *)
  465.                                    (* if necessary                   *)
  466.  
  467.    IF ( ( Kermit_Handshake_Char <> ' ' ) AND ( Local_Echo ) ) THEN
  468.       BEGIN
  469.          REPEAT  (* get handshake character *)
  470.             Get_Char( H_Char );
  471.          UNTIL ( ( H_Char = ORD( Kermit_Handshake_Char ) ) OR
  472.                    Kermit_Abort OR Kermit_Retry );
  473.          IF ( Kermit_Abort OR Kermit_Retry ) THEN
  474.             EXIT;
  475.       END;
  476.                                    (* Purge buffer before send unless *)
  477.                                    (* sliding windows being used.     *)
  478.  
  479.    IF ( NOT ( Kermit_Do_Sliding_Win AND Kermit_Doing_Transfer ) ) THEN
  480.       Async_Purge_Buffer;
  481.                                    (* Make sure carrier still there   *)
  482.  
  483.    IF ( NOT Async_Carrier_Detect ) THEN
  484.       BEGIN
  485.          Kermit_Abort       := TRUE;
  486.          Kermit_Abort_Level := Entire_Protocol;
  487.          EXIT;
  488.       END;
  489.                                    (* Send requested padding         *)
  490.    IF ( My_Pad_Num > 0 ) THEN
  491.       FOR Count := 1 TO My_Pad_Num DO
  492.          Async_Send( My_Pad_Char );
  493.  
  494.                                    (* Make sure carrier still there  *)
  495.  
  496.    IF ( NOT Async_Carrier_Detect ) THEN
  497.       BEGIN
  498.          Kermit_Abort       := TRUE;
  499.          Kermit_Abort_Level := Entire_Protocol;
  500.          EXIT;
  501.       END;
  502.                                    (* Send the packet data           *)
  503.  
  504.    FOR Count := 1 TO Send_Packet_Length DO
  505.       Async_Send( Send_Packet_Ptr^[Count] );
  506.  
  507.                                    (* Send the end of line marker    *)
  508.    Async_Send( CHR( Send_EOL ) );
  509.  
  510.                                    (* Purge input buffer after send,  *)
  511.                                    (* and wait for output buffer to   *)
  512.                                    (* drain to avoid false timeouts.  *)
  513.    Ch := ' ';
  514.  
  515.    IF ( NOT Kermit_Do_Sliding_Win ) THEN
  516.       BEGIN
  517.          WHILE ( Async_Receive( Ch )      AND
  518.                  ( Ch <> CHR( Send_EOL ) ) AND
  519.                  ( NOT PibTerm_KeyPressed )             ) DO;
  520.          Async_Drain_Output_Buffer( Five_Seconds );
  521.       END;
  522.                                    (* Update packets sent count      *)
  523.  
  524.    Packets_Sent := Packets_Sent + 1;
  525.  
  526.    Update_Kermit_Display;
  527. {
  528.    IF Kermit_Debug THEN
  529.       BEGIN
  530.          Write_Log('>>>>> Send_Packet: sent packet number ' +
  531.                    IToS( ORD( Send_Packet_Ptr^[3] ) - 32 ),
  532.                    FALSE, FALSE );
  533.          Write_Log('                   length = ' + IToS( Send_Packet_Length ),
  534.                    FALSE, FALSE );
  535.       END;
  536. }
  537. END   (* Send_Packet *);
  538.  
  539. (*----------------------------------------------------------------------*)
  540. (*                 Build_Packet --- Build a packet                      *)
  541. (*----------------------------------------------------------------------*)
  542.  
  543. PROCEDURE Build_Packet;
  544.  
  545. (*----------------------------------------------------------------------*)
  546. (*                                                                      *)
  547. (*     Procedure:  Build_Packet                                         *)
  548. (*                                                                      *)
  549. (*     Purpose:    Builds a Kermit packet                               *)
  550. (*                                                                      *)
  551. (*     Calling Sequence:                                                *)
  552. (*                                                                      *)
  553. (*        Build_Packet;                                                 *)
  554. (*                                                                      *)
  555. (*     Remarks:                                                         *)
  556. (*                                                                      *)
  557. (*        This routine add the block number and checksum to the data in *)
  558. (*        Send_Packet_Ptr^_Data.                                        *)
  559. (*                                                                      *)
  560. (*----------------------------------------------------------------------*)
  561.  
  562. VAR
  563.    CheckSum        : INTEGER;
  564.    Count           : INTEGER;
  565.    Check_Type      : INTEGER;
  566.    Long_Length     : INTEGER;
  567.    Send_Packet_Ptr2: Kermit_Packet_Ptr;
  568.  
  569. BEGIN (* Build_Packet *)
  570.                                    (* Add block header, length, packet *)
  571.                                    (* number to front of packet data.  *)
  572.                                    (* This is done differently for     *)
  573.                                    (* short and long blocks.           *)
  574.  
  575.    Check_Type          := ORD( His_Chk_Type ) - ORD('0');
  576.  
  577.    Send_Packet_Ptr^[1] := Kermit_Header_Char;
  578.    Send_Packet_Ptr^[3] := CHR( Packet_Num MOD 64 + 32 );
  579.  
  580.    IF ( Kermit_Do_Long_Blocks AND ( Send_Packet_Ptr^[4] = 'D' ) ) THEN
  581.       BEGIN
  582.          Long_Length         := Send_Packet_Length + Check_Type - 7;
  583.          Send_Packet_Ptr^[2] := ' ';
  584.          Send_Packet_Ptr^[5] := CHR( Long_Length DIV 95 + 32 );
  585.          Send_Packet_Ptr^[6] := CHR( Long_Length MOD 95 + 32 );
  586.          CheckSum            := 32 + ORD( Send_Packet_Ptr^[3] ) +
  587.                                      ORD( Send_Packet_Ptr^[4] ) +
  588.                                      ORD( Send_Packet_Ptr^[5] ) +
  589.                                      ORD( Send_Packet_Ptr^[6] );
  590.          CheckSum            := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) )
  591.                                 AND 63 );
  592.          Send_Packet_Ptr^[7] := CHR( CheckSum + 32 );
  593.       END
  594.    ELSE
  595.       Send_Packet_Ptr^[2] := CHR( Send_Packet_Length + Check_Type + 30 );
  596.  
  597.                                    (* Calculate checksum/crc *)
  598.  
  599.    Send_Packet_Ptr2 := ADDR( Send_Packet_Ptr^[2] );
  600.    Count            := Send_Packet_Length - 1;
  601.  
  602.    CASE His_Chk_Type OF
  603.  
  604.       '1': BEGIN
  605.  
  606.               Kermit_Chk8( Send_Packet_Ptr2^, Count, CheckSum );
  607.               CheckSum := ( ( CheckSum + ( ( CheckSum AND 192 ) SHR 6 ) ) AND 63 );
  608.  
  609.               Send_Packet_Length                   := SUCC( Send_Packet_Length );
  610.               Send_Packet_Ptr^[Send_Packet_Length] := CHR( CheckSum + 32 );
  611.  
  612.            END;
  613.  
  614.       '2': BEGIN
  615.  
  616.               Kermit_Chk12( Send_Packet_Ptr2^, Count, CheckSum );
  617.  
  618.               Send_Packet_Length                   := SUCC( Send_Packet_Length );
  619.               Send_Packet_Ptr^[Send_Packet_Length] := CHR( CheckSum SHR 6 + 32 );
  620.  
  621.               Send_Packet_Length                   := SUCC( Send_Packet_Length );
  622.               Send_Packet_Ptr^[Send_Packet_Length] := CHR( CheckSum AND 63 + 32 );
  623.  
  624.            END;
  625.  
  626.       '3': BEGIN
  627.  
  628.               Kermit_CRC( Send_Packet_Ptr2^, Count, CheckSum );
  629.  
  630.               Send_Packet_Length                   := SUCC( Send_Packet_Length );
  631.               Send_Packet_Ptr^[Send_Packet_Length] := CHR( ( CheckSum SHR 12 ) AND 63 + 32 );
  632.  
  633.               Send_Packet_Length                   := SUCC( Send_Packet_Length );
  634.               Send_Packet_Ptr^[Send_Packet_Length] := CHR( ( CheckSum SHR 6  ) AND 63 + 32 );
  635.  
  636.               Send_Packet_Length                   := SUCC( Send_Packet_Length );
  637.               Send_Packet_Ptr^[Send_Packet_Length] := CHR( CheckSum AND 63            + 32 );
  638.  
  639.            END;
  640.  
  641.    END (* CASE *);
  642.  
  643. END    (* Build_Packet *);
  644.  
  645. (*----------------------------------------------------------------------*)
  646. (*               Send_ACK  --- Send acknowledge for a packet            *)
  647. (*----------------------------------------------------------------------*)
  648.  
  649. PROCEDURE Send_ACK;
  650.  
  651. (*----------------------------------------------------------------------*)
  652. (*                                                                      *)
  653. (*     Procedure:  Send_ACK                                             *)
  654. (*                                                                      *)
  655. (*     Purpose:    Sends acknowledge for packet to host                 *)
  656. (*                                                                      *)
  657. (*     Calling Sequence:                                                *)
  658. (*                                                                      *)
  659. (*        Send_ACK;                                                     *)
  660. (*                                                                      *)
  661. (*     Calls:                                                           *)
  662. (*                                                                      *)
  663. (*        Build_Packet;                                                 *)
  664. (*        Send_Packet;                                                  *)
  665. (*                                                                      *)
  666. (*----------------------------------------------------------------------*)
  667.  
  668. VAR
  669.    Save_CHK      : CHAR;
  670.    Quote_8       : CHAR;
  671.    My_Attributes : CHAR;
  672.    Window_Size   : STRING[1];
  673.    LX1           : CHAR;
  674.    LX2           : CHAR;
  675.  
  676. BEGIN (* Send_ACK *)
  677.  
  678.    IF ( Kermit_State = Receive_Init ) OR
  679.       ( Kermit_State = Get_File     ) THEN
  680.       BEGIN
  681.  
  682.          IF Quoting THEN
  683.             Quote_8 := His_Quote_8_Char
  684.          ELSE
  685.             Quote_8 := 'N';
  686.  
  687.          My_Attributes := CHR( 8 + 32 );
  688.          Window_Size   := ' ';
  689.  
  690.          IF Kermit_Do_Sliding_Win THEN
  691.             BEGIN
  692.                My_Attributes := CHR( 8 + 4 + 32 );
  693.                Window_Size   := CHR( His_Kermit_Window_Size + 32 );
  694.             END;
  695.  
  696.          IF Kermit_Do_Long_Blocks THEN
  697.             BEGIN
  698.                My_Attributes := CHR( 8 + 2 + 32 );
  699.                LX1           := CHR( His_Kermit_MaxLX1 + 32 );
  700.                LX2           := CHR( His_Kermit_MaxLX2 + 32 );
  701.                Window_Size   := ' ';
  702.             END;
  703.  
  704.          Send_Packet_Ptr^[ 4] := 'Y';
  705.          Send_Packet_Ptr^[ 5] := CHR( Kermit_Packet_Size + 32    );
  706.          Send_Packet_Ptr^[ 6] := CHR( Kermit_TimeOut     + 32    );
  707.          Send_Packet_Ptr^[ 7] := CHR( My_Pad_Num         + 32    );
  708.          Send_Packet_Ptr^[ 8] := CHR( ORD( My_Pad_Char ) XOR $40 );
  709.          Send_Packet_Ptr^[ 9] := CHR( Send_EOL           + 32    );
  710.          Send_Packet_Ptr^[10] := His_Quote_Char;
  711.          Send_Packet_Ptr^[11] := Quote_8;
  712.          Send_Packet_Ptr^[12] := His_Chk_Type;
  713.          Send_Packet_Ptr^[13] := His_Repeat_Char;
  714.          Send_Packet_Ptr^[14] := My_Attributes;
  715.  
  716.          Send_Packet_Length   := 14;
  717.  
  718.          IF ( Kermit_Do_Sliding_Win OR Kermit_Do_Long_Blocks ) THEN
  719.             BEGIN
  720.                Send_Packet_Ptr^[15] := Window_Size[1];
  721.                Send_Packet_Length   := 15;
  722.             END;
  723.  
  724.          IF Kermit_Do_Long_Blocks THEN
  725.             BEGIN
  726.                Send_Packet_Ptr^[16] := LX1;
  727.                Send_Packet_Ptr^[17] := LX2;
  728.                Send_Packet_Length   := 17;
  729.             END;
  730.  
  731.          Save_CHK     := His_Chk_Type;
  732.          His_Chk_Type := '1';
  733.  
  734.          Build_Packet;
  735.          Send_Packet;
  736.  
  737.          His_Chk_Type := Save_CHK;
  738.  
  739.       END
  740.    ELSE
  741.       BEGIN
  742.  
  743.          Send_Packet_Ptr^[4] := 'Y';
  744.          Send_Packet_Length  := 4;
  745.  
  746.          Build_Packet;
  747.          Send_Packet;
  748.  
  749.       END;
  750.  
  751. END   (* Send_ACK *);
  752.  
  753. (*----------------------------------------------------------------------*)
  754. (*         Send_NAK  --- Send negative acknowledge for a packet         *)
  755. (*----------------------------------------------------------------------*)
  756.  
  757. PROCEDURE Send_NAK;
  758.  
  759. (*----------------------------------------------------------------------*)
  760. (*                                                                      *)
  761. (*     Procedure:  Send_NAK                                             *)
  762. (*                                                                      *)
  763. (*     Purpose:    Sends negative acknowledge for packet to host        *)
  764. (*                                                                      *)
  765. (*     Calling Sequence:                                                *)
  766. (*                                                                      *)
  767. (*        Send_NAK;                                                     *)
  768. (*                                                                      *)
  769. (*     Calls:                                                           *)
  770. (*                                                                      *)
  771. (*        Build_Packet;                                                 *)
  772. (*        Send_Packet;                                                  *)
  773. (*                                                                      *)
  774. (*----------------------------------------------------------------------*)
  775.  
  776. BEGIN (* Send_NAK *)
  777.  
  778.    Send_Packet_Ptr^[4] := 'N';
  779.    Send_Packet_Length  := 4;
  780.  
  781.    Build_Packet;
  782.    Send_Packet;
  783.  
  784.    Display_Kermit_Message('Sending NAK for packet ' + IToS( Packet_Num ));
  785.  
  786. END   (* Send_NAK *);
  787.  
  788. (*----------------------------------------------------------------------*)
  789. (*         PacketInWindow --- Check if packet is in current window      *)
  790. (*----------------------------------------------------------------------*)
  791.  
  792. FUNCTION PacketInWindow : BOOLEAN;
  793.  
  794. VAR
  795.    Inside : BOOLEAN;
  796.  
  797. BEGIN (* PacketInWindow *)
  798.  
  799.     IF ( Kermit_Window_Top > Kermit_Window_Bottom ) THEN
  800.        Inside := ( Rec_Packet_Num >= Kermit_Window_Bottom ) AND
  801.                  ( Rec_Packet_Num <= Kermit_Window_Top    )
  802.     ELSE
  803.        Inside := ( Rec_Packet_Num <= Kermit_Window_Top    ) OR
  804.                  ( Rec_Packet_Num >= Kermit_Window_Bottom );
  805.  
  806.     PacketInWindow := Inside;
  807.  
  808. END   (* PacketInWindow *);
  809.