ssh-upload: prevent buffer overrun
[gitweb.git] / git-svn.perl
index 4288a05c166b0b75bba387c099daa8622fea487a..56f17002d1647d5a0e0c59a78a60bd96496dcf1b 100755 (executable)
@@ -69,8 +69,8 @@
        $_limit, $_verbose, $_incremental, $_oneline, $_l_fmt, $_show_commit,
        $_version, $_upgrade, $_authors, $_branch_all_refs, @_opt_m,
        $_merge, $_strategy, $_dry_run, $_ignore_nodate, $_non_recursive,
-       $_username, $_config_dir, $_no_auth_cache, $_xfer_delta,
-       $_pager, $_color);
+       $_username, $_config_dir, $_no_auth_cache,
+       $_pager, $_color, $_prefix);
 my (@_branch_from, %tree_map, %users, %rusers, %equiv);
 my ($_svn_can_do_switch);
 my @repo_path_split_cache;
 );
 
 my %cmd = (
-       fetch => [ \&fetch, "Download new revisions from SVN",
+       fetch => [ \&cmd_fetch, "Download new revisions from SVN",
                        { 'revision|r=s' => \$_revision, %fc_opts } ],
        init => [ \&init, "Initialize a repo for tracking" .
                          " (requires URL argument)",
                         'username=s' => \$_username,
                         'config-dir=s' => \$_config_dir,
                         'no-auth-cache' => \$_no_auth_cache,
+                        'prefix=s' => \$_prefix,
                        } ],
        'multi-fetch' => [ \&multi_fetch,
                        'Fetch multiple trees (like git-svnimport)',
@@ -216,7 +217,7 @@ sub usage {
 }
 
 sub version {
-       print "git-svn version $VERSION\n";
+       print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
        exit 0;
 }
 
@@ -293,6 +294,10 @@ sub init {
        setup_git_svn();
 }
 
+sub cmd_fetch {
+       fetch_child_id($GIT_SVN, @_);
+}
+
 sub fetch {
        check_upgrade_needed();
        $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
@@ -512,15 +517,15 @@ sub dcommit {
        }
        return if $_dry_run;
        fetch();
-       my @diff = command('diff-tree', $head, $gs, '--');
+       my @diff = command('diff-tree', 'HEAD', $gs, '--');
        my @finish;
        if (@diff) {
                @finish = qw/rebase/;
                push @finish, qw/--merge/ if $_merge;
                push @finish, "--strategy=$_strategy" if $_strategy;
-               print STDERR "W: $head and $gs differ, using @finish:\n", @diff;
+               print STDERR "W: HEAD and $gs differ, using @finish:\n", @diff;
        } else {
-               print "No changes between current $head and $gs\n",
+               print "No changes between current HEAD and $gs\n",
                      "Resetting to the latest $gs\n";
                @finish = qw/reset --mixed/;
        }
@@ -532,7 +537,7 @@ sub show_ignore {
        my $repo;
        $SVN ||= libsvn_connect($SVN_URL);
        my $r = defined $_revision ? $_revision : $SVN->get_latest_revnum;
-       libsvn_traverse_ignore(\*STDOUT, $SVN->{svn_path}, $r);
+       libsvn_traverse_ignore(\*STDOUT, '', $r);
 }
 
 sub graft_branches {
@@ -571,31 +576,29 @@ sub graft_branches {
 
 sub multi_init {
        my $url = shift;
-       $_trunk ||= 'trunk';
-       $_trunk =~ s#/+$##;
-       $url =~ s#/+$## if $url;
-       if ($_trunk !~ m#^[a-z\+]+://#) {
-               $_trunk = '/' . $_trunk if ($_trunk !~ m#^/#);
-               unless ($url) {
-                       print STDERR "E: '$_trunk' is not a complete URL ",
-                               "and a separate URL is not specified\n";
-                       exit 1;
-               }
-               $_trunk = $url . $_trunk;
-       }
-       my $ch_id;
-       if ($GIT_SVN eq 'git-svn') {
-               $ch_id = 1;
-               $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
+       unless (defined $_trunk || defined $_branches || defined $_tags) {
+               usage(1);
        }
-       init_vars();
-       unless (-d $GIT_SVN_DIR) {
-               print "GIT_SVN_ID set to 'trunk' for $_trunk\n" if $ch_id;
-               init($_trunk);
-               command_noisy('repo-config', 'svn.trunk', $_trunk);
+       if (defined $_trunk) {
+               my $trunk_url = complete_svn_url($url, $_trunk);
+               my $ch_id;
+               if ($GIT_SVN eq 'git-svn') {
+                       $ch_id = 1;
+                       $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
+               }
+               init_vars();
+               unless (-d $GIT_SVN_DIR) {
+                       if ($ch_id) {
+                               print "GIT_SVN_ID set to 'trunk' for ",
+                                     "$trunk_url ($_trunk)\n";
+                       }
+                       init($trunk_url);
+                       command_noisy('repo-config', 'svn.trunk', $trunk_url);
+               }
        }
-       complete_url_ls_init($url, $_branches, '--branches/-b', '');
-       complete_url_ls_init($url, $_tags, '--tags/-t', 'tags/');
+       $_prefix = '' unless defined $_prefix;
+       complete_url_ls_init($url, $_branches, '--branches/-b', $_prefix);
+       complete_url_ls_init($url, $_tags, '--tags/-t', $_prefix . 'tags/');
 }
 
 sub multi_fetch {
@@ -839,7 +842,6 @@ sub fetch_child_id {
        my $ref = "$GIT_DIR/refs/remotes/$id";
        defined(my $pid = open my $fh, '-|') or croak $!;
        if (!$pid) {
-               $_repack = undef;
                $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
                init_vars();
                fetch(@_);
@@ -847,7 +849,7 @@ sub fetch_child_id {
        }
        while (<$fh>) {
                print $_;
-               check_repack() if (/^r\d+ = $sha1/);
+               check_repack() if (/^r\d+ = $sha1/o);
        }
        close $fh or croak $?;
 }
@@ -872,29 +874,34 @@ sub rec_fetch {
        }
 }
 
+sub complete_svn_url {
+       my ($url, $path) = @_;
+       $path =~ s#/+$##;
+       $url =~ s#/+$## if $url;
+       if ($path !~ m#^[a-z\+]+://#) {
+               $path = '/' . $path if ($path !~ m#^/#);
+               if (!defined $url || $url !~ m#^[a-z\+]+://#) {
+                       fatal("E: '$path' is not a complete URL ",
+                             "and a separate URL is not specified\n");
+               }
+               $path = $url . $path;
+       }
+       return $path;
+}
+
 sub complete_url_ls_init {
-       my ($url, $var, $switch, $pfx) = @_;
-       unless ($var) {
+       my ($url, $path, $switch, $pfx) = @_;
+       unless ($path) {
                print STDERR "W: $switch not specified\n";
                return;
        }
-       $var =~ s#/+$##;
-       if ($var !~ m#^[a-z\+]+://#) {
-               $var = '/' . $var if ($var !~ m#^/#);
-               unless ($url) {
-                       print STDERR "E: '$var' is not a complete URL ",
-                               "and a separate URL is not specified\n";
-                       exit 1;
-               }
-               $var = $url . $var;
-       }
-       my @ls = libsvn_ls_fullurl($var);
-       my $old = $GIT_SVN;
+       my $full_url = complete_svn_url($url, $path);
+       my @ls = libsvn_ls_fullurl($full_url);
        defined(my $pid = fork) or croak $!;
        if (!$pid) {
-               foreach my $u (map { "$var/$_" } (grep m!/$!, @ls)) {
+               foreach my $u (map { "$full_url/$_" } (grep m!/$!, @ls)) {
                        $u =~ s#/+$##;
-                       if ($u !~ m!\Q$var\E/(.+)$!) {
+                       if ($u !~ m!\Q$full_url\E/(.+)$!) {
                                print STDERR "W: Unrecognized URL: $u\n";
                                die "This should never happen\n";
                        }
@@ -912,7 +919,7 @@ sub complete_url_ls_init {
        waitpid $pid, 0;
        croak $? if $?;
        my ($n) = ($switch =~ /^--(\w+)/);
-       command_noisy('repo-config', "svn.$n", $var);
+       command_noisy('repo-config', "svn.$n", $full_url);
 }
 
 sub common_prefix {
@@ -1079,7 +1086,7 @@ sub graft_merge_msg {
        my ($grafts, $l_map, $u, $p, @re) = @_;
 
        my $x = $l_map->{$u}->{$p};
-       my $rl = rev_list_raw($x);
+       my $rl = rev_list_raw("refs/remotes/$x");
        while (my $c = next_rev_list_entry($rl)) {
                foreach my $re (@re) {
                        my (@br) = ($c->{m} =~ /$re/g);
@@ -1098,7 +1105,8 @@ sub read_uuid {
 
 sub verify_ref {
        my ($ref) = @_;
-       eval { command_oneline([ 'rev-parse', $ref ], { STDERR => 0 }) };
+       eval { command_oneline([ 'rev-parse', '--verify', $ref ],
+                              { STDERR => 0 }); };
 }
 
 sub repo_path_split {
@@ -1404,7 +1412,6 @@ sub git_commit {
 
        # this output is read via pipe, do not change:
        print "r$log_msg->{revision} = $commit\n";
-       check_repack();
        return $commit;
 }
 
@@ -2044,13 +2051,6 @@ sub libsvn_connect {
                              config => $config,
                              pool => SVN::Pool->new,
                              auth_provider_callbacks => $callbacks);
-
-       my $df = $ENV{GIT_SVN_DELTA_FETCH};
-       if (defined $df) {
-               $_xfer_delta = $df;
-       } else {
-               $_xfer_delta = ($url =~ m#^file://#) ? undef : 1;
-       }
        $ra->{svn_path} = $url;
        $ra->{repos_root} = $ra->get_repos_root;
        $ra->{svn_path} =~ s#^\Q$ra->{repos_root}\E/*##;
@@ -2082,49 +2082,6 @@ sub libsvn_dup_ra {
                     auth auth_provider_callbacks repos_root svn_path/);
 }
 
-sub libsvn_get_file {
-       my ($gui, $f, $rev, $chg, $untracked) = @_;
-       $f =~ s#^/##;
-       print "\t$chg\t$f\n" unless $_q;
-
-       my ($hash, $pid, $in, $out);
-       my $pool = SVN::Pool->new;
-       defined($pid = open3($in, $out, '>&STDERR',
-                               qw/git-hash-object -w --stdin/)) or croak $!;
-       # redirect STDOUT for SVN 1.1.x compatibility
-       open my $stdout, '>&', \*STDOUT or croak $!;
-       open STDOUT, '>&', $in or croak $!;
-       my ($r, $props) = $SVN->get_file($f, $rev, \*STDOUT, $pool);
-       $in->flush == 0 or croak $!;
-       open STDOUT, '>&', $stdout or croak $!;
-       close $in or croak $!;
-       close $stdout or croak $!;
-       $pool->clear;
-       chomp($hash = do { local $/; <$out> });
-       close $out or croak $!;
-       waitpid $pid, 0;
-       $hash =~ /^$sha1$/o or die "not a sha1: $hash\n";
-
-       my $mode = exists $props->{'svn:executable'} ? '100755' : '100644';
-       if (exists $props->{'svn:special'}) {
-               $mode = '120000';
-               my $link = `git-cat-file blob $hash`; # no chomping symlinks
-               $link =~ s/^link // or die "svn:special file with contents: <",
-                                               $link, "> is not understood\n";
-               defined($pid = open3($in, $out, '>&STDERR',
-                               qw/git-hash-object -w --stdin/)) or croak $!;
-               print $in $link;
-               $in->flush == 0 or croak $!;
-               close $in or croak $!;
-               chomp($hash = do { local $/; <$out> });
-               close $out or croak $!;
-               waitpid $pid, 0;
-               $hash =~ /^$sha1$/o or die "not a sha1: $hash\n";
-       }
-       %{$untracked->{file_prop}->{$f}} = %$props;
-       print $gui $mode,' ',$hash,"\t",$f,"\0" or croak $!;
-}
-
 sub uri_encode {
        my ($f) = @_;
        $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg;
@@ -2232,10 +2189,6 @@ sub process_rm {
 }
 
 sub libsvn_fetch {
-       $_xfer_delta ? libsvn_fetch_delta(@_) : libsvn_fetch_full(@_);
-}
-
-sub libsvn_fetch_delta {
        my ($last_commit, $paths, $rev, $author, $date, $msg) = @_;
        my $pool = SVN::Pool->new;
        my $ed = SVN::Git::Fetcher->new({ c => $last_commit, q => $_q });
@@ -2251,66 +2204,6 @@ sub libsvn_fetch_delta {
        libsvn_log_entry($rev, $author, $date, $msg, [$last_commit], $ed);
 }
 
-sub libsvn_fetch_full {
-       my ($last_commit, $paths, $rev, $author, $date, $msg) = @_;
-       my ($gui, $ctx) = command_input_pipe(qw/update-index -z --index-info/);
-       my %amr;
-       my $ut = { empty => {}, dir_prop => {}, file_prop => {} };
-       my $p = $SVN->{svn_path};
-       foreach my $f (keys %$paths) {
-               my $m = $paths->{$f}->action();
-               if (length $p) {
-                       $f =~ s#^/\Q$p\E/##;
-                       next if $f =~ m#^/#;
-               } else {
-                       $f =~ s#^/##;
-               }
-               if ($m =~ /^[DR]$/) {
-                       my $t = process_rm($gui, $last_commit, $f, $_q);
-                       if ($m eq 'D') {
-                               $ut->{empty}->{$f} = 0 if $t == $SVN::Node::dir;
-                               next;
-                       }
-                       # 'R' can be file replacements, too, right?
-               }
-               my $pool = SVN::Pool->new;
-               my $t = $SVN->check_path($f, $rev, $pool);
-               if ($t == $SVN::Node::file) {
-                       if ($m =~ /^[AMR]$/) {
-                               $amr{$f} = $m;
-                       } else {
-                               die "Unrecognized action: $m, ($f r$rev)\n";
-                       }
-               } elsif ($t == $SVN::Node::dir && $m =~ /^[AR]$/) {
-                       my @traversed = ();
-                       libsvn_traverse($gui, '', $f, $rev, \@traversed, $ut);
-                       if (@traversed) {
-                               foreach (@traversed) {
-                                       $amr{$_} = $m;
-                               }
-                       } else {
-                               my ($dir, $file) = ($f =~ m#^(.*?)/?([^/]+)$#);
-                               delete $ut->{empty}->{$dir};
-                               $ut->{empty}->{$f} = 1;
-                       }
-               }
-               $pool->clear;
-       }
-       foreach (keys %amr) {
-               libsvn_get_file($gui, $_, $rev, $amr{$_}, $ut);
-               my ($d) = ($_ =~ m#^(.*?)/?(?:[^/]+)$#);
-               delete $ut->{empty}->{$d};
-       }
-       unless (exists $ut->{dir_prop}->{''}) {
-               my $pool = SVN::Pool->new;
-               my (undef, undef, $props) = $SVN->get_dir('', $rev, $pool);
-               %{$ut->{dir_prop}->{''}} = %$props;
-               $pool->clear;
-       }
-       command_close_pipe($gui, $ctx);
-       libsvn_log_entry($rev, $author, $date, $msg, [$last_commit], $ut);
-}
-
 sub svn_grab_base_rev {
        my $c = eval { command_oneline([qw/rev-parse --verify/,
                                        "refs/remotes/$GIT_SVN^0"],
@@ -2362,41 +2255,6 @@ sub libsvn_parse_revision {
                "Try using the command-line svn client instead\n";
 }
 
-sub libsvn_traverse {
-       my ($gui, $pfx, $path, $rev, $files, $untracked) = @_;
-       my $cwd = length $pfx ? "$pfx/$path" : $path;
-       my $pool = SVN::Pool->new;
-       $cwd =~ s#^\Q$SVN->{svn_path}\E##;
-       my $nr = 0;
-       my ($dirent, $r, $props) = $SVN->get_dir($cwd, $rev, $pool);
-       %{$untracked->{dir_prop}->{$cwd}} = %$props;
-       foreach my $d (keys %$dirent) {
-               my $t = $dirent->{$d}->kind;
-               if ($t == $SVN::Node::dir) {
-                       my $i = libsvn_traverse($gui, $cwd, $d, $rev,
-                                               $files, $untracked);
-                       if ($i) {
-                               $nr += $i;
-                       } else {
-                               $untracked->{empty}->{"$cwd/$d"} = 1;
-                       }
-               } elsif ($t == $SVN::Node::file) {
-                       $nr++;
-                       my $file = "$cwd/$d";
-                       if (defined $files) {
-                               push @$files, $file;
-                       } else {
-                               libsvn_get_file($gui, $file, $rev, 'A',
-                                               $untracked);
-                               my ($dir) = ($file =~ m#^(.*?)/?(?:[^/]+)$#);
-                               delete $untracked->{empty}->{$dir};
-                       }
-               }
-       }
-       $pool->clear;
-       $nr;
-}
-
 sub libsvn_traverse_ignore {
        my ($fh, $path, $r) = @_;
        $path =~ s#^/+##g;
@@ -2488,8 +2346,8 @@ sub libsvn_find_parent_branch {
                print STDERR "Found branch parent: ($GIT_SVN) $parent\n";
                command_noisy('read-tree', $parent);
                unless (libsvn_can_do_switch()) {
-                       return libsvn_fetch_full($parent, $paths, $rev,
-                                               $author, $date, $msg);
+                       return _libsvn_new_tree($paths, $rev, $author, $date,
+                                               $msg, [$parent]);
                }
                # do_switch works with svn/trunk >= r22312, but that is not
                # included with SVN 1.4.2 (the latest version at the moment),
@@ -2514,7 +2372,7 @@ sub libsvn_find_parent_branch {
 
 sub libsvn_get_log {
        my ($ra, @args) = @_;
-       $args[4]-- if $args[4] && $_xfer_delta && ! $_follow_parent;
+       $args[4]-- if $args[4] && ! $_follow_parent;
        if ($SVN::Core::VERSION le '1.2.0') {
                splice(@args, 3, 1);
        }
@@ -2525,28 +2383,23 @@ sub libsvn_new_tree {
        if (my $log_entry = libsvn_find_parent_branch(@_)) {
                return $log_entry;
        }
-       my ($paths, $rev, $author, $date, $msg) = @_;
-       my $ut;
-       if ($_xfer_delta) {
-               my $pool = SVN::Pool->new;
-               my $ed = SVN::Git::Fetcher->new({q => $_q});
-               my $reporter = $SVN->do_update($rev, '', 1, $ed, $pool);
-               my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
-               $reporter->set_path('', $rev, 1, @lock, $pool);
-               $reporter->finish_report($pool);
-               $pool->clear;
-               unless ($ed->{git_commit_ok}) {
-                       die "SVN connection failed somewhere...\n";
-               }
-               $ut = $ed;
-       } else {
-               $ut = { empty => {}, dir_prop => {}, file_prop => {} };
-               my ($gui, $ctx) = command_input_pipe(qw/update-index
-                                                    -z --index-info/);
-               libsvn_traverse($gui, '', $SVN->{svn_path}, $rev, undef, $ut);
-               command_close_pipe($gui, $ctx);
+       my ($paths, $rev, $author, $date, $msg) = @_; # $pool is last
+       _libsvn_new_tree($paths, $rev, $author, $date, $msg, []);
+}
+
+sub _libsvn_new_tree {
+       my ($paths, $rev, $author, $date, $msg, $parents) = @_;
+       my $pool = SVN::Pool->new;
+       my $ed = SVN::Git::Fetcher->new({q => $_q});
+       my $reporter = $SVN->do_update($rev, '', 1, $ed, $pool);
+       my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
+       $reporter->set_path('', $rev, 1, @lock, $pool);
+       $reporter->finish_report($pool);
+       $pool->clear;
+       unless ($ed->{git_commit_ok}) {
+               die "SVN connection failed somewhere...\n";
        }
-       libsvn_log_entry($rev, $author, $date, $msg, [], $ut);
+       libsvn_log_entry($rev, $author, $date, $msg, $parents, $ed);
 }
 
 sub find_graft_path_commit {
@@ -2634,7 +2487,7 @@ sub libsvn_ls_fullurl {
        my $pool = SVN::Pool->new;
        my $r = defined $_revision ? $_revision : $ra->get_latest_revnum;
        my ($dirent, undef, undef) = $ra->get_dir('', $r, $pool);
-       foreach my $d (keys %$dirent) {
+       foreach my $d (sort keys %$dirent) {
                if ($dirent->{$d}->kind == $SVN::Node::dir) {
                        push @ret, "$d/"; # add '/' for compat with cli svn
                }