clsspi.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

      for I := 0 to Length(PACKAGE_NAMES) - 1 do
      begin
        if (StrComp(PSecPkgInfo(Integer(PackageInfoArray) + SizeOf(TSecPkgInfo) * J).Name,
          PACKAGE_NAMES[I]) = 0) then
        begin
          if (I < Result) then Result := I;
          Break;
        end;
      end;
    end;
  finally
    FunctionTable.FreeContextBuffer(PackageInfoArray);
  end;
  SetSspiErrorIf(Result >= Length(PACKAGE_NAMES), SSPI_E_PackageNotFound);
end;

function TclTlsSspi.GetMaxToken: Cardinal;
var
  ss: SECURITY_STATUS;
  PackageInfo: PSecPkgInfo;
begin
  ss := FunctionTable.QuerySecurityPackageInfo(PChar(GetPackageName()), PackageInfo);
  SetSspiErrorIf(ss, SSPI_E_QueryPackageInfoFailed);
  Result := PackageInfo.cbMaxToken;
  FunctionTable.FreeContextBuffer(PackageInfo);
end;

procedure TclTlsSspi.InitPackage;
begin
  FPackageNo := GetPackageNo();
  FMaxToken := GetMaxToken();
end;

function TclTlsSspi.Encrypt(ASource, ADestination: TStream; ASourceSize: Integer): TclSspiReturnCode;
var
  Msg: TSecBufferDesc;
  Buffers: array[0..3] of TSecBuffer;
  pbPacket,
  pbMessInPacket,
  pbMessage: PChar;
  SrcCurPos,
  cbPacketSize,
  cbMessage: Cardinal;
  srcBuf, dstBuf: PChar;
  dstSize: Integer;
begin
{$IFDEF LOGGER}
  clPutLogMessage(Self, edInside, 'EncryptMessage', ASource, ASource.Position);
{$ENDIF}

  Result := rcOk;

  srcBuf := nil;
  dstBuf := nil;
  try
    SrcCurPos := 0;
    cbPacketSize := StreamSizes.cbHeader + StreamSizes.cbTrailer;

    dstSize := ASourceSize + (Integer(cbPacketSize))*(ASourceSize div Integer(StreamSizes.cbMaximumMessage) + 1);
    GetMem(srcBuf, ASourceSize);
    GetMem(dstBuf, dstSize);

    ASource.Read(srcBuf^, ASourceSize);
    ASource.Position := ASource.Position - ASourceSize;

    pbPacket := dstBuf;
    pbMessInPacket := PChar(Cardinal(dstBuf) + StreamSizes.cbHeader);
    pbMessage := srcBuf;

    Buffers[0].cbBuffer     := StreamSizes.cbHeader;
    Buffers[0].BufferType   := SECBUFFER_STREAM_HEADER;
    Buffers[1].BufferType   := SECBUFFER_DATA;
    Buffers[2].cbBuffer     := StreamSizes.cbTrailer;
    Buffers[2].BufferType   := SECBUFFER_STREAM_TRAILER;
    Buffers[3].BufferType   := SECBUFFER_EMPTY;

    Msg.ulVersion       := SECBUFFER_VERSION;
    Msg.cBuffers        := 4;
    Msg.pBuffers        := @Buffers;

    while (SrcCurPos < DWORD(ASourceSize)) do
    begin
      cbMessage := DWORD(ASourceSize) - SrcCurPos;
      if (cbMessage > StreamSizes.cbMaximumMessage) then
      begin
        cbMessage := StreamSizes.cbMaximumMessage;
      end;
      CopyMemory(pbMessInPacket, pbMessage, cbMessage);
      Inc(SrcCurPos, cbMessage);

      Buffers[0].pvBuffer     := pbPacket;
      Buffers[1].pvBuffer     := pbMessInPacket;
      Buffers[1].cbBuffer     := cbMessage;
      Buffers[2].pvBuffer     := Pointer(Cardinal(pbMessInPacket) + cbMessage);
      Buffers[3].BufferType   := SECBUFFER_EMPTY;

      if (Win32Platform <> VER_PLATFORM_WIN32_WINDOWS) then
      begin
        FStatusCode := FunctionTable.EncryptMessage(@FCtxtHandle, nil, @Msg, 0);
      end else
      begin
        FStatusCode := FunctionTable.SealMessage(@FCtxtHandle, nil, @Msg, 0);
      end;

{$IFDEF LOGGER}
    clPutLogMessage(Self, edInside, 'EncryptMessage');
{$ENDIF}
      
      Result := CheckSspiError(FStatusCode);

      pbPacket := PChar(Cardinal(pbPacket) + cbMessage + cbPacketSize);
      pbMessInPacket := Pointer(Cardinal(pbPacket) + Buffers[0].cbBuffer);
      pbMessage := PChar(Cardinal(srcBuf) + SrcCurPos);
    end;

    ADestination.Write(dstBuf^, dstSize);
    ADestination.Position := ADestination.Position - dstSize;
  finally
    FreeMem(dstBuf);
    FreeMem(srcBuf);
  end;
end;

function TclTlsSspi.Decrypt(ASource, ADestination, AExtraBuffer: TStream): TclSspiReturnCode;
var
  i, size: Integer;
  pbBuffPtr, pbIoBuffer: PChar;
  cbIoBufferSize: Cardinal;
  Msg: TSecBufferDesc;
  Buffers: array[0..3] of TSecBuffer;
  HasDecodedData,
  InExtraLoop: Boolean;
begin
  InExtraLoop := False;
  HasDecodedData := False;
  Result := rcOk;
  size := ASource.Size - ASource.Position;
  GetMem(pbIoBuffer, size);
  try
    pbBuffPtr := pbIoBuffer;

    ASource.Read(pbIoBuffer^, size);
    ASource.Position := ASource.Position - size;

    cbIoBufferSize := size;
    repeat
      if (cbIoBufferSize < 6) then
      begin
        if HasDecodedData then
        begin
          AExtraBuffer.Size := 0;
          AExtraBuffer.Write(pbBuffPtr^, cbIoBufferSize);
          AExtraBuffer.Position := AExtraBuffer.Position - Integer(cbIoBufferSize);

          Result := rcContinueAndMoreDataNeeded;
        end else
        begin
          Result := rcMoreDataNeeded;
        end;
        break;
      end;
      Buffers[0].pvBuffer     := pbBuffPtr;
      Buffers[0].cbBuffer     := cbIoBufferSize;
      Buffers[0].BufferType   := SECBUFFER_DATA;

      Buffers[1].BufferType   := SECBUFFER_EMPTY;
      Buffers[2].BufferType   := SECBUFFER_EMPTY;
      Buffers[3].BufferType   := SECBUFFER_EMPTY;

      Msg.ulVersion       := SECBUFFER_VERSION;
      Msg.cBuffers        := Length(Buffers);
      Msg.pBuffers        := @Buffers;

      if (Win32Platform <> VER_PLATFORM_WIN32_WINDOWS) then
      begin
        FStatusCode := FunctionTable.DecryptMessage(@FCtxtHandle, @Msg, 0, nil);
      end else
      begin
        FStatusCode := FunctionTable.UnSealMessage(@FCtxtHandle, @Msg, 0, nil);
      end;

{$IFDEF LOGGER}
    clPutLogMessage(Self, edInside, 'DecryptMessage');
{$ENDIF}

      Result := CheckSspiError(FStatusCode);

      for i := Low(Buffers) to High(Buffers) do
      begin
        case Buffers[i].BufferType of
          SECBUFFER_DATA:
            begin
              if (Result = rcMoreDataNeeded) or (Result = rcClosingNeeded) then
              begin
                AExtraBuffer.Size := 0;
                AExtraBuffer.Write(Buffers[i].pvBuffer^, Buffers[i].cbBuffer);
                AExtraBuffer.Position := AExtraBuffer.Position - Integer(Buffers[i].cbBuffer);

                if (Result <> rcClosingNeeded) then
                begin
                  Result := rcContinueAndMoreDataNeeded;
                end;
              end else
              begin
                HasDecodedData := True;
                ADestination.Write(Buffers[i].pvBuffer^, Buffers[i].cbBuffer);
{$IFDEF LOGGER}
    clPutLogMessage(Self, edInside, 'DecryptMessage : ADestination.Write', Buffers[i].pvBuffer, Buffers[i].cbBuffer);
{$ENDIF}
              end;
              InExtraLoop := False;
            end;
          SECBUFFER_EXTRA:
            begin
              cbIoBufferSize := Buffers[i].cbBuffer;
              pbBuffPtr := Buffers[i].pvBuffer;
              InExtraLoop := True;
            end;
          SECBUFFER_MISSING:
            begin
              if HasDecodedData then
              begin
                AExtraBuffer.Size := 0;
                AExtraBuffer.Write(pbBuffPtr^, cbIoBufferSize);
{$IFDEF LOGGER}
    clPutLogMessage(Self, edInside, 'DecryptMessage : AExtraBuffer.Write', pbBuffPtr, cbIoBufferSize);
{$ENDIF}
                AExtraBuffer.Position := AExtraBuffer.Position - Integer(cbIoBufferSize);

                Result := rcContinueAndMoreDataNeeded;
              end else
              begin
                Result := rcMoreDataNeeded;
              end;
              InExtraLoop := False;
              break;
            end;
        end;
      end;
    until not InExtraLoop;
  finally
    FreeMem(pbIoBuffer);
  end;
end;

procedure TclTlsSspi.EnumerateSecurityPackages(var APackagesCount: Cardinal;
  var APackageInfoArray: PSecPkgInfo);
var
  ss: SECURITY_STATUS;
begin
  ss := FunctionTable.EnumerateSecurityPackages(APackagesCount, PSecPkgInfo(APackageInfoArray));
  SetSspiErrorIf(ss, SSPI_E_QueryPackageInfoFailed);
end;

procedure TclTlsSspi.DeleteContext;
begin
  if ((FCtxtHandle.dwLower <> 0) or (FCtxtHandle.dwUpper <> 0)) then
  begin
    FunctionTable.DeleteSecurityContext(@FCtxtHandle);
    FCtxtHandle.dwLower := 0;
    FCtxtHandle.dwUpper := 0;
  end;
end;

procedure TclTlsSspi.DeleteCredentials;
begin
  if ((FCredHandle.dwLower <> 0) or (FCredHandle.dwUpper <> 0)) then
  begin
    FunctionTable.FreeCredentialHandle(@FCredHandle);
    FCredHandle.dwLower := 0;
    FCredHandle.dwUpper := 0;
  end;
end;

constructor TclTlsSspi.Create;
begin
  inherited Create();
  FNewConversation := True;
  InitPackage();
  TLSFlags :=  [tfUseTLS];
end;

function TclTlsSspi.GenCredentials(ACertificate: TclCertificate; AllowEmptyCred: Boolean;
  ASecData: TSChannel_Cred; ACredentialUse: Cardinal): Boolean;
var
  tsExpiry: TTimeStamp;
begin
  DeleteCredentials();

  if AllowEmptyCred then
  begin
    Result := True;
  end else
  begin
    Result := (ACertificate <> nil);
    if not Result then Exit;
  end;

  if (ACertificate <> nil) then
  begin
    ASecData.cCreds := 1;
    ASecData.paCred := @ACertificate.Context;
  end;

  FStatusCode := FunctionTable.AcquireCredentialsHandle(
      nil,                   // use the default principal
      PChar(GetPackageName()),
      ACredentialUse,
      nil,                   // use the default LOGON id
      @ASecData,
      nil,                   // no callback function needed to get a key
      nil,                   // no callback function arguments needed
      @FCredHandle,
      @tsExpiry);

{$IFDEF LOGGER}
    clPutLogMessage(Self, edInside, 'AcquireCredentialsHandle');
{$ENDIF}
      
  SetSspiErrorIf(FStatusCode, SSPI_E_AcquireFailed);
end;

procedure TclTlsSspi.FreePeerCertificate;
begin
  FPeerCertificate.Free();
  FPeerCertificate := nil;
end;

destructor TclTlsSspi.Destroy;
begin
  FreePeerCertificate();
  inherited Destroy();
end;

{ TclSspi }

constructor TclSspi.Create;
begin
  inherited Create();
  FDLLHandle := 0;
  FFunctionTable := nil;
end;

destructor TclSspi.Destroy;
begin
  if (FDLLHandle <> 0) then
  begin
    FreeLibrary(FDLLHandle);
  end;
  inherited Destroy();
end;

function TclSspi.GetFunctionTable: PSecurityFunctionTable;
begin
  if (FFunctionTable = nil) then
  begin
    InitFunctionTable();
  end;
  Result := FFunctionTable;
end;

procedure TclSspi.InitFunctionTable;
var
  ind: Integer;
  InitSecurityInterface: PInitSecurityInterface;
begin
  ind := 0;
  FDLLHandle := LoadLibrary(DLL_NAMES[ind]);
  if (FDLLHandle <= HINSTANCE_ERROR) then