tree checksum vpatch file split hunks
all signers: phf
antecedents: vtools_fixes_bitrate_char_array vdiff_keccak
press order:
| vtools_genesis | phf |
| vdiff_fixes_newline_gcc | phf |
| keccak | phf |
| vdiff_keccak | phf |
| vtools_fixes_bitrate_char_array | phf |
| vtools_vpatch | phf |
patch:
(2 . 6)(2 . 9)
5 vdiff:
6 gprbuild -Pvdiff.gpr
7
8 vpatch:
9 gprbuild -Pvpatch.gpr
10
11 clean:
12 gprclean -Pvdiff.gpr
13
14 gprclean -Pvpatch.gpr
- DE81A97D5DA86B1A3F934E6AFB04B4AB40AA58163AD292438814FD9CA1DC09D9209C4984099E2E709FBE637CF8046A30B04039E2ABCE74EC565BF2F7881C0E91(3 . 3)(3 . 4)
19 511300 phf keccak Included diana_coman's keccak implementation.
20 511300 phf vdiff_keccak Vdiff hashing and output using Keccak instead of SHA512.
21 512600 phf vtools_fixes_bitrate_char_array Fixes for keccak from diana_coman, different approach to C interop.
22 514700 phf vtools_vpatch Initial vpatch tool implementation in Ada.
-(0 . 0)(1 . 67)
27 with Interfaces; use Interfaces;
28 package body Bits is
29 -- helper functions
30 procedure ToBitstream(S: in String; B: out Bitstream ) is
31 V : Unsigned_8;
32 Pos : Natural;
33 begin
34 Pos := B'First;
35 for C of S loop
36 V := Character'Pos( C );
37 B( Pos ) := Bit( V and 1 );
38 B( Pos + 1 ) := Bit( Shift_Right( V, 1 ) and 1 );
39 B( Pos + 2 ) := Bit( Shift_Right( V, 2 ) and 1 );
40 B( Pos + 3 ) := Bit( Shift_Right( V, 3 ) and 1 );
41 B( Pos + 4 ) := Bit( Shift_Right( V, 4 ) and 1 );
42 B( Pos + 5 ) := Bit( Shift_Right( V, 5 ) and 1 );
43 B( Pos + 6 ) := Bit( Shift_Right( V, 6 ) and 1 );
44 B( Pos + 7 ) := Bit( Shift_Right( V, 7 ) and 1 );
45 Pos := Pos + 8;
46 end loop;
47 end ToBitstream;
48
49 procedure ToString(B: in Bitstream; S: out String ) is
50 N : Natural;
51 Pos : Natural;
52 begin
53 Pos := B'First;
54 for I in S'Range loop
55 N := Natural( B( Pos ) ) +
56 Natural( B( Pos + 1 ) ) * 2 +
57 Natural( B( Pos + 2 ) ) * 4 +
58 Natural( B( Pos + 3 ) ) * 8 +
59 Natural( B( Pos + 4 ) ) * 16 +
60 Natural( B( Pos + 5 ) ) * 32 +
61 Natural( B( Pos + 6 ) ) * 64 +
62 Natural( B( Pos + 7 ) ) * 128;
63 Pos := Pos + 8;
64 S( I ) := Character'Val( N );
65 end loop;
66 end ToString;
67
68 -- direction translation of C function from vdiff
69 procedure ToHex(B: in Bitstream; S: out String) is
70 Bytes: String(1..B'Length/8);
71 Hex_Digits: constant String := "0123456789abcdef";
72 I: Positive := 1;
73 V: Unsigned_8;
74 X: Positive := 1;
75 begin
76 ToString(B, Bytes);
77 for C of S loop
78 V := Character'Pos(C);
79 S(I) := Hex_Digits(Integer(Shift_Right(V, 4) + 1));
80 I := I + 1;
81 S(I) := Hex_Digits(Integer((V and 16#F#) + 1));
82 I := I + 1;
83 end loop;
84 end;
85
86 function ToHex(B: in Bitstream) return String is
87 S: String(1..B'Length/4);
88 begin
89 ToHex(B, S);
90 return S;
91 end;
92
93 end Bits;
-(0 . 0)(1 . 11)
98 package Bits is
99 pragma Pure(Bits);
100
101 type Bit is mod 2;
102 type Bitstream is array( Natural range <> ) of Bit; -- any length; message
103
104 procedure ToBitstream(S: in String; B: out Bitstream);
105 procedure ToString(B: in Bitstream; S: out String);
106 procedure ToHex(B: in Bitstream; S: out String);
107 function ToHex(B: in Bitstream) return String;
108 end Bits;
- 252A6F237724580F4AF2F1FBF2DFF39DCDD7C1A14AC7C17021D4ED0D0939F6394BF2CBCE3E2ECC3261B8474ECF0D7DE34728467679E557A7C44BAD510D070747(1 . 43)(1 . 5)- 9E720F186B11BB3E2D398765619E1E4220659E74BDF9AD4D3BE83EEB51C9A45E5F7A4BFCECE333F5E86B50838874DBC31462EFD45F25294C3661EB069C9E4DB2
113 with Bits; use Bits;
114 package body Keccak_C is
115 -- helper functions
116 procedure ToBitstream(S: in String; B: out Bitstream ) is
117 V : Unsigned_8;
118 Pos : Natural;
119 begin
120 Pos := B'First;
121 for C of S loop
122 V := Character'Pos( C );
123 B( Pos ) := Bit( V and 1 );
124 B( Pos + 1 ) := Bit( Shift_Right( V, 1 ) and 1 );
125 B( Pos + 2 ) := Bit( Shift_Right( V, 2 ) and 1 );
126 B( Pos + 3 ) := Bit( Shift_Right( V, 3 ) and 1 );
127 B( Pos + 4 ) := Bit( Shift_Right( V, 4 ) and 1 );
128 B( Pos + 5 ) := Bit( Shift_Right( V, 5 ) and 1 );
129 B( Pos + 6 ) := Bit( Shift_Right( V, 6 ) and 1 );
130 B( Pos + 7 ) := Bit( Shift_Right( V, 7 ) and 1 );
131 Pos := Pos + 8;
132 end loop;
133 end ToBitstream;
134
135 procedure ToString(B: in Bitstream; S: out String ) is
136 N : Natural;
137 Pos : Natural;
138 begin
139 Pos := B'First;
140 for I in S'Range loop
141 N := Natural( B( Pos ) ) +
142 Natural( B( Pos + 1 ) ) * 2 +
143 Natural( B( Pos + 2 ) ) * 4 +
144 Natural( B( Pos + 3 ) ) * 8 +
145 Natural( B( Pos + 4 ) ) * 16 +
146 Natural( B( Pos + 5 ) ) * 32 +
147 Natural( B( Pos + 6 ) ) * 64 +
148 Natural( B( Pos + 7 ) ) * 128;
149 Pos := Pos + 8;
150 S( I ) := Character'Val( N );
151 end loop;
152 end ToString;
153
154 -- C interface
155
156 procedure C_Get_Size(Size: out Interfaces.C.size_t) is
(62 . 7)(24 . 7)
158 Ptr: Char_Star := Input;
159 begin
160 if Input = null then
161 raise C.Strings.Dereference_Error;
162 raise Strings.Dereference_Error;
163 end if;
164 for Chr of S loop
165 Chr := Character(Ptr.all);
(81 . 7)(43 . 7)
167 Ptr: Char_Star := Output;
168 begin
169 if Output = null then
170 raise C.Strings.Dereference_Error;
171 raise Strings.Dereference_Error;
172 end if;
173 KeccakEnd(Ctx.all, B);
174 ToString(B, S);
(1 . 4)(1 . 3)
179 with Interfaces; use Interfaces;
180 with Interfaces.C; use Interfaces.C;
181 with Interfaces.C.Strings;
182 with Interfaces.C.Pointers;
- 71BCA4B94AE6EA691D3A1FAF6C84AE5D17B803D11607E786C34E2711CABEB6921789AAE27A3A14B9B5CF5216A133EC2E8BD3B06EB1F2B88923F7E65297C2F5F4(5 . 6)(5 . 7)-
187
188 -- S.MG, 2018
189
190 with Bits; use Bits;
191 package SMG_Keccak is
192 pragma Pure(SMG_Keccak); --stateless, no side effects -> can cache calls
193
(38 . 8)(39 . 6)
195 -- the "secret" part of the state (i.e. lower capacity)
196 subtype Keccak_Rate is Positive range 1..Width; -- capacity = width - rate
197
198 type Bit is mod 2;
199 type Bitstream is array( Natural range <> ) of Bit; -- any length; message
200 subtype Bitword is Bitstream( 0..Z_Length - 1 ); -- bits of one state "word"
201
202 -- type conversions
(0 . 0)(1 . 619)
207 with Bits; use Bits;
208 with Interfaces.C;
209 with Interfaces.C.Strings;
210 with Ada.Text_IO; use Ada.Text_IO;
211 with Ada.Integer_Text_IO; use Ada.Integer_Text_IO;
212 with Ada.Strings.Fixed;
213 with Ada.Directories;
214 with Ada.Characters;
215 with Ada.Characters.Handling;
216 with Ada.Characters.Latin_1;
217 with Ada.Sequential_IO;
218 with SMG_Keccak; use SMG_Keccak;
219
220 procedure VPatch is
221 package Latin_1 renames Ada.Characters.Latin_1;
222 package Dirs renames Ada.Directories;
223
224 -- Utilities
225
226 function Starts_With(S: String; Prefix: String) return Boolean is
227 begin
228 if S'Length < Prefix'Length then
229 return False;
230 end if;
231 return S(S'First..S'First+Prefix'Length-1) = Prefix;
232 end;
233
234 function Path_Prefix(Pathname: String;
235 Suffix: Positive) return String is
236 Pos: Natural := Pathname'Last;
237 begin
238 for I in 1..Suffix loop
239 Pos := Ada.Strings.Fixed.Index(Pathname, "/",
240 From => Pos,
241 Going => Ada.Strings.Backward);
242 if Pos = 0 then
243 return Pathname;
244 end if;
245 Pos := Pos - 1;
246 end loop;
247 return Pathname(Pathname'First .. Pos);
248 end;
249
250 function Path_Without_Prefix(Pathname: String;
251 Prefix: Positive) return String is
252 Pos: Natural := 1;
253 begin
254 for I in 1..Prefix loop
255 Pos := Ada.Strings.Fixed.Index(Pathname, "/", From => Pos);
256 if Pos = 0 then
257 return Pathname;
258 end if;
259 Pos := Pos + 1;
260 end loop;
261 return Pathname(Pos .. Pathname'Last);
262 end;
263
264 -- Temporary File
265
266 procedure MkTemp(Template: Interfaces.C.Strings.Chars_Ptr);
267 pragma Import(C, mktemp);
268
269 function Temp_File_Name(Template: String) return String is
270 X: Interfaces.C.Strings.Chars_Ptr
271 := Interfaces.C.Strings.New_String(Template);
272 begin
273 MkTemp(X);
274 declare
275 Result: String := Interfaces.C.Strings.Value(X);
276 begin
277 Interfaces.C.Strings.Free(X);
278 return Result;
279 end;
280 end;
281
282 procedure Create_Temp(File : in out File_Type;
283 Mode : in File_Mode := Out_File;
284 Template : in String := "vpatch.XXX";
285 Form : in String := "") is
286 Name: String := Temp_File_Name(Template);
287 begin
288 Create(File, Mode, Name, Form);
289 end;
290
291 -- VPatch data structures
292
293 type Patch_Op is (Op_Create, Op_Delete, Op_Patch);
294
295 Hash_Length: constant Positive := 128;
296 type Hash_Type is (Empty, Value);
297 type Hash(The_Type: Hash_Type := Empty) is record
298 case The_Type is
299 when Value =>
300 Value: String(1..Hash_Length);
301 when Empty =>
302 null;
303 end case;
304 end record;
305
306 function "=" (Left, Right: in Hash) return Boolean is
307 begin
308 if Left.The_Type = Empty and Right.The_Type = Empty then
309 return True;
310 elsif Left.The_Type = Empty or Right.The_Type = Empty then
311 return False;
312 elsif Left.Value /= Right.Value then
313 return False;
314 else
315 return True;
316 end if;
317 end "=";
318
319 type Header (From_L, To_L: Natural) Is record
320 From_Hash: Hash;
321 From_File: String(1..From_L);
322 To_Hash: Hash;
323 To_File: String(1..To_L);
324 end record;
325
326 function Operation(A_Header: Header) return Patch_Op is
327 begin
328 if A_Header.From_Hash.The_Type = Empty then
329 return Op_Create;
330 elsif A_Header.To_Hash.The_Type = Empty then
331 return Op_Delete;
332 else
333 return Op_Patch;
334 end if;
335 end;
336
337 function Press_Name(A_Header: Header) return String is
338 begin
339 return Path_Without_Prefix(A_Header.From_File, 1);
340 end;
341
342 type Line_Numbers is record
343 Start: Natural;
344 Count: Natural;
345 end record;
346
347 type Hunk is record
348 From_File_Line_Numbers: Line_Numbers;
349 To_File_Line_Numbers: Line_Numbers;
350 end record;
351
352 -- VPatch debug output routines
353
354 procedure Put(A_Line_Numbers: Line_Numbers) is
355 begin
356 Put(A_Line_Numbers.Start);
357 Put(A_Line_Numbers.Count);
358 end;
359
360 procedure Put(A_Hash: Hash) is
361 begin
362 case A_Hash.The_Type is
363 when Value =>
364 Put(A_Hash.Value);
365 when Empty =>
366 Put("no value");
367 end case;
368 end;
369
370 procedure Put(A_Header: Header) is
371 begin
372 Put("from file: ");
373 Put(A_Header.From_File);
374 New_Line;
375 Put("to file: ");
376 Put(A_Header.To_File);
377 New_Line;
378 Put("from hash: ");
379 Put(A_Header.From_Hash);
380 New_Line;
381 Put("to hash: ");
382 Put(A_Header.To_Hash);
383 New_Line;
384 end;
385
386 procedure Put(A_Hunk: Hunk) is
387 begin
388 Put("from file line numbers: ");
389 Put(A_Hunk.From_File_Line_Numbers);
390 New_Line;
391 Put("to file line numbers: ");
392 Put(A_Hunk.To_File_Line_Numbers);
393 New_Line;
394 end;
395
396 -- VPatch parser
397
398 Parse, State: exception;
399
400 procedure Skip_Whitespace is
401 EOL: Boolean;
402 C: Character;
403 begin
404 Skip_Loop:
405 loop
406 Look_Ahead(C, EOL);
407 exit Skip_Loop when EOL;
408 exit Skip_Loop when
409 C /= Latin_1.Space and
410 C /= Latin_1.HT;
411 Get(C);
412 end loop Skip_Loop;
413 end;
414
415 procedure Looking_At(Expected: String) is
416 Actual: String(Expected'Range);
417 begin
418 Get(Actual);
419 if Expected /= Actual then
420 raise Parse with "expected " & Expected & ", got " & Actual;
421 end if;
422 end;
423
424 procedure Next_Line is
425 begin
426 if not End_Of_Line then
427 raise Parse with "expected end of line";
428 end if;
429 Skip_Line;
430 end;
431
432 procedure Get(A_Hash: out Hash) is
433 No_Hash_Label: constant String := "false";
434 V: String(1..Hash_Length);
435 begin
436 Get(V(1..No_Hash_Label'Length));
437 if V(1..No_Hash_Label'Length) = No_Hash_Label then
438 A_Hash := (The_Type => Empty);
439 return;
440 end if;
441 Get(V(No_Hash_Label'Length + 1..V'Last));
442 A_Hash := (The_Type => Value,
443 Value => V);
444 end;
445
446 procedure Get(A_Line_Numbers: out Line_Numbers) is
447 C: Character;
448 Eol: Boolean;
449 begin
450 Get(A_Line_Numbers.Start);
451 Look_Ahead(C, Eol);
452 if Eol then
453 raise Parse;
454 end if;
455 case C is
456 when ' ' =>
457 -- If a hunk contains just one line, only its start line
458 -- number appears.
459 A_Line_Numbers.Count := 1;
460 when ',' =>
461 -- Otherwise its line numbers look like `start,count'. An
462 -- empty hunk is considered to start at the line that
463 -- follows the hunk.
464 Get(C);
465 Get(A_Line_Numbers.Count);
466 when others =>
467 raise Parse;
468 end case;
469 end;
470
471 function Get_Header_Filename return String is
472 EOL: Boolean;
473 Buffer: String(1..1000);
474 C: Character;
475 I: Natural := 0;
476 begin
477 Read_Loop:
478 loop
479 Look_Ahead(C, EOL);
480 exit Read_Loop when EOL;
481 exit Read_Loop when
482 C = Latin_1.Space or C = Latin_1.HT;
483 Get(C);
484 I := I + 1;
485 Buffer(I) := C;
486 end loop Read_Loop;
487 return Buffer(1..I);
488 end;
489
490 function Get_Header return Header is
491 From_Hash: Hash;
492 To_Hash: Hash;
493 begin
494 Looking_At("--- ");
495 declare
496 From_File: String := Get_Header_Filename;
497 begin
498 Skip_Whitespace;
499 Get(From_Hash);
500 Looking_At("+++ ");
501 declare
502 To_File: String := Get_Header_Filename;
503 begin
504 Skip_Whitespace;
505 Get(To_Hash);
506 Next_Line;
507 declare
508 H: Header := (From_L => From_File'Length,
509 To_L => To_File'Length,
510 From_File => From_File,
511 To_File => To_File,
512 From_Hash => From_Hash,
513 To_Hash => To_Hash);
514 begin
515 return H;
516 end;
517 end;
518 end;
519 end;
520
521 procedure Get(A_Hunk: out Hunk) is
522 begin
523 Looking_At("@@ -");
524 Get(A_Hunk.From_File_Line_Numbers);
525 Looking_At(" +");
526 Get(A_Hunk.To_File_Line_Numbers);
527 Looking_At(" @@");
528 Next_Line;
529 end;
530
531 procedure Process_Hunks_For_Header(A_Header: Header) Is
532 EOL: Boolean;
533 C: Character;
534 A_Hunk: Hunk;
535 -- ensure valid line counts
536 From_Count: Natural := 0;
537 To_Count: Natural := 0;
538 Has_Input_File: Boolean;
539 In_F: File_Type;
540 To_F: File_Type;
541 Line: Positive := 1;
542 In_Ctx: Keccak_Context;
543 To_Ctx: Keccak_Context;
544 In_Hash: Bitstream(1..64*8);
545 To_Hash: Bitstream(1..64*8);
546 To_F_Name: constant String := Press_Name(A_Header);
547 Op: Patch_Op;
548
549 procedure Hash_Line(Ctx: in out Keccak_Context; S: String) is
550 B: Bitstream(1..S'Length*8);
551 LF_B: constant Bitstream(1..8) := (0, 1, 0, 1, 0, 0, 0, 0);
552 begin
553 ToBitstream(S, B);
554 KeccakHash(Ctx, B);
555 KeccakHash(Ctx, LF_B);
556 end;
557
558 procedure Check_Input_File_Hash is
559 begin
560 if Has_Input_File then
561 begin
562 Catch_Up_Loop:
563 loop
564 declare
565 In_Line: String := Get_Line(In_F);
566 begin
567 Put_Line(To_F, In_Line);
568 Hash_Line(In_Ctx, In_Line);
569 Hash_Line(To_Ctx, In_Line);
570 end;
571 end loop Catch_Up_Loop;
572 exception
573 when End_Error =>
574 null;
575 end;
576 KeccakEnd(In_Ctx, In_Hash);
577
578 declare
579 Hex_Hash: String := ToHex(In_Hash);
580 H: Hash := (Value => Hex_Hash,
581 The_Type => Value);
582 begin
583 if A_Header.From_Hash /= (Value => Hex_Hash,
584 The_Type => Value) then
585 raise State with "from hash doesn't match";
586 end if;
587 end;
588 end if;
589 end Check_Input_File_Hash;
590
591 procedure Check_Output_File_Hash is
592 begin
593 KeccakEnd(To_Ctx, To_Hash);
594 declare
595 H_Hex: String := ToHex(To_Hash);
596 H: Hash;
597 begin
598 case Op is
599 when Op_Create | Op_Patch =>
600 H := (Value => H_Hex,
601 The_Type => Value);
602 when Op_Delete =>
603 H := (The_Type => Empty);
604 end case;
605 if A_Header.To_Hash /= H then
606 raise State with "to hash doesn't match";
607 end if;
608 end;
609 end Check_Output_File_Hash;
610
611 procedure Cleanup is
612 begin
613 if Is_Open(To_F) then
614 Dirs.Delete_File(Name(To_F));
615 end if;
616 end Cleanup;
617
618 begin
619 Op := Operation(A_Header);
620
621 -- log
622 case Op is
623 when Op_Create => Put_Line("creating " & To_F_Name);
624 when Op_Delete => Put_Line("deleting " & To_F_Name);
625 when Op_Patch => Put_Line("patching " & To_F_Name);
626 end case;
627
628 -- check the file system state
629 case Op is
630 when Op_Delete | Op_Patch =>
631 if not Dirs.Exists(To_F_Name) then
632 raise State with "attempt to "
633 & Patch_Op'Image(Op)
634 & " non existing file " & To_F_Name;
635 end if;
636 when Op_Create =>
637 if Dirs.Exists(To_F_Name) then
638 raise State with "attempt to create a file, but file already exists";
639 end if;
640 end case;
641
642 -- prepare keccak and open files
643 KeccakBegin(To_Ctx);
644 Create_Temp(To_F, Out_File, "tmp.XXX");
645 case Op is
646 when Op_Create =>
647 Has_Input_File := False;
648 when Op_Delete | Op_Patch =>
649 Has_Input_File := True;
650 KeccakBegin(In_Ctx);
651 Open(In_F, In_File, To_F_Name);
652 end case;
653
654 Hunk_Loop:
655 loop
656 Look_Ahead(C, EOL);
657 exit Hunk_Loop when EOL;
658 exit Hunk_Loop when C /= '@';
659 Get(A_Hunk);
660 From_Count := A_Hunk.From_File_Line_Numbers.Count;
661 To_Count := A_Hunk.To_File_Line_Numbers.Count;
662 -- Hunk is not at the beginning of the file, copy lines up to
663 -- start.
664 if Line < A_Hunk.From_File_Line_Numbers.Start then
665 if not Has_Input_File then
666 raise State with "hunk requires before context lines, "
667 & "but there's no input file";
668 end if;
669 while Line < A_Hunk.From_File_Line_Numbers.Start loop
670 if End_Of_File(In_F) then
671 raise State with "hunk requires before context lines, "
672 & "but the file has ended";
673 end if;
674 declare
675 In_Line: String := Get_Line(In_F);
676 begin
677 Hash_Line(In_Ctx, In_Line);
678 Hash_Line(To_Ctx, In_Line);
679 Put_Line(To_F, In_Line);
680 Line := Line + 1;
681 end;
682 end loop;
683 end if;
684 Hunk_Body_Loop:
685 loop
686 exit Hunk_Body_Loop when From_Count = 0 and To_Count = 0;
687 Look_Ahead(C, EOL);
688 if EOL then
689 raise Parse with "blank line in hunk";
690 end if;
691 case C is
692 when '+' => -- line added
693 Get(C);
694 case Op is
695 when Op_Create | Op_Patch => null;
696 when Op_Delete => raise State with "hunk trying to add lines, "
697 & "but the operation is deletion";
698 end case;
699 if To_Count = 0 then
700 raise State with "hunk trying to add lines, "
701 & "but the line count is not valid";
702 end if;
703 declare
704 Patch_Line: String := Get_Line;
705 begin
706 Put_Line(To_F, Patch_Line);
707 Hash_Line(To_Ctx, Patch_Line);
708 end;
709 To_Count := To_Count - 1;
710 when '-' => -- line deleted
711 Get(C);
712 case Op is
713 when Op_Delete | Op_Patch => null;
714 when Op_Create => raise State;
715 end case;
716 if not Has_Input_File then
717 raise State with "hunk trying to remove lines, "
718 & "but the input file doesn't exist";
719 end if;
720 if From_Count = 0 then
721 raise State with "hunk trying to remove lines, "
722 & "when the input file already ended";
723 end if;
724 declare
725 In_Line: String := Get_Line(In_F);
726 Patch_Line: String := Get_Line;
727 begin
728 if In_Line /= Patch_Line then
729 raise State with "lines don't match";
730 end if;
731 Hash_Line(In_Ctx, In_Line);
732 end;
733 Line := Line + 1;
734 From_Count := From_Count - 1;
735 when ' ' => -- line stays the same
736 Get(C);
737 if not Has_Input_File then
738 raise State with "hunk claims identical lines, "
739 & "but the input file doesn't exist";
740 end if;
741 if End_Of_File(In_F) then
742 raise State with "hunk claims identical lines, "
743 & "but the input file has ended";
744 end if;
745 if From_Count = 0 then
746 raise State with "hunk claims identical lines, "
747 & "when input file already ended";
748 end if;
749 declare
750 In_Line: String := Get_Line(In_F);
751 Patch_Line: String := Get_Line;
752 begin
753 if In_Line /= Patch_Line then
754 raise State with "lines don't match";
755 end if;
756 Put_Line(To_F, Patch_Line);
757 Hash_Line(In_Ctx, In_Line);
758 Hash_Line(To_Ctx, In_Line);
759 end;
760 Line := Line + 1;
761 From_Count := From_Count - 1;
762 To_Count := To_Count - 1;
763 when others =>
764 raise Parse with "unexpected character "
765 & Character'Image(C)
766 & " at beginning of line in hunk body";
767 end case;
768 end loop Hunk_Body_Loop;
769 end loop Hunk_Loop;
770
771 Check_Input_File_Hash;
772 Check_Output_File_Hash;
773
774 declare
775 Tmp_Name: String := Name(To_F);
776 begin
777 Close(To_F);
778 if Has_Input_File then
779 Close(In_F);
780 Dirs.Delete_File(To_F_Name);
781 else
782 if not Dirs.Exists(Path_Prefix(To_F_Name, 1)) then
783 Dirs.Create_Path(Path_Prefix(To_F_Name, 1));
784 end if;
785 end if;
786 case Op is
787 when Op_Create | Op_Patch =>
788 Dirs.Rename(Tmp_Name, To_F_Name);
789 when Op_Delete =>
790 Dirs.Delete_File(Tmp_Name);
791 end case;
792 end;
793
794 exception
795 when E : State =>
796 -- we've encountered state issue,
797 -- check first that the input hash is valid
798 Cleanup;
799 Check_Input_File_Hash;
800 raise;
801
802 when E : others =>
803 Cleanup;
804 raise;
805 end Process_Hunks_For_Header;
806
807 begin
808 Read_Loop:
809 loop
810 declare
811 S: String := Get_Line;
812 begin
813 if Starts_With(S, "diff ") then
814 declare
815 H: Header := Get_Header;
816 begin
817 Process_Hunks_For_Header(H);
818 exit Read_Loop when End_Of_File;
819 end;
820 else
821 Put_Line("Prelude: " & S);
822 end if;
823 end;
824 end loop Read_Loop;
825 end;
- 145A4C9BDC6DA1FAE51C1C4F8DA23F73DB1D7BADDD59B5E4D630E1DF2C8AC6E7FC00A37529A1F679FF68F57E60E495AC4360A7CB90C02A35093ED8A3D66FE696(4 . 6)(4 . 7)
830 for Object_Dir use "obj";
831 for Exec_Dir use ".";
832 for Main use ("diff.c");
833 for Excluded_Source_Files use ("vpatch.adb");
834 package Builder is
835 for Executable ("diff.c") use "vdiff";
836 end Builder;
-(0 . 0)(1 . 7)
841 project Vpatch is
842 for Languages use ("Ada");
843 for Source_Dirs use ("src");
844 for Object_Dir use "obj";
845 for Exec_Dir use ".";
846 for Main use ("vpatch.adb");
847 end Vpatch;