unit BinDiff;
{ ---------------------------------------------------------------------------
BinDiff - rsync-style block/rolling-checksum binary diff & patch engine.
Modernised re-implementation (FreePascal / Delphi, mode "delphi") of a
block-based binary differ:
- The OLD file is split into fixed-size blocks. For every block a
"weak" rolling checksum (Adler/rsync style, 16+16 bit) and a
"strong" checksum (CRC32) are computed -> this is the "signature".
- The NEW file is scanned byte-by-byte with the rolling checksum.
Whenever the weak checksum of the current window matches an entry
in the signature's hash table, the CRC32 (strong checksum) of that
window is verified against the candidate block(s) before accepting
a match - this is the "CRC32 diff list" collision handling: a weak
hit can point at more than one candidate block, and each candidate
is confirmed (or rejected) via CRC32 before it is trusted.
- Matched windows become COPY instructions (reference into the old
file); everything else becomes LITERAL bytes. The resulting
instruction stream is the patch.
- Applying the patch replays COPY/LITERAL instructions against the
old file to reconstruct the new file, with CRC32 sanity checks
on the base file and the final size.
Both the signature stream and the patch stream are plain, versioned
binary formats (4-byte magic + fixed header), so they round-trip
identically between FPC and Delphi.
Known, deliberate simplifications versus "real" rsync:
- The new file is read fully into memory while building the delta
(the old file is only ever accessed via random Seek/Read, so it
does NOT need to fit in memory).
- Only full-block windows are matched; a trailing fragment of the
new file shorter than one block is always emitted as a literal.
--------------------------------------------------------------------------- }
{$ifdef fpc}
{$mode delphi}{$WARN 5026 OFF}{$WARN 5027 OFF}{$WARN 5057 OFF}{$WARN 5058 OFF}
{$endif}
{$H+}
{$POINTERMATH ON}
interface
uses
SysUtils, Classes, Generics.Collections;
const
DefaultBlockSize = 4096;
type
EBinDiffFormat = class(Exception);
ECRCMismatch = class(Exception);
{ One block entry in a file signature. Packed so the on-disk layout is
identical regardless of compiler/platform alignment rules. }
TSignatureEntry = packed record
Weak: LongWord; // rolling (weak) checksum of the block
Strong: LongWord; // CRC32 (strong) checksum of the block
Offset: Int64; // offset of the block in the old file
Size: LongWord; // block length (last block of a file may be short)
end;
TSignatureEntryArray = array of TSignatureEntry;
{ Full signature of a file: header info + the per-block entries. }
TFileSignature = record
BlockSize: LongWord;
FileSize: Int64;
FileCRC: LongWord; // CRC32 of the whole file
Entries: TSignatureEntryArray;
end;
TBinDiffEngine = class
private
FBlockSize: LongWord;
class function CRC32Update(CRC: LongWord; const Buf; Len: LongWord): LongWord; static;
class function CRC32OfBlock(const Buf; Len: LongWord): LongWord; static;
class function WeakInit(const Buf; Len: LongWord): LongWord; static;
class function WeakRoll(W: LongWord; OldByte, NewByte: Byte; BlockLen: LongWord): LongWord; static;
procedure WritePatchHeader(PatchStream: TStream; const Sig: TFileSignature; NewSize: Int64);
procedure ReadPatchHeader(PatchStream: TStream; out BlockSize: LongWord;
out OldSize, NewSize: Int64; out OldCRC: LongWord);
public
constructor Create(ABlockSize: LongWord = DefaultBlockSize);
{ Step 1: build the signature (per-block weak+strong checksums) of
the OLD/base file. }
function BuildSignature(OldStream: TStream): TFileSignature;
procedure SaveSignature(const Sig: TFileSignature; Dest: TStream);
function LoadSignature(Source: TStream): TFileSignature;
{ Step 2: compare NewStream against a previously built signature and
write the resulting binary delta (patch) to PatchStream. }
procedure CreateDelta(const Sig: TFileSignature; NewStream, PatchStream: TStream);
{ Step 3: replay a patch against the old file to reconstruct the new
file. Raises ECRCMismatch if the old file does not match the one
the patch was built from (unless VerifyOldCRC is False), and
EBinDiffFormat on any structural / size inconsistency. }
procedure ApplyPatch(OldStream, PatchStream, OutStream: TStream; VerifyOldCRC: Boolean = True);
{ Convenience wrappers operating directly on file names. }
procedure DiffFiles(const OldFileName, NewFileName, PatchFileName: string);
procedure PatchFiles(const OldFileName, PatchFileName, OutFileName: string);
class function CRC32OfStream(Stream: TStream): LongWord; static;
property BlockSize: LongWord read FBlockSize write FBlockSize;
end;
implementation
const
SigMagic: array[0..3] of AnsiChar = 'BDS1';
PatchMagic: array[0..3] of AnsiChar = 'BDP1';
opEnd = 0;
opCopy = 1;
opLiteral = 2;
{ A multiple of 65536 that is comfortably larger than any single
subtraction we perform below, so the (mod 65536) arithmetic in the
rolling checksum never has to deal with a negative intermediate. }
RollBias = LongWord($01000000);
var
CRCTable: array[Byte] of LongWord;
procedure BuildCRCTable;
const
Poly = LongWord($EDB88320);
var
i, j: Integer;
c: LongWord;
begin
for i := 0 to 255 do
begin
c := LongWord(i);
for j := 0 to 7 do
begin
if (c and 1) <> 0 then
c := Poly xor (c shr 1)
else
c := c shr 1;
end;
CRCTable[i] := c;
end;
end;
{ ---------------------------------------------------------------------------
TBinDiffEngine
--------------------------------------------------------------------------- }
constructor TBinDiffEngine.Create(ABlockSize: LongWord);
begin
inherited Create;
if ABlockSize = 0 then
ABlockSize := DefaultBlockSize;
FBlockSize := ABlockSize;
end;
class function TBinDiffEngine.CRC32Update(CRC: LongWord; const Buf; Len: LongWord): LongWord;
var
p: PByte;
i: LongWord;
begin
p := PByte(@Buf);
for i := 0 to Len - 1 do
CRC := CRCTable[Byte(CRC xor p[i])] xor (CRC shr 8);
Result := CRC;
end;
class function TBinDiffEngine.CRC32OfBlock(const Buf; Len: LongWord): LongWord;
begin
Result := CRC32Update($FFFFFFFF, Buf, Len) xor $FFFFFFFF;
end;
class function TBinDiffEngine.CRC32OfStream(Stream: TStream): LongWord;
var
Buf: array[0..65535] of Byte;
n: Integer;
CRC: LongWord;
begin
Stream.Position := 0;
CRC := $FFFFFFFF;
repeat
n := Stream.Read(Buf, SizeOf(Buf));
if n > 0 then
CRC := CRC32Update(CRC, Buf, n);
until n < SizeOf(Buf);
Result := CRC xor $FFFFFFFF;
end;
{ Weak (rolling) checksum: classic two-part Adler/rsync style checksum,
16 bits per half, combined into one 32-bit value. }
class function TBinDiffEngine.WeakInit(const Buf; Len: LongWord): LongWord;
var
p: PByte;
i: LongWord;
s1, s2: LongWord;
begin
p := PByte(@Buf);
s1 := 0;
s2 := 0;
for i := 0 to Len - 1 do
begin
s1 := s1 + p[i];
s2 := s2 + s1;
end;
Result := ((s2 and $FFFF) shl 16) or (s1 and $FFFF);
end;
class function TBinDiffEngine.WeakRoll(W: LongWord; OldByte, NewByte: Byte; BlockLen: LongWord): LongWord;
var
s1, s2, NewS1: LongWord;
begin
s1 := W and $FFFF;
s2 := (W shr 16) and $FFFF;
NewS1 := (s1 + RollBias - OldByte + NewByte) and $FFFF;
s2 := (s2 + RollBias - ((BlockLen * OldByte) and $FFFF) + NewS1) and $FFFF;
Result := (s2 shl 16) or NewS1;
end;
{ ---------------------------------------------------------------------------
Signature building / (de)serialisation
--------------------------------------------------------------------------- }
function TBinDiffEngine.BuildSignature(OldStream: TStream): TFileSignature;
var
Buf: array of Byte = [];
n: Integer;
Offset: Int64;
Cnt: Integer;
RunningCRC: LongWord;
begin
Result := Default(TFileSignature);
SetLength(Buf, FBlockSize);
SetLength(Result.Entries, 0);
Result.BlockSize := FBlockSize;
OldStream.Position := 0;
Offset := 0;
Cnt := 0;
RunningCRC := $FFFFFFFF;
repeat
n := OldStream.Read(Buf[0], FBlockSize);
if n > 0 then
begin
RunningCRC := CRC32Update(RunningCRC, Buf[0], n);
if Cnt >= Length(Result.Entries) then
SetLength(Result.Entries, Length(Result.Entries) + 1024);
Result.Entries[Cnt].Weak := WeakInit(Buf[0], n);
Result.Entries[Cnt].Strong := CRC32OfBlock(Buf[0], n);
Result.Entries[Cnt].Offset := Offset;
Result.Entries[Cnt].Size := LongWord(n);
Inc(Cnt);
Inc(Offset, n);
end;
until n < Integer(FBlockSize);
SetLength(Result.Entries, Cnt);
Result.FileSize := Offset;
Result.FileCRC := RunningCRC xor $FFFFFFFF;
end;
procedure TBinDiffEngine.SaveSignature(const Sig: TFileSignature; Dest: TStream);
var
Cnt: LongWord;
begin
Dest.WriteBuffer(SigMagic, SizeOf(SigMagic));
Dest.WriteBuffer(Sig.BlockSize, SizeOf(Sig.BlockSize));
Dest.WriteBuffer(Sig.FileSize, SizeOf(Sig.FileSize));
Dest.WriteBuffer(Sig.FileCRC, SizeOf(Sig.FileCRC));
Cnt := Length(Sig.Entries);
Dest.WriteBuffer(Cnt, SizeOf(Cnt));
if Cnt > 0 then
Dest.WriteBuffer(Sig.Entries[0], Cnt * SizeOf(TSignatureEntry));
end;
function TBinDiffEngine.LoadSignature(Source: TStream): TFileSignature;
var
Magic: array[0..3] of AnsiChar = (#0,#0,#0,#0);
Cnt: LongWord = 0;
begin
Result := Default(TFileSignature);
Source.ReadBuffer(Magic, SizeOf(Magic));
if Magic <> SigMagic then
raise EBinDiffFormat.Create('BinDiff: not a valid signature stream (bad magic)');
Source.ReadBuffer(Result.BlockSize, SizeOf(Result.BlockSize));
Source.ReadBuffer(Result.FileSize, SizeOf(Result.FileSize));
Source.ReadBuffer(Result.FileCRC, SizeOf(Result.FileCRC));
Source.ReadBuffer(Cnt, SizeOf(Cnt));
SetLength(Result.Entries, Cnt);
if Cnt > 0 then
Source.ReadBuffer(Result.Entries[0], Cnt * SizeOf(TSignatureEntry));
FBlockSize := Result.BlockSize;
end;
{ ---------------------------------------------------------------------------
Patch header
--------------------------------------------------------------------------- }
procedure TBinDiffEngine.WritePatchHeader(PatchStream: TStream; const Sig: TFileSignature; NewSize: Int64);
begin
PatchStream.WriteBuffer(PatchMagic, SizeOf(PatchMagic));
PatchStream.WriteBuffer(Sig.BlockSize, SizeOf(Sig.BlockSize));
PatchStream.WriteBuffer(Sig.FileSize, SizeOf(Sig.FileSize));
PatchStream.WriteBuffer(Sig.FileCRC, SizeOf(Sig.FileCRC));
PatchStream.WriteBuffer(NewSize, SizeOf(NewSize));
end;
procedure TBinDiffEngine.ReadPatchHeader(PatchStream: TStream; out BlockSize: LongWord;
out OldSize, NewSize: Int64; out OldCRC: LongWord);
var
Magic: array[0..3] of AnsiChar = (#0,#0,#0,#0);
begin
PatchStream.ReadBuffer(Magic, SizeOf(Magic));
if Magic <> PatchMagic then
raise EBinDiffFormat.Create('BinDiff: not a valid patch stream (bad magic)');
PatchStream.ReadBuffer(BlockSize, SizeOf(BlockSize));
PatchStream.ReadBuffer(OldSize, SizeOf(OldSize));
PatchStream.ReadBuffer(OldCRC, SizeOf(OldCRC));
PatchStream.ReadBuffer(NewSize, SizeOf(NewSize));
end;
{ ---------------------------------------------------------------------------
Delta creation (the actual rsync-style rolling scan)
--------------------------------------------------------------------------- }
procedure TBinDiffEngine.CreateDelta(const Sig: TFileSignature; NewStream, PatchStream: TStream);
var
HashTable: TDictionary<LongWord, TList<Integer>>;
Candidates: TList<Integer>;
List: TList<Integer>;
i, idx, MatchIndex: Integer;
NewBuf: array of Byte = nil;
NewSize: Int64;
BlockSize: LongWord;
Pos, LiteralStart: Int64;
W: LongWord;
HaveWeak: Boolean;
StrongCandidate: LongWord;
b: Byte;
Off8: Int64;
Len8: Int64;
procedure FlushLiteral(EndPos: Int64);
var
RunLen: Int64;
begin
RunLen := EndPos - LiteralStart;
if RunLen <= 0 then
Exit;
b := opLiteral;
PatchStream.WriteBuffer(b, SizeOf(b));
Len8 := RunLen;
PatchStream.WriteBuffer(Len8, SizeOf(Len8));
PatchStream.WriteBuffer(NewBuf[LiteralStart], RunLen);
end;
begin
BlockSize := Sig.BlockSize;
if BlockSize = 0 then
raise EBinDiffFormat.Create('BinDiff: signature has zero block size');
NewSize := NewStream.Size;
SetLength(NewBuf, NewSize);
NewStream.Position := 0;
if NewSize > 0 then
NewStream.ReadBuffer(NewBuf[0], NewSize);
WritePatchHeader(PatchStream, Sig, NewSize);
{ Build weak-checksum -> candidate-block-index hash table. Several old
blocks can share the same weak checksum (that is precisely the
"diff list" for a given hash bucket); every candidate in the list
is confirmed against the strong CRC32 before being trusted. }
HashTable := TDictionary<LongWord, TList<Integer>>.Create;
try
for i := 0 to High(Sig.Entries) do
begin
if not HashTable.TryGetValue(Sig.Entries[i].Weak, List) then
begin
List := TList<Integer>.Create;
HashTable.Add(Sig.Entries[i].Weak, List);
end;
List.Add(i);
end;
Pos := 0;
LiteralStart := 0;
HaveWeak := False;
W := 0;
while Pos + Int64(BlockSize) <= NewSize do
begin
if not HaveWeak then
begin
W := WeakInit(NewBuf[Pos], BlockSize);
HaveWeak := True;
end;
MatchIndex := -1;
if HashTable.TryGetValue(W, Candidates) then
begin
for idx := 0 to Candidates.Count - 1 do
begin
i := Candidates[idx];
if Sig.Entries[i].Size <> BlockSize then
Continue; // only match full-size blocks during the rolling scan
StrongCandidate := CRC32OfBlock(NewBuf[Pos], BlockSize);
if StrongCandidate = Sig.Entries[i].Strong then
begin
MatchIndex := i;
Break;
end;
end;
end;
if MatchIndex >= 0 then
begin
FlushLiteral(Pos);
b := opCopy;
PatchStream.WriteBuffer(b, SizeOf(b));
Off8 := Sig.Entries[MatchIndex].Offset;
PatchStream.WriteBuffer(Off8, SizeOf(Off8));
Len8 := BlockSize;
PatchStream.WriteBuffer(Len8, SizeOf(Len8));
Inc(Pos, BlockSize);
LiteralStart := Pos;
HaveWeak := False;
end
else
begin
if Pos + Int64(BlockSize) < NewSize then
W := WeakRoll(W, NewBuf[Pos], NewBuf[Pos + Int64(BlockSize)], BlockSize)
else
HaveWeak := False;
Inc(Pos);
end;
end;
{ Trailing fragment shorter than one block: always literal. }
FlushLiteral(NewSize);
b := opEnd;
PatchStream.WriteBuffer(b, SizeOf(b));
finally
for List in HashTable.Values do
List.Free;
HashTable.Free;
end;
end;
{ ---------------------------------------------------------------------------
Patch application
--------------------------------------------------------------------------- }
procedure TBinDiffEngine.ApplyPatch(OldStream, PatchStream, OutStream: TStream; VerifyOldCRC: Boolean);
var
BlockSize: LongWord;
OldSizeHdr, NewSizeHdr: Int64;
OldCRCHdr: LongWord;
Op: Byte;
Offset, RunLen, BytesLeft, ChunkLen: Int64;
Buf: array of Byte;
begin
PatchStream.Position := 0;
ReadPatchHeader(PatchStream, BlockSize, OldSizeHdr, NewSizeHdr, OldCRCHdr);
if OldStream.Size <> OldSizeHdr then
raise EBinDiffFormat.CreateFmt(
'BinDiff: base file size mismatch (patch expects %d bytes, got %d)',
[OldSizeHdr, OldStream.Size]);
if VerifyOldCRC then
if CRC32OfStream(OldStream) <> OldCRCHdr then
raise ECRCMismatch.Create(
'BinDiff: base file CRC32 does not match the file the patch was created from');
SetLength(Buf, 65536);
repeat
PatchStream.ReadBuffer(Op, SizeOf(Op));
case Op of
opEnd:
Break;
opCopy:
begin
PatchStream.ReadBuffer(Offset, SizeOf(Offset));
PatchStream.ReadBuffer(RunLen, SizeOf(RunLen));
OldStream.Position := Offset;
BytesLeft := RunLen;
while BytesLeft > 0 do
begin
ChunkLen := BytesLeft;
if ChunkLen > Length(Buf) then
ChunkLen := Length(Buf);
OldStream.ReadBuffer(Buf[0], ChunkLen);
OutStream.WriteBuffer(Buf[0], ChunkLen);
Dec(BytesLeft, ChunkLen);
end;
end;
opLiteral:
begin
PatchStream.ReadBuffer(RunLen, SizeOf(RunLen));
BytesLeft := RunLen;
while BytesLeft > 0 do
begin
ChunkLen := BytesLeft;
if ChunkLen > Length(Buf) then
ChunkLen := Length(Buf);
PatchStream.ReadBuffer(Buf[0], ChunkLen);
OutStream.WriteBuffer(Buf[0], ChunkLen);
Dec(BytesLeft, ChunkLen);
end;
end;
else
raise EBinDiffFormat.CreateFmt('BinDiff: unknown patch opcode %d', [Op]);
end;
until False;
if OutStream.Size <> NewSizeHdr then
raise EBinDiffFormat.CreateFmt(
'BinDiff: reconstructed size mismatch (expected %d bytes, got %d)',
[NewSizeHdr, OutStream.Size]);
end;
{ ---------------------------------------------------------------------------
File-based convenience wrappers
--------------------------------------------------------------------------- }
procedure TBinDiffEngine.DiffFiles(const OldFileName, NewFileName, PatchFileName: string);
var
OldFS, NewFS, PatchFS: TFileStream;
Sig: TFileSignature;
begin
OldFS := TFileStream.Create(OldFileName, fmOpenRead or fmShareDenyWrite);
try
Sig := BuildSignature(OldFS);
finally
OldFS.Free;
end;
NewFS := TFileStream.Create(NewFileName, fmOpenRead or fmShareDenyWrite);
try
PatchFS := TFileStream.Create(PatchFileName, fmCreate);
try
CreateDelta(Sig, NewFS, PatchFS);
finally
PatchFS.Free;
end;
finally
NewFS.Free;
end;
end;
procedure TBinDiffEngine.PatchFiles(const OldFileName, PatchFileName, OutFileName: string);
var
OldFS, PatchFS, OutFS: TFileStream;
begin
OldFS := TFileStream.Create(OldFileName, fmOpenRead or fmShareDenyWrite);
try
PatchFS := TFileStream.Create(PatchFileName, fmOpenRead or fmShareDenyWrite);
try
OutFS := TFileStream.Create(OutFileName, fmCreate);
try
ApplyPatch(OldFS, PatchFS, OutFS);
finally
OutFS.Free;
end;
finally
PatchFS.Free;
end;
finally
OldFS.Free;
end;
end;
initialization
BuildCRCTable;
end.
