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