sha1_name: add get_sha1_with_context()
[gitweb.git] / git-svn.perl
index 650c9e5f02ead07351629d6572e82c3a9ac7ef92..09c4ca56f0c9af9c6ff49d3b3a197a8e30602520 100755 (executable)
@@ -26,6 +26,7 @@
                $ENV{SVN_SSH} = $ENV{GIT_SSH};
                if ($^O eq 'msys') {
                        $ENV{SVN_SSH} =~ s/\\/\\\\/g;
+                       $ENV{SVN_SSH} =~ s/(.*)/"$1"/;
                }
        }
 }
 $| = 1; # unbuffer STDOUT
 
 sub fatal (@) { print STDERR "@_\n"; exit 1 }
-require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
-require SVN::Ra;
-require SVN::Delta;
-if ($SVN::Core::VERSION lt '1.1.0') {
-       fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
+sub _req_svn {
+       require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
+       require SVN::Ra;
+       require SVN::Delta;
+       if ($SVN::Core::VERSION lt '1.1.0') {
+               fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)";
+       }
 }
 my $can_compress = eval { require Compress::Zlib; 1};
 push @Git::SVN::Ra::ISA, 'SVN::Ra';
@@ -115,6 +118,7 @@ BEGIN
                  'use-svm-props' => sub { $icv{useSvmProps} = 1 },
                  'use-svnsync-props' => sub { $icv{useSvnsyncProps} = 1 },
                  'rewrite-root=s' => sub { $icv{rewriteRoot} = $_[1] },
+                 'rewrite-uuid=s' => sub { $icv{rewriteUUID} = $_[1] },
                   %remote_opts );
 my %cmt_opts = ( 'edit|e' => \$_edit,
                'rmdir' => \$SVN::Git::Editor::_rmdir,
@@ -155,12 +159,16 @@ BEGIN
                    { 'message|m=s' => \$_message,
                      'destination|d=s' => \$_branch_dest,
                      'dry-run|n' => \$_dry_run,
-                     'tag|t' => \$_tag } ],
+                     'tag|t' => \$_tag,
+                     'username=s' => \$Git::SVN::Prompt::_username,
+                     'commit-url=s' => \$_commit_url } ],
        tag => [ sub { $_tag = 1; cmd_branch(@_) },
                 'Create a tag in the SVN repository',
                 { 'message|m=s' => \$_message,
                   'destination|d=s' => \$_branch_dest,
-                  'dry-run|n' => \$_dry_run } ],
+                  'dry-run|n' => \$_dry_run,
+                  'username=s' => \$Git::SVN::Prompt::_username,
+                  'commit-url=s' => \$_commit_url } ],
        'set-tree' => [ \&cmd_set_tree,
                        "Set an SVN repository to a git tree-ish",
                        { 'stdin' => \$_stdin, %cmt_opts, %fc_opts, } ],
@@ -343,6 +351,7 @@ sub usage {
 }
 
 sub version {
+       ::_req_svn();
        print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
        exit 0;
 }
@@ -361,7 +370,6 @@ sub do_git_init_db {
                command_noisy(@init_db);
                $_repository = Git->repository(Repository => ".git");
        }
-       command_noisy('config', 'core.autocrlf', 'false');
        my $set;
        my $pfx = "svn-remote.$Git::SVN::default_repo_id";
        foreach my $i (keys %icv) {
@@ -708,7 +716,23 @@ sub cmd_branch {
                }
        }
        my ($lft, $rgt) = @{ $glob->{path} }{qw/left right/};
-       my $dst = join '/', $remote->{url}, $lft, $branch_name, ($rgt || ());
+       my $url;
+       if (defined $_commit_url) {
+               $url = $_commit_url;
+       } else {
+               $url = eval { command_oneline('config', '--get',
+                       "svn-remote.$gs->{repo_id}.commiturl") };
+               if (!$url) {
+                       $url = $remote->{url};
+               }
+       }
+       my $dst = join '/', $url, $lft, $branch_name, ($rgt || ());
+
+       if ($dst =~ /^https:/ && $src =~ /^http:/) {
+               $src=~s/^http:/https:/;
+       }
+
+       ::_req_svn();
 
        my $ctx = SVN::Client->new(
                auth    => Git::SVN::Ra::_auth_providers(),
@@ -1078,6 +1102,7 @@ sub cmd_info {
        if ($@) {
                $result .= "Repository Root: (offline)\n";
        }
+       ::_req_svn();
        $result .= "Repository UUID: $uuid\n" unless $diff_status eq "A" &&
                ($SVN::Core::VERSION le '1.5.4' || $file_type ne "dir");
        $result .= "Revision: " . ($diff_status eq "A" ? 0 : $rev) . "\n";
@@ -1160,6 +1185,7 @@ sub cmd_reset {
                    "history\n";
        }
        my ($r, $c) = $gs->find_rev_before($target, not $_fetch_parent);
+       die "Cannot find SVN revision $target\n" unless defined($c);
        $gs->rev_map_set($r, $c, 'reset', $uuid);
        print "r$r = $c ($gs->{ref_id})\n";
 }
@@ -1636,6 +1662,7 @@ package Git::SVN;
 use File::Copy qw/copy/;
 use IPC::Open3;
 use Memoize;  # core since 5.8.0, Jul 2002
+use Memoize::Storable;
 
 my ($_gc_nr, $_gc_period);
 
@@ -1806,8 +1833,8 @@ sub read_all_remotes {
                        my $rs = {
                            t => $t,
                            remote => $remote,
-                           path => Git::SVN::GlobSpec->new($local_ref),
-                           ref => Git::SVN::GlobSpec->new($remote_ref) };
+                           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";
@@ -2060,6 +2087,14 @@ sub refname {
        # .. 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;
 }
 
@@ -2189,6 +2224,10 @@ sub svnsync {
                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:
@@ -2470,6 +2509,20 @@ sub rewrite_root {
        $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}) .
@@ -2783,8 +2836,9 @@ sub mkemptydirs {
        foreach my $d (sort keys %empty_dirs) {
                $d = uri_decode($d);
                $d =~ s/$strip//;
+               next unless length($d);
                next if -d $d;
-               if (-e _) {
+               if (-e $d) {
                        warn "$d exists but is not a directory\n";
                } else {
                        print "creating empty directory: $d\n";
@@ -2954,7 +3008,7 @@ sub find_extra_svk_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 $url = $self->{url};
                        my $repos_root = $url;
                        my $branch_from = $path;
                        $branch_from =~ s{^/}{};
@@ -3052,12 +3106,65 @@ sub check_cherry_pick {
        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);
 }
 
-BEGIN {
-       memoize 'lookup_svn_merge';
-       memoize 'check_cherry_pick';
+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}"));
+}
+
+# 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;
+
+               tie my %lookup_svn_merge_cache => 'Memoize::Storable',
+                   "$cache_path/lookup_svn_merge.db", 'nstore';
+               memoize 'lookup_svn_merge',
+                       SCALAR_CACHE => 'FAULT',
+                       LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache],
+               ;
+
+               tie my %check_cherry_pick_cache => 'Memoize::Storable',
+                   "$cache_path/check_cherry_pick.db", 'nstore';
+               memoize 'check_cherry_pick',
+                       SCALAR_CACHE => 'FAULT',
+                       LIST_CACHE => ['HASH' => \%check_cherry_pick_cache],
+               ;
+
+               tie my %has_no_changes_cache => 'Memoize::Storable',
+                   "$cache_path/has_no_changes.db", 'nstore';
+               memoize 'has_no_changes',
+                       SCALAR_CACHE => ['HASH' => \%has_no_changes_cache],
+                       LIST_CACHE => 'FAULT',
+               ;
+       }
 }
 
 sub parents_exclude {
@@ -3101,13 +3208,15 @@ 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->rewrite_root || $self->{url};
+       my $url = $self->{url};
        my $uuid = $self->ra_uuid;
        my %ranges;
        for my $merge ( @merges ) {
@@ -3134,10 +3243,21 @@ sub find_extra_svn_parents {
                my $ranges = $ranges{$merge_tip};
 
                # check out 'new' tips
-               my $merge_base = command_oneline(
-                       "merge-base",
-                       @$parents, $merge_tip,
-                      );
+               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(
@@ -3168,7 +3288,7 @@ sub find_extra_svn_parents {
                                        "$new_parents[$i]..$new_parents[$j]",
                                       );
                                if ( !$revs ) {
-                                       undef($new_parents[$i]);
+                                       undef($new_parents[$j]);
                                }
                        }
                }
@@ -3253,6 +3373,10 @@ sub make_log_entry {
                        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;
@@ -3283,10 +3407,10 @@ sub make_log_entry {
        } else {
                my $url = $self->metadata_url;
                remove_username($url);
-               $log_entry{metadata} = "$url\@$rev " .
-                                      $self->ra->get_uuid;
-               $email ||= "$author\@" . $self->ra->get_uuid;
-               $commit_email ||= "$author\@" . $self->ra->get_uuid;
+               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;
@@ -3368,7 +3492,7 @@ sub rebuild {
                                '--');
        my $metadata_url = $self->metadata_url;
        remove_username($metadata_url);
-       my $svn_uuid = $self->ra_uuid;
+       my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid;
        my $c;
        while (<$log>) {
                if ( m{^commit ($::sha1)$} ) {
@@ -3491,6 +3615,7 @@ sub mkfile {
 
 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";
@@ -3857,18 +3982,25 @@ sub username {
 
 sub _read_password {
        my ($prompt, $realm) = @_;
-       print STDERR $prompt;
-       STDERR->flush;
-       require Term::ReadKey;
-       Term::ReadKey::ReadMode('noecho');
        my $password = '';
-       while (defined(my $key = Term::ReadKey::ReadKey(0))) {
-               last if $key =~ /[\012\015]/; # \n\r
-               $password .= $key;
+       if (exists $ENV{GIT_ASKPASS}) {
+               open(PH, "-|", $ENV{GIT_ASKPASS}, $prompt);
+               $password = <PH>;
+               $password =~ s/[\012\015]//; # \n\r
+               close(PH);
+       } else {
+               print STDERR $prompt;
+               STDERR->flush;
+               require Term::ReadKey;
+               Term::ReadKey::ReadMode('noecho');
+               while (defined(my $key = Term::ReadKey::ReadKey(0))) {
+                       last if $key =~ /[\012\015]/; # \n\r
+                       $password .= $key;
+               }
+               Term::ReadKey::ReadMode('restore');
+               print STDERR "\n";
+               STDERR->flush;
        }
-       Term::ReadKey::ReadMode('restore');
-       print STDERR "\n";
-       STDERR->flush;
        $password;
 }
 
@@ -3877,7 +4009,6 @@ package SVN::Git::Fetcher;
 use strict;
 use warnings;
 use Carp qw/croak/;
-use File::Temp qw/tempfile/;
 use IO::File qw//;
 use vars qw/$_ignore_regex/;
 
@@ -4750,6 +4881,8 @@ sub new {
        $url =~ s!/+$!!;
        return $RA if ($RA && $RA->{url} eq $url);
 
+       ::_req_svn();
+
        SVN::_Core::svn_config_ensure($config_dir, undef);
        my ($baton, $callbacks) = SVN::Core::auth_open_helper(_auth_providers);
        my $config = SVN::Core::config_get_config($config_dir);
@@ -5157,6 +5290,7 @@ sub match_globs {
                        next if (length $g->{path}->{right} &&
                                 ($self->check_path($p, $r) !=
                                  $SVN::Node::dir));
+                       next unless $p =~ /$g->{path}->{regex}/;
                        $exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
                                         $g->{ref}->full_path($de), 1);
                }
@@ -5349,7 +5483,12 @@ sub git_svn_log_cmd {
 
 # adapted from pager.c
 sub config_pager {
-       chomp(my $pager = command_oneline(qw(var GIT_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;
        }
@@ -5357,7 +5496,7 @@ sub config_pager {
 }
 
 sub run_pager {
-       return unless -t *STDOUT && defined $pager;
+       return unless defined $pager;
        pipe my ($rfd, $wfd) or return;
        defined(my $pid = fork) or ::fatal "Can't fork: $!";
        if (!$pid) {
@@ -5930,29 +6069,48 @@ package Git::SVN::GlobSpec;
 use warnings;
 
 sub new {
-       my ($class, $glob) = @_;
+       my ($class, $glob, $pattern_ok) = @_;
        my $re = $glob;
        $re =~ s!/+$!!g; # no need for trailing slashes
-       $re =~ m!^([^*]*)(\*(?:/\*)*)(.*)$!;
-       my $temp = $re;
-       my ($left, $right) = ($1, $3);
-       $re = $2;
-       my $depth = $re =~ tr/*/*/;
-       if ($depth != $temp =~ tr/*/*/) {
-               die "Only one set of wildcard directories " .
-                       "(e.g. '*' or '*/*/*') is supported: '$glob'\n";
+       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 for glob: '$glob'\n";
-       }
-       $re =~ s!\*!\[^/\]*!g;
-       $re = quotemeta($left) . "($re)" . quotemeta($right);
-       if (length $left && !($left =~ s!/+$!!g)) {
-               die "Missing trailing '/' on left side of: '$glob' ($left)\n";
-       }
-       if (length $right && !($right =~ s!^/+!!g)) {
-               die "Missing leading '/' on right side of: '$glob' ($right)\n";
+               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;