awkermit.pas

测试用例

  begin
    with P^ do begin
      Inc(Index, Increment);
      if Index > kTableSize then
        Dec(Index, kTableSize);
      kpIncTableIndex := Index;
    end;
  end;

  procedure kpFlushTableToDisk(P : PProtocolData);
    {-Write all outstanding packets to disk}
  var
    Last, I : Cardinal;
  begin
    with P^ do begin
      Last := kpIncTableIndex(P, kTableHead, 1);
      I := Last;
      repeat
        with kInfoTable[I] do begin
          if InUse then
            if Acked then
              kpWritePacket(P, I)
            else begin
              apProtocolError(P, ecTableFull);
              Exit;
            end;
        end;
        I := kpIncTableIndex(P, I, 1);
      until (I = Last);
    end;
  end;


  procedure kpReceiveBlock(P : PProtocolData);
    {-Get the datafield of a Kermit packet}
  var
    C : Char;
    Check1 : Cardinal;
    Check2 : Cardinal;
    Check3 : Cardinal;
  label
    ExitPoint;
  begin
    with P^ do begin
      {Get the data block}
      if kRecDataLen > 1024 then
        kRecDataLen := 1024;
      kActualDataLen := kRecDataLen;

      {If continuing a previous block we need to restore aBlockCheck}
      if kBlockIndex <> 1 then begin
        aBlockCheck := kSaveCheck;
        kBlockCheck2 := kSaveCheck2;
      end;

      {Set desired check type}
      if kCheckKnown then
        kTempCheck := kKermitOptions.Check
      else
        kTempCheck := '1';

      while kpCharReady(P) do begin
        C := kpGetChar(P);                                           
        
        case kKermitDataState of
          dskData :
            begin
              aDataBlock^[kBlockIndex] := C;
              kpUpdateBlockCheck(P, Byte(C));
              Inc(kBlockIndex);
              if kBlockIndex > kRecDataLen then begin
                kKermitDataState := dskCheck1;
              end;
            end;
          dskCheck1 :
            begin
              kC1 := UnChar(C);
              if kTempCheck = '1' then begin
                Check1 := Lo(aBlockCheck);
                Check1 := (Check1 + (Check1 shr 6)) and $3F;
                if Check1 <> Byte(kC1) then
                  aProtocolStatus := psBlockCheckError
                else
                  aProtocolStatus := psGotData;
                Exit;
              end else
                kKermitDataState := dskCheck2;
            end;
          dskCheck2 :
            begin
              kC2 := UnChar(C);
              if kTempCheck = '2' then begin
                {1st byte has bits 11-6}
                Check1 := (aBlockCheck shr 6) and $3F;
                {Second byte has bits 5-0}
                Check2 := aBlockCheck and $3F;
                if (Check1 <> Byte(kC1)) or (Check2 <> Byte(kC2)) then
                  aProtocolStatus := psBlockCheckError
                else
                  aProtocolStatus := psGotData;
                Exit;
              end else
                kKermitDataState := dskCheck3;
            end;
          dskCheck3 :
            begin
              kC3 := UnChar(C);
              Check1 := (kBlockCheck2 shr 12) and $0F;
              Check2 := (kBlockCheck2 shr 6) and $3F;
              Check3 := kBlockCheck2 and $3F;
              if (Check1 <> Byte(kC1)) or
                 (Check2 <> Byte(kC2)) or
                 (Check3 <> Byte(kC3)) then
                aProtocolStatus := psBlockCheckError
              else
                aProtocolStatus := psGotData;
              Exit;
            end;
        end;
      end;

      {If we exit this way we don't have a data block yet}
      aProtocolStatus := psNoData;
      kSaveCheck := aBlockCheck;
      kSaveCheck2 := kBlockCheck2;
    end;
  end;
 
  procedure kpExpandFileInfo(P : PProtocolData);
    {Un-escapes file info }
  var
    ExName : PDataBlock;
    Index, NIndex : Cardinal;
    Repeating : Boolean;
    RepeatCount : Integer;
    C : Char;
  begin
    with P^ do begin
      ExName := AllocMem(SizeOf(TDataBlock));
      FillChar(ExName^[1], SizeOf(ExName^), #0);
      Repeating := False;
      RepeatCount := 0;
      Index := 1;
      NIndex := 1;
      repeat
        C := aDataBlock^[Index];
        if Repeating then begin
          if RepeatCount = 0 then begin
            if C = kKermitOptions.CtlPrefix then begin
              { the repeat char is a literal char }
              ExName^[NIndex] := C;
              inc(NIndex);
            end else
              { get the number of times to repeat the next char }
              RepeatCount := Ord(C) - 32
           end else begin
            { repeat the current char }
            FillChar(ExName^[NIndex], RepeatCount, C);
            inc(NIndex, RepeatCount);
            RepeatCount := 0;
            Repeating := False;
          end
        end else if C = kKermitOptions.RepeatPrefix then
          { see if this is a repeat char prefix }
          Repeating := True
        else begin
          { just a regular char }
          ExName^[NIndex] := C;
          inc(NIndex);
        end;
        inc(Index);
      until Index > kActualDataLen;
      { initialize aDataBlock }
      FillChar(aDataBlock^[1], SizeOf(aDataBlock^), #0);
      { mode the unescaped file info to aDataBlock }
      Move(ExName^[1], aDataBlock^[1], NIndex);
      kActualDataLen := NIndex;
    end;
    FreeMem(ExName, SizeOf(TDataBlock));
  end;                                                           

  procedure kpExtractFileInfo(P : PProtocolData);
    {-Extracts the file name from the aDatablock}
  var
    S    : string[fsPathname];
    Name : string[fsName];
    NameExt : array[0..fsName] of Char;
  begin
    with P^ do begin
      kpExpandFileInfo(P);                                          
      if kActualDataLen <= 255 then begin
        Move(aDataBlock^[1], aPathname[0], kActualDataLen);
        aPathname[kActualDataLen] := #0;
      end else begin
        Move(aDataBlock^[1], aPathname[0], SizeOf(aPathName));
        aPathname[fsPathName] := #0;
      end;

      {Should we use its directory or ours?}
      if not FlagIsSet(aFlags, apHonorDirectory) then begin
        S := StrPas(aPathname);
        Name := ExtractFileName(S);
        StrPCopy(NameExt, Name);
        AddBackSlashZ(aPathName, aDestDir);
        StrLCat(aPathName, NameExt, SizeOf(aPathName));
      end;
    end;
  end;

  procedure kpSendInitialize(P : PProtocolData);
    {-Send our SendInit packet and get a response}
  const
    StdHdrLen = 13;
  var
    kSaveCheckChar : Char;
  begin
    with P^ do begin
      {Send the header}
      kpPutHeader(P, KSendInit, StdHdrLen+3);

      with kKermitOptions do begin
        {Flush input buffer in preparation for reply}
        kpFlushInBuffer(P);                                         

        WindowSize := WindowSize and $1F;
        {Send the data bytes for the Send Initialize packet}
        kpPutToChar(P, Char(MaxPacketLen));
        kpPutToChar(P, Char(MaxTimeout));
        kpPutToChar(P, Char(PadCount));
        aHC.PutChar(Ctl(PadChar));
        kpPutToChar(P, Terminator);
        aHC.PutChar(CtlPrefix);
        aHC.PutChar(HibitPrefix);
        aHC.PutChar(Check);
        aHC.PutChar(RepeatPrefix);
        kpPutToChar(P, Char(CapabilitiesMask));
        kpPutToChar(P, Char(WindowSize));
        kpPutToChar(P, Char(MaxLongPacketLen div 95));
        kpPutToChar(P, Char(MaxLongPacketLen mod 95));

        {Always use 1-byte checksum for SendInit packets}
        kSaveCheckChar := Check;
        Check := '1';

        {Update the check value}
        kpUpdateBlockCheck(P, Byte(ToChar(Char(MaxPacketLen))));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(MaxTimeout))));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(PadCount))));
        kpUpdateBlockCheck(P, Byte(Ctl(PadChar)));
        kpUpdateBlockCheck(P, Byte(ToChar(Terminator)));
        kpUpdateBlockCheck(P, Byte(CtlPrefix));
        kpUpdateBlockCheck(P, Byte(HibitPrefix));
        kpUpdateBlockCheck(P, Byte(kSaveCheckChar));
        kpUpdateBlockCheck(P, Byte(RepeatPrefix));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(CapabilitiesMask))));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(WindowSize))));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(MaxLongPacketLen div 95))));
        kpUpdateBlockCheck(P, Byte(ToChar(Char(MaxLongPacketLen mod 95))));

        {Send the check value and terminator}
        kpSendBlockCheck(P);
        kpSendTerminator(P);

        {Restore the desired check type}
        Check := kSaveCheckChar;
      end;
    end;
  end;

  procedure kpSendDataPacket(P : PProtocolData; Slot : Cardinal);
    {-Send the prepared data packet in kDataTable[Slot]}
  var
    SaveBlockNum : Cardinal;
  begin
    with P^ do begin
      {Move data from table to aDataBlock}
      kDataLen := kInfoTable[Slot].Len;
      Move(kDataTable^[(Slot-1)*aBlockLen], aDataBlock^, kDataLen);

      {Send the packet}
      SaveBlockNum := aBlockNum;
      aBlockNum := kInfoTable[Slot].Seq;
      kpSendPacket(P, KData);
      aBlockNum := SaveBlockNum;
    end;
  end;

  procedure kpResendDataPacket(P : PProtocolData; Seq : Integer);     
    {-Resend a data packet}
  var
    I : Cardinal;
    SaveBlockNum : Cardinal;
  begin
    with P^ do begin
      {Find our sequence in the table}
      for I := 1 to kTableSize do
        if kInfoTable[I].Seq = Seq then
          Break;
      {Move data from Table to a DataBlock}
      kDataLen := kInfoTable[I].Len;
      Move(kDataTable^[(I-1)*aBlockLen], aDataBlock^, kDataLen);

      {Send the packet}
      SaveBlockNum := aBlockNum;
      aBlockNum := kINfoTable[I].Seq;
      kpSendPacket(P, kData);
      aBlockNum := SaveBlockNum;
    end;
  end;

  procedure kpSendFilePacket(P : PProtocolData);
    {-Fill in the Data field with Pathname and send a file packet}
  var
    S : TCharArray;
  begin
    with P^ do begin
      {Send the data field}
      if FlagIsSet(aFlags, apIncludeDirectory) then
        StrCopy(S, aPathname)
      else
        JustFileNameZ(S, aPathname);
      kDataLen := StrLen(S);

      {Truncate if aPathname is a long filename greater than blocksize}
      if kDataLen > aBlockLen then
        kDataLen := aBlockLen;

      Move(S[0], aDataBlock^[1], kDataLen);
      kpSendPacket(P, KFile);
    end;
  end;

  procedure kpProcessOptions(P : PProtocolData);
    {-Save the just-received options}
  var
    Tmp : Byte;
    LBLen : Cardinal;
    NewTableSize : Cardinal;
    NewaBlockLen : Cardinal;
  begin
    with P^ do begin
      aProtocolError := ecOK;

      {Move defaults in}
      kUsingRepeat := False;
      kUsingHibit := False;
      kRmtKermitOptions := MissingKermitOptions;

      {Override the defaults where specified}
      Move (aDataBlock^[1], kRmtKermitOptions,
            SizeOf(kRmtKermitOptions));                                

      {Limit the block size, if requested}
      if kRmtKermitOptions.MaxPacketLen < kKermitOptions.MaxPacketLen then
        kKermitOptions.MaxPacketLen := kRmtKermitOptions.MaxPacketLen;

      {Set repeat option if both sides are asking for it}
      Tmp := Byte(kRmtKermitOptions.RepeatPrefix);
      if (Char(Tmp) = kKermitOptions.RepeatPrefix) and
         (((Tmp > 32) and (Tmp < 63)) or ((Tmp > 95) and (Tmp < 127))) then
        kUsingRepeat := True;

      {Set hibit quoting option if either side asks for it}
      Tmp := Byte(kRmtKermitOptions.HibitPrefix);
      if ((Tmp > 32) and (Tmp < 63)) or ((Tmp > 95) and (Tmp < 127)) then begin
        kUsingHibit := True;
        kKermitOptions.HibitPrefix := kRmtKermitOptions.HibitPrefix;
      end;
      if not kUsingHibit then begin
        Tmp := Byte(kKermitOptions.HibitPrefix);
        {if we want it, and the remote said he can do it if requested, turn it on}
        if ((Tmp > 32) and (Tmp < 63)) or ((Tmp > 95) and (Tmp < 127)) then
          if kRmtKermitOptions.HibitPrefix = 'Y' then
            kUsingHibit := True;
      end;

      {Set long packets if sender asks and we allow}
      if (Byte(kRmtKermitOptions.CapabilitiesMask) and LongPackets <> 0) and
         (FlagIsSet(aFlags, apKermitLongPackets)) then begin
        kKermitOptions.CapabilitiesMask :=
          kKermitOptions.CapabilitiesMask or LongPackets;
        LBLen := Cardinal(Byte(UnChar(aDataBlock^[MaxLx1])) * 95) +
                     (Byte(UnChar(aDataBlock^[MaxLx2])));
        if LBLen = 0 then
          kKermitOptions.MaxLongPacketLen := kKermitOptions.MaxPacketLen
        else if (LBLen > 0) and (LBLen <= 1024) then
          kKermitOptions.MaxLongPacketLen := LBLen
        else
          kKermitOptions.MaxLongPacketLen := 500;
        kLPInUse := True;
      end;

      {Set SWC if sender asks and we allow}
      NewTableSize := kTableSize;
      if (Byte(kRmtKermitOptions.CapabilitiesMask) and SlidingWindows <> 0) and
         (FlagIsSet(aFlags, apKermitSWC)) then begin
        kKermitOptions.CapabilitiesMask :=
          kKermitOptions.CapabilitiesMask or SlidingWindows;
        {If remote's window size is less than ours then use its size}
        Tmp := kRmtKermitOptions.WindowSize and $1F;
        if Tmp < kKermitOptions.WindowSize then begin
          kKermitOptions.WindowSize := Tmp;
          NewTableSize := Tmp;
        end;
      end else begin
        NewTableSize := 1;
        kKermitOptions.WindowSize := 1;
      end;

      if kKermitState = rkCollectInit the