Git Source Code Mirror - This is a publish-only repository and all pull requests are ignored. Please follow Documentation/SubmittingPatches procedure for any of your improvements. https://git-scm.com/
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
git/git-archimport.perl

1135 lines
36 KiB

#!/usr/bin/perl
#
# This tool is copyright (c) 2005, Martin Langhoff.
# It is released under the Gnu Public License, version 2.
#
# The basic idea is to walk the output of tla abrowse,
# fetch the changesets and apply them.
#
=head1 Invocation
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>
parameters supplied. If it cannot find the remote branch a merge comes from
it will just import it as a regular commit. If it can find it, it will mark it
as a merge whenever possible.
See man (1) git-archimport for more details.
=head1 TODO
- create tag objects instead of ref tags
- 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
Add print in front of the shell commands invoked via backticks.
=head1 Devel Notes
There are several places where Arch and git terminology are intermixed
and potentially confused.
The notion of a "branch" in git is approximately equivalent to
a "archive/category--branch--version" in Arch. Also, it should be noted
that the "--branch" portion of "archive/category--branch--version" is really
optional in Arch although not many people (nor tools!) seem to know this.
This means that "archive/category--version" is also a valid "branch"
in git terms.
We always refer to Arch names by their fully qualified variant (which
means the "archive" name is prefixed.
For people unfamiliar with Arch, an "archive" is the term for "repository",
and can contain multiple, unrelated branches.
=cut
use 5.008;
use strict;
use warnings;
use Getopt::Std;
use File::Temp qw(tempdir);
use File::Path qw(mkpath rmtree);
use File::Basename qw(basename dirname);
use Data::Dumper qw/ Dumper /;
use IPC::Open2;
$SIG{'PIPE'}="IGNORE";
$ENV{'TZ'}="UTC";
my $git_dir = $ENV{"GIT_DIR"} || ".git";
$ENV{"GIT_DIR"} = $git_dir;
my $ptag_dir = "$git_dir/archimport/tags";
our($opt_h,$opt_f,$opt_v,$opt_T,$opt_t,$opt_D,$opt_a,$opt_o);
sub usage() {
print STDERR <<END;
usage: git archimport # fetch/update GIT from Arch
[ -h ] [ -v ] [ -o ] [ -a ] [ -f ] [ -T ] [ -D depth ] [ -t tempdir ]
repository/arch-branch [ repository/arch-branch] ...
END
exit(1);
}
getopts("fThvat:D:") or usage();
usage if $opt_h;
@ARGV >= 1 or usage();
# $arch_branches:
# values associated with keys:
# =1 - Arch version / git 'branch' detected via abrowse on a limit
# >1 - Arch version / git 'branch' of an auxiliary branch we've merged
my %arch_branches = map { my $branch = $_; $branch =~ s/:[^:]*$//; $branch => 1 } @ARGV;
# $branch_name_map:
# maps arch branches to git branch names
my %branch_name_map = map { m/^(.*):([^:]*)$/; $1 => $2 } grep { m/:/ } @ARGV;
$ENV{'TMPDIR'} = $opt_t if $opt_t; # $ENV{TMPDIR} will affect tempdir() calls:
my $tmp = tempdir('git-archimport-XXXXXX', TMPDIR => 1, CLEANUP => 1);
$opt_v && print "+ Using $tmp as temporary directory\n";
unless (-d $git_dir) { # initial import needs empty directory
opendir DIR, '.' or die "Unable to open current directory: $!\n";
while (my $entry = readdir DIR) {
$entry =~ /^\.\.?$/ or
die "Initial import needs an empty current working directory.\n"
}
closedir DIR
}
my $default_archive; # default Arch archive
my %reachable = (); # Arch repositories we can access
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
my $TLA = $ENV{'ARCH_CLIENT'} || 'tla';
sub do_abrowse {
my $stage = shift;
while (my ($limit, $level) = each %arch_branches) {
next unless $level == $stage;
open ABROWSE, "$TLA abrowse -fkD --merges $limit |"
or die "Problems with tla abrowse: $!";
my %ps = (); # the current one
my $lastseen = '';
while (<ABROWSE>) {
chomp;
# first record padded w 8 spaces
if (s/^\s{8}\b//) {
my ($id, $type) = split(m/\s+/, $_, 2);
my %last_ps;
# store the record we just captured
if (%ps && !exists $psets{ $ps{id} }) {
%last_ps = %ps; # break references
push (@psets, \%last_ps);
$psets{ $last_ps{id} } = \%last_ps;
}
my $branch = extract_versionname($id);
%ps = ( id => $id, branch => $branch );
if (%last_ps && ($last_ps{branch} eq $branch)) {
$ps{parent_id} = $last_ps{id};
}
$arch_branches{$branch} = 1;
$lastseen = 'id';
# deal with types (should work with baz or tla):
if ($type =~ m/\(.*changeset\)/) {
$ps{type} = 's';
} elsif ($type =~ /\(.*import\)/) {
$ps{type} = 'i';
} elsif ($type =~ m/\(tag.*?(\S+\@\S+).*?\)/) {
$ps{type} = 't';
# read which revision we've tagged when we parse the log
$ps{tag} = $1;
} else {
warn "Unknown type $type";
}
$arch_branches{$branch} = 1;
$lastseen = 'id';
} elsif (s/^\s{10}//) {
# 10 leading spaces or more
# indicate commit metadata
# date
if ($lastseen eq 'id' && m/^(\d{4}-\d\d-\d\d \d\d:\d\d:\d\d)/){
$ps{date} = $1;
$lastseen = 'date';
} elsif ($_ eq 'merges in:') {
$ps{merges} = [];
$lastseen = 'merges';
} elsif ($lastseen eq 'merges' && s/^\s{2}//) {
my $id = $_;
push (@{$ps{merges}}, $id);
# aggressive branch finding:
if ($opt_D) {
my $branch = extract_versionname($id);
my $repo = extract_reponame($branch);
if (archive_reachable($repo) &&
!defined $arch_branches{$branch}) {
$arch_branches{$branch} = $stage + 1;
}
}
} else {
warn "more metadata after merges!?: $_\n" unless /^\s*$/;
}
}
}
if (%ps && !exists $psets{ $ps{id} }) {
my %temp = %ps; # break references
if (@psets && $psets[$#psets]{branch} eq $ps{branch}) {
$temp{parent_id} = $psets[$#psets]{id};
}
push (@psets, \%temp);
$psets{ $temp{id} } = \%temp;
}
close ABROWSE or die "$TLA abrowse failed on $limit\n";
}
} # end foreach $root
do_abrowse(1);
my $depth = 2;
$opt_D ||= 0;
while ($depth <= $opt_D) {
do_abrowse($depth);
$depth++;
}
## Order patches by time
# FIXME see if we can find a more optimal way to do this by graphing
# the ancestry data and walking it, that way we won't have to rely on
# client-supplied dates
@psets = sort {$a->{date}.$b->{id} cmp $b->{date}.$b->{id}} @psets;
#print Dumper \@psets;
##
## TODO cleanup irrelevant patches
## and put an initial import
## or a full tag
my $import = 0;
unless (-d $git_dir) { # initial import
if ($psets[0]{type} eq 'i' || $psets[0]{type} eq 't') {
print "Starting import from $psets[0]{id}\n";
`git-init`;
die $! if $?;
$import = 1;
} else {
die "Need to start from an import or a tag -- cannot use $psets[0]{id}";
}
} else { # progressing an import
# load the rptags
opendir(DIR, $ptag_dir)
|| die "can't opendir: $!";
while (my $file = readdir(DIR)) {
# skip non-interesting-files
next unless -f "$ptag_dir/$file";
# convert first '--' to '/' from old git-archimport to use
# as an archivename/c--b--v private tag
if ($file !~ m!,!) {
my $oldfile = $file;
$file =~ s!--!,!;
print STDERR "converting old tag $oldfile to $file\n";
rename("$ptag_dir/$oldfile", "$ptag_dir/$file") or die $!;
}
my $sha = ptag($file);
chomp $sha;
$rptags{$sha} = $file;
}
closedir DIR;
}
# process patchsets
# extract the Arch repository name (Arch "archive" in Arch-speak)
sub extract_reponame {
my $fq_cvbr = shift; # archivename/[[[[category]branch]version]revision]
return (split(/\//, $fq_cvbr))[0];
}
sub extract_versionname {
my $name = shift;
$name =~ s/--(?:patch|version(?:fix)?|base)-\d+$//;
return $name;
}
# convert a fully-qualified revision or version to a unique dirname:
# normalperson@yhbt.net-05/mpd--uclinux--1--patch-2
# becomes: normalperson@yhbt.net-05,mpd--uclinux--1
#
# the git notion of a branch is closer to
# archive/category--branch--version than archive/category--branch, so we
# use this to convert to git branch names.
# Also, keep archive names but replace '/' with ',' since it won't require
# subdirectories, and is safer than swapping '--' which could confuse
# reverse-mapping when dealing with bastard branches that
# are just archive/category--version (no --branch)
sub tree_dirname {
my $revision = shift;
my $name = extract_versionname($revision);
$name =~ s#/#,#;
return $name;
}
# old versions of git-archimport just use the <category--branch> part:
sub old_style_branchname {
my $id = shift;
my $ret = safe_pipe_capture($TLA,'parse-package-name','-p',$id);
chomp $ret;
return $ret;
}
*git_default_branchname = $opt_o ? *old_style_branchname : *tree_dirname;
# retrieve default archive, since $branch_name_map keys might not include it
sub get_default_archive {
if (!defined $default_archive) {
$default_archive = safe_pipe_capture($TLA,'my-default-archive');
chomp $default_archive;
}
return $default_archive;
}
sub git_branchname {
my $revision = shift;
my $name = extract_versionname($revision);
if (exists $branch_name_map{$name}) {
return $branch_name_map{$name};
} elsif ($name =~ m#^([^/]*)/(.*)$#
&& $1 eq get_default_archive()
&& exists $branch_name_map{$2}) {
# the names given in the command-line lacked the archive.
return $branch_name_map{$2};
} else {
return git_default_branchname($revision);
}
}
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";
# 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
if (! -e "$git_dir/refs/heads/$ps->{branch}") {
system('git-branch',$ps->{branch},$branchpoint) == 0 or die "$! $?\n";
# We trust Arch with the fact that this is just a tag,
# and it does not affect the state of the tree, so
# we just tag and move on. If the user really wants us
# to consolidate more branches into one, don't tag because
# the tag name would be already taken.
tag($ps->{id}, $branchpoint);
ptag($ps->{id}, $branchpoint);
print " * Tagged $ps->{id} at $branchpoint\n";
}
system('git-checkout','-f',$ps->{branch}) == 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;
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
#
if ($ps->{type} eq 'i' && !$import) {
die "Should not have more than one 'Initial import' per GIT import: $ps->{id}";
}
unless ($import) { # skip for import
if ( -e "$git_dir/refs/heads/$ps->{branch}") {
# we know about this branch
system('git-checkout',$ps->{branch});
} else {
# new branch! we need to verify a few things
die "Branch on a non-tag!" unless $ps->{type} eq 't';
my $branchpoint = ptag($ps->{tag});
die "Tagging from unknown id unsupported: $ps->{tag}"
unless $branchpoint;
# find where we are supposed to branch from
if (! -e "$git_dir/refs/heads/$ps->{branch}") {
system('git-branch',$ps->{branch},$branchpoint) == 0 or die "$! $?\n";
# We trust Arch with the fact that this is just a tag,
# and it does not affect the state of the tree, so
# we just tag and move on. If the user really wants us
# to consolidate more branches into one, don't tag because
# the tag name would be already taken.
tag($ps->{id}, $branchpoint);
ptag($ps->{id}, $branchpoint);
print " * Tagged $ps->{id} at $branchpoint\n";
}
system('git-checkout',$ps->{branch}) == 0 or die "$! $?\n";
return 0;
}
die $! if $?;
}
#
# Apply the import/changeset/merge into the working tree
#
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 @commitlog = safe_pipe_capture($TLA,'cat-archive-log',$ps->{id});
die "Error in cat-archive-log: $!" if $?;
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') {
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";
}
# TODO: handle removed_directories and renamed_directories:
if (my $del = $ps->{removed_files}) {
unlink @$del;
while (@$del) {
my @slice = splice(@$del, 0, 100);
system('git-update-index','--remove','--',@slice) == 0 or
die "Error in git-update-index --remove: $! $?\n";
}
}
if (my $ren = $ps->{renamed_files}) { # renamed
if (@$ren % 2) {
die "Odd number of entries in rename!?";
}
while (@$ren) {
my $from = shift @$ren;
my $to = shift @$ren;
unless (-d dirname($to)) {
mkpath(dirname($to)); # will die on err
}
# 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 (my $mod = $ps->{modified_files}) {
while (@$mod) {
my @slice = splice(@$mod, 0, 100);
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! $!";
my $tree = `git-write-tree`;
die "cannot write tree $!" if $?;
chomp $tree;
#
# Who's your daddy?
#
my @par;
if ( -e "$git_dir/refs/heads/$ps->{branch}") {
if (open HEAD, "<","$git_dir/refs/heads/$ps->{branch}") {
my $p = <HEAD>;
close HEAD;
chomp $p;
push @par, '-p', $p;
} else {
if ($ps->{type} eq 's') {
warn "Could not find the right head for the branch $ps->{branch}";
}
}
}
if ($ps->{merges}) {
push @par, find_parents($ps);
}
#
# Commit, tag and clean state
#
$ENV{TZ} = 'GMT';
$ENV{GIT_AUTHOR_NAME} = $ps->{author};
$ENV{GIT_AUTHOR_EMAIL} = $ps->{email};
$ENV{GIT_AUTHOR_DATE} = $ps->{date};
$ENV{GIT_COMMITTER_NAME} = $ps->{author};
$ENV{GIT_COMMITTER_EMAIL} = $ps->{email};
$ENV{GIT_COMMITTER_DATE} = $ps->{date};
my $pid = open2(*READER, *WRITER,'git-commit-tree',$tree,@par)
or die $!;
print WRITER $ps->{summary},"\n\n";
# only print message if it's not empty, to avoid a spurious blank line;
# also append an extra newline, so there's a blank line before the
# following "git-archimport-id:" line.
print WRITER $ps->{message},"\n\n" if ($ps->{message} ne "");
# make it easy to backtrack and figure out which Arch revision this was:
print WRITER 'git-archimport-id: ',$ps->{id},"\n";