abdfcrys.pas

Lazarus is a free and open source development tool for the FreePascal Compiler. The purpose of the p

(* ***** 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 Abbrevia
 *
 * 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 ***** *)

{*********************************************************}
{* ABBREVIA: AbDfCryS.pas 3.05                           *}
{*********************************************************}
{* Deflate encryption streams                            *}
{*********************************************************}

unit AbDfCryS;

{$I AbDefine.inc}

interface

uses
  SysUtils,
  Classes,
  AbDfBase;

type
  TAbZipEncryptHeader = array [0..11] of byte;

  TAbZipDecryptEngine = class
    private
      FReady : boolean;
      FState : array [0..2] of longint;
    protected
      procedure zdeInitState(const aPassphrase : string);
    public
      constructor Create;

      function Decode(aCh : byte) : byte;
        {-decodes a byte}
      procedure DecodeBuffer(var aBuffer; aCount : integer);
        {-decodes a buffer}

      function VerifyHeader(const aHeader     : TAbZipEncryptHeader;
                            const aPassphrase : string;
                                  aCheckValue : longint) : boolean;
        {-validate an encryption header}
    end;

  TAbDfDecryptStream = class(TStream)
    private
      FCheckValue : longint;
      FEngine     : TAbZipDecryptEngine;
      FPassphrase : string;
      FReady      : boolean;
      FStream     : TStream;
    protected
    public
      constructor Create(aStream     : TStream;
                         aCheckValue : longint;
                   const aPassphrase : string);
      destructor Destroy; override;                            {!!.02}

      function IsValid : boolean;

      function Read(var aBuffer; aCount : longint) : longint; override;
      function Seek(aOffset : longint; aOrigin : word) : longint; override;
      function Write(const aBuffer; aCount : longint) : longint; override;
  end;

  TAbZipEncryptEngine = class
    private
      FReady : boolean;
      FState : array [0..2] of longint;
    protected
      procedure zeeInitState(const aPassphrase : string);
    public
      constructor Create;

      function Encode(aCh : byte) : byte;
        {-encodes a byte}
      procedure EncodeBuffer(var aBuffer; aCount : integer);
        {-encodes a buffer}

      procedure CreateHeader(var aHeader     : TAbZipEncryptHeader;
                           const aPassphrase : string;
                                 aCheckValue : longint);
        {-generate an encryption header}
    end;

  TAbDfEncryptStream = class(TStream)
    private
      FBuffer  : PAnsiChar;
      FBufSize : integer;
      FEngine  : TAbZipEncryptEngine;
      FStream  : TStream;
    protected
    public
      constructor Create(aStream     : TStream;
                         aCheckValue : longint;
                   const aPassphrase : string);
      destructor Destroy; override;

      function Read(var aBuffer; aCount : longint) : longint; override;
      function Seek(aOffset : longint; aOrigin : word) : longint; override;
      function Write(const aBuffer; aCount : longint) : longint; override;
  end;

implementation

{Notes: the ZIP spec defines a couple of primitive routines for
        performing encryption. For speed Abbrevia inlines them into
        the respective methods of the encryption/decryption engines

        char crc32(long,char)
          return updated CRC from current CRC and next char

        update_keys(char):
          Key(0) <- crc32(key(0),char)
          Key(1) <- Key(1) + (Key(0) & 000000ffH)
          Key(1) <- Key(1) * 134775813 + 1
          Key(2) <- crc32(key(2),key(1) >> 24)
        end update_keys

        char decrypt_byte()
          local unsigned short temp
          temp <- Key(2) | 2
          decrypt_byte <- (temp * (temp ^ 1)) >> 8
        end decrypt_byte
}

uses
  AbUtils;

{---magic numbers from ZIP spec---}
const
  StateInit1 = 305419896;
  StateInit2 = 591751049;
  StateInit3 = 878082192;
  MagicNumber = 134775813;

{===internal encryption class========================================}
constructor TAbZipDecryptEngine.Create;
begin
  {create the ancestor}
  inherited Create;

  {we're not ready for decryption yet since a header hasn't been
   properly verified with VerifyHeader}
  FReady := false;
end;
{--------}
function TAbZipDecryptEngine.Decode(aCh : byte) : byte;
var
  Temp : longint;
begin
  {check for programming error}
  Assert(FReady,
         'TAbZipDecryptEngine.Decode: must successfully call VerifyHeader first');

  {calculate the decoded byte (uses inlined decrypt_byte)}
  Temp := (FState[2] and $FFFF) or 2;
  Result := aCh xor ((Temp * (Temp xor 1)) shr 8);

  {mix the decoded byte into the state (uses inlined update_keys)}
  FState[0] := AbUpdateCrc32(Result, FState[0]);
  FState[1] := FState[1] + (FState[0] and $FF);
  FState[1] := (FState[1] * MagicNumber) + 1;
  FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
end;
{--------}
procedure TAbZipDecryptEngine.DecodeBuffer(var aBuffer; aCount : integer);
var
  i      : integer;
  Temp   : longint;
  Buffer : PAnsiChar;
  WorkState : array [0..2] of longint;
begin
  {check for programming error}
  Assert(FReady,
         'TAbZipDecryptEngine.Decode: must successfully call VerifyHeader first');

  {move the state to a local variable--for better speed}
  WorkState[0] := FState[0];
  WorkState[1] := FState[1];
  WorkState[2] := FState[2];

  {reference the buffer as a PChar--easier arithmetic}
  Buffer := @aBuffer;

  {for each byte in the buffer...}
  for i := 0 to pred(aCount) do begin

    {calculate the next decoded byte (uses inlined decrypt_byte)}
    Temp := (WorkState[2] and $FFFF) or 2;
    Buffer^ := AnsiChar(
                  byte(Buffer^) xor ((Temp * (Temp xor 1)) shr 8));

    {mix the decoded byte into the state (uses inlined update_keys)}
    WorkState[0] := AbUpdateCrc32(byte(Buffer^), WorkState[0]);
    WorkState[1] := WorkState[1] + (WorkState[0] and $FF);
    WorkState[1] := (WorkState[1] * MagicNumber) + 1;
    WorkState[2] := AbUpdateCrc32(WorkState[1] shr 24, WorkState[2]);

    {move onto the next byte}
    inc(Buffer);
  end;

  {save the state}
  FState[0] := WorkState[0];
  FState[1] := WorkState[1];
  FState[2] := WorkState[2];
end;
{--------}
function TAbZipDecryptEngine.VerifyHeader(const aHeader     : TAbZipEncryptHeader;
                                          const aPassphrase : string;
                                                aCheckValue : longint) : boolean;
type
  TLongAsBytes = packed record
    L1, L2, L3, L4 : byte
  end;
var
  i    : integer;
  Temp : longint;
  WorkHeader : TAbZipEncryptHeader;
begin
  {check for programming errors}
  Assert(aPassphrase <> '',
         'TAbZipDecryptEngine.VerifyHeader: need a passphrase');

  {initialize the decryption state}
  zdeInitState(aPassphrase);

  {decrypt the bytes in the header}
  for i := 0 to 11 do begin

    {calculate the next decoded byte (uses inlined decrypt_byte)}
    Temp := (FState[2] and $FFFF) or 2;
    WorkHeader[i] := aHeader[i] xor ((Temp * (Temp xor 1)) shr 8);

    {mix the decoded byte into the state (uses inlined update_keys)}
    FState[0] := AbUpdateCrc32(WorkHeader[i], FState[0]);
    FState[1] := FState[1] + (FState[0] and $FF);
    FState[1] := (FState[1] * MagicNumber) + 1;
    FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
  end;

  {the header is valid if the twelfth byte of the decrypted header
   equals the fourth byte of the check value}
  Result := WorkHeader[11] = TLongAsBytes(aCheckValue).L4;

  {note: zips created with PKZIP prior to version 2.0 also checked
         that the tenth byte of the decrypted header equals the third
         byte of the check value}
  FReady := Result;
end;
{--------}
procedure TAbZipDecryptEngine.zdeInitState(const aPassphrase : string);
var
  i : integer;
begin
  {initialize the decryption state}
  FState[0] := StateInit1;
  FState[1] := StateInit2;
  FState[2] := StateInit3;

  {mix in the passphrase to the state (uses inlined update_keys)}
  for i := 1 to length(aPassphrase) do begin
    FState[0] := AbUpdateCrc32(byte(aPassphrase[i]), FState[0]);
    FState[1] := FState[1] + (FState[0] and $FF);
    FState[1] := (FState[1] * MagicNumber) + 1;
    FState[2] := AbUpdateCrc32(FState[1] shr 24, FState[2]);
  end;
end;
{====================================================================}


{====================================================================}
constructor TAbDfDecryptStream.Create(aStream     : TStream;
                                      aCheckValue : longint;
                                const aPassphrase : string);
begin
  {create the ancestor}
  inherited Create;

  {save the parameters}
  FStream := aStream;
  FCheckValue := aCheckValue;
  FPassphrase := aPassphrase;

  {create the decryption engine}
  FEngine := TAbZipDecryptEngine.Create;
end;
{--------}
destructor TAbDfDecryptStream.Destroy;                     {new !!.02}
begin
  FEngine.Free;
  inherited Destroy;
end;