vfs/extfs/patchfs.in

   1 #! @PERL@ -w
   2 #
   3 # Written by Adam Byrtek <alpha@debian.org>, 2002
   4 # Rewritten by David Sterba <dave@jikos.cz>, 2009
   5 #
   6 # Extfs to handle patches in context and unified diff format.
   7 # Known issues: When name of file to patch is modified during editing,
   8 # hunk is duplicated on copyin. It is unavoidable.
   9
  10 use bytes;
  11 use strict;
  12 use POSIX;
  13 use File::Temp 'tempfile';
  14
  15 # standard binaries
  16 my $lzma = 'lzma';
  17 my $xz   = 'xz';
  18 my $bzip = 'bzip2';
  19 my $gzip = 'gzip';
  20 my $fileutil = 'file -b';
  21
  22 # date parsing requires Date::Parse from TimeDate module
  23 my $parsedates = eval 'require Date::Parse';
  24
  25 # regular expressions
  26 my $unified_header=qr/^--- .*\n\+\+\+ .*\n$/;
  27 my $unified_extract=qr/^--- ([^\s]+).*\n\+\+\+ ([^\s]+)\s*([^\t\n]*)/;
  28 my $unified_contents=qr/^([+\-\\ \n]|@@ .* @@)/;
  29 my $unified_hunk=qr/@@ -(\d+)(,(\d+))? \+(\d+)(,(\d+)) @@.*\n/;
  30
  31 my $context_header=qr/^\*\*\* .*\n--- .*\n$/;
  32 my $context_extract=qr/^\*\*\* ([^\s]+).*\n--- ([^\s]+)\s*([^\t\n]*)/;
  33 my $context_contents=qr/^([!+\-\\ \n]|-{3} .* -{4}|\*{3} .* \*{4}|\*{15})/;
  34
  35 my $ls_extract_id=qr/^[^\s]+\s+[^\s]+\s+([^\s]+)\s+([^\s]+)/;
  36 my $basename=qr|^(.*/)*([^/]+)$|;
  37
  38 sub patchfs_canonicalize_path ($) {
  39   my ($fname) = @_;
  40   $fname =~ s,/+,/,g;
  41   $fname =~ s,(^|/)(?:\.?\./)+,$1,;
  42   return $fname;
  43 }
  44
  45 # output unix date in a mc-readable format
  46 sub timef
  47 {
  48     my @time=localtime($_[0]);
  49     return sprintf '%02d-%02d-%02d %02d:%02d', $time[4]+1, $time[3],
  50                    $time[5]+1900, $time[2], $time[1];
  51 }
  52
  53 # parse given string as a date and return unix time
  54 sub datetime
  55 {
  56     # in case of problems fall back to 0 in unix time
  57     # note: str2time interprets some wrong values (eg. " ") as 'today'
  58     if ($parsedates && defined (my $t=str2time($_[0]))) {
  59         return timef($t);
  60     }
  61     return timef(time);
  62 }
  63
  64 # print message on stderr and exit
  65 sub error
  66 {
  67     print STDERR $_[0], "\n";
  68     exit 1;
  69 }
  70
  71 # (compressed) input
  72 sub myin
  73 {
  74     my ($qfname)=(quotemeta $_[0]);
  75
  76     $_=`$fileutil $qfname`;
  77     if (/^'*lzma/) {
  78         return "$lzma -dc $qfname";
  79     } elsif (/^'*xz/) {
  80         return "$xz -dc $qfname";
  81     } elsif (/^'*bzip/) {
  82         return "$bzip -dc $qfname";
  83     } elsif (/^'*gzip/) {
  84         return "$gzip -dc $qfname";
  85     } else {
  86         return "cat $qfname";
  87     }
  88 }
  89
  90 # (compressed) output
  91 sub myout
  92 {
  93     my ($qfname,$append)=(quotemeta $_[0],$_[1]);
  94     my ($sep) = $append ? '>>' : '>';
  95
  96     $_=`$fileutil $qfname`;
  97     if (/^'*lzma/) {
  98         return "$lzma -c $sep $qfname";
  99     } elsif (/^'*xz/) {
 100         return "$xz -c $sep $qfname";
 101     } elsif (/^'*bzip/) {
 102         return "$bzip -c $sep $qfname";
 103     } elsif (/^'*gzip/) {
 104         return "$gzip -c $sep $qfname";
 105     } else {
 106         return "cat $sep $qfname";
 107     }
 108 }
 109
 110 # select diff filename conforming with rules found in diff.info
 111 sub diff_filename
 112 {
 113     my ($fsrc,$fdst)= @_;
 114     # TODO: can remove these two calls later
 115     $fsrc = patchfs_canonicalize_path ($fsrc);
 116     $fdst = patchfs_canonicalize_path ($fdst);
 117     if (!$fdst && !$fsrc) {
 118         error 'Index: not yet implemented';
 119     } elsif (!$fsrc || $fsrc eq '/dev/null') {
 120         return ($fdst,'PATCH-CREATE/');
 121     } elsif (!$fdst || $fdst eq '/dev/null') {
 122         return ($fsrc,'PATCH-REMOVE/');
 123     } elsif (($fdst eq '/dev/null') && ($fsrc eq '/dev/null')) {
 124         error 'Malformed diff';
 125     } else {
 126         # fewest path name components
 127         if ($fdst=~s|/|/|g < $fsrc=~s|/|/|g) {
 128             return ($fdst,'');
 129         } elsif ($fdst=~s|/|/|g > $fsrc=~s|/|/|g) {
 130             return ($fsrc,'');
 131         } else {
 132             # shorter base name
 133             if (($fdst=~/$basename/o,length $2) < ($fsrc=~/$basename/o,length $2)) {
 134                 return ($fdst,'');
 135             } elsif (($fdst=~/$basename/o,length $2) > ($fsrc=~/$basename/o,length $2)) {
 136                 return ($fsrc,'');
 137             } else {
 138                 # shortest names
 139                 if (length $fdst < length $fsrc) {
 140                     return ($fdst,'');
 141                 } else {
 142                     return ($fsrc,'');
 143                 }
 144             }
 145         }
 146     }
 147 }
 148
 149 # IN: diff "archive" name
 150 # IN: file handle for output; STDIN for list, tempfile else
 151 # IN: filename to watch (for: copyout, rm), '' for: list
 152 # IN: remove the file?
 153 #     true  - ... and print out the rest
 154 #     false - ie. copyout mode, print just the file
 155 sub parse($$$$)
 156 {
 157     my $archive=quotemeta shift;
 158     my $fh=shift;
 159     my $file=shift;
 160     my $rmmod=shift;
 161     my ($state,$fsize,$time);
 162     my ($f,$fsrc,$fdst,$prefix);
 163     my ($unified,$context);
 164     my ($skipread, $filetoprint, $filefound);
 165     my ($h_add,$h_del,$h_ctx);  # hunk line counts
 166     my ($h_r1,$h_r2);           # hunk ranges
 167     my @outsrc;         # if desired ...
 168     my @outdst;
 169     my $line;
 170
 171     # use uid and gid from file
 172     my ($uid,$gid)=(`ls -l $archive`=~/$ls_extract_id/o);
 173
 174     import Date::Parse if ($parsedates && $file eq '');
 175
 176     $line=1;
 177     $state=0; $fsize=0; $f='';
 178     $filefound=0;
 179     while ($skipread || ($line++,$_=<I>)) {
 180         $skipread=0;
 181         if($state == 0) {       # expecting comments
 182             $unified=$context=0;
 183             $unified=1 if (/^--- /);
 184             $context=1 if (/^\*\*\* /);
 185             if (!$unified && !$context) {
 186                 $filefound=0 if($file ne '' && $filetoprint);
 187                 # shortcut for rmmod xor filefound
 188                 # - in rmmod we print if not found
 189                 # - in copyout (!rmmod) we print if found
 190                 print $fh $_ if($rmmod != $filefound);
 191                 next;
 192             }
 193
 194             if($file eq '' && $filetoprint) {
 195                 printf $fh "-rw-r--r-- 1 %s %s %d %s %s%s\n", $uid, $gid, $fsize, datetime($time), $prefix, $f;
 196             }
 197
 198             # start of new file
 199             $_ .=<I>;   # steel next line, both formats
 200             $line++;
 201             if($unified) {
 202                 if(/$unified_header/o) {
 203                     ($fsrc,$fdst,$time) = /$unified_extract/o;
 204                 } else {
 205                     error "Can't parse unified diff header";
 206                 }
 207             } elsif($context) {
 208                 if(/$context_header/o) {
 209                     ($fsrc,$fdst,$time) = /$context_extract/o;
 210                 } else {
 211                     error "Can't parse context diff header";
 212                 }
 213             } else {
 214                 error "Unrecognized diff header";
 215             }
 216             $fsrc=patchfs_canonicalize_path($fsrc);
 217             $fdst=patchfs_canonicalize_path($fdst);
 218             if(wantarray) {
 219                 push @outsrc,$fsrc;
 220                 push @outdst,$fdst;
 221             }
 222             ($f,$prefix)=diff_filename($fsrc,$fdst);
 223             $filefound=($fsrc eq $file || $fdst eq $file);
 224
 225             $f="$f.diff";
 226             $filetoprint=1;
 227             $fsize=length;
 228             print $fh $_ if($rmmod != $filefound);
 229
 230             $state=1;
 231         } elsif($state == 1) { # expecting diff hunk headers, end of file or comments
 232             if($unified) {
 233                 my ($a,$b,$c,$d);
 234                 ($a,$b,$h_r1,$c,$d,$h_r2)=/$unified_hunk/o;
 235                 if(!defined($a) || !defined($c)) {
 236                     # hunk header does not come, a comment inside
 237                     # or maybe a new file, state 0 will decide
 238                     $skipread=1;
 239                     $state=0;
 240                     next;
 241                 }
 242                 $fsize+=length;
 243                 print $fh $_ if($rmmod != $filefound);
 244                 $h_r1=1 if(!defined($b));
 245                 $h_r2=1 if(!defined($d));
 246                 $h_add=$h_del=$h_ctx=0;
 247                 $state=2;
 248             } elsif($context) {
 249                 if(!/$context_contents/o) {
 250                     $skipread=1;
 251                     $state=0;
 252                     next;
 253                 }
 254                 print $fh $_ if($rmmod != $filefound);
 255                 $fsize+=length;
 256             }
 257         } elsif($state == 2) { # expecting hunk contents
 258             if($h_del + $h_ctx == $h_r1 && $h_add + $h_ctx == $h_r2) {
 259                 # hooray, end of hunk
 260                 # we optimistically ended with a hunk before but
 261                 # the line has been read already
 262                 $skipread=1;
 263                 $state=1;
 264                 next;
 265             }
 266             print $fh $_ if($rmmod != $filefound);
 267             $fsize+=length;
 268             my ($first)= /^(.)/;
 269             if(ord($first) == ord('+')) { $h_add++; }
 270             elsif(ord($first) == ord('-')) { $h_del++; }
 271             elsif(ord($first) == ord(' ')) { $h_ctx++; }
 272             elsif(ord($first) == ord('\\')) { 0; }
 273             elsif(ord($first) == ord('@')) { error "Malformed hunk, header came too early"; }
 274             else { error "Unrecognized character in hunk"; }
 275         }
 276     }
 277     if($file eq '' && $filetoprint) {
 278         printf $fh "-rw-r--r-- 1 %s %s %d %s %s%s\n", $uid, $gid, $fsize, datetime($time), $prefix, $f;
 279     }
 280
 281     close($fh) if($file ne '');
 282     return \(@outsrc, @outdst) if wantarray;
 283 }
 284
 285 # list files affected by patch
 286 sub list($) {
 287         parse($_[0], *STDOUT, '', 0);
 288         close(I);
 289 }
 290
 291 # extract diff from patch
 292 # IN: diff file to find
 293 # IN: output file name
 294 sub copyout($$) {
 295     my ($file,$out)=@_;
 296
 297     $file=~s/^(PATCH-(CREATE|REMOVE)\/)?(.*)\.diff$/$3/;
 298     $file = patchfs_canonicalize_path ($file);
 299
 300     open(FH, ">$out") or error("Cannot open output file");
 301     parse('', *FH, $file, 0);
 302 }
 303
 304 # remove diff(s) from patch
 305 # IN: archive
 306 # IN: file to delete
 307 sub rm($$) {
 308     my $archive=shift;
 309     my ($tmp,$tmpname)=tempfile();
 310
 311     @_=map {scalar(s/^(PATCH-(CREATE|REMOVE)\/)?(.*)\.diff$/$3/,$_)} @_;
 312
 313     # just the first file for now
 314     parse($archive, $tmp, $_[0], 1);
 315     close I;
 316
 317     # replace archive
 318     system("cat \Q$tmpname\E | " . myout($archive,0))==0
 319       or error "Can't write to archive";
 320     system("rm -f -- \Q$tmpname\E");
 321 }
 322
 323 # append diff to archive
 324 # IN: diff archive name
 325 # IN: newly created file name in archive
 326 # IN: the real source file
 327 sub copyin($$$) {
 328     # TODO: seems to be tricky. what to do?
 329     # copyin of file which is already there may:
 330     #  * delete the original and copy only the new
 331     #  * just append the new hunks to the same file
 332     #    problems: may not be a valid diff, unmerged hunks
 333     #  * try to merge the two together
 334     #    ... but we do not want write patchutils again, right?
 335     error "Copying files into diff not supported";
 336     return;
 337
 338     my ($archive,$name,$src)=@_;
 339
 340     # in case we are appending another diff, we have
 341     # to delete/merge all the files
 342     open(DEVNULL, ">/dev/null");
 343     open I, myin($src).'|';
 344     my ($srclist,$dstlist)=parse($archive, *DEVNULL, '', 0);
 345     close(I);
 346     close(DEVNULL);
 347     foreach(@$srclist) {
 348         print("SRC: del $_\n");
 349     }
 350     foreach(@$dstlist) {
 351         print("DST: del $_\n");
 352     }
 353     return;
 354
 355     # remove overwritten file
 356     open I, myin($archive).'|';
 357     rm ($archive, $name);
 358     close I;
 359
 360     my $cmd1=myin("$src.diff");
 361     my $cmd2=myout($archive,1);
 362     system("$cmd1 | $cmd2")==0
 363       or error "Can't write to archive";
 364 }
 365
 366
 367 if ($ARGV[0] eq 'list') {
 368     open I, myin($ARGV[1]).'|';
 369     list ($ARGV[1]);
 370     exit 0;
 371 } elsif ($ARGV[0] eq 'copyout') {
 372     open I, myin($ARGV[1])."|";
 373     copyout ($ARGV[2], $ARGV[3]);
 374     exit 0;
 375 } elsif ($ARGV[0] eq 'rm') {
 376     open I, myin($ARGV[1])."|";
 377     rm ($ARGV[1], $ARGV[2]);
 378     exit 0;
 379 } elsif ($ARGV[0] eq 'rmdir') {
 380     exit 0;
 381 } elsif ($ARGV[0] eq 'mkdir') {
 382     exit 0;
 383 } elsif ($ARGV[0] eq 'copyin') {
 384     copyin ($ARGV[1], $ARGV[2], $ARGV[3]);
 385     exit 0;
 386 }
 387 exit 1;