diff -uNr a/vtools/manifest b/vtools/manifest --- a/vtools/manifest c93d8fe6648187f6a90d9ceebdd6ea70f201bfeb8d71abb94769820e95b00a13ba2511920e59c4bb04b163d7f589e3ba380f221ad29642a0adfed96eb849b2ed +++ b/vtools/manifest 5e11d4d3daca9f3d116806cbab37f38ce17fb6876cff7aa05f2f47b4e3055ce0117de27c02dae4b8c4741307f888266d678c8934cf63867b35f29dddc6d48c5e @@ -14,3 +14,4 @@ 615544 bvt vtools_add_vsh Add shell v-presser implementation. 615638 bvt vtools_add_vsh_utils Add utilities required by v-presser. 617378 bvt vtools_vsh_utils_one_binary Merge all v.sh Ada utilities into one. +617638 bvt vtools_vsh_ada_vfilter Add an implementation of vfilter in Ada. diff -uNr a/vtools/src/vfilter.adb b/vtools/src/vfilter.adb --- a/vtools/src/vfilter.adb false +++ b/vtools/src/vfilter.adb 09c95a7895470e3a4d7093f096808dc57d72c388c927c31b819ee63f6ee88444abf74138b6f837ef12d3fe220500c81fa716598b10eecc516e0fd1f574f83eed @@ -0,0 +1,44 @@ +with Ada.Text_IO; use Ada.Text_IO; +with Vpatch_Utils; use Vpatch_Utils; +with Ada.Command_Line; use Ada.Command_Line; + +procedure VFilter is + procedure Put(A_Hash: Hash) is + begin + case A_Hash.The_Type is + when Value => + Put(A_Hash.Value); + when Empty => + Put("false"); + end case; + end; + + procedure Put(A_Header: Header) is + begin + Put(Path_Without_Prefix(A_Header.From_File, 1) & " " & + Path_Without_Prefix(A_Header.To_File, 1) & " "); + Put(A_Header.From_Hash); + Put(" "); + Put(A_Header.To_Hash); + New_Line; + end; + + Vpatch_No : String := Argument(1); +begin +Read_Loop: + loop + exit Read_Loop when End_Of_File; + declare + S: String := Get_Line; + begin + if Starts_With(S, "diff ") then + declare + H: Header := Get_Header; + begin + Put(Vpatch_No & " "); + Put(H); + end; + end if; + end; + end loop Read_Loop; +end; diff -uNr a/vtools/src/vpatch.adb b/vtools/src/vpatch.adb --- a/vtools/src/vpatch.adb c4fa36a0508048691ea823a57b90de3bd895f10c36150fa990983ae3996eadcd1ac8a25e9d4ececfc8b41af9a0e7e29ac5382959bf7624fad8185a350c2b82c5 +++ b/vtools/src/vpatch.adb ee428fbc49cd7e0c16a9a43f1d44debd2b59f697708034bbd333ab63f85d00b2f91af46efd5ff8b1cddf253d4a1f27f557ef9b17e9130a89ec960210d3ee4675 @@ -1,649 +1,7 @@ -with Bits; use Bits; with Ada.Text_IO; use Ada.Text_IO; -with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; -with Character_IO; use Character_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; -with Temporary_File; use Temporary_File; +with Vpatch_Utils; use Vpatch_Utils; procedure VPatch is - package Latin_1 renames Ada.Characters.Latin_1; - package Dirs renames Ada.Directories; - package CIO renames Character_IO.Character_IO; - - -- 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 Directory_Name(Pathname: String) return String is - Pos: Natural := Pathname'Last; - begin - Pos := Ada.Strings.Fixed.Index(Pathname, "/", - From => Pos, - Going => Ada.Strings.Backward); - if Pos = 0 then - return Dirs.Current_Directory; - end if; - 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 Create_Temp(File : in out File_Type; - Mode : in File_Mode := Out_File; - Prefix : in String; - Seed : in String := ""; - Form : in String := "") is - Name: String := Temporary_File.Temporary_File(Prefix, Seed); - begin - Create(File, Mode, Name, Form); - end; - - procedure Create_Temp(File : in out CIO.File_Type; - Mode : in CIO.File_Mode := CIO.Out_File; - Prefix : in String; - Seed : in String := ""; - Form : in String := "") is - Name: String := Temporary_File.Temporary_File(Prefix, Seed); - 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: CIO.File_Type; - To_F: CIO.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; - Newline_Directive: constant String := "\ No newline at end of file"; - - procedure Hash_Line(Ctx: in out Keccak_Context; - S: String; - New_Line: Boolean := True) 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); - if New_Line then - KeccakHash(Ctx, LF_B); - end if; - end; - - Check_Input_File_Hash_Pending: Boolean := True; - procedure Check_Input_File_Hash is - begin - if Has_Input_File and Is_Open(In_F) - and Check_Input_File_Hash_Pending then - begin - Check_Input_File_Hash_Pending := False; - Catch_Up_Loop: - loop - declare - New_Line: Boolean; - In_Line: String := Get_Line(In_F, New_Line); - begin - Put_Line(To_F, In_Line, New_Line); - Hash_Line(In_Ctx, In_Line, New_Line); - Hash_Line(To_Ctx, In_Line, New_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 /= H 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; - - function Has_No_Newline_Directive return Boolean is - C: Character; - begin - Look_Ahead(C, EOL); - if C = '\' then - Looking_At(Newline_Directive); - Next_Line; - return True; - end if; - return False; - end; - - 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, Prefix => "vpatch-", Seed => To_F_Name); - 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, CIO.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 - New_Line: Boolean; - In_Line: String := Get_Line(In_F, New_Line); - begin - Hash_Line(In_Ctx, In_Line, New_Line); - Hash_Line(To_Ctx, In_Line, New_Line); - Put_Line(To_F, In_Line, New_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 - New_Line: Boolean := True; - Patch_Line: String := Get_Line; - begin - -- Last line, check for Newline directive. - if To_Count = 1 then - New_Line := not Has_No_Newline_Directive; - end if; - Put_Line(To_F, Patch_Line, New_Line); - Hash_Line(To_Ctx, Patch_Line, New_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 - New_Line: Boolean; - In_Line: String := Get_Line(In_F, New_Line); - Patch_Line: String := Get_Line; - begin - -- Last line, check for Newline directive. - if From_Count = 1 then - if Has_No_Newline_Directive and New_Line then - raise State with "input file has newline, " - & "while hunk claims it doesn't"; - end if; - end if; - - if In_Line /= Patch_Line then - raise State with "lines don't match"; - end if; - Hash_Line(In_Ctx, In_Line, New_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 - New_Line: Boolean; - In_Line: String := Get_Line(In_F, New_Line); - Patch_Line: String := Get_Line; - begin - if In_Line /= Patch_Line then - raise State with "lines don't match"; - end if; - if From_Count = 1 then - if Has_No_Newline_Directive and New_Line then - raise State with "input file has newline, " - & "while hunk claims it doesn't"; - end if; - end if; - - Put_Line(To_F, Patch_Line, New_Line); - Hash_Line(In_Ctx, In_Line, New_Line); - Hash_Line(To_Ctx, In_Line, New_Line); - end; - Line := Line + 1; - From_Count := From_Count - 1; - To_Count := To_Count - 1; - - when '\' => - Looking_At(Newline_Directive); - raise State with "invalid line count in hunk"; - - 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(Directory_Name(To_F_Name)) then - Dirs.Create_Path(Directory_Name(To_F_Name)); - 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 diff -uNr a/vtools/src/vpatch_utils.adb b/vtools/src/vpatch_utils.adb --- a/vtools/src/vpatch_utils.adb false +++ b/vtools/src/vpatch_utils.adb 95e0f4bd9b0399b9d2ff524a0400edab21e366c05e248dfdceaef65030a93df01b2ea510aad2d29c7811de00cd002df0f6566e1dccb4c8e720a0aebbec2acc1f @@ -0,0 +1,615 @@ +package body Vpatch_Utils is + package Latin_1 renames Ada.Characters.Latin_1; + package Dirs renames Ada.Directories; + package CIO renames Character_IO.Character_IO; + + -- 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 Directory_Name(Pathname: String) return String is + Pos: Natural := Pathname'Last; + begin + Pos := Ada.Strings.Fixed.Index(Pathname, "/", + From => Pos, + Going => Ada.Strings.Backward); + if Pos = 0 then + return Dirs.Current_Directory; + end if; + 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 Create_Temp(File : in out File_Type; + Mode : in File_Mode := Out_File; + Prefix : in String; + Seed : in String := ""; + Form : in String := "") is + Name: String := Temporary_File.Temporary_File(Prefix, Seed); + begin + Create(File, Mode, Name, Form); + end; + + procedure Create_Temp(File : in out CIO.File_Type; + Mode : in CIO.File_Mode := CIO.Out_File; + Prefix : in String; + Seed : in String := ""; + Form : in String := "") is + Name: String := Temporary_File.Temporary_File(Prefix, Seed); + begin + Create(File, Mode, Name, Form); + end; + + -- VPatch data structures + + type Patch_Op is (Op_Create, Op_Delete, Op_Patch); + + 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 "="; + + 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: CIO.File_Type; + To_F: CIO.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; + Newline_Directive: constant String := "\ No newline at end of file"; + + procedure Hash_Line(Ctx: in out Keccak_Context; + S: String; + New_Line: Boolean := True) 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); + if New_Line then + KeccakHash(Ctx, LF_B); + end if; + end; + + Check_Input_File_Hash_Pending: Boolean := True; + procedure Check_Input_File_Hash is + begin + if Has_Input_File and Is_Open(In_F) + and Check_Input_File_Hash_Pending then + begin + Check_Input_File_Hash_Pending := False; + Catch_Up_Loop: + loop + declare + New_Line: Boolean; + In_Line: String := Get_Line(In_F, New_Line); + begin + Put_Line(To_F, In_Line, New_Line); + Hash_Line(In_Ctx, In_Line, New_Line); + Hash_Line(To_Ctx, In_Line, New_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 /= H 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; + + function Has_No_Newline_Directive return Boolean is + C: Character; + begin + Look_Ahead(C, EOL); + if C = '\' then + Looking_At(Newline_Directive); + Next_Line; + return True; + end if; + return False; + end; + + 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, Prefix => "vpatch-", Seed => To_F_Name); + 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, CIO.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 + New_Line: Boolean; + In_Line: String := Get_Line(In_F, New_Line); + begin + Hash_Line(In_Ctx, In_Line, New_Line); + Hash_Line(To_Ctx, In_Line, New_Line); + Put_Line(To_F, In_Line, New_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 + New_Line: Boolean := True; + Patch_Line: String := Get_Line; + begin + -- Last line, check for Newline directive. + if To_Count = 1 then + New_Line := not Has_No_Newline_Directive; + end if; + Put_Line(To_F, Patch_Line, New_Line); + Hash_Line(To_Ctx, Patch_Line, New_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 + New_Line: Boolean; + In_Line: String := Get_Line(In_F, New_Line); + Patch_Line: String := Get_Line; + begin + -- Last line, check for Newline directive. + if From_Count = 1 then + if Has_No_Newline_Directive and New_Line then + raise State with "input file has newline, " + & "while hunk claims it doesn't"; + end if; + end if; + + if In_Line /= Patch_Line then + raise State with "lines don't match"; + end if; + Hash_Line(In_Ctx, In_Line, New_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 + New_Line: Boolean; + In_Line: String := Get_Line(In_F, New_Line); + Patch_Line: String := Get_Line; + begin + if In_Line /= Patch_Line then + raise State with "lines don't match"; + end if; + if From_Count = 1 then + if Has_No_Newline_Directive and New_Line then + raise State with "input file has newline, " + & "while hunk claims it doesn't"; + end if; + end if; + + Put_Line(To_F, Patch_Line, New_Line); + Hash_Line(In_Ctx, In_Line, New_Line); + Hash_Line(To_Ctx, In_Line, New_Line); + end; + Line := Line + 1; + From_Count := From_Count - 1; + To_Count := To_Count - 1; + + when '\' => + Looking_At(Newline_Directive); + raise State with "invalid line count in hunk"; + + 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(Directory_Name(To_F_Name)) then + Dirs.Create_Path(Directory_Name(To_F_Name)); + 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; +end Vpatch_Utils; diff -uNr a/vtools/src/vpatch_utils.ads b/vtools/src/vpatch_utils.ads --- a/vtools/src/vpatch_utils.ads false +++ b/vtools/src/vpatch_utils.ads 6cac2d49f8220dc958bbf503e36a6fa3eb13bd7b2fc409093a697fa5401b1db6fba7fe37cbdecc0bab5ddb852425062c46590fcedb5526d47bee748db0095fc8 @@ -0,0 +1,39 @@ +with Bits; use Bits; +with Ada.Text_IO; use Ada.Text_IO; +with Ada.Integer_Text_IO; use Ada.Integer_Text_IO; +with Character_IO; use Character_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; +with Temporary_File; use Temporary_File; + +package Vpatch_Utils is + + 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; + + 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 Get_Header return Header; + function Starts_With(S: String; Prefix: String) return Boolean; + procedure Process_Hunks_For_Header(A_Header: Header); + function Path_Without_Prefix(Pathname: String; + Prefix: Positive) return String; +end Vpatch_Utils; diff -uNr a/vtools/v.sh b/vtools/v.sh --- a/vtools/v.sh 4f93f505f530e9342269287c9d0be9356ec8a596f3bceb2b9fd2cbb6db1dc15ab3603b2f13b1a9e37d01df7483a5f1c581beb38ff66f7b443bacd413aa546ef6 +++ b/vtools/v.sh 2c3cf57471f96dbe84d4eb5827f6360c5cda5ae5bfca8c08e8656393e6b53581c23d04b28b182b135b3482efac49d5a324714f4cb7b510ba576bc1abd96d68dc @@ -85,14 +85,6 @@ done } -vfilter() { - awk -v N="$1" ' -BEGIN {r=0;} -$0 ~ /^diff -uNr/ {r=1;} -r == 1 && $1 == "---" {sub("[^/]*/", "", $2); ip=$2; ih=$3} -r == 1 && $1 == "+++" {sub("[^/]*/", "", $2); print N,ip,$2,ih,$3; r=0;}' -} - filterall() { n=0 diff -uNr a/vtools/vdiff.gpr b/vtools/vdiff.gpr --- a/vtools/vdiff.gpr f015aa9dc6512c23101090d560ff44aff8603f91e83c96a26c74bc257f7124b7a2e7d8ad3447af407cd01e416a48b83a12c248115af2a91bffea6b36edeed723 +++ b/vtools/vdiff.gpr 9213651f0823c96399660f3b7f2e3ba5026a74176e7e83f8ac6e0cbbf13f141a72e4b91c581d8cdda3015c69486469b114d830c12530768286aed84a63ad971c @@ -4,7 +4,9 @@ for Object_Dir use "obj"; for Exec_Dir use "."; for Main use ("diff.c"); - for Excluded_Source_Files use ("vpatch.adb", "ksum.adb", "vflow.adb"); + for Excluded_Source_Files use ("vpatch.adb", "ksum.adb", "vflow.adb", + "vfilter.adb", "vpatch_utils.adb", + "vpatch_utils.ads"); package Builder is for Executable ("diff.c") use "vdiff"; end Builder; diff -uNr a/vtools/vfilter.gpr b/vtools/vfilter.gpr --- a/vtools/vfilter.gpr false +++ b/vtools/vfilter.gpr efaf66fea0cf128535f35fac412a915d042b2481576185b73d1ccdc05f9af8d1658fcb5694d25a9abf6fe26df49db9dc8b60bf05c2025964bdb8dc2b2fd17ca6 @@ -0,0 +1,7 @@ +project Vfilter is + for Languages use ("Ada"); + for Source_Dirs use ("src"); + for Object_Dir use "obj"; + for Exec_Dir use "."; + for Main use ("vfilter.adb"); +end Vfilter;