home *** CD-ROM | disk | FTP | other *** search
/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / extra / ndksen.pas < prev    next >
Pascal/Delphi Source File  |  1988-08-16  |  16KB  |  466 lines

  1. (*
  2.  *
  3.  *      Routines for sending files.
  4.  *      Low-level routines (send a packet etc.) are in the file Kermit-PacketLvl
  5.  *
  6.  *      Globals: ( among others )
  7.  *          CurrState : KermitStates    - the state Kermit is in.
  8.  *
  9.  *
  10. *)
  11.  
  12.     function    GetNewFile( VAR FileList   :   NListPtr;
  13.                             VAR InFile     :   ByteFile;
  14.                             VAR FNPacket   :   Packet  ): KermitStates;
  15.     (*
  16.      * Get (possibly) a new file from FileList, build fileheader packet
  17.      * and open InFile. Return Abort (Could not open file), FileHeader(OK) or
  18.      * Break(No more files in list).
  19.      *)
  20.     var     RetVal  :   KermitStates;
  21.             Status  :   integer;
  22.             p       :   NListPtr;
  23.     begin
  24.         if FileList <> NIL then begin
  25.             with FileList^ do begin
  26.                 if Debug then begin
  27.                     DbgWrite('Opening file: $');
  28.                     DbgFileName( Name ); DbgNL;
  29.                 end;
  30.                 Status := OpenRead( InFile, Name );
  31.                 if Status <> 0 then begin
  32.                     if Debug then begin
  33.                         DbgWrite('Error opening file: $');
  34.                         DbgFileName( Name ); DbgNL;
  35.                     end;
  36.                     RetVal := Abort;
  37.                 end else begin
  38.                     if AltUsed then begin
  39.                         if Debug then begin
  40.                             DbgWrite('Sending as: $');
  41.                             DbgFileName( AltName ); DbgNL;
  42.                         end;
  43.                         PutFileName( AltName, FNPacket, NoTranslate);
  44.                     end else
  45.                         PutFileName( Name, FNPacket, DoTranslate);
  46.                     RetVal := FileHeader;
  47.                     (* Dispose of first filename-pair in list *)
  48.                     p := FileList;
  49.                     FileList := FileList^.Next;
  50.                     dispose(p);
  51.                 end;
  52.             end;
  53.         end else RetVal := Break;
  54.         GetNewFile := RetVal;
  55.     end;
  56.  
  57.     function SendInitiate(  idev, odev  : integer;
  58.                         VAR FileList    : NListPtr;
  59.                         VAR InFile      : ByteFile;
  60.                         VAR FNPacket    : Packet        ) : KermitStates;
  61.  
  62.     var     RetVal   : KermitStates;
  63.             Pack     : Packet;
  64.             num      : integer;
  65.             len      : integer;
  66.             p        : NListPtr;
  67.     begin
  68.         if Debug then begin
  69.             DbgWrite('Enter SendInit$');
  70.             DbgNL;
  71.         end;
  72.         NumTry := NumTry + 1;
  73.         if NumTry > MaxTry then
  74.             RetVal := Abort
  75.         else begin
  76.             SetInitPars ( Pack );
  77.             if Debug then begin
  78.                 DbgWrite(' n =$');
  79.                 DbgInt( n );
  80.                 DbgNL;
  81.             end;
  82.             SendPacket (    SInitPack,
  83.                             n,
  84.                             -1,
  85.                             Pack,
  86.                             ODev );
  87.             case ReadPacket( num, len, Pack, idev ) of
  88.                 NAKPack :
  89.                     begin
  90.                         RetVal := CurrState;
  91.                     end;
  92.  
  93.                 ACKPack :
  94.                     begin
  95.                         if num <> n then     (* Wrong ACK ? *)
  96.                             RetVal := CurrState     (* Stay in current state *)
  97.                         else begin
  98.                             ReadPars( Pack );
  99.                             NumTry := 0;
  100.                             n := (n + 1) mod 64;
  101.                             RetVal := GetNewFile( FileList, InFile, FNPacket );
  102.                         end;
  103.                     end;
  104.  
  105.                 DataPack, SInitPack, BrkPack,
  106.                 FHeadPack, EOFPack, ErrPack,
  107.                 IllPack :
  108.                     begin
  109.                         RetVal := Abort;
  110.                     end;
  111.  
  112.                 ChkIllPack :
  113.                     begin
  114.                         if Debug then begin
  115.                             DbgWrite('Illegal checksum read - retrying$');
  116.                             DbgNL;
  117.                         end;
  118.                         RetVal := CurrState;
  119.                     end;
  120.  
  121.                 TimOutPack  :
  122.                     begin
  123.                         if Debug then begin
  124.                             DbgWrite('Timed out waiting for ACK for SendInit$');
  125.                             DbgNL;
  126.                         end;
  127.                         RetVal := CurrState;
  128.                     end;
  129.  
  130.             end;
  131.         end;
  132.         SendInitiate := RetVal;
  133.     end;
  134.  
  135.     function    SendFileHeader(     idev, odev  : integer;
  136.                                 VAR FNPacket    : Packet;
  137.                                 VAR FDPacket    : Packet;
  138.                                 VAR INFile      : ByteFile    ) : KermitStates;
  139.  
  140.     var     RetVal  : KermitStates;
  141.             len, i  : integer;
  142.             num     : integer;
  143.             Treated : boolean;
  144.             Pack    : Packet;
  145.             Answer  : PacketType;
  146.             SaveTime: integer;
  147.     begin
  148.         if Debug then begin
  149.             DbgWrite('Enter SendFileHeader$');
  150.             DbgNL;
  151.         end;
  152.         NumTry := NumTry + 1;
  153.         if NumTry > MaxTry then
  154.             RetVal := Abort
  155.         else
  156.         begin
  157.             SendPacket( FHeadPack,
  158.                         n,
  159.                         -1,
  160.                         FNPacket,
  161.                         Odev    );
  162.  
  163.             SaveTime := TimeOut;
  164.             TimeOut := TimeOut * LongWait;
  165.             Answer := ReadPacket( num, len, Pack, idev );
  166.             TimeOut := SaveTime;
  167.             Treated := false;
  168.             if Answer = NAKPack then
  169.             begin
  170.                 Treated := True;
  171.                 Num := Prev( Num );
  172.                 if n <> Num then         (* is it a NAK for the next packet? *)
  173.                     RetVal := CurrState  (* NO - stay in current state       *)
  174.                 else
  175.                     Answer := ACKPack;   (* YES - treat as ACK for current   *)
  176.             end;
  177.             if Answer = ACKPack then
  178.             begin
  179.                 Treated := true;
  180.                 if n <> num then
  181.                     RetVal := CurrState
  182.                 else
  183.                 begin
  184.                     NumTry := 0;
  185.                     n := (n + 1) mod 64;
  186.                     FillBuffer( FDPacket, InFile );
  187.                     RetVal := FileData;
  188.                 end;
  189.             end;
  190.             if not Treated then
  191.             begin
  192.                 if Answer = TimOutPack then
  193.                 begin
  194.                     if Debug then begin
  195.                         DbgWrite('Timed out waiting for ACK for File-header$');
  196.                         DbgNL;
  197.                     end;
  198.                     RetVal := CurrState;
  199.                 end else
  200.                     if Answer = ChkIllPack then begin
  201.                         if Debug then begin
  202.                             DbgWrite('Illegal checksum read - retrying$');
  203.                             DbgNL;
  204.                         end;
  205.                         RetVal := CurrState;
  206.                     end else begin
  207.                         if Debug then begin
  208.                             DbgWrite('Illegal packet-type received-aborting$');
  209.                             DbgNL;
  210.                         end;
  211.                         RetVal := Abort;
  212.                     end;
  213.             end;
  214.         end;
  215.         SendFileHeader := RetVal;
  216.     end;
  217.  
  218.     function   SendData( idev, odev    : integer ;
  219.                           var Pack      : Packet ;
  220.                           var InFile    : ByteFile ) : KermitStates;
  221.     var     RetVal : KermitStates;
  222.             RecPack: Packet;
  223.             Answer : PacketType;
  224.             len    : integer;
  225.             num    : integer;
  226.             Treated: boolean;
  227.     begin
  228.         NumTry := NumTry + 1;
  229.         if NumTry > MaxTry then
  230.             RetVal := Abort
  231.         else begin
  232.             SendPacket( DataPack,
  233.                         n,
  234.                         -1,
  235.                         Pack,
  236.                         ODev    );
  237.             Answer := ReadPacket( Num, Len, RecPack, Idev );
  238.             Treated := false;
  239.             if Answer = NAKPack then begin
  240.                 Treated := true;
  241.                 Num := Prev( Num );
  242.                 if n <> Num then
  243.                     RetVal := CurrState
  244.                 else
  245.                     Answer := ACKPack;
  246.             end;
  247.             if Answer = ACKPack then begin
  248.                 Treated := true;
  249.                 if n <> Num then
  250.                     RetVal := CurrState
  251.                 else begin
  252.                     NumTry := 0;
  253.                     n := (n + 1) mod 64;
  254.                     if EOF( infile ) then
  255.                         RetVal := EOFile
  256.                     else begin
  257.                         FillBuffer( Pack, InFile );
  258.                         RetVal := CurrState;
  259.                     end;
  260.                 end;
  261.             end;
  262.             if not Treated then begin
  263.                 if Answer = TimOutPack then begin
  264.                     if Debug then begin
  265.                         DbgWrite('Timed out waiting for ACK for FileData$');
  266.                         DbgNL;
  267.                     end;
  268.                     RetVal := CurrState;
  269.                 end else
  270.                     if Answer = ChkIllPack then begin
  271.                         if Debug then begin
  272.                             DbgWrite('Illegal checksum read - retrying$');
  273.                             DbgNL;
  274.                         end;
  275.                         RetVal := CurrState;
  276.                     end else
  277.                         RetVal := Abort;
  278.             end;
  279.         end;
  280.         SendData := RetVal;
  281.     end; (* SendData *)
  282.  
  283.     function    SendEof( idev, odev     : integer;
  284.                          VAR NameList   : NListPtr;
  285.                          VAR InFile     : ByteFile;
  286.                          VAR FNPack     : Packet ) : KermitStates;
  287.     var     Pack   : Packet;
  288.             Len    : integer;
  289.             Num    : integer;
  290.             RetVal : KermitStates;
  291.             Treated: boolean;
  292.             Answer : PacketType;
  293.     begin
  294.         if Debug then begin
  295.             DbgWrite('Enter SendEof$');
  296.             DbgNL;
  297.         end;
  298.         NumTry := NumTry + 1;
  299.         if NumTry > MaxTry then
  300.             RetVal := Abort
  301.         else
  302.         begin
  303.             SendPacket (    EOFPack,
  304.                             n,
  305.                             0,
  306.                             Pack,   (* Dummy *)
  307.                             ODev    );
  308.             Answer := ReadPacket( Num , Len, Pack, IDev );
  309.             Treated := false;
  310.             if Answer = NAKPack then
  311.             begin
  312.                 Treated := true;
  313.                 Num := Prev( Num );
  314.                 if Num <> n then
  315.                     RetVal := CurrState
  316.                 else
  317.                     Answer := ACKPack;
  318.             end;
  319.             if Answer = ACKPack then begin
  320.                 Treated := true;
  321.                 if n <> Num then
  322.                     RetVal := CurrState
  323.                 else begin
  324.                     NumTry := 0;
  325.                     n := (n + 1) mod 64;
  326.                     if Debug then begin
  327.                         DbgWrite('Closing input-file$');
  328.                         DbgNL;
  329.                     end;
  330.                     if ( CloseFile( InFile )<>0 ) and Debug then begin
  331.                         DbgWrite(' Unable to close input file$');
  332.                         DbgNL;
  333.                     end;
  334.                     RetVal := GetNewFile( NameList, InFile, FNPack );
  335.                 end;
  336.             end;
  337.             if not Treated then
  338.             begin
  339.                 if Answer = TimOutPack then begin
  340.                     if Debug then begin
  341.                         DbgWrite('Timed out waiting for ACK for EOF-packet$');
  342.                         DbgNL;
  343.                     end;
  344.                     RetVal := CurrState;
  345.                 end else
  346.                     if Answer = ChkIllPack then begin
  347.                         if Debug then begin
  348.                             DbgWrite('Illegel checksum read - retrying$');
  349.                             DbgNL;
  350.                         end;
  351.                         RetVal := CurrState;
  352.                     end else
  353.                         RetVal := Abort;
  354.             end;
  355.         end;
  356.         SendEOF := RetVal;
  357.     end;
  358.  
  359.     function    SendBreak( idev, odev : integer ) : KermitStates;
  360.     var     Answer : PacketType;
  361.             Treated: boolean;
  362.             Pack   : Packet;
  363.             Len    : integer;
  364.             Num    : integer;
  365.             RetVal : KermitStates;
  366.     begin
  367.         if Debug then begin
  368.             DbgWrite('Enter Send-break$');
  369.             DbgNL;
  370.         end;
  371.         NumTry := NumTry + 1;
  372.         if NumTry > MaxTry then
  373.             RetVal := Abort
  374.         else
  375.         begin
  376.             SendPacket (    BrkPack,
  377.                             n,
  378.                             0,
  379.                             Pack,   (* dummy *)
  380.                             ODev    );
  381.             Answer := ReadPacket ( Num, Len, Pack, Idev );
  382.             Treated := false;
  383.             if Answer = NAKPack then
  384.             begin
  385.                 Treated := true;
  386.                 Num := Prev( Num );
  387.                 if Num <> n then
  388.                     RetVal := CurrState
  389.                 else
  390.                     Answer := ACKPack;
  391.             end;
  392.             if Answer = ACKPack then
  393.             begin
  394.                 Treated := true;
  395.                 if n <> ord(Num) then
  396.                     RetVal := CurrState
  397.                 else
  398.                 begin
  399.                     NumTry := 0;
  400.                     n := (n + 1) mod 64;
  401.                     RetVal := Complete;
  402.                 end;
  403.             end;
  404.             if not Treated then
  405.             begin
  406.                 if Answer = TimOutPack then begin
  407.                     if Debug then begin
  408.                         DbgWrite('Timed out waiting for ACK for Brk-packet$');
  409.                         DbgNL;
  410.                     end;
  411.                     RetVal := CurrState;
  412.                 end else
  413.                     if Answer = ChkIllPack then begin
  414.                         if Debug then begin
  415.                             DbgWrite('Illegal checksum read - retrying$');
  416.                             DbgNL;
  417.                         end;
  418.                         RetVal := CurrState;
  419.                     end else
  420.                         RetVal := Abort;
  421.             end;
  422.         end;
  423.         SendBreak := RetVal;
  424.     end;
  425.  
  426.     function    SendSwitch( VAR NameList : NListPtr;
  427.                             VAR InFile   : ByteFile ;       
  428.                             Idev, Odev   : integer      ) :  KermitStates;
  429.     var     FNPack, FDPack  : Packet;
  430.     begin
  431.         CurrState := Init;
  432.         xhold( SUnits, Delay );
  433.         n := 0;
  434.         NumTry := 0;
  435.         while (CurrState <> Complete) and (CurrState <> Abort) do
  436.         begin
  437.             case CurrState of
  438.                 FileData    :   CurrState := SendData( Idev, Odev,
  439.                                                 FDPack, InFile );
  440.                 FileHeader  :   CurrState := SendFileHeader( Idev, Odev,
  441.                                                 FNPack, FDPack, InFile );
  442.                 EOFile      :   CurrState := SendEof( Idev, Odev,
  443.                                                 NameList, InFile, FNPack );
  444.                 Init        :
  445.                     begin
  446.                         CurrState := SendInitiate( Idev, Odev,
  447.                                                 NameList, InFile, FNPack );
  448.                         if STSet then
  449.                             TimeOut := SendTimeOut;
  450.                     end;
  451.                 Break       :   CurrState := SendBreak( Idev, Odev );
  452.                 Complete,
  453.                 Abort       :   ;
  454.             end; (* case *)
  455.             if Debug then begin
  456.                 DbgWrite ( 'SendSwitch :  State transition to --> $' );
  457.                 DbgState ( CurrState );
  458.                 DbgNL;
  459.             end;
  460.         end; (* while *)
  461.         SendSwitch := CurrState;
  462.     end;
  463.  
  464.  
  465. 
  466.