Show usage string for 'git get-tar-commit-id -h'
[gitweb.git] / git-svn.perl
index b0bfb74792d775155221bc857bb117479d3cbca2..6a3b501d24ebaa50e297511ccf0b18e3bbd2bb16 100755 (executable)
 $Git::SVN::Ra::_log_window_size = 100;
 $Git::SVN::_minimize_url = 'unset';
 
+if (! exists $ENV{SVN_SSH}) {
+       if (exists $ENV{GIT_SSH}) {
+               $ENV{SVN_SSH} = $ENV{GIT_SSH};
+               if ($^O eq 'msys') {
+                       $ENV{SVN_SSH} =~ s/\\/\\\\/g;
+               }
+       }
+}
+
 $Git::SVN::Log::TZ = $ENV{TZ};
 $ENV{TZ} = 'UTC';
 $| = 1; # unbuffer STDOUT
@@ -594,8 +603,15 @@ sub cmd_dcommit {
                                          "\nBefore dcommitting";
                                }
                                if ($url_ ne $expect_url) {
-                                       fatal "URL mismatch after rebase: ",
-                                             "$url_ != $expect_url";
+                                       if ($url_ eq $gs->metadata_url) {
+                                               print
+                                                 "Accepting rewritten URL:",
+                                                 " $url_\n";
+                                       } else {
+                                               fatal
+                                                 "URL mismatch after rebase:",
+                                                 " $url_ != $expect_url";
+                                       }
                                }
                                if ($uuid_ ne $uuid) {
                                        fatal "uuid mismatch after rebase: ",
@@ -909,7 +925,7 @@ sub cmd_multi_init {
        }
        do_git_init_db();
        if (defined $_trunk) {
-               my $trunk_ref = $_prefix . 'trunk';
+               my $trunk_ref = 'refs/remotes/' . $_prefix . 'trunk';
                # try both old-style and new-style lookups:
                my $gs_trunk = eval { Git::SVN->new($trunk_ref) };
                unless ($gs_trunk) {
@@ -1156,6 +1172,17 @@ sub post_fetch_checkout {
        my $gs = $Git::SVN::_head or return;
        return if verify_ref('refs/heads/master^0');
 
+       # look for "trunk" ref if it exists
+       my $remote = Git::SVN::read_all_remotes()->{$gs->{repo_id}};
+       my $fetch = $remote->{fetch};
+       if ($fetch) {
+               foreach my $p (keys %$fetch) {
+                       basename($fetch->{$p}) eq 'trunk' or next;
+                       $gs = Git::SVN->new($fetch->{$p}, $gs->{repo_id}, $p);
+                       last;
+               }
+       }
+
        my $valid_head = verify_ref('HEAD^0');
        command_noisy(qw(update-ref refs/heads/master), $gs->refname);
        return if ($valid_head || !verify_ref('HEAD^0'));
@@ -1211,6 +1238,7 @@ sub complete_url_ls_init {
        }
        command_oneline('config', $k, $gs->{url}) unless $orig_url;
        my $remote_path = "$gs->{path}/$repo_path";
+       $remote_path =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg;
        $remote_path =~ s#/+#/#g;
        $remote_path =~ s#^/##g;
        $remote_path .= "/*" if $remote_path !~ /\*/;
@@ -1643,23 +1671,23 @@ sub resolve_local_globs {
        return unless defined $glob_spec;
        my $ref = $glob_spec->{ref};
        my $path = $glob_spec->{path};
-       foreach (command(qw#for-each-ref --format=%(refname) refs/remotes#)) {
-               next unless m#^refs/remotes/$ref->{regex}$#;
+       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: refs/remotes/$existing\n",
-                                   " globbed: refs/remotes/$refname\n";
+                                   "existing: $existing\n",
+                                   " globbed: $refname\n";
                        }
-                       my $u = (::cmt_metadata("refs/remotes/$refname"))[0];
+                       my $u = (::cmt_metadata("$refname"))[0];
                        $u =~ s!^\Q$url\E(/|$)!! or die
-                         "refs/remotes/$refname: '$url' not found in '$u'\n";
+                         "$refname: '$url' not found in '$u'\n";
                        if ($pathname ne $u) {
                                warn "W: Refspec glob conflict ",
-                                    "(ref: refs/remotes/$refname):\n",
+                                    "(ref: $refname):\n",
                                     "expected path: $pathname\n",
                                     "    real path: $u\n",
                                     "Continuing ahead with $u\n";
@@ -1737,33 +1765,35 @@ sub read_all_remotes {
        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=\s*(.*)\s*:\s*(.+)\s*$!) {
-                       my ($remote, $local_ref, $_remote_ref) = ($1, $2, $3);
-                       die("svn-remote.$remote: remote ref '$_remote_ref' "
-                           . "must start with 'refs/remotes/'\n")
-                               unless $_remote_ref =~ m{^refs/remotes/(.+)};
-                       my $remote_ref = $1;
-                       $local_ref =~ s{^/}{};
+               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/};
                        $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!^(.+)\.(branches|tags)=
-                          (.*):refs/remotes/(.+)\s*$/!x) {
-                       my ($p, $g) = ($3, $4);
+               } 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/};
                        my $rs = {
-                           t => $2,
-                           remote => $1,
-                           path => Git::SVN::GlobSpec->new($p),
-                           ref => Git::SVN::GlobSpec->new($g) };
+                           t => $t,
+                           remote => $remote,
+                           path => Git::SVN::GlobSpec->new($local_ref),
+                           ref => Git::SVN::GlobSpec->new($remote_ref) };
                        if (length($rs->{ref}->{right}) != 0) {
                                die "The '*' glob character must be the last ",
-                                   "character of '$g'\n";
+                                   "character of '$remote_ref'\n";
                        }
-                       push @{ $r->{$1}->{$2} }, $rs;
+                       push @{ $r->{$remote}->{$t} }, $rs;
                }
        }
 
@@ -1871,14 +1901,15 @@ sub init_remote_config {
                }
        }
        my ($xrepo_id, $xpath) = find_ref($self->refname);
-       if (defined $xpath) {
+       if (!$no_write && defined $xpath) {
                die "svn-remote.$xrepo_id.fetch already set to track ",
-                   "$xpath:refs/remotes/", $self->refname, "\n";
+                   "$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);
@@ -1948,7 +1979,7 @@ sub find_ref {
        my ($ref_id) = @_;
        foreach (command(qw/config -l/)) {
                next unless m!^svn-remote\.(.+)\.fetch=
-                             \s*(.*)\s*:\s*refs/remotes/(.+)\s*$!x;
+                             \s*(.*?)\s*:\s*(.+?)\s*$!x;
                my ($repo_id, $path, $ref) = ($1, $2, $3);
                if ($ref eq $ref_id) {
                        $path = '' if ($path =~ m#^\./?#);
@@ -1965,16 +1996,16 @@ sub new {
                if (!defined $repo_id) {
                        die "Could not find a \"svn-remote.*.fetch\" key ",
                            "in the repository configuration matching: ",
-                           "refs/remotes/$ref_id\n";
+                           "$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",
-                                           ":refs/remotes/$ref_id\$") or
+                                           ":$ref_id\$") or
                     die "Failed to read \"svn-remote.$repo_id.fetch\" ",
-                        "\":refs/remotes/$ref_id\$\" in config\n";
+                        "\":$ref_id\$\" in config\n";
                ($self->{path}, undef) = split(/\s*:\s*/, $fetch);
        }
        $self->{url} = command_oneline('config', '--get',
@@ -1985,7 +2016,7 @@ sub new {
 }
 
 sub refname {
-       my ($refname) = "refs/remotes/$_[0]->{ref_id}" ;
+       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:
@@ -2602,7 +2633,8 @@ sub find_parent_branch {
        my $url = $self->ra->{url};
        my $new_url = $url . $branch_from;
        print STDERR  "Found possible branch point: ",
-                     "$new_url => ", $self->full_url, ", $r\n";
+                     "$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});
@@ -2623,11 +2655,13 @@ sub find_parent_branch {
                ($r0, $parent) = $gs->find_rev_before($r, 1);
        }
        if (defined $r0 && defined $parent) {
-               print STDERR "Found branch parent: ($self->{ref_id}) $parent\n";
+               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";
+                       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
@@ -2642,18 +2676,20 @@ sub find_parent_branch {
                        print STDERR "Trees match:\n",
                                     "  $new_url\@$r0\n",
                                     "  ${\$self->full_url}\@$rev\n",
-                                    "Following parent with no changes\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";
+                       print STDERR "Following parent with do_update\n"
+                                    unless $::_q > 1;
                        $ed = SVN::Git::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";
+               print STDERR "Successfully followed parent\n" unless $::_q > 1;
                return $self->make_log_entry($rev, [$parent], $ed);
        }
        return undef;
@@ -2798,7 +2834,7 @@ sub other_gs {
                $ref_id .= "\@$r";
                # just grow a tail if we're not unique enough :x
                $ref_id .= '-' while find_ref($ref_id);
-               print STDERR "Initializing parent: $ref_id\n";
+               print STDERR "Initializing parent: $ref_id\n" unless $::_q > 1;
                my ($u, $p, $repo_id) = ($new_url, '', $ref_id);
                if ($u =~ s#^\Q$url\E(/|$)##) {
                        $p = $u;
@@ -2812,6 +2848,7 @@ sub other_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"
@@ -2841,14 +2878,157 @@ sub check_author {
        $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->rewrite_root || $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, $commit;
+                       }
+               }
+       }
+       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;
+               }
+       }
+}
+
+# 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...
+
+       # 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 @merged_commit_ranges;
+       my $url = $self->rewrite_root || $self->{url};
+       for my $merge ( @merges ) {
+               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";
+                       next;
+               }
+               my @ranges = split ",", $revs;
+               my ($tip, $tip_commit);
+               # find the tip
+               for my $range ( @ranges ) {
+                       my ($bottom, $top) = split "-", $range;
+                       $top ||= $bottom;
+                       my $bottom_commit =
+                               $gs->rev_map_get($bottom, $self->ra_uuid) ||
+                               $gs->rev_map_get($bottom+1, $self->ra_uuid);
+                       my $top_commit =
+                               $gs->rev_map_get($top, $self->ra_uuid);
+
+                       unless ($top_commit and $bottom_commit) {
+                               warn "W:unknown path/rev in svn:mergeinfo "
+                                       ."dirprop: $source:$range\n";
+                               next;
+                       }
+
+                       push @merged_commit_ranges,
+                               "$bottom_commit..$top_commit";
+
+                       if ( !defined $tip or $top > $tip ) {
+                               $tip = $top;
+                               $tip_commit = $top_commit;
+                       }
+               }
+               unless (!$tip_commit or
+                               grep { $_ eq $tip_commit } @$parents ) {
+                       push @merge_tips, $tip_commit;
+               } else {
+                       push @merge_tips, undef;
+               }
+       }
+       for my $merge_tip ( @merge_tips ) {
+               my $spec = shift @merges;
+               next unless $merge_tip;
+               my @cmd = ('rev-list', "-1", $merge_tip,
+                          "--not", @$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 ) {
+                       push @cmd, @merged_commit_ranges;
+                       my ($msg_fh, $ctx) = command_output_pipe(@cmd);
+                       my $unmerged;
+                       while ( <$msg_fh> ) {
+                               $unmerged=1;last;
+                       }
+                       command_close_pipe($msg_fh, $ctx);
+                       if ( $unmerged ) {
+                               warn "W:svn cherry-pick ignored ($spec)\n";
+                       } else {
+                               warn
+                                 "Found merge parent (svn:mergeinfo prop): ",
+                                 $merge_tip, "\n";
+                               push @$parents, $merge_tip;
+                       }
+               }
+       }
+}
+
 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,
+       my %log_entry = ( parents => \@parents, revision => $rev,
                          log => '');
 
        my $headrev;
@@ -3264,7 +3444,7 @@ sub _rev_map_get {
                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('NH40', $buf);
+               my ($r, $c) = unpack(rev_map_fmt, $buf);
 
                if ($r < $rev) {
                        $l = $i + 24;
@@ -3320,12 +3500,23 @@ sub _new {
        }
        unless (defined $ref_id && length $ref_id) {
                $_prefix = '' unless defined($_prefix);
-               $_[2] = $ref_id = $_prefix . $Git::SVN::default_ref_id;
+               $_[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(["$ENV{GIT_DIR}/svn"]);
+       mkpath([$dir]);
        bless {
                ref_id => $ref_id, dir => $dir, index => "$dir/index",
                path => $path, config => "$ENV{GIT_DIR}/svn/config",
@@ -5498,7 +5689,7 @@ sub minimize_connections {
                        my $pfx = "svn-remote.$x->{old_repo_id}";
 
                        my $old_fetch = quotemeta("$x->{old_path}:".
-                                                 "refs/remotes/$x->{ref_id}");
+                                                 "$x->{ref_id}");
                        command_noisy(qw/config --unset/,
                                      "$pfx.fetch", '^'. $old_fetch . '$');
                        delete $r->{$x->{old_repo_id}}->
@@ -5567,7 +5758,7 @@ sub new {
        my ($class, $glob) = @_;
        my $re = $glob;
        $re =~ s!/+$!!g; # no need for trailing slashes
-       $re =~ m!^([^*]*)(\*(?:/\*)*)([^*]*)$!;
+       $re =~ m!^([^*]*)(\*(?:/\*)*)(.*)$!;
        my $temp = $re;
        my ($left, $right) = ($1, $3);
        $re = $2;