This slices off another 600 or so lines from the frighteningly long
git-svn.perl script.
The Git::SVN::Ra interface is similar enough to SVN::Ra that it is
probably safe to ignore most of its implementation on first reading.
(Documenting or moving functions that do not fit that pattern is left
as an exercise to the interested reader.)
Signed-off-by: Jonathan Nieder <jrnieder@xxxxxxxxx>
---
git-svn.perl | 612 +-----------------------------------------------
perl/Git/SVN/Ra.pm | 658 ++++++++++++++++++++++++++++++++++++++++++++++++++++
perl/Makefile.PL | 1 +
3 files changed, 660 insertions(+), 611 deletions(-)
create mode 100644 perl/Git/SVN/Ra.pm
diff --git a/git-svn.perl b/git-svn.perl
index 7cec4416..24c0af2e 100755
--- a/git-svn.perl
+++ b/git-svn.perl
@@ -67,7 +67,6 @@ sub _req_svn {
}
}
my $can_compress = eval { require Compress::Zlib; 1};
-push @Git::SVN::Ra::ISA, 'SVN::Ra';
use Carp qw/croak/;
use Digest::MD5;
use IO::File qw//;
@@ -80,6 +79,7 @@ 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
@@ -4326,616 +4326,6 @@ sub remove_username {
$_[0] =~ s{^([^:]*://)[^@]+@}{$1};
}
-package Git::SVN::Ra;
-use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
-use strict;
-use warnings;
-my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
-
-BEGIN {
- # enforce temporary pool usage for some simple functions
- no strict 'refs';
- for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root
- get_file/) {
- my $SUPER = "SUPER::$f";
- *$f = sub {
- my $self = shift;
- my $pool = SVN::Pool->new;
- my @ret = $self->$SUPER(@_,$pool);
- $pool->clear;
- wantarray ? @ret : $ret[0];
- };
- }
-}
-
-sub _auth_providers () {
- my @rv = (
- SVN::Client::get_simple_provider(),
- SVN::Client::get_ssl_server_trust_file_provider(),
- SVN::Client::get_simple_prompt_provider(
- \&Git::SVN::Prompt::simple, 2),
- SVN::Client::get_ssl_client_cert_file_provider(),
- SVN::Client::get_ssl_client_cert_prompt_provider(
- \&Git::SVN::Prompt::ssl_client_cert, 2),
- SVN::Client::get_ssl_client_cert_pw_file_provider(),
- SVN::Client::get_ssl_client_cert_pw_prompt_provider(
- \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
- SVN::Client::get_username_provider(),
- SVN::Client::get_ssl_server_trust_prompt_provider(
- \&Git::SVN::Prompt::ssl_server_trust),
- SVN::Client::get_username_prompt_provider(
- \&Git::SVN::Prompt::username, 2)
- );
-
- # earlier 1.6.x versions would segfault, and <= 1.5.x didn't have
- # this function
- if (::compare_svn_version('1.6.12') > 0) {
- my $config = SVN::Core::config_get_config($config_dir);
- my ($p, @a);
- # config_get_config returns all config files from
- # ~/.subversion, auth_get_platform_specific_client_providers
- # just wants the config "file".
- @a = ($config->{'config'}, undef);
- $p = SVN::Core::auth_get_platform_specific_client_providers(@a);
- # Insert the return value from
- # auth_get_platform_specific_providers
- unshift @rv, @$p;
- }
- \@rv;
-}
-
-sub escape_uri_only {
- my ($uri) = @_;
- my @tmp;
- foreach (split m{/}, $uri) {
- s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
- push @tmp, $_;
- }
- join('/', @tmp);
-}
-
-sub escape_url {
- my ($url) = @_;
- if ($url =~ m#^(https?)://([^/]+)(.*)$#) {
- my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
- $url = "$scheme://$domain$uri";
- }
- $url;
-}
-
-sub new {
- my ($class, $url) = @_;
- $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);
- $RA = undef;
- my $dont_store_passwords = 1;
- my $conf_t = ${$config}{'config'};
- {
- no warnings 'once';
- # The usage of $SVN::_Core::SVN_CONFIG_* variables
- # produces warnings that variables are used only once.
- # I had not found the better way to shut them up, so
- # the warnings of type 'once' are disabled in this block.
- if (SVN::_Core::svn_config_get_bool($conf_t,
- $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
- $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS,
- 1) == 0) {
- SVN::_Core::svn_auth_set_parameter($baton,
- $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS,
- bless (\$dont_store_passwords, "_p_void"));
- }
- if (SVN::_Core::svn_config_get_bool($conf_t,
- $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
- $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS,
- 1) == 0) {
- $Git::SVN::Prompt::_no_auth_cache = 1;
- }
- } # no warnings 'once'
- my $self = SVN::Ra->new(url => escape_url($url), auth => $baton,
- config => $config,
- pool => SVN::Pool->new,
- auth_provider_callbacks => $callbacks);
- $self->{url} = $url;
- $self->{svn_path} = $url;
- $self->{repos_root} = $self->get_repos_root;
- $self->{svn_path} =~ s#^\Q$self->{repos_root}\E(/|$)##;
- $self->{cache} = { check_path => { r => 0, data => {} },
- get_dir => { r => 0, data => {} } };
- $RA = bless $self, $class;
-}
-
-sub check_path {
- my ($self, $path, $r) = @_;
- my $cache = $self->{cache}->{check_path};
- if ($r == $cache->{r} && exists $cache->{data}->{$path}) {
- return $cache->{data}->{$path};
- }
- my $pool = SVN::Pool->new;
- my $t = $self->SUPER::check_path($path, $r, $pool);
- $pool->clear;
- if ($r != $cache->{r}) {
- %{$cache->{data}} = ();
- $cache->{r} = $r;
- }
- $cache->{data}->{$path} = $t;
-}
-
-sub get_dir {
- my ($self, $dir, $r) = @_;
- my $cache = $self->{cache}->{get_dir};
- if ($r == $cache->{r}) {
- if (my $x = $cache->{data}->{$dir}) {
- return wantarray ? @$x : $x->[0];
- }
- }
- my $pool = SVN::Pool->new;
- my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
- my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
- $pool->clear;
- if ($r != $cache->{r}) {
- %{$cache->{data}} = ();
- $cache->{r} = $r;
- }
- $cache->{data}->{$dir} = [ \%dirents, $r, $props ];
- wantarray ? (\%dirents, $r, $props) : \%dirents;
-}
-
-sub DESTROY {
- # do not call the real DESTROY since we store ourselves in $RA
-}
-
-# get_log(paths, start, end, limit,
-# discover_changed_paths, strict_node_history, receiver)
-sub get_log {
- my ($self, @args) = @_;
- my $pool = SVN::Pool->new;
-
- # svn_log_changed_path_t objects passed to get_log are likely to be
- # overwritten even if only the refs are copied to an external variable,
- # so we should dup the structures in their entirety. Using an
- # externally passed pool (instead of our temporary and quickly cleared
- # pool in Git::SVN::Ra) does not help matters at all...
- my $receiver = pop @args;
- my $prefix = "/".$self->{svn_path};
- $prefix =~ s#/+($)##;
- my $prefix_regex = qr#^\Q$prefix\E#;
- push(@args, sub {
- my ($paths) = $_[0];
- return &$receiver(@_) unless $paths;
- $_[0] = ();
- foreach my $p (keys %$paths) {
- my $i = $paths->{$p};
- # Make path relative to our url, not repos_root
- $p =~ s/$prefix_regex//;
- my %s = map { $_ => $i->$_; }
- qw/copyfrom_path copyfrom_rev action/;
- if ($s{'copyfrom_path'}) {
- $s{'copyfrom_path'} =~ s/$prefix_regex//;
- }
- $_[0]{$p} = \%s;
- }
- &$receiver(@_);
- });
-
-
- # the limit parameter was not supported in SVN 1.1.x, so we
- # drop it. Therefore, the receiver callback passed to it
- # is made aware of this limitation by being wrapped if
- # the limit passed to is being wrapped.
- if (::compare_svn_version('1.2.0') <= 0) {
- my $limit = splice(@args, 3, 1);
- if ($limit > 0) {
- my $receiver = pop @args;
- push(@args, sub { &$receiver(@_) if (--$limit >= 0) });
- }
- }
- my $ret = $self->SUPER::get_log(@args, $pool);
- $pool->clear;
- $ret;
-}
-
-sub trees_match {
- my ($self, $url1, $rev1, $url2, $rev2) = @_;
- my $ctx = SVN::Client->new(auth => _auth_providers);
- my $out = IO::File->new_tmpfile;
-
- # older SVN (1.1.x) doesn't take $pool as the last parameter for
- # $ctx->diff(), so we'll create a default one
- my $pool = SVN::Pool->new_default_sub;
-
- $ra_invalid = 1; # this will open a new SVN::Ra connection to $url1
- $ctx->diff([], $url1, $rev1, $url2, $rev2, 1, 1, 0, $out, $out);
- $out->flush;
- my $ret = (($out->stat)[7] == 0);
- close $out or croak $!;
-
- $ret;
-}
-
-sub get_commit_editor {
- my ($self, $log, $cb, $pool) = @_;
-
- my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef, 0) : ();
- $self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
-}
-
-sub gs_do_update {
- my ($self, $rev_a, $rev_b, $gs, $editor) = @_;
- my $new = ($rev_a == $rev_b);
- my $path = $gs->{path};
-
- if ($new && -e $gs->{index}) {
- unlink $gs->{index} or die
- "Couldn't unlink index: $gs->{index}: $!\n";
- }
- my $pool = SVN::Pool->new;
- $editor->set_path_strip($path);
- my (@pc) = split m#/#, $path;
- my $reporter = $self->do_update($rev_b, (@pc ? shift @pc : ''),
- 1, $editor, $pool);
- my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
-
- # Since we can't rely on svn_ra_reparent being available, we'll
- # just have to do some magic with set_path to make it so
- # we only want a partial path.
- my $sp = '';
- my $final = join('/', @pc);
- while (@pc) {
- $reporter->set_path($sp, $rev_b, 0, @lock, $pool);
- $sp .= '/' if length $sp;
- $sp .= shift @pc;
- }
- die "BUG: '$sp' != '$final'\n" if ($sp ne $final);
-
- $reporter->set_path($sp, $rev_a, $new, @lock, $pool);
-
- $reporter->finish_report($pool);
- $pool->clear;
- $editor->{git_commit_ok};
-}
-
-# this requires SVN 1.4.3 or later (do_switch didn't work before 1.4.3, and
-# svn_ra_reparent didn't work before 1.4)
-sub gs_do_switch {
- my ($self, $rev_a, $rev_b, $gs, $url_b, $editor) = @_;
- my $path = $gs->{path};
- my $pool = SVN::Pool->new;
-
- my $full_url = $self->{url};
- my $old_url = $full_url;
- $full_url .= '/' . $path if length $path;
- my ($ra, $reparented);
-
- if ($old_url =~ m#^svn(\+ssh)?://# ||
- ($full_url =~ m#^https?://# &&
- escape_url($full_url) ne $full_url)) {
- $_[0] = undef;
- $self = undef;
- $RA = undef;
- $ra = Git::SVN::Ra->new($full_url);
- $ra_invalid = 1;
- } elsif ($old_url ne $full_url) {
- SVN::_Ra::svn_ra_reparent($self->{session}, $full_url, $pool);
- $self->{url} = $full_url;
- $reparented = 1;
- }
-
- $ra ||= $self;
- $url_b = escape_url($url_b);
- my $reporter = $ra->do_switch($rev_b, '', 1, $url_b, $editor, $pool);
- my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
- $reporter->set_path('', $rev_a, 0, @lock, $pool);
- $reporter->finish_report($pool);
-
- if ($reparented) {
- SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
- $self->{url} = $old_url;
- }
-
- $pool->clear;
- $editor->{git_commit_ok};
-}
-
-sub longest_common_path {
- my ($gsv, $globs) = @_;
- my %common;
- my $common_max = scalar @$gsv;
-
- foreach my $gs (@$gsv) {
- my @tmp = split m#/#, $gs->{path};
- my $p = '';
- foreach (@tmp) {
- $p .= length($p) ? "/$_" : $_;
- $common{$p} ||= 0;
- $common{$p}++;
- }
- }
- $globs ||= [];
- $common_max += scalar @$globs;
- foreach my $glob (@$globs) {
- my @tmp = split m#/#, $glob->{path}->{left};
- my $p = '';
- foreach (@tmp) {
- $p .= length($p) ? "/$_" : $_;
- $common{$p} ||= 0;
- $common{$p}++;
- }
- }
-
- my $longest_path = '';
- foreach (sort {length $b <=> length $a} keys %common) {
- if ($common{$_} == $common_max) {
- $longest_path = $_;
- last;
- }
- }
- $longest_path;
-}
-
-sub gs_fetch_loop_common {
- my ($self, $base, $head, $gsv, $globs) = @_;
- return if ($base > $head);
- my $inc = $_log_window_size;
- my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
- my $longest_path = longest_common_path($gsv, $globs);
- my $ra_url = $self->{url};
- my $find_trailing_edge;
- while (1) {
- my %revs;
- my $err;
- my $err_handler = $SVN::Error::handler;
- $SVN::Error::handler = sub {
- ($err) = @_;
- skip_unknown_revs($err);
- };
- sub _cb {
- my ($paths, $r, $author, $date, $log) = @_;
- [ $paths,
- { author => $author, date => $date, log => $log } ];
- }
- $self->get_log([$longest_path], $min, $max, 0, 1, 1,
- sub { $revs{$_[1]} = _cb(@_) });
- if ($err) {
- print "Checked through r$max\r";
- } else {
- $find_trailing_edge = 1;
- }
- if ($err and $find_trailing_edge) {
- print STDERR "Path '$longest_path' ",
- "was probably deleted:\n",
- $err->expanded_message,
- "\nWill attempt to follow ",
- "revisions r$min .. r$max ",
- "committed before the deletion\n";
- my $hi = $max;
- while (--$hi >= $min) {
- my $ok;
- $self->get_log([$longest_path], $min, $hi,
- 0, 1, 1, sub {
- $ok = $_[1];
- $revs{$_[1]} = _cb(@_) });
- if ($ok) {
- print STDERR "r$min .. r$ok OK\n";
- last;
- }
- }
- $find_trailing_edge = 0;
- }
- $SVN::Error::handler = $err_handler;
-
- my %exists = map { $_->{path} => $_ } @$gsv;
- foreach my $r (sort {$a <=> $b} keys %revs) {
- my ($paths, $logged) = @{$revs{$r}};
-
- foreach my $gs ($self->match_globs(\%exists, $paths,
- $globs, $r)) {
- if ($gs->rev_map_max >= $r) {
- next;
- }
- next unless $gs->match_paths($paths, $r);
- $gs->{logged_rev_props} = $logged;
- if (my $last_commit = $gs->last_commit) {
- $gs->assert_index_clean($last_commit);
- }
- my $log_entry = $gs->do_fetch($paths, $r);
- if ($log_entry) {
- $gs->do_git_commit($log_entry);
- }
- $INDEX_FILES{$gs->{index}} = 1;
- }
- foreach my $g (@$globs) {
- my $k = "svn-remote.$g->{remote}." .
- "$g->{t}-maxRev";
- Git::SVN::tmp_config($k, $r);
- }
- if ($ra_invalid) {
- $_[0] = undef;
- $self = undef;
- $RA = undef;
- $self = Git::SVN::Ra->new($ra_url);
- $ra_invalid = undef;
- }
- }
- # pre-fill the .rev_db since it'll eventually get filled in
- # with '0' x40 if something new gets committed
- foreach my $gs (@$gsv) {
- next if $gs->rev_map_max >= $max;
- next if defined $gs->rev_map_get($max);
- $gs->rev_map_set($max, 0 x40);
- }
- foreach my $g (@$globs) {
- my $k = "svn-remote.$g->{remote}.$g->{t}-maxRev";
- Git::SVN::tmp_config($k, $max);
- }
- last if $max >= $head;
- $min = $max + 1;
- $max += $inc;
- $max = $head if ($max > $head);
- }
- Git::SVN::gc();
-}
-
-sub get_dir_globbed {
- my ($self, $left, $depth, $r) = @_;
-
- my @x = eval { $self->get_dir($left, $r) };
- return unless scalar @x == 3;
- my $dirents = $x[0];
- my @finalents;
- foreach my $de (keys %$dirents) {
- next if $dirents->{$de}->{kind} != $SVN::Node::dir;
- if ($depth > 1) {
- my @args = ("$left/$de", $depth - 1, $r);
- foreach my $dir ($self->get_dir_globbed(@args)) {
- push @finalents, "$de/$dir";
- }
- } else {
- push @finalents, $de;
- }
- }
- @finalents;
-}
-
-# return value: 0 -- don't ignore, 1 -- ignore
-sub is_ref_ignored {
- my ($g, $p) = @_;
- my $refname = $g->{ref}->full_path($p);
- return 1 if defined($g->{ignore_refs_regex}) &&
- $refname =~ m!$g->{ignore_refs_regex}!;
- return 0 unless defined($_ignore_refs_regex);
- return 1 if $refname =~ m!$_ignore_refs_regex!o;
- return 0;
-}
-
-sub match_globs {
- my ($self, $exists, $paths, $globs, $r) = @_;
-
- sub get_dir_check {
- my ($self, $exists, $g, $r) = @_;
-
- my @dirs = $self->get_dir_globbed($g->{path}->{left},
- $g->{path}->{depth},
- $r);
-
- foreach my $de (@dirs) {
- my $p = $g->{path}->full_path($de);
- next if $exists->{$p};
- 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);
- }
- }
- foreach my $g (@$globs) {
- if (my $path = $paths->{"/$g->{path}->{left}"}) {
- if ($path->{action} =~ /^[AR]$/) {
- get_dir_check($self, $exists, $g, $r);
- }
- }
- foreach (keys %$paths) {
- if (/$g->{path}->{left_regex}/ &&
- !/$g->{path}->{regex}/) {
- next if $paths->{$_}->{action} !~ /^[AR]$/;
- get_dir_check($self, $exists, $g, $r);
- }
- next unless /$g->{path}->{regex}/;
- my $p = $1;
- my $pathname = $g->{path}->full_path($p);
- next if is_ref_ignored($g, $p);
- next if $exists->{$pathname};
- next if ($self->check_path($pathname, $r) !=
- $SVN::Node::dir);
- $exists->{$pathname} = Git::SVN->init(
- $self->{url}, $pathname, undef,
- $g->{ref}->full_path($p), 1);
- }
- my $c = '';
- foreach (split m#/#, $g->{path}->{left}) {
- $c .= "/$_";
- next unless ($paths->{$c} &&
- ($paths->{$c}->{action} =~ /^[AR]$/));
- get_dir_check($self, $exists, $g, $r);
- }
- }
- values %$exists;
-}
-
-sub minimize_url {
- my ($self) = @_;
- return $self->{url} if ($self->{url} eq $self->{repos_root});
- my $url = $self->{repos_root};
- my @components = split(m!/!, $self->{svn_path});
- my $c = '';
- do {
- $url .= "/$c" if length $c;
- eval {
- my $ra = (ref $self)->new($url);
- my $latest = $ra->get_latest_revnum;
- $ra->get_log("", $latest, 0, 1, 0, 1, sub {});
- };
- } while ($@ && ($c = shift @components));
- $url;
-}
-
-sub can_do_switch {
- my $self = shift;
- unless (defined $can_do_switch) {
- my $pool = SVN::Pool->new;
- my $rep = eval {
- $self->do_switch(1, '', 0, $self->{url},
- SVN::Delta::Editor->new, $pool);
- };
- if ($@) {
- $can_do_switch = 0;
- } else {
- $rep->abort_report($pool);
- $can_do_switch = 1;
- }
- $pool->clear;
- }
- $can_do_switch;
-}
-
-sub skip_unknown_revs {
- my ($err) = @_;
- my $errno = $err->apr_err();
- # Maybe the branch we're tracking didn't
- # exist when the repo started, so it's
- # not an error if it doesn't, just continue
- #
- # Wonderfully consistent library, eh?
- # 160013 - svn:// and file://
- # 175002 - http(s)://
- # 175007 - http(s):// (this repo required authorization, too...)
- # More codes may be discovered later...
- if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
- my $err_key = $err->expanded_message;
- # revision numbers change every time, filter them out
- $err_key =~ s/\d+/\0/g;
- $err_key = "$errno\0$err_key";
- unless ($ignored_err{$err_key}) {
- warn "W: Ignoring error from SVN, path probably ",
- "does not exist: ($errno): ",
- $err->expanded_message,"\n";
- warn "W: Do not be alarmed at the above message ",
- "git-svn is just searching aggressively for ",
- "old history.\n",
- "This may take a while on large repositories\n";
- $ignored_err{$err_key} = 1;
- }
- return;
- }
- die "Error from SVN, ($errno): ", $err->expanded_message,"\n";
-}
-
package Git::SVN::Log;
use strict;
use warnings;
diff --git a/perl/Git/SVN/Ra.pm b/perl/Git/SVN/Ra.pm
new file mode 100644
index 00000000..e88b4e79
--- /dev/null
+++ b/perl/Git/SVN/Ra.pm
@@ -0,0 +1,658 @@
+package Git::SVN::Ra;
+use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
+use strict;
+use warnings;
+use SVN::Client;
+use SVN::Ra;
+BEGIN {
+ @ISA = qw(SVN::Ra);
+}
+
+my ($ra_invalid, $can_do_switch, %ignored_err, $RA);
+
+BEGIN {
+ # enforce temporary pool usage for some simple functions
+ no strict 'refs';
+ for my $f (qw/rev_proplist get_latest_revnum get_uuid get_repos_root
+ get_file/) {
+ my $SUPER = "SUPER::$f";
+ *$f = sub {
+ my $self = shift;
+ my $pool = SVN::Pool->new;
+ my @ret = $self->$SUPER(@_,$pool);
+ $pool->clear;
+ wantarray ? @ret : $ret[0];
+ };
+ }
+}
+
+sub _auth_providers () {
+ my @rv = (
+ SVN::Client::get_simple_provider(),
+ SVN::Client::get_ssl_server_trust_file_provider(),
+ SVN::Client::get_simple_prompt_provider(
+ \&Git::SVN::Prompt::simple, 2),
+ SVN::Client::get_ssl_client_cert_file_provider(),
+ SVN::Client::get_ssl_client_cert_prompt_provider(
+ \&Git::SVN::Prompt::ssl_client_cert, 2),
+ SVN::Client::get_ssl_client_cert_pw_file_provider(),
+ SVN::Client::get_ssl_client_cert_pw_prompt_provider(
+ \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
+ SVN::Client::get_username_provider(),
+ SVN::Client::get_ssl_server_trust_prompt_provider(
+ \&Git::SVN::Prompt::ssl_server_trust),
+ SVN::Client::get_username_prompt_provider(
+ \&Git::SVN::Prompt::username, 2)
+ );
+
+ # earlier 1.6.x versions would segfault, and <= 1.5.x didn't have
+ # this function
+ if (::compare_svn_version('1.6.12') > 0) {
+ my $config = SVN::Core::config_get_config($config_dir);
+ my ($p, @a);
+ # config_get_config returns all config files from
+ # ~/.subversion, auth_get_platform_specific_client_providers
+ # just wants the config "file".
+ @a = ($config->{'config'}, undef);
+ $p = SVN::Core::auth_get_platform_specific_client_providers(@a);
+ # Insert the return value from
+ # auth_get_platform_specific_providers
+ unshift @rv, @$p;
+ }
+ \@rv;
+}
+
+sub escape_uri_only {
+ my ($uri) = @_;
+ my @tmp;
+ foreach (split m{/}, $uri) {
+ s/([^~\w.%+-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
+ push @tmp, $_;
+ }
+ join('/', @tmp);
+}
+
+sub escape_url {
+ my ($url) = @_;
+ if ($url =~ m#^(https?)://([^/]+)(.*)$#) {
+ my ($scheme, $domain, $uri) = ($1, $2, escape_uri_only($3));
+ $url = "$scheme://$domain$uri";
+ }
+ $url;
+}
+
+sub new {
+ my ($class, $url) = @_;
+ $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);
+ $RA = undef;
+ my $dont_store_passwords = 1;
+ my $conf_t = ${$config}{'config'};
+ {
+ no warnings 'once';
+ # The usage of $SVN::_Core::SVN_CONFIG_* variables
+ # produces warnings that variables are used only once.
+ # I had not found the better way to shut them up, so
+ # the warnings of type 'once' are disabled in this block.
+ if (SVN::_Core::svn_config_get_bool($conf_t,
+ $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
+ $SVN::_Core::SVN_CONFIG_OPTION_STORE_PASSWORDS,
+ 1) == 0) {
+ SVN::_Core::svn_auth_set_parameter($baton,
+ $SVN::_Core::SVN_AUTH_PARAM_DONT_STORE_PASSWORDS,
+ bless (\$dont_store_passwords, "_p_void"));
+ }
+ if (SVN::_Core::svn_config_get_bool($conf_t,
+ $SVN::_Core::SVN_CONFIG_SECTION_AUTH,
+ $SVN::_Core::SVN_CONFIG_OPTION_STORE_AUTH_CREDS,
+ 1) == 0) {
+ $Git::SVN::Prompt::_no_auth_cache = 1;
+ }
+ } # no warnings 'once'
+ my $self = SVN::Ra->new(url => escape_url($url), auth => $baton,
+ config => $config,
+ pool => SVN::Pool->new,
+ auth_provider_callbacks => $callbacks);
+ $self->{url} = $url;
+ $self->{svn_path} = $url;
+ $self->{repos_root} = $self->get_repos_root;
+ $self->{svn_path} =~ s#^\Q$self->{repos_root}\E(/|$)##;
+ $self->{cache} = { check_path => { r => 0, data => {} },
+ get_dir => { r => 0, data => {} } };
+ $RA = bless $self, $class;
+}
+
+sub check_path {
+ my ($self, $path, $r) = @_;
+ my $cache = $self->{cache}->{check_path};
+ if ($r == $cache->{r} && exists $cache->{data}->{$path}) {
+ return $cache->{data}->{$path};
+ }
+ my $pool = SVN::Pool->new;
+ my $t = $self->SUPER::check_path($path, $r, $pool);
+ $pool->clear;
+ if ($r != $cache->{r}) {
+ %{$cache->{data}} = ();
+ $cache->{r} = $r;
+ }
+ $cache->{data}->{$path} = $t;
+}
+
+sub get_dir {
+ my ($self, $dir, $r) = @_;
+ my $cache = $self->{cache}->{get_dir};
+ if ($r == $cache->{r}) {
+ if (my $x = $cache->{data}->{$dir}) {
+ return wantarray ? @$x : $x->[0];
+ }
+ }
+ my $pool = SVN::Pool->new;
+ my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
+ my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
+ $pool->clear;
+ if ($r != $cache->{r}) {
+ %{$cache->{data}} = ();
+ $cache->{r} = $r;
+ }
+ $cache->{data}->{$dir} = [ \%dirents, $r, $props ];
+ wantarray ? (\%dirents, $r, $props) : \%dirents;
+}
+
+sub DESTROY {
+ # do not call the real DESTROY since we store ourselves in $RA
+}
+
+# get_log(paths, start, end, limit,
+# discover_changed_paths, strict_node_history, receiver)
+sub get_log {
+ my ($self, @args) = @_;
+ my $pool = SVN::Pool->new;
+
+ # svn_log_changed_path_t objects passed to get_log are likely to be
+ # overwritten even if only the refs are copied to an external variable,
+ # so we should dup the structures in their entirety. Using an
+ # externally passed pool (instead of our temporary and quickly cleared
+ # pool in Git::SVN::Ra) does not help matters at all...
+ my $receiver = pop @args;
+ my $prefix = "/".$self->{svn_path};
+ $prefix =~ s#/+($)##;
+ my $prefix_regex = qr#^\Q$prefix\E#;
+ push(@args, sub {
+ my ($paths) = $_[0];
+ return &$receiver(@_) unless $paths;
+ $_[0] = ();
+ foreach my $p (keys %$paths) {
+ my $i = $paths->{$p};
+ # Make path relative to our url, not repos_root
+ $p =~ s/$prefix_regex//;
+ my %s = map { $_ => $i->$_; }
+ qw/copyfrom_path copyfrom_rev action/;
+ if ($s{'copyfrom_path'}) {
+ $s{'copyfrom_path'} =~ s/$prefix_regex//;
+ }
+ $_[0]{$p} = \%s;
+ }
+ &$receiver(@_);
+ });
+
+
+ # the limit parameter was not supported in SVN 1.1.x, so we
+ # drop it. Therefore, the receiver callback passed to it
+ # is made aware of this limitation by being wrapped if
+ # the limit passed to is being wrapped.
+ if (::compare_svn_version('1.2.0') <= 0) {
+ my $limit = splice(@args, 3, 1);
+ if ($limit > 0) {
+ my $receiver = pop @args;
+ push(@args, sub { &$receiver(@_) if (--$limit >= 0) });
+ }
+ }
+ my $ret = $self->SUPER::get_log(@args, $pool);
+ $pool->clear;
+ $ret;
+}
+
+sub trees_match {
+ my ($self, $url1, $rev1, $url2, $rev2) = @_;
+ my $ctx = SVN::Client->new(auth => _auth_providers);
+ my $out = IO::File->new_tmpfile;
+
+ # older SVN (1.1.x) doesn't take $pool as the last parameter for
+ # $ctx->diff(), so we'll create a default one
+ my $pool = SVN::Pool->new_default_sub;
+
+ $ra_invalid = 1; # this will open a new SVN::Ra connection to $url1
+ $ctx->diff([], $url1, $rev1, $url2, $rev2, 1, 1, 0, $out, $out);
+ $out->flush;
+ my $ret = (($out->stat)[7] == 0);
+ close $out or croak $!;
+
+ $ret;
+}
+
+sub get_commit_editor {
+ my ($self, $log, $cb, $pool) = @_;
+
+ my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef, 0) : ();
+ $self->SUPER::get_commit_editor($log, $cb, @lock, $pool);
+}
+
+sub gs_do_update {
+ my ($self, $rev_a, $rev_b, $gs, $editor) = @_;
+ my $new = ($rev_a == $rev_b);
+ my $path = $gs->{path};
+
+ if ($new && -e $gs->{index}) {
+ unlink $gs->{index} or die
+ "Couldn't unlink index: $gs->{index}: $!\n";
+ }
+ my $pool = SVN::Pool->new;
+ $editor->set_path_strip($path);
+ my (@pc) = split m#/#, $path;
+ my $reporter = $self->do_update($rev_b, (@pc ? shift @pc : ''),
+ 1, $editor, $pool);
+ my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
+
+ # Since we can't rely on svn_ra_reparent being available, we'll
+ # just have to do some magic with set_path to make it so
+ # we only want a partial path.
+ my $sp = '';
+ my $final = join('/', @pc);
+ while (@pc) {
+ $reporter->set_path($sp, $rev_b, 0, @lock, $pool);
+ $sp .= '/' if length $sp;
+ $sp .= shift @pc;
+ }
+ die "BUG: '$sp' != '$final'\n" if ($sp ne $final);
+
+ $reporter->set_path($sp, $rev_a, $new, @lock, $pool);
+
+ $reporter->finish_report($pool);
+ $pool->clear;
+ $editor->{git_commit_ok};
+}
+
+# this requires SVN 1.4.3 or later (do_switch didn't work before 1.4.3, and
+# svn_ra_reparent didn't work before 1.4)
+sub gs_do_switch {
+ my ($self, $rev_a, $rev_b, $gs, $url_b, $editor) = @_;
+ my $path = $gs->{path};
+ my $pool = SVN::Pool->new;
+
+ my $full_url = $self->{url};
+ my $old_url = $full_url;
+ $full_url .= '/' . $path if length $path;
+ my ($ra, $reparented);
+
+ if ($old_url =~ m#^svn(\+ssh)?://# ||
+ ($full_url =~ m#^https?://# &&
+ escape_url($full_url) ne $full_url)) {
+ $_[0] = undef;
+ $self = undef;
+ $RA = undef;
+ $ra = Git::SVN::Ra->new($full_url);
+ $ra_invalid = 1;
+ } elsif ($old_url ne $full_url) {
+ SVN::_Ra::svn_ra_reparent($self->{session}, $full_url, $pool);
+ $self->{url} = $full_url;
+ $reparented = 1;
+ }
+
+ $ra ||= $self;
+ $url_b = escape_url($url_b);
+ my $reporter = $ra->do_switch($rev_b, '', 1, $url_b, $editor, $pool);
+ my @lock = (::compare_svn_version('1.2.0') >= 0) ? (undef) : ();
+ $reporter->set_path('', $rev_a, 0, @lock, $pool);
+ $reporter->finish_report($pool);
+
+ if ($reparented) {
+ SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
+ $self->{url} = $old_url;
+ }
+
+ $pool->clear;
+ $editor->{git_commit_ok};
+}
+
+sub longest_common_path {
+ my ($gsv, $globs) = @_;
+ my %common;
+ my $common_max = scalar @$gsv;
+
+ foreach my $gs (@$gsv) {
+ my @tmp = split m#/#, $gs->{path};
+ my $p = '';
+ foreach (@tmp) {
+ $p .= length($p) ? "/$_" : $_;
+ $common{$p} ||= 0;
+ $common{$p}++;
+ }
+ }
+ $globs ||= [];
+ $common_max += scalar @$globs;
+ foreach my $glob (@$globs) {
+ my @tmp = split m#/#, $glob->{path}->{left};
+ my $p = '';
+ foreach (@tmp) {
+ $p .= length($p) ? "/$_" : $_;
+ $common{$p} ||= 0;
+ $common{$p}++;
+ }
+ }
+
+ my $longest_path = '';
+ foreach (sort {length $b <=> length $a} keys %common) {
+ if ($common{$_} == $common_max) {
+ $longest_path = $_;
+ last;
+ }
+ }
+ $longest_path;
+}
+
+sub gs_fetch_loop_common {
+ my ($self, $base, $head, $gsv, $globs) = @_;
+ return if ($base > $head);
+ my $inc = $_log_window_size;
+ my ($min, $max) = ($base, $head < $base + $inc ? $head : $base + $inc);
+ my $longest_path = longest_common_path($gsv, $globs);
+ my $ra_url = $self->{url};
+ my $find_trailing_edge;
+ while (1) {
+ my %revs;
+ my $err;
+ my $err_handler = $SVN::Error::handler;
+ $SVN::Error::handler = sub {
+ ($err) = @_;
+ skip_unknown_revs($err);
+ };
+ sub _cb {
+ my ($paths, $r, $author, $date, $log) = @_;
+ [ $paths,
+ { author => $author, date => $date, log => $log } ];
+ }
+ $self->get_log([$longest_path], $min, $max, 0, 1, 1,
+ sub { $revs{$_[1]} = _cb(@_) });
+ if ($err) {
+ print "Checked through r$max\r";
+ } else {
+ $find_trailing_edge = 1;
+ }
+ if ($err and $find_trailing_edge) {
+ print STDERR "Path '$longest_path' ",
+ "was probably deleted:\n",
+ $err->expanded_message,
+ "\nWill attempt to follow ",
+ "revisions r$min .. r$max ",
+ "committed before the deletion\n";
+ my $hi = $max;
+ while (--$hi >= $min) {
+ my $ok;
+ $self->get_log([$longest_path], $min, $hi,
+ 0, 1, 1, sub {
+ $ok = $_[1];
+ $revs{$_[1]} = _cb(@_) });
+ if ($ok) {
+ print STDERR "r$min .. r$ok OK\n";
+ last;
+ }
+ }
+ $find_trailing_edge = 0;
+ }
+ $SVN::Error::handler = $err_handler;
+
+ my %exists = map { $_->{path} => $_ } @$gsv;
+ foreach my $r (sort {$a <=> $b} keys %revs) {
+ my ($paths, $logged) = @{$revs{$r}};
+
+ foreach my $gs ($self->match_globs(\%exists, $paths,
+ $globs, $r)) {
+ if ($gs->rev_map_max >= $r) {
+ next;
+ }
+ next unless $gs->match_paths($paths, $r);
+ $gs->{logged_rev_props} = $logged;
+ if (my $last_commit = $gs->last_commit) {
+ $gs->assert_index_clean($last_commit);
+ }
+ my $log_entry = $gs->do_fetch($paths, $r);
+ if ($log_entry) {
+ $gs->do_git_commit($log_entry);
+ }
+ $Git::SVN::INDEX_FILES{$gs->{index}} = 1;
+ }
+ foreach my $g (@$globs) {
+ my $k = "svn-remote.$g->{remote}." .
+ "$g->{t}-maxRev";
+ Git::SVN::tmp_config($k, $r);
+ }
+ if ($ra_invalid) {
+ $_[0] = undef;
+ $self = undef;
+ $RA = undef;
+ $self = Git::SVN::Ra->new($ra_url);
+ $ra_invalid = undef;
+ }
+ }
+ # pre-fill the .rev_db since it'll eventually get filled in
+ # with '0' x40 if something new gets committed
+ foreach my $gs (@$gsv) {
+ next if $gs->rev_map_max >= $max;
+ next if defined $gs->rev_map_get($max);
+ $gs->rev_map_set($max, 0 x40);
+ }
+ foreach my $g (@$globs) {
+ my $k = "svn-remote.$g->{remote}.$g->{t}-maxRev";
+ Git::SVN::tmp_config($k, $max);
+ }
+ last if $max >= $head;
+ $min = $max + 1;
+ $max += $inc;
+ $max = $head if ($max > $head);
+ }
+ Git::SVN::gc();
+}
+
+sub get_dir_globbed {
+ my ($self, $left, $depth, $r) = @_;
+
+ my @x = eval { $self->get_dir($left, $r) };
+ return unless scalar @x == 3;
+ my $dirents = $x[0];
+ my @finalents;
+ foreach my $de (keys %$dirents) {
+ next if $dirents->{$de}->{kind} != $SVN::Node::dir;
+ if ($depth > 1) {
+ my @args = ("$left/$de", $depth - 1, $r);
+ foreach my $dir ($self->get_dir_globbed(@args)) {
+ push @finalents, "$de/$dir";
+ }
+ } else {
+ push @finalents, $de;
+ }
+ }
+ @finalents;
+}
+
+# return value: 0 -- don't ignore, 1 -- ignore
+sub is_ref_ignored {
+ my ($g, $p) = @_;
+ my $refname = $g->{ref}->full_path($p);
+ return 1 if defined($g->{ignore_refs_regex}) &&
+ $refname =~ m!$g->{ignore_refs_regex}!;
+ return 0 unless defined($_ignore_refs_regex);
+ return 1 if $refname =~ m!$_ignore_refs_regex!o;
+ return 0;
+}
+
+sub match_globs {
+ my ($self, $exists, $paths, $globs, $r) = @_;
+
+ sub get_dir_check {
+ my ($self, $exists, $g, $r) = @_;
+
+ my @dirs = $self->get_dir_globbed($g->{path}->{left},
+ $g->{path}->{depth},
+ $r);
+
+ foreach my $de (@dirs) {
+ my $p = $g->{path}->full_path($de);
+ next if $exists->{$p};
+ 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);
+ }
+ }
+ foreach my $g (@$globs) {
+ if (my $path = $paths->{"/$g->{path}->{left}"}) {
+ if ($path->{action} =~ /^[AR]$/) {
+ get_dir_check($self, $exists, $g, $r);
+ }
+ }
+ foreach (keys %$paths) {
+ if (/$g->{path}->{left_regex}/ &&
+ !/$g->{path}->{regex}/) {
+ next if $paths->{$_}->{action} !~ /^[AR]$/;
+ get_dir_check($self, $exists, $g, $r);
+ }
+ next unless /$g->{path}->{regex}/;
+ my $p = $1;
+ my $pathname = $g->{path}->full_path($p);
+ next if is_ref_ignored($g, $p);
+ next if $exists->{$pathname};
+ next if ($self->check_path($pathname, $r) !=
+ $SVN::Node::dir);
+ $exists->{$pathname} = Git::SVN->init(
+ $self->{url}, $pathname, undef,
+ $g->{ref}->full_path($p), 1);
+ }
+ my $c = '';
+ foreach (split m#/#, $g->{path}->{left}) {
+ $c .= "/$_";
+ next unless ($paths->{$c} &&
+ ($paths->{$c}->{action} =~ /^[AR]$/));
+ get_dir_check($self, $exists, $g, $r);
+ }
+ }
+ values %$exists;
+}
+
+sub minimize_url {
+ my ($self) = @_;
+ return $self->{url} if ($self->{url} eq $self->{repos_root});
+ my $url = $self->{repos_root};
+ my @components = split(m!/!, $self->{svn_path});
+ my $c = '';
+ do {
+ $url .= "/$c" if length $c;
+ eval {
+ my $ra = (ref $self)->new($url);
+ my $latest = $ra->get_latest_revnum;
+ $ra->get_log("", $latest, 0, 1, 0, 1, sub {});
+ };
+ } while ($@ && ($c = shift @components));
+ $url;
+}
+
+sub can_do_switch {
+ my $self = shift;
+ unless (defined $can_do_switch) {
+ my $pool = SVN::Pool->new;
+ my $rep = eval {
+ $self->do_switch(1, '', 0, $self->{url},
+ SVN::Delta::Editor->new, $pool);
+ };
+ if ($@) {
+ $can_do_switch = 0;
+ } else {
+ $rep->abort_report($pool);
+ $can_do_switch = 1;
+ }
+ $pool->clear;
+ }
+ $can_do_switch;
+}
+
+sub skip_unknown_revs {
+ my ($err) = @_;
+ my $errno = $err->apr_err();
+ # Maybe the branch we're tracking didn't
+ # exist when the repo started, so it's
+ # not an error if it doesn't, just continue
+ #
+ # Wonderfully consistent library, eh?
+ # 160013 - svn:// and file://
+ # 175002 - http(s)://
+ # 175007 - http(s):// (this repo required authorization, too...)
+ # More codes may be discovered later...
+ if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
+ my $err_key = $err->expanded_message;
+ # revision numbers change every time, filter them out
+ $err_key =~ s/\d+/\0/g;
+ $err_key = "$errno\0$err_key";
+ unless ($ignored_err{$err_key}) {
+ warn "W: Ignoring error from SVN, path probably ",
+ "does not exist: ($errno): ",
+ $err->expanded_message,"\n";
+ warn "W: Do not be alarmed at the above message ",
+ "git-svn is just searching aggressively for ",
+ "old history.\n",
+ "This may take a while on large repositories\n";
+ $ignored_err{$err_key} = 1;
+ }
+ return;
+ }
+ die "Error from SVN, ($errno): ", $err->expanded_message,"\n";
+}
+
+1;
+__END__
+
+Git::SVN::Ra - Subversion remote access functions for git-svn
+
+=head1 SYNOPSIS
+
+ use Git::SVN::Ra;
+
+ my $ra = Git::SVN::Ra->new($branchurl);
+ my ($dirents, $fetched_revnum, $props) =
+ $ra->get_dir('.', $SVN::Core::INVALID_REVNUM);
+
+=head1 DESCRIPTION
+
+This is a wrapper around the L<SVN::Ra> module for use by B<git-svn>.
+It fills in some default parameters (such as the authentication
+scheme), smooths over incompatibilities between libsvn versions, adds
+caching, and implements some functions specific to B<git-svn>.
+
+Do not use it unless you are developing git-svn. The interface will
+change as git-svn evolves.
+
+=head1 DEPENDENCIES
+
+Subversion perl bindings,
+L<Git::SVN>.
+
+C<Git::SVN::Ra> has not been tested using callers other than
+B<git-svn> itself.
+
+=head1 SEE ALSO
+
+L<SVN::Ra>.
+
+=head1 INCOMPATIBILITIES
+
+None reported.
+
+=head1 BUGS
+
+None.
diff --git a/perl/Makefile.PL b/perl/Makefile.PL
index 32caf214..08afdcb2 100644
--- a/perl/Makefile.PL
+++ b/perl/Makefile.PL
@@ -30,6 +30,7 @@ my %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',
);
# We come with our own bundled Error.pm. It's not in the set of default
--
1.7.10
--
To unsubscribe from this list: send the line "unsubscribe git" in
the body of a message to majordomo@xxxxxxxxxxxxxxx
More majordomo info at http://vger.kernel.org/majordomo-info.html