=head1 Invocation
- git-archimport [ -h ] [ -v ] [ -T ] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
+ git-archimport [ -h ] [ -v ] [ -o ] [ -a ] [ -f ] [ -T ]
+ [ -D depth] [ -t tempdir ] <archive>/<branch> [ <archive>/<branch> ]
Imports a project from one or more Arch repositories. It will follow branches
and repositories within the namespaces defined by the <archive/branch>
- audit shell-escaping of filenames
- hide our private tags somewhere smarter
- find a way to make "cat *patches | patch" safe even when patchfiles are missing newlines
+ - sort and apply patches by graphing ancestry relations instead of just
+ relying in dates supplied in the changeset itself.
+ tla ancestry-graph -m could be helpful here...
=head1 Devel tricks
$ENV{"GIT_DIR"} = $git_dir;
my $ptag_dir = "$git_dir/archimport/tags";
-our($opt_h,$opt_v,$opt_T,$opt_t,$opt_D,$opt_a,$opt_o);
+our($opt_h,$opt_f,$opt_v,$opt_T,$opt_t,$opt_D,$opt_a,$opt_o);
sub usage() {
print STDERR <<END;
Usage: ${\basename $0} # fetch/update GIT from Arch
- [ -o ] [ -h ] [ -v ] [ -T ] [ -a ] [ -D depth ] [ -t tempdir ]
+ [ -h ] [ -v ] [ -o ] [ -a ] [ -f ] [ -T ] [ -D depth ] [ -t tempdir ]
repository/arch-branch [ repository/arch-branch] ...
END
exit(1);
}
-getopts("Thvat:D:") or usage();
+getopts("fThvat:D:") or usage();
usage if $opt_h;
@ARGV >= 1 or usage();
my %unreachable = (); # Arch repositories we can't access :<
my @psets = (); # the collection
my %psets = (); # the collection, by name
+my %stats = ( # Track which strategy we used to import:
+ get_tag => 0, replay => 0, get_new => 0, get_delta => 0,
+ simple_changeset => 0, import_or_tag => 0
+);
my %rptags = (); # my reverse private tags
# to map a SHA1 to a commitid
$ps{type} = 's';
} elsif ($type =~ /\(.*import\)/) {
$ps{type} = 'i';
- } elsif ($type =~ m/\(tag.*\)/) {
+ } elsif ($type =~ m/\(tag.*?(\S+\@\S+).*?\)/) {
$ps{type} = 't';
# read which revision we've tagged when we parse the log
- #$ps{tag} = $1;
+ $ps{tag} = $1;
} else {
warn "Unknown type $type";
}
*git_branchname = $opt_o ? *old_style_branchname : *tree_dirname;
-# process patchsets
-foreach my $ps (@psets) {
- $ps->{branch} = git_branchname($ps->{id});
+sub process_patchset_accurate {
+ my $ps = shift;
+
+ # switch to that branch if we're not already in that branch:
+ if (-e "$git_dir/refs/heads/$ps->{branch}") {
+ system('git-checkout','-f',$ps->{branch}) == 0 or die "$! $?\n";
- #
- # ensure we have a clean state
- #
- if (`git-diff-files`) {
- die "Unclean tree when about to process $ps->{id} " .
- " - did we fail to commit cleanly before?";
- }
- die $! if $?;
-
- #
- # skip commits already in repo
- #
- if (ptag($ps->{id})) {
- $opt_v && print " * Skipping already imported: $ps->{id}\n";
- next;
+ # remove any old stuff that got leftover:
+ my $rm = safe_pipe_capture('git-ls-files','--others','-z');
+ rmtree(split(/\0/,$rm)) if $rm;
}
+
+ # Apply the import/changeset/merge into the working tree
+ my $dir = sync_to_ps($ps);
+ # read the new log entry:
+ my @commitlog = safe_pipe_capture($TLA,'cat-log','-d',$dir,$ps->{id});
+ die "Error in cat-log: $!" if $?;
+ chomp @commitlog;
+
+ # grab variables we want from the log, new fields get added to $ps:
+ # (author, date, email, summary, message body ...)
+ parselog($ps, \@commitlog);
+
+ if ($ps->{id} =~ /--base-0$/ && $ps->{id} ne $psets[0]{id}) {
+ # this should work when importing continuations
+ if ($ps->{tag} && (my $branchpoint = eval { ptag($ps->{tag}) })) {
+
+ # find where we are supposed to branch from
+ system('git-checkout','-f','-b',$ps->{branch},
+ $branchpoint) == 0 or die "$! $?\n";
+
+ # remove any old stuff that got leftover:
+ my $rm = safe_pipe_capture('git-ls-files','--others','-z');
+ rmtree(split(/\0/,$rm)) if $rm;
- print " * Starting to work on $ps->{id}\n";
+ # If we trust Arch with the fact that this is just
+ # a tag, and it does not affect the state of the tree
+ # then we just tag and move on
+ tag($ps->{id}, $branchpoint);
+ ptag($ps->{id}, $branchpoint);
+ print " * Tagged $ps->{id} at $branchpoint\n";
+ return 0;
+ } else {
+ warn "Tagging from unknown id unsupported\n" if $ps->{tag};
+ }
+ # allow multiple bases/imports here since Arch supports cherry-picks
+ # from unrelated trees
+ }
+
+ # update the index with all the changes we got
+ system('git-diff-files --name-only -z | '.
+ 'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";
+ system('git-ls-files --others -z | '.
+ 'git-update-index --add -z --stdin') == 0 or die "$! $?\n";
+ return 1;
+}
+# the native changeset processing strategy. This is very fast, but
+# does not handle permissions or any renames involving directories
+sub process_patchset_fast {
+ my $ps = shift;
#
# create the branch if needed
#
tag($ps->{id}, $branchpoint);
ptag($ps->{id}, $branchpoint);
print " * Tagged $ps->{id} at $branchpoint\n";
- next;
+ return 0;
}
die $! if $?;
}
#
if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
apply_import($ps) or die $!;
+ $stats{import_or_tag}++;
$import=0;
} elsif ($ps->{type} eq 's') {
apply_cset($ps);
+ $stats{simple_changeset}++;
}
#
# prepare update git's index, based on what arch knows
# about the pset, resolve parents, etc
#
- my $tree;
- my $commitlog = safe_pipe_capture($TLA,'cat-archive-log',$ps->{id});
+ my @commitlog = safe_pipe_capture($TLA,'cat-archive-log',$ps->{id});
die "Error in cat-archive-log: $!" if $?;
- # parselog will git-add/rm files
- # and generally prepare things for the commit
- # NOTE: parselog will shell-quote filenames!
- my ($sum, $msg, $add, $del, $mod, $ren) = parselog($commitlog);
- my $logmessage = "$sum\n$msg";
-
+ parselog($ps,\@commitlog);
# imports don't give us good info
# on added files. Shame on them
- if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
- `find . -type f -print0 | grep -zv '^./$git_dir' | xargs -0 -l100 git-update-index --add`;
- `git-ls-files --deleted -z | xargs --no-run-if-empty -0 -l100 git-update-index --remove`;
+ if ($ps->{type} eq 'i' || $ps->{type} eq 't') {
+ system('git-ls-files --deleted -z | '.
+ 'git-update-index --remove -z --stdin') == 0 or die "$! $?\n";
+ system('git-ls-files --others -z | '.
+ 'git-update-index --add -z --stdin') == 0 or die "$! $?\n";
}
- if (@$add) {
- while (@$add) {
- my @slice = splice(@$add, 0, 100);
- my $slice = join(' ', @slice);
- `git-update-index --add $slice`;
- die "Error in git-update-index --add: $!" if $?;
- }
- }
- if (@$del) {
- foreach my $file (@$del) {
- unlink $file or die "Problems deleting $file : $!";
- }
+ # TODO: handle removed_directories and renamed_directories:
+
+ if (my $del = $ps->{removed_files}) {
+ unlink @$del;
while (@$del) {
my @slice = splice(@$del, 0, 100);
- my $slice = join(' ', @slice);
- `git-update-index --remove $slice`;
- die "Error in git-update-index --remove: $!" if $?;
+ system('git-update-index','--remove','--',@slice) == 0 or
+ die "Error in git-update-index --remove: $! $?\n";
}
}
- if (@$ren) { # renamed
+
+ if (my $ren = $ps->{renamed_files}) { # renamed
if (@$ren % 2) {
die "Odd number of entries in rename!?";
}
- ;
+
while (@$ren) {
- my $from = pop @$ren;
- my $to = pop @$ren;
+ my $from = shift @$ren;
+ my $to = shift @$ren;
unless (-d dirname($to)) {
mkpath(dirname($to)); # will die on err
}
- #print "moving $from $to";
- `mv $from $to`;
- die "Error renaming $from $to : $!" if $?;
- `git-update-index --remove $from`;
- die "Error in git-update-index --remove: $!" if $?;
- `git-update-index --add $to`;
- die "Error in git-update-index --add: $!" if $?;
+ # print "moving $from $to";
+ rename($from, $to) or die "Error renaming '$from' '$to': $!\n";
+ system('git-update-index','--remove','--',$from) == 0 or
+ die "Error in git-update-index --remove: $! $?\n";
+ system('git-update-index','--add','--',$to) == 0 or
+ die "Error in git-update-index --add: $! $?\n";
}
+ }
+ if (my $add = $ps->{new_files}) {
+ while (@$add) {
+ my @slice = splice(@$add, 0, 100);
+ system('git-update-index','--add','--',@slice) == 0 or
+ die "Error in git-update-index --add: $! $?\n";
+ }
}
- if (@$mod) { # must be _after_ renames
+
+ if (my $mod = $ps->{modified_files}) {
while (@$mod) {
my @slice = splice(@$mod, 0, 100);
- my $slice = join(' ', @slice);
- `git-update-index $slice`;
- die "Error in git-update-index: $!" if $?;
+ system('git-update-index','--',@slice) == 0 or
+ die "Error in git-update-index: $! $?\n";
}
}
+ return 1; # we successfully applied the changeset
+}
+
+if ($opt_f) {
+ print "Will import patchsets using the fast strategy\n",
+ "Renamed directories and permission changes will be missed\n";
+ *process_patchset = *process_patchset_fast;
+} else {
+ print "Using the default (accurate) import strategy.\n",
+ "Things may be a bit slow\n";
+ *process_patchset = *process_patchset_accurate;
+}
+
+foreach my $ps (@psets) {
+ # process patchsets
+ $ps->{branch} = git_branchname($ps->{id});
+
+ #
+ # ensure we have a clean state
+ #
+ if (my $dirty = `git-diff-files`) {
+ die "Unclean tree when about to process $ps->{id} " .
+ " - did we fail to commit cleanly before?\n$dirty";
+ }
+ die $! if $?;
+
+ #
+ # skip commits already in repo
+ #
+ if (ptag($ps->{id})) {
+ $opt_v && print " * Skipping already imported: $ps->{id}\n";
+ next;
+ }
+
+ print " * Starting to work on $ps->{id}\n";
+
+ process_patchset($ps) or next;
# warn "errors when running git-update-index! $!";
- $tree = `git-write-tree`;
+ my $tree = `git-write-tree`;
die "cannot write tree $!" if $?;
chomp $tree;
-
#
# Who's your daddy?
$ENV{GIT_COMMITTER_EMAIL} = $ps->{email};
$ENV{GIT_COMMITTER_DATE} = $ps->{date};
- my ($pid, $commit_rh, $commit_wh);
- $commit_rh = 'commit_rh';
- $commit_wh = 'commit_wh';
-
- $pid = open2(*READER, *WRITER,'git-commit-tree',$tree,@par)
+ my $pid = open2(*READER, *WRITER,'git-commit-tree',$tree,@par)
or die $!;
- print WRITER $logmessage; # write
+ print WRITER $ps->{summary},"\n";
+ print WRITER $ps->{message},"\n";
+
+ # make it easy to backtrack and figure out which Arch revision this was:
+ print WRITER 'git-archimport-id: ',$ps->{id},"\n";
+
close WRITER;
my $commitid = <READER>; # read
chomp $commitid;
$opt_v && print " + parents: ",join(' ',@par),"\n";
}
+if ($opt_v) {
+ foreach (sort keys %stats) {
+ print" $_: $stats{$_}\n";
+ }
+}
+exit 0;
+
+# used by the accurate strategy:
+sub sync_to_ps {
+ my $ps = shift;
+ my $tree_dir = $tmp.'/'.tree_dirname($ps->{id});
+
+ $opt_v && print "sync_to_ps($ps->{id}) method: ";
+
+ if (-d $tree_dir) {
+ if ($ps->{type} eq 't') {
+ $opt_v && print "get (tag)\n";
+ # looks like a tag-only or (worse,) a mixed tags/changeset branch,
+ # can't rely on replay to work correctly on these
+ rmtree($tree_dir);
+ safe_pipe_capture($TLA,'get','--no-pristine',$ps->{id},$tree_dir);
+ $stats{get_tag}++;
+ } else {
+ my $tree_id = arch_tree_id($tree_dir);
+ if ($ps->{parent_id} && ($ps->{parent_id} eq $tree_id)) {
+ # the common case (hopefully)
+ $opt_v && print "replay\n";
+ safe_pipe_capture($TLA,'replay','-d',$tree_dir,$ps->{id});
+ $stats{replay}++;
+ } else {
+ # getting one tree is usually faster than getting two trees
+ # and applying the delta ...
+ rmtree($tree_dir);
+ $opt_v && print "apply-delta\n";
+ safe_pipe_capture($TLA,'get','--no-pristine',
+ $ps->{id},$tree_dir);
+ $stats{get_delta}++;
+ }
+ }
+ } else {
+ # new branch work
+ $opt_v && print "get (new tree)\n";
+ safe_pipe_capture($TLA,'get','--no-pristine',$ps->{id},$tree_dir);
+ $stats{get_new}++;
+ }
+
+ # added -I flag to rsync since we're going to fast! AIEEEEE!!!!
+ system('rsync','-aI','--delete','--exclude',$git_dir,
+# '--exclude','.arch-inventory',
+ '--exclude','.arch-ids','--exclude','{arch}',
+ '--exclude','+*','--exclude',',*',
+ "$tree_dir/",'./') == 0 or die "Cannot rsync $tree_dir: $! $?";
+ return $tree_dir;
+}
+
sub apply_import {
my $ps = shift;
my $bname = git_branchname($ps->{id});
# =for reference
-# A log entry looks like
+# notes: *-files/-directories keys cannot have spaces, they're always
+# pika-escaped. Everything after the first newline
+# A log entry looks like:
# Revision: moodle-org--moodle--1.3.3--patch-15
# Archive: arch-eduforge@catalyst.net.nz--2004
# Creator: Penny Leach <penny@catalyst.net.nz>
# admin/editor.html backup/lib.php backup/restore.php
# New-patches: arch-eduforge@catalyst.net.nz--2004/moodle-org--moodle--1.3.3--patch-15
# Summary: Updating to latest from MOODLE_14_STABLE (1.4.5+)
+# summary can be multiline with a leading space just like the above fields
# Keywords:
#
# Updating yadda tadda tadda madda
sub parselog {
- my $log = shift;
- #print $log;
-
- my (@add, @del, @mod, @ren, @kw, $sum, $msg );
-
- if ($log =~ m/(?:\n|^)New-files:(.*?)(?=\n\w)/s ) {
- my $files = $1;
- @add = split(m/\s+/s, $files);
- }
-
- if ($log =~ m/(?:\n|^)Removed-files:(.*?)(?=\n\w)/s ) {
- my $files = $1;
- @del = split(m/\s+/s, $files);
- }
+ my ($ps, $log) = @_;
+ my $key = undef;
+
+ # headers we want that contain filenames:
+ my %want_headers = (
+ new_files => 1,
+ modified_files => 1,
+ renamed_files => 1,
+ renamed_directories => 1,
+ removed_files => 1,
+ removed_directories => 1,
+ );
- if ($log =~ m/(?:\n|^)Modified-files:(.*?)(?=\n\w)/s ) {
- my $files = $1;
- @mod = split(m/\s+/s, $files);
+ chomp (@$log);
+ while ($_ = shift @$log) {
+ if (/^Continuation-of:\s*(.*)/) {
+ $ps->{tag} = $1;
+ $key = undef;
+ } elsif (/^Summary:\s*(.*)$/ ) {
+ # summary can be multiline as long as it has a leading space
+ $ps->{summary} = [ $1 ];
+ $key = 'summary';
+ } elsif (/^Creator: (.*)\s*<([^\>]+)>/) {
+ $ps->{author} = $1;
+ $ps->{email} = $2;
+ $key = undef;
+ # any *-files or *-directories can be read here:
+ } elsif (/^([A-Z][a-z\-]+):\s*(.*)$/) {
+ my $val = $2;
+ $key = lc $1;
+ $key =~ tr/-/_/; # too lazy to quote :P
+ if ($want_headers{$key}) {
+ push @{$ps->{$key}}, split(/\s+/, $val);
+ } else {
+ $key = undef;
+ }
+ } elsif (/^$/) {
+ last; # remainder of @$log that didn't get shifted off is message
+ } elsif ($key) {
+ if (/^\s+(.*)$/) {
+ if ($key eq 'summary') {
+ push @{$ps->{$key}}, $1;
+ } else { # files/directories:
+ push @{$ps->{$key}}, split(/\s+/, $1);
+ }
+ } else {
+ $key = undef;
+ }
+ }
}
+
+ # post-processing:
+ $ps->{summary} = join("\n",@{$ps->{summary}})."\n";
+ $ps->{message} = join("\n",@$log);
- if ($log =~ m/(?:\n|^)Renamed-files:(.*?)(?=\n\w)/s ) {
- my $files = $1;
- @ren = split(m/\s+/s, $files);
- }
-
- $sum ='';
- if ($log =~ m/^Summary:(.+?)$/m ) {
- $sum = $1;
- $sum =~ s/^\s+//;
- $sum =~ s/\s+$//;
- }
-
- $msg = '';
- if ($log =~ m/\n\n(.+)$/s) {
- $msg = $1;
- $msg =~ s/^\s+//;
- $msg =~ s/\s+$//;
- }
-
-
- # cleanup the arrays
- foreach my $ref ( (\@add, \@del, \@mod, \@ren) ) {
+ # skip Arch control files, unescape pika-escaped files
+ foreach my $k (keys %want_headers) {
+ next unless (defined $ps->{$k});
my @tmp = ();
- while (my $t = pop @$ref) {
- next unless length ($t);
- next if $t =~ m!\{arch\}/!;
- next if $t =~ m!\.arch-ids/!;
- next if $t =~ m!\.arch-inventory$!;
+ foreach my $t (@{$ps->{$k}}) {
+ next unless length ($t);
+ next if $t =~ m!\{arch\}/!;
+ next if $t =~ m!\.arch-ids/!;
+ # should we skip this?
+ next if $t =~ m!\.arch-inventory$!;
# tla cat-archive-log will give us filenames with spaces as file\(sp)name - why?
# we can assume that any filename with \ indicates some pika escaping that we want to get rid of.
- if ($t =~ /\\/ ){
+ if ($t =~ /\\/ ){
$t = (safe_pipe_capture($TLA,'escape','--unescaped',$t))[0];
}
- push (@tmp, $t);
+ push @tmp, $t;
}
- @$ref = @tmp;
+ $ps->{$k} = \@tmp;
}
-
- #print Dumper [$sum, $msg, \@add, \@del, \@mod, \@ren];
- return ($sum, $msg, \@add, \@del, \@mod, \@ren);
}
# write/read a tag
@output = (<$child>);
close $child or die join(' ',@_).": $! $?";
} else {
- exec(@_) or die $?; # exec() can fail the executable can't be found
+ exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
}
return wantarray ? @output : join('',@output);
}