| 1 | #!/usr/bin/perl |
| 2 | |
| 3 | require v5.26; |
| 4 | use strict; |
| 5 | use warnings; |
| 6 | use Getopt::Std; |
| 7 | use File::Temp qw(tempdir); |
| 8 | use Data::Dumper; |
| 9 | use File::Basename qw(basename dirname); |
| 10 | use File::Spec; |
| 11 | use Git; |
| 12 | |
| 13 | our ($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 | |
| 15 | getopts('uhPpvcfkam:d:w:W'); |
| 16 | |
| 17 | $opt_h && usage(); |
| 18 | |
| 19 | die "Need at least one commit identifier!" unless @ARGV; |
| 20 | |
| 21 | # Get git-config settings |
| 22 | my $repo = Git->repository(); |
| 23 | $opt_w = $repo->config('cvsexportcommit.cvsdir') unless defined $opt_w; |
| 24 | |
| 25 | my $tmpdir = File::Temp::tempdir(CLEANUP => 1); |
| 26 | my $hash_algo = $repo->config('extensions.objectformat') || 'sha1'; |
| 27 | my $hexsz = $hash_algo eq 'sha256' ? 64 : 40; |
| 28 | |
| 29 | if ($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 | |
| 48 | if ($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 | } |
| 54 | unless ($ENV{GIT_DIR} && -r $ENV{GIT_DIR}){ |
| 55 | die "GIT_DIR is not defined or is unreadable"; |
| 56 | } |
| 57 | |
| 58 | |
| 59 | my @cvs; |
| 60 | if ($opt_d) { |
| 61 | @cvs = ('cvs', '-d', $opt_d); |
| 62 | } else { |
| 63 | @cvs = ('cvs'); |
| 64 | } |
| 65 | |
| 66 | # resolve target commit |
| 67 | my $commit; |
| 68 | $commit = pop @ARGV; |
| 69 | $commit = safe_pipe_capture('git', 'rev-parse', '--verify', "$commit^0"); |
| 70 | chomp $commit; |
| 71 | if ($?) { |
| 72 | die "The commit reference $commit did not resolve!"; |
| 73 | } |
| 74 | |
| 75 | # resolve what parent we want |
| 76 | my $parent; |
| 77 | if (@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 |
| 87 | my @commit = safe_pipe_capture('git', 'cat-file', 'commit', $commit); |
| 88 | my @parents; |
| 89 | my $committer; |
| 90 | my $author; |
| 91 | my $stage = 'headers'; # headers, msg |
| 92 | my $title; |
| 93 | my $msg = ''; |
| 94 | |
| 95 | foreach 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 | |
| 118 | my $noparent = "0" x $hexsz; |
| 119 | if ($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 | |
| 139 | my $go_back_to = 0; |
| 140 | |
| 141 | if ($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 |
| 151 | open(MSG, ">.msg") or die "Cannot open .msg for writing"; |
| 152 | if ($opt_m) { |
| 153 | print MSG $opt_m; |
| 154 | } |
| 155 | print MSG $msg; |
| 156 | if ($opt_a) { |
| 157 | print MSG "\n\nAuthor: $author\n"; |
| 158 | if ($author ne $committer) { |
| 159 | print MSG "Committer: $committer\n"; |
| 160 | } |
| 161 | } |
| 162 | close MSG; |
| 163 | |
| 164 | if ($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. |
| 176 | my $context = $opt_p ? '' : '-C1'; |
| 177 | |
| 178 | print "Checking if patch will apply\n"; |
| 179 | |
| 180 | my @stat; |
| 181 | open APPLY, "GIT_INDEX_FILE=$tmpdir/index git apply $context --summary --numstat<.cvsexportcommit.diff|" || die "cannot patch"; |
| 182 | @stat=<APPLY>; |
| 183 | close APPLY || die "Cannot patch"; |
| 184 | my (@bfiles,@files,@afiles,@dfiles); |
| 185 | chomp @stat; |
| 186 | foreach (@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 | } |
| 193 | map { s/^"(.*)"$/$1/g } @bfiles,@files; |
| 194 | map { 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 |
| 197 | my $dirty; |
| 198 | my @dirs; |
| 199 | foreach 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, |
| 208 | foreach 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. |
| 216 | my @canstatusfiles; |
| 217 | foreach my $f (@files) { |
| 218 | my $path = dirname $f; |
| 219 | next if (grep { $_ eq $path } @dirs); |
| 220 | push @canstatusfiles, $f; |
| 221 | } |
| 222 | |
| 223 | my %cvsstat; |
| 224 | if (@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 |
| 282 | foreach 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. |
| 297 | foreach 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 | |
| 324 | if ($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 | |
| 332 | print "Applying\n"; |
| 333 | if ($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 | |
| 339 | print "Patch applied successfully. Adding new files and directories to CVS\n"; |
| 340 | my $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 | |
| 352 | foreach 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 | |
| 359 | foreach 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 | |
| 371 | foreach 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 | |
| 379 | print "Commit to CVS\n"; |
| 380 | print "Patch title (first comment line): $title\n"; |
| 381 | my @commitfiles = map { unless (m/\s/) { '\''.$_.'\''; } else { $_; }; } (@files); |
| 382 | my $cmd = join(' ', @cvs)." commit -F .msg @commitfiles"; |
| 383 | |
| 384 | if ($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 | |
| 396 | if ($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 |
| 410 | unlink(".cvsexportcommit.diff"); |
| 411 | |
| 412 | if ($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. |
| 423 | sleep(1); |
| 424 | |
| 425 | sub usage { |
| 426 | print STDERR <<END; |
| 427 | usage: GIT_DIR=/path/to/.git git cvsexportcommit [-h] [-p] [-v] [-c] [-f] [-u] [-k] [-w cvsworkdir] [-m msgprefix] [ parent ] commit |
| 428 | END |
| 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 |
| 435 | sub 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 | |
| 447 | sub 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 | } |