diff options
| -rw-r--r-- | Documentation/RelNotes/1.7.12.txt | 15 | ||||
| -rw-r--r-- | Documentation/revisions.txt | 43 | ||||
| -rw-r--r-- | Makefile | 7 | ||||
| -rw-r--r-- | attr.c | 12 | ||||
| -rw-r--r-- | builtin/checkout.c | 2 | ||||
| -rw-r--r-- | dir.c | 2 | ||||
| -rw-r--r-- | git-rebase--interactive.sh | 25 | ||||
| -rwxr-xr-x | git-svn.perl | 3119 | ||||
| -rw-r--r-- | help.c | 14 | ||||
| -rw-r--r-- | perl/.gitignore | 1 | ||||
| -rw-r--r-- | perl/Git/IndexInfo.pm | 33 | ||||
| -rw-r--r-- | perl/Git/SVN.pm | 2326 | ||||
| -rw-r--r-- | perl/Git/SVN/Fetcher.pm | 1 | ||||
| -rw-r--r-- | perl/Git/SVN/GlobSpec.pm | 59 | ||||
| -rw-r--r-- | perl/Git/SVN/Log.pm | 395 | ||||
| -rw-r--r-- | perl/Git/SVN/Migration.pm | 258 | ||||
| -rw-r--r-- | perl/Git/SVN/Utils.pm | 59 | ||||
| -rw-r--r-- | perl/Makefile | 9 | ||||
| -rw-r--r-- | perl/Makefile.PL | 35 | ||||
| -rw-r--r-- | sha1_file.c | 2 | ||||
| -rw-r--r-- | t/Git-SVN/00compile.t | 14 | ||||
| -rw-r--r-- | t/Git-SVN/Utils/can_compress.t | 11 | ||||
| -rw-r--r-- | t/Git-SVN/Utils/fatal.t | 34 | ||||
| -rwxr-xr-x | t/t1100-commit-tree-options.sh | 1 | ||||
| -rwxr-xr-x | t/t1306-xdg-files.sh | 39 | ||||
| -rwxr-xr-x | t/t3404-rebase-interactive.sh | 8 | ||||
| -rwxr-xr-x[-rw-r--r--] | t/t7409-submodule-detached-worktree.sh | 0 | ||||
| -rwxr-xr-x | t/t7502-commit.sh | 75 | ||||
| -rw-r--r-- | t/test-lib.sh | 46 | ||||
| -rw-r--r-- | transport-helper.c | 15 |
30 files changed, 3484 insertions, 3176 deletions
diff --git a/Documentation/RelNotes/1.7.12.txt b/Documentation/RelNotes/1.7.12.txt index 904561de1..4de5b6611 100644 --- a/Documentation/RelNotes/1.7.12.txt +++ b/Documentation/RelNotes/1.7.12.txt @@ -117,6 +117,8 @@ Performance, Internal Implementation, etc. (please report possible regressions) cycles after showing the first change to find the next one, only to discard it. + * "git svn" got a large-looking code reorganization at the last + minute before the code freeze. Also contains minor documentation updates and code clean-ups. @@ -128,6 +130,19 @@ Unless otherwise noted, all the fixes since v1.7.11 in the maintenance releases are contained in this release (see release notes to them for details). + * "git checkout <branchname>" to come back from a detached HEAD state + incorrectly computed reachability of the detached HEAD, resulting + in unnecessary warnings. + (merge add416a jk/maint-checkout-orphan-check-fix later to maint). + + * The documentation for revision range specifiers (e.g. A..B, A^@) + has been updated. + (merge ca5ee2d mh/maint-revisions-doc later to maint). + + * "git submodule add" was confused when the superproject did not have + its repository in its usual place in the working tree and GIT_DIR + and GIT_WORK_TREE was used to access it. + * "git mergetool" did not support --tool-help option to give the list of supported backends, like "git difftool" does. (merge 109859e jc/mergetool-tool-help later to maint). diff --git a/Documentation/revisions.txt b/Documentation/revisions.txt index 172566183..dc0070bcb 100644 --- a/Documentation/revisions.txt +++ b/Documentation/revisions.txt @@ -24,22 +24,22 @@ blobs contained in a commit. object referenced by 'refs/heads/master'. If you happen to have both 'heads/master' and 'tags/master', you can explicitly say 'heads/master' to tell git which one you mean. - When ambiguous, a '<name>' is disambiguated by taking the + When ambiguous, a '<refname>' is disambiguated by taking the first match in the following rules: - . If '$GIT_DIR/<name>' exists, that is what you mean (this is usually + . If '$GIT_DIR/<refname>' exists, that is what you mean (this is usually useful only for 'HEAD', 'FETCH_HEAD', 'ORIG_HEAD', 'MERGE_HEAD' and 'CHERRY_PICK_HEAD'); - . otherwise, 'refs/<name>' if it exists; + . otherwise, 'refs/<refname>' if it exists; . otherwise, 'refs/tags/<refname>' if it exists; - . otherwise, 'refs/heads/<name>' if it exists; + . otherwise, 'refs/heads/<refname>' if it exists; - . otherwise, 'refs/remotes/<name>' if it exists; + . otherwise, 'refs/remotes/<refname>' if it exists; - . otherwise, 'refs/remotes/<name>/HEAD' if it exists. + . otherwise, 'refs/remotes/<refname>/HEAD' if it exists. + 'HEAD' names the commit on which you based the changes in the working tree. 'FETCH_HEAD' records the branch which you fetched from a remote repository @@ -218,13 +218,44 @@ and its parent commits exist. The 'r1{caret}@' notation means all parents of 'r1'. 'r1{caret}!' includes commit 'r1' but excludes all of its parents. +To summarize: + +'<rev>':: + Include commits that are reachable from (i.e. ancestors of) + <rev>. + +'{caret}<rev>':: + Exclude commits that are reachable from (i.e. ancestors of) + <rev>. + +'<rev1>..<rev2>':: + Include commits that are reachable from <rev2> but exclude + those that are reachable from <rev1>. + +'<rev1>\...<rev2>':: + Include commits that are reachable from either <rev1> or + <rev2> but exclude those that are reachable from both. + +'<rev>{caret}@', e.g. 'HEAD{caret}@':: + A suffix '{caret}' followed by an at sign is the same as listing + all parents of '<rev>' (meaning, include anything reachable from + its parents, but not the commit itself). + +'<rev>{caret}!', e.g. 'HEAD{caret}!':: + A suffix '{caret}' followed by an exclamation mark is the same + as giving commit '<rev>' and then all its parents prefixed with + '{caret}' to exclude them (and their ancestors). + Here are a handful of examples: D G H D D F G H I J D F ^G D H D ^D B E I J F B + B..C C B...C G H D E B C ^D B C E I J F B C + C I J F C C^@ I J F + C^! C F^! D G H D F @@ -2090,6 +2090,13 @@ $(SCRIPT_LIB) : % : %.sh GIT-SCRIPT-DEFINES ifndef NO_PERL $(patsubst %.perl,%,$(SCRIPT_PERL)): perl/perl.mak +perl/perl.mak: perl/PM.stamp + +perl/PM.stamp: FORCE + $(QUIET_GEN)find perl -type f -name '*.pm' | sort >$@+ && \ + { cmp $@+ $@ >/dev/null 2>/dev/null || mv $@+ $@; } && \ + $(RM) $@+ + perl/perl.mak: GIT-CFLAGS GIT-PREFIX perl/Makefile perl/Makefile.PL $(QUIET_SUBDIR0)perl $(QUIET_SUBDIR1) PERL_PATH='$(PERL_PATH_SQ)' prefix='$(prefix_SQ)' $(@F) @@ -520,11 +520,13 @@ static void bootstrap_attr_stack(void) home_config_paths(NULL, &xdg_attributes_file, "attributes"); git_attributes_file = xdg_attributes_file; } - elem = read_attr_from_file(git_attributes_file, 1); - if (elem) { - elem->origin = NULL; - elem->prev = attr_stack; - attr_stack = elem; + if (git_attributes_file) { + elem = read_attr_from_file(git_attributes_file, 1); + if (elem) { + elem->origin = NULL; + elem->prev = attr_stack; + attr_stack = elem; + } } if (!is_bare_repository() || direction == GIT_ATTR_INDEX) { diff --git a/builtin/checkout.c b/builtin/checkout.c index 6acca75f4..d812219b3 100644 --- a/builtin/checkout.c +++ b/builtin/checkout.c @@ -606,7 +606,7 @@ static int add_pending_uninteresting_ref(const char *refname, const unsigned char *sha1, int flags, void *cb_data) { - add_pending_sha1(cb_data, refname, sha1, flags | UNINTERESTING); + add_pending_sha1(cb_data, refname, sha1, UNINTERESTING); return 0; } @@ -1313,7 +1313,7 @@ void setup_standard_excludes(struct dir_struct *dir) } if (!access(path, R_OK)) add_excludes_from_file(dir, path); - if (!access(excludes_file, R_OK)) + if (excludes_file && !access(excludes_file, R_OK)) add_excludes_from_file(dir, excludes_file); } diff --git a/git-rebase--interactive.sh b/git-rebase--interactive.sh index bef7bc044..0d2056f02 100644 --- a/git-rebase--interactive.sh +++ b/git-rebase--interactive.sh @@ -493,25 +493,28 @@ do_next () { author_script_content=$(get_author_ident_from_commit HEAD) echo "$author_script_content" > "$author_script" eval "$author_script_content" - output git reset --soft HEAD^ - pick_one -n $sha1 || die_failed_squash $sha1 "$rest" + if ! pick_one -n $sha1 + then + git rev-parse --verify HEAD >"$amend" + die_failed_squash $sha1 "$rest" + fi case "$(peek_next_command)" in squash|s|fixup|f) # This is an intermediate commit; its message will only be # used in case of trouble. So use the long version: - do_with_author output git commit --no-verify -F "$squash_msg" || + do_with_author output git commit --amend --no-verify -F "$squash_msg" || die_failed_squash $sha1 "$rest" ;; *) # This is the final command of this squash/fixup group if test -f "$fixup_msg" then - do_with_author git commit --no-verify -F "$fixup_msg" || + do_with_author git commit --amend --no-verify -F "$fixup_msg" || die_failed_squash $sha1 "$rest" else cp "$squash_msg" "$GIT_DIR"/SQUASH_MSG || exit rm -f "$GIT_DIR"/MERGE_MSG - do_with_author git commit --no-verify -e || + do_with_author git commit --amend --no-verify -F "$GIT_DIR"/SQUASH_MSG -e || die_failed_squash $sha1 "$rest" fi rm -f "$squash_msg" "$fixup_msg" @@ -748,7 +751,6 @@ In both case, once you're done, continue with: fi . "$author_script" || die "Error trying to find the author identity to amend commit" - current_head= if test -f "$amend" then current_head=$(git rev-parse --verify HEAD) @@ -756,13 +758,12 @@ In both case, once you're done, continue with: die "\ You have uncommitted changes in your working tree. Please, commit them first and then run 'git rebase --continue' again." - git reset --soft HEAD^ || - die "Cannot rewind the HEAD" + do_with_author git commit --amend --no-verify -F "$msg" -e || + die "Could not commit staged changes." + else + do_with_author git commit --no-verify -F "$msg" -e || + die "Could not commit staged changes." fi - do_with_author git commit --no-verify -F "$msg" -e || { - test -n "$current_head" && git reset --soft $current_head - die "Could not commit staged changes." - } fi record_in_rewritten "$(cat "$state_dir"/stopped-sha)" diff --git a/git-svn.perl b/git-svn.perl index 6673d21f8..5711c5719 100755 --- a/git-svn.perl +++ b/git-svn.perl @@ -10,6 +10,43 @@ use vars qw/ $AUTHOR $VERSION $AUTHOR = 'Eric Wong <normalperson@yhbt.net>'; $VERSION = '@@GIT_VERSION@@'; +use Carp qw/croak/; +use Digest::MD5; +use IO::File qw//; +use File::Basename qw/dirname basename/; +use File::Path qw/mkpath/; +use File::Spec; +use File::Find; +use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/; +use IPC::Open3; +use Memoize; + +use Git::SVN; +use Git::SVN::Editor; +use Git::SVN::Fetcher; +use Git::SVN::Ra; +use Git::SVN::Prompt; +use Git::SVN::Log; +use Git::SVN::Migration; + +use Git::SVN::Utils qw(fatal can_compress); +use Git qw( + git_cmd_try + command + command_oneline + command_noisy + command_output_pipe + command_close_pipe + command_bidi_pipe + command_close_bidi_pipe +); + +BEGIN { + Memoize::memoize 'Git::config'; + Memoize::memoize 'Git::config_bool'; +} + + # From which subdir have we been invoked? my $cmd_dir_prefix = eval { command_oneline([qw/rev-parse --show-prefix/], STDERR => 0) @@ -17,10 +54,7 @@ my $cmd_dir_prefix = eval { my $git_dir_user_set = 1 if defined $ENV{GIT_DIR}; $ENV{GIT_DIR} ||= '.git'; -$Git::SVN::default_repo_id = 'svn'; -$Git::SVN::default_ref_id = $ENV{GIT_SVN_ID} || 'git-svn'; $Git::SVN::Ra::_log_window_size = 100; -$Git::SVN::_minimize_url = 'unset'; if (! exists $ENV{SVN_SSH} && exists $ENV{GIT_SSH}) { $ENV{SVN_SSH} = $ENV{GIT_SSH}; @@ -35,8 +69,6 @@ $Git::SVN::Log::TZ = $ENV{TZ}; $ENV{TZ} = 'UTC'; $| = 1; # unbuffer STDOUT -sub fatal (@) { print STDERR "@_\n"; exit 1 } - # All SVN commands do it. Otherwise we may die on SIGPIPE when the remote # repository decides to close the connection which we expect to be kept alive. $SIG{PIPE} = 'IGNORE'; @@ -66,39 +98,6 @@ sub _req_svn { fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)"; } } -my $can_compress = eval { require Compress::Zlib; 1}; -use Carp qw/croak/; -use Digest::MD5; -use IO::File qw//; -use File::Basename qw/dirname basename/; -use File::Path qw/mkpath/; -use File::Spec; -use File::Find; -use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev/; -use IPC::Open3; -use Git; -use Git::SVN::Editor qw//; -use Git::SVN::Fetcher qw//; -use Git::SVN::Ra qw//; -use Git::SVN::Prompt qw//; -use Memoize; # core since 5.8.0, Jul 2002 - -BEGIN { - # import functions from Git into our packages, en masse - no strict 'refs'; - foreach (qw/command command_oneline command_noisy command_output_pipe - command_input_pipe command_close_pipe - command_bidi_pipe command_close_bidi_pipe/) { - for my $package ( qw(Git::SVN::Migration Git::SVN::Log Git::SVN), - __PACKAGE__) { - *{"${package}::$_"} = \&{"Git::$_"}; - } - } - Memoize::memoize 'Git::config'; - Memoize::memoize 'Git::config_bool'; -} - -my ($SVN); $sha1 = qr/[a-f\d]{40}/; $sha1_short = qr/[a-f\d]{4,40}/; @@ -108,8 +107,11 @@ my ($_stdin, $_help, $_edit, $_version, $_fetch_all, $_no_rebase, $_fetch_parent, $_merge, $_strategy, $_preserve_merges, $_dry_run, $_local, $_prefix, $_no_checkout, $_url, $_verbose, - $_git_format, $_commit_url, $_tag, $_merge_info, $_interactive); -$Git::SVN::_follow_parent = 1; + $_commit_url, $_tag, $_merge_info, $_interactive); + +# This is a refactoring artifact so Git::SVN can get at this git-svn switch. +sub opt_prefix { return $_prefix || '' } + $Git::SVN::Fetcher::_placeholder_filename = ".gitignore"; $_q ||= 0; my %remote_opts = ( 'username=s' => \$Git::SVN::Prompt::_username, @@ -269,7 +271,7 @@ my %cmd = ( { 'url' => \$_url, } ], 'blame' => [ \&Git::SVN::Log::cmd_blame, "Show what revision and author last modified each line of a file", - { 'git-format' => \$_git_format } ], + { 'git-format' => \$Git::SVN::Log::_git_format } ], 'reset' => [ \&cmd_reset, "Undo fetches back to the specified SVN revision", { 'revision|r=s' => \$_revision, @@ -1578,7 +1580,7 @@ sub cmd_reset { } sub cmd_gc { - if (!$can_compress) { + if (!can_compress()) { warn "Compress::Zlib could not be found; unhandled.log " . "files will not be compressed.\n"; } @@ -2013,13 +2015,13 @@ sub md5sum { } elsif (!$ref) { $md5->add($arg) or croak $!; } else { - ::fatal "Can't provide MD5 hash for unknown ref type: '", $ref, "'"; + fatal "Can't provide MD5 hash for unknown ref type: '", $ref, "'"; } return $md5->hexdigest(); } sub gc_directory { - if ($can_compress && -f $_ && basename($_) eq "unhandled.log") { + if (can_compress() && -f $_ && basename($_) eq "unhandled.log") { my $out_filename = $_ . ".gz"; open my $in_fh, "<", $_ or die "Unable to open $_: $!\n"; binmode $in_fh; @@ -2037,3035 +2039,6 @@ sub gc_directory { } } -package Git::SVN; -use strict; -use warnings; -use Fcntl qw/:DEFAULT :seek/; -use constant rev_map_fmt => 'NH40'; -use vars qw/$default_repo_id $default_ref_id $_no_metadata $_follow_parent - $_repack $_repack_flags $_use_svm_props $_head - $_use_svnsync_props $no_reuse_existing $_minimize_url - $_use_log_author $_add_author_from $_localtime/; -use Carp qw/croak/; -use File::Path qw/mkpath/; -use File::Copy qw/copy/; -use IPC::Open3; -use Time::Local; -use Memoize; # core since 5.8.0, Jul 2002 -use Memoize::Storable; -use POSIX qw(:signal_h); -my $can_use_yaml; -BEGIN { - $can_use_yaml = eval { require Git::SVN::Memoize::YAML; 1}; -} - -my ($_gc_nr, $_gc_period); - -# properties that we do not log: -my %SKIP_PROP; -BEGIN { - %SKIP_PROP = map { $_ => 1 } qw/svn:wc:ra_dav:version-url - svn:special svn:executable - svn:entry:committed-rev - svn:entry:last-author - svn:entry:uuid - svn:entry:committed-date/; - - # some options are read globally, but can be overridden locally - # per [svn-remote "..."] section. Command-line options will *NOT* - # override options set in an [svn-remote "..."] section - no strict 'refs'; - for my $option (qw/follow_parent no_metadata use_svm_props - use_svnsync_props/) { - my $key = $option; - $key =~ tr/_//d; - my $prop = "-$option"; - *$option = sub { - my ($self) = @_; - return $self->{$prop} if exists $self->{$prop}; - my $k = "svn-remote.$self->{repo_id}.$key"; - eval { command_oneline(qw/config --get/, $k) }; - if ($@) { - $self->{$prop} = ${"Git::SVN::_$option"}; - } else { - my $v = command_oneline(qw/config --bool/,$k); - $self->{$prop} = $v eq 'false' ? 0 : 1; - } - return $self->{$prop}; - } - } -} - - -my (%LOCKFILES, %INDEX_FILES); -END { - unlink keys %LOCKFILES if %LOCKFILES; - unlink keys %INDEX_FILES if %INDEX_FILES; -} - -sub resolve_local_globs { - my ($url, $fetch, $glob_spec) = @_; - return unless defined $glob_spec; - my $ref = $glob_spec->{ref}; - my $path = $glob_spec->{path}; - foreach (command(qw#for-each-ref --format=%(refname) refs/#)) { - next unless m#^$ref->{regex}$#; - my $p = $1; - my $pathname = desanitize_refname($path->full_path($p)); - my $refname = desanitize_refname($ref->full_path($p)); - if (my $existing = $fetch->{$pathname}) { - if ($existing ne $refname) { - die "Refspec conflict:\n", - "existing: $existing\n", - " globbed: $refname\n"; - } - my $u = (::cmt_metadata("$refname"))[0]; - $u =~ s!^\Q$url\E(/|$)!! or die - "$refname: '$url' not found in '$u'\n"; - if ($pathname ne $u) { - warn "W: Refspec glob conflict ", - "(ref: $refname):\n", - "expected path: $pathname\n", - " real path: $u\n", - "Continuing ahead with $u\n"; - next; - } - } else { - $fetch->{$pathname} = $refname; - } - } -} - -sub parse_revision_argument { - my ($base, $head) = @_; - if (!defined $::_revision || $::_revision eq 'BASE:HEAD') { - return ($base, $head); - } - return ($1, $2) if ($::_revision =~ /^(\d+):(\d+)$/); - return ($::_revision, $::_revision) if ($::_revision =~ /^\d+$/); - return ($head, $head) if ($::_revision eq 'HEAD'); - return ($base, $1) if ($::_revision =~ /^BASE:(\d+)$/); - return ($1, $head) if ($::_revision =~ /^(\d+):HEAD$/); - die "revision argument: $::_revision not understood by git-svn\n"; -} - -sub fetch_all { - my ($repo_id, $remotes) = @_; - if (ref $repo_id) { - my $gs = $repo_id; - $repo_id = undef; - $repo_id = $gs->{repo_id}; - } - $remotes ||= read_all_remotes(); - my $remote = $remotes->{$repo_id} or - die "[svn-remote \"$repo_id\"] unknown\n"; - my $fetch = $remote->{fetch}; - my $url = $remote->{url} or die "svn-remote.$repo_id.url not defined\n"; - my (@gs, @globs); - my $ra = Git::SVN::Ra->new($url); - my $uuid = $ra->get_uuid; - my $head = $ra->get_latest_revnum; - - # ignore errors, $head revision may not even exist anymore - eval { $ra->get_log("", $head, 0, 1, 0, 1, sub { $head = $_[1] }) }; - warn "W: $@\n" if $@; - - my $base = defined $fetch ? $head : 0; - - # read the max revs for wildcard expansion (branches/*, tags/*) - foreach my $t (qw/branches tags/) { - defined $remote->{$t} or next; - push @globs, @{$remote->{$t}}; - - my $max_rev = eval { tmp_config(qw/--int --get/, - "svn-remote.$repo_id.${t}-maxRev") }; - if (defined $max_rev && ($max_rev < $base)) { - $base = $max_rev; - } elsif (!defined $max_rev) { - $base = 0; - } - } - - if ($fetch) { - foreach my $p (sort keys %$fetch) { - my $gs = Git::SVN->new($fetch->{$p}, $repo_id, $p); - my $lr = $gs->rev_map_max; - if (defined $lr) { - $base = $lr if ($lr < $base); - } - push @gs, $gs; - } - } - - ($base, $head) = parse_revision_argument($base, $head); - $ra->gs_fetch_loop_common($base, $head, \@gs, \@globs); -} - -sub read_all_remotes { - my $r = {}; - my $use_svm_props = eval { command_oneline(qw/config --bool - svn.useSvmProps/) }; - $use_svm_props = $use_svm_props eq 'true' if $use_svm_props; - my $svn_refspec = qr{\s*(.*?)\s*:\s*(.+?)\s*}; - foreach (grep { s/^svn-remote\.// } command(qw/config -l/)) { - if (m!^(.+)\.fetch=$svn_refspec$!) { - my ($remote, $local_ref, $remote_ref) = ($1, $2, $3); - die("svn-remote.$remote: remote ref '$remote_ref' " - . "must start with 'refs/'\n") - unless $remote_ref =~ m{^refs/}; - $local_ref = uri_decode($local_ref); - $r->{$remote}->{fetch}->{$local_ref} = $remote_ref; - $r->{$remote}->{svm} = {} if $use_svm_props; - } elsif (m!^(.+)\.usesvmprops=\s*(.*)\s*$!) { - $r->{$1}->{svm} = {}; - } elsif (m!^(.+)\.url=\s*(.*)\s*$!) { - $r->{$1}->{url} = $2; - } elsif (m!^(.+)\.pushurl=\s*(.*)\s*$!) { - $r->{$1}->{pushurl} = $2; - } elsif (m!^(.+)\.ignore-refs=\s*(.*)\s*$!) { - $r->{$1}->{ignore_refs_regex} = $2; - } elsif (m!^(.+)\.(branches|tags)=$svn_refspec$!) { - my ($remote, $t, $local_ref, $remote_ref) = - ($1, $2, $3, $4); - die("svn-remote.$remote: remote ref '$remote_ref' ($t) " - . "must start with 'refs/'\n") - unless $remote_ref =~ m{^refs/}; - $local_ref = uri_decode($local_ref); - my $rs = { - t => $t, - remote => $remote, - path => Git::SVN::GlobSpec->new($local_ref, 1), - ref => Git::SVN::GlobSpec->new($remote_ref, 0) }; - if (length($rs->{ref}->{right}) != 0) { - die "The '*' glob character must be the last ", - "character of '$remote_ref'\n"; - } - push @{ $r->{$remote}->{$t} }, $rs; - } - } - - map { - if (defined $r->{$_}->{svm}) { - my $svm; - eval { - my $section = "svn-remote.$_"; - $svm = { - source => tmp_config('--get', - "$section.svm-source"), - replace => tmp_config('--get', - "$section.svm-replace"), - } - }; - $r->{$_}->{svm} = $svm; - } - } keys %$r; - - foreach my $remote (keys %$r) { - foreach ( grep { defined $_ } - map { $r->{$remote}->{$_} } qw(branches tags) ) { - foreach my $rs ( @$_ ) { - $rs->{ignore_refs_regex} = - $r->{$remote}->{ignore_refs_regex}; - } - } - } - - $r; -} - -sub init_vars { - $_gc_nr = $_gc_period = 1000; - if (defined $_repack || defined $_repack_flags) { - warn "Repack options are obsolete; they have no effect.\n"; - } -} - -sub verify_remotes_sanity { - return unless -d $ENV{GIT_DIR}; - my %seen; - foreach (command(qw/config -l/)) { - if (m!^svn-remote\.(?:.+)\.fetch=.*:refs/remotes/(\S+)\s*$!) { - if ($seen{$1}) { - die "Remote ref refs/remote/$1 is tracked by", - "\n \"$_\"\nand\n \"$seen{$1}\"\n", - "Please resolve this ambiguity in ", - "your git configuration file before ", - "continuing\n"; - } - $seen{$1} = $_; - } - } -} - -sub find_existing_remote { - my ($url, $remotes) = @_; - return undef if $no_reuse_existing; - my $existing; - foreach my $repo_id (keys %$remotes) { - my $u = $remotes->{$repo_id}->{url} or next; - next if $u ne $url; - $existing = $repo_id; - last; - } - $existing; -} - -sub init_remote_config { - my ($self, $url, $no_write) = @_; - $url =~ s!/+$!!; # strip trailing slash - my $r = read_all_remotes(); - my $existing = find_existing_remote($url, $r); - if ($existing) { - unless ($no_write) { - print STDERR "Using existing ", - "[svn-remote \"$existing\"]\n"; - } - $self->{repo_id} = $existing; - } elsif ($_minimize_url) { - my $min_url = Git::SVN::Ra->new($url)->minimize_url; - $existing = find_existing_remote($min_url, $r); - if ($existing) { - unless ($no_write) { - print STDERR "Using existing ", - "[svn-remote \"$existing\"]\n"; - } - $self->{repo_id} = $existing; - } - if ($min_url ne $url) { - unless ($no_write) { - print STDERR "Using higher level of URL: ", - "$url => $min_url\n"; - } - my $old_path = $self->{path}; - $self->{path} = $url; - $self->{path} =~ s!^\Q$min_url\E(/|$)!!; - if (length $old_path) { - $self->{path} .= "/$old_path"; - } - $url = $min_url; - } - } - my $orig_url; - if (!$existing) { - # verify that we aren't overwriting anything: - $orig_url = eval { - command_oneline('config', '--get', - "svn-remote.$self->{repo_id}.url") - }; - if ($orig_url && ($orig_url ne $url)) { - die "svn-remote.$self->{repo_id}.url already set: ", - "$orig_url\nwanted to set to: $url\n"; - } - } - my ($xrepo_id, $xpath) = find_ref($self->refname); - if (!$no_write && defined $xpath) { - die "svn-remote.$xrepo_id.fetch already set to track ", - "$xpath:", $self->refname, "\n"; - } - unless ($no_write) { - command_noisy('config', - "svn-remote.$self->{repo_id}.url", $url); - $self->{path} =~ s{^/}{}; - $self->{path} =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg; - command_noisy('config', '--add', - "svn-remote.$self->{repo_id}.fetch", - "$self->{path}:".$self->refname); - } - $self->{url} = $url; -} - -sub find_by_url { # repos_root and, path are optional - my ($class, $full_url, $repos_root, $path) = @_; - - return undef unless defined $full_url; - remove_username($full_url); - remove_username($repos_root) if defined $repos_root; - my $remotes = read_all_remotes(); - if (defined $full_url && defined $repos_root && !defined $path) { - $path = $full_url; - $path =~ s#^\Q$repos_root\E(?:/|$)##; - } - foreach my $repo_id (keys %$remotes) { - my $u = $remotes->{$repo_id}->{url} or next; - remove_username($u); - next if defined $repos_root && $repos_root ne $u; - - my $fetch = $remotes->{$repo_id}->{fetch} || {}; - foreach my $t (qw/branches tags/) { - foreach my $globspec (@{$remotes->{$repo_id}->{$t}}) { - resolve_local_globs($u, $fetch, $globspec); - } - } - my $p = $path; - my $rwr = rewrite_root({repo_id => $repo_id}); - my $svm = $remotes->{$repo_id}->{svm} - if defined $remotes->{$repo_id}->{svm}; - unless (defined $p) { - $p = $full_url; - my $z = $u; - my $prefix = ''; - if ($rwr) { - $z = $rwr; - remove_username($z); - } elsif (defined $svm) { - $z = $svm->{source}; - $prefix = $svm->{replace}; - $prefix =~ s#^\Q$u\E(?:/|$)##; - $prefix =~ s#/$##; - } - $p =~ s#^\Q$z\E(?:/|$)#$prefix# or next; - } - foreach my $f (keys %$fetch) { - next if $f ne $p; - return Git::SVN->new($fetch->{$f}, $repo_id, $f); - } - } - undef; -} - -sub init { - my ($class, $url, $path, $repo_id, $ref_id, $no_write) = @_; - my $self = _new($class, $repo_id, $ref_id, $path); - if (defined $url) { - $self->init_remote_config($url, $no_write); - } - $self; -} - -sub find_ref { - my ($ref_id) = @_; - foreach (command(qw/config -l/)) { - next unless m!^svn-remote\.(.+)\.fetch= - \s*(.*?)\s*:\s*(.+?)\s*$!x; - my ($repo_id, $path, $ref) = ($1, $2, $3); - if ($ref eq $ref_id) { - $path = '' if ($path =~ m#^\./?#); - return ($repo_id, $path); - } - } - (undef, undef, undef); -} - -sub new { - my ($class, $ref_id, $repo_id, $path) = @_; - if (defined $ref_id && !defined $repo_id && !defined $path) { - ($repo_id, $path) = find_ref($ref_id); - if (!defined $repo_id) { - die "Could not find a \"svn-remote.*.fetch\" key ", - "in the repository configuration matching: ", - "$ref_id\n"; - } - } - my $self = _new($class, $repo_id, $ref_id, $path); - if (!defined $self->{path} || !length $self->{path}) { - my $fetch = command_oneline('config', '--get', - "svn-remote.$repo_id.fetch", - ":$ref_id\$") or - die "Failed to read \"svn-remote.$repo_id.fetch\" ", - "\":$ref_id\$\" in config\n"; - ($self->{path}, undef) = split(/\s*:\s*/, $fetch); - } - $self->{path} =~ s{/+}{/}g; - $self->{path} =~ s{\A/}{}; - $self->{path} =~ s{/\z}{}; - $self->{url} = command_oneline('config', '--get', - "svn-remote.$repo_id.url") or - die "Failed to read \"svn-remote.$repo_id.url\" in config\n"; - $self->{pushurl} = eval { command_oneline('config', '--get', - "svn-remote.$repo_id.pushurl") }; - $self->rebuild; - $self; -} - -sub refname { - my ($refname) = $_[0]->{ref_id} ; - - # It cannot end with a slash /, we'll throw up on this because - # SVN can't have directories with a slash in their name, either: - if ($refname =~ m{/$}) { - die "ref: '$refname' ends with a trailing slash, this is ", - "not permitted by git nor Subversion\n"; - } - - # It cannot have ASCII control character space, tilde ~, caret ^, - # colon :, question-mark ?, asterisk *, space, or open bracket [ - # anywhere. - # - # Additionally, % must be escaped because it is used for escaping - # and we want our escaped refname to be reversible - $refname =~ s{([ \%~\^:\?\*\[\t])}{uc sprintf('%%%02x',ord($1))}eg; - - # no slash-separated component can begin with a dot . - # /.* becomes /%2E* - $refname =~ s{/\.}{/%2E}g; - - # It cannot have two consecutive dots .. anywhere - # .. becomes %2E%2E - $refname =~ s{\.\.}{%2E%2E}g; - - # trailing dots and .lock are not allowed - # .$ becomes %2E and .lock becomes %2Elock - $refname =~ s{\.(?=$|lock$)}{%2E}; - - # the sequence @{ is used to access the reflog - # @{ becomes %40{ - $refname =~ s{\@\{}{%40\{}g; - - return $refname; -} - -sub desanitize_refname { - my ($refname) = @_; - $refname =~ s{%(?:([0-9A-F]{2}))}{chr hex($1)}eg; - return $refname; -} - -sub svm_uuid { - my ($self) = @_; - return $self->{svm}->{uuid} if $self->svm; - $self->ra; - unless ($self->{svm}) { - die "SVM UUID not cached, and reading remotely failed\n"; - } - $self->{svm}->{uuid}; -} - -sub svm { - my ($self) = @_; - return $self->{svm} if $self->{svm}; - my $svm; - # see if we have it in our config, first: - eval { - my $section = "svn-remote.$self->{repo_id}"; - $svm = { - source => tmp_config('--get', "$section.svm-source"), - uuid => tmp_config('--get', "$section.svm-uuid"), - replace => tmp_config('--get', "$section.svm-replace"), - } - }; - if ($svm && $svm->{source} && $svm->{uuid} && $svm->{replace}) { - $self->{svm} = $svm; - } - $self->{svm}; -} - -sub _set_svm_vars { - my ($self, $ra) = @_; - return $ra if $self->svm; - - my @err = ( "useSvmProps set, but failed to read SVM properties\n", - "(svm:source, svm:uuid) ", - "from the following URLs:\n" ); - sub read_svm_props { - my ($self, $ra, $path, $r) = @_; - my $props = ($ra->get_dir($path, $r))[2]; - my $src = $props->{'svm:source'}; - my $uuid = $props->{'svm:uuid'}; - return undef if (!$src || !$uuid); - - chomp($src, $uuid); - - $uuid =~ m{^[0-9a-f\-]{30,}$}i - or die "doesn't look right - svm:uuid is '$uuid'\n"; - - # the '!' is used to mark the repos_root!/relative/path - $src =~ s{/?!/?}{/}; - $src =~ s{/+$}{}; # no trailing slashes please - # username is of no interest - $src =~ s{(^[a-z\+]*://)[^/@]*@}{$1}; - - my $replace = $ra->{url}; - $replace .= "/$path" if length $path; - - my $section = "svn-remote.$self->{repo_id}"; - tmp_config("$section.svm-source", $src); - tmp_config("$section.svm-replace", $replace); - tmp_config("$section.svm-uuid", $uuid); - $self->{svm} = { - source => $src, - uuid => $uuid, - replace => $replace - }; - } - - my $r = $ra->get_latest_revnum; - my $path = $self->{path}; - my %tried; - while (length $path) { - unless ($tried{"$self->{url}/$path"}) { - return $ra if $self->read_svm_props($ra, $path, $r); - $tried{"$self->{url}/$path"} = 1; - } - $path =~ s#/?[^/]+$##; - } - die "Path: '$path' should be ''\n" if $path ne ''; - return $ra if $self->read_svm_props($ra, $path, $r); - $tried{"$self->{url}/$path"} = 1; - - if ($ra->{repos_root} eq $self->{url}) { - die @err, (map { " $_\n" } keys %tried), "\n"; - } - - # nope, make sure we're connected to the repository root: - my $ok; - my @tried_b; - $path = $ra->{svn_path}; - $ra = Git::SVN::Ra->new($ra->{repos_root}); - while (length $path) { - unless ($tried{"$ra->{url}/$path"}) { - $ok = $self->read_svm_props($ra, $path, $r); - last if $ok; - $tried{"$ra->{url}/$path"} = 1; - } - $path =~ s#/?[^/]+$##; - } - die "Path: '$path' should be ''\n" if $path ne ''; - $ok ||= $self->read_svm_props($ra, $path, $r); - $tried{"$ra->{url}/$path"} = 1; - if (!$ok) { - die @err, (map { " $_\n" } keys %tried), "\n"; - } - Git::SVN::Ra->new($self->{url}); -} - -sub svnsync { - my ($self) = @_; - return $self->{svnsync} if $self->{svnsync}; - - if ($self->no_metadata) { - die "Can't have both 'noMetadata' and ", - "'useSvnsyncProps' options set!\n"; - } - if ($self->rewrite_root) { - die "Can't have both 'useSvnsyncProps' and 'rewriteRoot' ", - "options set!\n"; - } - if ($self->rewrite_uuid) { - die "Can't have both 'useSvnsyncProps' and 'rewriteUUID' ", - "options set!\n"; - } - - my $svnsync; - # see if we have it in our config, first: - eval { - my $section = "svn-remote.$self->{repo_id}"; - - my $url = tmp_config('--get', "$section.svnsync-url"); - ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or - die "doesn't look right - svn:sync-from-url is '$url'\n"; - - my $uuid = tmp_config('--get', "$section.svnsync-uuid"); - ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or - die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; - - $svnsync = { url => $url, uuid => $uuid } - }; - if ($svnsync && $svnsync->{url} && $svnsync->{uuid}) { - return $self->{svnsync} = $svnsync; - } - - my $err = "useSvnsyncProps set, but failed to read " . - "svnsync property: svn:sync-from-"; - my $rp = $self->ra->rev_proplist(0); - - my $url = $rp->{'svn:sync-from-url'} or die $err . "url\n"; - ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or - die "doesn't look right - svn:sync-from-url is '$url'\n"; - - my $uuid = $rp->{'svn:sync-from-uuid'} or die $err . "uuid\n"; - ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or - die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; - - my $section = "svn-remote.$self->{repo_id}"; - tmp_config('--add', "$section.svnsync-uuid", $uuid); - tmp_config('--add', "$section.svnsync-url", $url); - return $self->{svnsync} = { url => $url, uuid => $uuid }; -} - -# this allows us to memoize our SVN::Ra UUID locally and avoid a -# remote lookup (useful for 'git svn log'). -sub ra_uuid { - my ($self) = @_; - unless ($self->{ra_uuid}) { - my $key = "svn-remote.$self->{repo_id}.uuid"; - my $uuid = eval { tmp_config('--get', $key) }; - if (!$@ && $uuid && $uuid =~ /^([a-f\d\-]{30,})$/i) { - $self->{ra_uuid} = $uuid; - } else { - die "ra_uuid called without URL\n" unless $self->{url}; - $self->{ra_uuid} = $self->ra->get_uuid; - tmp_config('--add', $key, $self->{ra_uuid}); - } - } - $self->{ra_uuid}; -} - -sub _set_repos_root { - my ($self, $repos_root) = @_; - my $k = "svn-remote.$self->{repo_id}.reposRoot"; - $repos_root ||= $self->ra->{repos_root}; - tmp_config($k, $repos_root); - $repos_root; -} - -sub repos_root { - my ($self) = @_; - my $k = "svn-remote.$self->{repo_id}.reposRoot"; - eval { tmp_config('--get', $k) } || $self->_set_repos_root; -} - -sub ra { - my ($self) = shift; - my $ra = Git::SVN::Ra->new($self->{url}); - $self->_set_repos_root($ra->{repos_root}); - if ($self->use_svm_props && !$self->{svm}) { - if ($self->no_metadata) { - die "Can't have both 'noMetadata' and ", - "'useSvmProps' options set!\n"; - } elsif ($self->use_svnsync_props) { - die "Can't have both 'useSvnsyncProps' and ", - "'useSvmProps' options set!\n"; - } - $ra = $self->_set_svm_vars($ra); - $self->{-want_revprops} = 1; - } - $ra; -} - -# prop_walk(PATH, REV, SUB) -# ------------------------- -# Recursively traverse PATH at revision REV and invoke SUB for each -# directory that contains a SVN property. SUB will be invoked as -# follows: &SUB(gs, path, props); where `gs' is this instance of -# Git::SVN, `path' the path to the directory where the properties -# `props' were found. The `path' will be relative to point of checkout, -# that is, if url://repo/trunk is the current Git branch, and that -# directory contains a sub-directory `d', SUB will be invoked with `/d/' -# as `path' (note the trailing `/'). -sub prop_walk { - my ($self, $path, $rev, $sub) = @_; - - $path =~ s#^/##; - my ($dirent, undef, $props) = $self->ra->get_dir($path, $rev); - $path =~ s#^/*#/#g; - my $p = $path; - # Strip the irrelevant part of the path. - $p =~ s#^/+\Q$self->{path}\E(/|$)#/#; - # Ensure the path is terminated by a `/'. - $p =~ s#/*$#/#; - - # The properties contain all the internal SVN stuff nobody - # (usually) cares about. - my $interesting_props = 0; - foreach (keys %{$props}) { - # If it doesn't start with `svn:', it must be a - # user-defined property. - ++$interesting_props and next if $_ !~ /^svn:/; - # FIXME: Fragile, if SVN adds new public properties, - # this needs to be updated. - ++$interesting_props if /^svn:(?:ignore|keywords|executable - |eol-style|mime-type - |externals|needs-lock)$/x; - } - &$sub($self, $p, $props) if $interesting_props; - - foreach (sort keys %$dirent) { - next if $dirent->{$_}->{kind} != $SVN::Node::dir; - $self->prop_walk($self->{path} . $p . $_, $rev, $sub); - } -} - -sub last_rev { ($_[0]->last_rev_commit)[0] } -sub last_commit { ($_[0]->last_rev_commit)[1] } - -# returns the newest SVN revision number and newest commit SHA1 -sub last_rev_commit { - my ($self) = @_; - if (defined $self->{last_rev} && defined $self->{last_commit}) { - return ($self->{last_rev}, $self->{last_commit}); - } - my $c = ::verify_ref($self->refname.'^0'); - if ($c && !$self->use_svm_props && !$self->no_metadata) { - my $rev = (::cmt_metadata($c))[1]; - if (defined $rev) { - ($self->{last_rev}, $self->{last_commit}) = ($rev, $c); - return ($rev, $c); - } - } - my $map_path = $self->map_path; - unless (-e $map_path) { - ($self->{last_rev}, $self->{last_commit}) = (undef, undef); - return (undef, undef); - } - my ($rev, $commit) = $self->rev_map_max(1); - ($self->{last_rev}, $self->{last_commit}) = ($rev, $commit); - return ($rev, $commit); -} - -sub get_fetch_range { - my ($self, $min, $max) = @_; - $max ||= $self->ra->get_latest_revnum; - $min ||= $self->rev_map_max; - (++$min, $max); -} - -sub tmp_config { - my (@args) = @_; - my $old_def_config = "$ENV{GIT_DIR}/svn/config"; - my $config = "$ENV{GIT_DIR}/svn/.metadata"; - if (! -f $config && -f $old_def_config) { - rename $old_def_config, $config or - die "Failed rename $old_def_config => $config: $!\n"; - } - my $old_config = $ENV{GIT_CONFIG}; - $ENV{GIT_CONFIG} = $config; - $@ = undef; - my @ret = eval { - unless (-f $config) { - mkfile($config); - open my $fh, '>', $config or - die "Can't open $config: $!\n"; - print $fh "; This file is used internally by ", - "git-svn\n" or die - "Couldn't write to $config: $!\n"; - print $fh "; You should not have to edit it\n" or - die "Couldn't write to $config: $!\n"; - close $fh or die "Couldn't close $config: $!\n"; - } - command('config', @args); - }; - my $err = $@; - if (defined $old_config) { - $ENV{GIT_CONFIG} = $old_config; - } else { - delete $ENV{GIT_CONFIG}; - } - die $err if $err; - wantarray ? @ret : $ret[0]; -} - -sub tmp_index_do { - my ($self, $sub) = @_; - my $old_index = $ENV{GIT_INDEX_FILE}; - $ENV{GIT_INDEX_FILE} = $self->{index}; - $@ = undef; - my @ret = eval { - my ($dir, $base) = ($self->{index} =~ m#^(.*?)/?([^/]+)$#); - mkpath([$dir]) unless -d $dir; - &$sub; - }; - my $err = $@; - if (defined $old_index) { - $ENV{GIT_INDEX_FILE} = $old_index; - } else { - delete $ENV{GIT_INDEX_FILE}; - } - die $err if $err; - wantarray ? @ret : $ret[0]; -} - -sub assert_index_clean { - my ($self, $treeish) = @_; - - $self->tmp_index_do(sub { - command_noisy('read-tree', $treeish) unless -e $self->{index}; - my $x = command_oneline('write-tree'); - my ($y) = (command(qw/cat-file commit/, $treeish) =~ - /^tree ($::sha1)/mo); - return if $y eq $x; - - warn "Index mismatch: $y != $x\nrereading $treeish\n"; - unlink $self->{index} or die "unlink $self->{index}: $!\n"; - command_noisy('read-tree', $treeish); - $x = command_oneline('write-tree'); - if ($y ne $x) { - ::fatal "trees ($treeish) $y != $x\n", - "Something is seriously wrong..."; - } - }); -} - -sub get_commit_parents { - my ($self, $log_entry) = @_; - my (%seen, @ret, @tmp); - # legacy support for 'set-tree'; this is only used by set_tree_cb: - if (my $ip = $self->{inject_parents}) { - if (my $commit = delete $ip->{$log_entry->{revision}}) { - push @tmp, $commit; - } - } - if (my $cur = ::verify_ref($self->refname.'^0')) { - push @tmp, $cur; - } - if (my $ipd = $self->{inject_parents_dcommit}) { - if (my $commit = delete $ipd->{$log_entry->{revision}}) { - push @tmp, @$commit; - } - } - push @tmp, $_ foreach (@{$log_entry->{parents}}, @tmp); - while (my $p = shift @tmp) { - next if $seen{$p}; - $seen{$p} = 1; - push @ret, $p; - } - @ret; -} - -sub rewrite_root { - my ($self) = @_; - return $self->{-rewrite_root} if exists $self->{-rewrite_root}; - my $k = "svn-remote.$self->{repo_id}.rewriteRoot"; - my $rwr = eval { command_oneline(qw/config --get/, $k) }; - if ($rwr) { - $rwr =~ s#/+$##; - if ($rwr !~ m#^[a-z\+]+://#) { - die "$rwr is not a valid URL (key: $k)\n"; - } - } - $self->{-rewrite_root} = $rwr; -} - -sub rewrite_uuid { - my ($self) = @_; - return $self->{-rewrite_uuid} if exists $self->{-rewrite_uuid}; - my $k = "svn-remote.$self->{repo_id}.rewriteUUID"; - my $rwid = eval { command_oneline(qw/config --get/, $k) }; - if ($rwid) { - $rwid =~ s#/+$##; - if ($rwid !~ m#^[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}$#) { - die "$rwid is not a valid UUID (key: $k)\n"; - } - } - $self->{-rewrite_uuid} = $rwid; -} - -sub metadata_url { - my ($self) = @_; - ($self->rewrite_root || $self->{url}) . - (length $self->{path} ? '/' . $self->{path} : ''); -} - -sub full_url { - my ($self) = @_; - $self->{url} . (length $self->{path} ? '/' . $self->{path} : ''); -} - -sub full_pushurl { - my ($self) = @_; - if ($self->{pushurl}) { - return $self->{pushurl} . (length $self->{path} ? '/' . - $self->{path} : ''); - } else { - return $self->full_url; - } -} - -sub set_commit_header_env { - my ($log_entry) = @_; - my %env; - foreach my $ned (qw/NAME EMAIL DATE/) { - foreach my $ac (qw/AUTHOR COMMITTER/) { - $env{"GIT_${ac}_${ned}"} = $ENV{"GIT_${ac}_${ned}"}; - } - } - - $ENV{GIT_AUTHOR_NAME} = $log_entry->{name}; - $ENV{GIT_AUTHOR_EMAIL} = $log_entry->{email}; - $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_entry->{date}; - - $ENV{GIT_COMMITTER_NAME} = (defined $log_entry->{commit_name}) - ? $log_entry->{commit_name} - : $log_entry->{name}; - $ENV{GIT_COMMITTER_EMAIL} = (defined $log_entry->{commit_email}) - ? $log_entry->{commit_email} - : $log_entry->{email}; - \%env; -} - -sub restore_commit_header_env { - my ($env) = @_; - foreach my $ned (qw/NAME EMAIL DATE/) { - foreach my $ac (qw/AUTHOR COMMITTER/) { - my $k = "GIT_${ac}_${ned}"; - if (defined $env->{$k}) { - $ENV{$k} = $env->{$k}; - } else { - delete $ENV{$k}; - } - } - } -} - -sub gc { - command_noisy('gc', '--auto'); -}; - -sub do_git_commit { - my ($self, $log_entry) = @_; - my $lr = $self->last_rev; - if (defined $lr && $lr >= $log_entry->{revision}) { - die "Last fetched revision of ", $self->refname, - " was r$lr, but we are about to fetch: ", - "r$log_entry->{revision}!\n"; - } - if (my $c = $self->rev_map_get($log_entry->{revision})) { - croak "$log_entry->{revision} = $c already exists! ", - "Why are we refetching it?\n"; - } - my $old_env = set_commit_header_env($log_entry); - my $tree = $log_entry->{tree}; - if (!defined $tree) { - $tree = $self->tmp_index_do(sub { - command_oneline('write-tree') }); - } - die "Tree is not a valid sha1: $tree\n" if $tree !~ /^$::sha1$/o; - - my @exec = ('git', 'commit-tree', $tree); - foreach ($self->get_commit_parents($log_entry)) { - push @exec, '-p', $_; - } - defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec)) - or croak $!; - binmode $msg_fh; - - # we always get UTF-8 from SVN, but we may want our commits in - # a different encoding. - if (my $enc = Git::config('i18n.commitencoding')) { - require Encode; - Encode::from_to($log_entry->{log}, 'UTF-8', $enc); - } - print $msg_fh $log_entry->{log} or croak $!; - restore_commit_header_env($old_env); - unless ($self->no_metadata) { - print $msg_fh "\ngit-svn-id: $log_entry->{metadata}\n" - or croak $!; - } - $msg_fh->flush == 0 or croak $!; - close $msg_fh or croak $!; - chomp(my $commit = do { local $/; <$out_fh> }); - close $out_fh or croak $!; - waitpid $pid, 0; - croak $? if $?; - if ($commit !~ /^$::sha1$/o) { - die "Failed to commit, invalid sha1: $commit\n"; - } - - $self->rev_map_set($log_entry->{revision}, $commit, 1); - - $self->{last_rev} = $log_entry->{revision}; - $self->{last_commit} = $commit; - print "r$log_entry->{revision}" unless $::_q > 1; - if (defined $log_entry->{svm_revision}) { - print " (\@$log_entry->{svm_revision})" unless $::_q > 1; - $self->rev_map_set($log_entry->{svm_revision}, $commit, - 0, $self->svm_uuid); - } - print " = $commit ($self->{ref_id})\n" unless $::_q > 1; - if (--$_gc_nr == 0) { - $_gc_nr = $_gc_period; - gc(); - } - return $commit; -} - -sub match_paths { - my ($self, $paths, $r) = @_; - return 1 if $self->{path} eq ''; - if (my $path = $paths->{"/$self->{path}"}) { - return ($path->{action} eq 'D') ? 0 : 1; - } - $self->{path_regex} ||= qr/^\/\Q$self->{path}\E\//; - if (grep /$self->{path_regex}/, keys %$paths) { - return 1; - } - my $c = ''; - foreach (split m#/#, $self->{path}) { - $c .= "/$_"; - next unless ($paths->{$c} && - ($paths->{$c}->{action} =~ /^[AR]$/)); - if ($self->ra->check_path($self->{path}, $r) == - $SVN::Node::dir) { - return 1; - } - } - return 0; -} - -sub find_parent_branch { - my ($self, $paths, $rev) = @_; - return undef unless $self->follow_parent; - unless (defined $paths) { - my $err_handler = $SVN::Error::handler; - $SVN::Error::handler = \&Git::SVN::Ra::skip_unknown_revs; - $self->ra->get_log([$self->{path}], $rev, $rev, 0, 1, 1, - sub { $paths = $_[0] }); - $SVN::Error::handler = $err_handler; - } - return undef unless defined $paths; - - # look for a parent from another branch: - my @b_path_components = split m#/#, $self->{path}; - my @a_path_components; - my $i; - while (@b_path_components) { - $i = $paths->{'/'.join('/', @b_path_components)}; - last if $i && defined $i->{copyfrom_path}; - unshift(@a_path_components, pop(@b_path_components)); - } - return undef unless defined $i && defined $i->{copyfrom_path}; - my $branch_from = $i->{copyfrom_path}; - if (@a_path_components) { - print STDERR "branch_from: $branch_from => "; - $branch_from .= '/'.join('/', @a_path_components); - print STDERR $branch_from, "\n"; - } - my $r = $i->{copyfrom_rev}; - my $repos_root = $self->ra->{repos_root}; - my $url = $self->ra->{url}; - my $new_url = $url . $branch_from; - print STDERR "Found possible branch point: ", - "$new_url => ", $self->full_url, ", $r\n" - unless $::_q > 1; - $branch_from =~ s#^/##; - my $gs = $self->other_gs($new_url, $url, - $branch_from, $r, $self->{ref_id}); - my ($r0, $parent) = $gs->find_rev_before($r, 1); - { - my ($base, $head); - if (!defined $r0 || !defined $parent) { - ($base, $head) = parse_revision_argument(0, $r); - } else { - if ($r0 < $r) { - $gs->ra->get_log([$gs->{path}], $r0 + 1, $r, 1, - 0, 1, sub { $base = $_[1] - 1 }); - } - } - if (defined $base && $base <= $r) { - $gs->fetch($base, $r); - } - ($r0, $parent) = $gs->find_rev_before($r, 1); - } - if (defined $r0 && defined $parent) { - print STDERR "Found branch parent: ($self->{ref_id}) $parent\n" - unless $::_q > 1; - my $ed; - if ($self->ra->can_do_switch) { - $self->assert_index_clean($parent); - print STDERR "Following parent with do_switch\n" - unless $::_q > 1; - # do_switch works with svn/trunk >= r22312, but that - # is not included with SVN 1.4.3 (the latest version - # at the moment), so we can't rely on it - $self->{last_rev} = $r0; - $self->{last_commit} = $parent; - $ed = Git::SVN::Fetcher->new($self, $gs->{path}); - $gs->ra->gs_do_switch($r0, $rev, $gs, - $self->full_url, $ed) - or die "SVN connection failed somewhere...\n"; - } elsif ($self->ra->trees_match($new_url, $r0, - $self->full_url, $rev)) { - print STDERR "Trees match:\n", - " $new_url\@$r0\n", - " ${\$self->full_url}\@$rev\n", - "Following parent with no changes\n" - unless $::_q > 1; - $self->tmp_index_do(sub { - command_noisy('read-tree', $parent); - }); - $self->{last_commit} = $parent; - } else { - print STDERR "Following parent with do_update\n" - unless $::_q > 1; - $ed = Git::SVN::Fetcher->new($self); - $self->ra->gs_do_update($rev, $rev, $self, $ed) - or die "SVN connection failed somewhere...\n"; - } - print STDERR "Successfully followed parent\n" unless $::_q > 1; - return $self->make_log_entry($rev, [$parent], $ed); - } - return undef; -} - -sub do_fetch { - my ($self, $paths, $rev) = @_; - my $ed; - my ($last_rev, @parents); - if (my $lc = $self->last_commit) { - # we can have a branch that was deleted, then re-added - # under the same name but copied from another path, in - # which case we'll have multiple parents (we don't - # want to break the original ref, nor lose copypath info): - if (my $log_entry = $self->find_parent_branch($paths, $rev)) { - push @{$log_entry->{parents}}, $lc; - return $log_entry; - } - $ed = Git::SVN::Fetcher->new($self); - $last_rev = $self->{last_rev}; - $ed->{c} = $lc; - @parents = ($lc); - } else { - $last_rev = $rev; - if (my $log_entry = $self->find_parent_branch($paths, $rev)) { - return $log_entry; - } - $ed = Git::SVN::Fetcher->new($self); - } - unless ($self->ra->gs_do_update($last_rev, $rev, $self, $ed)) { - die "SVN connection failed somewhere...\n"; - } - $self->make_log_entry($rev, \@parents, $ed); -} - -sub mkemptydirs { - my ($self, $r) = @_; - - sub scan { - my ($r, $empty_dirs, $line) = @_; - if (defined $r && $line =~ /^r(\d+)$/) { - return 0 if $1 > $r; - } elsif ($line =~ /^ \+empty_dir: (.+)$/) { - $empty_dirs->{$1} = 1; - } elsif ($line =~ /^ \-empty_dir: (.+)$/) { - my @d = grep {m[^\Q$1\E(/|$)]} (keys %$empty_dirs); - delete @$empty_dirs{@d}; - } - 1; # continue - }; - - my %empty_dirs = (); - my $gz_file = "$self->{dir}/unhandled.log.gz"; - if (-f $gz_file) { - if (!$can_compress) { - warn "Compress::Zlib could not be found; ", - "empty directories in $gz_file will not be read\n"; - } else { - my $gz = Compress::Zlib::gzopen($gz_file, "rb") or - die "Unable to open $gz_file: $!\n"; - my $line; - while ($gz->gzreadline($line) > 0) { - scan($r, \%empty_dirs, $line) or last; - } - $gz->gzclose; - } - } - - if (open my $fh, '<', "$self->{dir}/unhandled.log") { - binmode $fh or croak "binmode: $!"; - while (<$fh>) { - scan($r, \%empty_dirs, $_) or last; - } - close $fh; - } - - my $strip = qr/\A\Q$self->{path}\E(?:\/|$)/; - foreach my $d (sort keys %empty_dirs) { - $d = uri_decode($d); - $d =~ s/$strip//; - next unless length($d); - next if -d $d; - if (-e $d) { - warn "$d exists but is not a directory\n"; - } else { - print "creating empty directory: $d\n"; - mkpath([$d]); - } - } -} - -sub get_untracked { - my ($self, $ed) = @_; - my @out; - my $h = $ed->{empty}; - foreach (sort keys %$h) { - my $act = $h->{$_} ? '+empty_dir' : '-empty_dir'; - push @out, " $act: " . uri_encode($_); - warn "W: $act: $_\n"; - } - foreach my $t (qw/dir_prop file_prop/) { - $h = $ed->{$t} or next; - foreach my $path (sort keys %$h) { - my $ppath = $path eq '' ? '.' : $path; - foreach my $prop (sort keys %{$h->{$path}}) { - next if $SKIP_PROP{$prop}; - my $v = $h->{$path}->{$prop}; - my $t_ppath_prop = "$t: " . - uri_encode($ppath) . ' ' . - uri_encode($prop); - if (defined $v) { - push @out, " +$t_ppath_prop " . - uri_encode($v); - } else { - push @out, " -$t_ppath_prop"; - } - } - } - } - foreach my $t (qw/absent_file absent_directory/) { - $h = $ed->{$t} or next; - foreach my $parent (sort keys %$h) { - foreach my $path (sort @{$h->{$parent}}) { - push @out, " $t: " . - uri_encode("$parent/$path"); - warn "W: $t: $parent/$path ", - "Insufficient permissions?\n"; - } - } - } - \@out; -} - -sub get_tz { - # some systmes don't handle or mishandle %z, so be creative. - my $t = shift || time; - my $gm = timelocal(gmtime($t)); - my $sign = qw( + + - )[ $t <=> $gm ]; - return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]); -} - -# parse_svn_date(DATE) -# -------------------- -# Given a date (in UTC) from Subversion, return a string in the format -# "<TZ Offset> <local date/time>" that Git will use. -# -# By default the parsed date will be in UTC; if $Git::SVN::_localtime -# is true we'll convert it to the local timezone instead. -sub parse_svn_date { - my $date = shift || return '+0000 1970-01-01 00:00:00'; - my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T - (\d\d)\:(\d\d)\:(\d\d)\.\d*Z$/x) or - croak "Unable to parse date: $date\n"; - my $parsed_date; # Set next. - - if ($Git::SVN::_localtime) { - # Translate the Subversion datetime to an epoch time. - # Begin by switching ourselves to $date's timezone, UTC. - my $old_env_TZ = $ENV{TZ}; - $ENV{TZ} = 'UTC'; - - my $epoch_in_UTC = - POSIX::strftime('%s', $S, $M, $H, $d, $m - 1, $Y - 1900); - - # Determine our local timezone (including DST) at the - # time of $epoch_in_UTC. $Git::SVN::Log::TZ stored the - # value of TZ, if any, at the time we were run. - if (defined $Git::SVN::Log::TZ) { - $ENV{TZ} = $Git::SVN::Log::TZ; - } else { - delete $ENV{TZ}; - } - - my $our_TZ = get_tz(); - - # This converts $epoch_in_UTC into our local timezone. - my ($sec, $min, $hour, $mday, $mon, $year, - $wday, $yday, $isdst) = localtime($epoch_in_UTC); - - $parsed_date = sprintf('%s %04d-%02d-%02d %02d:%02d:%02d', - $our_TZ, $year + 1900, $mon + 1, - $mday, $hour, $min, $sec); - - # Reset us to the timezone in effect when we entered - # this routine. - if (defined $old_env_TZ) { - $ENV{TZ} = $old_env_TZ; - } else { - delete $ENV{TZ}; - } - } else { - $parsed_date = "+0000 $Y-$m-$d $H:$M:$S"; - } - - return $parsed_date; -} - -sub other_gs { - my ($self, $new_url, $url, - $branch_from, $r, $old_ref_id) = @_; - my $gs = Git::SVN->find_by_url($new_url, $url, $branch_from); - unless ($gs) { - my $ref_id = $old_ref_id; - $ref_id =~ s/\@\d+-*$//; - $ref_id .= "\@$r"; - # just grow a tail if we're not unique enough :x - $ref_id .= '-' while find_ref($ref_id); - my ($u, $p, $repo_id) = ($new_url, '', $ref_id); - if ($u =~ s#^\Q$url\E(/|$)##) { - $p = $u; - $u = $url; - $repo_id = $self->{repo_id}; - } - while (1) { - # It is possible to tag two different subdirectories at - # the same revision. If the url for an existing ref - # does not match, we must either find a ref with a - # matching url or create a new ref by growing a tail. - $gs = Git::SVN->init($u, $p, $repo_id, $ref_id, 1); - my (undef, $max_commit) = $gs->rev_map_max(1); - last if (!$max_commit); - my ($url) = ::cmt_metadata($max_commit); - last if ($url eq $gs->metadata_url); - $ref_id .= '-'; - } - print STDERR "Initializing parent: $ref_id\n" unless $::_q > 1; - } - $gs -} - -sub call_authors_prog { - my ($orig_author) = @_; - $orig_author = command_oneline('rev-parse', '--sq-quote', $orig_author); - my $author = `$::_authors_prog $orig_author`; - if ($? != 0) { - die "$::_authors_prog failed with exit code $?\n" - } - if ($author =~ /^\s*(.+?)\s*<(.*)>\s*$/) { - my ($name, $email) = ($1, $2); - $email = undef if length $2 == 0; - return [$name, $email]; - } else { - die "Author: $orig_author: $::_authors_prog returned " - . "invalid author format: $author\n"; - } -} - -sub check_author { - my ($author) = @_; - if (!defined $author || length $author == 0) { - $author = '(no author)'; - } - if (!defined $::users{$author}) { - if (defined $::_authors_prog) { - $::users{$author} = call_authors_prog($author); - } elsif (defined $::_authors) { - die "Author: $author not defined in $::_authors file\n"; - } - } - $author; -} - -sub find_extra_svk_parents { - my ($self, $ed, $tickets, $parents) = @_; - # aha! svk:merge property changed... - my @tickets = split "\n", $tickets; - my @known_parents; - for my $ticket ( @tickets ) { - my ($uuid, $path, $rev) = split /:/, $ticket; - if ( $uuid eq $self->ra_uuid ) { - my $url = $self->{url}; - my $repos_root = $url; - my $branch_from = $path; - $branch_from =~ s{^/}{}; - my $gs = $self->other_gs($repos_root."/".$branch_from, - $url, - $branch_from, - $rev, - $self->{ref_id}); - if ( my $commit = $gs->rev_map_get($rev, $uuid) ) { - # wahey! we found it, but it might be - # an old one (!) - push @known_parents, [ $rev, $commit ]; - } - } - } - # Ordering matters; highest-numbered commit merge tickets - # first, as they may account for later merge ticket additions - # or changes. - @known_parents = map {$_->[1]} sort {$b->[0] <=> $a->[0]} @known_parents; - for my $parent ( @known_parents ) { - my @cmd = ('rev-list', $parent, map { "^$_" } @$parents ); - my ($msg_fh, $ctx) = command_output_pipe(@cmd); - my $new; - while ( <$msg_fh> ) { - $new=1;last; - } - command_close_pipe($msg_fh, $ctx); - if ( $new ) { - print STDERR - "Found merge parent (svk:merge ticket): $parent\n"; - push @$parents, $parent; - } - } -} - -sub lookup_svn_merge { - my $uuid = shift; - my $url = shift; - my $merge = shift; - - my ($source, $revs) = split ":", $merge; - my $path = $source; - $path =~ s{^/}{}; - my $gs = Git::SVN->find_by_url($url.$source, $url, $path); - if ( !$gs ) { - warn "Couldn't find revmap for $url$source\n"; - return; - } - my @ranges = split ",", $revs; - my ($tip, $tip_commit); - my @merged_commit_ranges; - # find the tip - for my $range ( @ranges ) { - my ($bottom, $top) = split "-", $range; - $top ||= $bottom; - my $bottom_commit = $gs->find_rev_after( $bottom, 1, $top ); - my $top_commit = $gs->find_rev_before( $top, 1, $bottom ); - - unless ($top_commit and $bottom_commit) { - warn "W:unknown path/rev in svn:mergeinfo " - ."dirprop: $source:$range\n"; - next; - } - - if (scalar(command('rev-parse', "$bottom_commit^@"))) { - push @merged_commit_ranges, - "$bottom_commit^..$top_commit"; - } else { - push @merged_commit_ranges, "$top_commit"; - } - - if ( !defined $tip or $top > $tip ) { - $tip = $top; - $tip_commit = $top_commit; - } - } - return ($tip_commit, @merged_commit_ranges); -} - -sub _rev_list { - my ($msg_fh, $ctx) = command_output_pipe( - "rev-list", @_, - ); - my @rv; - while ( <$msg_fh> ) { - chomp; - push @rv, $_; - } - command_close_pipe($msg_fh, $ctx); - @rv; -} - -sub check_cherry_pick { - my $base = shift; - my $tip = shift; - my $parents = shift; - my @ranges = @_; - my %commits = map { $_ => 1 } - _rev_list("--no-merges", $tip, "--not", $base, @$parents, "--"); - for my $range ( @ranges ) { - delete @commits{_rev_list($range, "--")}; - } - for my $commit (keys %commits) { - if (has_no_changes($commit)) { - delete $commits{$commit}; - } - } - return (keys %commits); -} - -sub has_no_changes { - my $commit = shift; - - my @revs = split / /, command_oneline( - qw(rev-list --parents -1 -m), $commit); - - # Commits with no parents, e.g. the start of a partial branch, - # have changes by definition. - return 1 if (@revs < 2); - - # Commits with multiple parents, e.g a merge, have no changes - # by definition. - return 0 if (@revs > 2); - - return (command_oneline("rev-parse", "$commit^{tree}") eq - command_oneline("rev-parse", "$commit~1^{tree}")); -} - -sub tie_for_persistent_memoization { - my $hash = shift; - my $path = shift; - - if ($can_use_yaml) { - tie %$hash => 'Git::SVN::Memoize::YAML', "$path.yaml"; - } else { - tie %$hash => 'Memoize::Storable', "$path.db", 'nstore'; - } -} - -# The GIT_DIR environment variable is not always set until after the command -# line arguments are processed, so we can't memoize in a BEGIN block. -{ - my $memoized = 0; - - sub memoize_svn_mergeinfo_functions { - return if $memoized; - $memoized = 1; - - my $cache_path = "$ENV{GIT_DIR}/svn/.caches/"; - mkpath([$cache_path]) unless -d $cache_path; - - my %lookup_svn_merge_cache; - my %check_cherry_pick_cache; - my %has_no_changes_cache; - - tie_for_persistent_memoization(\%lookup_svn_merge_cache, - "$cache_path/lookup_svn_merge"); - memoize 'lookup_svn_merge', - SCALAR_CACHE => 'FAULT', - LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache], - ; - - tie_for_persistent_memoization(\%check_cherry_pick_cache, - "$cache_path/check_cherry_pick"); - memoize 'check_cherry_pick', - SCALAR_CACHE => 'FAULT', - LIST_CACHE => ['HASH' => \%check_cherry_pick_cache], - ; - - tie_for_persistent_memoization(\%has_no_changes_cache, - "$cache_path/has_no_changes"); - memoize 'has_no_changes', - SCALAR_CACHE => ['HASH' => \%has_no_changes_cache], - LIST_CACHE => 'FAULT', - ; - } - - sub unmemoize_svn_mergeinfo_functions { - return if not $memoized; - $memoized = 0; - - Memoize::unmemoize 'lookup_svn_merge'; - Memoize::unmemoize 'check_cherry_pick'; - Memoize::unmemoize 'has_no_changes'; - } - - Memoize::memoize 'Git::SVN::repos_root'; -} - -END { - # Force cache writeout explicitly instead of waiting for - # global destruction to avoid segfault in Storable: - # http://rt.cpan.org/Public/Bug/Display.html?id=36087 - unmemoize_svn_mergeinfo_functions(); -} - -sub parents_exclude { - my $parents = shift; - my @commits = @_; - return unless @commits; - - my @excluded; - my $excluded; - do { - my @cmd = ('rev-list', "-1", @commits, "--not", @$parents ); - $excluded = command_oneline(@cmd); - if ( $excluded ) { - my @new; - my $found; - for my $commit ( @commits ) { - if ( $commit eq $excluded ) { - push @excluded, $commit; - $found++; - last; - } - else { - push @new, $commit; - } - } - die "saw commit '$excluded' in rev-list output, " - ."but we didn't ask for that commit (wanted: @commits --not @$parents)" - unless $found; - @commits = @new; - } - } - while ($excluded and @commits); - - return @excluded; -} - - -# note: this function should only be called if the various dirprops -# have actually changed -sub find_extra_svn_parents { - my ($self, $ed, $mergeinfo, $parents) = @_; - # aha! svk:merge property changed... - - memoize_svn_mergeinfo_functions(); - - # We first search for merged tips which are not in our - # history. Then, we figure out which git revisions are in - # that tip, but not this revision. If all of those revisions - # are now marked as merge, we can add the tip as a parent. - my @merges = split "\n", $mergeinfo; - my @merge_tips; - my $url = $self->{url}; - my $uuid = $self->ra_uuid; - my %ranges; - for my $merge ( @merges ) { - my ($tip_commit, @ranges) = - lookup_svn_merge( $uuid, $url, $merge ); - unless (!$tip_commit or - grep { $_ eq $tip_commit } @$parents ) { - push @merge_tips, $tip_commit; - $ranges{$tip_commit} = \@ranges; - } else { - push @merge_tips, undef; - } - } - - my %excluded = map { $_ => 1 } - parents_exclude($parents, grep { defined } @merge_tips); - - # check merge tips for new parents - my @new_parents; - for my $merge_tip ( @merge_tips ) { - my $spec = shift @merges; - next unless $merge_tip and $excluded{$merge_tip}; - - my $ranges = $ranges{$merge_tip}; - - # check out 'new' tips - my $merge_base; - eval { - $merge_base = command_oneline( - "merge-base", - @$parents, $merge_tip, - ); - }; - if ($@) { - die "An error occurred during merge-base" - unless $@->isa("Git::Error::Command"); - - warn "W: Cannot find common ancestor between ". - "@$parents and $merge_tip. Ignoring merge info.\n"; - next; - } - - # double check that there are no missing non-merge commits - my (@incomplete) = check_cherry_pick( - $merge_base, $merge_tip, - $parents, - @$ranges, - ); - - if ( @incomplete ) { - warn "W:svn cherry-pick ignored ($spec) - missing " - .@incomplete." commit(s) (eg $incomplete[0])\n"; - } else { - warn - "Found merge parent (svn:mergeinfo prop): ", - $merge_tip, "\n"; - push @new_parents, $merge_tip; - } - } - - # cater for merges which merge commits from multiple branches - if ( @new_parents > 1 ) { - for ( my $i = 0; $i <= $#new_parents; $i++ ) { - for ( my $j = 0; $j <= $#new_parents; $j++ ) { - next if $i == $j; - next unless $new_parents[$i]; - next unless $new_parents[$j]; - my $revs = command_oneline( - "rev-list", "-1", - "$new_parents[$i]..$new_parents[$j]", - ); - if ( !$revs ) { - undef($new_parents[$j]); - } - } - } - } - push @$parents, grep { defined } @new_parents; -} - -sub make_log_entry { - my ($self, $rev, $parents, $ed) = @_; - my $untracked = $self->get_untracked($ed); - - my @parents = @$parents; - my $ps = $ed->{path_strip} || ""; - for my $path ( grep { m/$ps/ } %{$ed->{dir_prop}} ) { - my $props = $ed->{dir_prop}{$path}; - if ( $props->{"svk:merge"} ) { - $self->find_extra_svk_parents - ($ed, $props->{"svk:merge"}, \@parents); - } - if ( $props->{"svn:mergeinfo"} ) { - $self->find_extra_svn_parents - ($ed, - $props->{"svn:mergeinfo"}, - \@parents); - } - } - - open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!; - print $un "r$rev\n" or croak $!; - print $un $_, "\n" foreach @$untracked; - my %log_entry = ( parents => \@parents, revision => $rev, - log => ''); - - my $headrev; - my $logged = delete $self->{logged_rev_props}; - if (!$logged || $self->{-want_revprops}) { - my $rp = $self->ra->rev_proplist($rev); - foreach (sort keys %$rp) { - my $v = $rp->{$_}; - if (/^svn:(author|date|log)$/) { - $log_entry{$1} = $v; - } elsif ($_ eq 'svm:headrev') { - $headrev = $v; - } else { - print $un " rev_prop: ", uri_encode($_), ' ', - uri_encode($v), "\n"; - } - } - } else { - map { $log_entry{$_} = $logged->{$_} } keys %$logged; - } - close $un or croak $!; - - $log_entry{date} = parse_svn_date($log_entry{date}); - $log_entry{log} .= "\n"; - my $author = $log_entry{author} = check_author($log_entry{author}); - my ($name, $email) = defined $::users{$author} ? @{$::users{$author}} - : ($author, undef); - - my ($commit_name, $commit_email) = ($name, $email); - if ($_use_log_author) { - my $name_field; - if ($log_entry{log} =~ /From:\s+(.*\S)\s*\n/i) { - $name_field = $1; - } elsif ($log_entry{log} =~ /Signed-off-by:\s+(.*\S)\s*\n/i) { - $name_field = $1; - } - if (!defined $name_field) { - if (!defined $email) { - $email = $name; - } - } elsif ($name_field =~ /(.*?)\s+<(.*)>/) { - ($name, $email) = ($1, $2); - } elsif ($name_field =~ /(.*)@/) { - ($name, $email) = ($1, $name_field); - } else { - ($name, $email) = ($name_field, $name_field); - } - } - if (defined $headrev && $self->use_svm_props) { - if ($self->rewrite_root) { - die "Can't have both 'useSvmProps' and 'rewriteRoot' ", - "options set!\n"; - } - if ($self->rewrite_uuid) { - die "Can't have both 'useSvmProps' and 'rewriteUUID' ", - "options set!\n"; - } - my ($uuid, $r) = $headrev =~ m{^([a-f\d\-]{30,}):(\d+)$}i; - # we don't want "SVM: initializing mirror for junk" ... - return undef if $r == 0; - my $svm = $self->svm; - if ($uuid ne $svm->{uuid}) { - die "UUID mismatch on SVM path:\n", - "expected: $svm->{uuid}\n", - " got: $uuid\n"; - } - my $full_url = $self->full_url; - $full_url =~ s#^\Q$svm->{replace}\E(/|$)#$svm->{source}$1# or - die "Failed to replace '$svm->{replace}' with ", - "'$svm->{source}' in $full_url\n"; - # throw away username for storing in records - remove_username($full_url); - $log_entry{metadata} = "$full_url\@$r $uuid"; - $log_entry{svm_revision} = $r; - $email ||= "$author\@$uuid"; - $commit_email ||= "$author\@$uuid"; - } elsif ($self->use_svnsync_props) { - my $full_url = $self->svnsync->{url}; - $full_url .= "/$self->{path}" if length $self->{path}; - remove_username($full_url); - my $uuid = $self->svnsync->{uuid}; - $log_entry{metadata} = "$full_url\@$rev $uuid"; - $email ||= "$author\@$uuid"; - $commit_email ||= "$author\@$uuid"; - } else { - my $url = $self->metadata_url; - remove_username($url); - my $uuid = $self->rewrite_uuid || $self->ra->get_uuid; - $log_entry{metadata} = "$url\@$rev " . $uuid; - $email ||= "$author\@" . $uuid; - $commit_email ||= "$author\@" . $uuid; - } - $log_entry{name} = $name; - $log_entry{email} = $email; - $log_entry{commit_name} = $commit_name; - $log_entry{commit_email} = $commit_email; - \%log_entry; -} - -sub fetch { - my ($self, $min_rev, $max_rev, @parents) = @_; - my ($last_rev, $last_commit) = $self->last_rev_commit; - my ($base, $head) = $self->get_fetch_range($min_rev, $max_rev); - $self->ra->gs_fetch_loop_common($base, $head, [$self]); -} - -sub set_tree_cb { - my ($self, $log_entry, $tree, $rev, $date, $author) = @_; - $self->{inject_parents} = { $rev => $tree }; - $self->fetch(undef, undef); -} - -sub set_tree { - my ($self, $tree) = (shift, shift); - my $log_entry = ::get_commit_entry($tree); - unless ($self->{last_rev}) { - ::fatal("Must have an existing revision to commit"); - } - my %ed_opts = ( r => $self->{last_rev}, - log => $log_entry->{log}, - ra => $self->ra, - tree_a => $self->{last_commit}, - tree_b => $tree, - editor_cb => sub { - $self->set_tree_cb($log_entry, $tree, @_) }, - svn_path => $self->{path} ); - if (!Git::SVN::Editor->new(\%ed_opts)->apply_diff) { - print "No changes\nr$self->{last_rev} = $tree\n"; - } -} - -sub rebuild_from_rev_db { - my ($self, $path) = @_; - my $r = -1; - open my $fh, '<', $path or croak "open: $!"; - binmode $fh or croak "binmode: $!"; - while (<$fh>) { - length($_) == 41 or croak "inconsistent size in ($_) != 41"; - chomp($_); - ++$r; - next if $_ eq ('0' x 40); - $self->rev_map_set($r, $_); - print "r$r = $_\n"; - } - close $fh or croak "close: $!"; - unlink $path or croak "unlink: $!"; -} - -sub rebuild { - my ($self) = @_; - my $map_path = $self->map_path; - my $partial = (-e $map_path && ! -z $map_path); - return unless ::verify_ref($self->refname.'^0'); - if (!$partial && ($self->use_svm_props || $self->no_metadata)) { - my $rev_db = $self->rev_db_path; - $self->rebuild_from_rev_db($rev_db); - if ($self->use_svm_props) { - my $svm_rev_db = $self->rev_db_path($self->svm_uuid); - $self->rebuild_from_rev_db($svm_rev_db); - } - $self->unlink_rev_db_symlink; - return; - } - print "Rebuilding $map_path ...\n" if (!$partial); - my ($base_rev, $head) = ($partial ? $self->rev_map_max_norebuild(1) : - (undef, undef)); - my ($log, $ctx) = - command_output_pipe(qw/rev-list --pretty=raw --reverse/, - ($head ? "$head.." : "") . $self->refname, - '--'); - my $metadata_url = $self->metadata_url; - remove_username($metadata_url); - my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid; - my $c; - while (<$log>) { - if ( m{^commit ($::sha1)$} ) { - $c = $1; - next; - } - next unless s{^\s*(git-svn-id:)}{$1}; - my ($url, $rev, $uuid) = ::extract_metadata($_); - remove_username($url); - - # ignore merges (from set-tree) - next if (!defined $rev || !$uuid); - - # if we merged or otherwise started elsewhere, this is - # how we break out of it - if (($uuid ne $svn_uuid) || - ($metadata_url && $url && ($url ne $metadata_url))) { - next; - } - if ($partial && $head) { - print "Partial-rebuilding $map_path ...\n"; - print "Currently at $base_rev = $head\n"; - $head = undef; - } - - $self->rev_map_set($rev, $c); - print "r$rev = $c\n"; - } - command_close_pipe($log, $ctx); - print "Done rebuilding $map_path\n" if (!$partial || !$head); - my $rev_db_path = $self->rev_db_path; - if (-f $self->rev_db_path) { - unlink $self->rev_db_path or croak "unlink: $!"; - } - $self->unlink_rev_db_symlink; -} - -# rev_map: -# Tie::File seems to be prone to offset errors if revisions get sparse, -# it's not that fast, either. Tie::File is also not in Perl 5.6. So -# one of my favorite modules is out :< Next up would be one of the DBM -# modules, but I'm not sure which is most portable... -# -# This is the replacement for the rev_db format, which was too big -# and inefficient for large repositories with a lot of sparse history -# (mainly tags) -# -# The format is this: -# - 24 bytes for every record, -# * 4 bytes for the integer representing an SVN revision number -# * 20 bytes representing the sha1 of a git commit -# - No empty padding records like the old format -# (except the last record, which can be overwritten) -# - new records are written append-only since SVN revision numbers -# increase monotonically -# - lookups on SVN revision number are done via a binary search -# - Piping the file to xxd -c24 is a good way of dumping it for -# viewing or editing (piped back through xxd -r), should the need -# ever arise. -# - The last record can be padding revision with an all-zero sha1 -# This is used to optimize fetch performance when using multiple -# "fetch" directives in .git/config -# -# These files are disposable unless noMetadata or useSvmProps is set - -sub _rev_map_set { - my ($fh, $rev, $commit) = @_; - - binmode $fh or croak "binmode: $!"; - my $size = (stat($fh))[7]; - ($size % 24) == 0 or croak "inconsistent size: $size"; - - my $wr_offset = 0; - if ($size > 0) { - sysseek($fh, -24, SEEK_END) or croak "seek: $!"; - my $read = sysread($fh, my $buf, 24) or croak "read: $!"; - $read == 24 or croak "read only $read bytes (!= 24)"; - my ($last_rev, $last_commit) = unpack(rev_map_fmt, $buf); - if ($last_commit eq ('0' x40)) { - if ($size >= 48) { - sysseek($fh, -48, SEEK_END) or croak "seek: $!"; - $read = sysread($fh, $buf, 24) or - croak "read: $!"; - $read == 24 or - croak "read only $read bytes (!= 24)"; - ($last_rev, $last_commit) = - unpack(rev_map_fmt, $buf); - if ($last_commit eq ('0' x40)) { - croak "inconsistent .rev_map\n"; - } - } - if ($last_rev >= $rev) { - croak "last_rev is higher!: $last_rev >= $rev"; - } - $wr_offset = -24; - } - } - sysseek($fh, $wr_offset, SEEK_END) or croak "seek: $!"; - syswrite($fh, pack(rev_map_fmt, $rev, $commit), 24) == 24 or - croak "write: $!"; -} - -sub _rev_map_reset { - my ($fh, $rev, $commit) = @_; - my $c = _rev_map_get($fh, $rev); - $c eq $commit or die "_rev_map_reset(@_) commit $c does not match!\n"; - my $offset = sysseek($fh, 0, SEEK_CUR) or croak "seek: $!"; - truncate $fh, $offset or croak "truncate: $!"; -} - -sub mkfile { - my ($path) = @_; - unless (-e $path) { - my ($dir, $base) = ($path =~ m#^(.*?)/?([^/]+)$#); - mkpath([$dir]) unless -d $dir; - open my $fh, '>>', $path or die "Couldn't create $path: $!\n"; - close $fh or die "Couldn't close (create) $path: $!\n"; - } -} - -sub rev_map_set { - my ($self, $rev, $commit, $update_ref, $uuid) = @_; - defined $commit or die "missing arg3\n"; - length $commit == 40 or die "arg3 must be a full SHA1 hexsum\n"; - my $db = $self->map_path($uuid); - my $db_lock = "$db.lock"; - my $sigmask; - $update_ref ||= 0; - if ($update_ref) { - $sigmask = POSIX::SigSet->new(); - my $signew = POSIX::SigSet->new(SIGINT, SIGHUP, SIGTERM, - SIGALRM, SIGUSR1, SIGUSR2); - sigprocmask(SIG_BLOCK, $signew, $sigmask) or - croak "Can't block signals: $!"; - } - mkfile($db); - - $LOCKFILES{$db_lock} = 1; - my $sync; - # both of these options make our .rev_db file very, very important - # and we can't afford to lose it because rebuild() won't work - if ($self->use_svm_props || $self->no_metadata) { - $sync = 1; - copy($db, $db_lock) or die "rev_map_set(@_): ", - "Failed to copy: ", - "$db => $db_lock ($!)\n"; - } else { - rename $db, $db_lock or die "rev_map_set(@_): ", - "Failed to rename: ", - "$db => $db_lock ($!)\n"; - } - - sysopen(my $fh, $db_lock, O_RDWR | O_CREAT) - or croak "Couldn't open $db_lock: $!\n"; - $update_ref eq 'reset' ? _rev_map_reset($fh, $rev, $commit) : - _rev_map_set($fh, $rev, $commit); - if ($sync) { - $fh->flush or die "Couldn't flush $db_lock: $!\n"; - $fh->sync or die "Couldn't sync $db_lock: $!\n"; - } - close $fh or croak $!; - if ($update_ref) { - $_head = $self; - my $note = ""; - $note = " ($update_ref)" if ($update_ref !~ /^\d*$/); - command_noisy('update-ref', '-m', "r$rev$note", - $self->refname, $commit); - } - rename $db_lock, $db or die "rev_map_set(@_): ", "Failed to rename: ", - "$db_lock => $db ($!)\n"; - delete $LOCKFILES{$db_lock}; - if ($update_ref) { - sigprocmask(SIG_SETMASK, $sigmask) or - croak "Can't restore signal mask: $!"; - } -} - -# If want_commit, this will return an array of (rev, commit) where -# commit _must_ be a valid commit in the archive. -# Otherwise, it'll return the max revision (whether or not the -# commit is valid or just a 0x40 placeholder). -sub rev_map_max { - my ($self, $want_commit) = @_; - $self->rebuild; - my ($r, $c) = $self->rev_map_max_norebuild($want_commit); - $want_commit ? ($r, $c) : $r; -} - -sub rev_map_max_norebuild { - my ($self, $want_commit) = @_; - my $map_path = $self->map_path; - stat $map_path or return $want_commit ? (0, undef) : 0; - sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!"; - binmode $fh or croak "binmode: $!"; - my $size = (stat($fh))[7]; - ($size % 24) == 0 or croak "inconsistent size: $size"; - - if ($size == 0) { - close $fh or croak "close: $!"; - return $want_commit ? (0, undef) : 0; - } - - sysseek($fh, -24, SEEK_END) or croak "seek: $!"; - sysread($fh, my $buf, 24) == 24 or croak "read: $!"; - my ($r, $c) = unpack(rev_map_fmt, $buf); - if ($want_commit && $c eq ('0' x40)) { - if ($size < 48) { - return $want_commit ? (0, undef) : 0; - } - sysseek($fh, -48, SEEK_END) or croak "seek: $!"; - sysread($fh, $buf, 24) == 24 or croak "read: $!"; - ($r, $c) = unpack(rev_map_fmt, $buf); - if ($c eq ('0'x40)) { - croak "Penultimate record is all-zeroes in $map_path"; - } - } - close $fh or croak "close: $!"; - $want_commit ? ($r, $c) : $r; -} - -sub rev_map_get { - my ($self, $rev, $uuid) = @_; - my $map_path = $self->map_path($uuid); - return undef unless -e $map_path; - - sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!"; - my $c = _rev_map_get($fh, $rev); - close($fh) or croak "close: $!"; - $c -} - -sub _rev_map_get { - my ($fh, $rev) = @_; - - binmode $fh or croak "binmode: $!"; - my $size = (stat($fh))[7]; - ($size % 24) == 0 or croak "inconsistent size: $size"; - - if ($size == 0) { - return undef; - } - - my ($l, $u) = (0, $size - 24); - my ($r, $c, $buf); - - while ($l <= $u) { - my $i = int(($l/24 + $u/24) / 2) * 24; - sysseek($fh, $i, SEEK_SET) or croak "seek: $!"; - sysread($fh, my $buf, 24) == 24 or croak "read: $!"; - my ($r, $c) = unpack(rev_map_fmt, $buf); - - if ($r < $rev) { - $l = $i + 24; - } elsif ($r > $rev) { - $u = $i - 24; - } else { # $r == $rev - return $c eq ('0' x 40) ? undef : $c; - } - } - undef; -} - -# Finds the first svn revision that exists on (if $eq_ok is true) or -# before $rev for the current branch. It will not search any lower -# than $min_rev. Returns the git commit hash and svn revision number -# if found, else (undef, undef). -sub find_rev_before { - my ($self, $rev, $eq_ok, $min_rev) = @_; - --$rev unless $eq_ok; - $min_rev ||= 1; - my $max_rev = $self->rev_map_max; - $rev = $max_rev if ($rev > $max_rev); - while ($rev >= $min_rev) { - if (my $c = $self->rev_map_get($rev)) { - return ($rev, $c); - } - --$rev; - } - return (undef, undef); -} - -# Finds the first svn revision that exists on (if $eq_ok is true) or -# after $rev for the current branch. It will not search any higher -# than $max_rev. Returns the git commit hash and svn revision number -# if found, else (undef, undef). -sub find_rev_after { - my ($self, $rev, $eq_ok, $max_rev) = @_; - ++$rev unless $eq_ok; - $max_rev ||= $self->rev_map_max; - while ($rev <= $max_rev) { - if (my $c = $self->rev_map_get($rev)) { - return ($rev, $c); - } - ++$rev; - } - return (undef, undef); -} - -sub _new { - my ($class, $repo_id, $ref_id, $path) = @_; - unless (defined $repo_id && length $repo_id) { - $repo_id = $Git::SVN::default_repo_id; - } - unless (defined $ref_id && length $ref_id) { - $_prefix = '' unless defined($_prefix); - $_[2] = $ref_id = - "refs/remotes/$_prefix$Git::SVN::default_ref_id"; - } - $_[1] = $repo_id; - my $dir = "$ENV{GIT_DIR}/svn/$ref_id"; - - # Older repos imported by us used $GIT_DIR/svn/foo instead of - # $GIT_DIR/svn/refs/remotes/foo when tracking refs/remotes/foo - if ($ref_id =~ m{^refs/remotes/(.*)}) { - my $old_dir = "$ENV{GIT_DIR}/svn/$1"; - if (-d $old_dir && ! -d $dir) { - $dir = $old_dir; - } - } - - $_[3] = $path = '' unless (defined $path); - mkpath([$dir]); - bless { - ref_id => $ref_id, dir => $dir, index => "$dir/index", - path => $path, config => "$ENV{GIT_DIR}/svn/config", - map_root => "$dir/.rev_map", repo_id => $repo_id }, $class; -} - -# for read-only access of old .rev_db formats -sub unlink_rev_db_symlink { - my ($self) = @_; - my $link = $self->rev_db_path; - $link =~ s/\.[\w-]+$// or croak "missing UUID at the end of $link"; - if (-l $link) { - unlink $link or croak "unlink: $link failed!"; - } -} - -sub rev_db_path { - my ($self, $uuid) = @_; - my $db_path = $self->map_path($uuid); - $db_path =~ s{/\.rev_map\.}{/\.rev_db\.} - or croak "map_path: $db_path does not contain '/.rev_map.' !"; - $db_path; -} - -# the new replacement for .rev_db -sub map_path { - my ($self, $uuid) = @_; - $uuid ||= $self->ra_uuid; - "$self->{map_root}.$uuid"; -} - -sub uri_encode { - my ($f) = @_; - $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg; - $f -} - -sub uri_decode { - my ($f) = @_; - $f =~ s#%([0-9a-fA-F]{2})#chr(hex($1))#eg; - $f -} - -sub remove_username { - $_[0] =~ s{^([^:]*://)[^@]+@}{$1}; -} - -package Git::SVN::Log; -use strict; -use warnings; -use POSIX qw/strftime/; -use constant commit_log_separator => ('-' x 72) . "\n"; -use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline - %rusers $show_commit $incremental/; -my $l_fmt; - -sub cmt_showable { - my ($c) = @_; - return 1 if defined $c->{r}; - - # big commit message got truncated by the 16k pretty buffer in rev-list - if ($c->{l} && $c->{l}->[-1] eq "...\n" && - $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) { - @{$c->{l}} = (); - my @log = command(qw/cat-file commit/, $c->{c}); - - # shift off the headers - shift @log while ($log[0] ne ''); - shift @log; - - # TODO: make $c->{l} not have a trailing newline in the future - @{$c->{l}} = map { "$_\n" } grep !/^git-svn-id: /, @log; - - (undef, $c->{r}, undef) = ::extract_metadata( - (grep(/^git-svn-id: /, @log))[-1]); - } - return defined $c->{r}; -} - -sub log_use_color { - return $color || Git->repository->get_colorbool('color.diff'); -} - -sub git_svn_log_cmd { - my ($r_min, $r_max, @args) = @_; - my $head = 'HEAD'; - my (@files, @log_opts); - foreach my $x (@args) { - if ($x eq '--' || @files) { - push @files, $x; - } else { - if (::verify_ref("$x^0")) { - $head = $x; - } else { - push @log_opts, $x; - } - } - } - - my ($url, $rev, $uuid, $gs) = ::working_head_info($head); - $gs ||= Git::SVN->_new; - my @cmd = (qw/log --abbrev-commit --pretty=raw --default/, - $gs->refname); - push @cmd, '-r' unless $non_recursive; - push @cmd, qw/--raw --name-status/ if $verbose; - push @cmd, '--color' if log_use_color(); - push @cmd, @log_opts; - if (defined $r_max && $r_max == $r_min) { - push @cmd, '--max-count=1'; - if (my $c = $gs->rev_map_get($r_max)) { - push @cmd, $c; - } - } elsif (defined $r_max) { - if ($r_max < $r_min) { - ($r_min, $r_max) = ($r_max, $r_min); - } - my (undef, $c_max) = $gs->find_rev_before($r_max, 1, $r_min); - my (undef, $c_min) = $gs->find_rev_after($r_min, 1, $r_max); - # If there are no commits in the range, both $c_max and $c_min - # will be undefined. If there is at least 1 commit in the - # range, both will be defined. - return () if !defined $c_min || !defined $c_max; - if ($c_min eq $c_max) { - push @cmd, '--max-count=1', $c_min; - } else { - push @cmd, '--boundary', "$c_min..$c_max"; - } - } - return (@cmd, @files); -} - -# adapted from pager.c -sub config_pager { - if (! -t *STDOUT) { - $ENV{GIT_PAGER_IN_USE} = 'false'; - $pager = undef; - return; - } - chomp($pager = command_oneline(qw(var GIT_PAGER))); - if ($pager eq 'cat') { - $pager = undef; - } - $ENV{GIT_PAGER_IN_USE} = defined($pager); -} - -sub run_pager { - return unless defined $pager; - pipe my ($rfd, $wfd) or return; - defined(my $pid = fork) or ::fatal "Can't fork: $!"; - if (!$pid) { - open STDOUT, '>&', $wfd or - ::fatal "Can't redirect to stdout: $!"; - return; - } - open STDIN, '<&', $rfd or ::fatal "Can't redirect stdin: $!"; - $ENV{LESS} ||= 'FRSX'; - exec $pager or ::fatal "Can't run pager: $! ($pager)"; -} - -sub format_svn_date { - my $t = shift || time; - my $gmoff = Git::SVN::get_tz($t); - return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t)); -} - -sub parse_git_date { - my ($t, $tz) = @_; - # Date::Parse isn't in the standard Perl distro :( - if ($tz =~ s/^\+//) { - $t += tz_to_s_offset($tz); - } elsif ($tz =~ s/^\-//) { - $t -= tz_to_s_offset($tz); - } - return $t; -} - -sub set_local_timezone { - if (defined $TZ) { - $ENV{TZ} = $TZ; - } else { - delete $ENV{TZ}; - } -} - -sub tz_to_s_offset { - my ($tz) = @_; - $tz =~ s/(\d\d)$//; - return ($1 * 60) + ($tz * 3600); -} - -sub get_author_info { - my ($dest, $author, $t, $tz) = @_; - $author =~ s/(?:^\s*|\s*$)//g; - $dest->{a_raw} = $author; - my $au; - if ($::_authors) { - $au = $rusers{$author} || undef; - } - if (!$au) { - ($au) = ($author =~ /<([^>]+)\@[^>]+>$/); - } - $dest->{t} = $t; - $dest->{tz} = $tz; - $dest->{a} = $au; - $dest->{t_utc} = parse_git_date($t, $tz); -} - -sub process_commit { - my ($c, $r_min, $r_max, $defer) = @_; - if (defined $r_min && defined $r_max) { - if ($r_min == $c->{r} && $r_min == $r_max) { - show_commit($c); - return 0; - } - return 1 if $r_min == $r_max; - if ($r_min < $r_max) { - # we need to reverse the print order - return 0 if (defined $limit && --$limit < 0); - push @$defer, $c; - return 1; - } - if ($r_min != $r_max) { - return 1 if ($r_min < $c->{r}); - return 1 if ($r_max > $c->{r}); - } - } - return 0 if (defined $limit && --$limit < 0); - show_commit($c); - return 1; -} - -sub show_commit { - my $c = shift; - if ($oneline) { - my $x = "\n"; - if (my $l = $c->{l}) { - while ($l->[0] =~ /^\s*$/) { shift @$l } - $x = $l->[0]; - } - $l_fmt ||= 'A' . length($c->{r}); - print 'r',pack($l_fmt, $c->{r}),' | '; - print "$c->{c} | " if $show_commit; - print $x; - } else { - show_commit_normal($c); - } -} - -sub show_commit_changed_paths { - my ($c) = @_; - return unless $c->{changed}; - print "Changed paths:\n", @{$c->{changed}}; -} - -sub show_commit_normal { - my ($c) = @_; - print commit_log_separator, "r$c->{r} | "; - print "$c->{c} | " if $show_commit; - print "$c->{a} | ", format_svn_date($c->{t_utc}), ' | '; - my $nr_line = 0; - - if (my $l = $c->{l}) { - while ($l->[$#$l] eq "\n" && $#$l > 0 - && $l->[($#$l - 1)] eq "\n") { - pop @$l; - } - $nr_line = scalar @$l; - if (!$nr_line) { - print "1 line\n\n\n"; - } else { - if ($nr_line == 1) { - $nr_line = '1 line'; - } else { - $nr_line .= ' lines'; - } - print $nr_line, "\n"; - show_commit_changed_paths($c); - print "\n"; - print $_ foreach @$l; - } - } else { - print "1 line\n"; - show_commit_changed_paths($c); - print "\n"; - - } - foreach my $x (qw/raw stat diff/) { - if ($c->{$x}) { - print "\n"; - print $_ foreach @{$c->{$x}} - } - } -} - -sub cmd_show_log { - my (@args) = @_; - my ($r_min, $r_max); - my $r_last = -1; # prevent dupes - set_local_timezone(); - if (defined $::_revision) { - if ($::_revision =~ /^(\d+):(\d+)$/) { - ($r_min, $r_max) = ($1, $2); - } elsif ($::_revision =~ /^\d+$/) { - $r_min = $r_max = $::_revision; - } else { - ::fatal "-r$::_revision is not supported, use ", - "standard 'git log' arguments instead"; - } - } - - config_pager(); - @args = git_svn_log_cmd($r_min, $r_max, @args); - if (!@args) { - print commit_log_separator unless $incremental || $oneline; - return; - } - my $log = command_output_pipe(@args); - run_pager(); - my (@k, $c, $d, $stat); - my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/; - while (<$log>) { - if (/^${esc_color}commit (?:- )?($::sha1_short)/o) { - my $cmt = $1; - if ($c && cmt_showable($c) && $c->{r} != $r_last) { - $r_last = $c->{r}; - process_commit($c, $r_min, $r_max, \@k) or - goto out; - } - $d = undef; - $c = { c => $cmt }; - } elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) { - get_author_info($c, $1, $2, $3); - } elsif (/^${esc_color}(?:tree|parent|committer) /o) { - # ignore - } elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) { - push @{$c->{raw}}, $_; - } elsif (/^${esc_color}[ACRMDT]\t/) { - # we could add $SVN->{svn_path} here, but that requires - # remote access at the moment (repo_path_split)... - s#^(${esc_color})([ACRMDT])\t#$1 $2 #o; - push @{$c->{changed}}, $_; - } elsif (/^${esc_color}diff /o) { - $d = 1; - push @{$c->{diff}}, $_; - } elsif ($d) { - push @{$c->{diff}}, $_; - } elsif (/^\ .+\ \|\s*\d+\ $esc_color[\+\-]* - $esc_color*[\+\-]*$esc_color$/x) { - $stat = 1; - push @{$c->{stat}}, $_; - } elsif ($stat && /^ \d+ files changed, \d+ insertions/) { - push @{$c->{stat}}, $_; - $stat = undef; - } elsif (/^${esc_color} (git-svn-id:.+)$/o) { - ($c->{url}, $c->{r}, undef) = ::extract_metadata($1); - } elsif (s/^${esc_color} //o) { - push @{$c->{l}}, $_; - } - } - if ($c && defined $c->{r} && $c->{r} != $r_last) { - $r_last = $c->{r}; - process_commit($c, $r_min, $r_max, \@k); - } - if (@k) { - ($r_min, $r_max) = ($r_max, $r_min); - process_commit($_, $r_min, $r_max) foreach reverse @k; - } -out: - close $log; - print commit_log_separator unless $incremental || $oneline; -} - -sub cmd_blame { - my $path = pop; - - config_pager(); - run_pager(); - - my ($fh, $ctx, $rev); - - if ($_git_format) { - ($fh, $ctx) = command_output_pipe('blame', @_, $path); - while (my $line = <$fh>) { - if ($line =~ /^\^?([[:xdigit:]]+)\s/) { - # Uncommitted edits show up as a rev ID of - # all zeros, which we can't look up with - # cmt_metadata - if ($1 !~ /^0+$/) { - (undef, $rev, undef) = - ::cmt_metadata($1); - $rev = '0' if (!$rev); - } else { - $rev = '0'; - } - $rev = sprintf('%-10s', $rev); - $line =~ s/^\^?[[:xdigit:]]+(\s)/$rev$1/; - } - print $line; - } - } else { - ($fh, $ctx) = command_output_pipe('blame', '-p', @_, 'HEAD', - '--', $path); - my ($sha1); - my %authors; - my @buffer; - my %dsha; #distinct sha keys - - while (my $line = <$fh>) { - push @buffer, $line; - if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { - $dsha{$1} = 1; - } - } - - my $s2r = ::cmt_sha2rev_batch([keys %dsha]); - - foreach my $line (@buffer) { - if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { - $rev = $s2r->{$1}; - $rev = '0' if (!$rev) - } - elsif ($line =~ /^author (.*)/) { - $authors{$rev} = $1; - $authors{$rev} =~ s/\s/_/g; - } - elsif ($line =~ /^\t(.*)$/) { - printf("%6s %10s %s\n", $rev, $authors{$rev}, $1); - } - } - } - command_close_pipe($fh, $ctx); -} - -package Git::SVN::Migration; -# these version numbers do NOT correspond to actual version numbers -# of git nor git-svn. They are just relative. -# -# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD -# -# v1 layout: .git/$id/info/url, refs/remotes/$id -# -# v2 layout: .git/svn/$id/info/url, refs/remotes/$id -# -# v3 layout: .git/svn/$id, refs/remotes/$id -# - info/url may remain for backwards compatibility -# - this is what we migrate up to this layout automatically, -# - this will be used by git svn init on single branches -# v3.1 layout (auto migrated): -# - .rev_db => .rev_db.$UUID, .rev_db will remain as a symlink -# for backwards compatibility -# -# v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id -# - this is only created for newly multi-init-ed -# repositories. Similar in spirit to the -# --use-separate-remotes option in git-clone (now default) -# - we do not automatically migrate to this (following -# the example set by core git) -# -# v5 layout: .rev_db.$UUID => .rev_map.$UUID -# - newer, more-efficient format that uses 24-bytes per record -# with no filler space. -# - use xxd -c24 < .rev_map.$UUID to view and debug -# - This is a one-way migration, repositories updated to the -# new format will not be able to use old git-svn without -# rebuilding the .rev_db. Rebuilding the rev_db is not -# possible if noMetadata or useSvmProps are set; but should -# be no problem for users that use the (sensible) defaults. -use strict; -use warnings; -use Carp qw/croak/; -use File::Path qw/mkpath/; -use File::Basename qw/dirname basename/; -use vars qw/$_minimize/; - -sub migrate_from_v0 { - my $git_dir = $ENV{GIT_DIR}; - return undef unless -d $git_dir; - my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); - my $migrated = 0; - while (<$fh>) { - chomp; - my ($id, $orig_ref) = ($_, $_); - next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#; - next unless -f "$git_dir/$id/info/url"; - my $new_ref = "refs/remotes/$id"; - if (::verify_ref("$new_ref^0")) { - print STDERR "W: $orig_ref is probably an old ", - "branch used by an ancient version of ", - "git-svn.\n", - "However, $new_ref also exists.\n", - "We will not be able ", - "to use this branch until this ", - "ambiguity is resolved.\n"; - next; - } - print STDERR "Migrating from v0 layout...\n" if !$migrated; - print STDERR "Renaming ref: $orig_ref => $new_ref\n"; - command_noisy('update-ref', $new_ref, $orig_ref); - command_noisy('update-ref', '-d', $orig_ref, $orig_ref); - $migrated++; - } - command_close_pipe($fh, $ctx); - print STDERR "Done migrating from v0 layout...\n" if $migrated; - $migrated; -} - -sub migrate_from_v1 { - my $git_dir = $ENV{GIT_DIR}; - my $migrated = 0; - return $migrated unless -d $git_dir; - my $svn_dir = "$git_dir/svn"; - - # just in case somebody used 'svn' as their $id at some point... - return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url"; - - print STDERR "Migrating from a git-svn v1 layout...\n"; - mkpath([$svn_dir]); - print STDERR "Data from a previous version of git-svn exists, but\n\t", - "$svn_dir\n\t(required for this version ", - "($::VERSION) of git-svn) does not exist.\n"; - my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); - while (<$fh>) { - my $x = $_; - next unless $x =~ s#^refs/remotes/##; - chomp $x; - next unless -f "$git_dir/$x/info/url"; - my $u = eval { ::file_to_s("$git_dir/$x/info/url") }; - next unless $u; - my $dn = dirname("$git_dir/svn/$x"); - mkpath([$dn]) unless -d $dn; - if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID: - mkpath(["$git_dir/svn/svn"]); - print STDERR " - $git_dir/$x/info => ", - "$git_dir/svn/$x/info\n"; - rename "$git_dir/$x/info", "$git_dir/svn/$x/info" or - croak "$!: $x"; - # don't worry too much about these, they probably - # don't exist with repos this old (save for index, - # and we can easily regenerate that) - foreach my $f (qw/unhandled.log index .rev_db/) { - rename "$git_dir/$x/$f", "$git_dir/svn/$x/$f"; - } - } else { - print STDERR " - $git_dir/$x => $git_dir/svn/$x\n"; - rename "$git_dir/$x", "$git_dir/svn/$x" or - croak "$!: $x"; - } - $migrated++; - } - command_close_pipe($fh, $ctx); - print STDERR "Done migrating from a git-svn v1 layout\n"; - $migrated; -} - -sub read_old_urls { - my ($l_map, $pfx, $path) = @_; - my @dir; - foreach (<$path/*>) { - if (-r "$_/info/url") { - $pfx .= '/' if $pfx && $pfx !~ m!/$!; - my $ref_id = $pfx . basename $_; - my $url = ::file_to_s("$_/info/url"); - $l_map->{$ref_id} = $url; - } elsif (-d $_) { - push @dir, $_; - } - } - foreach (@dir) { - my $x = $_; - $x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o; - read_old_urls($l_map, $x, $_); - } -} - -sub migrate_from_v2 { - my @cfg = command(qw/config -l/); - return if grep /^svn-remote\..+\.url=/, @cfg; - my %l_map; - read_old_urls(\%l_map, '', "$ENV{GIT_DIR}/svn"); - my $migrated = 0; - - foreach my $ref_id (sort keys %l_map) { - eval { Git::SVN->init($l_map{$ref_id}, '', undef, $ref_id) }; - if ($@) { - Git::SVN->init($l_map{$ref_id}, '', $ref_id, $ref_id); - } - $migrated++; - } - $migrated; -} - -sub minimize_connections { - my $r = Git::SVN::read_all_remotes(); - my $new_urls = {}; - my $root_repos = {}; - foreach my $repo_id (keys %$r) { - my $url = $r->{$repo_id}->{url} or next; - my $fetch = $r->{$repo_id}->{fetch} or next; - my $ra = Git::SVN::Ra->new($url); - - # skip existing cases where we already connect to the root - if (($ra->{url} eq $ra->{repos_root}) || - ($ra->{repos_root} eq $repo_id)) { - $root_repos->{$ra->{url}} = $repo_id; - next; - } - - my $root_ra = Git::SVN::Ra->new($ra->{repos_root}); - my $root_path = $ra->{url}; - $root_path =~ s#^\Q$ra->{repos_root}\E(/|$)##; - foreach my $path (keys %$fetch) { - my $ref_id = $fetch->{$path}; - my $gs = Git::SVN->new($ref_id, $repo_id, $path); - - # make sure we can read when connecting to - # a higher level of a repository - my ($last_rev, undef) = $gs->last_rev_commit; - if (!defined $last_rev) { - $last_rev = eval { - $root_ra->get_latest_revnum; - }; - next if $@; - } - my $new = $root_path; - $new .= length $path ? "/$path" : ''; - eval { - $root_ra->get_log([$new], $last_rev, $last_rev, - 0, 0, 1, sub { }); - }; - next if $@; - $new_urls->{$ra->{repos_root}}->{$new} = - { ref_id => $ref_id, - old_repo_id => $repo_id, - old_path => $path }; - } - } - - my @emptied; - foreach my $url (keys %$new_urls) { - # see if we can re-use an existing [svn-remote "repo_id"] - # instead of creating a(n ugly) new section: - my $repo_id = $root_repos->{$url} || $url; - - my $fetch = $new_urls->{$url}; - foreach my $path (keys %$fetch) { - my $x = $fetch->{$path}; - Git::SVN->init($url, $path, $repo_id, $x->{ref_id}); - my $pfx = "svn-remote.$x->{old_repo_id}"; - - my $old_fetch = quotemeta("$x->{old_path}:". - "$x->{ref_id}"); - command_noisy(qw/config --unset/, - "$pfx.fetch", '^'. $old_fetch . '$'); - delete $r->{$x->{old_repo_id}}-> - {fetch}->{$x->{old_path}}; - if (!keys %{$r->{$x->{old_repo_id}}->{fetch}}) { - command_noisy(qw/config --unset/, - "$pfx.url"); - push @emptied, $x->{old_repo_id} - } - } - } - if (@emptied) { - my $file = $ENV{GIT_CONFIG} || "$ENV{GIT_DIR}/config"; - print STDERR <<EOF; -The following [svn-remote] sections in your config file ($file) are empty -and can be safely removed: -EOF - print STDERR "[svn-remote \"$_\"]\n" foreach @emptied; - } -} - -sub migration_check { - migrate_from_v0(); - migrate_from_v1(); - migrate_from_v2(); - minimize_connections() if $_minimize; -} - -package Git::IndexInfo; -use strict; -use warnings; -use Git qw/command_input_pipe command_close_pipe/; - -sub new { - my ($class) = @_; - my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/); - bless { gui => $gui, ctx => $ctx, nr => 0}, $class; -} - -sub remove { - my ($self, $path) = @_; - if (print { $self->{gui} } '0 ', 0 x 40, "\t", $path, "\0") { - return ++$self->{nr}; - } - undef; -} - -sub update { - my ($self, $mode, $hash, $path) = @_; - if (print { $self->{gui} } $mode, ' ', $hash, "\t", $path, "\0") { - return ++$self->{nr}; - } - undef; -} - -sub DESTROY { - my ($self) = @_; - command_close_pipe($self->{gui}, $self->{ctx}); -} - -package Git::SVN::GlobSpec; -use strict; -use warnings; - -sub new { - my ($class, $glob, $pattern_ok) = @_; - my $re = $glob; - $re =~ s!/+$!!g; # no need for trailing slashes - my (@left, @right, @patterns); - my $state = "left"; - my $die_msg = "Only one set of wildcard directories " . - "(e.g. '*' or '*/*/*') is supported: '$glob'\n"; - for my $part (split(m|/|, $glob)) { - if ($part =~ /\*/ && $part ne "*") { - die "Invalid pattern in '$glob': $part\n"; - } elsif ($pattern_ok && $part =~ /[{}]/ && - $part !~ /^\{[^{}]+\}/) { - die "Invalid pattern in '$glob': $part\n"; - } - if ($part eq "*") { - die $die_msg if $state eq "right"; - $state = "pattern"; - push(@patterns, "[^/]*"); - } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) { - die $die_msg if $state eq "right"; - $state = "pattern"; - my $p = quotemeta($1); - $p =~ s/\\,/|/g; - push(@patterns, "(?:$p)"); - } else { - if ($state eq "left") { - push(@left, $part); - } else { - push(@right, $part); - $state = "right"; - } - } - } - my $depth = @patterns; - if ($depth == 0) { - die "One '*' is needed in glob: '$glob'\n"; - } - my $left = join('/', @left); - my $right = join('/', @right); - $re = join('/', @patterns); - $re = join('\/', - grep(length, quotemeta($left), "($re)", quotemeta($right))); - my $left_re = qr/^\/\Q$left\E(\/|$)/; - bless { left => $left, right => $right, left_regex => $left_re, - regex => qr/$re/, glob => $glob, depth => $depth }, $class; -} - -sub full_path { - my ($self, $path) = @_; - return (length $self->{left} ? "$self->{left}/" : '') . - $path . (length $self->{right} ? "/$self->{right}" : ''); -} - __END__ Data structures: @@ -44,9 +44,12 @@ static void uniq(struct cmdnames *cmds) if (!cmds->cnt) return; - for (i = j = 1; i < cmds->cnt; i++) - if (strcmp(cmds->names[i]->name, cmds->names[i-1]->name)) + for (i = j = 1; i < cmds->cnt; i++) { + if (!strcmp(cmds->names[i]->name, cmds->names[j-1]->name)) + free(cmds->names[i]); + else cmds->names[j++] = cmds->names[i]; + } cmds->cnt = j; } @@ -61,9 +64,10 @@ void exclude_cmds(struct cmdnames *cmds, struct cmdnames *excludes) cmp = strcmp(cmds->names[ci]->name, excludes->names[ei]->name); if (cmp < 0) cmds->names[cj++] = cmds->names[ci++]; - else if (cmp == 0) - ci++, ei++; - else if (cmp > 0) + else if (cmp == 0) { + ei++; + free(cmds->names[ci++]); + } else if (cmp > 0) ei++; } diff --git a/perl/.gitignore b/perl/.gitignore index d5c6e22d0..0f1fc27f8 100644 --- a/perl/.gitignore +++ b/perl/.gitignore @@ -5,3 +5,4 @@ MYMETA.yml blib blibdirs pm_to_blib +PM.stamp diff --git a/perl/Git/IndexInfo.pm b/perl/Git/IndexInfo.pm new file mode 100644 index 000000000..a43108c98 --- /dev/null +++ b/perl/Git/IndexInfo.pm @@ -0,0 +1,33 @@ +package Git::IndexInfo; +use strict; +use warnings; +use Git qw/command_input_pipe command_close_pipe/; + +sub new { + my ($class) = @_; + my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/); + bless { gui => $gui, ctx => $ctx, nr => 0}, $class; +} + +sub remove { + my ($self, $path) = @_; + if (print { $self->{gui} } '0 ', 0 x 40, "\t", $path, "\0") { + return ++$self->{nr}; + } + undef; +} + +sub update { + my ($self, $mode, $hash, $path) = @_; + if (print { $self->{gui} } $mode, ' ', $hash, "\t", $path, "\0") { + return ++$self->{nr}; + } + undef; +} + +sub DESTROY { + my ($self) = @_; + command_close_pipe($self->{gui}, $self->{ctx}); +} + +1; diff --git a/perl/Git/SVN.pm b/perl/Git/SVN.pm new file mode 100644 index 000000000..b8b34744e --- /dev/null +++ b/perl/Git/SVN.pm @@ -0,0 +1,2326 @@ +package Git::SVN; +use strict; +use warnings; +use Fcntl qw/:DEFAULT :seek/; +use constant rev_map_fmt => 'NH40'; +use vars qw/$_no_metadata + $_repack $_repack_flags $_use_svm_props $_head + $_use_svnsync_props $no_reuse_existing + $_use_log_author $_add_author_from $_localtime/; +use Carp qw/croak/; +use File::Path qw/mkpath/; +use File::Copy qw/copy/; +use IPC::Open3; +use Time::Local; +use Memoize; # core since 5.8.0, Jul 2002 +use Memoize::Storable; +use POSIX qw(:signal_h); + +use Git qw( + command + command_oneline + command_noisy + command_output_pipe + command_close_pipe +); +use Git::SVN::Utils qw(fatal can_compress); + +my $can_use_yaml; +BEGIN { + $can_use_yaml = eval { require Git::SVN::Memoize::YAML; 1}; +} + +our $_follow_parent = 1; +our $_minimize_url = 'unset'; +our $default_repo_id = 'svn'; +our $default_ref_id = $ENV{GIT_SVN_ID} || 'git-svn'; + +my ($_gc_nr, $_gc_period); + +# properties that we do not log: +my %SKIP_PROP; +BEGIN { + %SKIP_PROP = map { $_ => 1 } qw/svn:wc:ra_dav:version-url + svn:special svn:executable + svn:entry:committed-rev + svn:entry:last-author + svn:entry:uuid + svn:entry:committed-date/; + + # some options are read globally, but can be overridden locally + # per [svn-remote "..."] section. Command-line options will *NOT* + # override options set in an [svn-remote "..."] section + no strict 'refs'; + for my $option (qw/follow_parent no_metadata use_svm_props + use_svnsync_props/) { + my $key = $option; + $key =~ tr/_//d; + my $prop = "-$option"; + *$option = sub { + my ($self) = @_; + return $self->{$prop} if exists $self->{$prop}; + my $k = "svn-remote.$self->{repo_id}.$key"; + eval { command_oneline(qw/config --get/, $k) }; + if ($@) { + $self->{$prop} = ${"Git::SVN::_$option"}; + } else { + my $v = command_oneline(qw/config --bool/,$k); + $self->{$prop} = $v eq 'false' ? 0 : 1; + } + return $self->{$prop}; + } + } +} + + +my (%LOCKFILES, %INDEX_FILES); +END { + unlink keys %LOCKFILES if %LOCKFILES; + unlink keys %INDEX_FILES if %INDEX_FILES; +} + +sub resolve_local_globs { + my ($url, $fetch, $glob_spec) = @_; + return unless defined $glob_spec; + my $ref = $glob_spec->{ref}; + my $path = $glob_spec->{path}; + foreach (command(qw#for-each-ref --format=%(refname) refs/#)) { + next unless m#^$ref->{regex}$#; + my $p = $1; + my $pathname = desanitize_refname($path->full_path($p)); + my $refname = desanitize_refname($ref->full_path($p)); + if (my $existing = $fetch->{$pathname}) { + if ($existing ne $refname) { + die "Refspec conflict:\n", + "existing: $existing\n", + " globbed: $refname\n"; + } + my $u = (::cmt_metadata("$refname"))[0]; + $u =~ s!^\Q$url\E(/|$)!! or die + "$refname: '$url' not found in '$u'\n"; + if ($pathname ne $u) { + warn "W: Refspec glob conflict ", + "(ref: $refname):\n", + "expected path: $pathname\n", + " real path: $u\n", + "Continuing ahead with $u\n"; + next; + } + } else { + $fetch->{$pathname} = $refname; + } + } +} + +sub parse_revision_argument { + my ($base, $head) = @_; + if (!defined $::_revision || $::_revision eq 'BASE:HEAD') { + return ($base, $head); + } + return ($1, $2) if ($::_revision =~ /^(\d+):(\d+)$/); + return ($::_revision, $::_revision) if ($::_revision =~ /^\d+$/); + return ($head, $head) if ($::_revision eq 'HEAD'); + return ($base, $1) if ($::_revision =~ /^BASE:(\d+)$/); + return ($1, $head) if ($::_revision =~ /^(\d+):HEAD$/); + die "revision argument: $::_revision not understood by git-svn\n"; +} + +sub fetch_all { + my ($repo_id, $remotes) = @_; + if (ref $repo_id) { + my $gs = $repo_id; + $repo_id = undef; + $repo_id = $gs->{repo_id}; + } + $remotes ||= read_all_remotes(); + my $remote = $remotes->{$repo_id} or + die "[svn-remote \"$repo_id\"] unknown\n"; + my $fetch = $remote->{fetch}; + my $url = $remote->{url} or die "svn-remote.$repo_id.url not defined\n"; + my (@gs, @globs); + my $ra = Git::SVN::Ra->new($url); + my $uuid = $ra->get_uuid; + my $head = $ra->get_latest_revnum; + + # ignore errors, $head revision may not even exist anymore + eval { $ra->get_log("", $head, 0, 1, 0, 1, sub { $head = $_[1] }) }; + warn "W: $@\n" if $@; + + my $base = defined $fetch ? $head : 0; + + # read the max revs for wildcard expansion (branches/*, tags/*) + foreach my $t (qw/branches tags/) { + defined $remote->{$t} or next; + push @globs, @{$remote->{$t}}; + + my $max_rev = eval { tmp_config(qw/--int --get/, + "svn-remote.$repo_id.${t}-maxRev") }; + if (defined $max_rev && ($max_rev < $base)) { + $base = $max_rev; + } elsif (!defined $max_rev) { + $base = 0; + } + } + + if ($fetch) { + foreach my $p (sort keys %$fetch) { + my $gs = Git::SVN->new($fetch->{$p}, $repo_id, $p); + my $lr = $gs->rev_map_max; + if (defined $lr) { + $base = $lr if ($lr < $base); + } + push @gs, $gs; + } + } + + ($base, $head) = parse_revision_argument($base, $head); + $ra->gs_fetch_loop_common($base, $head, \@gs, \@globs); +} + +sub read_all_remotes { + my $r = {}; + my $use_svm_props = eval { command_oneline(qw/config --bool + svn.useSvmProps/) }; + $use_svm_props = $use_svm_props eq 'true' if $use_svm_props; + my $svn_refspec = qr{\s*(.*?)\s*:\s*(.+?)\s*}; + foreach (grep { s/^svn-remote\.// } command(qw/config -l/)) { + if (m!^(.+)\.fetch=$svn_refspec$!) { + my ($remote, $local_ref, $remote_ref) = ($1, $2, $3); + die("svn-remote.$remote: remote ref '$remote_ref' " + . "must start with 'refs/'\n") + unless $remote_ref =~ m{^refs/}; + $local_ref = uri_decode($local_ref); + $r->{$remote}->{fetch}->{$local_ref} = $remote_ref; + $r->{$remote}->{svm} = {} if $use_svm_props; + } elsif (m!^(.+)\.usesvmprops=\s*(.*)\s*$!) { + $r->{$1}->{svm} = {}; + } elsif (m!^(.+)\.url=\s*(.*)\s*$!) { + $r->{$1}->{url} = $2; + } elsif (m!^(.+)\.pushurl=\s*(.*)\s*$!) { + $r->{$1}->{pushurl} = $2; + } elsif (m!^(.+)\.ignore-refs=\s*(.*)\s*$!) { + $r->{$1}->{ignore_refs_regex} = $2; + } elsif (m!^(.+)\.(branches|tags)=$svn_refspec$!) { + my ($remote, $t, $local_ref, $remote_ref) = + ($1, $2, $3, $4); + die("svn-remote.$remote: remote ref '$remote_ref' ($t) " + . "must start with 'refs/'\n") + unless $remote_ref =~ m{^refs/}; + $local_ref = uri_decode($local_ref); + + require Git::SVN::GlobSpec; + my $rs = { + t => $t, + remote => $remote, + path => Git::SVN::GlobSpec->new($local_ref, 1), + ref => Git::SVN::GlobSpec->new($remote_ref, 0) }; + if (length($rs->{ref}->{right}) != 0) { + die "The '*' glob character must be the last ", + "character of '$remote_ref'\n"; + } + push @{ $r->{$remote}->{$t} }, $rs; + } + } + + map { + if (defined $r->{$_}->{svm}) { + my $svm; + eval { + my $section = "svn-remote.$_"; + $svm = { + source => tmp_config('--get', + "$section.svm-source"), + replace => tmp_config('--get', + "$section.svm-replace"), + } + }; + $r->{$_}->{svm} = $svm; + } + } keys %$r; + + foreach my $remote (keys %$r) { + foreach ( grep { defined $_ } + map { $r->{$remote}->{$_} } qw(branches tags) ) { + foreach my $rs ( @$_ ) { + $rs->{ignore_refs_regex} = + $r->{$remote}->{ignore_refs_regex}; + } + } + } + + $r; +} + +sub init_vars { + $_gc_nr = $_gc_period = 1000; + if (defined $_repack || defined $_repack_flags) { + warn "Repack options are obsolete; they have no effect.\n"; + } +} + +sub verify_remotes_sanity { + return unless -d $ENV{GIT_DIR}; + my %seen; + foreach (command(qw/config -l/)) { + if (m!^svn-remote\.(?:.+)\.fetch=.*:refs/remotes/(\S+)\s*$!) { + if ($seen{$1}) { + die "Remote ref refs/remote/$1 is tracked by", + "\n \"$_\"\nand\n \"$seen{$1}\"\n", + "Please resolve this ambiguity in ", + "your git configuration file before ", + "continuing\n"; + } + $seen{$1} = $_; + } + } +} + +sub find_existing_remote { + my ($url, $remotes) = @_; + return undef if $no_reuse_existing; + my $existing; + foreach my $repo_id (keys %$remotes) { + my $u = $remotes->{$repo_id}->{url} or next; + next if $u ne $url; + $existing = $repo_id; + last; + } + $existing; +} + +sub init_remote_config { + my ($self, $url, $no_write) = @_; + $url =~ s!/+$!!; # strip trailing slash + my $r = read_all_remotes(); + my $existing = find_existing_remote($url, $r); + if ($existing) { + unless ($no_write) { + print STDERR "Using existing ", + "[svn-remote \"$existing\"]\n"; + } + $self->{repo_id} = $existing; + } elsif ($_minimize_url) { + my $min_url = Git::SVN::Ra->new($url)->minimize_url; + $existing = find_existing_remote($min_url, $r); + if ($existing) { + unless ($no_write) { + print STDERR "Using existing ", + "[svn-remote \"$existing\"]\n"; + } + $self->{repo_id} = $existing; + } + if ($min_url ne $url) { + unless ($no_write) { + print STDERR "Using higher level of URL: ", + "$url => $min_url\n"; + } + my $old_path = $self->{path}; + $self->{path} = $url; + $self->{path} =~ s!^\Q$min_url\E(/|$)!!; + if (length $old_path) { + $self->{path} .= "/$old_path"; + } + $url = $min_url; + } + } + my $orig_url; + if (!$existing) { + # verify that we aren't overwriting anything: + $orig_url = eval { + command_oneline('config', '--get', + "svn-remote.$self->{repo_id}.url") + }; + if ($orig_url && ($orig_url ne $url)) { + die "svn-remote.$self->{repo_id}.url already set: ", + "$orig_url\nwanted to set to: $url\n"; + } + } + my ($xrepo_id, $xpath) = find_ref($self->refname); + if (!$no_write && defined $xpath) { + die "svn-remote.$xrepo_id.fetch already set to track ", + "$xpath:", $self->refname, "\n"; + } + unless ($no_write) { + command_noisy('config', + "svn-remote.$self->{repo_id}.url", $url); + $self->{path} =~ s{^/}{}; + $self->{path} =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg; + command_noisy('config', '--add', + "svn-remote.$self->{repo_id}.fetch", + "$self->{path}:".$self->refname); + } + $self->{url} = $url; +} + +sub find_by_url { # repos_root and, path are optional + my ($class, $full_url, $repos_root, $path) = @_; + + return undef unless defined $full_url; + remove_username($full_url); + remove_username($repos_root) if defined $repos_root; + my $remotes = read_all_remotes(); + if (defined $full_url && defined $repos_root && !defined $path) { + $path = $full_url; + $path =~ s#^\Q$repos_root\E(?:/|$)##; + } + foreach my $repo_id (keys %$remotes) { + my $u = $remotes->{$repo_id}->{url} or next; + remove_username($u); + next if defined $repos_root && $repos_root ne $u; + + my $fetch = $remotes->{$repo_id}->{fetch} || {}; + foreach my $t (qw/branches tags/) { + foreach my $globspec (@{$remotes->{$repo_id}->{$t}}) { + resolve_local_globs($u, $fetch, $globspec); + } + } + my $p = $path; + my $rwr = rewrite_root({repo_id => $repo_id}); + my $svm = $remotes->{$repo_id}->{svm} + if defined $remotes->{$repo_id}->{svm}; + unless (defined $p) { + $p = $full_url; + my $z = $u; + my $prefix = ''; + if ($rwr) { + $z = $rwr; + remove_username($z); + } elsif (defined $svm) { + $z = $svm->{source}; + $prefix = $svm->{replace}; + $prefix =~ s#^\Q$u\E(?:/|$)##; + $prefix =~ s#/$##; + } + $p =~ s#^\Q$z\E(?:/|$)#$prefix# or next; + } + foreach my $f (keys %$fetch) { + next if $f ne $p; + return Git::SVN->new($fetch->{$f}, $repo_id, $f); + } + } + undef; +} + +sub init { + my ($class, $url, $path, $repo_id, $ref_id, $no_write) = @_; + my $self = _new($class, $repo_id, $ref_id, $path); + if (defined $url) { + $self->init_remote_config($url, $no_write); + } + $self; +} + +sub find_ref { + my ($ref_id) = @_; + foreach (command(qw/config -l/)) { + next unless m!^svn-remote\.(.+)\.fetch= + \s*(.*?)\s*:\s*(.+?)\s*$!x; + my ($repo_id, $path, $ref) = ($1, $2, $3); + if ($ref eq $ref_id) { + $path = '' if ($path =~ m#^\./?#); + return ($repo_id, $path); + } + } + (undef, undef, undef); +} + +sub new { + my ($class, $ref_id, $repo_id, $path) = @_; + if (defined $ref_id && !defined $repo_id && !defined $path) { + ($repo_id, $path) = find_ref($ref_id); + if (!defined $repo_id) { + die "Could not find a \"svn-remote.*.fetch\" key ", + "in the repository configuration matching: ", + "$ref_id\n"; + } + } + my $self = _new($class, $repo_id, $ref_id, $path); + if (!defined $self->{path} || !length $self->{path}) { + my $fetch = command_oneline('config', '--get', + "svn-remote.$repo_id.fetch", + ":$ref_id\$") or + die "Failed to read \"svn-remote.$repo_id.fetch\" ", + "\":$ref_id\$\" in config\n"; + ($self->{path}, undef) = split(/\s*:\s*/, $fetch); + } + $self->{path} =~ s{/+}{/}g; + $self->{path} =~ s{\A/}{}; + $self->{path} =~ s{/\z}{}; + $self->{url} = command_oneline('config', '--get', + "svn-remote.$repo_id.url") or + die "Failed to read \"svn-remote.$repo_id.url\" in config\n"; + $self->{pushurl} = eval { command_oneline('config', '--get', + "svn-remote.$repo_id.pushurl") }; + $self->rebuild; + $self; +} + +sub refname { + my ($refname) = $_[0]->{ref_id} ; + + # It cannot end with a slash /, we'll throw up on this because + # SVN can't have directories with a slash in their name, either: + if ($refname =~ m{/$}) { + die "ref: '$refname' ends with a trailing slash, this is ", + "not permitted by git nor Subversion\n"; + } + + # It cannot have ASCII control character space, tilde ~, caret ^, + # colon :, question-mark ?, asterisk *, space, or open bracket [ + # anywhere. + # + # Additionally, % must be escaped because it is used for escaping + # and we want our escaped refname to be reversible + $refname =~ s{([ \%~\^:\?\*\[\t])}{uc sprintf('%%%02x',ord($1))}eg; + + # no slash-separated component can begin with a dot . + # /.* becomes /%2E* + $refname =~ s{/\.}{/%2E}g; + + # It cannot have two consecutive dots .. anywhere + # .. becomes %2E%2E + $refname =~ s{\.\.}{%2E%2E}g; + + # trailing dots and .lock are not allowed + # .$ becomes %2E and .lock becomes %2Elock + $refname =~ s{\.(?=$|lock$)}{%2E}; + + # the sequence @{ is used to access the reflog + # @{ becomes %40{ + $refname =~ s{\@\{}{%40\{}g; + + return $refname; +} + +sub desanitize_refname { + my ($refname) = @_; + $refname =~ s{%(?:([0-9A-F]{2}))}{chr hex($1)}eg; + return $refname; +} + +sub svm_uuid { + my ($self) = @_; + return $self->{svm}->{uuid} if $self->svm; + $self->ra; + unless ($self->{svm}) { + die "SVM UUID not cached, and reading remotely failed\n"; + } + $self->{svm}->{uuid}; +} + +sub svm { + my ($self) = @_; + return $self->{svm} if $self->{svm}; + my $svm; + # see if we have it in our config, first: + eval { + my $section = "svn-remote.$self->{repo_id}"; + $svm = { + source => tmp_config('--get', "$section.svm-source"), + uuid => tmp_config('--get', "$section.svm-uuid"), + replace => tmp_config('--get', "$section.svm-replace"), + } + }; + if ($svm && $svm->{source} && $svm->{uuid} && $svm->{replace}) { + $self->{svm} = $svm; + } + $self->{svm}; +} + +sub _set_svm_vars { + my ($self, $ra) = @_; + return $ra if $self->svm; + + my @err = ( "useSvmProps set, but failed to read SVM properties\n", + "(svm:source, svm:uuid) ", + "from the following URLs:\n" ); + sub read_svm_props { + my ($self, $ra, $path, $r) = @_; + my $props = ($ra->get_dir($path, $r))[2]; + my $src = $props->{'svm:source'}; + my $uuid = $props->{'svm:uuid'}; + return undef if (!$src || !$uuid); + + chomp($src, $uuid); + + $uuid =~ m{^[0-9a-f\-]{30,}$}i + or die "doesn't look right - svm:uuid is '$uuid'\n"; + + # the '!' is used to mark the repos_root!/relative/path + $src =~ s{/?!/?}{/}; + $src =~ s{/+$}{}; # no trailing slashes please + # username is of no interest + $src =~ s{(^[a-z\+]*://)[^/@]*@}{$1}; + + my $replace = $ra->{url}; + $replace .= "/$path" if length $path; + + my $section = "svn-remote.$self->{repo_id}"; + tmp_config("$section.svm-source", $src); + tmp_config("$section.svm-replace", $replace); + tmp_config("$section.svm-uuid", $uuid); + $self->{svm} = { + source => $src, + uuid => $uuid, + replace => $replace + }; + } + + my $r = $ra->get_latest_revnum; + my $path = $self->{path}; + my %tried; + while (length $path) { + unless ($tried{"$self->{url}/$path"}) { + return $ra if $self->read_svm_props($ra, $path, $r); + $tried{"$self->{url}/$path"} = 1; + } + $path =~ s#/?[^/]+$##; + } + die "Path: '$path' should be ''\n" if $path ne ''; + return $ra if $self->read_svm_props($ra, $path, $r); + $tried{"$self->{url}/$path"} = 1; + + if ($ra->{repos_root} eq $self->{url}) { + die @err, (map { " $_\n" } keys %tried), "\n"; + } + + # nope, make sure we're connected to the repository root: + my $ok; + my @tried_b; + $path = $ra->{svn_path}; + $ra = Git::SVN::Ra->new($ra->{repos_root}); + while (length $path) { + unless ($tried{"$ra->{url}/$path"}) { + $ok = $self->read_svm_props($ra, $path, $r); + last if $ok; + $tried{"$ra->{url}/$path"} = 1; + } + $path =~ s#/?[^/]+$##; + } + die "Path: '$path' should be ''\n" if $path ne ''; + $ok ||= $self->read_svm_props($ra, $path, $r); + $tried{"$ra->{url}/$path"} = 1; + if (!$ok) { + die @err, (map { " $_\n" } keys %tried), "\n"; + } + Git::SVN::Ra->new($self->{url}); +} + +sub svnsync { + my ($self) = @_; + return $self->{svnsync} if $self->{svnsync}; + + if ($self->no_metadata) { + die "Can't have both 'noMetadata' and ", + "'useSvnsyncProps' options set!\n"; + } + if ($self->rewrite_root) { + die "Can't have both 'useSvnsyncProps' and 'rewriteRoot' ", + "options set!\n"; + } + if ($self->rewrite_uuid) { + die "Can't have both 'useSvnsyncProps' and 'rewriteUUID' ", + "options set!\n"; + } + + my $svnsync; + # see if we have it in our config, first: + eval { + my $section = "svn-remote.$self->{repo_id}"; + + my $url = tmp_config('--get', "$section.svnsync-url"); + ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or + die "doesn't look right - svn:sync-from-url is '$url'\n"; + + my $uuid = tmp_config('--get', "$section.svnsync-uuid"); + ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or + die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; + + $svnsync = { url => $url, uuid => $uuid } + }; + if ($svnsync && $svnsync->{url} && $svnsync->{uuid}) { + return $self->{svnsync} = $svnsync; + } + + my $err = "useSvnsyncProps set, but failed to read " . + "svnsync property: svn:sync-from-"; + my $rp = $self->ra->rev_proplist(0); + + my $url = $rp->{'svn:sync-from-url'} or die $err . "url\n"; + ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or + die "doesn't look right - svn:sync-from-url is '$url'\n"; + + my $uuid = $rp->{'svn:sync-from-uuid'} or die $err . "uuid\n"; + ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or + die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; + + my $section = "svn-remote.$self->{repo_id}"; + tmp_config('--add', "$section.svnsync-uuid", $uuid); + tmp_config('--add', "$section.svnsync-url", $url); + return $self->{svnsync} = { url => $url, uuid => $uuid }; +} + +# this allows us to memoize our SVN::Ra UUID locally and avoid a +# remote lookup (useful for 'git svn log'). +sub ra_uuid { + my ($self) = @_; + unless ($self->{ra_uuid}) { + my $key = "svn-remote.$self->{repo_id}.uuid"; + my $uuid = eval { tmp_config('--get', $key) }; + if (!$@ && $uuid && $uuid =~ /^([a-f\d\-]{30,})$/i) { + $self->{ra_uuid} = $uuid; + } else { + die "ra_uuid called without URL\n" unless $self->{url}; + $self->{ra_uuid} = $self->ra->get_uuid; + tmp_config('--add', $key, $self->{ra_uuid}); + } + } + $self->{ra_uuid}; +} + +sub _set_repos_root { + my ($self, $repos_root) = @_; + my $k = "svn-remote.$self->{repo_id}.reposRoot"; + $repos_root ||= $self->ra->{repos_root}; + tmp_config($k, $repos_root); + $repos_root; +} + +sub repos_root { + my ($self) = @_; + my $k = "svn-remote.$self->{repo_id}.reposRoot"; + eval { tmp_config('--get', $k) } || $self->_set_repos_root; +} + +sub ra { + my ($self) = shift; + my $ra = Git::SVN::Ra->new($self->{url}); + $self->_set_repos_root($ra->{repos_root}); + if ($self->use_svm_props && !$self->{svm}) { + if ($self->no_metadata) { + die "Can't have both 'noMetadata' and ", + "'useSvmProps' options set!\n"; + } elsif ($self->use_svnsync_props) { + die "Can't have both 'useSvnsyncProps' and ", + "'useSvmProps' options set!\n"; + } + $ra = $self->_set_svm_vars($ra); + $self->{-want_revprops} = 1; + } + $ra; +} + +# prop_walk(PATH, REV, SUB) +# ------------------------- +# Recursively traverse PATH at revision REV and invoke SUB for each +# directory that contains a SVN property. SUB will be invoked as +# follows: &SUB(gs, path, props); where `gs' is this instance of +# Git::SVN, `path' the path to the directory where the properties +# `props' were found. The `path' will be relative to point of checkout, +# that is, if url://repo/trunk is the current Git branch, and that +# directory contains a sub-directory `d', SUB will be invoked with `/d/' +# as `path' (note the trailing `/'). +sub prop_walk { + my ($self, $path, $rev, $sub) = @_; + + $path =~ s#^/##; + my ($dirent, undef, $props) = $self->ra->get_dir($path, $rev); + $path =~ s#^/*#/#g; + my $p = $path; + # Strip the irrelevant part of the path. + $p =~ s#^/+\Q$self->{path}\E(/|$)#/#; + # Ensure the path is terminated by a `/'. + $p =~ s#/*$#/#; + + # The properties contain all the internal SVN stuff nobody + # (usually) cares about. + my $interesting_props = 0; + foreach (keys %{$props}) { + # If it doesn't start with `svn:', it must be a + # user-defined property. + ++$interesting_props and next if $_ !~ /^svn:/; + # FIXME: Fragile, if SVN adds new public properties, + # this needs to be updated. + ++$interesting_props if /^svn:(?:ignore|keywords|executable + |eol-style|mime-type + |externals|needs-lock)$/x; + } + &$sub($self, $p, $props) if $interesting_props; + + foreach (sort keys %$dirent) { + next if $dirent->{$_}->{kind} != $SVN::Node::dir; + $self->prop_walk($self->{path} . $p . $_, $rev, $sub); + } +} + +sub last_rev { ($_[0]->last_rev_commit)[0] } +sub last_commit { ($_[0]->last_rev_commit)[1] } + +# returns the newest SVN revision number and newest commit SHA1 +sub last_rev_commit { + my ($self) = @_; + if (defined $self->{last_rev} && defined $self->{last_commit}) { + return ($self->{last_rev}, $self->{last_commit}); + } + my $c = ::verify_ref($self->refname.'^0'); + if ($c && !$self->use_svm_props && !$self->no_metadata) { + my $rev = (::cmt_metadata($c))[1]; + if (defined $rev) { + ($self->{last_rev}, $self->{last_commit}) = ($rev, $c); + return ($rev, $c); + } + } + my $map_path = $self->map_path; + unless (-e $map_path) { + ($self->{last_rev}, $self->{last_commit}) = (undef, undef); + return (undef, undef); + } + my ($rev, $commit) = $self->rev_map_max(1); + ($self->{last_rev}, $self->{last_commit}) = ($rev, $commit); + return ($rev, $commit); +} + +sub get_fetch_range { + my ($self, $min, $max) = @_; + $max ||= $self->ra->get_latest_revnum; + $min ||= $self->rev_map_max; + (++$min, $max); +} + +sub tmp_config { + my (@args) = @_; + my $old_def_config = "$ENV{GIT_DIR}/svn/config"; + my $config = "$ENV{GIT_DIR}/svn/.metadata"; + if (! -f $config && -f $old_def_config) { + rename $old_def_config, $config or + die "Failed rename $old_def_config => $config: $!\n"; + } + my $old_config = $ENV{GIT_CONFIG}; + $ENV{GIT_CONFIG} = $config; + $@ = undef; + my @ret = eval { + unless (-f $config) { + mkfile($config); + open my $fh, '>', $config or + die "Can't open $config: $!\n"; + print $fh "; This file is used internally by ", + "git-svn\n" or die + "Couldn't write to $config: $!\n"; + print $fh "; You should not have to edit it\n" or + die "Couldn't write to $config: $!\n"; + close $fh or die "Couldn't close $config: $!\n"; + } + command('config', @args); + }; + my $err = $@; + if (defined $old_config) { + $ENV{GIT_CONFIG} = $old_config; + } else { + delete $ENV{GIT_CONFIG}; + } + die $err if $err; + wantarray ? @ret : $ret[0]; +} + +sub tmp_index_do { + my ($self, $sub) = @_; + my $old_index = $ENV{GIT_INDEX_FILE}; + $ENV{GIT_INDEX_FILE} = $self->{index}; + $@ = undef; + my @ret = eval { + my ($dir, $base) = ($self->{index} =~ m#^(.*?)/?([^/]+)$#); + mkpath([$dir]) unless -d $dir; + &$sub; + }; + my $err = $@; + if (defined $old_index) { + $ENV{GIT_INDEX_FILE} = $old_index; + } else { + delete $ENV{GIT_INDEX_FILE}; + } + die $err if $err; + wantarray ? @ret : $ret[0]; +} + +sub assert_index_clean { + my ($self, $treeish) = @_; + + $self->tmp_index_do(sub { + command_noisy('read-tree', $treeish) unless -e $self->{index}; + my $x = command_oneline('write-tree'); + my ($y) = (command(qw/cat-file commit/, $treeish) =~ + /^tree ($::sha1)/mo); + return if $y eq $x; + + warn "Index mismatch: $y != $x\nrereading $treeish\n"; + unlink $self->{index} or die "unlink $self->{index}: $!\n"; + command_noisy('read-tree', $treeish); + $x = command_oneline('write-tree'); + if ($y ne $x) { + fatal "trees ($treeish) $y != $x\n", + "Something is seriously wrong..."; + } + }); +} + +sub get_commit_parents { + my ($self, $log_entry) = @_; + my (%seen, @ret, @tmp); + # legacy support for 'set-tree'; this is only used by set_tree_cb: + if (my $ip = $self->{inject_parents}) { + if (my $commit = delete $ip->{$log_entry->{revision}}) { + push @tmp, $commit; + } + } + if (my $cur = ::verify_ref($self->refname.'^0')) { + push @tmp, $cur; + } + if (my $ipd = $self->{inject_parents_dcommit}) { + if (my $commit = delete $ipd->{$log_entry->{revision}}) { + push @tmp, @$commit; + } + } + push @tmp, $_ foreach (@{$log_entry->{parents}}, @tmp); + while (my $p = shift @tmp) { + next if $seen{$p}; + $seen{$p} = 1; + push @ret, $p; + } + @ret; +} + +sub rewrite_root { + my ($self) = @_; + return $self->{-rewrite_root} if exists $self->{-rewrite_root}; + my $k = "svn-remote.$self->{repo_id}.rewriteRoot"; + my $rwr = eval { command_oneline(qw/config --get/, $k) }; + if ($rwr) { + $rwr =~ s#/+$##; + if ($rwr !~ m#^[a-z\+]+://#) { + die "$rwr is not a valid URL (key: $k)\n"; + } + } + $self->{-rewrite_root} = $rwr; +} + +sub rewrite_uuid { + my ($self) = @_; + return $self->{-rewrite_uuid} if exists $self->{-rewrite_uuid}; + my $k = "svn-remote.$self->{repo_id}.rewriteUUID"; + my $rwid = eval { command_oneline(qw/config --get/, $k) }; + if ($rwid) { + $rwid =~ s#/+$##; + if ($rwid !~ m#^[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}$#) { + die "$rwid is not a valid UUID (key: $k)\n"; + } + } + $self->{-rewrite_uuid} = $rwid; +} + +sub metadata_url { + my ($self) = @_; + ($self->rewrite_root || $self->{url}) . + (length $self->{path} ? '/' . $self->{path} : ''); +} + +sub full_url { + my ($self) = @_; + $self->{url} . (length $self->{path} ? '/' . $self->{path} : ''); +} + +sub full_pushurl { + my ($self) = @_; + if ($self->{pushurl}) { + return $self->{pushurl} . (length $self->{path} ? '/' . + $self->{path} : ''); + } else { + return $self->full_url; + } +} + +sub set_commit_header_env { + my ($log_entry) = @_; + my %env; + foreach my $ned (qw/NAME EMAIL DATE/) { + foreach my $ac (qw/AUTHOR COMMITTER/) { + $env{"GIT_${ac}_${ned}"} = $ENV{"GIT_${ac}_${ned}"}; + } + } + + $ENV{GIT_AUTHOR_NAME} = $log_entry->{name}; + $ENV{GIT_AUTHOR_EMAIL} = $log_entry->{email}; + $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_entry->{date}; + + $ENV{GIT_COMMITTER_NAME} = (defined $log_entry->{commit_name}) + ? $log_entry->{commit_name} + : $log_entry->{name}; + $ENV{GIT_COMMITTER_EMAIL} = (defined $log_entry->{commit_email}) + ? $log_entry->{commit_email} + : $log_entry->{email}; + \%env; +} + +sub restore_commit_header_env { + my ($env) = @_; + foreach my $ned (qw/NAME EMAIL DATE/) { + foreach my $ac (qw/AUTHOR COMMITTER/) { + my $k = "GIT_${ac}_${ned}"; + if (defined $env->{$k}) { + $ENV{$k} = $env->{$k}; + } else { + delete $ENV{$k}; + } + } + } +} + +sub gc { + command_noisy('gc', '--auto'); +}; + +sub do_git_commit { + my ($self, $log_entry) = @_; + my $lr = $self->last_rev; + if (defined $lr && $lr >= $log_entry->{revision}) { + die "Last fetched revision of ", $self->refname, + " was r$lr, but we are about to fetch: ", + "r$log_entry->{revision}!\n"; + } + if (my $c = $self->rev_map_get($log_entry->{revision})) { + croak "$log_entry->{revision} = $c already exists! ", + "Why are we refetching it?\n"; + } + my $old_env = set_commit_header_env($log_entry); + my $tree = $log_entry->{tree}; + if (!defined $tree) { + $tree = $self->tmp_index_do(sub { + command_oneline('write-tree') }); + } + die "Tree is not a valid sha1: $tree\n" if $tree !~ /^$::sha1$/o; + + my @exec = ('git', 'commit-tree', $tree); + foreach ($self->get_commit_parents($log_entry)) { + push @exec, '-p', $_; + } + defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec)) + or croak $!; + binmode $msg_fh; + + # we always get UTF-8 from SVN, but we may want our commits in + # a different encoding. + if (my $enc = Git::config('i18n.commitencoding')) { + require Encode; + Encode::from_to($log_entry->{log}, 'UTF-8', $enc); + } + print $msg_fh $log_entry->{log} or croak $!; + restore_commit_header_env($old_env); + unless ($self->no_metadata) { + print $msg_fh "\ngit-svn-id: $log_entry->{metadata}\n" + or croak $!; + } + $msg_fh->flush == 0 or croak $!; + close $msg_fh or croak $!; + chomp(my $commit = do { local $/; <$out_fh> }); + close $out_fh or croak $!; + waitpid $pid, 0; + croak $? if $?; + if ($commit !~ /^$::sha1$/o) { + die "Failed to commit, invalid sha1: $commit\n"; + } + + $self->rev_map_set($log_entry->{revision}, $commit, 1); + + $self->{last_rev} = $log_entry->{revision}; + $self->{last_commit} = $commit; + print "r$log_entry->{revision}" unless $::_q > 1; + if (defined $log_entry->{svm_revision}) { + print " (\@$log_entry->{svm_revision})" unless $::_q > 1; + $self->rev_map_set($log_entry->{svm_revision}, $commit, + 0, $self->svm_uuid); + } + print " = $commit ($self->{ref_id})\n" unless $::_q > 1; + if (--$_gc_nr == 0) { + $_gc_nr = $_gc_period; + gc(); + } + return $commit; +} + +sub match_paths { + my ($self, $paths, $r) = @_; + return 1 if $self->{path} eq ''; + if (my $path = $paths->{"/$self->{path}"}) { + return ($path->{action} eq 'D') ? 0 : 1; + } + $self->{path_regex} ||= qr/^\/\Q$self->{path}\E\//; + if (grep /$self->{path_regex}/, keys %$paths) { + return 1; + } + my $c = ''; + foreach (split m#/#, $self->{path}) { + $c .= "/$_"; + next unless ($paths->{$c} && + ($paths->{$c}->{action} =~ /^[AR]$/)); + if ($self->ra->check_path($self->{path}, $r) == + $SVN::Node::dir) { + return 1; + } + } + return 0; +} + +sub find_parent_branch { + my ($self, $paths, $rev) = @_; + return undef unless $self->follow_parent; + unless (defined $paths) { + my $err_handler = $SVN::Error::handler; + $SVN::Error::handler = \&Git::SVN::Ra::skip_unknown_revs; + $self->ra->get_log([$self->{path}], $rev, $rev, 0, 1, 1, + sub { $paths = $_[0] }); + $SVN::Error::handler = $err_handler; + } + return undef unless defined $paths; + + # look for a parent from another branch: + my @b_path_components = split m#/#, $self->{path}; + my @a_path_components; + my $i; + while (@b_path_components) { + $i = $paths->{'/'.join('/', @b_path_components)}; + last if $i && defined $i->{copyfrom_path}; + unshift(@a_path_components, pop(@b_path_components)); + } + return undef unless defined $i && defined $i->{copyfrom_path}; + my $branch_from = $i->{copyfrom_path}; + if (@a_path_components) { + print STDERR "branch_from: $branch_from => "; + $branch_from .= '/'.join('/', @a_path_components); + print STDERR $branch_from, "\n"; + } + my $r = $i->{copyfrom_rev}; + my $repos_root = $self->ra->{repos_root}; + my $url = $self->ra->{url}; + my $new_url = $url . $branch_from; + print STDERR "Found possible branch point: ", + "$new_url => ", $self->full_url, ", $r\n" + unless $::_q > 1; + $branch_from =~ s#^/##; + my $gs = $self->other_gs($new_url, $url, + $branch_from, $r, $self->{ref_id}); + my ($r0, $parent) = $gs->find_rev_before($r, 1); + { + my ($base, $head); + if (!defined $r0 || !defined $parent) { + ($base, $head) = parse_revision_argument(0, $r); + } else { + if ($r0 < $r) { + $gs->ra->get_log([$gs->{path}], $r0 + 1, $r, 1, + 0, 1, sub { $base = $_[1] - 1 }); + } + } + if (defined $base && $base <= $r) { + $gs->fetch($base, $r); + } + ($r0, $parent) = $gs->find_rev_before($r, 1); + } + if (defined $r0 && defined $parent) { + print STDERR "Found branch parent: ($self->{ref_id}) $parent\n" + unless $::_q > 1; + my $ed; + if ($self->ra->can_do_switch) { + $self->assert_index_clean($parent); + print STDERR "Following parent with do_switch\n" + unless $::_q > 1; + # do_switch works with svn/trunk >= r22312, but that + # is not included with SVN 1.4.3 (the latest version + # at the moment), so we can't rely on it + $self->{last_rev} = $r0; + $self->{last_commit} = $parent; + $ed = Git::SVN::Fetcher->new($self, $gs->{path}); + $gs->ra->gs_do_switch($r0, $rev, $gs, + $self->full_url, $ed) + or die "SVN connection failed somewhere...\n"; + } elsif ($self->ra->trees_match($new_url, $r0, + $self->full_url, $rev)) { + print STDERR "Trees match:\n", + " $new_url\@$r0\n", + " ${\$self->full_url}\@$rev\n", + "Following parent with no changes\n" + unless $::_q > 1; + $self->tmp_index_do(sub { + command_noisy('read-tree', $parent); + }); + $self->{last_commit} = $parent; + } else { + print STDERR "Following parent with do_update\n" + unless $::_q > 1; + $ed = Git::SVN::Fetcher->new($self); + $self->ra->gs_do_update($rev, $rev, $self, $ed) + or die "SVN connection failed somewhere...\n"; + } + print STDERR "Successfully followed parent\n" unless $::_q > 1; + return $self->make_log_entry($rev, [$parent], $ed); + } + return undef; +} + +sub do_fetch { + my ($self, $paths, $rev) = @_; + my $ed; + my ($last_rev, @parents); + if (my $lc = $self->last_commit) { + # we can have a branch that was deleted, then re-added + # under the same name but copied from another path, in + # which case we'll have multiple parents (we don't + # want to break the original ref, nor lose copypath info): + if (my $log_entry = $self->find_parent_branch($paths, $rev)) { + push @{$log_entry->{parents}}, $lc; + return $log_entry; + } + $ed = Git::SVN::Fetcher->new($self); + $last_rev = $self->{last_rev}; + $ed->{c} = $lc; + @parents = ($lc); + } else { + $last_rev = $rev; + if (my $log_entry = $self->find_parent_branch($paths, $rev)) { + return $log_entry; + } + $ed = Git::SVN::Fetcher->new($self); + } + unless ($self->ra->gs_do_update($last_rev, $rev, $self, $ed)) { + die "SVN connection failed somewhere...\n"; + } + $self->make_log_entry($rev, \@parents, $ed); +} + +sub mkemptydirs { + my ($self, $r) = @_; + + sub scan { + my ($r, $empty_dirs, $line) = @_; + if (defined $r && $line =~ /^r(\d+)$/) { + return 0 if $1 > $r; + } elsif ($line =~ /^ \+empty_dir: (.+)$/) { + $empty_dirs->{$1} = 1; + } elsif ($line =~ /^ \-empty_dir: (.+)$/) { + my @d = grep {m[^\Q$1\E(/|$)]} (keys %$empty_dirs); + delete @$empty_dirs{@d}; + } + 1; # continue + }; + + my %empty_dirs = (); + my $gz_file = "$self->{dir}/unhandled.log.gz"; + if (-f $gz_file) { + if (!can_compress()) { + warn "Compress::Zlib could not be found; ", + "empty directories in $gz_file will not be read\n"; + } else { + my $gz = Compress::Zlib::gzopen($gz_file, "rb") or + die "Unable to open $gz_file: $!\n"; + my $line; + while ($gz->gzreadline($line) > 0) { + scan($r, \%empty_dirs, $line) or last; + } + $gz->gzclose; + } + } + + if (open my $fh, '<', "$self->{dir}/unhandled.log") { + binmode $fh or croak "binmode: $!"; + while (<$fh>) { + scan($r, \%empty_dirs, $_) or last; + } + close $fh; + } + + my $strip = qr/\A\Q$self->{path}\E(?:\/|$)/; + foreach my $d (sort keys %empty_dirs) { + $d = uri_decode($d); + $d =~ s/$strip//; + next unless length($d); + next if -d $d; + if (-e $d) { + warn "$d exists but is not a directory\n"; + } else { + print "creating empty directory: $d\n"; + mkpath([$d]); + } + } +} + +sub get_untracked { + my ($self, $ed) = @_; + my @out; + my $h = $ed->{empty}; + foreach (sort keys %$h) { + my $act = $h->{$_} ? '+empty_dir' : '-empty_dir'; + push @out, " $act: " . uri_encode($_); + warn "W: $act: $_\n"; + } + foreach my $t (qw/dir_prop file_prop/) { + $h = $ed->{$t} or next; + foreach my $path (sort keys %$h) { + my $ppath = $path eq '' ? '.' : $path; + foreach my $prop (sort keys %{$h->{$path}}) { + next if $SKIP_PROP{$prop}; + my $v = $h->{$path}->{$prop}; + my $t_ppath_prop = "$t: " . + uri_encode($ppath) . ' ' . + uri_encode($prop); + if (defined $v) { + push @out, " +$t_ppath_prop " . + uri_encode($v); + } else { + push @out, " -$t_ppath_prop"; + } + } + } + } + foreach my $t (qw/absent_file absent_directory/) { + $h = $ed->{$t} or next; + foreach my $parent (sort keys %$h) { + foreach my $path (sort @{$h->{$parent}}) { + push @out, " $t: " . + uri_encode("$parent/$path"); + warn "W: $t: $parent/$path ", + "Insufficient permissions?\n"; + } + } + } + \@out; +} + +sub get_tz { + # some systmes don't handle or mishandle %z, so be creative. + my $t = shift || time; + my $gm = timelocal(gmtime($t)); + my $sign = qw( + + - )[ $t <=> $gm ]; + return sprintf("%s%02d%02d", $sign, (gmtime(abs($t - $gm)))[2,1]); +} + +# parse_svn_date(DATE) +# -------------------- +# Given a date (in UTC) from Subversion, return a string in the format +# "<TZ Offset> <local date/time>" that Git will use. +# +# By default the parsed date will be in UTC; if $Git::SVN::_localtime +# is true we'll convert it to the local timezone instead. +sub parse_svn_date { + my $date = shift || return '+0000 1970-01-01 00:00:00'; + my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T + (\d\d)\:(\d\d)\:(\d\d)\.\d*Z$/x) or + croak "Unable to parse date: $date\n"; + my $parsed_date; # Set next. + + if ($Git::SVN::_localtime) { + # Translate the Subversion datetime to an epoch time. + # Begin by switching ourselves to $date's timezone, UTC. + my $old_env_TZ = $ENV{TZ}; + $ENV{TZ} = 'UTC'; + + my $epoch_in_UTC = + POSIX::strftime('%s', $S, $M, $H, $d, $m - 1, $Y - 1900); + + # Determine our local timezone (including DST) at the + # time of $epoch_in_UTC. $Git::SVN::Log::TZ stored the + # value of TZ, if any, at the time we were run. + if (defined $Git::SVN::Log::TZ) { + $ENV{TZ} = $Git::SVN::Log::TZ; + } else { + delete $ENV{TZ}; + } + + my $our_TZ = get_tz(); + + # This converts $epoch_in_UTC into our local timezone. + my ($sec, $min, $hour, $mday, $mon, $year, + $wday, $yday, $isdst) = localtime($epoch_in_UTC); + + $parsed_date = sprintf('%s %04d-%02d-%02d %02d:%02d:%02d', + $our_TZ, $year + 1900, $mon + 1, + $mday, $hour, $min, $sec); + + # Reset us to the timezone in effect when we entered + # this routine. + if (defined $old_env_TZ) { + $ENV{TZ} = $old_env_TZ; + } else { + delete $ENV{TZ}; + } + } else { + $parsed_date = "+0000 $Y-$m-$d $H:$M:$S"; + } + + return $parsed_date; +} + +sub other_gs { + my ($self, $new_url, $url, + $branch_from, $r, $old_ref_id) = @_; + my $gs = Git::SVN->find_by_url($new_url, $url, $branch_from); + unless ($gs) { + my $ref_id = $old_ref_id; + $ref_id =~ s/\@\d+-*$//; + $ref_id .= "\@$r"; + # just grow a tail if we're not unique enough :x + $ref_id .= '-' while find_ref($ref_id); + my ($u, $p, $repo_id) = ($new_url, '', $ref_id); + if ($u =~ s#^\Q$url\E(/|$)##) { + $p = $u; + $u = $url; + $repo_id = $self->{repo_id}; + } + while (1) { + # It is possible to tag two different subdirectories at + # the same revision. If the url for an existing ref + # does not match, we must either find a ref with a + # matching url or create a new ref by growing a tail. + $gs = Git::SVN->init($u, $p, $repo_id, $ref_id, 1); + my (undef, $max_commit) = $gs->rev_map_max(1); + last if (!$max_commit); + my ($url) = ::cmt_metadata($max_commit); + last if ($url eq $gs->metadata_url); + $ref_id .= '-'; + } + print STDERR "Initializing parent: $ref_id\n" unless $::_q > 1; + } + $gs +} + +sub call_authors_prog { + my ($orig_author) = @_; + $orig_author = command_oneline('rev-parse', '--sq-quote', $orig_author); + my $author = `$::_authors_prog $orig_author`; + if ($? != 0) { + die "$::_authors_prog failed with exit code $?\n" + } + if ($author =~ /^\s*(.+?)\s*<(.*)>\s*$/) { + my ($name, $email) = ($1, $2); + $email = undef if length $2 == 0; + return [$name, $email]; + } else { + die "Author: $orig_author: $::_authors_prog returned " + . "invalid author format: $author\n"; + } +} + +sub check_author { + my ($author) = @_; + if (!defined $author || length $author == 0) { + $author = '(no author)'; + } + if (!defined $::users{$author}) { + if (defined $::_authors_prog) { + $::users{$author} = call_authors_prog($author); + } elsif (defined $::_authors) { + die "Author: $author not defined in $::_authors file\n"; + } + } + $author; +} + +sub find_extra_svk_parents { + my ($self, $ed, $tickets, $parents) = @_; + # aha! svk:merge property changed... + my @tickets = split "\n", $tickets; + my @known_parents; + for my $ticket ( @tickets ) { + my ($uuid, $path, $rev) = split /:/, $ticket; + if ( $uuid eq $self->ra_uuid ) { + my $url = $self->{url}; + my $repos_root = $url; + my $branch_from = $path; + $branch_from =~ s{^/}{}; + my $gs = $self->other_gs($repos_root."/".$branch_from, + $url, + $branch_from, + $rev, + $self->{ref_id}); + if ( my $commit = $gs->rev_map_get($rev, $uuid) ) { + # wahey! we found it, but it might be + # an old one (!) + push @known_parents, [ $rev, $commit ]; + } + } + } + # Ordering matters; highest-numbered commit merge tickets + # first, as they may account for later merge ticket additions + # or changes. + @known_parents = map {$_->[1]} sort {$b->[0] <=> $a->[0]} @known_parents; + for my $parent ( @known_parents ) { + my @cmd = ('rev-list', $parent, map { "^$_" } @$parents ); + my ($msg_fh, $ctx) = command_output_pipe(@cmd); + my $new; + while ( <$msg_fh> ) { + $new=1;last; + } + command_close_pipe($msg_fh, $ctx); + if ( $new ) { + print STDERR + "Found merge parent (svk:merge ticket): $parent\n"; + push @$parents, $parent; + } + } +} + +sub lookup_svn_merge { + my $uuid = shift; + my $url = shift; + my $merge = shift; + + my ($source, $revs) = split ":", $merge; + my $path = $source; + $path =~ s{^/}{}; + my $gs = Git::SVN->find_by_url($url.$source, $url, $path); + if ( !$gs ) { + warn "Couldn't find revmap for $url$source\n"; + return; + } + my @ranges = split ",", $revs; + my ($tip, $tip_commit); + my @merged_commit_ranges; + # find the tip + for my $range ( @ranges ) { + my ($bottom, $top) = split "-", $range; + $top ||= $bottom; + my $bottom_commit = $gs->find_rev_after( $bottom, 1, $top ); + my $top_commit = $gs->find_rev_before( $top, 1, $bottom ); + + unless ($top_commit and $bottom_commit) { + warn "W:unknown path/rev in svn:mergeinfo " + ."dirprop: $source:$range\n"; + next; + } + + if (scalar(command('rev-parse', "$bottom_commit^@"))) { + push @merged_commit_ranges, + "$bottom_commit^..$top_commit"; + } else { + push @merged_commit_ranges, "$top_commit"; + } + + if ( !defined $tip or $top > $tip ) { + $tip = $top; + $tip_commit = $top_commit; + } + } + return ($tip_commit, @merged_commit_ranges); +} + +sub _rev_list { + my ($msg_fh, $ctx) = command_output_pipe( + "rev-list", @_, + ); + my @rv; + while ( <$msg_fh> ) { + chomp; + push @rv, $_; + } + command_close_pipe($msg_fh, $ctx); + @rv; +} + +sub check_cherry_pick { + my $base = shift; + my $tip = shift; + my $parents = shift; + my @ranges = @_; + my %commits = map { $_ => 1 } + _rev_list("--no-merges", $tip, "--not", $base, @$parents, "--"); + for my $range ( @ranges ) { + delete @commits{_rev_list($range, "--")}; + } + for my $commit (keys %commits) { + if (has_no_changes($commit)) { + delete $commits{$commit}; + } + } + return (keys %commits); +} + +sub has_no_changes { + my $commit = shift; + + my @revs = split / /, command_oneline( + qw(rev-list --parents -1 -m), $commit); + + # Commits with no parents, e.g. the start of a partial branch, + # have changes by definition. + return 1 if (@revs < 2); + + # Commits with multiple parents, e.g a merge, have no changes + # by definition. + return 0 if (@revs > 2); + + return (command_oneline("rev-parse", "$commit^{tree}") eq + command_oneline("rev-parse", "$commit~1^{tree}")); +} + +sub tie_for_persistent_memoization { + my $hash = shift; + my $path = shift; + + if ($can_use_yaml) { + tie %$hash => 'Git::SVN::Memoize::YAML', "$path.yaml"; + } else { + tie %$hash => 'Memoize::Storable', "$path.db", 'nstore'; + } +} + +# The GIT_DIR environment variable is not always set until after the command +# line arguments are processed, so we can't memoize in a BEGIN block. +{ + my $memoized = 0; + + sub memoize_svn_mergeinfo_functions { + return if $memoized; + $memoized = 1; + + my $cache_path = "$ENV{GIT_DIR}/svn/.caches/"; + mkpath([$cache_path]) unless -d $cache_path; + + my %lookup_svn_merge_cache; + my %check_cherry_pick_cache; + my %has_no_changes_cache; + + tie_for_persistent_memoization(\%lookup_svn_merge_cache, + "$cache_path/lookup_svn_merge"); + memoize 'lookup_svn_merge', + SCALAR_CACHE => 'FAULT', + LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache], + ; + + tie_for_persistent_memoization(\%check_cherry_pick_cache, + "$cache_path/check_cherry_pick"); + memoize 'check_cherry_pick', + SCALAR_CACHE => 'FAULT', + LIST_CACHE => ['HASH' => \%check_cherry_pick_cache], + ; + + tie_for_persistent_memoization(\%has_no_changes_cache, + "$cache_path/has_no_changes"); + memoize 'has_no_changes', + SCALAR_CACHE => ['HASH' => \%has_no_changes_cache], + LIST_CACHE => 'FAULT', + ; + } + + sub unmemoize_svn_mergeinfo_functions { + return if not $memoized; + $memoized = 0; + + Memoize::unmemoize 'lookup_svn_merge'; + Memoize::unmemoize 'check_cherry_pick'; + Memoize::unmemoize 'has_no_changes'; + } + + Memoize::memoize 'Git::SVN::repos_root'; +} + +END { + # Force cache writeout explicitly instead of waiting for + # global destruction to avoid segfault in Storable: + # http://rt.cpan.org/Public/Bug/Display.html?id=36087 + unmemoize_svn_mergeinfo_functions(); +} + +sub parents_exclude { + my $parents = shift; + my @commits = @_; + return unless @commits; + + my @excluded; + my $excluded; + do { + my @cmd = ('rev-list', "-1", @commits, "--not", @$parents ); + $excluded = command_oneline(@cmd); + if ( $excluded ) { + my @new; + my $found; + for my $commit ( @commits ) { + if ( $commit eq $excluded ) { + push @excluded, $commit; + $found++; + last; + } + else { + push @new, $commit; + } + } + die "saw commit '$excluded' in rev-list output, " + ."but we didn't ask for that commit (wanted: @commits --not @$parents)" + unless $found; + @commits = @new; + } + } + while ($excluded and @commits); + + return @excluded; +} + + +# note: this function should only be called if the various dirprops +# have actually changed +sub find_extra_svn_parents { + my ($self, $ed, $mergeinfo, $parents) = @_; + # aha! svk:merge property changed... + + memoize_svn_mergeinfo_functions(); + + # We first search for merged tips which are not in our + # history. Then, we figure out which git revisions are in + # that tip, but not this revision. If all of those revisions + # are now marked as merge, we can add the tip as a parent. + my @merges = split "\n", $mergeinfo; + my @merge_tips; + my $url = $self->{url}; + my $uuid = $self->ra_uuid; + my %ranges; + for my $merge ( @merges ) { + my ($tip_commit, @ranges) = + lookup_svn_merge( $uuid, $url, $merge ); + unless (!$tip_commit or + grep { $_ eq $tip_commit } @$parents ) { + push @merge_tips, $tip_commit; + $ranges{$tip_commit} = \@ranges; + } else { + push @merge_tips, undef; + } + } + + my %excluded = map { $_ => 1 } + parents_exclude($parents, grep { defined } @merge_tips); + + # check merge tips for new parents + my @new_parents; + for my $merge_tip ( @merge_tips ) { + my $spec = shift @merges; + next unless $merge_tip and $excluded{$merge_tip}; + + my $ranges = $ranges{$merge_tip}; + + # check out 'new' tips + my $merge_base; + eval { + $merge_base = command_oneline( + "merge-base", + @$parents, $merge_tip, + ); + }; + if ($@) { + die "An error occurred during merge-base" + unless $@->isa("Git::Error::Command"); + + warn "W: Cannot find common ancestor between ". + "@$parents and $merge_tip. Ignoring merge info.\n"; + next; + } + + # double check that there are no missing non-merge commits + my (@incomplete) = check_cherry_pick( + $merge_base, $merge_tip, + $parents, + @$ranges, + ); + + if ( @incomplete ) { + warn "W:svn cherry-pick ignored ($spec) - missing " + .@incomplete." commit(s) (eg $incomplete[0])\n"; + } else { + warn + "Found merge parent (svn:mergeinfo prop): ", + $merge_tip, "\n"; + push @new_parents, $merge_tip; + } + } + + # cater for merges which merge commits from multiple branches + if ( @new_parents > 1 ) { + for ( my $i = 0; $i <= $#new_parents; $i++ ) { + for ( my $j = 0; $j <= $#new_parents; $j++ ) { + next if $i == $j; + next unless $new_parents[$i]; + next unless $new_parents[$j]; + my $revs = command_oneline( + "rev-list", "-1", + "$new_parents[$i]..$new_parents[$j]", + ); + if ( !$revs ) { + undef($new_parents[$j]); + } + } + } + } + push @$parents, grep { defined } @new_parents; +} + +sub make_log_entry { + my ($self, $rev, $parents, $ed) = @_; + my $untracked = $self->get_untracked($ed); + + my @parents = @$parents; + my $ps = $ed->{path_strip} || ""; + for my $path ( grep { m/$ps/ } %{$ed->{dir_prop}} ) { + my $props = $ed->{dir_prop}{$path}; + if ( $props->{"svk:merge"} ) { + $self->find_extra_svk_parents + ($ed, $props->{"svk:merge"}, \@parents); + } + if ( $props->{"svn:mergeinfo"} ) { + $self->find_extra_svn_parents + ($ed, + $props->{"svn:mergeinfo"}, + \@parents); + } + } + + open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!; + print $un "r$rev\n" or croak $!; + print $un $_, "\n" foreach @$untracked; + my %log_entry = ( parents => \@parents, revision => $rev, + log => ''); + + my $headrev; + my $logged = delete $self->{logged_rev_props}; + if (!$logged || $self->{-want_revprops}) { + my $rp = $self->ra->rev_proplist($rev); + foreach (sort keys %$rp) { + my $v = $rp->{$_}; + if (/^svn:(author|date|log)$/) { + $log_entry{$1} = $v; + } elsif ($_ eq 'svm:headrev') { + $headrev = $v; + } else { + print $un " rev_prop: ", uri_encode($_), ' ', + uri_encode($v), "\n"; + } + } + } else { + map { $log_entry{$_} = $logged->{$_} } keys %$logged; + } + close $un or croak $!; + + $log_entry{date} = parse_svn_date($log_entry{date}); + $log_entry{log} .= "\n"; + my $author = $log_entry{author} = check_author($log_entry{author}); + my ($name, $email) = defined $::users{$author} ? @{$::users{$author}} + : ($author, undef); + + my ($commit_name, $commit_email) = ($name, $email); + if ($_use_log_author) { + my $name_field; + if ($log_entry{log} =~ /From:\s+(.*\S)\s*\n/i) { + $name_field = $1; + } elsif ($log_entry{log} =~ /Signed-off-by:\s+(.*\S)\s*\n/i) { + $name_field = $1; + } + if (!defined $name_field) { + if (!defined $email) { + $email = $name; + } + } elsif ($name_field =~ /(.*?)\s+<(.*)>/) { + ($name, $email) = ($1, $2); + } elsif ($name_field =~ /(.*)@/) { + ($name, $email) = ($1, $name_field); + } else { + ($name, $email) = ($name_field, $name_field); + } + } + if (defined $headrev && $self->use_svm_props) { + if ($self->rewrite_root) { + die "Can't have both 'useSvmProps' and 'rewriteRoot' ", + "options set!\n"; + } + if ($self->rewrite_uuid) { + die "Can't have both 'useSvmProps' and 'rewriteUUID' ", + "options set!\n"; + } + my ($uuid, $r) = $headrev =~ m{^([a-f\d\-]{30,}):(\d+)$}i; + # we don't want "SVM: initializing mirror for junk" ... + return undef if $r == 0; + my $svm = $self->svm; + if ($uuid ne $svm->{uuid}) { + die "UUID mismatch on SVM path:\n", + "expected: $svm->{uuid}\n", + " got: $uuid\n"; + } + my $full_url = $self->full_url; + $full_url =~ s#^\Q$svm->{replace}\E(/|$)#$svm->{source}$1# or + die "Failed to replace '$svm->{replace}' with ", + "'$svm->{source}' in $full_url\n"; + # throw away username for storing in records + remove_username($full_url); + $log_entry{metadata} = "$full_url\@$r $uuid"; + $log_entry{svm_revision} = $r; + $email ||= "$author\@$uuid"; + $commit_email ||= "$author\@$uuid"; + } elsif ($self->use_svnsync_props) { + my $full_url = $self->svnsync->{url}; + $full_url .= "/$self->{path}" if length $self->{path}; + remove_username($full_url); + my $uuid = $self->svnsync->{uuid}; + $log_entry{metadata} = "$full_url\@$rev $uuid"; + $email ||= "$author\@$uuid"; + $commit_email ||= "$author\@$uuid"; + } else { + my $url = $self->metadata_url; + remove_username($url); + my $uuid = $self->rewrite_uuid || $self->ra->get_uuid; + $log_entry{metadata} = "$url\@$rev " . $uuid; + $email ||= "$author\@" . $uuid; + $commit_email ||= "$author\@" . $uuid; + } + $log_entry{name} = $name; + $log_entry{email} = $email; + $log_entry{commit_name} = $commit_name; + $log_entry{commit_email} = $commit_email; + \%log_entry; +} + +sub fetch { + my ($self, $min_rev, $max_rev, @parents) = @_; + my ($last_rev, $last_commit) = $self->last_rev_commit; + my ($base, $head) = $self->get_fetch_range($min_rev, $max_rev); + $self->ra->gs_fetch_loop_common($base, $head, [$self]); +} + +sub set_tree_cb { + my ($self, $log_entry, $tree, $rev, $date, $author) = @_; + $self->{inject_parents} = { $rev => $tree }; + $self->fetch(undef, undef); +} + +sub set_tree { + my ($self, $tree) = (shift, shift); + my $log_entry = ::get_commit_entry($tree); + unless ($self->{last_rev}) { + fatal("Must have an existing revision to commit"); + } + my %ed_opts = ( r => $self->{last_rev}, + log => $log_entry->{log}, + ra => $self->ra, + tree_a => $self->{last_commit}, + tree_b => $tree, + editor_cb => sub { + $self->set_tree_cb($log_entry, $tree, @_) }, + svn_path => $self->{path} ); + if (!Git::SVN::Editor->new(\%ed_opts)->apply_diff) { + print "No changes\nr$self->{last_rev} = $tree\n"; + } +} + +sub rebuild_from_rev_db { + my ($self, $path) = @_; + my $r = -1; + open my $fh, '<', $path or croak "open: $!"; + binmode $fh or croak "binmode: $!"; + while (<$fh>) { + length($_) == 41 or croak "inconsistent size in ($_) != 41"; + chomp($_); + ++$r; + next if $_ eq ('0' x 40); + $self->rev_map_set($r, $_); + print "r$r = $_\n"; + } + close $fh or croak "close: $!"; + unlink $path or croak "unlink: $!"; +} + +sub rebuild { + my ($self) = @_; + my $map_path = $self->map_path; + my $partial = (-e $map_path && ! -z $map_path); + return unless ::verify_ref($self->refname.'^0'); + if (!$partial && ($self->use_svm_props || $self->no_metadata)) { + my $rev_db = $self->rev_db_path; + $self->rebuild_from_rev_db($rev_db); + if ($self->use_svm_props) { + my $svm_rev_db = $self->rev_db_path($self->svm_uuid); + $self->rebuild_from_rev_db($svm_rev_db); + } + $self->unlink_rev_db_symlink; + return; + } + print "Rebuilding $map_path ...\n" if (!$partial); + my ($base_rev, $head) = ($partial ? $self->rev_map_max_norebuild(1) : + (undef, undef)); + my ($log, $ctx) = + command_output_pipe(qw/rev-list --pretty=raw --reverse/, + ($head ? "$head.." : "") . $self->refname, + '--'); + my $metadata_url = $self->metadata_url; + remove_username($metadata_url); + my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid; + my $c; + while (<$log>) { + if ( m{^commit ($::sha1)$} ) { + $c = $1; + next; + } + next unless s{^\s*(git-svn-id:)}{$1}; + my ($url, $rev, $uuid) = ::extract_metadata($_); + remove_username($url); + + # ignore merges (from set-tree) + next if (!defined $rev || !$uuid); + + # if we merged or otherwise started elsewhere, this is + # how we break out of it + if (($uuid ne $svn_uuid) || + ($metadata_url && $url && ($url ne $metadata_url))) { + next; + } + if ($partial && $head) { + print "Partial-rebuilding $map_path ...\n"; + print "Currently at $base_rev = $head\n"; + $head = undef; + } + + $self->rev_map_set($rev, $c); + print "r$rev = $c\n"; + } + command_close_pipe($log, $ctx); + print "Done rebuilding $map_path\n" if (!$partial || !$head); + my $rev_db_path = $self->rev_db_path; + if (-f $self->rev_db_path) { + unlink $self->rev_db_path or croak "unlink: $!"; + } + $self->unlink_rev_db_symlink; +} + +# rev_map: +# Tie::File seems to be prone to offset errors if revisions get sparse, +# it's not that fast, either. Tie::File is also not in Perl 5.6. So +# one of my favorite modules is out :< Next up would be one of the DBM +# modules, but I'm not sure which is most portable... +# +# This is the replacement for the rev_db format, which was too big +# and inefficient for large repositories with a lot of sparse history +# (mainly tags) +# +# The format is this: +# - 24 bytes for every record, +# * 4 bytes for the integer representing an SVN revision number +# * 20 bytes representing the sha1 of a git commit +# - No empty padding records like the old format +# (except the last record, which can be overwritten) +# - new records are written append-only since SVN revision numbers +# increase monotonically +# - lookups on SVN revision number are done via a binary search +# - Piping the file to xxd -c24 is a good way of dumping it for +# viewing or editing (piped back through xxd -r), should the need +# ever arise. +# - The last record can be padding revision with an all-zero sha1 +# This is used to optimize fetch performance when using multiple +# "fetch" directives in .git/config +# +# These files are disposable unless noMetadata or useSvmProps is set + +sub _rev_map_set { + my ($fh, $rev, $commit) = @_; + + binmode $fh or croak "binmode: $!"; + my $size = (stat($fh))[7]; + ($size % 24) == 0 or croak "inconsistent size: $size"; + + my $wr_offset = 0; + if ($size > 0) { + sysseek($fh, -24, SEEK_END) or croak "seek: $!"; + my $read = sysread($fh, my $buf, 24) or croak "read: $!"; + $read == 24 or croak "read only $read bytes (!= 24)"; + my ($last_rev, $last_commit) = unpack(rev_map_fmt, $buf); + if ($last_commit eq ('0' x40)) { + if ($size >= 48) { + sysseek($fh, -48, SEEK_END) or croak "seek: $!"; + $read = sysread($fh, $buf, 24) or + croak "read: $!"; + $read == 24 or + croak "read only $read bytes (!= 24)"; + ($last_rev, $last_commit) = + unpack(rev_map_fmt, $buf); + if ($last_commit eq ('0' x40)) { + croak "inconsistent .rev_map\n"; + } + } + if ($last_rev >= $rev) { + croak "last_rev is higher!: $last_rev >= $rev"; + } + $wr_offset = -24; + } + } + sysseek($fh, $wr_offset, SEEK_END) or croak "seek: $!"; + syswrite($fh, pack(rev_map_fmt, $rev, $commit), 24) == 24 or + croak "write: $!"; +} + +sub _rev_map_reset { + my ($fh, $rev, $commit) = @_; + my $c = _rev_map_get($fh, $rev); + $c eq $commit or die "_rev_map_reset(@_) commit $c does not match!\n"; + my $offset = sysseek($fh, 0, SEEK_CUR) or croak "seek: $!"; + truncate $fh, $offset or croak "truncate: $!"; +} + +sub mkfile { + my ($path) = @_; + unless (-e $path) { + my ($dir, $base) = ($path =~ m#^(.*?)/?([^/]+)$#); + mkpath([$dir]) unless -d $dir; + open my $fh, '>>', $path or die "Couldn't create $path: $!\n"; + close $fh or die "Couldn't close (create) $path: $!\n"; + } +} + +sub rev_map_set { + my ($self, $rev, $commit, $update_ref, $uuid) = @_; + defined $commit or die "missing arg3\n"; + length $commit == 40 or die "arg3 must be a full SHA1 hexsum\n"; + my $db = $self->map_path($uuid); + my $db_lock = "$db.lock"; + my $sigmask; + $update_ref ||= 0; + if ($update_ref) { + $sigmask = POSIX::SigSet->new(); + my $signew = POSIX::SigSet->new(SIGINT, SIGHUP, SIGTERM, + SIGALRM, SIGUSR1, SIGUSR2); + sigprocmask(SIG_BLOCK, $signew, $sigmask) or + croak "Can't block signals: $!"; + } + mkfile($db); + + $LOCKFILES{$db_lock} = 1; + my $sync; + # both of these options make our .rev_db file very, very important + # and we can't afford to lose it because rebuild() won't work + if ($self->use_svm_props || $self->no_metadata) { + $sync = 1; + copy($db, $db_lock) or die "rev_map_set(@_): ", + "Failed to copy: ", + "$db => $db_lock ($!)\n"; + } else { + rename $db, $db_lock or die "rev_map_set(@_): ", + "Failed to rename: ", + "$db => $db_lock ($!)\n"; + } + + sysopen(my $fh, $db_lock, O_RDWR | O_CREAT) + or croak "Couldn't open $db_lock: $!\n"; + $update_ref eq 'reset' ? _rev_map_reset($fh, $rev, $commit) : + _rev_map_set($fh, $rev, $commit); + if ($sync) { + $fh->flush or die "Couldn't flush $db_lock: $!\n"; + $fh->sync or die "Couldn't sync $db_lock: $!\n"; + } + close $fh or croak $!; + if ($update_ref) { + $_head = $self; + my $note = ""; + $note = " ($update_ref)" if ($update_ref !~ /^\d*$/); + command_noisy('update-ref', '-m', "r$rev$note", + $self->refname, $commit); + } + rename $db_lock, $db or die "rev_map_set(@_): ", "Failed to rename: ", + "$db_lock => $db ($!)\n"; + delete $LOCKFILES{$db_lock}; + if ($update_ref) { + sigprocmask(SIG_SETMASK, $sigmask) or + croak "Can't restore signal mask: $!"; + } +} + +# If want_commit, this will return an array of (rev, commit) where +# commit _must_ be a valid commit in the archive. +# Otherwise, it'll return the max revision (whether or not the +# commit is valid or just a 0x40 placeholder). +sub rev_map_max { + my ($self, $want_commit) = @_; + $self->rebuild; + my ($r, $c) = $self->rev_map_max_norebuild($want_commit); + $want_commit ? ($r, $c) : $r; +} + +sub rev_map_max_norebuild { + my ($self, $want_commit) = @_; + my $map_path = $self->map_path; + stat $map_path or return $want_commit ? (0, undef) : 0; + sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!"; + binmode $fh or croak "binmode: $!"; + my $size = (stat($fh))[7]; + ($size % 24) == 0 or croak "inconsistent size: $size"; + + if ($size == 0) { + close $fh or croak "close: $!"; + return $want_commit ? (0, undef) : 0; + } + + sysseek($fh, -24, SEEK_END) or croak "seek: $!"; + sysread($fh, my $buf, 24) == 24 or croak "read: $!"; + my ($r, $c) = unpack(rev_map_fmt, $buf); + if ($want_commit && $c eq ('0' x40)) { + if ($size < 48) { + return $want_commit ? (0, undef) : 0; + } + sysseek($fh, -48, SEEK_END) or croak "seek: $!"; + sysread($fh, $buf, 24) == 24 or croak "read: $!"; + ($r, $c) = unpack(rev_map_fmt, $buf); + if ($c eq ('0'x40)) { + croak "Penultimate record is all-zeroes in $map_path"; + } + } + close $fh or croak "close: $!"; + $want_commit ? ($r, $c) : $r; +} + +sub rev_map_get { + my ($self, $rev, $uuid) = @_; + my $map_path = $self->map_path($uuid); + return undef unless -e $map_path; + + sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!"; + my $c = _rev_map_get($fh, $rev); + close($fh) or croak "close: $!"; + $c +} + +sub _rev_map_get { + my ($fh, $rev) = @_; + + binmode $fh or croak "binmode: $!"; + my $size = (stat($fh))[7]; + ($size % 24) == 0 or croak "inconsistent size: $size"; + + if ($size == 0) { + return undef; + } + + my ($l, $u) = (0, $size - 24); + my ($r, $c, $buf); + + while ($l <= $u) { + my $i = int(($l/24 + $u/24) / 2) * 24; + sysseek($fh, $i, SEEK_SET) or croak "seek: $!"; + sysread($fh, my $buf, 24) == 24 or croak "read: $!"; + my ($r, $c) = unpack(rev_map_fmt, $buf); + + if ($r < $rev) { + $l = $i + 24; + } elsif ($r > $rev) { + $u = $i - 24; + } else { # $r == $rev + return $c eq ('0' x 40) ? undef : $c; + } + } + undef; +} + +# Finds the first svn revision that exists on (if $eq_ok is true) or +# before $rev for the current branch. It will not search any lower +# than $min_rev. Returns the git commit hash and svn revision number +# if found, else (undef, undef). +sub find_rev_before { + my ($self, $rev, $eq_ok, $min_rev) = @_; + --$rev unless $eq_ok; + $min_rev ||= 1; + my $max_rev = $self->rev_map_max; + $rev = $max_rev if ($rev > $max_rev); + while ($rev >= $min_rev) { + if (my $c = $self->rev_map_get($rev)) { + return ($rev, $c); + } + --$rev; + } + return (undef, undef); +} + +# Finds the first svn revision that exists on (if $eq_ok is true) or +# after $rev for the current branch. It will not search any higher +# than $max_rev. Returns the git commit hash and svn revision number +# if found, else (undef, undef). +sub find_rev_after { + my ($self, $rev, $eq_ok, $max_rev) = @_; + ++$rev unless $eq_ok; + $max_rev ||= $self->rev_map_max; + while ($rev <= $max_rev) { + if (my $c = $self->rev_map_get($rev)) { + return ($rev, $c); + } + ++$rev; + } + return (undef, undef); +} + +sub _new { + my ($class, $repo_id, $ref_id, $path) = @_; + unless (defined $repo_id && length $repo_id) { + $repo_id = $default_repo_id; + } + unless (defined $ref_id && length $ref_id) { + # Access the prefix option from the git-svn main program if it's loaded. + my $prefix = defined &::opt_prefix ? ::opt_prefix() : ""; + $_[2] = $ref_id = + "refs/remotes/$prefix$default_ref_id"; + } + $_[1] = $repo_id; + my $dir = "$ENV{GIT_DIR}/svn/$ref_id"; + + # Older repos imported by us used $GIT_DIR/svn/foo instead of + # $GIT_DIR/svn/refs/remotes/foo when tracking refs/remotes/foo + if ($ref_id =~ m{^refs/remotes/(.*)}) { + my $old_dir = "$ENV{GIT_DIR}/svn/$1"; + if (-d $old_dir && ! -d $dir) { + $dir = $old_dir; + } + } + + $_[3] = $path = '' unless (defined $path); + mkpath([$dir]); + bless { + ref_id => $ref_id, dir => $dir, index => "$dir/index", + path => $path, config => "$ENV{GIT_DIR}/svn/config", + map_root => "$dir/.rev_map", repo_id => $repo_id }, $class; +} + +# for read-only access of old .rev_db formats +sub unlink_rev_db_symlink { + my ($self) = @_; + my $link = $self->rev_db_path; + $link =~ s/\.[\w-]+$// or croak "missing UUID at the end of $link"; + if (-l $link) { + unlink $link or croak "unlink: $link failed!"; + } +} + +sub rev_db_path { + my ($self, $uuid) = @_; + my $db_path = $self->map_path($uuid); + $db_path =~ s{/\.rev_map\.}{/\.rev_db\.} + or croak "map_path: $db_path does not contain '/.rev_map.' !"; + $db_path; +} + +# the new replacement for .rev_db +sub map_path { + my ($self, $uuid) = @_; + $uuid ||= $self->ra_uuid; + "$self->{map_root}.$uuid"; +} + +sub uri_encode { + my ($f) = @_; + $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg; + $f +} + +sub uri_decode { + my ($f) = @_; + $f =~ s#%([0-9a-fA-F]{2})#chr(hex($1))#eg; + $f +} + +sub remove_username { + $_[0] =~ s{^([^:]*://)[^@]+@}{$1}; +} + +1; diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm index ef8e9ed2a..76fae9bce 100644 --- a/perl/Git/SVN/Fetcher.pm +++ b/perl/Git/SVN/Fetcher.pm @@ -57,6 +57,7 @@ sub new { $self->{file_prop} = {}; $self->{absent_dir} = {}; $self->{absent_file} = {}; + require Git::IndexInfo; $self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new }); $self->{pathnameencoding} = Git::config('svn.pathnameencoding'); $self; diff --git a/perl/Git/SVN/GlobSpec.pm b/perl/Git/SVN/GlobSpec.pm new file mode 100644 index 000000000..96cfd9896 --- /dev/null +++ b/perl/Git/SVN/GlobSpec.pm @@ -0,0 +1,59 @@ +package Git::SVN::GlobSpec; +use strict; +use warnings; + +sub new { + my ($class, $glob, $pattern_ok) = @_; + my $re = $glob; + $re =~ s!/+$!!g; # no need for trailing slashes + my (@left, @right, @patterns); + my $state = "left"; + my $die_msg = "Only one set of wildcard directories " . + "(e.g. '*' or '*/*/*') is supported: '$glob'\n"; + for my $part (split(m|/|, $glob)) { + if ($part =~ /\*/ && $part ne "*") { + die "Invalid pattern in '$glob': $part\n"; + } elsif ($pattern_ok && $part =~ /[{}]/ && + $part !~ /^\{[^{}]+\}/) { + die "Invalid pattern in '$glob': $part\n"; + } + if ($part eq "*") { + die $die_msg if $state eq "right"; + $state = "pattern"; + push(@patterns, "[^/]*"); + } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) { + die $die_msg if $state eq "right"; + $state = "pattern"; + my $p = quotemeta($1); + $p =~ s/\\,/|/g; + push(@patterns, "(?:$p)"); + } else { + if ($state eq "left") { + push(@left, $part); + } else { + push(@right, $part); + $state = "right"; + } + } + } + my $depth = @patterns; + if ($depth == 0) { + die "One '*' is needed in glob: '$glob'\n"; + } + my $left = join('/', @left); + my $right = join('/', @right); + $re = join('/', @patterns); + $re = join('\/', + grep(length, quotemeta($left), "($re)", quotemeta($right))); + my $left_re = qr/^\/\Q$left\E(\/|$)/; + bless { left => $left, right => $right, left_regex => $left_re, + regex => qr/$re/, glob => $glob, depth => $depth }, $class; +} + +sub full_path { + my ($self, $path) = @_; + return (length $self->{left} ? "$self->{left}/" : '') . + $path . (length $self->{right} ? "/$self->{right}" : ''); +} + +1; diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm new file mode 100644 index 000000000..3cc1c6f08 --- /dev/null +++ b/perl/Git/SVN/Log.pm @@ -0,0 +1,395 @@ +package Git::SVN::Log; +use strict; +use warnings; +use Git::SVN::Utils qw(fatal); +use Git qw(command command_oneline command_output_pipe command_close_pipe); +use POSIX qw/strftime/; +use constant commit_log_separator => ('-' x 72) . "\n"; +use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline + %rusers $show_commit $incremental/; + +# Option set in git-svn +our $_git_format; + +sub cmt_showable { + my ($c) = @_; + return 1 if defined $c->{r}; + + # big commit message got truncated by the 16k pretty buffer in rev-list + if ($c->{l} && $c->{l}->[-1] eq "...\n" && + $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) { + @{$c->{l}} = (); + my @log = command(qw/cat-file commit/, $c->{c}); + + # shift off the headers + shift @log while ($log[0] ne ''); + shift @log; + + # TODO: make $c->{l} not have a trailing newline in the future + @{$c->{l}} = map { "$_\n" } grep !/^git-svn-id: /, @log; + + (undef, $c->{r}, undef) = ::extract_metadata( + (grep(/^git-svn-id: /, @log))[-1]); + } + return defined $c->{r}; +} + +sub log_use_color { + return $color || Git->repository->get_colorbool('color.diff'); +} + +sub git_svn_log_cmd { + my ($r_min, $r_max, @args) = @_; + my $head = 'HEAD'; + my (@files, @log_opts); + foreach my $x (@args) { + if ($x eq '--' || @files) { + push @files, $x; + } else { + if (::verify_ref("$x^0")) { + $head = $x; + } else { + push @log_opts, $x; + } + } + } + + my ($url, $rev, $uuid, $gs) = ::working_head_info($head); + + require Git::SVN; + $gs ||= Git::SVN->_new; + my @cmd = (qw/log --abbrev-commit --pretty=raw --default/, + $gs->refname); + push @cmd, '-r' unless $non_recursive; + push @cmd, qw/--raw --name-status/ if $verbose; + push @cmd, '--color' if log_use_color(); + push @cmd, @log_opts; + if (defined $r_max && $r_max == $r_min) { + push @cmd, '--max-count=1'; + if (my $c = $gs->rev_map_get($r_max)) { + push @cmd, $c; + } + } elsif (defined $r_max) { + if ($r_max < $r_min) { + ($r_min, $r_max) = ($r_max, $r_min); + } + my (undef, $c_max) = $gs->find_rev_before($r_max, 1, $r_min); + my (undef, $c_min) = $gs->find_rev_after($r_min, 1, $r_max); + # If there are no commits in the range, both $c_max and $c_min + # will be undefined. If there is at least 1 commit in the + # range, both will be defined. + return () if !defined $c_min || !defined $c_max; + if ($c_min eq $c_max) { + push @cmd, '--max-count=1', $c_min; + } else { + push @cmd, '--boundary', "$c_min..$c_max"; + } + } + return (@cmd, @files); +} + +# adapted from pager.c +sub config_pager { + if (! -t *STDOUT) { + $ENV{GIT_PAGER_IN_USE} = 'false'; + $pager = undef; + return; + } + chomp($pager = command_oneline(qw(var GIT_PAGER))); + if ($pager eq 'cat') { + $pager = undef; + } + $ENV{GIT_PAGER_IN_USE} = defined($pager); +} + +sub run_pager { + return unless defined $pager; + pipe my ($rfd, $wfd) or return; + defined(my $pid = fork) or fatal "Can't fork: $!"; + if (!$pid) { + open STDOUT, '>&', $wfd or + fatal "Can't redirect to stdout: $!"; + return; + } + open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!"; + $ENV{LESS} ||= 'FRSX'; + exec $pager or fatal "Can't run pager: $! ($pager)"; +} + +sub format_svn_date { + my $t = shift || time; + require Git::SVN; + my $gmoff = Git::SVN::get_tz($t); + return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t)); +} + +sub parse_git_date { + my ($t, $tz) = @_; + # Date::Parse isn't in the standard Perl distro :( + if ($tz =~ s/^\+//) { + $t += tz_to_s_offset($tz); + } elsif ($tz =~ s/^\-//) { + $t -= tz_to_s_offset($tz); + } + return $t; +} + +sub set_local_timezone { + if (defined $TZ) { + $ENV{TZ} = $TZ; + } else { + delete $ENV{TZ}; + } +} + +sub tz_to_s_offset { + my ($tz) = @_; + $tz =~ s/(\d\d)$//; + return ($1 * 60) + ($tz * 3600); +} + +sub get_author_info { + my ($dest, $author, $t, $tz) = @_; + $author =~ s/(?:^\s*|\s*$)//g; + $dest->{a_raw} = $author; + my $au; + if ($::_authors) { + $au = $rusers{$author} || undef; + } + if (!$au) { + ($au) = ($author =~ /<([^>]+)\@[^>]+>$/); + } + $dest->{t} = $t; + $dest->{tz} = $tz; + $dest->{a} = $au; + $dest->{t_utc} = parse_git_date($t, $tz); +} + +sub process_commit { + my ($c, $r_min, $r_max, $defer) = @_; + if (defined $r_min && defined $r_max) { + if ($r_min == $c->{r} && $r_min == $r_max) { + show_commit($c); + return 0; + } + return 1 if $r_min == $r_max; + if ($r_min < $r_max) { + # we need to reverse the print order + return 0 if (defined $limit && --$limit < 0); + push @$defer, $c; + return 1; + } + if ($r_min != $r_max) { + return 1 if ($r_min < $c->{r}); + return 1 if ($r_max > $c->{r}); + } + } + return 0 if (defined $limit && --$limit < 0); + show_commit($c); + return 1; +} + +my $l_fmt; +sub show_commit { + my $c = shift; + if ($oneline) { + my $x = "\n"; + if (my $l = $c->{l}) { + while ($l->[0] =~ /^\s*$/) { shift @$l } + $x = $l->[0]; + } + $l_fmt ||= 'A' . length($c->{r}); + print 'r',pack($l_fmt, $c->{r}),' | '; + print "$c->{c} | " if $show_commit; + print $x; + } else { + show_commit_normal($c); + } +} + +sub show_commit_changed_paths { + my ($c) = @_; + return unless $c->{changed}; + print "Changed paths:\n", @{$c->{changed}}; +} + +sub show_commit_normal { + my ($c) = @_; + print commit_log_separator, "r$c->{r} | "; + print "$c->{c} | " if $show_commit; + print "$c->{a} | ", format_svn_date($c->{t_utc}), ' | '; + my $nr_line = 0; + + if (my $l = $c->{l}) { + while ($l->[$#$l] eq "\n" && $#$l > 0 + && $l->[($#$l - 1)] eq "\n") { + pop @$l; + } + $nr_line = scalar @$l; + if (!$nr_line) { + print "1 line\n\n\n"; + } else { + if ($nr_line == 1) { + $nr_line = '1 line'; + } else { + $nr_line .= ' lines'; + } + print $nr_line, "\n"; + show_commit_changed_paths($c); + print "\n"; + print $_ foreach @$l; + } + } else { + print "1 line\n"; + show_commit_changed_paths($c); + print "\n"; + + } + foreach my $x (qw/raw stat diff/) { + if ($c->{$x}) { + print "\n"; + print $_ foreach @{$c->{$x}} + } + } +} + +sub cmd_show_log { + my (@args) = @_; + my ($r_min, $r_max); + my $r_last = -1; # prevent dupes + set_local_timezone(); + if (defined $::_revision) { + if ($::_revision =~ /^(\d+):(\d+)$/) { + ($r_min, $r_max) = ($1, $2); + } elsif ($::_revision =~ /^\d+$/) { + $r_min = $r_max = $::_revision; + } else { + fatal "-r$::_revision is not supported, use ", + "standard 'git log' arguments instead"; + } + } + + config_pager(); + @args = git_svn_log_cmd($r_min, $r_max, @args); + if (!@args) { + print commit_log_separator unless $incremental || $oneline; + return; + } + my $log = command_output_pipe(@args); + run_pager(); + my (@k, $c, $d, $stat); + my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/; + while (<$log>) { + if (/^${esc_color}commit (?:- )?($::sha1_short)/o) { + my $cmt = $1; + if ($c && cmt_showable($c) && $c->{r} != $r_last) { + $r_last = $c->{r}; + process_commit($c, $r_min, $r_max, \@k) or + goto out; + } + $d = undef; + $c = { c => $cmt }; + } elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) { + get_author_info($c, $1, $2, $3); + } elsif (/^${esc_color}(?:tree|parent|committer) /o) { + # ignore + } elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) { + push @{$c->{raw}}, $_; + } elsif (/^${esc_color}[ACRMDT]\t/) { + # we could add $SVN->{svn_path} here, but that requires + # remote access at the moment (repo_path_split)... + s#^(${esc_color})([ACRMDT])\t#$1 $2 #o; + push @{$c->{changed}}, $_; + } elsif (/^${esc_color}diff /o) { + $d = 1; + push @{$c->{diff}}, $_; + } elsif ($d) { + push @{$c->{diff}}, $_; + } elsif (/^\ .+\ \|\s*\d+\ $esc_color[\+\-]* + $esc_color*[\+\-]*$esc_color$/x) { + $stat = 1; + push @{$c->{stat}}, $_; + } elsif ($stat && /^ \d+ files changed, \d+ insertions/) { + push @{$c->{stat}}, $_; + $stat = undef; + } elsif (/^${esc_color} (git-svn-id:.+)$/o) { + ($c->{url}, $c->{r}, undef) = ::extract_metadata($1); + } elsif (s/^${esc_color} //o) { + push @{$c->{l}}, $_; + } + } + if ($c && defined $c->{r} && $c->{r} != $r_last) { + $r_last = $c->{r}; + process_commit($c, $r_min, $r_max, \@k); + } + if (@k) { + ($r_min, $r_max) = ($r_max, $r_min); + process_commit($_, $r_min, $r_max) foreach reverse @k; + } +out: + close $log; + print commit_log_separator unless $incremental || $oneline; +} + +sub cmd_blame { + my $path = pop; + + config_pager(); + run_pager(); + + my ($fh, $ctx, $rev); + + if ($_git_format) { + ($fh, $ctx) = command_output_pipe('blame', @_, $path); + while (my $line = <$fh>) { + if ($line =~ /^\^?([[:xdigit:]]+)\s/) { + # Uncommitted edits show up as a rev ID of + # all zeros, which we can't look up with + # cmt_metadata + if ($1 !~ /^0+$/) { + (undef, $rev, undef) = + ::cmt_metadata($1); + $rev = '0' if (!$rev); + } else { + $rev = '0'; + } + $rev = sprintf('%-10s', $rev); + $line =~ s/^\^?[[:xdigit:]]+(\s)/$rev$1/; + } + print $line; + } + } else { + ($fh, $ctx) = command_output_pipe('blame', '-p', @_, 'HEAD', + '--', $path); + my ($sha1); + my %authors; + my @buffer; + my %dsha; #distinct sha keys + + while (my $line = <$fh>) { + push @buffer, $line; + if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { + $dsha{$1} = 1; + } + } + + my $s2r = ::cmt_sha2rev_batch([keys %dsha]); + + foreach my $line (@buffer) { + if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { + $rev = $s2r->{$1}; + $rev = '0' if (!$rev) + } + elsif ($line =~ /^author (.*)/) { + $authors{$rev} = $1; + $authors{$rev} =~ s/\s/_/g; + } + elsif ($line =~ /^\t(.*)$/) { + printf("%6s %10s %s\n", $rev, $authors{$rev}, $1); + } + } + } + command_close_pipe($fh, $ctx); +} + +1; diff --git a/perl/Git/SVN/Migration.pm b/perl/Git/SVN/Migration.pm new file mode 100644 index 000000000..75d74298e --- /dev/null +++ b/perl/Git/SVN/Migration.pm @@ -0,0 +1,258 @@ +package Git::SVN::Migration; +# these version numbers do NOT correspond to actual version numbers +# of git nor git-svn. They are just relative. +# +# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD +# +# v1 layout: .git/$id/info/url, refs/remotes/$id +# +# v2 layout: .git/svn/$id/info/url, refs/remotes/$id +# +# v3 layout: .git/svn/$id, refs/remotes/$id +# - info/url may remain for backwards compatibility +# - this is what we migrate up to this layout automatically, +# - this will be used by git svn init on single branches +# v3.1 layout (auto migrated): +# - .rev_db => .rev_db.$UUID, .rev_db will remain as a symlink +# for backwards compatibility +# +# v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id +# - this is only created for newly multi-init-ed +# repositories. Similar in spirit to the +# --use-separate-remotes option in git-clone (now default) +# - we do not automatically migrate to this (following +# the example set by core git) +# +# v5 layout: .rev_db.$UUID => .rev_map.$UUID +# - newer, more-efficient format that uses 24-bytes per record +# with no filler space. +# - use xxd -c24 < .rev_map.$UUID to view and debug +# - This is a one-way migration, repositories updated to the +# new format will not be able to use old git-svn without +# rebuilding the .rev_db. Rebuilding the rev_db is not +# possible if noMetadata or useSvmProps are set; but should +# be no problem for users that use the (sensible) defaults. +use strict; +use warnings; +use Carp qw/croak/; +use File::Path qw/mkpath/; +use File::Basename qw/dirname basename/; + +our $_minimize; +use Git qw( + command + command_noisy + command_output_pipe + command_close_pipe +); + +sub migrate_from_v0 { + my $git_dir = $ENV{GIT_DIR}; + return undef unless -d $git_dir; + my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); + my $migrated = 0; + while (<$fh>) { + chomp; + my ($id, $orig_ref) = ($_, $_); + next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#; + next unless -f "$git_dir/$id/info/url"; + my $new_ref = "refs/remotes/$id"; + if (::verify_ref("$new_ref^0")) { + print STDERR "W: $orig_ref is probably an old ", + "branch used by an ancient version of ", + "git-svn.\n", + "However, $new_ref also exists.\n", + "We will not be able ", + "to use this branch until this ", + "ambiguity is resolved.\n"; + next; + } + print STDERR "Migrating from v0 layout...\n" if !$migrated; + print STDERR "Renaming ref: $orig_ref => $new_ref\n"; + command_noisy('update-ref', $new_ref, $orig_ref); + command_noisy('update-ref', '-d', $orig_ref, $orig_ref); + $migrated++; + } + command_close_pipe($fh, $ctx); + print STDERR "Done migrating from v0 layout...\n" if $migrated; + $migrated; +} + +sub migrate_from_v1 { + my $git_dir = $ENV{GIT_DIR}; + my $migrated = 0; + return $migrated unless -d $git_dir; + my $svn_dir = "$git_dir/svn"; + + # just in case somebody used 'svn' as their $id at some point... + return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url"; + + print STDERR "Migrating from a git-svn v1 layout...\n"; + mkpath([$svn_dir]); + print STDERR "Data from a previous version of git-svn exists, but\n\t", + "$svn_dir\n\t(required for this version ", + "($::VERSION) of git-svn) does not exist.\n"; + my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); + while (<$fh>) { + my $x = $_; + next unless $x =~ s#^refs/remotes/##; + chomp $x; + next unless -f "$git_dir/$x/info/url"; + my $u = eval { ::file_to_s("$git_dir/$x/info/url") }; + next unless $u; + my $dn = dirname("$git_dir/svn/$x"); + mkpath([$dn]) unless -d $dn; + if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID: + mkpath(["$git_dir/svn/svn"]); + print STDERR " - $git_dir/$x/info => ", + "$git_dir/svn/$x/info\n"; + rename "$git_dir/$x/info", "$git_dir/svn/$x/info" or + croak "$!: $x"; + # don't worry too much about these, they probably + # don't exist with repos this old (save for index, + # and we can easily regenerate that) + foreach my $f (qw/unhandled.log index .rev_db/) { + rename "$git_dir/$x/$f", "$git_dir/svn/$x/$f"; + } + } else { + print STDERR " - $git_dir/$x => $git_dir/svn/$x\n"; + rename "$git_dir/$x", "$git_dir/svn/$x" or + croak "$!: $x"; + } + $migrated++; + } + command_close_pipe($fh, $ctx); + print STDERR "Done migrating from a git-svn v1 layout\n"; + $migrated; +} + +sub read_old_urls { + my ($l_map, $pfx, $path) = @_; + my @dir; + foreach (<$path/*>) { + if (-r "$_/info/url") { + $pfx .= '/' if $pfx && $pfx !~ m!/$!; + my $ref_id = $pfx . basename $_; + my $url = ::file_to_s("$_/info/url"); + $l_map->{$ref_id} = $url; + } elsif (-d $_) { + push @dir, $_; + } + } + foreach (@dir) { + my $x = $_; + $x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o; + read_old_urls($l_map, $x, $_); + } +} + +sub migrate_from_v2 { + my @cfg = command(qw/config -l/); + return if grep /^svn-remote\..+\.url=/, @cfg; + my %l_map; + read_old_urls(\%l_map, '', "$ENV{GIT_DIR}/svn"); + my $migrated = 0; + + require Git::SVN; + foreach my $ref_id (sort keys %l_map) { + eval { Git::SVN->init($l_map{$ref_id}, '', undef, $ref_id) }; + if ($@) { + Git::SVN->init($l_map{$ref_id}, '', $ref_id, $ref_id); + } + $migrated++; + } + $migrated; +} + +sub minimize_connections { + require Git::SVN; + require Git::SVN::Ra; + + my $r = Git::SVN::read_all_remotes(); + my $new_urls = {}; + my $root_repos = {}; + foreach my $repo_id (keys %$r) { + my $url = $r->{$repo_id}->{url} or next; + my $fetch = $r->{$repo_id}->{fetch} or next; + my $ra = Git::SVN::Ra->new($url); + + # skip existing cases where we already connect to the root + if (($ra->{url} eq $ra->{repos_root}) || + ($ra->{repos_root} eq $repo_id)) { + $root_repos->{$ra->{url}} = $repo_id; + next; + } + + my $root_ra = Git::SVN::Ra->new($ra->{repos_root}); + my $root_path = $ra->{url}; + $root_path =~ s#^\Q$ra->{repos_root}\E(/|$)##; + foreach my $path (keys %$fetch) { + my $ref_id = $fetch->{$path}; + my $gs = Git::SVN->new($ref_id, $repo_id, $path); + + # make sure we can read when connecting to + # a higher level of a repository + my ($last_rev, undef) = $gs->last_rev_commit; + if (!defined $last_rev) { + $last_rev = eval { + $root_ra->get_latest_revnum; + }; + next if $@; + } + my $new = $root_path; + $new .= length $path ? "/$path" : ''; + eval { + $root_ra->get_log([$new], $last_rev, $last_rev, + 0, 0, 1, sub { }); + }; + next if $@; + $new_urls->{$ra->{repos_root}}->{$new} = + { ref_id => $ref_id, + old_repo_id => $repo_id, + old_path => $path }; + } + } + + my @emptied; + foreach my $url (keys %$new_urls) { + # see if we can re-use an existing [svn-remote "repo_id"] + # instead of creating a(n ugly) new section: + my $repo_id = $root_repos->{$url} || $url; + + my $fetch = $new_urls->{$url}; + foreach my $path (keys %$fetch) { + my $x = $fetch->{$path}; + Git::SVN->init($url, $path, $repo_id, $x->{ref_id}); + my $pfx = "svn-remote.$x->{old_repo_id}"; + + my $old_fetch = quotemeta("$x->{old_path}:". + "$x->{ref_id}"); + command_noisy(qw/config --unset/, + "$pfx.fetch", '^'. $old_fetch . '$'); + delete $r->{$x->{old_repo_id}}-> + {fetch}->{$x->{old_path}}; + if (!keys %{$r->{$x->{old_repo_id}}->{fetch}}) { + command_noisy(qw/config --unset/, + "$pfx.url"); + push @emptied, $x->{old_repo_id} + } + } + } + if (@emptied) { + my $file = $ENV{GIT_CONFIG} || "$ENV{GIT_DIR}/config"; + print STDERR <<EOF; +The following [svn-remote] sections in your config file ($file) are empty +and can be safely removed: +EOF + print STDERR "[svn-remote \"$_\"]\n" foreach @emptied; + } +} + +sub migration_check { + migrate_from_v0(); + migrate_from_v1(); + migrate_from_v2(); + minimize_connections() if $_minimize; +} + +1; diff --git a/perl/Git/SVN/Utils.pm b/perl/Git/SVN/Utils.pm new file mode 100644 index 000000000..496006bc7 --- /dev/null +++ b/perl/Git/SVN/Utils.pm @@ -0,0 +1,59 @@ +package Git::SVN::Utils; + +use strict; +use warnings; + +use base qw(Exporter); + +our @EXPORT_OK = qw(fatal can_compress); + + +=head1 NAME + +Git::SVN::Utils - utility functions used across Git::SVN + +=head1 SYNOPSIS + + use Git::SVN::Utils qw(functions to import); + +=head1 DESCRIPTION + +This module contains functions which are useful across many different +parts of Git::SVN. Mostly it's a place to put utility functions +rather than duplicate the code or have classes grabbing at other +classes. + +=head1 FUNCTIONS + +All functions can be imported only on request. + +=head3 fatal + + fatal(@message); + +Display a message and exit with a fatal error code. + +=cut + +# Note: not certain why this is in use instead of die. Probably because +# the exit code of die is 255? Doesn't appear to be used consistently. +sub fatal (@) { print STDERR "@_\n"; exit 1 } + + +=head3 can_compress + + my $can_compress = can_compress; + +Returns true if Compress::Zlib is available, false otherwise. + +=cut + +my $can_compress; +sub can_compress { + return $can_compress if defined $can_compress; + + return $can_compress = eval { require Compress::Zlib; }; +} + + +1; diff --git a/perl/Makefile b/perl/Makefile index 6ca7d472e..15d96fcc7 100644 --- a/perl/Makefile +++ b/perl/Makefile @@ -20,17 +20,26 @@ clean: $(RM) ppport.h $(RM) $(makfile) $(RM) $(makfile).old + $(RM) PM.stamp + +$(makfile): PM.stamp ifdef NO_PERL_MAKEMAKER instdir_SQ = $(subst ','\'',$(prefix)/lib) modules += Git modules += Git/I18N +modules += Git/IndexInfo +modules += Git/SVN modules += Git/SVN/Memoize/YAML modules += Git/SVN/Fetcher modules += Git/SVN/Editor +modules += Git/SVN/GlobSpec +modules += Git/SVN/Log +modules += Git/SVN/Migration modules += Git/SVN/Prompt modules += Git/SVN/Ra +modules += Git/SVN/Utils $(makfile): ../GIT-CFLAGS Makefile echo all: private-Error.pm Git.pm Git/I18N.pm > $@ diff --git a/perl/Makefile.PL b/perl/Makefile.PL index b54b04a61..3f29ba98a 100644 --- a/perl/Makefile.PL +++ b/perl/Makefile.PL @@ -2,11 +2,16 @@ use strict; use warnings; use ExtUtils::MakeMaker; use Getopt::Long; +use File::Find; + +# Don't forget to update the perl/Makefile, too. +# Don't forget to test with NO_PERL_MAKEMAKER=YesPlease # Sanity: die at first unknown option Getopt::Long::Configure qw/ pass_through /; -GetOptions("localedir=s" => \my $localedir); +my $localedir = ''; +GetOptions("localedir=s" => \$localedir); sub MY::postamble { return <<'MAKE_FRAG'; @@ -24,24 +29,22 @@ endif MAKE_FRAG } -# XXX. When editing this list: -# -# * Please update perl/Makefile, too. -# * Don't forget to test with NO_PERL_MAKEMAKER=YesPlease -my %pm = ( - 'Git.pm' => '$(INST_LIBDIR)/Git.pm', - 'Git/I18N.pm' => '$(INST_LIBDIR)/Git/I18N.pm', - 'Git/SVN/Memoize/YAML.pm' => '$(INST_LIBDIR)/Git/SVN/Memoize/YAML.pm', - 'Git/SVN/Fetcher.pm' => '$(INST_LIBDIR)/Git/SVN/Fetcher.pm', - 'Git/SVN/Editor.pm' => '$(INST_LIBDIR)/Git/SVN/Editor.pm', - 'Git/SVN/Prompt.pm' => '$(INST_LIBDIR)/Git/SVN/Prompt.pm', - 'Git/SVN/Ra.pm' => '$(INST_LIBDIR)/Git/SVN/Ra.pm', -); +# Find all the .pm files in "Git/" and Git.pm +my %pm; +find sub { + return unless /\.pm$/; + + # sometimes File::Find prepends a ./ Strip it. + my $pm_path = $File::Find::name; + $pm_path =~ s{^\./}{}; + + $pm{$pm_path} = '$(INST_LIBDIR)/'.$pm_path; +}, "Git", "Git.pm"; + # We come with our own bundled Error.pm. It's not in the set of default # Perl modules so install it if it's not available on the system yet. -eval { require Error }; -if ($@ || $Error::VERSION < 0.15009) { +if ( !eval { require Error } || $Error::VERSION < 0.15009) { $pm{'private-Error.pm'} = '$(INST_LIBDIR)/Error.pm'; } diff --git a/sha1_file.c b/sha1_file.c index 4ccaf7ac1..af5cfbde6 100644 --- a/sha1_file.c +++ b/sha1_file.c @@ -298,7 +298,7 @@ static int link_alt_odb_entry(const char * entry, int len, const char * relative return -1; } } - if (!memcmp(ent->base, objdir, pfxlen)) { + if (!strcmp(ent->base, objdir)) { free(ent); return -1; } diff --git a/t/Git-SVN/00compile.t b/t/Git-SVN/00compile.t new file mode 100644 index 000000000..c92fee453 --- /dev/null +++ b/t/Git-SVN/00compile.t @@ -0,0 +1,14 @@ +#!/usr/bin/env perl + +use strict; +use warnings; + +use Test::More tests => 7; + +require_ok 'Git::SVN'; +require_ok 'Git::SVN::Utils'; +require_ok 'Git::SVN::Ra'; +require_ok 'Git::SVN::Log'; +require_ok 'Git::SVN::Migration'; +require_ok 'Git::IndexInfo'; +require_ok 'Git::SVN::GlobSpec'; diff --git a/t/Git-SVN/Utils/can_compress.t b/t/Git-SVN/Utils/can_compress.t new file mode 100644 index 000000000..d7b49b8d5 --- /dev/null +++ b/t/Git-SVN/Utils/can_compress.t @@ -0,0 +1,11 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More 'no_plan'; + +use Git::SVN::Utils qw(can_compress); + +# !! is the "convert this to boolean" operator. +is !!can_compress(), !!eval { require Compress::Zlib }; diff --git a/t/Git-SVN/Utils/fatal.t b/t/Git-SVN/Utils/fatal.t new file mode 100644 index 000000000..49e143829 --- /dev/null +++ b/t/Git-SVN/Utils/fatal.t @@ -0,0 +1,34 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More 'no_plan'; + +BEGIN { + # Override exit at BEGIN time before Git::SVN::Utils is loaded + # so it will see our local exit later. + *CORE::GLOBAL::exit = sub(;$) { + return @_ ? CORE::exit($_[0]) : CORE::exit(); + }; +} + +use Git::SVN::Utils qw(fatal); + +# fatal() +{ + # Capture the exit code and prevent exit. + my $exit_status; + no warnings 'redefine'; + local *CORE::GLOBAL::exit = sub { $exit_status = $_[0] || 0 }; + + # Trap fatal's message to STDERR + my $stderr; + close STDERR; + ok open STDERR, ">", \$stderr; + + fatal "Some", "Stuff", "Happened"; + + is $stderr, "Some Stuff Happened\n"; + is $exit_status, 1; +} diff --git a/t/t1100-commit-tree-options.sh b/t/t1100-commit-tree-options.sh index a3b77239f..f8457f9d1 100755 --- a/t/t1100-commit-tree-options.sh +++ b/t/t1100-commit-tree-options.sh @@ -47,6 +47,7 @@ test_expect_success \ test_expect_success 'flags and then non flags' ' + test_tick && echo comment text | git commit-tree $(cat treeid) >commitid && echo comment text | diff --git a/t/t1306-xdg-files.sh b/t/t1306-xdg-files.sh index 3c75c3f2e..8b14ab187 100755 --- a/t/t1306-xdg-files.sh +++ b/t/t1306-xdg-files.sh @@ -38,6 +38,13 @@ test_expect_success 'read with --get: xdg file exists and ~/.gitconfig doesn'\'' test_cmp expected actual ' +test_expect_success '"$XDG_CONFIG_HOME overrides $HOME/.config/git' ' + mkdir -p "$HOME"/xdg/git && + echo "[user]name = in_xdg" >"$HOME"/xdg/git/config && + echo in_xdg >expected && + XDG_CONFIG_HOME="$HOME"/xdg git config --get-all user.name >actual && + test_cmp expected actual +' test_expect_success 'read with --get: xdg file exists and ~/.gitconfig exists' ' >.gitconfig && @@ -80,6 +87,17 @@ test_expect_success 'Exclusion of a file in the XDG ignore file' ' test_must_fail git add to_be_excluded ' +test_expect_success '$XDG_CONFIG_HOME overrides $HOME/.config/git/ignore' ' + mkdir -p "$HOME"/xdg/git && + echo content >excluded_by_xdg_only && + echo excluded_by_xdg_only >"$HOME"/xdg/git/ignore && + test_when_finished "git read-tree --empty" && + (XDG_CONFIG_HOME="$HOME/xdg" && + export XDG_CONFIG_HOME && + git add to_be_excluded && + test_must_fail git add excluded_by_xdg_only + ) +' test_expect_success 'Exclusion in both XDG and local ignore files' ' echo to_be_excluded >.gitignore && @@ -95,6 +113,13 @@ test_expect_success 'Exclusion in a non-XDG global ignore file' ' test_must_fail git add to_be_excluded ' +test_expect_success 'Checking XDG ignore file when HOME is unset' ' + >expected && + (sane_unset HOME && + git config --unset core.excludesfile && + git ls-files --exclude-standard --ignored >actual) && + test_cmp expected actual +' test_expect_success 'Checking attributes in the XDG attributes file' ' echo foo >f && @@ -106,6 +131,20 @@ test_expect_success 'Checking attributes in the XDG attributes file' ' test_cmp expected actual ' +test_expect_success 'Checking XDG attributes when HOME is unset' ' + >expected && + (sane_unset HOME && + git check-attr -a f >actual) && + test_cmp expected actual +' + +test_expect_success '$XDG_CONFIG_HOME overrides $HOME/.config/git/attributes' ' + mkdir -p "$HOME"/xdg/git && + echo "f attr_f=xdg" >"$HOME"/xdg/git/attributes && + echo "f: attr_f: xdg" >expected && + XDG_CONFIG_HOME="$HOME/xdg" git check-attr -a f >actual && + test_cmp expected actual +' test_expect_success 'Checking attributes in both XDG and local attributes files' ' echo "f -attr_f" >.gitattributes && diff --git a/t/t3404-rebase-interactive.sh b/t/t3404-rebase-interactive.sh index 8078db685..3f75d328d 100755 --- a/t/t3404-rebase-interactive.sh +++ b/t/t3404-rebase-interactive.sh @@ -903,4 +903,12 @@ test_expect_success 'rebase -i --root temporary sentinel commit' ' git rebase --abort ' +test_expect_success 'rebase -i --root fixup root commit' ' + git checkout B && + FAKE_LINES="1 fixup 2" git rebase -i --root && + test A = $(git cat-file commit HEAD | sed -ne \$p) && + test B = $(git show HEAD:file1) && + test 0 = $(git cat-file commit HEAD | grep -c ^parent\ ) +' + test_done diff --git a/t/t7409-submodule-detached-worktree.sh b/t/t7409-submodule-detached-worktree.sh index 2fec13dcd..2fec13dcd 100644..100755 --- a/t/t7409-submodule-detached-worktree.sh +++ b/t/t7409-submodule-detached-worktree.sh diff --git a/t/t7502-commit.sh b/t/t7502-commit.sh index 181456aa9..deb187eb7 100755 --- a/t/t7502-commit.sh +++ b/t/t7502-commit.sh @@ -235,44 +235,56 @@ test_expect_success 'cleanup commit messages (strip,-F,-e): output' ' test_i18ncmp expect actual ' -echo "# -# Author: $GIT_AUTHOR_NAME <$GIT_AUTHOR_EMAIL> -#" >> expect - -test_expect_success 'author different from committer' ' +test_expect_success 'message shows author when it is not equal to committer' ' echo >>negative && - test_might_fail git commit -e -m "sample" && - head -n 7 .git/COMMIT_EDITMSG >actual && - test_i18ncmp expect actual + git commit -e -m "sample" -a && + test_i18ngrep \ + "^# Author: *A U Thor <author@example.com>\$" \ + .git/COMMIT_EDITMSG ' -mv expect expect.tmp -sed '$d' < expect.tmp > expect -rm -f expect.tmp -echo "# Committer: -#" >> expect +test_expect_success 'setup auto-ident prerequisite' ' + if (sane_unset GIT_COMMITTER_EMAIL && + sane_unset GIT_COMMITTER_NAME && + git var GIT_COMMITTER_IDENT); then + test_set_prereq AUTOIDENT + else + test_set_prereq NOAUTOIDENT + fi +' -test_expect_success 'committer is automatic' ' +test_expect_success AUTOIDENT 'message shows committer when it is automatic' ' echo >>negative && ( sane_unset GIT_COMMITTER_EMAIL && sane_unset GIT_COMMITTER_NAME && - # must fail because there is no change - test_must_fail git commit -e -m "sample" + git commit -e -m "sample" -a ) && - head -n 8 .git/COMMIT_EDITMSG | \ - sed "s/^# Committer: .*/# Committer:/" >actual - test_i18ncmp expect actual + # the ident is calculated from the system, so we cannot + # check the actual value, only that it is there + test_i18ngrep "^# Committer: " .git/COMMIT_EDITMSG ' -pwd=`pwd` -cat >> .git/FAKE_EDITOR << EOF -#! /bin/sh -echo editor started > "$pwd/.git/result" +write_script .git/FAKE_EDITOR <<EOF +echo editor started > "$(pwd)/.git/result" exit 0 EOF -chmod +x .git/FAKE_EDITOR + +test_expect_success NOAUTOIDENT 'do not fire editor when committer is bogus' ' + >.git/result + >expect && + + echo >>negative && + ( + sane_unset GIT_COMMITTER_EMAIL && + sane_unset GIT_COMMITTER_NAME && + GIT_EDITOR="\"$(pwd)/.git/FAKE_EDITOR\"" && + export GIT_EDITOR && + test_must_fail git commit -e -m sample -a + ) && + test_cmp expect .git/result +' test_expect_success 'do not fire editor in the presence of conflicts' ' @@ -293,16 +305,14 @@ test_expect_success 'do not fire editor in the presence of conflicts' ' test_must_fail git cherry-pick -n master && echo "editor not started" >.git/result && ( - GIT_EDITOR="$(pwd)/.git/FAKE_EDITOR" && + GIT_EDITOR="\"$(pwd)/.git/FAKE_EDITOR\"" && export GIT_EDITOR && test_must_fail git commit ) && test "$(cat .git/result)" = "editor not started" ' -pwd=`pwd` -cat >.git/FAKE_EDITOR <<EOF -#! $SHELL_PATH +write_script .git/FAKE_EDITOR <<EOF # kill -TERM command added below. EOF @@ -339,13 +349,12 @@ test_expect_success 'A single-liner subject with a token plus colon is not a foo ' -cat >.git/FAKE_EDITOR <<EOF -#!$SHELL_PATH -mv "\$1" "\$1.orig" +write_script .git/FAKE_EDITOR <<\EOF +mv "$1" "$1.orig" ( echo message - cat "\$1.orig" -) >"\$1" + cat "$1.orig" +) >"$1" EOF echo '## Custom template' >template diff --git a/t/test-lib.sh b/t/test-lib.sh index acda33d17..bb4f8865b 100644 --- a/t/test-lib.sh +++ b/t/test-lib.sh @@ -34,6 +34,26 @@ esac # Keep the original TERM for say_color ORIGINAL_TERM=$TERM +# Test the binaries we have just built. The tests are kept in +# t/ subdirectory and are run in 'trash directory' subdirectory. +if test -z "$TEST_DIRECTORY" +then + # We allow tests to override this, in case they want to run tests + # outside of t/, e.g. for running tests on the test library + # itself. + TEST_DIRECTORY=$(pwd) +fi +if test -z "$TEST_OUTPUT_DIRECTORY" +then + # Similarly, override this to store the test-results subdir + # elsewhere + TEST_OUTPUT_DIRECTORY=$TEST_DIRECTORY +fi +GIT_BUILD_DIR="$TEST_DIRECTORY"/.. + +. "$GIT_BUILD_DIR"/GIT-BUILD-OPTIONS +export PERL_PATH SHELL_PATH + # For repeatability, reset the environment to known value. LANG=C LC_ALL=C @@ -46,7 +66,7 @@ EDITOR=: # /usr/xpg4/bin/sh and /bin/ksh to bail out. So keep the unsets # deriving from the command substitution clustered with the other # ones. -unset VISUAL EMAIL LANGUAGE COLUMNS $(perl -e ' +unset VISUAL EMAIL LANGUAGE COLUMNS $("$PERL_PATH" -e ' my @env = keys %ENV; my $ok = join("|", qw( TRACE @@ -61,6 +81,7 @@ unset VISUAL EMAIL LANGUAGE COLUMNS $(perl -e ' my @vars = grep(/^GIT_/ && !/^GIT_($ok)/o, @env); print join("\n", @vars); ') +unset XDG_CONFIG_HOME GIT_AUTHOR_EMAIL=author@example.com GIT_AUTHOR_NAME='A U Thor' GIT_COMMITTER_EMAIL=committer@example.com @@ -229,7 +250,7 @@ trap 'die' EXIT # The user-facing functions are loaded from a separate file so that # test_perf subshells can have them too -. "${TEST_DIRECTORY:-.}"/test-lib-functions.sh +. "$TEST_DIRECTORY/test-lib-functions.sh" # You are not expected to call test_ok_ and test_failure_ directly, use # the text_expect_* functions instead. @@ -380,23 +401,6 @@ test_done () { esac } -# Test the binaries we have just built. The tests are kept in -# t/ subdirectory and are run in 'trash directory' subdirectory. -if test -z "$TEST_DIRECTORY" -then - # We allow tests to override this, in case they want to run tests - # outside of t/, e.g. for running tests on the test library - # itself. - TEST_DIRECTORY=$(pwd) -fi -if test -z "$TEST_OUTPUT_DIRECTORY" -then - # Similarly, override this to store the test-results subdir - # elsewhere - TEST_OUTPUT_DIRECTORY=$TEST_DIRECTORY -fi -GIT_BUILD_DIR="$TEST_DIRECTORY"/.. - if test -n "$valgrind" then make_symlink () { @@ -492,10 +496,6 @@ GIT_CONFIG_NOSYSTEM=1 GIT_ATTR_NOSYSTEM=1 export PATH GIT_EXEC_PATH GIT_TEMPLATE_DIR GIT_CONFIG_NOSYSTEM GIT_ATTR_NOSYSTEM -. "$GIT_BUILD_DIR"/GIT-BUILD-OPTIONS - -export PERL_PATH - if test -z "$GIT_TEST_CMP" then if test -n "$GIT_TEST_CMP_USE_COPIED_CONTEXT" diff --git a/transport-helper.c b/transport-helper.c index 61c928f6c..cfe098849 100644 --- a/transport-helper.c +++ b/transport-helper.c @@ -444,6 +444,21 @@ static int fetch_with_import(struct transport *transport, free(fastimport.argv); fastimport.argv = NULL; + /* + * The fast-import stream of a remote helper that advertises + * the "refspec" capability writes to the refs named after the + * right hand side of the first refspec matching each ref we + * were fetching. + * + * (If no "refspec" capability was specified, for historical + * reasons we default to *:*.) + * + * Store the result in to_fetch[i].old_sha1. Callers such + * as "git fetch" can use the value to write feedback to the + * terminal, populate FETCH_HEAD, and determine what new value + * should be written to peer_ref if the update is a + * fast-forward or this is a forced update. + */ for (i = 0; i < nr_heads; i++) { char *private; posn = to_fetch[i]; |