UNIT _BlwFile;

 (* ********************************************************************** *)
 (*                      File Access and Control Unit                      *)
 (*                    Hereby distributed as OPEN SOURCE                   *)
 (*                 Copyrighted by (2001) Dutra de Lacerda                 *)
 (* ********************************************************************** *)
 (*                                                                        *)
 (* This code is Open Source in respect to the similar status of Blowfish  *)
 (* It is Copyrighted by "(2001) Dutra de Lacerda"                         *)
 (* You are allowed to use it with the usual conditions:                   *)
 (*   - Maintain this Copyright notice in the code.                        *)
 (*   - Make reference to this code, and Author, in your application.      *)
 (*   - Graciously communicate the Author your use of this code.           *)
 (*                                                                        *)
 (* ---------------------------------------------------------------------- *)
 (*                                                                        *)
 (*                           Finding the Author                           *)
 (*                           ~~~~~~~~~~~~~~~~~~                           *)
 (*  This units author can be reached via the following E-Mail addresses:  *)
 (*                                                                        *)
 (*      Via InterNet    : dulac@ip.pt                                     *)
 (*            ...and    : dutra.lacerda@mail.telepac.pt                   *)
 (*                                                                        *)
 (* ---------------------------------------------------------------------- *)
 (*                                                                        *)
 (*                          Finding New Versions                          *)
 (*                          ~~~~~~~~~~~~~~~~~~~~                          *)
 (*      My Home Site    : http://planeta.ip.pt/~ip200075                  *)
 (*            ...and    : http://www.factor-h.com                         *)
 (*                                                                        *)
 (*      Net Archives    : ftp://garbo.uwasa.fi/pc/crypt                   *)
 (*                      : ftp://garbo.uwasa.fi/pc/security                *)
 (*                      : ftp://ftp.elf.stuba.sk/pub/pc/security          *)
 (*                                                                        *)
 (* ---------------------------------------------------------------------- *)


    (****************************** Header ******************************)
    (****************************** Header ******************************)
    (****************************** Header ******************************)

INTERFACE

uses _Ciphers, _BFISH5, _Feistel, _RunError, Dos;

const

  Version       = 16; {version 1.6 = Development = Not Compatible yet}
  TailBlockSize = 16; {A full block of 2^4 = 16 bytes}

procedure BLW_INIT(var k : String);
procedure BLW_CRYPT(var InputFile : String; var OutputFile : String);
procedure BLW_DECRYPT(var InputFile : String; var OutputFile : String);


    (******************************* Code *******************************)
    (******************************* Code *******************************)
    (******************************* Code *******************************)

IMPLEMENTATION

const
{$IFDEF DEBUG}
  Debug = TRUE;
{$ELSE}
  Debug = FALSE;
{$ENDIF}

var
  VersionL : LongInt; {Value in EOF Header}
  VersionC : Array[0..3] of Char ABSOLUTE VersionL;
  VersionB : Array[0..3] of Byte ABSOLUTE VersionL;
  (***********************************************************)
  (* Tail Format (extensible backwards):                     *)
  (* ~~~~~~~~~~~                                             *)
  (*    IVleft : Longint;                                    *)
  (*    IVright: Longint;                                    *)
  (*    version: byte; (compatibility)  | Both make Version? *)
  (*    Extension: Array[1..3] of char; | Arrays = 4 bytes   *)
  (*    FileSize : Longint;                                  *)
  (*    -------------------                                  *)
  (*    Total: 16 bytes (minimum size)                       *)
  (***********************************************************)

  Key : String[56];
  InputFile,
  OutputFile : PathStr;
  Argument : String[2];
  Teller,
  FillBuffer,
  NumRead,
  NumWritten : Word; { MUST be global }
  Input,             { MUST be global }
  Output : file;     { MUST be global }


{$IFDEF Use_Assembler}
  WORK      : BFC_ASM32;      { Defined in _BFISH5.PAS  }
{$ELSE}
  WORK      : BFC_PAS;        { Defined in _BFISH5.PAS  }
{$ENDIF}
  IV        : Block_2x32;     { Defined in _FEISTEL.PAS }
  Buffer    : Buffer_2x32;    { Defined in _FEISTEL.PAS }



  FileVersion,
  FileOrigSize,
  InputSize,
  Counter : LongInt;
  Pad_B : Array[0..15] OF byte;
  Pad_L : Array[0..3] OF LongInt ABSOLUTE Pad_B;
  P : PArray;
  S : SBox;
  PP : array[0..17, 0..3] of Byte absolute P;
  SS : array[0..3, 0..255, 0..3] of Byte absolute S;
  BB : array[0..BufferSize-1] of Byte absolute Buffer;

  FullPasses : LongInt;
  ExtraBytes : LongInt;
  ExtraAtoms : LongInt;
  PadBytes   : Integer;
  LastBytes  : Integer;

  IOerror    : Integer;
  i, j       : Integer;

  Fpath : Pathstr;
  Fdir  : DirStr;
  Fname : NameStr;
  Fext  : ExtStr;


  function CheckDisk: Boolean;
  begin
    if NumWritten=0 then
      begin
      Writeln;
      Writeln( #13, #10, 'Unable to write Disk: Check for Disk Full...' );
      close(input);
      close(output);
      halt(101);
      end;
  end;

  function CheckIO( warn: boolean ): integer;
  var IOerror : integer;
  begin
    IOError := IOresult;
    if IOError<>0 then
      begin
      ErrorAddr := NIL;
      ExitCode  := 0;
      if warn then
        Writeln( #13,#10, 'Please correct the problem and try again...' );
      end;
    CheckIO := IOerror;
  end;

  procedure BLW_INIT(var k : String);
  begin
    WORK.Init( k );
  end;

  procedure BLW_CRYPT(var InputFile : String; var OutputFile : String);
  begin
    Assign(Input, InputFile);
    FileMode := 0; { 0= Read; 1=Write; 2=Read/Write}
    {$I-} Reset(Input, 1); {$I+} IOerror := CheckIO(true);
    If IOerror <> 0 then
      begin
      halt(IOerror);
      end;
    InputSize := FileSize(Input);

    FullPasses := InputSize div SizeOf(Buffer);
    ExtraBytes := InputSize mod SizeOf(Buffer);
    ExtraAtoms := (ExtraBytes + (BlockSize-1)) div AtomSize;
    PadBytes   := BlockSize - (ExtraBytes mod BlockSize);

    Fpath := FExpand( InputFile );
    FSplit(Fpath, Fdir, Fname, Fext);

    VersionB[0] := Version;
    for i := 1 to 3 do
      if (i > ord(Fext[0])) then
        Fext[i] := #32;
    for i := 1 to 3 do
      VersionC[i] := Fext[i+1];

    if OutputFile = '' then
      OutputFile := Fname+'.BFC';
    Assign(Output, OutputFile);
    FileMode := 1; { 0= Read; 1=Write; 2=Read/Write}
    {$I-} Rewrite(Output, 1); {$I+} IOerror:=CheckIO(true);
    If IOerror <> 0 then
      begin
      close(input);
      halt(IOerror);
      end;

    WORK.Get_IV ( IV );

    if FullPasses > 0 Then
       for Counter := 1 to FullPasses do
          begin
          BlockRead(Input, Buffer, BufferSize, NumRead);
          WORK.EnCrypt( @Buffer, BufferAtoms );  {*** HowMany?!? ***}
          BlockWrite(Output, Buffer, NumRead, NumWritten);
          CheckDisk;
          Write('Pass ', Counter, ' of ', succ(FullPasses), #13);
          end;

    if ExtraBytes > 0 Then
       begin
       BlockRead(Input, Buffer, BufferSize, NumRead);

       (* Padding *)
       Pad_L[0] := IV[Xl].Atom;
       Pad_L[1] := IV[Xr].Atom;
       Pad_L[2] := not IV[Xl].Atom;
       Pad_L[3] := not IV[Xr].Atom;
       if PadBytes <> 0 then
         begin
           j := 0;
           for i := ExtraBytes to (ExtraBytes+PadBytes) do
             begin
               BB[i] := Pad_B[ j ];
               J := succ(j);
             end;                {for i...}
         end;                    {if Npad..}

       WORK.EnCrypt( @Buffer, ExtraAtoms );  {*** HowMany?!? ***}
       BlockWrite(Output, Buffer, NumRead+PadBytes, NumWritten);
       CheckDisk;
       Write('Pass ', succ(Counter), ' of ', succ(FullPasses), #13);
       end;
    WriteLn;

    BlockWrite(Output, IV[Xl].Atom, SizeOf(IV[Xl].Atom), NumWritten);
    CheckDisk;
    BlockWrite(Output, IV[Xr].Atom, SizeOf(IV[Xr].Atom), NumWritten);
    CheckDisk;
    BlockWrite(Output, VersionL, SizeOf(VersionL), NumWritten);
    CheckDisk;
    BlockWrite(Output, InputSize, SizeOf(InputSize), NumWritten);
    CheckDisk;

    Close(Input);
    Close(Output);

  end; {BLW_ENCRYPT}



  procedure BLW_DECRYPT(var InputFile : String; var OutputFile : String);
    var Error : Integer;
  begin
    Assign(Input, InputFile);
    FileMode := 0; { 0= Read; 1=Write; 2=Read/Write}
    {$I-} Reset(Input, 1); {$I+} IOerror := CheckIO(true);
    If IOerror <> 0 then
      begin
      halt(IOerror);
      end;
    InputSize := FileSize(Input);

    Fpath := FExpand( InputFile );
    FSplit(Fpath, Fdir, Fname, Fext);

    Seek(Input, FileSize(Input)-16);
    BlockRead(Input, Buffer, SizeOf(Buffer), NumRead);
    IV[xl].Atom := Buffer[0].Atom;
    IV[xr].Atom := Buffer[1].Atom;
    VersionL  := Buffer[2].Atom;
    FileOrigSize := Buffer[3].Atom;

    FullPasses := (FileOrigSize + (BlockSize - 1)) div BufferSize;
    ExtraBytes := (FileOrigSize + (BlockSize - 1)) mod BufferSize;
    ExtraAtoms := ExtraBytes div AtomSize;
    LastBytes  := FileOrigSize mod BufferSize;

    WORK.Set_IV( IV );
    WORK.Start_IV;

    if NOT (VersionB[0] = Version) then
      begin
      Write('Wrong version. File was Encrypted with version ');
      Case VersionB[0] of
        1  : WriteLn('1.3');
        15 : WriteLn('1.5 Official Release');
        16 : WriteLn('1.6 Development = Not Official/Not Compatible')
        else
           WriteLn('??? - Cannot find Tail Information OR Unknown version');
        end;
      halt(254);
      end;

    FileMode := 0; { 0= Read; 1=Write; 2=Read/Write}
    Reset(Input, 1);
    Fext := '.'+VersionC[1]+VersionC[2]+VersionC[3];
    if OutputFile = '' then
      OutputFile:= Fname+Fext;

    Assign(Output, OutputFile);
    FileMode := 1; { 0= Read; 1=Write; 2=Read/Write}
    {$I-} Rewrite(Output, 1); {$I+}

    IOerror:=CheckIO(true);
    If IOerror <> 0 then
      begin
      close(input);
      halt(IOerror);
      end;

    for Counter := 1 to FullPasses do (* Only if Full *)
      begin
      BlockRead(Input, Buffer, BufferSize, NumRead);
      WORK.DeCrypt( @Buffer, BufferAtoms );  {*** HowMany?!? ***}
      BlockWrite(Output, Buffer, NumRead, NumWritten);
      CheckDisk;
      Write('Pass ', Counter, ' of ', succ(FullPasses), #13);
      end;

    if LastBytes > 0 Then    (* Workout the Remaining *)
      begin
      BlockRead(Input, Buffer, BufferSize, NumRead);
      WORK.DeCrypt( @Buffer, ExtraAtoms+2 );  {*** HowMany?!? ***}
      BlockWrite(Output, Buffer, LastBytes, NumWritten);
      CheckDisk;
      Write('Pass ', succ(Counter), ' of ', succ(FullPasses), #13);
      end;

    WriteLn;

    (*                                                    *)
    (* The following block crashes with FreeBSD FPC v1.04 *)
    (* UnDocumented Error 218 appears if Truncate is used *)
    (* Therefore it was substituted with use of LastBytes *)
    (* in the previous Block...                           *)
    (*                                                    *)
    (*                                                    *)
    (* Seek(Output, FileOrigSize);                        *)
    (*                                                    *)
    (* {$I-}   { // Disable I/O Checking }                *)
    (* Truncate(Output);                                  *)
    (* CheckIO(False);                                    *)
    (* {$I+}   { //  Enable I/O Checking }                *)
    (*                                                    *)

    Close(Input);
    Close(Output);

  end; {BLW_DECRYPT}

begin
  { No need to initialize... This is a Classic Procedures Unit... }
end.