git-archimport.perl

   1 #!/usr/bin/perl -w
   2 #
   3 # This tool is copyright (c) 2005, Martin Langhoff.
   4 # It is released under the Gnu Public License, version 2.
   5 #
   6 # The basic idea is to walk the output of tla abrowse,
   7 # fetch the changesets and apply them.
   8 #
   9 =head1 Invocation
  10
  11     git-archimport -i <archive>/<branch> [<archive>/<branch>]
  12     [ <archive>/<branch> ]
  13
  14     The script expects you to provide the key roots where it can start the
  15     import from an 'initial import' or 'tag' type of Arch commit. It will
  16     then follow all the branching and tagging within the provided roots.
  17
  18     It will die if it sees branches that have different roots.
  19
  20 =head2 TODO
  21
  22  - keep track of merged patches, and mark a git merge when it happens
  23  - smarter rules to parse the archive history "up" and "down"
  24  - be able to continue an import where we left off
  25  - audit shell-escaping of filenames
  26
  27 =head1 Devel tricks
  28
  29 Add print in front of the shell commands invoked via backticks.
  30
  31 =cut
  32
  33 use strict;
  34 use warnings;
  35 use Getopt::Std;
  36 use File::Spec;
  37 use File::Temp qw(tempfile);
  38 use File::Path qw(mkpath);
  39 use File::Basename qw(basename dirname);
  40 use String::ShellQuote;
  41 use Time::Local;
  42 use IO::Socket;
  43 use IO::Pipe;
  44 use POSIX qw(strftime dup2);
  45 use Data::Dumper qw/ Dumper /;
  46 use IPC::Open2;
  47
  48 $SIG{'PIPE'}="IGNORE";
  49 $ENV{'TZ'}="UTC";
  50
  51 our($opt_h,$opt_v, $opt_T,
  52     $opt_C,$opt_t);
  53
  54 sub usage() {
  55     print STDERR <<END;
  56 Usage: ${\basename $0}     # fetch/update GIT from Arch
  57        [ -h ] [ -v ] [ -T ]
  58        [ -C GIT_repository ] [ -t tempdir ]
  59        repository/arch-branch [ repository/arch-branch] ...
  60 END
  61     exit(1);
  62 }
  63
  64 getopts("hviC:t:") or usage();
  65 usage if $opt_h;
  66
  67 @ARGV >= 1 or usage();
  68 my @arch_roots = @ARGV;
  69
  70 my $tmp = $opt_t;
  71 $tmp ||= '/tmp';
  72 $tmp .= '/git-archimport/';
  73
  74 my $git_tree = $opt_C;
  75 $git_tree ||= ".";
  76
  77
  78 my @psets  = ();                # the collection
  79
  80 foreach my $root (@arch_roots) {
  81     my ($arepo, $abranch) = split(m!/!, $root);
  82     open ABROWSE, "tla abrowse -f -A $arepo --desc --merges $abranch |"
  83         or die "Problems with tla abrowse: $!";
  84
  85     my %ps        = ();         # the current one
  86     my $mode      = '';
  87     my $lastseen  = '';
  88
  89     while (<ABROWSE>) {
  90         chomp;
  91
  92         # first record padded w 8 spaces
  93         if (s/^\s{8}\b//) {
  94
  95             # store the record we just captured
  96             if (%ps) {
  97                 my %temp = %ps; # break references
  98                 push (@psets, \%temp);
  99                 %ps = ();
 100             }
 101
 102             my ($id, $type) = split(m/\s{3}/, $_);
 103             $ps{id}   = $id;
 104             $ps{repo} = $arepo;
 105
 106             # deal with types
 107             if ($type =~ m/^\(simple changeset\)/) {
 108                 $ps{type} = 's';
 109             } elsif ($type eq '(initial import)') {
 110                 $ps{type} = 'i';
 111             } elsif ($type =~ m/^\(tag revision of (.+)\)/) {
 112                 $ps{type} = 't';
 113                 $ps{tag}  = $1;
 114             } else {
 115                 warn "Unknown type $type";
 116             }
 117             $lastseen = 'id';
 118         }
 119
 120         if (s/^\s{10}//) {
 121             # 10 leading spaces or more
 122             # indicate commit metadata
 123
 124             # date & author
 125             if ($lastseen eq 'id' && m/^\d{4}-\d{2}-\d{2}/) {
 126
 127                 my ($date, $authoremail) = split(m/\s{2,}/, $_);
 128                 $ps{date}   = $date;
 129                 $ps{date}   =~ s/\bGMT$//; # strip off trailign GMT
 130                 if ($ps{date} =~ m/\b\w+$/) {
 131                     warn 'Arch dates not in GMT?! - imported dates will be wrong';
 132                 }
 133
 134                 $authoremail =~ m/^(.+)\s(\S+)$/;
 135                 $ps{author} = $1;
 136                 $ps{email}  = $2;
 137
 138                 $lastseen = 'date';
 139
 140             } elsif ($lastseen eq 'date') {
 141                 # the only hint is position
 142                 # subject is after date
 143                 $ps{subj} = $_;
 144                 $lastseen = 'subj';
 145
 146             } elsif ($lastseen eq 'subj' && $_ eq 'merges in:') {
 147                 $ps{merges} = [];
 148                 $lastseen = 'merges';
 149
 150             } elsif ($lastseen eq 'merges' && s/^\s{2}//) {
 151                 push (@{$ps{merges}}, $_);
 152             } else {
 153                 warn 'more metadata after merges!?';
 154             }
 155
 156         }
 157     }
 158
 159     if (%ps) {
 160         my %temp = %ps;         # break references
 161         push (@psets, \%temp);
 162         %ps = ();
 163     }
 164     close ABROWSE;
 165 }                               # end foreach $root
 166
 167 ## Order patches by time
 168 @psets = sort {$a->{date}.$b->{id} cmp $b->{date}.$b->{id}} @psets;
 169
 170 #print Dumper \@psets;
 171
 172 ##
 173 ## TODO cleanup irrelevant patches
 174 ##      and put an initial import
 175 ##      or a full tag
 176 my $import = 0;
 177 unless (-d '.git') { # initial import
 178     if ($psets[0]{type} eq 'i' || $psets[0]{type} eq 't') {
 179         print "Starting import from $psets[0]{id}\n";
 180         `git-init-db`;
 181         die $! if $?;
 182         $import = 1;
 183     } else {
 184         die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
 185     }
 186 }
 187
 188 # process patchsets
 189 foreach my $ps (@psets) {
 190
 191     $ps->{branch} =  branchname($ps->{id});
 192
 193     #
 194     # ensure we have a clean state
 195     #
 196     if (`git diff-files`) {
 197         die "Unclean tree when about to process $ps->{id} " .
 198             " - did we fail to commit cleanly before?";
 199     }
 200     die $! if $?;
 201
 202     #
 203     # skip commits already in repo
 204     #
 205     if (ptag($ps->{id})) {
 206       $opt_v && print "Skipping already imported: $ps->{id}\n";
 207       next;
 208     }
 209
 210     #
 211     # create the branch if needed
 212     #
 213     if ($ps->{type} eq 'i' && !$import) {
 214         die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
 215     }
 216
 217     unless ($import) { # skip for import
 218         if ( -e ".git/refs/heads/$ps->{branch}") {
 219             # we know about this branch
 220             `git checkout    $ps->{branch}`;
 221         } else {
 222             # new branch! we need to verify a few things
 223             die "Branch on a non-tag!" unless $ps->{type} eq 't';
 224             my $branchpoint = ptag($ps->{tag});
 225             die "Tagging from unknown id unsupported: $ps->{tag}"
 226                 unless $branchpoint;
 227
 228             # find where we are supposed to branch from
 229             `git checkout -b $ps->{branch} $branchpoint`;
 230
 231             # If we trust Arch with the fact that this is just
 232             # a tag, and it does not affect the state of the tree
 233             # then we just tag and move on
 234             tag($ps->{id}, $branchpoint);
 235             ptag($ps->{id}, $branchpoint);
 236             print " * Tagged $ps->{id} at $branchpoint\n";
 237             next;
 238         }
 239         die $! if $?;
 240     }
 241
 242     #
 243     # Apply the import/changeset/merge into the working tree
 244     #
 245     if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
 246         apply_import($ps) or die $!;
 247         $import=0;
 248     } elsif ($ps->{type} eq 's') {
 249         apply_cset($ps);
 250     }
 251
 252     #
 253     # prepare update git's index, based on what arch knows
 254     # about the pset, resolve parents, etc
 255     #
 256     my $tree;
 257
 258     my $commitlog = `tla cat-archive-log -A $ps->{repo} $ps->{id}`;
 259     die "Error in cat-archive-log: $!" if $?;
 260
 261     # parselog will git-add/rm files
 262     # and generally prepare things for the commit
 263     # NOTE: parselog will shell-quote filenames!
 264     my ($sum, $msg, $add, $del, $mod, $ren) = parselog($commitlog);
 265     my $logmessage = "$sum\n$msg";
 266
 267
 268     # imports don't give us good info
 269     # on added files. Shame on them
 270     if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
 271         `find . -type f -print0 | grep -zv '^./.git' | xargs -0 -l100 git-update-index --add`;
 272         `git-ls-files --deleted -z | xargs --no-run-if-empty -0 -l100 git-update-index --remove`;
 273     }
 274
 275     if (@$add) {
 276         while (@$add) {
 277             my @slice = splice(@$add, 0, 100);
 278             my $slice = join(' ', @slice);
 279             `git-update-index --add $slice`;
 280             die "Error in git-update-index --add: $!" if $?;
 281         }
 282     }
 283     if (@$del) {
 284         foreach my $file (@$del) {
 285             unlink $file or die "Problems deleting $file : $!";
 286         }
 287         while (@$del) {
 288             my @slice = splice(@$del, 0, 100);
 289             my $slice = join(' ', @slice);
 290             `git-update-index --remove $slice`;
 291             die "Error in git-update-index --remove: $!" if $?;
 292         }
 293     }
 294     if (@$ren) {                # renamed
 295         if (@$ren % 2) {
 296             die "Odd number of entries in rename!?";
 297         }
 298         ;
 299         while (@$ren) {
 300             my $from = pop @$ren;
 301             my $to   = pop @$ren;
 302
 303             unless (-d dirname($to)) {
 304                 mkpath(dirname($to)); # will die on err
 305             }
 306             #print "moving $from $to";
 307             `mv $from $to`;
 308             die "Error renaming $from $to : $!" if $?;
 309             `git-update-index --remove $from`;
 310             die "Error in git-update-index --remove: $!" if $?;
 311             `git-update-index --add $to`;
 312             die "Error in git-update-index --add: $!" if $?;
 313         }
 314
 315     }
 316     if (@$mod) {                # must be _after_ renames
 317         while (@$mod) {
 318             my @slice = splice(@$mod, 0, 100);
 319             my $slice = join(' ', @slice);
 320             `git-update-index $slice`;
 321             die "Error in git-update-index: $!" if $?;
 322         }
 323     }
 324
 325     # warn "errors when running git-update-index! $!";
 326     $tree = `git-write-tree`;
 327     die "cannot write tree $!" if $?;
 328     chomp $tree;
 329
 330
 331     #
 332     # Who's your daddy?
 333     #
 334     my @par;
 335     if ( -e ".git/refs/heads/$ps->{branch}") {
 336         if (open HEAD, "<.git/refs/heads/$ps->{branch}") {
 337             my $p = <HEAD>;
 338             close HEAD;
 339             chomp $p;
 340             push @par, '-p', $p;
 341         } else {
 342             if ($ps->{type} eq 's') {
 343                 warn "Could not find the right head for the branch $ps->{branch}";
 344             }
 345         }
 346     }
 347
 348     my $par = join (' ', @par);
 349
 350     #
 351     # Commit, tag and clean state
 352     #
 353     $ENV{TZ}                  = 'GMT';
 354     $ENV{GIT_AUTHOR_NAME}     = $ps->{author};
 355     $ENV{GIT_AUTHOR_EMAIL}    = $ps->{email};
 356     $ENV{GIT_AUTHOR_DATE}     = $ps->{date};
 357     $ENV{GIT_COMMITTER_NAME}  = $ps->{author};
 358     $ENV{GIT_COMMITTER_EMAIL} = $ps->{email};
 359     $ENV{GIT_COMMITTER_DATE}  = $ps->{date};
 360
 361     my ($pid, $commit_rh, $commit_wh);
 362     $commit_rh = 'commit_rh';
 363     $commit_wh = 'commit_wh';
 364
 365     $pid = open2(*READER, *WRITER, "git-commit-tree $tree $par")
 366         or die $!;
 367     print WRITER $logmessage;   # write
 368     close WRITER;
 369     my $commitid = <READER>;    # read
 370     chomp $commitid;
 371     close READER;
 372     waitpid $pid,0;             # close;
 373
 374     if (length $commitid != 40) {
 375         die "Something went wrong with the commit! $! $commitid";
 376     }
 377     #
 378     # Update the branch
 379     #
 380     open  HEAD, ">.git/refs/heads/$ps->{branch}";
 381     print HEAD $commitid;
 382     close HEAD;
 383     unlink ('.git/HEAD');
 384     symlink("refs/heads/$ps->{branch}",".git/HEAD");
 385
 386     # tag accordingly
 387     ptag($ps->{id}, $commitid); # private tag
 388     if ($opt_T || $ps->{type} eq 't' || $ps->{type} eq 'i') {
 389         tag($ps->{id}, $commitid);
 390     }
 391     print " * Committed $ps->{id}\n";
 392     print "   + tree   $tree\n";
 393     print "   + commit $commitid\n";
 394     # print "   + commit date is  $ps->{date} \n";
 395 }
 396
 397 sub branchname {
 398     my $id = shift;
 399     $id =~ s#^.+?/##;
 400     my @parts = split(m/--/, $id);
 401     return join('--', @parts[0..1]);
 402 }
 403
 404 sub apply_import {
 405     my $ps = shift;
 406     my $bname = branchname($ps->{id});
 407
 408     `mkdir -p $tmp`;
 409
 410     `tla get -s --no-pristine -A $ps->{repo} $ps->{id} $tmp/import`;
 411     die "Cannot get import: $!" if $?;
 412     `rsync -v --archive --delete --exclude '.git' --exclude '.arch-ids' --exclude '{arch}' $tmp/import/* ./`;
 413     die "Cannot rsync import:$!" if $?;
 414
 415     `rm -fr $tmp/import`;
 416     die "Cannot remove tempdir: $!" if $?;
 417
 418
 419     return 1;
 420 }
 421
 422 sub apply_cset {
 423     my $ps = shift;
 424
 425     `mkdir -p $tmp`;
 426
 427     # get the changeset
 428     `tla get-changeset  -A $ps->{repo} $ps->{id} $tmp/changeset`;
 429     die "Cannot get changeset: $!" if $?;
 430
 431     # apply patches
 432     if (`find $tmp/changeset/patches -type f -name '*.patch'`) {
 433         # this can be sped up considerably by doing
 434         #    (find | xargs cat) | patch
 435         # but that cna get mucked up by patches
 436         # with missing trailing newlines or the standard
 437         # 'missing newline' flag in the patch - possibly
 438         # produced with an old/buggy diff.
 439         # slow and safe, we invoke patch once per patchfile
 440         `find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;
 441         die "Problem applying patches! $!" if $?;
 442     }
 443
 444     # apply changed binary files
 445     if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {
 446         foreach my $mod (@modified) {
 447             chomp $mod;
 448             my $orig = $mod;
 449             $orig =~ s/\.modified$//; # lazy
 450             $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
 451             #print "rsync -p '$mod' '$orig'";
 452             `rsync -p $mod ./$orig`;
 453             die "Problem applying binary changes! $!" if $?;
 454         }
 455     }
 456
 457     # bring in new files
 458     `rsync --archive --exclude '.git' --exclude '.arch-ids' --exclude '{arch}' $tmp/changeset/new-files-archive/* ./`;
 459
 460     # deleted files are hinted from the commitlog processing
 461
 462     `rm -fr $tmp/changeset`;
 463 }
 464
 465
 466 # =for reference
 467 # A log entry looks like
 468 # Revision: moodle-org--moodle--1.3.3--patch-15
 469 # Archive: arch-eduforge@catalyst.net.nz--2004
 470 # Creator: Penny Leach <penny@catalyst.net.nz>
 471 # Date: Wed May 25 14:15:34 NZST 2005
 472 # Standard-date: 2005-05-25 02:15:34 GMT
 473 # New-files: lang/de/.arch-ids/block_glossary_random.php.id
 474 #     lang/de/.arch-ids/block_html.php.id
 475 # New-directories: lang/de/help/questionnaire
 476 #     lang/de/help/questionnaire/.arch-ids
 477 # Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
 478 #    db_sears.sql db/db_sears.sql
 479 # Removed-files: lang/be/docs/.arch-ids/release.html.id
 480 #     lang/be/docs/.arch-ids/releaseold.html.id
 481 # Modified-files: admin/cron.php admin/delete.php
 482 #     admin/editor.html backup/lib.php backup/restore.php
 483 # New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
 484 # Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
 485 # Keywords:
 486 #
 487 # Updating yadda tadda tadda madda
 488 sub parselog {
 489     my $log = shift;
 490     #print $log;
 491
 492     my (@add, @del, @mod, @ren, @kw, $sum, $msg );
 493
 494     if ($log =~ m/(?:\n|^)New-files:(.*?)(?=\n\w)/s ) {
 495         my $files = $1;
 496         @add = split(m/\s+/s, $files);
 497     }
 498
 499     if ($log =~ m/(?:\n|^)Removed-files:(.*?)(?=\n\w)/s ) {
 500         my $files = $1;
 501         @del = split(m/\s+/s, $files);
 502     }
 503
 504     if ($log =~ m/(?:\n|^)Modified-files:(.*?)(?=\n\w)/s ) {
 505         my $files = $1;
 506         @mod = split(m/\s+/s, $files);
 507     }
 508
 509     if ($log =~ m/(?:\n|^)Renamed-files:(.*?)(?=\n\w)/s ) {
 510         my $files = $1;
 511         @ren = split(m/\s+/s, $files);
 512     }
 513
 514     $sum ='';
 515     if ($log =~ m/^Summary:(.+?)$/m ) {
 516         $sum = $1;
 517         $sum =~ s/^\s+//;
 518         $sum =~ s/\s+$//;
 519     }
 520
 521     $msg = '';
 522     if ($log =~ m/\n\n(.+)$/s) {
 523         $msg = $1;
 524         $msg =~ s/^\s+//;
 525         $msg =~ s/\s+$//;
 526     }
 527
 528
 529     # cleanup the arrays
 530     foreach my $ref ( (\@add, \@del, \@mod, \@ren) ) {
 531         my @tmp = ();
 532         while (my $t = pop @$ref) {
 533             next unless length ($t);
 534             next if $t =~ m!\{arch\}/!;
 535             next if $t =~ m!\.arch-ids/!;
 536             next if $t =~ m!\.arch-inventory$!;
 537             push (@tmp, shell_quote($t));
 538         }
 539         @$ref = @tmp;
 540     }
 541
 542     #print Dumper [$sum, $msg, \@add, \@del, \@mod, \@ren];
 543     return       ($sum, $msg, \@add, \@del, \@mod, \@ren);
 544 }
 545
 546 # write/read a tag
 547 sub tag {
 548     my ($tag, $commit) = @_;
 549     $tag =~ s|/|--|g;
 550     $tag = shell_quote($tag);
 551
 552     if ($commit) {
 553         open(C,">.git/refs/tags/$tag")
 554             or die "Cannot create tag $tag: $!\n";
 555         print C "$commit\n"
 556             or die "Cannot write tag $tag: $!\n";
 557         close(C)
 558             or die "Cannot write tag $tag: $!\n";
 559         print "Created tag '$tag' on '$commit'\n" if $opt_v;
 560     } else {                    # read
 561         open(C,"<.git/refs/tags/$tag")
 562             or die "Cannot read tag $tag: $!\n";
 563         $commit = <C>;
 564         chomp $commit;
 565         die "Error reading tag $tag: $!\n" unless length $commit == 40;
 566         close(C)
 567             or die "Cannot read tag $tag: $!\n";
 568         return $commit;
 569     }
 570 }
 571
 572 # write/read a private tag
 573 # reads fail softly if the tag isn't there
 574 sub ptag {
 575     my ($tag, $commit) = @_;
 576     $tag =~ s|/|--|g;
 577     $tag = shell_quote($tag);
 578
 579     unless (-d '.git/archimport/tags') {
 580         mkpath('.git/archimport/tags');
 581     }
 582
 583     if ($commit) {              # write
 584         open(C,">.git/archimport/tags/$tag")
 585             or die "Cannot create tag $tag: $!\n";
 586         print C "$commit\n"
 587             or die "Cannot write tag $tag: $!\n";
 588         close(C)
 589             or die "Cannot write tag $tag: $!\n";
 590     } else {                    # read
 591         # if the tag isn't there, return 0
 592         unless ( -s ".git/archimport/tags/$tag") {
 593             return 0;
 594         }
 595         open(C,"<.git/archimport/tags/$tag")
 596             or die "Cannot read tag $tag: $!\n";
 597         $commit = <C>;
 598         chomp $commit;
 599         die "Error reading tag $tag: $!\n" unless length $commit == 40;
 600         close(C)
 601             or die "Cannot read tag $tag: $!\n";
 602         return $commit;
 603     }
 604 }