diff options
Diffstat (limited to 'git-svn.perl')
-rwxr-xr-x | git-svn.perl | 612 |
1 files changed, 1 insertions, 611 deletions
diff --git a/git-svn.perl b/git-svn.perl index aa14d459f2..24c0af2e3a 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.15') >= 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; |