lbrsa.pas

tool pour ubuntu 8.10

(* ***** BEGIN LICENSE BLOCK *****
 * Version: MPL 1.1
 *
 * The contents of this file are subject to the Mozilla Public License Version
 * 1.1 (the "License"); you may not use this file except in compliance with
 * the License. You may obtain a copy of the License at
 * http://www.mozilla.org/MPL/
 *
 * Software distributed under the License is distributed on an "AS IS" basis,
 * WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
 * for the specific language governing rights and limitations under the
 * License.
 *
 * The Original Code is TurboPower LockBox
 *
 * The Initial Developer of the Original Code is
 * TurboPower Software
 *
 * Portions created by the Initial Developer are Copyright (C) 1997-2002
 * the Initial Developer. All Rights Reserved.
 *
 * Contributor(s):
 *
 * ***** END LICENSE BLOCK ***** *)
{*********************************************************}
{*                  LBRSA.PAS 2.07                       *}
{*     Copyright (c) 2002 TurboPower Software Co         *}
{*                 All rights reserved.                  *}
{*********************************************************}

{$I LockBox.inc}

unit LbRSA;
  {-RSA encryption and signature components, classes, and routines}

interface

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
{$IFDEF UsingCLX}
  Types,
{$ENDIF}
{$IFDEF LINUX}
  Libc,
{$ENDIF}
  Classes,
  SysUtils,
  LbBigInt,
  LbAsym,
  LbCipher,
  LbConst;


const
  { cipher block size constants }                                    {!!.02}
  cRSAMinPadBytes = 11;
  cRSACipherBlockSize : array[TLbAsymKeySize] of Word =
    (cBytes128, cBytes256, cBytes512, cBytes768, cBytes1024);
  cRSAPlainBlockSize : array[TLbAsymKeySize] of Word =
    (cBytes128-cRSAMinPadBytes, cBytes256-cRSAMinPadBytes,
     cBytes512-cRSAMinPadBytes, cBytes768-cRSAMinPadBytes,
     cBytes1024-cRSAMinPadBytes);

type
  { ciphertext block types }                                         {!!.02}
  PRSACipherBlock128 = ^TRSACipherBlock128;
  TRSACipherBlock128 = array[0..cBytes128-1] of Byte;
  PRSACipherBlock256 = ^TRSACipherBlock256;
  TRSACipherBlock256 = array[0..cBytes256-1] of Byte;
  PRSACipherBlock512 = ^TRSACipherBlock512;
  TRSACipherBlock512 = array[0..cBytes512-1] of Byte;
  PRSACipherBlock768 = ^TRSACipherBlock768;
  TRSACipherBlock768 = array[0..cBytes768-1] of Byte;
  PRSACipherBlock1024 = ^TRSACipherBlock1024;
  TRSACipherBlock1024 = array[0..cBytes1024-1] of Byte;

  { plaintext block types }                                          {!!.02}
  PRSAPlainBlock128 = ^TRSAPlainBlock128;
  TRSAPlainBlock128 = array[0..cBytes128-12] of Byte;
  PRSAPlainBlock256 = ^TRSAPlainBlock256;
  TRSAPlainBlock256 = array[0..cBytes256-12] of Byte;
  PRSAPlainBlock512 = ^TRSAPlainBlock512;
  TRSAPlainBlock512 = array[0..cBytes512-12] of Byte;
  PRSAPlainBlock768 = ^TRSAPlainBlock768;
  TRSAPlainBlock768 = array[0..cBytes768-12] of Byte;
  PRSAPlainBlock1024 = ^TRSAPlainBlock1024;
  TRSAPlainBlock1024 = array[0..cBytes1024-12] of Byte;

  { default block type }
  TRSAPlainBlock  = TRSAPlainBlock512;
  TRSACipherBlock = TRSACipherBlock512;

  { signature types }
  TRSASignatureBlock = array[0..cBytes1024-1] of Byte;
  TRSAHashMethod  = (hmMD5, hmSHA1);


type
  TLbRSAGetSignatureEvent = procedure(Sender : TObject;
                                      var Sig : TRSASignatureBlock) of object;
  TLbRSACallback = procedure(var Abort : Boolean) of object;


{ TLbRSAKey }
type
  TLbRSAKey = class(TLbAsymmetricKey)
    protected {private}
      FModulus  : TLbBigInt;
      FExponent : TLbBigInt;
      function ParseASNKey(Input : pByte; Length : Integer) : boolean; override;
      function  CreateASNKey(Input : pByteArray; Length : Integer) : Integer; override;
      function GetModulusAsString : string;
      procedure SetModulusAsString(Value : string);
      function GetExponentAsString : string;
      procedure SetExponentAsString(Value : string);

    public
      constructor Create(aKeySize : TLbAsymKeySize); override;
      destructor Destroy; override;

      procedure Assign(aKey : TLbAsymmetricKey); override;
      procedure Clear;

      property Modulus : TLbBigInt
        read FModulus;
      property ModulusAsString : string
        read GetModulusAsString write SetModulusAsString;
      property Exponent : TLbBigInt
        read FExponent;
      property ExponentAsString : string
        read GetExponentAsString write SetExponentAsString;
      property Passphrase : string
        read FPassphrase write FPassphrase;
  end;


{ TLbRSA }
type
  TLbRSA = class(TLbAsymmetricCipher)
    protected {private}
      FPrivateKey : TLbRSAKey;
      FPublicKey : TLbRSAKey;
      FPrimeTestIterations : Byte;
      procedure SetKeySize(Value : TLbAsymKeySize); override;
    public {methods}
      constructor Create(AOwner : TComponent); override;
      destructor Destroy; override;
      procedure DecryptFile(const InFile, OutFile : string); override;
      procedure DecryptStream(InStream , OutStream : TStream); override;
      function  DecryptString(const InString : string) : string; override;
      procedure EncryptFile(const InFile, OutFile : string); override;
      procedure EncryptStream(InStream, OutStream : TStream); override;
      function  EncryptString(const InString : string) : string; override;
      procedure GenerateKeyPair; override;
      function  OutBufSizeNeeded(InBufSize : Cardinal) : Cardinal; override;
      procedure RSACallback(var Abort : Boolean);
    public {properties}
      property PrivateKey : TLbRSAKey
        read FPrivateKey;
      property PublicKey : TLbRSAKey
        read FPublicKey;
    published {properties}
      property PrimeTestIterations : Byte
        read FPrimeTestIterations write FPrimeTestIterations;
      property KeySize;
    published {events}
      property OnProgress;
  end;


{ TLbRSASSA }
type
  TLbRSASSA = class(TLbSignature)
    protected {private}
      FPrivateKey : TLbRSAKey;
      FPublicKey : TLbRSAKey;
      FHashMethod : TRSAHashMethod;
      FPrimeTestIterations : Byte;
      FSignature  : TLbBigInt;
      FOnGetSignature : TLbRSAGetSignatureEvent;
      procedure DoGetSignature;
      procedure EncryptHash(const HashDigest; DigestLen : Cardinal);
      procedure DecryptHash(var HashDigest; DigestLen : Cardinal);
      procedure RSACallback(var Abort : Boolean);
      procedure SetKeySize(Value : TLbAsymKeySize); override;

    public {methods}
      constructor Create(AOwner : TComponent); override;
      destructor Destroy; override;

      procedure GenerateKeyPair; override;
      procedure SignBuffer(const Buf; BufLen : Cardinal); override;
      procedure SignFile(const AFileName : string);  override;
      procedure SignStream(AStream : TStream); override;
      procedure SignString(const AStr : string); override;

      function  VerifyBuffer(const Buf; BufLen : Cardinal) : Boolean; override;
      function  VerifyFile(const AFileName : string) : Boolean; override;
      function  VerifyStream(AStream : TStream) : Boolean; override;
      function  VerifyString(const AStr : string) : Boolean; override;

    public {properties}
      property PrivateKey : TLbRSAKey
        read FPrivateKey;
      property PublicKey : TLbRSAKey
        read FPublicKey;
      property Signature : TLbBigInt
        read FSignature;

    published {properties}
      property HashMethod : TRSAHashMethod
        read FHashMethod write FHashMethod;
      property PrimeTestIterations : Byte
        read FPrimeTestIterations write FPrimeTestIterations;
      property KeySize;

    published {events}
      property OnGetSignature : TLbRSAGetSignatureEvent
        read FOnGetSignature write FOnGetSignature;
      property OnProgress;
    end;


{ low level RSA cipher public routines }

{ new public routines }                                              {!!.02}
function EncryptRSAEx(PublicKey : TLbRSAKey; pInBlock, pOutBlock : PByteArray;
           InDataSize : Integer) : Longint;
function DecryptRSAEx(PrivateKey : TLbRSAKey;
           pInBlock, pOutBlock : PByteArray) : Longint;
function  EncryptRSA128(PublicKey : TLbRSAKey; const InBlock : TRSAPlainBlock128;
            var OutBlock : TRSACipherBlock128) : Longint;
function  DecryptRSA128(PrivateKey : TLbRSAKey; const InBlock : TRSACipherBlock128;
            var OutBlock : TRSAPlainBlock128) : Longint;
function  EncryptRSA256(PublicKey : TLbRSAKey; const InBlock : TRSAPlainBlock256;
            var OutBlock : TRSACipherBlock256) : Longint;
function  DecryptRSA256(PrivateKey : TLbRSAKey; const InBlock : TRSACipherBlock256;
            var OutBlock : TRSAPlainBlock256) : Longint;
function  EncryptRSA512(PublicKey : TLbRSAKey; const InBlock : TRSAPlainBlock512;
            var OutBlock : TRSACipherBlock512) : Longint;
function  DecryptRSA512(PrivateKey : TLbRSAKey; const InBlock : TRSACipherBlock512;
            var OutBlock : TRSAPlainBlock512) : Longint;
function  EncryptRSA768(PublicKey : TLbRSAKey; const InBlock : TRSAPlainBlock768;
            var OutBlock : TRSACipherBlock768) : Longint;
function  DecryptRSA768(PrivateKey : TLbRSAKey; const InBlock : TRSACipherBlock768;
            var OutBlock : TRSAPlainBlock768) : Longint;
function  EncryptRSA1024(PublicKey : TLbRSAKey; const InBlock : TRSAPlainBlock1024;
            var OutBlock : TRSACipherBlock1024) : Longint;
function  DecryptRSA1024(PrivateKey : TLbRSAKey; const InBlock : TRSACipherBlock1024;
            var OutBlock : TRSAPlainBlock1024) : Longint;
{!!.02}

function  EncryptRSA(PublicKey : TLbRSAKey; const InBlock : TRSAPlainBlock;
            var OutBlock : TRSACipherBlock) : Longint;
function  DecryptRSA(PrivateKey : TLbRSAKey; const InBlock : TRSACipherBlock;
            var OutBlock : TRSAPlainBlock) : Longint;
procedure RSAEncryptFile(const InFile, OutFile : string;
            Key : TLbRSAKey; Encrypt : Boolean);
procedure RSAEncryptStream(InStream, OutStream : TStream;
            Key : TLbRSAKey; Encrypt : Boolean);
function RSAEncryptString(const InString : string;
            Key : TLbRSAKey; Encrypt : Boolean) : string;
procedure GenerateRSAKeysEx(var PrivateKey, PublicKey : TLbRSAKey;
            KeySize : TLbAsymKeySize; PrimeTestIterations : Byte;
            Callback : TLbRSACallback);
procedure GenerateRSAKeys(var PrivateKey, PublicKey : TLbRSAKey);


implementation

uses
  LbUtils, LbString, LbProc;

const
  cDefHashMethod  = hmMD5;

type
  TRSABlockType = (bt00, bt01, bt02);



{ == Local RSA routines ==================================================== }
procedure RSADecodeBlock(biBlock : TLbBigInt);
var
  i : DWord;
  Buf : TRSAPlainBlock1024;
begin
  { verify block format }
  i := biBlock.Size;
  if (i < cRSAMinPadBytes) then
    raise Exception.Create(sRSADecodingErrBTS);
  if (i > cBytes1024) then
    raise Exception.Create(sRSADecodingErrBTL);
  if (biBlock.GetByteValue(i) <> Byte(bt01)) and (biBlock.GetByteValue(i) <> Byte(bt02)) then
    raise Exception.Create(sRSADecodingErrIBT);
  Dec(i);

  { count padding bytes }
  while (biBlock.GetByteValue(i) <> 0) do begin
    Dec(i);
    if (i <= 0) then
    raise Exception.Create(sRSADecodingErrIBF);
  end;

  { strip off padding bytes }
  biBlock.ToBuffer(Buf, i-1);
  biBlock.CopyBuffer(Buf, i-1);
end;
{ -------------------------------------------------------------------------- }
procedure RSAFormatBlock(biBlock : TLbBigInt; BlockType : TRSABlockType);
begin
  if (biBlock.Int.IntBuf.dwLen - biBlock.Int.dwUsed) < 11 then       {!!.02}
    raise Exception.Create(sRSAEncodingErr);                         {!!.02}

  { separate data from padding }
  biBlock.AppendByte($00);

  { append padding }
  while (biBlock.Int.IntBuf.dwLen - biBlock.Int.dwUsed) > 2 do begin {!!.02}
    if (BlockType = bt01) then
      biBlock.AppendByte(Byte($FF))
    else
      biBlock.AppendByte(Byte(Random($FD) + 1));
  end;

  { append tag }
  if (BlockType = bt01) then
    biBlock.AppendByte($01)
  else
    biBlock.AppendByte($02);

  { last byte always 0 }
  biBlock.AppendByte($00);
end;
{ -------------------------------------------------------------------------- }
procedure RSAEncryptBigInt(biBlock : TLbBigInt; Key : TLbRSAKey;
                          BlockType : TRSABlockType; Encrypt : Boolean);
var
  dwSize, dwLen : DWORD;
  tmp1, tmp2 : TLbBigInt;
begin
  tmp1 := TLbBigInt.Create(cLbAsymKeyBytes[Key.KeySize]);
  tmp2 := TLbBigInt.Create(cLbAsymKeyBytes[Key.KeySize]);

  try
    if Encrypt then
      RSAFormatBlock(biBlock, BlockType);
    tmp1.Copy(biBlock);
    dwSize := tmp1.Size;
    biBlock.Clear;
    repeat
      dwLen := Min(dwSize, Key.Modulus.Size);
      tmp2.CopyLen(tmp1, dwLen);
      tmp2.PowerAndMod(Key.Exponent, Key.Modulus);

      biBlock.Append(tmp2);
      tmp1.Shr_(dwLen * 8);
      dwSize := dwSize - dwLen;
    until (dwSize <= 0);

    if Encrypt then                                                  {!!.02}
      { replace leading zeros that were trimmed in the math }        {!!.02}
      while (biBlock.Size < cLbAsymKeyBytes[Key.KeySize]) do         {!!.02}
        biBlock.AppendByte($00)                                      {!!.02}
    else                                                             {!!.02}
      RSADecodeBlock(biBlock);

  finally
    tmp1.Free;
    tmp2.Free;
  end;
end;


{ == Public RSA routines =================================================== }
procedure GenerateRSAKeys(var PrivateKey, PublicKey : TLbRSAKey);
  { create RSA public/private key pair with default settings }
begin
  GenerateRSAKeysEx(PrivateKey, PublicKey, cLbDefAsymKeySize, cDefIterations, nil);
end;
{ -------------------------------------------------------------------------- }
procedure GenerateRSAKeysEx(var PrivateKey, PublicKey : TLbRSAKey;
                            KeySize : TLbAsymKeySize;
                            PrimeTestIterations : Byte;
                            Callback : TLbRSACallback);
  { create RSA key pair speciying size and prime test iterations and }
  { callback function }
var
  q : TLbBigInt;
  p : TLbBigInt;
  p1q1 : TLbBigInt;
  d : TLbBigInt;
  e : TLbBigInt;
  n : TLbBigInt;
  Abort : Boolean;
begin
  PrivateKey := TLbRSAKey.Create(KeySize);
  PublicKey := TLbRSAKey.Create(KeySize);

  { create temp variables }
  p1q1 := TLbBigInt.Create(cLbAsymKeyBytes[KeySize]);
  d := TLbBigInt.Create(cLbAsymKeyBytes[KeySize]);
  e := TLbBigInt.Create(cLbAsymKeyBytes[KeySize]);
  n := TLbBigInt.Create(cLbAsymKeyBytes[KeySize]);
  p := TLbBigInt.Create(cLbAsymKeyBytes[KeySize] div 2);
  q := TLbBigInt.Create(cLbAsymKeyBytes[KeySize] div 2);

  try
    Abort := False;