diff -uNr a/vtools/Makefile b/vtools/Makefile --- a/vtools/Makefile 257066f00b2af8569e4b24cdf06fa376a6312d8f0568eecc83e6f4624d7c5109a51906fd5b2bc4f55840577939d86aa4173c0dd70160916998d528cff0f6a67b +++ b/vtools/Makefile 85500ed7a489bcd8d604fd29696a630d9b43a7422bb23f393c77c5029f34a729316a0a19e5bd4ec591e06f4b9fb170e119739e3d6ac8f20bf11c613c5c7c116b @@ -2,6 +2,9 @@ vdiff: gprbuild -Pvdiff.gpr +vpatch: + gprbuild -Pvpatch.gpr + clean: gprclean -Pvdiff.gpr - + gprclean -Pvpatch.gpr diff -uNr a/vtools/manifest b/vtools/manifest --- a/vtools/manifest de81a97d5da86b1a3f934e6afb04b4ab40aa58163ad292438814fd9ca1dc09d9209c4984099e2e709fbe637cf8046a30b04039e2abce74ec565bf2f7881c0e91 +++ b/vtools/manifest 86d8b63e1a034dcde84b1fadfcc9e5da14a0a6207beb81bbadd37f32084921e71184b8dc8316ff3fc011527ee60457e5fa0f0b72ac9b9e28f9730f1e9e91cec7 @@ -3,3 +3,4 @@ 511300 phf keccak Included diana_coman's keccak implementation. 511300 phf vdiff_keccak Vdiff hashing and output using Keccak instead of SHA512. 512600 phf vtools_fixes_bitrate_char_array Fixes for keccak from diana_coman, different approach to C interop. +514700 phf vtools_vpatch Initial vpatch tool implementation in Ada. diff -uNr a/vtools/src/bits.adb b/vtools/src/bits.adb --- a/vtools/src/bits.adb false +++ b/vtools/src/bits.adb f9f8125f17b849d7e49d39ff7b8c49d2b9a1acd27b1d7a3fb449d2c9971098d1f22a64263d89d210d8c15b8ad963951d674aa4998e7823c19ab22e03c4f6373a @@ -0,0 +1,67 @@ +with Interfaces; use Interfaces; +package body Bits is + -- helper functions + procedure ToBitstream(S: in String; B: out Bitstream ) is + V : Unsigned_8; + Pos : Natural; + begin + Pos := B'First; + for C of S loop + V := Character'Pos( C ); + B( Pos ) := Bit( V and 1 ); + B( Pos + 1 ) := Bit( Shift_Right( V, 1 ) and 1 ); + B( Pos + 2 ) := Bit( Shift_Right( V, 2 ) and 1 ); + B( Pos + 3 ) := Bit( Shift_Right( V, 3 ) and 1 ); + B( Pos + 4 ) := Bit( Shift_Right( V, 4 ) and 1 ); + B( Pos + 5 ) := Bit( Shift_Right( V, 5 ) and 1 ); + B( Pos + 6 ) := Bit( Shift_Right( V, 6 ) and 1 ); + B( Pos + 7 ) := Bit( Shift_Right( V, 7 ) and 1 ); + Pos := Pos + 8; + end loop; + end ToBitstream; + + procedure ToString(B: in Bitstream; S: out String ) is + N : Natural; + Pos : Natural; + begin + Pos := B'First; + for I in S'Range loop + N := Natural( B( Pos ) ) + + Natural( B( Pos + 1 ) ) * 2 + + Natural( B( Pos + 2 ) ) * 4 + + Natural( B( Pos + 3 ) ) * 8 + + Natural( B( Pos + 4 ) ) * 16 + + Natural( B( Pos + 5 ) ) * 32 + + Natural( B( Pos + 6 ) ) * 64 + + Natural( B( Pos + 7 ) ) * 128; + Pos := Pos + 8; + S( I ) := Character'Val( N ); + end loop; + end ToString; + + -- direction translation of C function from vdiff + procedure ToHex(B: in Bitstream; S: out String) is + Bytes: String(1..B'Length/8); + Hex_Digits: constant String := "0123456789abcdef"; + I: Positive := 1; + V: Unsigned_8; + X: Positive := 1; + begin + ToString(B, Bytes); + for C of S loop + V := Character'Pos(C); + S(I) := Hex_Digits(Integer(Shift_Right(V, 4) + 1)); + I := I + 1; + S(I) := Hex_Digits(Integer((V and 16#F#) + 1)); + I := I + 1; + end loop; + end; + + function ToHex(B: in Bitstream) return String is + S: String(1..B'Length/4); + begin + ToHex(B, S); + return S; + end; + +end Bits; diff -uNr a/vtools/src/bits.ads b/vtools/src/bits.ads --- a/vtools/src/bits.ads false +++ b/vtools/src/bits.ads 8ad58fb0739dc94201e75308b93d1741700e42527532fe5efd38acd819d5047d38462e9fe7fb10263817317420c285ddb6a411be6ebb29c94111a2c5782abe24 @@ -0,0 +1,11 @@ +package Bits is + pragma Pure(Bits); + + type Bit is mod 2; + type Bitstream is array( Natural range <> ) of Bit; -- any length; message + + procedure ToBitstream(S: in String; B: out Bitstream); + procedure ToString(B: in Bitstream; S: out String); + procedure ToHex(B: in Bitstream; S: out String); + function ToHex(B: in Bitstream) return String; +end Bits; diff -uNr a/vtools/src/keccak_c.adb b/vtools/src/keccak_c.adb --- a/vtools/src/keccak_c.adb 252a6f237724580f4af2f1fbf2dff39dcdd7c1a14ac7c17021d4ed0d0939f6394bf2cbce3e2ecc3261b8474ecf0d7de34728467679e557a7c44bad510d070747 +++ b/vtools/src/keccak_c.adb 8b4ed2ecae1c6fee1cc25f280351f57e4329d048617754f580ccc2df61734ede8d64d26dff20f29810a345b3e376ed6455f78e792eb02af14d1e5c6c757771fd @@ -1,43 +1,5 @@ +with Bits; use Bits; package body Keccak_C is - -- helper functions - procedure ToBitstream(S: in String; B: out Bitstream ) is - V : Unsigned_8; - Pos : Natural; - begin - Pos := B'First; - for C of S loop - V := Character'Pos( C ); - B( Pos ) := Bit( V and 1 ); - B( Pos + 1 ) := Bit( Shift_Right( V, 1 ) and 1 ); - B( Pos + 2 ) := Bit( Shift_Right( V, 2 ) and 1 ); - B( Pos + 3 ) := Bit( Shift_Right( V, 3 ) and 1 ); - B( Pos + 4 ) := Bit( Shift_Right( V, 4 ) and 1 ); - B( Pos + 5 ) := Bit( Shift_Right( V, 5 ) and 1 ); - B( Pos + 6 ) := Bit( Shift_Right( V, 6 ) and 1 ); - B( Pos + 7 ) := Bit( Shift_Right( V, 7 ) and 1 ); - Pos := Pos + 8; - end loop; - end ToBitstream; - - procedure ToString(B: in Bitstream; S: out String ) is - N : Natural; - Pos : Natural; - begin - Pos := B'First; - for I in S'Range loop - N := Natural( B( Pos ) ) + - Natural( B( Pos + 1 ) ) * 2 + - Natural( B( Pos + 2 ) ) * 4 + - Natural( B( Pos + 3 ) ) * 8 + - Natural( B( Pos + 4 ) ) * 16 + - Natural( B( Pos + 5 ) ) * 32 + - Natural( B( Pos + 6 ) ) * 64 + - Natural( B( Pos + 7 ) ) * 128; - Pos := Pos + 8; - S( I ) := Character'Val( N ); - end loop; - end ToString; - -- C interface procedure C_Get_Size(Size: out Interfaces.C.size_t) is @@ -62,7 +24,7 @@ Ptr: Char_Star := Input; begin if Input = null then - raise C.Strings.Dereference_Error; + raise Strings.Dereference_Error; end if; for Chr of S loop Chr := Character(Ptr.all); @@ -81,7 +43,7 @@ Ptr: Char_Star := Output; begin if Output = null then - raise C.Strings.Dereference_Error; + raise Strings.Dereference_Error; end if; KeccakEnd(Ctx.all, B); ToString(B, S); diff -uNr a/vtools/src/keccak_c.ads b/vtools/src/keccak_c.ads --- a/vtools/src/keccak_c.ads 9e720f186b11bb3e2d398765619e1e4220659e74bdf9ad4d3be83eeb51c9a45e5f7a4bfcece333f5e86b50838874dbc31462efd45f25294c3661eb069c9e4db2 +++ b/vtools/src/keccak_c.ads 90e5e7dd39779fb38469b32ef8d6206a5a2eb190d7cb7ef90fe61922f7572f640ecd062e85688a3a99f22b0842cb690fd705adc15a3b67df31ba397a3f017a9e @@ -1,4 +1,3 @@ -with Interfaces; use Interfaces; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; with Interfaces.C.Pointers; diff -uNr a/vtools/src/smg_keccak.ads b/vtools/src/smg_keccak.ads --- a/vtools/src/smg_keccak.ads 71bca4b94ae6ea691d3a1faf6c84ae5d17b803d11607e786c34e2711cabeb6921789aae27a3a14b9b5cf5216a133ec2e8bd3b06eb1f2b88923f7e65297c2f5f4 +++ b/vtools/src/smg_keccak.ads 116e16b2714ef88045a3cbea42e604a1fdf8b0f55fc1017af960105c046c97ef84edc4d74c919652029d0ea61bd1049f4ff445873ca9f0a73549ddd3146a3faa @@ -5,6 +5,7 @@ -- S.MG, 2018 +with Bits; use Bits; package SMG_Keccak is pragma Pure(SMG_Keccak); --stateless, no side effects -> can cache calls @@ -38,8 +39,6 @@ -- the "secret" part of the state (i.e. lower capacity) subtype Keccak_Rate is Positive range 1..Width; -- capacity = width - rate - type Bit is mod 2; - type Bitstream is array( Natural range <> ) of Bit; -- any length; message subtype Bitword is Bitstream( 0..Z_Length - 1 ); -- bits of one state "word" -- type conversions diff -uNr a/vtools/src/vpatch.adb b/vtools/src/vpatch.adb --- a/vtools/src/vpatch.adb false +++ b/vtools/src/vpatch.adb afd665d979fe64dfdcc2d99a515a887b8c32e961afa20201755a80dccb64713db2942bf7828748a41c8b88859be4bfa917cb50134a0d3f4fef403fcfb26463ef @@ -0,0 +1,619 @@ +with Bits; use Bits; +with Interfaces.C; +with Interfaces.C.Strings; +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with Ada.Strings.Fixed; +with Ada.Directories; +with Ada.Characters; +with Ada.Characters.Handling; +with Ada.Characters.Latin_1; +with Ada.Sequential_IO; +with SMG_Keccak; use SMG_Keccak; + +procedure VPatch is + package Latin_1 renames Ada.Characters.Latin_1; + package Dirs renames Ada.Directories; + + -- Utilities + + function Starts_With(S: String; Prefix: String) return Boolean is + begin + if S'Length < Prefix'Length then + return False; + end if; + return S(S'First..S'First+Prefix'Length-1) = Prefix; + end; + + function Path_Prefix(Pathname: String; + Suffix: Positive) return String is + Pos: Natural := Pathname'Last; + begin + for I in 1..Suffix loop + Pos := Ada.Strings.Fixed.Index(Pathname, "/", + From => Pos, + Going => Ada.Strings.Backward); + if Pos = 0 then + return Pathname; + end if; + Pos := Pos - 1; + end loop; + return Pathname(Pathname'First .. Pos); + end; + + function Path_Without_Prefix(Pathname: String; + Prefix: Positive) return String is + Pos: Natural := 1; + begin + for I in 1..Prefix loop + Pos := Ada.Strings.Fixed.Index(Pathname, "/", From => Pos); + if Pos = 0 then + return Pathname; + end if; + Pos := Pos + 1; + end loop; + return Pathname(Pos .. Pathname'Last); + end; + + -- Temporary File + + procedure MkTemp(Template: Interfaces.C.Strings.Chars_Ptr); + pragma Import(C, mktemp); + + function Temp_File_Name(Template: String) return String is + X: Interfaces.C.Strings.Chars_Ptr + := Interfaces.C.Strings.New_String(Template); + begin + MkTemp(X); + declare + Result: String := Interfaces.C.Strings.Value(X); + begin + Interfaces.C.Strings.Free(X); + return Result; + end; + end; + + procedure Create_Temp(File : in out File_Type; + Mode : in File_Mode := Out_File; + Template : in String := "vpatch.XXX"; + Form : in String := "") is + Name: String := Temp_File_Name(Template); + begin + Create(File, Mode, Name, Form); + end; + + -- VPatch data structures + + type Patch_Op is (Op_Create, Op_Delete, Op_Patch); + + Hash_Length: constant Positive := 128; + type Hash_Type is (Empty, Value); + type Hash(The_Type: Hash_Type := Empty) is record + case The_Type is + when Value => + Value: String(1..Hash_Length); + when Empty => + null; + end case; + end record; + + function "=" (Left, Right: in Hash) return Boolean is + begin + if Left.The_Type = Empty and Right.The_Type = Empty then + return True; + elsif Left.The_Type = Empty or Right.The_Type = Empty then + return False; + elsif Left.Value /= Right.Value then + return False; + else + return True; + end if; + end "="; + + type Header (From_L, To_L: Natural) Is record + From_Hash: Hash; + From_File: String(1..From_L); + To_Hash: Hash; + To_File: String(1..To_L); + end record; + + function Operation(A_Header: Header) return Patch_Op is + begin + if A_Header.From_Hash.The_Type = Empty then + return Op_Create; + elsif A_Header.To_Hash.The_Type = Empty then + return Op_Delete; + else + return Op_Patch; + end if; + end; + + function Press_Name(A_Header: Header) return String is + begin + return Path_Without_Prefix(A_Header.From_File, 1); + end; + + type Line_Numbers is record + Start: Natural; + Count: Natural; + end record; + + type Hunk is record + From_File_Line_Numbers: Line_Numbers; + To_File_Line_Numbers: Line_Numbers; + end record; + + -- VPatch debug output routines + + procedure Put(A_Line_Numbers: Line_Numbers) is + begin + Put(A_Line_Numbers.Start); + Put(A_Line_Numbers.Count); + end; + + procedure Put(A_Hash: Hash) is + begin + case A_Hash.The_Type is + when Value => + Put(A_Hash.Value); + when Empty => + Put("no value"); + end case; + end; + + procedure Put(A_Header: Header) is + begin + Put("from file: "); + Put(A_Header.From_File); + New_Line; + Put("to file: "); + Put(A_Header.To_File); + New_Line; + Put("from hash: "); + Put(A_Header.From_Hash); + New_Line; + Put("to hash: "); + Put(A_Header.To_Hash); + New_Line; + end; + + procedure Put(A_Hunk: Hunk) is + begin + Put("from file line numbers: "); + Put(A_Hunk.From_File_Line_Numbers); + New_Line; + Put("to file line numbers: "); + Put(A_Hunk.To_File_Line_Numbers); + New_Line; + end; + + -- VPatch parser + + Parse, State: exception; + + procedure Skip_Whitespace is + EOL: Boolean; + C: Character; + begin + Skip_Loop: + loop + Look_Ahead(C, EOL); + exit Skip_Loop when EOL; + exit Skip_Loop when + C /= Latin_1.Space and + C /= Latin_1.HT; + Get(C); + end loop Skip_Loop; + end; + + procedure Looking_At(Expected: String) is + Actual: String(Expected'Range); + begin + Get(Actual); + if Expected /= Actual then + raise Parse with "expected " & Expected & ", got " & Actual; + end if; + end; + + procedure Next_Line is + begin + if not End_Of_Line then + raise Parse with "expected end of line"; + end if; + Skip_Line; + end; + + procedure Get(A_Hash: out Hash) is + No_Hash_Label: constant String := "false"; + V: String(1..Hash_Length); + begin + Get(V(1..No_Hash_Label'Length)); + if V(1..No_Hash_Label'Length) = No_Hash_Label then + A_Hash := (The_Type => Empty); + return; + end if; + Get(V(No_Hash_Label'Length + 1..V'Last)); + A_Hash := (The_Type => Value, + Value => V); + end; + + procedure Get(A_Line_Numbers: out Line_Numbers) is + C: Character; + Eol: Boolean; + begin + Get(A_Line_Numbers.Start); + Look_Ahead(C, Eol); + if Eol then + raise Parse; + end if; + case C is + when ' ' => + -- If a hunk contains just one line, only its start line + -- number appears. + A_Line_Numbers.Count := 1; + when ',' => + -- Otherwise its line numbers look like `start,count'. An + -- empty hunk is considered to start at the line that + -- follows the hunk. + Get(C); + Get(A_Line_Numbers.Count); + when others => + raise Parse; + end case; + end; + + function Get_Header_Filename return String is + EOL: Boolean; + Buffer: String(1..1000); + C: Character; + I: Natural := 0; + begin + Read_Loop: + loop + Look_Ahead(C, EOL); + exit Read_Loop when EOL; + exit Read_Loop when + C = Latin_1.Space or C = Latin_1.HT; + Get(C); + I := I + 1; + Buffer(I) := C; + end loop Read_Loop; + return Buffer(1..I); + end; + + function Get_Header return Header is + From_Hash: Hash; + To_Hash: Hash; + begin + Looking_At("--- "); + declare + From_File: String := Get_Header_Filename; + begin + Skip_Whitespace; + Get(From_Hash); + Looking_At("+++ "); + declare + To_File: String := Get_Header_Filename; + begin + Skip_Whitespace; + Get(To_Hash); + Next_Line; + declare + H: Header := (From_L => From_File'Length, + To_L => To_File'Length, + From_File => From_File, + To_File => To_File, + From_Hash => From_Hash, + To_Hash => To_Hash); + begin + return H; + end; + end; + end; + end; + + procedure Get(A_Hunk: out Hunk) is + begin + Looking_At("@@ -"); + Get(A_Hunk.From_File_Line_Numbers); + Looking_At(" +"); + Get(A_Hunk.To_File_Line_Numbers); + Looking_At(" @@"); + Next_Line; + end; + + procedure Process_Hunks_For_Header(A_Header: Header) Is + EOL: Boolean; + C: Character; + A_Hunk: Hunk; + -- ensure valid line counts + From_Count: Natural := 0; + To_Count: Natural := 0; + Has_Input_File: Boolean; + In_F: File_Type; + To_F: File_Type; + Line: Positive := 1; + In_Ctx: Keccak_Context; + To_Ctx: Keccak_Context; + In_Hash: Bitstream(1..64*8); + To_Hash: Bitstream(1..64*8); + To_F_Name: constant String := Press_Name(A_Header); + Op: Patch_Op; + + procedure Hash_Line(Ctx: in out Keccak_Context; S: String) is + B: Bitstream(1..S'Length*8); + LF_B: constant Bitstream(1..8) := (0, 1, 0, 1, 0, 0, 0, 0); + begin + ToBitstream(S, B); + KeccakHash(Ctx, B); + KeccakHash(Ctx, LF_B); + end; + + procedure Check_Input_File_Hash is + begin + if Has_Input_File then + begin + Catch_Up_Loop: + loop + declare + In_Line: String := Get_Line(In_F); + begin + Put_Line(To_F, In_Line); + Hash_Line(In_Ctx, In_Line); + Hash_Line(To_Ctx, In_Line); + end; + end loop Catch_Up_Loop; + exception + when End_Error => + null; + end; + KeccakEnd(In_Ctx, In_Hash); + + declare + Hex_Hash: String := ToHex(In_Hash); + H: Hash := (Value => Hex_Hash, + The_Type => Value); + begin + if A_Header.From_Hash /= (Value => Hex_Hash, + The_Type => Value) then + raise State with "from hash doesn't match"; + end if; + end; + end if; + end Check_Input_File_Hash; + + procedure Check_Output_File_Hash is + begin + KeccakEnd(To_Ctx, To_Hash); + declare + H_Hex: String := ToHex(To_Hash); + H: Hash; + begin + case Op is + when Op_Create | Op_Patch => + H := (Value => H_Hex, + The_Type => Value); + when Op_Delete => + H := (The_Type => Empty); + end case; + if A_Header.To_Hash /= H then + raise State with "to hash doesn't match"; + end if; + end; + end Check_Output_File_Hash; + + procedure Cleanup is + begin + if Is_Open(To_F) then + Dirs.Delete_File(Name(To_F)); + end if; + end Cleanup; + + begin + Op := Operation(A_Header); + + -- log + case Op is + when Op_Create => Put_Line("creating " & To_F_Name); + when Op_Delete => Put_Line("deleting " & To_F_Name); + when Op_Patch => Put_Line("patching " & To_F_Name); + end case; + + -- check the file system state + case Op is + when Op_Delete | Op_Patch => + if not Dirs.Exists(To_F_Name) then + raise State with "attempt to " + & Patch_Op'Image(Op) + & " non existing file " & To_F_Name; + end if; + when Op_Create => + if Dirs.Exists(To_F_Name) then + raise State with "attempt to create a file, but file already exists"; + end if; + end case; + + -- prepare keccak and open files + KeccakBegin(To_Ctx); + Create_Temp(To_F, Out_File, "tmp.XXX"); + case Op is + when Op_Create => + Has_Input_File := False; + when Op_Delete | Op_Patch => + Has_Input_File := True; + KeccakBegin(In_Ctx); + Open(In_F, In_File, To_F_Name); + end case; + + Hunk_Loop: + loop + Look_Ahead(C, EOL); + exit Hunk_Loop when EOL; + exit Hunk_Loop when C /= '@'; + Get(A_Hunk); + From_Count := A_Hunk.From_File_Line_Numbers.Count; + To_Count := A_Hunk.To_File_Line_Numbers.Count; + -- Hunk is not at the beginning of the file, copy lines up to + -- start. + if Line < A_Hunk.From_File_Line_Numbers.Start then + if not Has_Input_File then + raise State with "hunk requires before context lines, " + & "but there's no input file"; + end if; + while Line < A_Hunk.From_File_Line_Numbers.Start loop + if End_Of_File(In_F) then + raise State with "hunk requires before context lines, " + & "but the file has ended"; + end if; + declare + In_Line: String := Get_Line(In_F); + begin + Hash_Line(In_Ctx, In_Line); + Hash_Line(To_Ctx, In_Line); + Put_Line(To_F, In_Line); + Line := Line + 1; + end; + end loop; + end if; + Hunk_Body_Loop: + loop + exit Hunk_Body_Loop when From_Count = 0 and To_Count = 0; + Look_Ahead(C, EOL); + if EOL then + raise Parse with "blank line in hunk"; + end if; + case C is + when '+' => -- line added + Get(C); + case Op is + when Op_Create | Op_Patch => null; + when Op_Delete => raise State with "hunk trying to add lines, " + & "but the operation is deletion"; + end case; + if To_Count = 0 then + raise State with "hunk trying to add lines, " + & "but the line count is not valid"; + end if; + declare + Patch_Line: String := Get_Line; + begin + Put_Line(To_F, Patch_Line); + Hash_Line(To_Ctx, Patch_Line); + end; + To_Count := To_Count - 1; + when '-' => -- line deleted + Get(C); + case Op is + when Op_Delete | Op_Patch => null; + when Op_Create => raise State; + end case; + if not Has_Input_File then + raise State with "hunk trying to remove lines, " + & "but the input file doesn't exist"; + end if; + if From_Count = 0 then + raise State with "hunk trying to remove lines, " + & "when the input file already ended"; + end if; + declare + In_Line: String := Get_Line(In_F); + Patch_Line: String := Get_Line; + begin + if In_Line /= Patch_Line then + raise State with "lines don't match"; + end if; + Hash_Line(In_Ctx, In_Line); + end; + Line := Line + 1; + From_Count := From_Count - 1; + when ' ' => -- line stays the same + Get(C); + if not Has_Input_File then + raise State with "hunk claims identical lines, " + & "but the input file doesn't exist"; + end if; + if End_Of_File(In_F) then + raise State with "hunk claims identical lines, " + & "but the input file has ended"; + end if; + if From_Count = 0 then + raise State with "hunk claims identical lines, " + & "when input file already ended"; + end if; + declare + In_Line: String := Get_Line(In_F); + Patch_Line: String := Get_Line; + begin + if In_Line /= Patch_Line then + raise State with "lines don't match"; + end if; + Put_Line(To_F, Patch_Line); + Hash_Line(In_Ctx, In_Line); + Hash_Line(To_Ctx, In_Line); + end; + Line := Line + 1; + From_Count := From_Count - 1; + To_Count := To_Count - 1; + when others => + raise Parse with "unexpected character " + & Character'Image(C) + & " at beginning of line in hunk body"; + end case; + end loop Hunk_Body_Loop; + end loop Hunk_Loop; + + Check_Input_File_Hash; + Check_Output_File_Hash; + + declare + Tmp_Name: String := Name(To_F); + begin + Close(To_F); + if Has_Input_File then + Close(In_F); + Dirs.Delete_File(To_F_Name); + else + if not Dirs.Exists(Path_Prefix(To_F_Name, 1)) then + Dirs.Create_Path(Path_Prefix(To_F_Name, 1)); + end if; + end if; + case Op is + when Op_Create | Op_Patch => + Dirs.Rename(Tmp_Name, To_F_Name); + when Op_Delete => + Dirs.Delete_File(Tmp_Name); + end case; + end; + + exception + when E : State => + -- we've encountered state issue, + -- check first that the input hash is valid + Cleanup; + Check_Input_File_Hash; + raise; + + when E : others => + Cleanup; + raise; + end Process_Hunks_For_Header; + +begin +Read_Loop: + loop + declare + S: String := Get_Line; + begin + if Starts_With(S, "diff ") then + declare + H: Header := Get_Header; + begin + Process_Hunks_For_Header(H); + exit Read_Loop when End_Of_File; + end; + else + Put_Line("Prelude: " & S); + end if; + end; + end loop Read_Loop; +end; diff -uNr a/vtools/vdiff.gpr b/vtools/vdiff.gpr --- a/vtools/vdiff.gpr 145a4c9bdc6da1fae51c1c4f8da23f73db1d7baddd59b5e4d630e1df2c8ac6e7fc00a37529a1f679ff68f57e60e495ac4360a7cb90c02a35093ed8a3d66fe696 +++ b/vtools/vdiff.gpr 00151d0b59944a4861dafb0d203a685f4cff45ecee80e0a45c236d0407f8c7ff9f228966787b83efd12e3e47fd4ed42c22010503d84bdf5b745baefbe52840ac @@ -4,6 +4,7 @@ for Object_Dir use "obj"; for Exec_Dir use "."; for Main use ("diff.c"); + for Excluded_Source_Files use ("vpatch.adb"); package Builder is for Executable ("diff.c") use "vdiff"; end Builder; diff -uNr a/vtools/vpatch.gpr b/vtools/vpatch.gpr --- a/vtools/vpatch.gpr false +++ b/vtools/vpatch.gpr f882850d136201ac5874c309fba57ba908028b86de996919766631e22ab62fe9e1c22405ec8145aed9f6fed762f9a97185b2bd8c1ecd96f7499f3575dc4973c0 @@ -0,0 +1,7 @@ +project Vpatch is + for Languages use ("Ada"); + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Exec_Dir use "."; + for Main use ("vpatch.adb"); +end Vpatch;