idsslopenssl.pas

indy的原文件哈!大家可以下来参考和学习之用.也可以用以作组件.开发其他的应用程序.

  if error <= 0 then begin
    Result := False;
  end else begin
    error := IdSslCtxCheckPrivateKeyFile(fContext);
    if error <= 0 then begin
      Result := False;
    end;
  end;

  StrDispose(pStr);
end;


//////////////////////////////////////////////////////////////

{ TIdSSLSocket }

constructor TIdSSLSocket.Create(Parent: TObject);
begin
  inherited Create;
  fParent := Parent;
  fSSLContext := nil;
end;

destructor TIdSSLSocket.Destroy;
begin
  if fSSL <> nil then begin
    //IdSslSetShutdown(fSSL, OPENSSL_SSL_SENT_SHUTDOWN);
    IdSslShutdown(fSSL);
    IdSslFree(fSSL);
    fSSL := nil;
  end;
  if fSSLCipher <> nil then begin
    FreeAndNil(fSSLCipher);
  end;
  inherited Destroy;
end;

function TIdSSLSocket.GetSSLError(retCode: Integer): Integer;
begin
  // COMMENT!!!
  // I found out that SSL layer should not interpret errors, cause they will pop up
  // on the socket layer. Only thing that the SSL layer should consider is key
  // or protocol renegotiation. This is done by loop in read and write

  Result := IdSslGetError(fSSL, retCode);
  case Result of
    OPENSSL_SSL_ERROR_NONE:
      Result := OPENSSL_SSL_ERROR_NONE;
    OPENSSL_SSL_ERROR_WANT_WRITE:
      Result := OPENSSL_SSL_ERROR_WANT_WRITE;
    OPENSSL_SSL_ERROR_WANT_READ:
      Result := OPENSSL_SSL_ERROR_WANT_READ;
    OPENSSL_SSL_ERROR_ZERO_RETURN:
      Result := OPENSSL_SSL_ERROR_ZERO_RETURN;
      //Result := OPENSSL_SSL_ERROR_NONE;
      {  
      // ssl layer has been disconnected, it is not necessary that also
      // socked has been closed
      case Mode of
        sslemClient: begin
          case Action of
            sslWrite: begin
              if retCode = 0 then begin
                Result := 0;
              end
              else begin
                raise EIdException.Create(RSOSSLConnectionDropped);
              end;
            end;
        end;
      end;}

        //raise EIdException.Create(RSOSSLConnectionDropped);
      // X509_LOOKUP event is not really an error, just an event
    // OPENSSL_SSL_ERROR_WANT_X509_LOOKUP:
        // raise EIdException.Create(RSOSSLCertificateLookup);
    OPENSSL_SSL_ERROR_SYSCALL:
      Result := OPENSSL_SSL_ERROR_SYSCALL;
      // Result := OPENSSL_SSL_ERROR_NONE;

        {//raise EIdException.Create(RSOSSLInternal);
        if (retCode <> 0) or (DataLen <> 0) then begin
          raise EIdException.Create(RSOSSLConnectionDropped);
        end
        else begin
          Result := 0;
        end;}

    OPENSSL_SSL_ERROR_SSL:
      // raise EIdException.Create(RSOSSLInternal);
      Result := OPENSSL_SSL_ERROR_SSL;
      // Result := OPENSSL_SSL_ERROR_NONE;
  end;
end;

procedure TIdSSLSocket.Accept(const pHandle: TIdStackSocketHandle; fSSLContext: TIdSSLContext);
var
  err: Integer;
  StatusStr: String;
begin
  fSSL := IdSslNew(fSSLContext.fContext);
  if fSSL = nil then exit;

  if IdSslSetAppData(fSSL, self) <= 0 then begin
    raise EIdOSSLDataBindingError.Create(RSSSLDataBindingError);
    exit;
  end;

  self.fSSLContext := fSSLContext;
  IdSslSetFd(fSSL, pHandle);
  err := IdSslAccept(fSSL);
  if err <= 0 then begin
    // err := GetSSLError(err);

    {if err <= -1 then
      raise EIdOSSLAcceptError.Create(RSSSLAcceptError)
    else}
    raise EIdOSSLAcceptError.Create(RSSSLAcceptError);
  end;

  StatusStr := 'Cipher: name = ' + Cipher.Name + '; ' +    {Do not Localize}
               'description = ' + Cipher.Description + '; ' +    {Do not Localize}
               'bits = ' + IntToStr(Cipher.Bits) + '; ' +    {Do not Localize}
               'version = ' + Cipher.Version + '; ';    {Do not Localize}

  if (fParent is TIdServerIOHandlerSSL) then begin
    (fParent as TIdServerIOHandlerSSL).DoStatusInfo(StatusStr);
  end;

end;

procedure TIdSSLSocket.Connect(const pHandle: TIdStackSocketHandle; fSSLContext: TIdSSLContext);
var
  error: Integer;
  StatusStr: String;
begin
  fSSL := IdSslNew(fSSLContext.fContext);
  if fSSL = nil then exit;

  if IdSslSetAppData(fSSL, self) <= 0 then begin
    raise EIdOSSLDataBindingError.Create(RSSSLDataBindingError);
    exit;
  end;

  IdSslSetFd(fSSL, pHandle);
  error := IdSslConnect(fSSL);
  if error <= 0 then begin
//    error2 := IdSslGetError(fSSL, error);
    raise EIdOSSLConnectError.Create(RSSSLConnectError);
  end;

  StatusStr := 'Cipher: name = ' + Cipher.Name + '; ' +    {Do not Localize}
               'description = ' + Cipher.Description + '; ' +    {Do not Localize}
               'bits = ' + IntToStr(Cipher.Bits) + '; ' +    {Do not Localize}
               'version = ' + Cipher.Version + '; ';    {Do not Localize}

  if (fParent is TIdSSLIOHandlerSocket) then begin
    (fParent as TIdSSLIOHandlerSocket).DoStatusInfo(StatusStr);
  end;

end;

function TIdSSLSocket.Recv(var ABuf; ALen: integer): integer;
var
  err: Integer;
begin
  Result := IdSslRead(fSSL, @ABuf, ALen);
  err := GetSSLError(Result);
  if (err = OPENSSL_SSL_ERROR_WANT_READ) or (err = OPENSSL_SSL_ERROR_WANT_WRITE) then begin
    Result := IdSslRead(fSSL, @ABuf, ALen);
  end;
end;

function TIdSSLSocket.Send(var ABuf; ALen: integer): integer;
var
  err: Integer;
begin
  Result := IdSslWrite(fSSL, @ABuf, ALen);
  err := GetSSLError(Result);
  if (err = OPENSSL_SSL_ERROR_WANT_READ) or (err = OPENSSL_SSL_ERROR_WANT_WRITE) then begin
    Result := IdSslWrite(fSSL, @ABuf, ALen);
  end;
end;

function TIdSSLSocket.GetPeerCert: TIdX509;
var
  X509: PX509;
begin
  if fPeerCert = nil then begin
    X509 := IdSslGetPeerCertificate(fSSL);
    if X509 <> nil then begin
      fPeerCert := TIdX509.Create(X509);
    end;
  end;
  Result := fPeerCert;
end;

function TIdSSLSocket.GetSSLCipher: TIdSSLCipher;
begin
  if (fSSLCipher = nil) and (fSSL<>nil) then begin
    fSSLCipher := TIdSSLCipher.Create(self);
  end;
  Result := fSSLCipher;
end;


function TIdSSLSocket.GetSessionID: TByteArray;
var
  pSession: PSSL_SESSION;
  tmpArray: TByteArray;
begin
  Result.Length := 0;
  FillChar(tmpArray, SizeOf(TByteArray), 0);
  if fSSL<>nil then begin
    pSession := IdSslGetSession(fSSL);
    if pSession <> nil then begin
      IdSslSessionGetId(pSession, @tmpArray.Data, @tmpArray.Length);
      Result := tmpArray;
    end;
  end;
end;

function  TIdSSLSocket.GetSessionIDAsString:String;
var
  Data: TByteArray;
  i: Integer;
begin
  Result := '';    {Do not Localize}
  Data := GetSessionID;
  for i := 0 to Data.Length-1 do begin
    Result := Result+Format('%.2x', [Byte(Data.Data[I])]);{do not localize}
  end;
end;

procedure TIdSSLSocket.SetCipherList(CipherList: String);
//var
//  tmpPStr: PChar;
begin
{
  fCipherList := CipherList;
  fCipherList_Ch:=True;
  aCipherList:=aCipherList+#0;
  If hSSL<>nil Then f_SSL_set_cipher_list(hSSL, @aCipherList[1]);
}
end;

///////////////////////////////////////////////////////////////
//  X509 Certificate
///////////////////////////////////////////////////////////////

{ TIdX509Name }

function TIdX509Name.CertInOneLine: String;
var
  OneLine: Array[0..2048] of Char;
begin
  if FX509Name = nil then begin
    Result := '';    {Do not Localize}
  end
  else begin
    Result := StrPas(IdSslX509NameOneline(FX509Name, PChar(@OneLine), sizeof(OneLine)));
  end;
end;

function TIdX509Name.GetHash: TULong;
begin
  if FX509Name = nil then begin
    FillChar(Result, SizeOf(Result), 0)
  end
  else begin
    Result.C1 := IdSslX509NameHash(FX509Name);
  end;
end;

function TIdX509Name.GetHashAsString: String;
begin
  Result := Format('%.8x', [Hash.L1]); {do not localize}
end;

constructor TIdX509Name.Create(aX509Name: PX509_NAME);
begin
  Inherited Create;

  FX509Name := aX509Name;
end;


///////////////////////////////////////////////////////////////
//  X509 Certificate
///////////////////////////////////////////////////////////////

{ TIdX509 }

constructor TIdX509.Create(aX509: PX509);
begin
  inherited Create;

  FX509 := aX509;
  FSubject := nil;
  FIssuer := nil;
end;

destructor TIdX509.Destroy;
begin
  if Assigned(FSubject) then FSubject.Destroy;
  if Assigned(FIssuer) then FIssuer.Destroy;

  inherited Destroy;
end;

function TIdX509.RSubject: TIdX509Name;
var
  x509_name: PX509_NAME;
Begin
  if not Assigned(FSubject) then begin
    if FX509<>nil then
      x509_name := IdSslX509GetSubjectName(FX509)
    else
      x509_name := nil;
    FSubject := TIdX509Name.Create(x509_name);
  end;
  Result := FSubject;
end;

function TIdX509.RIssuer: TIdX509Name;
var
  x509_name: PX509_NAME;
begin
  if not Assigned(FIssuer) then begin
    if FX509<>nil then
      x509_name := IdSslX509GetIssuerName(FX509)
    else
      x509_name := nil;
    FIssuer := TIdX509Name.Create(x509_name);
  End;
  Result := FIssuer;
end;

function TIdX509.RFingerprint: TEVP_MD;
begin
  IdSslX509Digest(FX509, IdSslEvpMd5, PChar(@Result.MD), @Result.Length);
end;

function TIdX509.RFingerprintAsString: String;
var
  I: Integer;
  EVP_MD: TEVP_MD;
begin
  Result := '';
  EVP_MD := Fingerprint;
  for I := 0 to EVP_MD.Length - 1 do begin
    if I <> 0 then Result := Result + ':';    {Do not Localize}
    Result := Result + Format('%.2x', [Byte(EVP_MD.MD[I])]);  {do not localize}
  end;
end;

function TIdX509.RnotBefore:TDateTime;
begin
  if FX509=nil then
    Result := 0
  else
    Result := UTCTime2DateTime(IdSslX509GetNotBefore(FX509));
end;


function TIdX509.RnotAfter:TDateTime;
begin
  if FX509=nil then
    Result := 0
  else
    Result := UTCTime2DateTime(IdSslX509GetNotAfter(FX509));
end;

///////////////////////////////////////////////////////////////
//  TIdSSLCipher
///////////////////////////////////////////////////////////////
constructor TIdSSLCipher.Create(AOwner: TIdSSLSocket);
begin
  inherited Create;

  FSSLSocket := AOwner;
end;

destructor TIdSSLCipher.Destroy;
begin
  inherited Destroy;
end;

function TIdSSLCipher.GetDescription;
var
  Buf: Array[0..1024] of Char;
begin
  Result := StrPas(IdSSLCipherDescription(IdSSLGetCurrentCipher(FSSLSocket.fSSL), @Buf[0], SizeOf(Buf)-1));
end;

function TIdSSLCipher.GetName:String;
begin
  Result := StrPas(IdSSLCipherGetName(IdSSLGetCurrentCipher(FSSLSocket.fSSL)));
end;

function TIdSSLCipher.GetBits:Integer;
begin
  IdSSLCipherGetBits(IdSSLGetCurrentCipher(FSSLSocket.fSSL), @Result);
end;

function TIdSSLCipher.GetVersion:String;
begin
  Result := StrPas(IdSSLCipherGetVersion(IdSSLGetCurrentCipher(FSSLSocket.fSSL)));
end;

initialization
  // Let's load the library    {Do not Localize}
  //if DLLLoadCount <= 0 then begin
   {
  	if not LoadOpenSLLibrary then begin
    	raise EIdException.Create(RSOSSLCouldNotLoadSSLLibrary);
    end;
   }
  //end;
  //Inc(DLLLoadCount);

finalization
  // if DLLLoadCount = 0 then begin
  UnLoadOpenSLLibrary;
  // end;
end.