Convert this php digital signing to Delphi

Question

I would like to rewrite this php digital signing function into Delphi code.

  function SaySig() {

  $privKeyFilePath = \"c:\\temp\\myrsakey.pem\";

  $dat         


        

Answer 1

Try this.
I don't claim it's perfect code(!) but it compiles :-)   and gives the same result you've quoted. Uses the OpenSSL API from M Ferrante that you mention above. A lot of the stuff it does you would normally only do once at startup - such as load private key, InitSSL etc. I use the Jedi JCL for base64 stuff - it's more straightforward.
Also some of this looks a bit odd (uses TBytes where PChar would do etc etc) as I originally wrote it using my modified Delphi 2010 API headers but then realised you were using D2007 and TEncoding wasn't available and a few mods were needed.
(SignStringToBase64 is the main call, right at the bottom of the listing)

uses libeay32, jclmime;

const
  LIBEAY_DLL_NAME = 'libeay32.dll';

// These aren't defined in the original libeay32.pas file
procedure EVP_MD_CTX_init(ctx: PEVP_MD_CTX); cdecl; external LIBEAY_DLL_NAME;
function EVP_MD_CTX_cleanup(ctx: PEVP_MD_CTX): integer; cdecl; external LIBEAY_DLL_NAME;

procedure InitSSL;
begin
  OpenSSL_add_all_algorithms;
  OpenSSL_add_all_ciphers;
  OpenSSL_add_all_digests;
  ERR_load_crypto_strings;
  // Seed the pseudo-random number generator
  // This should be something a little more "random"!
  RAND_load_file('c:\windows\paint.exe', 512);
end;

procedure FinalizeSSL;
begin
  EVP_cleanup;
end;

function GetSSLErrorMessage: string;
const
  BUFF_SIZE = 128; // OpenSSL docs state should be >= 120 bytes
var
  err: TBytes;
begin
  SetLength(err, BUFF_SIZE);
  ERR_error_string(ERR_get_error, @err[0]);
  result := string(err);
end;

function RSALoadPrivateKey(const AFileName, APassPhrase: string): PRSA;
var
  bp: pBIO;
  fn, pp: PAnsiChar;
  pk: PRSA;
begin
  fn := PAnsiChar(AnsiString(AFileName));
  pp := PAnsiChar(AnsiString(APassPhrase));
  bp := BIO_new(BIO_s_file());
  BIO_read_filename(bp, fn);
  pk := nil;
  result := PEM_read_bio_RSAPrivateKey(bp, pk, nil, pp);
  if result = nil then
    raise Exception.Create('Private key failure.' + GetSSLErrorMessage);
end;

function LoadPrivateKey(const AFileName, APass: string): PEVP_PKEY;
var
  rkey: PRSA;
begin
  rkey := RSALoadPrivateKey(AFileName, APass);
  result := EVP_PKEY_new;
  EVP_PKEY_assign(result, EVP_PKEY_RSA, rkey);
end;

procedure CleanUpKey(AKey: PEVP_PKEY);
begin
  if (AKey <> nil) then
  begin
    EVP_PKEY_free(AKey);
    // The OpenSSL docs state that the related rsa key will also
    // be freed when the parent key is freed
  end;
end;

function EVPSign(ASource: TBytes; const APrivateKey: PEVP_PKEY): TBytes;
var
  keysize: integer;
  ks: cardinal;
  ctx: EVP_MD_CTX;
begin
  keysize := EVP_PKEY_size(APrivateKey);
  SetLength(result, keysize);

  EVP_MD_CTX_init(@ctx);
  try
    EVP_SignInit(@ctx, EVP_sha1);
    EVP_SignUpdate(@ctx, @ASource[0], Length(ASource));
    EVP_SignFinal(@ctx, @result[0], ks, APrivateKey);
    SetLength(result, ks);
  finally
    EVP_MD_CTX_cleanup(@ctx);
  end;
end;

function Base64EncodeBytes(Input: TBytes): string;
var
  b64: TBytes;
begin
  SetLength(b64, jclMime.MimeEncodedSizeNoCRLF(Length(Input)));
  jclMime.MimeEncodeNoCRLF(Input[0], Length(Input), b64[0]);
  result := string(b64);
end;

function SignStringToBase64(const AText: string): string;
var
  key: PEVP_PKEY;
  src, enc: TBytes;
begin
  InitSSL;
  try
    key := LoadPrivateKey('c:\temp\priv-key.pem', '');
    try
      SetLength(src, Length(AText)); 
      CopyMemory(@src[0], @AText, Length(AText));           
      enc := EVPSign(src, key);
      result := Base64EncodeBytes(enc);
    finally
      CleanUpKey(key);
    end;
  finally
    FinalizeSSL;
  end;
end;