sbidftpiohandler.pas

著名的SecureBlackBox控件完整源码

  if (FSSLMode = smImplicit) then
    if not EstablishImplicitSession then
      raise Exception.Create('Server cannot perform SSL negotiation');
end;

procedure TElIdFTPIOHandlerSocket.Close;
begin
  if FBinding <> nil then
    FSecureClient.Close;
  inherited;
end;

procedure TElIdFTPIOHandlerSocket.Open;
begin
  FSecureClient.Close;
  FServerHelloReceived := false;
  FState := fsPlain;
  inherited;
end;

function TElIdFTPIOHandlerSocket.ParseServerHello(const ABuf; ALen : integer) : boolean;
begin
  // add ftp hello check later
  Result := true;
end;

function TElIdFTPIOHandlerSocket.GetFTPCode(const ABuf; ALen : integer) : integer;
var
  S: string;
  I : integer;
begin
  S := '';
  I := 0;
  while (I <= ALen) and (PByteArray(@ABuf)[I] >= Ord('0')) and (PByteArray(@ABuf)[I] <= Ord('9')) do
  begin
    S := S + Chr(PByteArray(@ABuf)[I]);
    Inc(I);
  end;
  try
    Result := StrToInt(S);
  except
    raise Exception.Create('Invalid FTP sequence');
  end;
end;

function TElIdFTPIOHandlerSocket.GetNextCommand(const S : string; var Code : integer) : string;
var
  Tmp : string;
  Ind : integer;
begin
  if S = '' then
  begin
    Code := 0;
    Exit;
  end;
  Ind := Pos(#13#10, S);
  Tmp := Copy(S, 1, Ind - 1);
  Code := GetFTPCode(Tmp[1], Length(Tmp));
  Result := Copy(S, Ind + 2, Length(S));
end;

function TElIdFTPIOHandlerSocket.Recv(var ABuf;  ALen: integer): integer;
var
  S : string;
begin
  if FState = fsPlain then
  begin
    Result := RecvEnc(ABuf, ALen);
    if FUseSSL and (not FServerHelloReceived) and (FSSLMode = smExplicit) then
    begin
      if ParseServerHello(ABuf, ALen) then
      begin
        FServerHelloReceived := true;
        S := EstablishSSLSession;
        Move(S[1], PByteArray(@ABuf)[Result], Length(S));
        Result := Result + Length(S);
      end;
    end;
  end
  else
  begin
    if Length(FBuffer) > 0 then
    begin
      if ALen < Length(FBuffer) then
      begin
        Move(FBuffer[1], ABuf, ALen);
        Delete(FBuffer, 1, ALen);
        Result := ALen;
      end
      else
      begin
        Result := Length(FBuffer);
        Move(FBuffer[1], ABuf, Length(FBuffer));
        SetLength(FBuffer, 0);
      end;
    end
    else
    begin
      FDataReceived := False;
      FRecvBuffer := @ABuf;
      FRecvMaxSize := ALen;
      FRecvWritten := 0;
      // II Sep 02 2004: added FRecvWritten=0 condition not to let Recv return 0 without waiting for data
      while ((not FDataReceived) and (FBinding.HandleAllocated)) or (FRecvWritten = 0) do
        FSecureClient.DataAvailable;
      Result := FRecvWritten;
    end;
  end;
end;

function TElIdFTPIOHandlerSocket.Send(var ABuf;
  ALen: integer): integer;
begin
  Result := ALen;
  if FState = fsPlain then
    DoActualSend(@ABuf, ALen)
  else
  begin
    FSecureClient.SendData(@ABuf, ALen);
    Result := ALen;
  end;
end;

function TElIdFTPIOHandlerSocket.EstablishSSLSession : string;
var
  S : string;
  Buf : string;
  Count : integer;
  Code, Received : integer;
  Ex : boolean;
begin
  // sending SSL request
  Result := '';
  S := 'AUTH SSL'#13#10;
  DoActualSend(@S[1], Length(S));
  Ex := false;
  repeat
    SetLength(Buf, 16000);
    Count := RecvEnc(Buf[1], 16000);
    SetLength(Buf, Count);
    repeat
      S := GetNextCommand(Buf, Code);
      if Code = 0 then Break;
      if Code <> 234 then
       Result := Result + Copy(Buf, 1, Length(Buf) - Length(S));
      Buf := S;
    until (code <> 220);
    if (Code = 234) or (Code >= 500) or (Code = 431) then
      Ex := true;
  until Ex;
  if (Code = 431) or (Code >= 500) then
  begin
    S := 'AUTH TLS'#13#10;
    DoActualSend(@S[1], Length(S));
    SetLength(Buf, 16000);
    Count := RecvEnc(Buf[1], 16000);
    SetLength(Buf, Count);
    GetNextCommand(Buf, Code);
  end;

  if Code = 234 then
  begin
    FErrorOccured := false;
    FSecureClient.Open;
    while (not FSecureClient.Active) and (not FErrorOccured) do
      FSecureClient.DataAvailable;
    if FSecureClient.Active then
      FState := fsEncrypted
    else
    begin
      FState := fsPlain;
      raise Exception.Create('Error occured while forcing SSL');
    end;

    S := 'PBSZ 0'#13#10;
    Send(S[1], Length(S));
    SetLength(S, 1000);
    Recv(S[1], 1000);
    Count := Pos(#13#10, S);
    SetLength(S, Count + 1);
    GetNextCommand(S, Count);
    if Count <> 200 then
      raise Exception.Create('Server cannot perform SSL negotiation');
      
    if FEncryptDataChannel then
      S := 'PROT P'#13#10
    else
      S := 'PROT C'#13#10;
    Send(S[1], Length(S));
    SetLength(S, 1000);
    Received := Recv(S[1], 1000);
    SetLength(S, Received);
    Count := Pos(#13#10, S);
    SetLength(S, Count + 1);
    GetNextCommand(S, Count);
    if Count <> 200 then
      raise Exception.Create('Server cannot perform SSL negotiation');

  end
  else if Code >= 500 then
    raise Exception.Create('Server doesn''t support SSL')
  else if Code = 431 then
    raise Exception.Create('Server cannot perform SSL negotiation');
end;

function TElIdFTPIOHandlerSocket.EstablishImplicitSession: boolean;
begin
  Result := false;
  FErrorOccured := false;
  FSecureClient.Open;
  while (not FSecureClient.Active) and (not FErrorOccured) do
    FSecureClient.DataAvailable;
  if FSecureClient.Active then
    FState := fsEncrypted
  else
  begin
    FState := fsPlain;
    Exit;
  end;
  Result := true;
end;

function TElIdFTPIOHandlerSocket.RecvEnc(var ABuf; ALen: integer): integer;
var
  Val : boolean;
begin
  if FReadTimeout <> 0 then
    Val := FBinding.Readable(FReadTimeout)
  else
    Val := true;
  if Val then
    Result := FBinding.Recv(ABuf, ALen, 0)
  else
    raise EIdReadTimeout.Create(RSReadTimeout);
end;

procedure TElIdFTPIOHandlerSocket.DoActualSend(Buffer: pointer;
  Size: integer);
var
  Sent, JustSent: integer;
begin
  Sent := 0;
  if FBinding = nil then
    Exit;
  while Sent < Size do
  begin
    JustSent := FBinding.Send(PByteArray(Buffer)[Sent], Size - Sent, 0);
    TIdAntiFreezeBase.DoProcess(False);
    if JustSent <= 0 then
    begin
      if FBinding.HandleAllocated then
      begin
        FBinding.CloseSocket;
        raise EIdConnClosedGracefully.Create(RSConnectionClosedGracefully);
      end;
      if GStack.CheckForSocketError(JustSent, [ID_WSAESHUTDOWN]) then
      begin
        if FBinding.HandleAllocated then
          FBinding.CloseSocket;
        GStack.RaiseSocketError(ID_WSAESHUTDOWN);
      end;
    end;
    Inc(Sent, JustSent);
  end;
end;

procedure TElIdFTPIOHandlerSocket.DoSSLEstablished;
begin
  if Assigned(FOnSSLEstablished) then
    FOnSSLEstablished(Self, FSecureClient.CurrentVersion, FSecureClient.CipherSuite);
end;

procedure TElIdFTPIOHandlerSocket.HandleSecureClientSend(Sender : TObject;
  Buffer : pointer; Size : longint);
begin
  DoActualSend(Buffer, Size);
end;

procedure TElIdFTPIOHandlerSocket.HandleSecureClientReceive(Sender : TObject; Buffer : pointer;
  MaxSize : longint; {$ifndef BUILDER_USED}out{$else}var{$endif} Written : longint);
var
  Val : boolean;
begin
  if FReadTimeout <> 0 then
    Val := FBinding.Readable(FReadTimeout)
  else
    Val := true;
  if Val then
  begin
    Written := FBinding.Recv(Buffer^, MaxSize, 0);
    if Written < 0 then
      Written := 0;
    if (Written = 0) and FBinding.HandleAllocated then
      FDataReceived := True;
  end
  else
    raise EIdReadTimeout.Create(RSReadTimeout);
end;

procedure TElIdFTPIOHandlerSocket.HandleSecureClientData(Sender : TObject;
  Buffer : pointer; Size : longint);
begin
  if Size <= FRecvMaxSize then
  begin
    Move(Buffer^, FRecvBuffer^, Size);
    FRecvWritten := Size;
  end
  else
  begin
    Move(Buffer^, FRecvBuffer^, FRecvMaxSize);
    FRecvWritten := FRecvMaxSize;
    SetLength(FBuffer, Size - FRecvMaxSize);
    Move(PByteArray(Buffer)[FRecvMaxSize], FBuffer[1], Size - FRecvMaxSize);
  end;
  FDataReceived := True;
end;

procedure TElIdFTPIOHandlerSocket.HandleSecureClientOpenConnection(Sender : TObject);
begin
  if FSecureClient.Active then
    DoSSLEstablished;
end;

procedure TElIdFTPIOHandlerSocket.HandleSecureClientCloseConnection(Sender : TObject;
  CloseReason : TSBCloseReason);
begin
  FErrorOccured := true;
end;

procedure TElIdFTPIOHandlerSocket.HandleSecureClientCertificateValidate(Sender : TObject;
  Certificate : TElX509Certificate; var Validate : boolean);
begin
  FSecureClient.InternalValidate(FValidity, FReason);
  if Assigned(FOnCertificateValidate) then
    FOnCertificateValidate(Self, Certificate, Validate);
end;

procedure TElIdFTPIOHandlerSocket.HandleSecureClientCertificateNeeded(Sender : TObject;
  CertificateBuffer: pointer; var CertificateSize: LongInt; PrivateKeyBuffer: pointer;
  var PrivateKeySize: LongInt; CertificateType: TClientCertificateType);
begin
  if Assigned(FOnCertificateNeeded) then
    FOnCertificateNeeded(Self, CertificateBuffer, CertificateSize,
    PrivateKeyBuffer, PrivateKeySize, CertificateType);
end;

procedure TElIdFTPIOHandlerSocket.HandleSecureClientCertificateNeededEx(Sender :
  TObject; var Certificate : TElX509Certificate);
begin
  if Assigned(FOnCertificateNeededEx) then
    FOnCertificateNeededEx(Self, Certificate);
end;

procedure TElIdFTPIOHandlerSocket.HandleIOHandlerCertificateValidate(Sender : TObject;