lbdsa.pas

tool pour ubuntu 8.10

  Max : Integer;
  pInput : PByte;
begin
  Max := Length;
  pInput := Input;

  { check for sequence }
  Tag := GetASN1StructNum(pInput, Max);
  GetASN1StructLen(pInput, Max);

  if (Tag <> ASN1_TYPE_SEQUENCE) then
    raise Exception.Create(sDSAKeyBadKey);

  ParseASN1(pInput, Max, FP);
  ParseASN1(pInput, Max, FQ);
  ParseASN1(pInput, Max, FG);
  ParseASN1(pInput, Max, FY);

  Result := (Max = 0);
end;


{ == TLbDSA ============================================================= }
constructor TLbDSA.Create(AOwner : TComponent);
  { initialization }
begin
  inherited Create(AOwner);

  FPrivateKey := TLbDSAPrivateKey.Create(FKeySize);
  FPrivateKey.Callback := DSAParameterCallback;
  FPublicKey  := TLbDSAPublicKey.Create(FKeySize);
  FPublicKey.Callback := DSAParameterCallback;
  FSignatureR := TLbBigInt.Create(SizeOf(TLbDSABlock));
  FSignatureS := TLbBigInt.Create(SizeOf(TLbDSABlock));
  FPrimeTestIterations := cDefIterations;
end;
{ -------------------------------------------------------------------------- }
destructor TLbDSA.Destroy;
  { finalization }
begin
  FPrivateKey.Free;
  FPublicKey.Free;
  FSignatureR.Free;
  FSignatureS.Free;

  inherited Destroy;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.Clear;
  { clear out everything }
begin
  FPrivateKey.Clear;
  FPublicKey.Clear;
  FSignatureR.Clear;
  FSignatureS.Clear;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.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;
    FPrivateKey.KeySize := FKeySize;
    FPublicKey.KeySize := FKeySize;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.SetPrimeTestIterations(Value : Byte);
  { set prime testing confidence level, 50 is plenty }
begin
  if (Value <> FPrimeTestIterations) then begin
    FPrimeTestIterations := Value;
    FPrivateKey.PrimeTestIterations := Value;
    FPublicKey.PrimeTestIterations := Value;
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.DSAParameterCallback(var Abort : Boolean);
  { pass callback on via OnProgress event }
begin
  Abort := False;
  if Assigned(FOnProgress) then
    FOnProgress(Self, Abort);
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.RandomBlock(var ABlock : TLbDSABlock);
  { fill block with random bytes }
begin
  with TLbRandomGenerator.Create do
    try
      RandomBytes(ABlock, SizeOf(ABlock));
    finally
      Free;
    end;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.DoGetSeed(var ASeed : TLbDSABlock);
  { fire OnGetSeed event to obtain seed, randomize if necessary }
begin
  FillChar(ASeed, SizeOf(ASeed), #0);
  if Assigned(FOnGetSeed) then
    FOnGetSeed(Self, ASeed);

  if CompareBuffers(ASeed, cZeroBlock, SizeOf(ASeed)) then
    RandomBlock(ASeed);
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.DoGetXKey(var AXKey : TLbDSABlock);
  { fire OnGetXKey event to obtain XKey, randomize if necessary }
begin
  FillChar(AXKey, SizeOf(AXKey), #0);
  if Assigned(FOnGetXKey) then
    FOnGetXKey(Self, AXKey);

  if CompareBuffers(AXKey, cZeroBlock, SizeOf(AXKey)) then
    RandomBlock(AXKey);
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.DoGetKKey(var AKKey : TLbDSABlock);
  { fire OnGetKKey event to obtain KKey, randomize if necessary }
begin
  FillChar(AKKey, SizeOf(AKKey), #0);
  if Assigned(FOnGetKKey) then
    FOnGetKKey(Self, AKKey);

  if CompareBuffers(AKKey, cZeroBlock, SizeOf(AKKey)) then
    RandomBlock(AKKey);
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.SHA1KKey(var AKKey : TLbDSABlock);
  { SHA(KKey) requires special magic number sequence }
var
  Context : TSHA1Context;
  Digest : TSHA1Digest;
begin
  Fillchar(Context, SizeOf(Context), #0);
  Context.sdHash[ 0 ] := SHA1_B;
  Context.sdHash[ 1 ] := SHA1_C;
  Context.sdHash[ 2 ] := SHA1_D;
  Context.sdHash[ 3 ] := SHA1_E;
  Context.sdHash[ 4 ] := SHA1_A;

  UpdateSHA1(Context, AKKey, SizeOf(AKKey));
  FinalizeSHA1(Context, Digest);
  Move(Digest, AKKey, SizeOf(AKKey));
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.DoGetR;
  { fire OnGetR event to obtain signature(R) }
var
  R : TLbDSABlock;
begin
  FillChar(R, SizeOf(R), #0);
  if Assigned(FOnGetR) then begin
    FOnGetR(Self, R);
    FSignatureR.CopyBuffer(R, SizeOf(R));
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.DoGetS;
  { fire OnGetS event to obtain signature(S) }
var
  S : TLbDSABlock;
begin
  FillChar(S, SizeOf(S), #0);
  if Assigned(FOnGetS) then begin
    FOnGetS(Self, S);
    FSignatureS.CopyBuffer(S, SizeOf(S));
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.GenerateKeyPair;
  { generate public and private key parameters p, q, g, x, and y }
begin
  GeneratePQG;
  GenerateXY;
end;
{ -------------------------------------------------------------------------- }
function TLbDSA.GeneratePQG : Boolean;
  { generate parameters p, q, and g }
var
  Seed : TLbDSABlock;
begin
  DoGetSeed(Seed);
  try
    Result := FPrivateKey.GenerateDSAParameters(Seed);
    if Result then
      FPublicKey.CopyDSAParameters(FPrivateKey);
  except
    raise Exception.Create(sDSAParametersPQGErr);
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.GenerateXY;
  { generate parameters x and y }
var
  XKey : TLbDSABlock;
begin
  DoGetXKey(XKey);
  try
    FPrivateKey.GenerateX(XKey);
    FPublicKey.GenerateY(FPrivateKey.X);
  except
    raise Exception.Create(sDSAParametersXYErr);
  end;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.SignHash(const ADigest : TSHA1Digest);
  { generate signature(r, s) of message hash }
var
  K : TLbBigInt;
  XR : TLbBigInt;
  KKey : TLbDSABlock;
begin
  K := TLbBigInt.Create(SizeOf(TLbDSABlock));
  XR := TLbBigInt.Create(SizeOf(TLbDSABlock));
  DoGetKKey(KKey);
  try
    K.CopyBuffer(KKey, SizeOf(KKey));
    K.Modulus(FPrivateKey.Q);                                        {!!.06}
    { r = (g^k mod p) mod q }
    with FSignatureR do begin
      Copy(FPrivateKey.G);
      PowerAndMod(K, FPrivateKey.P);
      Modulus(FPrivateKey.Q);
      if FSignatureR.IsZero then
        raise Exception.Create(sDSASignatureZeroR);
    end;

    { compute k^(-1) and xr }
    K.ModInv(FPrivateKey.Q);
    XR.Copy(FPrivateKey.X);
    XR.Multiply(FSignatureR);

    { s = (k^(-1)(SHA(M) + xr)) mod q }
    with FSignatureS do begin
      CopyBuffer(ADigest, SizeOf(ADigest));     { s = SHA(M) is big to little }
      ReverseBytes;                             { s -> little to big for math }
      Add(XR);
      Multiply(K);
      Modulus(FPrivateKey.Q);
      if FSignatureS.IsZero then
        raise Exception.Create(sDSASignatureZeroS);
    end;
  except
    K.Free;
    XR.Free;
    raise Exception.Create(sDSASignatureErr);
  end;
  K.Free;
  XR.Free;
end;
{ -------------------------------------------------------------------------- }
function TLbDSA.VerifyHash(const ADigest : TSHA1Digest) : Boolean;
  { verify signature(r, s) against message hash }
var
  W, U1, U2, V, V2 : TLbBigInt;
begin
  W  := TLbBigInt.Create(20);
  U1 := TLbBigInt.Create(20);
  U2 := TLbBigInt.Create(20);
  V  := TLbBigInt.Create(cLbAsymKeyBytes[FKeySize]);
  V2 := TLbBigInt.Create(cLbAsymKeyBytes[FKeySize]);
  DoGetR;
  DoGetS;
  try
    { w = s^(-1) mod q }
    with W do begin
      Copy(FSignatureS);
      ModInv(FPublicKey.Q);
    end;

    { u1 = (SHA(M)*w) mod q }
    with U1 do begin
      CopyBuffer(ADigest, SizeOf(ADigest));    { U1 = SHA(M) is big to little }
      ReverseBytes;                            { U1 -> little to big for math }
      Multiply(W);
      Modulus(FPublicKey.Q);
    end;

    { u2 = (r*w) mod q }
    with U2 do begin
      Copy(FSignatureR);
      Multiply(W);
      Modulus(FPublicKey.Q);
    end;

    { v = ((g^u1 * y^u2) mod p) mod q }
    V.Copy(FPublicKey.Y);
    V.PowerAndMod(U2, FPublicKey.P);
    V2.Copy(FPublicKey.G);
    V2.PowerAndMod(U1, FPublicKey.P);
    V.Multiply(V2);
    V.Modulus(FPublicKey.P);
    V.Modulus(FPublicKey.Q);

    { signature valid when v = r }
    Result := V.Compare(FSignatureR) = cEQUAL_TO;
  except
    Result := False;
  end;
  W.Free;
  U1.Free;
  U2.Free;
  V.Free;
  V2.Free;
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.SignBuffer(const Buf; BufLen : Cardinal);
  { generate DSA signature of buffer data }
var
  Digest : TSHA1Digest;
begin
  HashSHA1(Digest, Buf, BufLen);
  SignHash(Digest);
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.SignFile(const AFileName : string);
  { generate DSA signature of file data }
var
  Digest : TSHA1Digest;
begin
  FileHashSHA1(Digest, AFileName);
  SignHash(Digest);
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.SignStream(AStream : TStream);
  { generate DSA signature of stream data }
var
  Digest : TSHA1Digest;
begin
  StreamHashSHA1(Digest, AStream);
  SignHash(Digest);
end;
{ -------------------------------------------------------------------------- }
procedure TLbDSA.SignString(const AStr : string);
  { generate DSA signature of string data }
var
  Digest : TSHA1Digest;
begin
  StringHashSHA1(Digest, AStr);
  SignHash(Digest);
end;
{ -------------------------------------------------------------------------- }
function TLbDSA.VerifyBuffer(const Buf; BufLen : Cardinal) : Boolean;
  { verify DSA signature agrees with buffer data }
var
  Digest : TSHA1Digest;
begin
  HashSHA1(Digest, Buf, BufLen);
  Result := VerifyHash(Digest);
end;
{ -------------------------------------------------------------------------- }
function TLbDSA.VerifyFile(const AFileName : string) : Boolean;
  { verify DSA signature agrees with file data }
var
  Digest : TSHA1Digest;
begin
  FileHashSHA1(Digest, AFileName);
  Result := VerifyHash(Digest);
end;
{ -------------------------------------------------------------------------- }
function TLbDSA.VerifyStream(AStream : TStream) : Boolean;
  { verify DSA signature agrees with stream data }
var
  Digest : TSHA1Digest;
begin
  StreamHashSHA1(Digest, AStream);
  Result := VerifyHash(Digest);
end;
{ -------------------------------------------------------------------------- }
function TLbDSA.VerifyString(const AStr : string) : Boolean;
  { verify DSA signature agrees with string data }
var
  Digest : TSHA1Digest;
begin
  StringHashSHA1(Digest, AStr);
  Result := VerifyHash(Digest);
end;

end.