1#!/usr/local/bin/perl 2 3use 5.008; 4use strict; 5use warnings; 6use Getopt::Std; 7use File::Temp qw(tempdir); 8use Data::Dumper; 9use File::Basename qw(basename dirname); 10use File::Spec; 11use Git; 12 13our ($opt_h, $opt_P, $opt_p, $opt_v, $opt_c, $opt_f, $opt_a, $opt_m, $opt_d, $opt_u, $opt_w, $opt_W, $opt_k); 14 15getopts('uhPpvcfkam:d:w:W'); 16 17$opt_h && usage(); 18 19die "Need at least one commit identifier!" unless @ARGV; 20 21# Get git-config settings 22my $repo = Git->repository(); 23$opt_w = $repo->config('cvsexportcommit.cvsdir') unless defined $opt_w; 24 25my $tmpdir = File::Temp::tempdir(CLEANUP => 1); 26my $hash_algo = $repo->config('extensions.objectformat') || 'sha1'; 27my $hexsz = $hash_algo eq 'sha256' ? 64 : 40; 28 29if ($opt_w || $opt_W) { 30 # Remember where GIT_DIR is before changing to CVS checkout 31 unless ($ENV{GIT_DIR}) { 32 # No GIT_DIR set. Figure it out for ourselves 33 my $gd =`git rev-parse --git-dir`; 34 chomp($gd); 35 $ENV{GIT_DIR} = $gd; 36 } 37 38 # On MSYS, convert a Windows-style path to an MSYS-style path 39 # so that rel2abs() below works correctly. 40 if ($^O eq 'msys') { 41 $ENV{GIT_DIR} =~ s#^([[:alpha:]]):/#/$1/#; 42 } 43 44 # Make sure GIT_DIR is absolute 45 $ENV{GIT_DIR} = File::Spec->rel2abs($ENV{GIT_DIR}); 46} 47 48if ($opt_w) { 49 if (! -d $opt_w."/CVS" ) { 50 die "$opt_w is not a CVS checkout"; 51 } 52 chdir $opt_w or die "Cannot change to CVS checkout at $opt_w"; 53} 54unless ($ENV{GIT_DIR} && -r $ENV{GIT_DIR}){ 55 die "GIT_DIR is not defined or is unreadable"; 56} 57 58 59my @cvs; 60if ($opt_d) { 61 @cvs = ('cvs', '-d', $opt_d); 62} else { 63 @cvs = ('cvs'); 64} 65 66# resolve target commit 67my $commit; 68$commit = pop @ARGV; 69$commit = safe_pipe_capture('git', 'rev-parse', '--verify', "$commit^0"); 70chomp $commit; 71if ($?) { 72 die "The commit reference $commit did not resolve!"; 73} 74 75# resolve what parent we want 76my $parent; 77if (@ARGV) { 78 $parent = pop @ARGV; 79 $parent = safe_pipe_capture('git', 'rev-parse', '--verify', "$parent^0"); 80 chomp $parent; 81 if ($?) { 82 die "The parent reference did not resolve!"; 83 } 84} 85 86# find parents from the commit itself 87my @commit = safe_pipe_capture('git', 'cat-file', 'commit', $commit); 88my @parents; 89my $committer; 90my $author; 91my $stage = 'headers'; # headers, msg 92my $title; 93my $msg = ''; 94 95foreach my $line (@commit) { 96 chomp $line; 97 if ($stage eq 'headers' && $line eq '') { 98 $stage = 'msg'; 99 next; 100 } 101 102 if ($stage eq 'headers') { 103 if ($line =~ m/^parent ([0-9a-f]{$hexsz})$/) { # found a parent 104 push @parents, $1; 105 } elsif ($line =~ m/^author (.+) \d+ [-+]\d+$/) { 106 $author = $1; 107 } elsif ($line =~ m/^committer (.+) \d+ [-+]\d+$/) { 108 $committer = $1; 109 } 110 } else { 111 $msg .= $line . "\n"; 112 unless ($title) { 113 $title = $line; 114 } 115 } 116} 117 118my $noparent = "0" x $hexsz; 119if ($parent) { 120 my $found; 121 # double check that it's a valid parent 122 foreach my $p (@parents) { 123 if ($p eq $parent) { 124 $found = 1; 125 last; 126 }; # found it 127 } 128 die "Did not find $parent in the parents for this commit!" if !$found and !$opt_P; 129} else { # we don't have a parent from the cmdline... 130 if (@parents == 1) { # it's safe to get it from the commit 131 $parent = $parents[0]; 132 } elsif (@parents == 0) { # there is no parent 133 $parent = $noparent; 134 } else { # cannot choose automatically from multiple parents 135 die "This commit has more than one parent -- please name the parent you want to use explicitly"; 136 } 137} 138 139my $go_back_to = 0; 140 141if ($opt_W) { 142 $opt_v && print "Resetting to $parent\n"; 143 $go_back_to = `git symbolic-ref HEAD 2> /dev/null || 144 git rev-parse HEAD` || die "Could not determine current branch"; 145 system("git checkout -q $parent^0") && die "Could not check out $parent^0"; 146} 147 148$opt_v && print "Applying to CVS commit $commit from parent $parent\n"; 149 150# grab the commit message 151open(MSG, ">.msg") or die "Cannot open .msg for writing"; 152if ($opt_m) { 153 print MSG $opt_m; 154} 155print MSG $msg; 156if ($opt_a) { 157 print MSG "\n\nAuthor: $author\n"; 158 if ($author ne $committer) { 159 print MSG "Committer: $committer\n"; 160 } 161} 162close MSG; 163 164if ($parent eq $noparent) { 165 `git diff-tree --binary -p --root $commit >.cvsexportcommit.diff`;# || die "Cannot diff"; 166} else { 167 `git diff-tree --binary -p $parent $commit >.cvsexportcommit.diff`;# || die "Cannot diff"; 168} 169 170## apply non-binary changes 171 172# In pedantic mode require all lines of context to match. In normal 173# mode, be compatible with diff/patch: assume 3 lines of context and 174# require at least one line match, i.e. ignore at most 2 lines of 175# context, like diff/patch do by default. 176my $context = $opt_p ? '' : '-C1'; 177 178print "Checking if patch will apply\n"; 179 180my @stat; 181open APPLY, "GIT_INDEX_FILE=$tmpdir/index git apply $context --summary --numstat<.cvsexportcommit.diff|" || die "cannot patch"; 182@stat=<APPLY>; 183close APPLY || die "Cannot patch"; 184my (@bfiles,@files,@afiles,@dfiles); 185chomp @stat; 186foreach (@stat) { 187 push (@bfiles,$1) if m/^-\t-\t(.*)$/; 188 push (@files, $1) if m/^-\t-\t(.*)$/; 189 push (@files, $1) if m/^\d+\t\d+\t(.*)$/; 190 push (@afiles,$1) if m/^ create mode [0-7]+ (.*)$/; 191 push (@dfiles,$1) if m/^ delete mode [0-7]+ (.*)$/; 192} 193map { s/^"(.*)"$/$1/g } @bfiles,@files; 194map { s/\\([0-7]{3})/sprintf('%c',oct $1)/eg } @bfiles,@files; 195 196# check that the files are clean and up to date according to cvs 197my $dirty; 198my @dirs; 199foreach my $p (@afiles) { 200 my $path = dirname $p; 201 while (!-d $path and ! grep { $_ eq $path } @dirs) { 202 unshift @dirs, $path; 203 $path = dirname $path; 204 } 205} 206 207# ... check dirs, 208foreach my $d (@dirs) { 209 if (-e $d) { 210 $dirty = 1; 211 warn "$d exists and is not a directory!\n"; 212 } 213} 214 215# ... query status of all files that we have a directory for and parse output of 'cvs status' to %cvsstat. 216my @canstatusfiles; 217foreach my $f (@files) { 218 my $path = dirname $f; 219 next if (grep { $_ eq $path } @dirs); 220 push @canstatusfiles, $f; 221} 222 223my %cvsstat; 224if (@canstatusfiles) { 225 if ($opt_u) { 226 my @updated = xargs_safe_pipe_capture([@cvs, 'update'], @canstatusfiles); 227 print @updated; 228 } 229 # "cvs status" reorders the parameters, notably when there are multiple 230 # arguments with the same basename. So be precise here. 231 232 my %added = map { $_ => 1 } @afiles; 233 my %todo = map { $_ => 1 } @canstatusfiles; 234 235 while (%todo) { 236 my @canstatusfiles2 = (); 237 my %fullname = (); 238 foreach my $name (keys %todo) { 239 my $basename = basename($name); 240 241 # CVS reports files that don't exist in the current revision as 242 # "no file $basename" in its "status" output, so we should 243 # anticipate that. Totally unknown files will have a status 244 # "Unknown". However, if they exist in the Attic, their status 245 # will be "Up-to-date" (this means they were added once but have 246 # been removed). 247 $basename = "no file $basename" if $added{$basename}; 248 249 $basename =~ s/^\s+//; 250 $basename =~ s/\s+$//; 251 252 if (!exists($fullname{$basename})) { 253 $fullname{$basename} = $name; 254 push (@canstatusfiles2, $name); 255 delete($todo{$name}); 256 } 257 } 258 my @cvsoutput; 259 @cvsoutput = xargs_safe_pipe_capture([@cvs, 'status'], @canstatusfiles2); 260 foreach my $l (@cvsoutput) { 261 chomp $l; 262 next unless 263 my ($file, $status) = $l =~ /^File:\s+(.*\S)\s+Status: (.*)$/; 264 265 my $fullname = $fullname{$file}; 266 print STDERR "Huh? Status '$status' reported for unexpected file '$file'\n" 267 unless defined $fullname; 268 269 # This response means the file does not exist except in 270 # CVS's attic, so set the status accordingly 271 $status = "In-attic" 272 if $file =~ /^no file / 273 && $status eq 'Up-to-date'; 274 275 $cvsstat{$fullname{$file}} = $status 276 if defined $fullname{$file}; 277 } 278 } 279} 280 281# ... Validate that new files have the correct status 282foreach my $f (@afiles) { 283 next unless defined(my $stat = $cvsstat{$f}); 284 285 # This means the file has never been seen before 286 next if $stat eq 'Unknown'; 287 288 # This means the file has been seen before but was removed 289 next if $stat eq 'In-attic'; 290 291 $dirty = 1; 292 warn "File $f is already known in your CVS checkout -- perhaps it has been added by another user. Or this may indicate that it exists on a different branch. If this is the case, use -f to force the merge.\n"; 293 warn "Status was: $cvsstat{$f}\n"; 294} 295 296# ... validate known files. 297foreach my $f (@files) { 298 next if grep { $_ eq $f } @afiles; 299 # TODO:we need to handle removed in cvs 300 unless (defined ($cvsstat{$f}) and $cvsstat{$f} eq "Up-to-date") { 301 $dirty = 1; 302 warn "File $f not up to date but has status '$cvsstat{$f}' in your CVS checkout!\n"; 303 } 304 305 # Depending on how your GIT tree got imported from CVS you may 306 # have a conflict between expanded keywords in your CVS tree and 307 # unexpanded keywords in the patch about to be applied. 308 if ($opt_k) { 309 my $orig_file ="$f.orig"; 310 rename $f, $orig_file; 311 open(FILTER_IN, "<$orig_file") or die "Cannot open $orig_file\n"; 312 open(FILTER_OUT, ">$f") or die "Cannot open $f\n"; 313 while (<FILTER_IN>) 314 { 315 my $line = $_; 316 $line =~ s/\$([A-Z][a-z]+):[^\$]+\$/\$$1\$/g; 317 print FILTER_OUT $line; 318 } 319 close FILTER_IN; 320 close FILTER_OUT; 321 } 322} 323 324if ($dirty) { 325 if ($opt_f) { warn "The tree is not clean -- forced merge\n"; 326 $dirty = 0; 327 } else { 328 die "Exiting: your CVS tree is not clean for this merge."; 329 } 330} 331 332print "Applying\n"; 333if ($opt_W) { 334 system("git checkout -q $commit^0") && die "cannot patch"; 335} else { 336 `GIT_INDEX_FILE=$tmpdir/index git apply $context --summary --numstat --apply <.cvsexportcommit.diff` || die "cannot patch"; 337} 338 339print "Patch applied successfully. Adding new files and directories to CVS\n"; 340my $dirtypatch = 0; 341 342# 343# We have to add the directories in order otherwise we will have 344# problems when we try and add the sub-directory of a directory we 345# have not added yet. 346# 347# Luckily this is easy to deal with by sorting the directories and 348# dealing with the shortest ones first. 349# 350@dirs = sort { length $a <=> length $b} @dirs; 351 352foreach my $d (@dirs) { 353 if (system(@cvs,'add',$d)) { 354 $dirtypatch = 1; 355 warn "Failed to cvs add directory $d -- you may need to do it manually"; 356 } 357} 358 359foreach my $f (@afiles) { 360 if (grep { $_ eq $f } @bfiles) { 361 system(@cvs, 'add','-kb',$f); 362 } else { 363 system(@cvs, 'add', $f); 364 } 365 if ($?) { 366 $dirtypatch = 1; 367 warn "Failed to cvs add $f -- you may need to do it manually"; 368 } 369} 370 371foreach my $f (@dfiles) { 372 system(@cvs, 'rm', '-f', $f); 373 if ($?) { 374 $dirtypatch = 1; 375 warn "Failed to cvs rm -f $f -- you may need to do it manually"; 376 } 377} 378 379print "Commit to CVS\n"; 380print "Patch title (first comment line): $title\n"; 381my @commitfiles = map { unless (m/\s/) { '\''.$_.'\''; } else { $_; }; } (@files); 382my $cmd = join(' ', @cvs)." commit -F .msg @commitfiles"; 383 384if ($dirtypatch) { 385 print "NOTE: One or more hunks failed to apply cleanly.\n"; 386 print "You'll need to apply the patch in .cvsexportcommit.diff manually\n"; 387 print "using a patch program. After applying the patch and resolving the\n"; 388 print "problems you may commit using:"; 389 print "\n cd \"$opt_w\"" if $opt_w; 390 print "\n $cmd\n"; 391 print "\n git checkout $go_back_to\n" if $go_back_to; 392 print "\n"; 393 exit(1); 394} 395 396if ($opt_c) { 397 print "Autocommit\n $cmd\n"; 398 print xargs_safe_pipe_capture([@cvs, 'commit', '-F', '.msg'], @files); 399 if ($?) { 400 die "Exiting: The commit did not succeed"; 401 } 402 print "Committed successfully to CVS\n"; 403 # clean up 404 unlink(".msg"); 405} else { 406 print "Ready for you to commit, just run:\n\n $cmd\n"; 407} 408 409# clean up 410unlink(".cvsexportcommit.diff"); 411 412if ($opt_W) { 413 system("git checkout $go_back_to") && die "cannot move back to $go_back_to"; 414 if (!($go_back_to =~ /^[0-9a-fA-F]{$hexsz}$/)) { 415 system("git symbolic-ref HEAD $go_back_to") && 416 die "cannot move back to $go_back_to"; 417 } 418} 419 420# CVS version 1.11.x and 1.12.x sleeps the wrong way to ensure the timestamp 421# used by CVS and the one set by subsequence file modifications are different. 422# If they are not different CVS will not detect changes. 423sleep(1); 424 425sub usage { 426 print STDERR <<END; 427usage: GIT_DIR=/path/to/.git git cvsexportcommit [-h] [-p] [-v] [-c] [-f] [-u] [-k] [-w cvsworkdir] [-m msgprefix] [ parent ] commit 428END 429 exit(1); 430} 431 432# An alternative to `command` that allows input to be passed as an array 433# to work around shell problems with weird characters in arguments 434# if the exec returns non-zero we die 435sub safe_pipe_capture { 436 my @output; 437 if (my $pid = open my $child, '-|') { 438 binmode($child, ":crlf"); 439 @output = (<$child>); 440 close $child or die join(' ',@_).": $! $?"; 441 } else { 442 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found 443 } 444 return wantarray ? @output : join('',@output); 445} 446 447sub xargs_safe_pipe_capture { 448 my $MAX_ARG_LENGTH = 65536; 449 my $cmd = shift; 450 my @output; 451 my $output; 452 while(@_) { 453 my @args; 454 my $length = 0; 455 while(@_ && $length < $MAX_ARG_LENGTH) { 456 push @args, shift; 457 $length += length($args[$#args]); 458 } 459 if (wantarray) { 460 push @output, safe_pipe_capture(@$cmd, @args); 461 } 462 else { 463 $output .= safe_pipe_capture(@$cmd, @args); 464 } 465 } 466 return wantarray ? @output : $output; 467} 468