lbdsa.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 ***** *)
{*********************************************************}
{*                  LBDSA.PAS 2.07                       *}
{*     Copyright (c) 2002 TurboPower Software Co         *}
{*                 All rights reserved.                  *}
{*********************************************************}

{$I LockBox.inc}

unit LbDSA;
  {-DSA signature component and key classes}
                                                              
interface

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

type
  TLbDSABlock = array[0..cBytes160-1] of Byte;   { same as TSHA1Digest }

type
  TLbGetDSABlockEvent = procedure(Sender : TObject; var Block : TLbDSABlock) of object;
  TLbDSACallback = procedure(var Abort : Boolean) of object;

{ TLbDSAParameters }
type
  TLbDSAParameters = class(TLbAsymmetricKey)
    protected
      FP : TLbBigInt;
      FQ : TLbBigInt;
      FG : TLbBigInt;
      F2Tog : TLbBigInt;
      FMostLeast : TLbBigInt;
      FPrimeTestIterations : Byte;
      FCallback : TLbDSACallback;
      function GenerateP(const ASeed : TLbDSABlock) : Boolean;
      function GenerateQ(const ASeed : TLbDSABlock) : Boolean;
      function GenerateG : Boolean;
      function GetPAsString : string;
      procedure SetPAsString(const Value : string);
      function GetQAsString : string;
      procedure SetQAsString(const Value : string);
      function GetGAsString : string;
      procedure SetGAsString(const Value : string);
      procedure SetKeySize(Value : TLbAsymKeySize); override;
    public {methods}
      constructor Create(aKeySize : TLbAsymKeySize); override;
      destructor Destroy; override;
      procedure Clear; virtual;
      procedure CopyDSAParameters(AKey : TLbDSAParameters);
      function GenerateDSAParameters(const ASeed : TLbDSABlock) : Boolean;
    public {properties}
      property P : TLbBigInt
        read FP;
      property Q : TLbBigInt
        read FQ;
      property G : TLbBigInt
        read FG;
      property PAsString : string
        read GetPAsString write SetPAsString;
      property QAsString : string
        read GetQAsString write SetQAsString;
      property GAsString : string
        read GetGAsString write SetGAsString;
      property PrimeTestIterations : Byte
        read FPrimeTestIterations write FPrimeTestIterations;
      property Callback : TLbDSACallback
        read FCallback write FCallback;
   end;


{ TLbDSAPrivateKey }
type
  TLbDSAPrivateKey = class(TLbDSAParameters)
    protected {private}
      FX    : TLbBigInt;
      FXKey : TLbDSABlock;
      function GetXAsString : string;
      procedure SetXAsString(const Value : string);

{!!.06}
      function  CreateASNKey(Input : pByteArray; Length : Integer) : Integer; override;
      function ParseASNKey(Input : pByte; Length : Integer) : boolean; override;
{!!.06}

    public {methods}
      constructor Create(aKeySize : TLbAsymKeySize); override;
      destructor Destroy; override;
      procedure Clear; override;
      procedure GenerateX(const AXKey : TLbDSABlock);
    public {properties}
      property X : TLbBigInt
        read FX;
      property XAsString : string
        read GetXAsString write SetXAsString;
   end;


{ TLbDSAPublicKey }
type
  TLbDSAPublicKey = class(TLbDSAParameters)
    protected {private}
      FY : TLbBigInt;
      function GetYAsString : string;
      procedure SetYAsString(const Value : string);

{!!.06}
      function  CreateASNKey(Input : pByteArray; Length : Integer) : Integer; override;
      function ParseASNKey(Input : pByte; Length : Integer) : boolean; override;
{!!.06}

    public {methods}
      constructor Create(aKeySize : TLbAsymKeySize); override;
      destructor Destroy; override;
      procedure Clear; override;
      procedure GenerateY(aX : TLbBigInt);
    public {properties}
      property Y : TLbBigInt
        read FY;
      property YAsString : string
        read GetYAsString write SetYAsString;
   end;


{ TLbDSA }
type
  TLbDSA = class(TLbSignature)
    protected {private}
      FPrivateKey : TLbDSAPrivateKey;
      FPublicKey : TLbDSAPublicKey;
      FPrimeTestIterations : Byte;
      FSignatureR : TLbBigInt;
      FSignatureS : TLbBigInt;
      FOnGetR     : TLbGetDSABlockEvent;
      FOnGetS     : TLbGetDSABlockEvent;
      FOnGetSeed  : TLbGetDSABlockEvent;
      FOnGetXKey  : TLbGetDSABlockEvent;
      FOnGetKKey  : TLbGetDSABlockEvent;
      FRandomSeed : Boolean;
      procedure SignHash(const ADigest : TSHA1Digest);
      function VerifyHash(const ADigest : TSHA1Digest) : Boolean;
      procedure SHA1KKey(var AKKey : TLbDSABlock);
      procedure RandomBlock(var ABlock : TLbDSABlock);
      procedure DoGetR;
      procedure DoGetS;
      procedure DoGetSeed(var ASeed : TLbDSABlock);
      procedure DoGetXKey(var AXKey : TLbDSABlock);
      procedure DoGetKKey(var AKKey : TLbDSABlock);
      procedure SetKeySize(Value : TLbAsymKeySize); override;
      procedure SetPrimeTestIterations(Value : Byte);
      procedure DSAParameterCallback(var Abort : Boolean);
    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;

      procedure Clear;
      function GeneratePQG : Boolean;
      procedure GenerateXY;

    public {properties}
      property PrivateKey : TLbDSAPrivateKey
        read FPrivateKey;
      property PublicKey : TLbDSAPublicKey
        read FPublicKey;
      property SignatureR : TLbBigInt
        read FSignatureR;
      property SignatureS : TLbBigInt
        read FSignatureS;

    published {properties}
      property PrimeTestIterations : Byte
        read FPrimeTestIterations write SetPrimeTestIterations;
      property KeySize;

    published {events}
      property OnGetR : TLbGetDSABlockEvent
        read FOnGetR write FOnGetR;
      property OnGetS : TLbGetDSABlockEvent
        read FOnGetS write FOnGetS;
      property OnGetSeed : TLbGetDSABlockEvent
        read FOnGetSeed write FOnGetSeed;
      property OnGetXKey : TLbGetDSABlockEvent
        read FOnGetXKey write FOnGetXKey;
      property OnGetKKey : TLbGetDSABlockEvent
        read FOnGetKKey write FOnGetKKey;
      property OnProgress : TLbProgressEvent
        read FOnProgress write FOnProgress;
    end;


implementation

uses
  LbProc, LbUtils;


const
  { 5 magic numbers for SHA-1 }
  SHA1_A = DWORD( $67452301 );
  SHA1_B = DWORD( $EFCDAB89 );
  SHA1_C = DWORD( $98BADCFE );
  SHA1_D = DWORD( $10325476 );
  SHA1_E = DWORD( $C3D2E1F0 );

  cZeroBlock : TLbDSABlock =
    (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0);


{ == TLbDSAParameters =================================================== }
constructor TLbDSAParameters.Create(aKeySize : TLbAsymKeySize);
  { initialization }
begin
  inherited Create(aKeySize);
  FP := TLbBigInt.Create(cLbAsymKeyBytes[FKeySize]);
  FQ := TLbBigInt.Create(SizeOf(TLbDSABlock));
  FG := TLbBigInt.Create(cLbAsymKeyBytes[FKeySize]);

  { constant: 2^160 }
  F2Tog := TLbBigInt.Create(SizeOf(TLbDSABlock));
  F2Tog.CopyByte(1);
  F2Tog.Shl_(SizeOf(TLbDSABlock) * 8);

    { constant: 2^159 + 1 }
  FMostLeast := TLbBigInt.Create(SizeOf(TLbDSABlock));
  FMostLeast.Copy(F2Tog);
  FMostLeast.Shr_(1);
  FMostLeast.AddByte(1);

  FPrimeTestIterations := cDefIterations;
end;
{ -------------------------------------------------------------------------- }
destructor TLbDSAParameters.Destroy;
  { finalization }
begin
  FP.Free;
  FQ.Free;
  FG.Free;
  F2Tog.Free;
  FMostLeast.Free;
  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSAParameters.Clear;
  { reset everything }
begin
  FP.Clear;
  FQ.Clear;
  FG.Clear;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSAParameters.SetKeySize(Value : TLbAsymKeySize);
  { DSA key must be between 512 and 1024 bits }
begin
  if (Value <> FKeySize) then begin
    if (Ord(Value) >= Ord(aks512)) and (Ord(Value) <= Ord(aks1024)) then
      FKeySize := Value
    else
      FKeySize := cLbDefAsymKeySize;
    FP.Clear;
    FQ.Clear;
    FG.Clear;
  end;
end;
{ -------------------------------------------------------------------------- }
function TLbDSAParameters.GetPAsString : string;
  { return "big to little" hex string representation of p }
begin
  Result := FP.IntStr;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSAParameters.SetPAsString(const Value : string);
  { set p to value represented by "big to little" hex string }
var
  Buf : array[Byte] of Byte;
begin
  FillChar(Buf, SizeOf(Buf), #0);
  HexToBuffer(Value, Buf, cLbAsymKeyBytes[FKeySize]);
  FP.CopyBuffer(Buf, cLbAsymKeyBytes[FKeySize]);
  FP.Trim;
end;
{ -------------------------------------------------------------------------- }
function TLbDSAParameters.GetQAsString : string;
  { return "big to little" hex string representation of q }
begin
  Result := FQ.IntStr;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSAParameters.SetQAsString(const Value : string);
  { set q to value represented by "big to little" hex string }
var
  Buf : TLbDSABlock;
begin
  FillChar(Buf, SizeOf(Buf), #0);
  HexToBuffer(Value, Buf, SizeOf(Buf));
  FQ.CopyBuffer(Buf, SizeOf(Buf));
  FQ.Trim;
end;
{ -------------------------------------------------------------------------- }
function TLbDSAParameters.GetGAsString : string;
  { return "big to little" hex string representation of g }
begin
  Result := FG.IntStr;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSAParameters.SetGAsString(const Value : string);
  { set g to value represented by "big to little" hex string }
var
  Buf : array[Byte] of Byte;
begin
  FillChar(Buf, SizeOf(Buf), #0);
  HexToBuffer(Value, Buf, cLbAsymKeyBytes[FKeySize]);
  FG.CopyBuffer(Buf, cLbAsymKeyBytes[FKeySize]);
  FG.Trim;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSAParameters.CopyDSAParameters(aKey : TLbDSAParameters);
  { assign paramters p, q, and g from another key }
begin
  FP.Copy(aKey.P);
  FQ.Copy(aKey.Q);
  FG.Copy(aKey.G);
end;
{ -------------------------------------------------------------------------- }
function TLbDSAParameters.GenerateDSAParameters(const ASeed : TLbDSABlock) : Boolean;
  { generate paramaters p, q, and g }
begin
  Result := GenerateQ(ASeed);
  if Result then
    Result := GenerateP(ASeed);
  if Result then
    Result := GenerateG;
end;
{ -------------------------------------------------------------------------- }
function TLbDSAParameters.GenerateQ(const ASeed : TLbDSABlock) : Boolean;
  { generate parameter q }
const
  MaxTries = 4096;                                                   {!!.06}
var