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.
35 There are several places where Arch and git terminology are intermixed
36 and potentially confused.
38 The notion of a "branch" in git is approximately equivalent to
39 a "archive/category--branch--version" in Arch. Also, it should be noted
40 that the "--branch" portion of "archive/category--branch--version" is really
41 optional in Arch although not many people (nor tools!) seem to know this.
42 This means that "archive/category--version" is also a valid "branch"
45 We always refer to Arch names by their fully qualified variant (which
46 means the "archive" name is prefixed.
48 For people unfamiliar with Arch, an "archive" is the term for "repository",
49 and can contain multiple, unrelated branches.
57 use File
::Temp
qw(tempfile tempdir);
58 use File
::Path
qw(mkpath rmtree);
59 use File
::Basename
qw(basename dirname);
63 use POSIX
qw(strftime dup2);
64 use Data
::Dumper qw
/ Dumper /;
67 $SIG{'PIPE'}="IGNORE";
70 my $git_dir = $ENV{"GIT_DIR"} || ".git";
71 $ENV{"GIT_DIR"} = $git_dir;
72 my $ptag_dir = "$git_dir/archimport/tags";
74 our($opt_h,$opt_v, $opt_T,$opt_t,$opt_o);
78 Usage: ${\basename $0} # fetch/update GIT from Arch
79 [ -o ] [ -h ] [ -v ] [ -T ] [ -t tempdir ]
80 repository/arch-branch [ repository/arch-branch] ...
85 getopts
("Thvt:") or usage
();
88 @ARGV >= 1 or usage
();
89 my @arch_roots = @ARGV;
91 my ($tmpdir, $tmpdirname) = tempdir
('git-archimport-XXXXXX', TMPDIR
=> 1, CLEANUP
=> 1);
92 my $tmp = $opt_t || 1;
93 $tmp = tempdir
('git-archimport-XXXXXX', TMPDIR
=> 1, CLEANUP
=> 1);
94 $opt_v && print "+ Using $tmp as temporary directory\n";
96 my @psets = (); # the collection
97 my %psets = (); # the collection, by name
99 my %rptags = (); # my reverse private tags
100 # to map a SHA1 to a commitid
101 my $TLA = $ENV{'ARCH_CLIENT'} || 'tla';
103 foreach my $root (@arch_roots) {
104 my ($arepo, $abranch) = split(m!/!, $root);
105 open ABROWSE
, "tla abrowse -f -A $arepo --desc --merges $abranch |"
106 or die "Problems with tla abrowse: $!";
108 my %ps = (); # the current one
115 # first record padded w 8 spaces
118 # store the record we just captured
120 my %temp = %ps; # break references
121 push (@psets, \
%temp);
122 $psets{$temp{id
}} = \
%temp;
126 my ($id, $type) = split(m/\s{3}/, $_);
131 if ($type =~ m/^\(simple changeset\)/) {
133 } elsif ($type eq '(initial import)') {
135 } elsif ($type =~ m/^\(tag revision of (.+)\)/) {
139 warn "Unknown type $type";
145 # 10 leading spaces or more
146 # indicate commit metadata
149 if ($lastseen eq 'id' && m/^\d{4}-\d{2}-\d{2}/) {
151 my ($date, $authoremail) = split(m/\s{2,}/, $_);
153 $ps{date
} =~ s/\bGMT$//; # strip off trailign GMT
154 if ($ps{date
} =~ m/\b\w+$/) {
155 warn 'Arch dates not in GMT?! - imported dates will be wrong';
158 $authoremail =~ m/^(.+)\s(\S+)$/;
164 } elsif ($lastseen eq 'date') {
165 # the only hint is position
166 # subject is after date
170 } elsif ($lastseen eq 'subj' && $_ eq 'merges in:') {
172 $lastseen = 'merges';
174 } elsif ($lastseen eq 'merges' && s/^\s{2}//) {
175 push (@
{$ps{merges
}}, $_);
177 warn 'more metadata after merges!?';
184 my %temp = %ps; # break references
185 push (@psets, \
%temp);
186 $psets{ $temp{id
} } = \
%temp;
190 } # end foreach $root
192 ## Order patches by time
193 @psets = sort {$a->{date
}.$b->{id
} cmp $b->{date
}.$b->{id
}} @psets;
195 #print Dumper \@psets;
198 ## TODO cleanup irrelevant patches
199 ## and put an initial import
202 unless (-d
$git_dir) { # initial import
203 if ($psets[0]{type
} eq 'i' || $psets[0]{type
} eq 't') {
204 print "Starting import from $psets[0]{id}\n";
209 die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
211 } else { # progressing an import
213 opendir(DIR
, "$git_dir/archimport/tags")
214 || die "can't opendir: $!";
215 while (my $file = readdir(DIR
)) {
216 # skip non-interesting-files
217 next unless -f
"$ptag_dir/$file";
219 # convert first '--' to '/' from old git-archimport to use
220 # as an archivename/c--b--v private tag
224 print STDERR
"converting old tag $oldfile to $file\n";
225 rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;
227 my $sha = ptag
($file);
229 $rptags{$sha} = $file;
235 # extract the Arch repository name (Arch "archive" in Arch-speak)
236 sub extract_reponame
{
237 my $fq_cvbr = shift; # archivename/[[[[category]branch]version]revision]
238 return (split(/\//, $fq_cvbr))[0];
241 sub extract_versionname
{
243 $name =~ s/--(?:patch|version(?:fix)?|base)-\d+$//;
247 # convert a fully-qualified revision or version to a unique dirname:
248 # normalperson@yhbt.net-05/mpd--uclinux--1--patch-2
249 # becomes: normalperson@yhbt.net-05,mpd--uclinux--1
251 # the git notion of a branch is closer to
252 # archive/category--branch--version than archive/category--branch, so we
253 # use this to convert to git branch names.
254 # Also, keep archive names but replace '/' with ',' since it won't require
255 # subdirectories, and is safer than swapping '--' which could confuse
256 # reverse-mapping when dealing with bastard branches that
257 # are just archive/category--version (no --branch)
259 my $revision = shift;
260 my $name = extract_versionname
($revision);
265 # old versions of git-archimport just use the <category--branch> part:
266 sub old_style_branchname
{
268 my $ret = safe_pipe_capture
($TLA,'parse-package-name','-p',$id);
273 *git_branchname
= $opt_o ?
*old_style_branchname
: *tree_dirname
;
276 foreach my $ps (@psets) {
277 $ps->{branch
} = git_branchname
($ps->{id
});
280 # ensure we have a clean state
282 if (`git diff-files`) {
283 die "Unclean tree when about to process $ps->{id} " .
284 " - did we fail to commit cleanly before?";
289 # skip commits already in repo
291 if (ptag
($ps->{id
})) {
292 $opt_v && print " * Skipping already imported: $ps->{id}\n";
296 print " * Starting to work on $ps->{id}\n";
299 # create the branch if needed
301 if ($ps->{type
} eq 'i' && !$import) {
302 die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
305 unless ($import) { # skip for import
306 if ( -e
"$git_dir/refs/heads/$ps->{branch}") {
307 # we know about this branch
308 system('git-checkout',$ps->{branch
});
310 # new branch! we need to verify a few things
311 die "Branch on a non-tag!" unless $ps->{type
} eq 't';
312 my $branchpoint = ptag
($ps->{tag
});
313 die "Tagging from unknown id unsupported: $ps->{tag}"
316 # find where we are supposed to branch from
317 system('git-checkout','-b',$ps->{branch
},$branchpoint);
319 # If we trust Arch with the fact that this is just
320 # a tag, and it does not affect the state of the tree
321 # then we just tag and move on
322 tag
($ps->{id
}, $branchpoint);
323 ptag
($ps->{id
}, $branchpoint);
324 print " * Tagged $ps->{id} at $branchpoint\n";
331 # Apply the import/changeset/merge into the working tree
333 if ($ps->{type
} eq 'i' || $ps->{type
} eq 't') {
334 apply_import
($ps) or die $!;
336 } elsif ($ps->{type
} eq 's') {
341 # prepare update git's index, based on what arch knows
342 # about the pset, resolve parents, etc
346 my $commitlog = safe_pipe_capture
($TLA,'cat-archive-log',$ps->{id
});
347 die "Error in cat-archive-log: $!" if $?
;
349 # parselog will git-add/rm files
350 # and generally prepare things for the commit
351 # NOTE: parselog will shell-quote filenames!
352 my ($sum, $msg, $add, $del, $mod, $ren) = parselog
($commitlog);
353 my $logmessage = "$sum\n$msg";
356 # imports don't give us good info
357 # on added files. Shame on them
358 if ($ps->{type
} eq 'i' || $ps->{type
} eq 't') {
359 `find . -type f -print0 | grep -zv '^./$git_dir' | xargs -0 -l100 git-update-index --add`;
360 `git-ls-files --deleted -z | xargs --no-run-if-empty -0 -l100 git-update-index --remove`;
365 my @slice = splice(@
$add, 0, 100);
366 my $slice = join(' ', @slice);
367 `git-update-index --add $slice`;
368 die "Error in git-update-index --add: $!" if $?
;
372 foreach my $file (@
$del) {
373 unlink $file or die "Problems deleting $file : $!";
376 my @slice = splice(@
$del, 0, 100);
377 my $slice = join(' ', @slice);
378 `git-update-index --remove $slice`;
379 die "Error in git-update-index --remove: $!" if $?
;
382 if (@
$ren) { # renamed
384 die "Odd number of entries in rename!?";
388 my $from = pop @
$ren;
391 unless (-d dirname
($to)) {
392 mkpath
(dirname
($to)); # will die on err
394 #print "moving $from $to";
396 die "Error renaming $from $to : $!" if $?
;
397 `git-update-index --remove $from`;
398 die "Error in git-update-index --remove: $!" if $?
;
399 `git-update-index --add $to`;
400 die "Error in git-update-index --add: $!" if $?
;
404 if (@
$mod) { # must be _after_ renames
406 my @slice = splice(@
$mod, 0, 100);
407 my $slice = join(' ', @slice);
408 `git-update-index $slice`;
409 die "Error in git-update-index: $!" if $?
;
413 # warn "errors when running git-update-index! $!";
414 $tree = `git-write-tree`;
415 die "cannot write tree $!" if $?
;
423 if ( -e
"$git_dir/refs/heads/$ps->{branch}") {
424 if (open HEAD
, "<","$git_dir/refs/heads/$ps->{branch}") {
430 if ($ps->{type
} eq 's') {
431 warn "Could not find the right head for the branch $ps->{branch}";
437 push @par, find_parents
($ps);
441 # Commit, tag and clean state
444 $ENV{GIT_AUTHOR_NAME
} = $ps->{author
};
445 $ENV{GIT_AUTHOR_EMAIL
} = $ps->{email
};
446 $ENV{GIT_AUTHOR_DATE
} = $ps->{date
};
447 $ENV{GIT_COMMITTER_NAME
} = $ps->{author
};
448 $ENV{GIT_COMMITTER_EMAIL
} = $ps->{email
};
449 $ENV{GIT_COMMITTER_DATE
} = $ps->{date
};
451 my ($pid, $commit_rh, $commit_wh);
452 $commit_rh = 'commit_rh';
453 $commit_wh = 'commit_wh';
455 $pid = open2
(*READER
, *WRITER
,'git-commit-tree',$tree,@par)
457 print WRITER
$logmessage; # write
459 my $commitid = <READER
>; # read
462 waitpid $pid,0; # close;
464 if (length $commitid != 40) {
465 die "Something went wrong with the commit! $! $commitid";
470 open HEAD
, ">","$git_dir/refs/heads/$ps->{branch}";
471 print HEAD
$commitid;
473 system('git-update-ref', 'HEAD', "$ps->{branch}");
476 ptag
($ps->{id
}, $commitid); # private tag
477 if ($opt_T || $ps->{type
} eq 't' || $ps->{type
} eq 'i') {
478 tag
($ps->{id
}, $commitid);
480 print " * Committed $ps->{id}\n";
481 print " + tree $tree\n";
482 print " + commit $commitid\n";
483 $opt_v && print " + commit date is $ps->{date} \n";
484 $opt_v && print " + parents: ",join(' ',@par),"\n";
489 my $bname = git_branchname
($ps->{id
});
493 safe_pipe_capture
($TLA,'get','-s','--no-pristine',$ps->{id
},"$tmp/import");
494 die "Cannot get import: $!" if $?
;
495 system('rsync','-aI','--delete', '--exclude',$git_dir,
496 '--exclude','.arch-ids','--exclude','{arch}',
497 "$tmp/import/", './');
498 die "Cannot rsync import:$!" if $?
;
500 rmtree
("$tmp/import");
501 die "Cannot remove tempdir: $!" if $?
;
513 safe_pipe_capture
($TLA,'get-changeset',$ps->{id
},"$tmp/changeset");
514 die "Cannot get changeset: $!" if $?
;
517 if (`find $tmp/changeset/patches -type f -name '*.patch'`) {
518 # this can be sped up considerably by doing
519 # (find | xargs cat) | patch
520 # but that cna get mucked up by patches
521 # with missing trailing newlines or the standard
522 # 'missing newline' flag in the patch - possibly
523 # produced with an old/buggy diff.
524 # slow and safe, we invoke patch once per patchfile
525 `find $tmp/changeset/patches -type f -name '*.patch' -print0 | grep -zv '{arch}' | xargs -iFILE -0 --no-run-if-empty patch -p1 --forward -iFILE`;
526 die "Problem applying patches! $!" if $?
;
529 # apply changed binary files
530 if (my @modified = `find $tmp/changeset/patches -type f -name '*.modified'`) {
531 foreach my $mod (@modified) {
534 $orig =~ s/\.modified$//; # lazy
535 $orig =~ s!^\Q$tmp\E/changeset/patches/!!;
536 #print "rsync -p '$mod' '$orig'";
537 system('rsync','-p',$mod,"./$orig");
538 die "Problem applying binary changes! $!" if $?
;
543 system('rsync','-aI','--exclude',$git_dir,
544 '--exclude','.arch-ids',
545 '--exclude', '{arch}',
546 "$tmp/changeset/new-files-archive/",'./');
548 # deleted files are hinted from the commitlog processing
550 rmtree
("$tmp/changeset");
555 # A log entry looks like
556 # Revision: moodle-org--moodle--1.3.3--patch-15
557 # Archive: arch-eduforge@catalyst.net.nz--2004
558 # Creator: Penny Leach <penny@catalyst.net.nz>
559 # Date: Wed May 25 14:15:34 NZST 2005
560 # Standard-date: 2005-05-25 02:15:34 GMT
561 # New-files: lang/de/.arch-ids/block_glossary_random.php.id
562 # lang/de/.arch-ids/block_html.php.id
563 # New-directories: lang/de/help/questionnaire
564 # lang/de/help/questionnaire/.arch-ids
565 # Renamed-files: .arch-ids/db_sears.sql.id db/.arch-ids/db_sears.sql.id
566 # db_sears.sql db/db_sears.sql
567 # Removed-files: lang/be/docs/.arch-ids/release.html.id
568 # lang/be/docs/.arch-ids/releaseold.html.id
569 # Modified-files: admin/cron.php admin/delete.php
570 # admin/editor.html backup/lib.php backup/restore.php
571 # New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
572 # Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
575 # Updating yadda tadda tadda madda
580 my (@add, @del, @mod, @ren, @kw, $sum, $msg );
582 if ($log =~ m/(?:\n|^)New-files:(.*?)(?=\n\w)/s ) {
584 @add = split(m/\s+/s, $files);
587 if ($log =~ m/(?:\n|^)Removed-files:(.*?)(?=\n\w)/s ) {
589 @del = split(m/\s+/s, $files);
592 if ($log =~ m/(?:\n|^)Modified-files:(.*?)(?=\n\w)/s ) {
594 @mod = split(m/\s+/s, $files);
597 if ($log =~ m/(?:\n|^)Renamed-files:(.*?)(?=\n\w)/s ) {
599 @ren = split(m/\s+/s, $files);
603 if ($log =~ m/^Summary:(.+?)$/m ) {
610 if ($log =~ m/\n\n(.+)$/s) {
618 foreach my $ref ( (\
@add, \
@del, \
@mod, \
@ren) ) {
620 while (my $t = pop @
$ref) {
621 next unless length ($t);
622 next if $t =~ m!\{arch\}/!;
623 next if $t =~ m!\.arch-ids/!;
624 next if $t =~ m!\.arch-inventory$!;
625 # tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
626 # we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
628 $t = (safe_pipe_capture
($TLA,'escape','--unescaped',$t))[0];
635 #print Dumper [$sum, $msg, \@add, \@del, \@mod, \@ren];
636 return ($sum, $msg, \
@add, \
@del, \
@mod, \
@ren);
641 my ($tag, $commit) = @_;
646 # don't use subdirs for tags yet, it could screw up other porcelains
651 open(C
,">","$git_dir/refs/tags/$tag")
652 or die "Cannot create tag $tag: $!\n";
654 or die "Cannot write tag $tag: $!\n";
656 or die "Cannot write tag $tag: $!\n";
657 print " * Created tag '$tag' on '$commit'\n" if $opt_v;
659 open(C
,"<","$git_dir/refs/tags/$tag")
660 or die "Cannot read tag $tag: $!\n";
663 die "Error reading tag $tag: $!\n" unless length $commit == 40;
665 or die "Cannot read tag $tag: $!\n";
670 # write/read a private tag
671 # reads fail softly if the tag isn't there
673 my ($tag, $commit) = @_;
675 # don't use subdirs for tags yet, it could screw up other porcelains
678 my $tag_file = "$ptag_dir/$tag";
679 my $tag_branch_dir = dirname
($tag_file);
680 mkpath
($tag_branch_dir) unless (-d
$tag_branch_dir);
682 if ($commit) { # write
683 open(C
,">",$tag_file)
684 or die "Cannot create tag $tag: $!\n";
686 or die "Cannot write tag $tag: $!\n";
688 or die "Cannot write tag $tag: $!\n";
689 $rptags{$commit} = $tag
690 unless $tag =~ m/--base-0$/;
692 # if the tag isn't there, return 0
693 unless ( -s
$tag_file) {
696 open(C
,"<",$tag_file)
697 or die "Cannot read tag $tag: $!\n";
700 die "Error reading tag $tag: $!\n" unless length $commit == 40;
702 or die "Cannot read tag $tag: $!\n";
703 unless (defined $rptags{$commit}) {
704 $rptags{$commit} = $tag;
712 # Identify what branches are merging into me
713 # and whether we are fully merged
714 # git-merge-base <headsha> <headsha> should tell
715 # me what the base of the merge should be
719 my %branches; # holds an arrayref per branch
720 # the arrayref contains a list of
721 # merged patches between the base
722 # of the merge and the current head
724 my @parents; # parents found for this commit
726 # simple loop to split the merges
728 foreach my $merge (@
{$ps->{merges
}}) {
729 my $branch = git_branchname
($merge);
730 unless (defined $branches{$branch} ){
731 $branches{$branch} = [];
733 push @
{$branches{$branch}}, $merge;
737 # foreach branch find a merge base and walk it to the
738 # head where we are, collecting the merged patchsets that
739 # Arch has recorded. Keep that in @have
740 # Compare that with the commits on the other branch
741 # between merge-base and the tip of the branch (@need)
742 # and see if we have a series of consecutive patches
743 # starting from the merge base. The tip of the series
744 # of consecutive patches merged is our new parent for
747 foreach my $branch (keys %branches) {
749 # check that we actually know about the branch
750 next unless -e
"$git_dir/refs/heads/$branch";
752 my $mergebase = `git-merge-base $branch $ps->{branch}`;
754 # Don't die here, Arch supports one-way cherry-picking
755 # between branches with no common base (or any relationship
757 warn "Cannot find merge base for $branch and $ps->{branch}";
762 # now walk up to the mergepoint collecting what patches we have
763 my $branchtip = git_rev_parse
($ps->{branch
});
764 my @ancestors = `git-rev-list --merge-order $branchtip ^$mergebase`;
765 my %have; # collected merges this branch has
766 foreach my $merge (@
{$ps->{merges
}}) {
770 foreach my $par (@ancestors) {
771 $par = commitid2pset
($par);
772 if (defined $par->{merges
}) {
773 foreach my $merge (@
{$par->{merges
}}) {
774 $ancestorshave{$merge}=1;
778 # print "++++ Merges in $ps->{id} are....\n";
779 # my @have = sort keys %have; print Dumper(\@have);
781 # merge what we have with what ancestors have
782 %have = (%have, %ancestorshave);
784 # see what the remote branch has - these are the merges we
785 # will want to have in a consecutive series from the mergebase
786 my $otherbranchtip = git_rev_parse
($branch);
787 my @needraw = `git-rev-list --merge-order $otherbranchtip ^$mergebase`;
789 foreach my $needps (@needraw) { # get the psets
790 $needps = commitid2pset
($needps);
791 # git-rev-list will also
792 # list commits merged in via earlier
793 # merges. we are only interested in commits
794 # from the branch we're looking at
795 if ($branch eq $needps->{branch
}) {
796 push @need, $needps->{id
};
800 # print "++++ Merges from $branch we want are....\n";
801 # print Dumper(\@need);
804 while (my $needed_commit = pop @need) {
805 if ($have{$needed_commit}) {
806 $newparent = $needed_commit;
808 last; # break out of the while
812 push @parents, $newparent;
816 } # end foreach branch
818 # prune redundant parents
820 foreach my $p (@parents) {
823 foreach my $p (@parents) {
824 next unless exists $psets{$p}{merges
};
825 next unless ref $psets{$p}{merges
};
826 my @merges = @
{$psets{$p}{merges
}};
827 foreach my $merge (@merges) {
828 if ($parents{$merge}) {
829 delete $parents{$merge};
834 foreach (keys %parents) {
835 push @parents, '-p', ptag
($_);
842 my $val = `git-rev-parse $name`;
843 die "Error: git-rev-parse $name" if $?
;
848 # resolve a SHA1 to a known patchset
850 my $commitid = shift;
852 my $name = $rptags{$commitid}
853 || die "Cannot find reverse tag mapping for $commitid";
855 my $ps = $psets{$name}
856 || (print Dumper
(sort keys %psets)) && die "Cannot find patchset for $name";
860 # an alterative to `command` that allows input to be passed as an array
861 # to work around shell problems with weird characters in arguments
862 sub safe_pipe_capture
{
864 if (my $pid = open my $child, '-|') {
865 @output = (<$child>);
866 close $child or die join(' ',@_).": $! $?";
868 exec(@_) or die $?
; # exec() can fail the executable can't be found
870 return wantarray ?
@output : join('',@output);