3 # This tool is copyright (c) 2005, Martin Langhoff.
4 # It is released under the Gnu Public License, version 2.
6 # The basic idea is to walk the output of tla abrowse,
7 # fetch the changesets and apply them.
12 git-archimport [ -h ] [ -v ] [ -T ] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
14 Imports a project from one or more Arch repositories. It will follow branches
15 and repositories within the namespaces defined by the <archive/branch>
16 parameters suppplied. If it cannot find the remote branch a merge comes from
17 it will just import it as a regular commit. If it can find it, it will mark it
18 as a merge whenever possible.
20 See man (1) git-archimport for more details.
24 - create tag objects instead of ref tags
25 - audit shell-escaping of filenames
26 - hide our private tags somewhere smarter
27 - find a way to make "cat *patches | patch" safe even when patchfiles are missing newlines
31 Add print in front of the shell commands invoked via backticks.
39 use File
::Temp
qw(tempfile tempdir);
40 use File
::Path
qw(mkpath);
41 use File
::Basename
qw(basename dirname);
42 use String
::ShellQuote
;
46 use POSIX
qw(strftime dup2);
47 use Data
::Dumper qw
/ Dumper /;
50 $SIG{'PIPE'}="IGNORE";
53 my $git_dir = $ENV{"GIT_DIR"} || ".git";
54 $ENV{"GIT_DIR"} = $git_dir;
55 my $ptag_dir = "$git_dir/archimport/tags";
57 our($opt_h,$opt_v, $opt_T,
62 Usage: ${\basename $0} # fetch/update GIT from Arch
63 [ -h ] [ -v ] [ -T ] [ -t tempdir ]
64 repository/arch-branch [ repository/arch-branch] ...
69 getopts
("Thvt:") or usage
();
72 @ARGV >= 1 or usage
();
73 my @arch_roots = @ARGV;
75 my ($tmpdir, $tmpdirname) = tempdir
('git-archimport-XXXXXX', TMPDIR
=> 1, CLEANUP
=> 1);
76 my $tmp = $opt_t || 1;
77 $tmp = tempdir
('git-archimport-XXXXXX', TMPDIR
=> 1, CLEANUP
=> 1);
78 $opt_v && print "+ Using $tmp as temporary directory\n";
80 my @psets = (); # the collection
81 my %psets = (); # the collection, by name
83 my %rptags = (); # my reverse private tags
84 # to map a SHA1 to a commitid
86 foreach my $root (@arch_roots) {
87 my ($arepo, $abranch) = split(m!/!, $root);
88 open ABROWSE
, "tla abrowse -f -A $arepo --desc --merges $abranch |"
89 or die "Problems with tla abrowse: $!";
91 my %ps = (); # the current one
98 # first record padded w 8 spaces
101 # store the record we just captured
103 my %temp = %ps; # break references
104 push (@psets, \
%temp);
105 $psets{$temp{id
}} = \
%temp;
109 my ($id, $type) = split(m/\s{3}/, $_);
114 if ($type =~ m/^\(simple changeset\)/) {
116 } elsif ($type eq '(initial import)') {
118 } elsif ($type =~ m/^\(tag revision of (.+)\)/) {
122 warn "Unknown type $type";
128 # 10 leading spaces or more
129 # indicate commit metadata
132 if ($lastseen eq 'id' && m/^\d{4}-\d{2}-\d{2}/) {
134 my ($date, $authoremail) = split(m/\s{2,}/, $_);
136 $ps{date
} =~ s/\bGMT$//; # strip off trailign GMT
137 if ($ps{date
} =~ m/\b\w+$/) {
138 warn 'Arch dates not in GMT?! - imported dates will be wrong';
141 $authoremail =~ m/^(.+)\s(\S+)$/;
147 } elsif ($lastseen eq 'date') {
148 # the only hint is position
149 # subject is after date
153 } elsif ($lastseen eq 'subj' && $_ eq 'merges in:') {
155 $lastseen = 'merges';
157 } elsif ($lastseen eq 'merges' && s/^\s{2}//) {
158 push (@
{$ps{merges
}}, $_);
160 warn 'more metadata after merges!?';
167 my %temp = %ps; # break references
168 push (@psets, \
%temp);
169 $psets{ $temp{id
} } = \
%temp;
173 } # end foreach $root
175 ## Order patches by time
176 @psets = sort {$a->{date
}.$b->{id
} cmp $b->{date
}.$b->{id
}} @psets;
178 #print Dumper \@psets;
181 ## TODO cleanup irrelevant patches
182 ## and put an initial import
185 unless (-d
$git_dir) { # initial import
186 if ($psets[0]{type
} eq 'i' || $psets[0]{type
} eq 't') {
187 print "Starting import from $psets[0]{id}\n";
192 die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
194 } else { # progressing an import
196 opendir(DIR
, "$git_dir/archimport/tags")
197 || die "can't opendir: $!";
198 while (my $file = readdir(DIR
)) {
199 # skip non-interesting-files
200 next unless -f
"$ptag_dir/$file";
202 # convert first '--' to '/' from old git-archimport to use
203 # as an archivename/c--b--v private tag
207 print STDERR
"converting old tag $oldfile to $file\n";
208 rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;
210 my $sha = ptag
($file);
212 $rptags{$sha} = $file;
218 foreach my $ps (@psets) {
220 $ps->{branch
} = branchname
($ps->{id
});
223 # ensure we have a clean state
225 if (`git diff-files`) {
226 die "Unclean tree when about to process $ps->{id} " .
227 " - did we fail to commit cleanly before?";
232 # skip commits already in repo
234 if (ptag
($ps->{id
})) {
235 $opt_v && print " * Skipping already imported: $ps->{id}\n";
239 print " * Starting to work on $ps->{id}\n";
242 # create the branch if needed
244 if ($ps->{type
} eq 'i' && !$import) {
245 die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
248 unless ($import) { # skip for import
249 if ( -e
"$git_dir/refs/heads/$ps->{branch}") {
250 # we know about this branch
251 `git checkout $ps->{branch}`;
253 # new branch! we need to verify a few things
254 die "Branch on a non-tag!" unless $ps->{type
} eq 't';
255 my $branchpoint = ptag
($ps->{tag
});
256 die "Tagging from unknown id unsupported: $ps->{tag}"
259 # find where we are supposed to branch from
260 `git checkout -b $ps->{branch} $branchpoint`;
262 # If we trust Arch with the fact that this is just
263 # a tag, and it does not affect the state of the tree
264 # then we just tag and move on
265 tag
($ps->{id
}, $branchpoint);
266 ptag
($ps->{id
}, $branchpoint);
267 print " * Tagged $ps->{id} at $branchpoint\n";
274 # Apply the import/changeset/merge into the working tree
276 if ($ps->{type
} eq 'i' || $ps->{type
} eq 't') {
277 apply_import
($ps) or die $!;
279 } elsif ($ps->{type
} eq 's') {
284 # prepare update git's index, based on what arch knows
285 # about the pset, resolve parents, etc
289 my $commitlog = `tla cat-archive-log -A $ps->{repo} $ps->{id}`;
290 die "Error in cat-archive-log: $!" if $?
;
292 # parselog will git-add/rm files
293 # and generally prepare things for the commit
294 # NOTE: parselog will shell-quote filenames!
295 my ($sum, $msg, $add, $del, $mod, $ren) = parselog
($commitlog);
296 my $logmessage = "$sum\n$msg";
299 # imports don't give us good info
300 # on added files. Shame on them
301 if ($ps->{type
} eq 'i' || $ps->{type
} eq 't') {
302 `find . -type f -print0 | grep -zv '^./$git_dir' | xargs -0 -l100 git-update-index --add`;
303 `git-ls-files --deleted -z | xargs --no-run-if-empty -0 -l100 git-update-index --remove`;
308 my @slice = splice(@
$add, 0, 100);
309 my $slice = join(' ', @slice);
310 `git-update-index --add $slice`;
311 die "Error in git-update-index --add: $!" if $?
;
315 foreach my $file (@
$del) {
316 unlink $file or die "Problems deleting $file : $!";
319 my @slice = splice(@
$del, 0, 100);
320 my $slice = join(' ', @slice);
321 `git-update-index --remove $slice`;
322 die "Error in git-update-index --remove: $!" if $?
;
325 if (@
$ren) { # renamed
327 die "Odd number of entries in rename!?";
331 my $from = pop @
$ren;
334 unless (-d dirname
($to)) {
335 mkpath
(dirname
($to)); # will die on err
337 #print "moving $from $to";
339 die "Error renaming $from $to : $!" if $?
;
340 `git-update-index --remove $from`;
341 die "Error in git-update-index --remove: $!" if $?
;
342 `git-update-index --add $to`;
343 die "Error in git-update-index --add: $!" if $?
;
347 if (@
$mod) { # must be _after_ renames
349 my @slice = splice(@
$mod, 0, 100);
350 my $slice = join(' ', @slice);
351 `git-update-index $slice`;
352 die "Error in git-update-index: $!" if $?
;
356 # warn "errors when running git-update-index! $!";
357 $tree = `git-write-tree`;
358 die "cannot write tree $!" if $?
;
366 if ( -e
"$git_dir/refs/heads/$ps->{branch}") {
367 if (open HEAD
, "<$git_dir/refs/heads/$ps->{branch}") {
373 if ($ps->{type
} eq 's') {
374 warn "Could not find the right head for the branch $ps->{branch}";
380 push @par, find_parents
($ps);
382 my $par = join (' ', @par);
385 # Commit, tag and clean state
388 $ENV{GIT_AUTHOR_NAME
} = $ps->{author
};
389 $ENV{GIT_AUTHOR_EMAIL
} = $ps->{email
};
390 $ENV{GIT_AUTHOR_DATE
} = $ps->{date
};
391 $ENV{GIT_COMMITTER_NAME
} = $ps->{author
};
392 $ENV{GIT_COMMITTER_EMAIL
} = $ps->{email
};
393 $ENV{GIT_COMMITTER_DATE
} = $ps->{date
};
395 my ($pid, $commit_rh, $commit_wh);
396 $commit_rh = 'commit_rh';
397 $commit_wh = 'commit_wh';
399 $pid = open2
(*READER
, *WRITER
, "git-commit-tree $tree $par")
401 print WRITER
$logmessage; # write
403 my $commitid = <READER
>; # read
406 waitpid $pid,0; # close;
408 if (length $commitid != 40) {
409 die "Something went wrong with the commit! $! $commitid";
414 open HEAD
, ">$git_dir/refs/heads/$ps->{branch}";
415 print HEAD
$commitid;
417 system('git-update-ref', 'HEAD', "$ps->{branch}");
420 ptag
($ps->{id
}, $commitid); # private tag
421 if ($opt_T || $ps->{type
} eq 't' || $ps->{type
} eq 'i') {
422 tag
($ps->{id
}, $commitid);
424 print " * Committed $ps->{id}\n";
425 print " + tree $tree\n";
426 print " + commit $commitid\n";
427 $opt_v && print " + commit date is $ps->{date} \n";
428 $opt_v && print " + parents: $par \n";
434 my @parts = split(m/--/, $id);
435 return join('--', @parts[0..1]);
440 my $bname = branchname
($ps->{id
});
444 `tla get -s --no-pristine -A $ps->{repo} $ps->{id} $tmp/import`;
445 die "Cannot get import: $!" if $?
;
446 `rsync -v --archive --delete --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/import/* ./`;
447 die "Cannot rsync import:$!" if $?
;
449 `rm -fr $tmp/import`;
450 die "Cannot remove tempdir: $!" if $?
;
462 `tla get-changeset -A $ps->{repo} $ps->{id} $tmp/changeset`;
463 die "Cannot get changeset: $!" if $?
;
466 if (`find $tmp/changeset/patches -type f -name '*.patch'`) {
467 # this can be sped up considerably by doing
468 # (find | xargs cat) | patch
469 # but that cna get mucked up by patches
470 # with missing trailing newlines or the standard
471 # 'missing newline' flag in the patch - possibly
472 # produced with an old/buggy diff.
473 # slow and safe, we invoke patch once per patchfile
474 `find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;
475 die "Problem applying patches! $!" if $?
;
478 # apply changed binary files
479 if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {
480 foreach my $mod (@modified) {
483 $orig =~ s/\.modified$//; # lazy
484 $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
485 #print "rsync -p '$mod' '$orig'";
486 `rsync -p $mod ./$orig`;
487 die "Problem applying binary changes! $!" if $?
;
492 `rsync --archive --exclude '$git_dir' --exclude '.arch-ids' --exclude '{arch}' $tmp/changeset/new-files-archive/* ./`;
494 # deleted files are hinted from the commitlog processing
496 `rm -fr $tmp/changeset`;
501 # A log entry looks like
502 # Revision: moodle-org--moodle--1.3.3--patch-15
503 # Archive: arch-eduforge@catalyst.net.nz--2004
504 # Creator: Penny Leach <penny@catalyst.net.nz>
505 # Date: Wed May 25 14:15:34 NZST 2005
506 # Standard-date: 2005-05-25 02:15:34 GMT
507 # New-files: lang/de/.arch-ids/block_glossary_random.php.id
508 # lang/de/.arch-ids/block_html.php.id
509 # New-directories: lang/de/help/questionnaire
510 # lang/de/help/questionnaire/.arch-ids
511 # Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
512 # db_sears.sql db/db_sears.sql
513 # Removed-files: lang/be/docs/.arch-ids/release.html.id
514 # lang/be/docs/.arch-ids/releaseold.html.id
515 # Modified-files: admin/cron.php admin/delete.php
516 # admin/editor.html backup/lib.php backup/restore.php
517 # New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
518 # Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
521 # Updating yadda tadda tadda madda
526 my (@add, @del, @mod, @ren, @kw, $sum, $msg );
528 if ($log =~ m/(?:\n|^)New-files:(.*?)(?=\n\w)/s ) {
530 @add = split(m/\s+/s, $files);
533 if ($log =~ m/(?:\n|^)Removed-files:(.*?)(?=\n\w)/s ) {
535 @del = split(m/\s+/s, $files);
538 if ($log =~ m/(?:\n|^)Modified-files:(.*?)(?=\n\w)/s ) {
540 @mod = split(m/\s+/s, $files);
543 if ($log =~ m/(?:\n|^)Renamed-files:(.*?)(?=\n\w)/s ) {
545 @ren = split(m/\s+/s, $files);
549 if ($log =~ m/^Summary:(.+?)$/m ) {
556 if ($log =~ m/\n\n(.+)$/s) {
564 foreach my $ref ( (\
@add, \
@del, \
@mod, \
@ren) ) {
566 while (my $t = pop @
$ref) {
567 next unless length ($t);
568 next if $t =~ m!\{arch\}/!;
569 next if $t =~ m!\.arch-ids/!;
570 next if $t =~ m!\.arch-inventory$!;
571 # tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
572 # we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
574 $t = `tla escape --unescaped '$t'`;
576 push (@tmp, shell_quote
($t));
581 #print Dumper [$sum, $msg, \@add, \@del, \@mod, \@ren];
582 return ($sum, $msg, \
@add, \
@del, \
@mod, \
@ren);
587 my ($tag, $commit) = @_;
589 # don't use subdirs for tags yet, it could screw up other porcelains
593 open(C
,">","$git_dir/refs/tags/$tag")
594 or die "Cannot create tag $tag: $!\n";
596 or die "Cannot write tag $tag: $!\n";
598 or die "Cannot write tag $tag: $!\n";
599 print " * Created tag '$tag' on '$commit'\n" if $opt_v;
601 open(C
,"<","$git_dir/refs/tags/$tag")
602 or die "Cannot read tag $tag: $!\n";
605 die "Error reading tag $tag: $!\n" unless length $commit == 40;
607 or die "Cannot read tag $tag: $!\n";
612 # write/read a private tag
613 # reads fail softly if the tag isn't there
615 my ($tag, $commit) = @_;
617 # don't use subdirs for tags yet, it could screw up other porcelains
620 my $tag_file = "$ptag_dir/$tag";
621 my $tag_branch_dir = dirname
($tag_file);
622 mkpath
($tag_branch_dir) unless (-d
$tag_branch_dir);
624 if ($commit) { # write
625 open(C
,">",$tag_file)
626 or die "Cannot create tag $tag: $!\n";
628 or die "Cannot write tag $tag: $!\n";
630 or die "Cannot write tag $tag: $!\n";
631 $rptags{$commit} = $tag
632 unless $tag =~ m/--base-0$/;
634 # if the tag isn't there, return 0
635 unless ( -s
$tag_file) {
638 open(C
,"<",$tag_file)
639 or die "Cannot read tag $tag: $!\n";
642 die "Error reading tag $tag: $!\n" unless length $commit == 40;
644 or die "Cannot read tag $tag: $!\n";
645 unless (defined $rptags{$commit}) {
646 $rptags{$commit} = $tag;
654 # Identify what branches are merging into me
655 # and whether we are fully merged
656 # git-merge-base <headsha> <headsha> should tell
657 # me what the base of the merge should be
661 my %branches; # holds an arrayref per branch
662 # the arrayref contains a list of
663 # merged patches between the base
664 # of the merge and the current head
666 my @parents; # parents found for this commit
668 # simple loop to split the merges
670 foreach my $merge (@
{$ps->{merges
}}) {
671 my $branch = branchname
($merge);
672 unless (defined $branches{$branch} ){
673 $branches{$branch} = [];
675 push @
{$branches{$branch}}, $merge;
679 # foreach branch find a merge base and walk it to the
680 # head where we are, collecting the merged patchsets that
681 # Arch has recorded. Keep that in @have
682 # Compare that with the commits on the other branch
683 # between merge-base and the tip of the branch (@need)
684 # and see if we have a series of consecutive patches
685 # starting from the merge base. The tip of the series
686 # of consecutive patches merged is our new parent for
689 foreach my $branch (keys %branches) {
691 # check that we actually know about the branch
692 next unless -e
"$git_dir/refs/heads/$branch";
694 my $mergebase = `git-merge-base $branch $ps->{branch}`;
695 die "Cannot find merge base for $branch and $ps->{branch}" if $?
;
698 # now walk up to the mergepoint collecting what patches we have
699 my $branchtip = git_rev_parse
($ps->{branch
});
700 my @ancestors = `git-rev-list --merge-order $branchtip ^$mergebase`;
701 my %have; # collected merges this branch has
702 foreach my $merge (@
{$ps->{merges
}}) {
706 foreach my $par (@ancestors) {
707 $par = commitid2pset
($par);
708 if (defined $par->{merges
}) {
709 foreach my $merge (@
{$par->{merges
}}) {
710 $ancestorshave{$merge}=1;
714 # print "++++ Merges in $ps->{id} are....\n";
715 # my @have = sort keys %have; print Dumper(\@have);
717 # merge what we have with what ancestors have
718 %have = (%have, %ancestorshave);
720 # see what the remote branch has - these are the merges we
721 # will want to have in a consecutive series from the mergebase
722 my $otherbranchtip = git_rev_parse
($branch);
723 my @needraw = `git-rev-list --merge-order $otherbranchtip ^$mergebase`;
725 foreach my $needps (@needraw) { # get the psets
726 $needps = commitid2pset
($needps);
727 # git-rev-list will also
728 # list commits merged in via earlier
729 # merges. we are only interested in commits
730 # from the branch we're looking at
731 if ($branch eq $needps->{branch
}) {
732 push @need, $needps->{id
};
736 # print "++++ Merges from $branch we want are....\n";
737 # print Dumper(\@need);
740 while (my $needed_commit = pop @need) {
741 if ($have{$needed_commit}) {
742 $newparent = $needed_commit;
744 last; # break out of the while
748 push @parents, $newparent;
752 } # end foreach branch
754 # prune redundant parents
756 foreach my $p (@parents) {
759 foreach my $p (@parents) {
760 next unless exists $psets{$p}{merges
};
761 next unless ref $psets{$p}{merges
};
762 my @merges = @
{$psets{$p}{merges
}};
763 foreach my $merge (@merges) {
764 if ($parents{$merge}) {
765 delete $parents{$merge};
769 @parents = keys %parents;
770 @parents = map { " -p " . ptag
($_) } @parents;
776 my $val = `git-rev-parse $name`;
777 die "Error: git-rev-parse $name" if $?
;
782 # resolve a SHA1 to a known patchset
784 my $commitid = shift;
786 my $name = $rptags{$commitid}
787 || die "Cannot find reverse tag mapping for $commitid";
789 my $ps = $psets{$name}
790 || (print Dumper
(sort keys %psets)) && die "Cannot find patchset for $name";