vtools_vpatch 1 with Bits; use Bits;
vtools_vpatch 2 with Interfaces.C;
vtools_vpatch 3 with Interfaces.C.Strings;
vtools_vpatch 4 with Ada.Text_IO; use Ada.Text_IO;
vtools_vpatch 5 with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
vtools_vpatch 6 with Ada.Strings.Fixed;
vtools_vpatch 7 with Ada.Directories;
vtools_vpatch 8 with Ada.Characters;
vtools_vpatch 9 with Ada.Characters.Handling;
vtools_vpatch 10 with Ada.Characters.Latin_1;
vtools_vpatch 11 with Ada.Sequential_IO;
vtools_vpatch 12 with SMG_Keccak; use SMG_Keccak;
vtools_vpatch 13
vtools_vpatch 14 procedure VPatch is
vtools_vpatch 15 package Latin_1 renames Ada.Characters.Latin_1;
vtools_vpatch 16 package Dirs renames Ada.Directories;
vtools_vpatch 17
vtools_vpatch 18
vtools_vpatch 19
vtools_vpatch 20 function Starts_With(S: String; Prefix: String) return Boolean is
vtools_vpatch 21 begin
vtools_vpatch 22 if S'Length < Prefix'Length then
vtools_vpatch 23 return False;
vtools_vpatch 24 end if;
vtools_vpatch 25 return S(S'First..S'First+Prefix'Length-1) = Prefix;
vtools_vpatch 26 end;
vtools_vpatch 27
vtools_vpatch 28 function Path_Prefix(Pathname: String;
vtools_vpatch 29 Suffix: Positive) return String is
vtools_vpatch 30 Pos: Natural := Pathname'Last;
vtools_vpatch 31 begin
vtools_vpatch 32 for I in 1..Suffix loop
vtools_vpatch 33 Pos := Ada.Strings.Fixed.Index(Pathname, "/",
vtools_vpatch 34 From => Pos,
vtools_vpatch 35 Going => Ada.Strings.Backward);
vtools_vpatch 36 if Pos = 0 then
vtools_vpatch 37 return Pathname;
vtools_vpatch 38 end if;
vtools_vpatch 39 Pos := Pos - 1;
vtools_vpatch 40 end loop;
vtools_vpatch 41 return Pathname(Pathname'First .. Pos);
vtools_vpatch 42 end;
vtools_vpatch 43
vtools_vpatch 44 function Path_Without_Prefix(Pathname: String;
vtools_vpatch 45 Prefix: Positive) return String is
vtools_vpatch 46 Pos: Natural := 1;
vtools_vpatch 47 begin
vtools_vpatch 48 for I in 1..Prefix loop
vtools_vpatch 49 Pos := Ada.Strings.Fixed.Index(Pathname, "/", From => Pos);
vtools_vpatch 50 if Pos = 0 then
vtools_vpatch 51 return Pathname;
vtools_vpatch 52 end if;
vtools_vpatch 53 Pos := Pos + 1;
vtools_vpatch 54 end loop;
vtools_vpatch 55 return Pathname(Pos .. Pathname'Last);
vtools_vpatch 56 end;
vtools_vpatch 57
vtools_vpatch 58
vtools_vpatch 59
vtools_vpatch 60 procedure MkTemp(Template: Interfaces.C.Strings.Chars_Ptr);
vtools_vpatch 61 pragma Import(C, mktemp);
vtools_vpatch 62
vtools_vpatch 63 function Temp_File_Name(Template: String) return String is
vtools_vpatch 64 X: Interfaces.C.Strings.Chars_Ptr
vtools_vpatch 65 := Interfaces.C.Strings.New_String(Template);
vtools_vpatch 66 begin
vtools_vpatch 67 MkTemp(X);
vtools_vpatch 68 declare
vtools_vpatch 69 Result: String := Interfaces.C.Strings.Value(X);
vtools_vpatch 70 begin
vtools_vpatch 71 Interfaces.C.Strings.Free(X);
vtools_vpatch 72 return Result;
vtools_vpatch 73 end;
vtools_vpatch 74 end;
vtools_vpatch 75
vtools_vpatch 76 procedure Create_Temp(File : in out File_Type;
vtools_vpatch 77 Mode : in File_Mode := Out_File;
vtools_vpatch 78 Template : in String := "vpatch.XXX";
vtools_vpatch 79 Form : in String := "") is
vtools_vpatch 80 Name: String := Temp_File_Name(Template);
vtools_vpatch 81 begin
vtools_vpatch 82 Create(File, Mode, Name, Form);
vtools_vpatch 83 end;
vtools_vpatch 84
vtools_vpatch 85
vtools_vpatch 86
vtools_vpatch 87 type Patch_Op is (Op_Create, Op_Delete, Op_Patch);
vtools_vpatch 88
vtools_vpatch 89 Hash_Length: constant Positive := 128;
vtools_vpatch 90 type Hash_Type is (Empty, Value);
vtools_vpatch 91 type Hash(The_Type: Hash_Type := Empty) is record
vtools_vpatch 92 case The_Type is
vtools_vpatch 93 when Value =>
vtools_vpatch 94 Value: String(1..Hash_Length);
vtools_vpatch 95 when Empty =>
vtools_vpatch 96 null;
vtools_vpatch 97 end case;
vtools_vpatch 98 end record;
vtools_vpatch 99
vtools_vpatch 100 function "=" (Left, Right: in Hash) return Boolean is
vtools_vpatch 101 begin
vtools_vpatch 102 if Left.The_Type = Empty and Right.The_Type = Empty then
vtools_vpatch 103 return True;
vtools_vpatch 104 elsif Left.The_Type = Empty or Right.The_Type = Empty then
vtools_vpatch 105 return False;
vtools_vpatch 106 elsif Left.Value /= Right.Value then
vtools_vpatch 107 return False;
vtools_vpatch 108 else
vtools_vpatch 109 return True;
vtools_vpatch 110 end if;
vtools_vpatch 111 end "=";
vtools_vpatch 112
vtools_vpatch 113 type Header (From_L, To_L: Natural) Is record
vtools_vpatch 114 From_Hash: Hash;
vtools_vpatch 115 From_File: String(1..From_L);
vtools_vpatch 116 To_Hash: Hash;
vtools_vpatch 117 To_File: String(1..To_L);
vtools_vpatch 118 end record;
vtools_vpatch 119
vtools_vpatch 120 function Operation(A_Header: Header) return Patch_Op is
vtools_vpatch 121 begin
vtools_vpatch 122 if A_Header.From_Hash.The_Type = Empty then
vtools_vpatch 123 return Op_Create;
vtools_vpatch 124 elsif A_Header.To_Hash.The_Type = Empty then
vtools_vpatch 125 return Op_Delete;
vtools_vpatch 126 else
vtools_vpatch 127 return Op_Patch;
vtools_vpatch 128 end if;
vtools_vpatch 129 end;
vtools_vpatch 130
vtools_vpatch 131 function Press_Name(A_Header: Header) return String is
vtools_vpatch 132 begin
vtools_vpatch 133 return Path_Without_Prefix(A_Header.From_File, 1);
vtools_vpatch 134 end;
vtools_vpatch 135
vtools_vpatch 136 type Line_Numbers is record
vtools_vpatch 137 Start: Natural;
vtools_vpatch 138 Count: Natural;
vtools_vpatch 139 end record;
vtools_vpatch 140
vtools_vpatch 141 type Hunk is record
vtools_vpatch 142 From_File_Line_Numbers: Line_Numbers;
vtools_vpatch 143 To_File_Line_Numbers: Line_Numbers;
vtools_vpatch 144 end record;
vtools_vpatch 145
vtools_vpatch 146
vtools_vpatch 147
vtools_vpatch 148 procedure Put(A_Line_Numbers: Line_Numbers) is
vtools_vpatch 149 begin
vtools_vpatch 150 Put(A_Line_Numbers.Start);
vtools_vpatch 151 Put(A_Line_Numbers.Count);
vtools_vpatch 152 end;
vtools_vpatch 153
vtools_vpatch 154 procedure Put(A_Hash: Hash) is
vtools_vpatch 155 begin
vtools_vpatch 156 case A_Hash.The_Type is
vtools_vpatch 157 when Value =>
vtools_vpatch 158 Put(A_Hash.Value);
vtools_vpatch 159 when Empty =>
vtools_vpatch 160 Put("no value");
vtools_vpatch 161 end case;
vtools_vpatch 162 end;
vtools_vpatch 163
vtools_vpatch 164 procedure Put(A_Header: Header) is
vtools_vpatch 165 begin
vtools_vpatch 166 Put("from file: ");
vtools_vpatch 167 Put(A_Header.From_File);
vtools_vpatch 168 New_Line;
vtools_vpatch 169 Put("to file: ");
vtools_vpatch 170 Put(A_Header.To_File);
vtools_vpatch 171 New_Line;
vtools_vpatch 172 Put("from hash: ");
vtools_vpatch 173 Put(A_Header.From_Hash);
vtools_vpatch 174 New_Line;
vtools_vpatch 175 Put("to hash: ");
vtools_vpatch 176 Put(A_Header.To_Hash);
vtools_vpatch 177 New_Line;
vtools_vpatch 178 end;
vtools_vpatch 179
vtools_vpatch 180 procedure Put(A_Hunk: Hunk) is
vtools_vpatch 181 begin
vtools_vpatch 182 Put("from file line numbers: ");
vtools_vpatch 183 Put(A_Hunk.From_File_Line_Numbers);
vtools_vpatch 184 New_Line;
vtools_vpatch 185 Put("to file line numbers: ");
vtools_vpatch 186 Put(A_Hunk.To_File_Line_Numbers);
vtools_vpatch 187 New_Line;
vtools_vpatch 188 end;
vtools_vpatch 189
vtools_vpatch 190
vtools_vpatch 191
vtools_vpatch 192 Parse, State: exception;
vtools_vpatch 193
vtools_vpatch 194 procedure Skip_Whitespace is
vtools_vpatch 195 EOL: Boolean;
vtools_vpatch 196 C: Character;
vtools_vpatch 197 begin
vtools_vpatch 198 Skip_Loop:
vtools_vpatch 199 loop
vtools_vpatch 200 Look_Ahead(C, EOL);
vtools_vpatch 201 exit Skip_Loop when EOL;
vtools_vpatch 202 exit Skip_Loop when
vtools_vpatch 203 C /= Latin_1.Space and
vtools_vpatch 204 C /= Latin_1.HT;
vtools_vpatch 205 Get(C);
vtools_vpatch 206 end loop Skip_Loop;
vtools_vpatch 207 end;
vtools_vpatch 208
vtools_vpatch 209 procedure Looking_At(Expected: String) is
vtools_vpatch 210 Actual: String(Expected'Range);
vtools_vpatch 211 begin
vtools_vpatch 212 Get(Actual);
vtools_vpatch 213 if Expected /= Actual then
vtools_vpatch 214 raise Parse with "expected " & Expected & ", got " & Actual;
vtools_vpatch 215 end if;
vtools_vpatch 216 end;
vtools_vpatch 217
vtools_vpatch 218 procedure Next_Line is
vtools_vpatch 219 begin
vtools_vpatch 220 if not End_Of_Line then
vtools_vpatch 221 raise Parse with "expected end of line";
vtools_vpatch 222 end if;
vtools_vpatch 223 Skip_Line;
vtools_vpatch 224 end;
vtools_vpatch 225
vtools_vpatch 226 procedure Get(A_Hash: out Hash) is
vtools_vpatch 227 No_Hash_Label: constant String := "false";
vtools_vpatch 228 V: String(1..Hash_Length);
vtools_vpatch 229 begin
vtools_vpatch 230 Get(V(1..No_Hash_Label'Length));
vtools_vpatch 231 if V(1..No_Hash_Label'Length) = No_Hash_Label then
vtools_vpatch 232 A_Hash := (The_Type => Empty);
vtools_vpatch 233 return;
vtools_vpatch 234 end if;
vtools_vpatch 235 Get(V(No_Hash_Label'Length + 1..V'Last));
vtools_vpatch 236 A_Hash := (The_Type => Value,
vtools_vpatch 237 Value => V);
vtools_vpatch 238 end;
vtools_vpatch 239
vtools_vpatch 240 procedure Get(A_Line_Numbers: out Line_Numbers) is
vtools_vpatch 241 C: Character;
vtools_vpatch 242 Eol: Boolean;
vtools_vpatch 243 begin
vtools_vpatch 244 Get(A_Line_Numbers.Start);
vtools_vpatch 245 Look_Ahead(C, Eol);
vtools_vpatch 246 if Eol then
vtools_vpatch 247 raise Parse;
vtools_vpatch 248 end if;
vtools_vpatch 249 case C is
vtools_vpatch 250 when ' ' =>
vtools_vpatch 251
vtools_vpatch 252
vtools_vpatch 253 A_Line_Numbers.Count := 1;
vtools_vpatch 254 when ',' =>
vtools_vpatch 255
vtools_vpatch 256
vtools_vpatch 257
vtools_vpatch 258 Get(C);
vtools_vpatch 259 Get(A_Line_Numbers.Count);
vtools_vpatch 260 when others =>
vtools_vpatch 261 raise Parse;
vtools_vpatch 262 end case;
vtools_vpatch 263 end;
vtools_vpatch 264
vtools_vpatch 265 function Get_Header_Filename return String is
vtools_vpatch 266 EOL: Boolean;
vtools_vpatch 267 Buffer: String(1..1000);
vtools_vpatch 268 C: Character;
vtools_vpatch 269 I: Natural := 0;
vtools_vpatch 270 begin
vtools_vpatch 271 Read_Loop:
vtools_vpatch 272 loop
vtools_vpatch 273 Look_Ahead(C, EOL);
vtools_vpatch 274 exit Read_Loop when EOL;
vtools_vpatch 275 exit Read_Loop when
vtools_vpatch 276 C = Latin_1.Space or C = Latin_1.HT;
vtools_vpatch 277 Get(C);
vtools_vpatch 278 I := I + 1;
vtools_vpatch 279 Buffer(I) := C;
vtools_vpatch 280 end loop Read_Loop;
vtools_vpatch 281 return Buffer(1..I);
vtools_vpatch 282 end;
vtools_vpatch 283
vtools_vpatch 284 function Get_Header return Header is
vtools_vpatch 285 From_Hash: Hash;
vtools_vpatch 286 To_Hash: Hash;
vtools_vpatch 287 begin
vtools_vpatch 288 Looking_At("--- ");
vtools_vpatch 289 declare
vtools_vpatch 290 From_File: String := Get_Header_Filename;
vtools_vpatch 291 begin
vtools_vpatch 292 Skip_Whitespace;
vtools_vpatch 293 Get(From_Hash);
vtools_vpatch 294 Looking_At("+++ ");
vtools_vpatch 295 declare
vtools_vpatch 296 To_File: String := Get_Header_Filename;
vtools_vpatch 297 begin
vtools_vpatch 298 Skip_Whitespace;
vtools_vpatch 299 Get(To_Hash);
vtools_vpatch 300 Next_Line;
vtools_vpatch 301 declare
vtools_vpatch 302 H: Header := (From_L => From_File'Length,
vtools_vpatch 303 To_L => To_File'Length,
vtools_vpatch 304 From_File => From_File,
vtools_vpatch 305 To_File => To_File,
vtools_vpatch 306 From_Hash => From_Hash,
vtools_vpatch 307 To_Hash => To_Hash);
vtools_vpatch 308 begin
vtools_vpatch 309 return H;
vtools_vpatch 310 end;
vtools_vpatch 311 end;
vtools_vpatch 312 end;
vtools_vpatch 313 end;
vtools_vpatch 314
vtools_vpatch 315 procedure Get(A_Hunk: out Hunk) is
vtools_vpatch 316 begin
vtools_vpatch 317 Looking_At("@@ -");
vtools_vpatch 318 Get(A_Hunk.From_File_Line_Numbers);
vtools_vpatch 319 Looking_At(" +");
vtools_vpatch 320 Get(A_Hunk.To_File_Line_Numbers);
vtools_vpatch 321 Looking_At(" @@");
vtools_vpatch 322 Next_Line;
vtools_vpatch 323 end;
vtools_vpatch 324
vtools_vpatch 325 procedure Process_Hunks_For_Header(A_Header: Header) Is
vtools_vpatch 326 EOL: Boolean;
vtools_vpatch 327 C: Character;
vtools_vpatch 328 A_Hunk: Hunk;
vtools_vpatch 329
vtools_vpatch 330 From_Count: Natural := 0;
vtools_vpatch 331 To_Count: Natural := 0;
vtools_vpatch 332 Has_Input_File: Boolean;
vtools_vpatch 333 In_F: File_Type;
vtools_vpatch 334 To_F: File_Type;
vtools_vpatch 335 Line: Positive := 1;
vtools_vpatch 336 In_Ctx: Keccak_Context;
vtools_vpatch 337 To_Ctx: Keccak_Context;
vtools_vpatch 338 In_Hash: Bitstream(1..64*8);
vtools_vpatch 339 To_Hash: Bitstream(1..64*8);
vtools_vpatch 340 To_F_Name: constant String := Press_Name(A_Header);
vtools_vpatch 341 Op: Patch_Op;
vtools_vpatch 342
vtools_vpatch 343 procedure Hash_Line(Ctx: in out Keccak_Context; S: String) is
vtools_vpatch 344 B: Bitstream(1..S'Length*8);
vtools_vpatch 345 LF_B: constant Bitstream(1..8) := (0, 1, 0, 1, 0, 0, 0, 0);
vtools_vpatch 346 begin
vtools_vpatch 347 ToBitstream(S, B);
vtools_vpatch 348 KeccakHash(Ctx, B);
vtools_vpatch 349 KeccakHash(Ctx, LF_B);
vtools_vpatch 350 end;
vtools_vpatch 351
vtools_vpatch 352 procedure Check_Input_File_Hash is
vtools_vpatch 353 begin
vtools_vpatch 354 if Has_Input_File then
vtools_vpatch 355 begin
vtools_vpatch 356 Catch_Up_Loop:
vtools_vpatch 357 loop
vtools_vpatch 358 declare
vtools_vpatch 359 In_Line: String := Get_Line(In_F);
vtools_vpatch 360 begin
vtools_vpatch 361 Put_Line(To_F, In_Line);
vtools_vpatch 362 Hash_Line(In_Ctx, In_Line);
vtools_vpatch 363 Hash_Line(To_Ctx, In_Line);
vtools_vpatch 364 end;
vtools_vpatch 365 end loop Catch_Up_Loop;
vtools_vpatch 366 exception
vtools_vpatch 367 when End_Error =>
vtools_vpatch 368 null;
vtools_vpatch 369 end;
vtools_vpatch 370 KeccakEnd(In_Ctx, In_Hash);
vtools_vpatch 371
vtools_vpatch 372 declare
vtools_vpatch 373 Hex_Hash: String := ToHex(In_Hash);
vtools_vpatch 374 H: Hash := (Value => Hex_Hash,
vtools_vpatch 375 The_Type => Value);
vtools_vpatch 376 begin
vtools_vpatch 377 if A_Header.From_Hash /= (Value => Hex_Hash,
vtools_vpatch 378 The_Type => Value) then
vtools_vpatch 379 raise State with "from hash doesn't match";
vtools_vpatch 380 end if;
vtools_vpatch 381 end;
vtools_vpatch 382 end if;
vtools_vpatch 383 end Check_Input_File_Hash;
vtools_vpatch 384
vtools_vpatch 385 procedure Check_Output_File_Hash is
vtools_vpatch 386 begin
vtools_vpatch 387 KeccakEnd(To_Ctx, To_Hash);
vtools_vpatch 388 declare
vtools_vpatch 389 H_Hex: String := ToHex(To_Hash);
vtools_vpatch 390 H: Hash;
vtools_vpatch 391 begin
vtools_vpatch 392 case Op is
vtools_vpatch 393 when Op_Create | Op_Patch =>
vtools_vpatch 394 H := (Value => H_Hex,
vtools_vpatch 395 The_Type => Value);
vtools_vpatch 396 when Op_Delete =>
vtools_vpatch 397 H := (The_Type => Empty);
vtools_vpatch 398 end case;
vtools_vpatch 399 if A_Header.To_Hash /= H then
vtools_vpatch 400 raise State with "to hash doesn't match";
vtools_vpatch 401 end if;
vtools_vpatch 402 end;
vtools_vpatch 403 end Check_Output_File_Hash;
vtools_vpatch 404
vtools_vpatch 405 procedure Cleanup is
vtools_vpatch 406 begin
vtools_vpatch 407 if Is_Open(To_F) then
vtools_vpatch 408 Dirs.Delete_File(Name(To_F));
vtools_vpatch 409 end if;
vtools_vpatch 410 end Cleanup;
vtools_vpatch 411
vtools_vpatch 412 begin
vtools_vpatch 413 Op := Operation(A_Header);
vtools_vpatch 414
vtools_vpatch 415
vtools_vpatch 416 case Op is
vtools_vpatch 417 when Op_Create => Put_Line("creating " & To_F_Name);
vtools_vpatch 418 when Op_Delete => Put_Line("deleting " & To_F_Name);
vtools_vpatch 419 when Op_Patch => Put_Line("patching " & To_F_Name);
vtools_vpatch 420 end case;
vtools_vpatch 421
vtools_vpatch 422
vtools_vpatch 423 case Op is
vtools_vpatch 424 when Op_Delete | Op_Patch =>
vtools_vpatch 425 if not Dirs.Exists(To_F_Name) then
vtools_vpatch 426 raise State with "attempt to "
vtools_vpatch 427 & Patch_Op'Image(Op)
vtools_vpatch 428 & " non existing file " & To_F_Name;
vtools_vpatch 429 end if;
vtools_vpatch 430 when Op_Create =>
vtools_vpatch 431 if Dirs.Exists(To_F_Name) then
vtools_vpatch 432 raise State with "attempt to create a file, but file already exists";
vtools_vpatch 433 end if;
vtools_vpatch 434 end case;
vtools_vpatch 435
vtools_vpatch 436
vtools_vpatch 437 KeccakBegin(To_Ctx);
vtools_vpatch 438 Create_Temp(To_F, Out_File, "tmp.XXX");
vtools_vpatch 439 case Op is
vtools_vpatch 440 when Op_Create =>
vtools_vpatch 441 Has_Input_File := False;
vtools_vpatch 442 when Op_Delete | Op_Patch =>
vtools_vpatch 443 Has_Input_File := True;
vtools_vpatch 444 KeccakBegin(In_Ctx);
vtools_vpatch 445 Open(In_F, In_File, To_F_Name);
vtools_vpatch 446 end case;
vtools_vpatch 447
vtools_vpatch 448 Hunk_Loop:
vtools_vpatch 449 loop
vtools_vpatch 450 Look_Ahead(C, EOL);
vtools_vpatch 451 exit Hunk_Loop when EOL;
vtools_vpatch 452 exit Hunk_Loop when C /= '@';
vtools_vpatch 453 Get(A_Hunk);
vtools_vpatch 454 From_Count := A_Hunk.From_File_Line_Numbers.Count;
vtools_vpatch 455 To_Count := A_Hunk.To_File_Line_Numbers.Count;
vtools_vpatch 456
vtools_vpatch 457
vtools_vpatch 458 if Line < A_Hunk.From_File_Line_Numbers.Start then
vtools_vpatch 459 if not Has_Input_File then
vtools_vpatch 460 raise State with "hunk requires before context lines, "
vtools_vpatch 461 & "but there's no input file";
vtools_vpatch 462 end if;
vtools_vpatch 463 while Line < A_Hunk.From_File_Line_Numbers.Start loop
vtools_vpatch 464 if End_Of_File(In_F) then
vtools_vpatch 465 raise State with "hunk requires before context lines, "
vtools_vpatch 466 & "but the file has ended";
vtools_vpatch 467 end if;
vtools_vpatch 468 declare
vtools_vpatch 469 In_Line: String := Get_Line(In_F);
vtools_vpatch 470 begin
vtools_vpatch 471 Hash_Line(In_Ctx, In_Line);
vtools_vpatch 472 Hash_Line(To_Ctx, In_Line);
vtools_vpatch 473 Put_Line(To_F, In_Line);
vtools_vpatch 474 Line := Line + 1;
vtools_vpatch 475 end;
vtools_vpatch 476 end loop;
vtools_vpatch 477 end if;
vtools_vpatch 478 Hunk_Body_Loop:
vtools_vpatch 479 loop
vtools_vpatch 480 exit Hunk_Body_Loop when From_Count = 0 and To_Count = 0;
vtools_vpatch 481 Look_Ahead(C, EOL);
vtools_vpatch 482 if EOL then
vtools_vpatch 483 raise Parse with "blank line in hunk";
vtools_vpatch 484 end if;
vtools_vpatch 485 case C is
vtools_vpatch 486 when '+' =>
vtools_vpatch 487 Get(C);
vtools_vpatch 488 case Op is
vtools_vpatch 489 when Op_Create | Op_Patch => null;
vtools_vpatch 490 when Op_Delete => raise State with "hunk trying to add lines, "
vtools_vpatch 491 & "but the operation is deletion";
vtools_vpatch 492 end case;
vtools_vpatch 493 if To_Count = 0 then
vtools_vpatch 494 raise State with "hunk trying to add lines, "
vtools_vpatch 495 & "but the line count is not valid";
vtools_vpatch 496 end if;
vtools_vpatch 497 declare
vtools_vpatch 498 Patch_Line: String := Get_Line;
vtools_vpatch 499 begin
vtools_vpatch 500 Put_Line(To_F, Patch_Line);
vtools_vpatch 501 Hash_Line(To_Ctx, Patch_Line);
vtools_vpatch 502 end;
vtools_vpatch 503 To_Count := To_Count - 1;
vtools_vpatch 504 when '-' =>
vtools_vpatch 505 Get(C);
vtools_vpatch 506 case Op is
vtools_vpatch 507 when Op_Delete | Op_Patch => null;
vtools_vpatch 508 when Op_Create => raise State;
vtools_vpatch 509 end case;
vtools_vpatch 510 if not Has_Input_File then
vtools_vpatch 511 raise State with "hunk trying to remove lines, "
vtools_vpatch 512 & "but the input file doesn't exist";
vtools_vpatch 513 end if;
vtools_vpatch 514 if From_Count = 0 then
vtools_vpatch 515 raise State with "hunk trying to remove lines, "
vtools_vpatch 516 & "when the input file already ended";
vtools_vpatch 517 end if;
vtools_vpatch 518 declare
vtools_vpatch 519 In_Line: String := Get_Line(In_F);
vtools_vpatch 520 Patch_Line: String := Get_Line;
vtools_vpatch 521 begin
vtools_vpatch 522 if In_Line /= Patch_Line then
vtools_vpatch 523 raise State with "lines don't match";
vtools_vpatch 524 end if;
vtools_vpatch 525 Hash_Line(In_Ctx, In_Line);
vtools_vpatch 526 end;
vtools_vpatch 527 Line := Line + 1;
vtools_vpatch 528 From_Count := From_Count - 1;
vtools_vpatch 529 when ' ' =>
vtools_vpatch 530 Get(C);
vtools_vpatch 531 if not Has_Input_File then
vtools_vpatch 532 raise State with "hunk claims identical lines, "
vtools_vpatch 533 & "but the input file doesn't exist";
vtools_vpatch 534 end if;
vtools_vpatch 535 if End_Of_File(In_F) then
vtools_vpatch 536 raise State with "hunk claims identical lines, "
vtools_vpatch 537 & "but the input file has ended";
vtools_vpatch 538 end if;
vtools_vpatch 539 if From_Count = 0 then
vtools_vpatch 540 raise State with "hunk claims identical lines, "
vtools_vpatch 541 & "when input file already ended";
vtools_vpatch 542 end if;
vtools_vpatch 543 declare
vtools_vpatch 544 In_Line: String := Get_Line(In_F);
vtools_vpatch 545 Patch_Line: String := Get_Line;
vtools_vpatch 546 begin
vtools_vpatch 547 if In_Line /= Patch_Line then
vtools_vpatch 548 raise State with "lines don't match";
vtools_vpatch 549 end if;
vtools_vpatch 550 Put_Line(To_F, Patch_Line);
vtools_vpatch 551 Hash_Line(In_Ctx, In_Line);
vtools_vpatch 552 Hash_Line(To_Ctx, In_Line);
vtools_vpatch 553 end;
vtools_vpatch 554 Line := Line + 1;
vtools_vpatch 555 From_Count := From_Count - 1;
vtools_vpatch 556 To_Count := To_Count - 1;
vtools_vpatch 557 when others =>
vtools_vpatch 558 raise Parse with "unexpected character "
vtools_vpatch 559 & Character'Image(C)
vtools_vpatch 560 & " at beginning of line in hunk body";
vtools_vpatch 561 end case;
vtools_vpatch 562 end loop Hunk_Body_Loop;
vtools_vpatch 563 end loop Hunk_Loop;
vtools_vpatch 564
vtools_vpatch 565 Check_Input_File_Hash;
vtools_vpatch 566 Check_Output_File_Hash;
vtools_vpatch 567
vtools_vpatch 568 declare
vtools_vpatch 569 Tmp_Name: String := Name(To_F);
vtools_vpatch 570 begin
vtools_vpatch 571 Close(To_F);
vtools_vpatch 572 if Has_Input_File then
vtools_vpatch 573 Close(In_F);
vtools_vpatch 574 Dirs.Delete_File(To_F_Name);
vtools_vpatch 575 else
vtools_vpatch 576 if not Dirs.Exists(Path_Prefix(To_F_Name, 1)) then
vtools_vpatch 577 Dirs.Create_Path(Path_Prefix(To_F_Name, 1));
vtools_vpatch 578 end if;
vtools_vpatch 579 end if;
vtools_vpatch 580 case Op is
vtools_vpatch 581 when Op_Create | Op_Patch =>
vtools_vpatch 582 Dirs.Rename(Tmp_Name, To_F_Name);
vtools_vpatch 583 when Op_Delete =>
vtools_vpatch 584 Dirs.Delete_File(Tmp_Name);
vtools_vpatch 585 end case;
vtools_vpatch 586 end;
vtools_vpatch 587
vtools_vpatch 588 exception
vtools_vpatch 589 when E : State =>
vtools_vpatch 590
vtools_vpatch 591
vtools_vpatch 592 Cleanup;
vtools_vpatch 593 Check_Input_File_Hash;
vtools_vpatch 594 raise;
vtools_vpatch 595
vtools_vpatch 596 when E : others =>
vtools_vpatch 597 Cleanup;
vtools_vpatch 598 raise;
vtools_vpatch 599 end Process_Hunks_For_Header;
vtools_vpatch 600
vtools_vpatch 601 begin
vtools_vpatch 602 Read_Loop:
vtools_vpatch 603 loop
vtools_vpatch 604 declare
vtools_vpatch 605 S: String := Get_Line;
vtools_vpatch 606 begin
vtools_vpatch 607 if Starts_With(S, "diff ") then
vtools_vpatch 608 declare
vtools_vpatch 609 H: Header := Get_Header;
vtools_vpatch 610 begin
vtools_vpatch 611 Process_Hunks_For_Header(H);
vtools_vpatch 612 exit Read_Loop when End_Of_File;
vtools_vpatch 613 end;
vtools_vpatch 614 else
vtools_vpatch 615 Put_Line("Prelude: " & S);
vtools_vpatch 616 end if;
vtools_vpatch 617 end;
vtools_vpatch 618 end loop Read_Loop;
vtools_vpatch 619 end;