summaryrefslogtreecommitdiff
path: root/perl/Git/SVN
diff options
context:
space:
mode:
Diffstat (limited to 'perl/Git/SVN')
-rw-r--r--perl/Git/SVN/Editor.pm81
-rw-r--r--perl/Git/SVN/Fetcher.pm37
-rw-r--r--perl/Git/SVN/GlobSpec.pm4
-rw-r--r--perl/Git/SVN/Log.pm11
-rw-r--r--perl/Git/SVN/Migration.pm8
-rw-r--r--perl/Git/SVN/Prompt.pm36
-rw-r--r--perl/Git/SVN/Ra.pm206
-rw-r--r--perl/Git/SVN/Utils.pm175
8 files changed, 429 insertions, 129 deletions
diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm
index 755092fdff..c50176eec9 100644
--- a/perl/Git/SVN/Editor.pm
+++ b/perl/Git/SVN/Editor.pm
@@ -5,7 +5,6 @@ use warnings;
use SVN::Core;
use SVN::Delta;
use Carp qw/croak/;
-use IO::File;
use Git qw/command command_oneline command_noisy command_output_pipe
command_input_pipe command_close_pipe
command_bidi_pipe command_close_bidi_pipe/;
@@ -145,7 +144,8 @@ sub repo_path {
sub url_path {
my ($self, $path) = @_;
if ($self->{url} =~ m#^https?://#) {
- $path =~ s!([^~a-zA-Z0-9_./-])!uc sprintf("%%%02x",ord($1))!eg;
+ # characters are taken from subversion/libsvn_subr/path.c
+ $path =~ s#([^~a-zA-Z0-9_./!$&'()*+,-])#sprintf("%%%02X",ord($1))#eg;
}
$self->{url} . '/' . $self->repo_path($path);
}
@@ -287,6 +287,40 @@ sub apply_autoprops {
}
}
+sub check_attr {
+ my ($attr,$path) = @_;
+ my $val = command_oneline("check-attr", $attr, "--", $path);
+ if ($val) { $val =~ s/^[^:]*:\s*[^:]*:\s*(.*)\s*$/$1/; }
+ return $val;
+}
+
+sub apply_manualprops {
+ my ($self, $file, $fbat) = @_;
+ my $pending_properties = check_attr( "svn-properties", $file );
+ if ($pending_properties eq "") { return; }
+ # Parse the list of properties to set.
+ my @props = split(/;/, $pending_properties);
+ # TODO: get existing properties to compare to
+ # - this fails for add so currently not done
+ # my $existing_props = ::get_svnprops($file);
+ my $existing_props = {};
+ # TODO: caching svn properties or storing them in .gitattributes
+ # would make that faster
+ foreach my $prop (@props) {
+ # Parse 'name=value' syntax and set the property.
+ if ($prop =~ /([^=]+)=(.*)/) {
+ my ($n,$v) = ($1,$2);
+ for ($n, $v) {
+ s/^\s+//; s/\s+$//;
+ }
+ my $existing = $existing_props->{$n};
+ if (!defined($existing) || $existing ne $v) {
+ $self->change_file_prop($fbat, $n, $v);
+ }
+ }
+ }
+}
+
sub A {
my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
@@ -295,6 +329,7 @@ sub A {
undef, -1);
print "\tA\t$m->{file_b}\n" unless $::_q;
$self->apply_autoprops($file, $fbat);
+ $self->apply_manualprops($m->{file_b}, $fbat);
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
}
@@ -303,9 +338,14 @@ sub C {
my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
my $pbat = $self->ensure_path($dir, $deletions);
+ # workaround for a bug in svn serf backend (v1.8.5 and below):
+ # store third argument to ->add_file() in a local variable, to make it
+ # have the same lifetime as $fbat
+ my $upa = $self->url_path($m->{file_a});
my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
- $self->url_path($m->{file_a}), $self->{r});
+ $upa, $self->{r});
print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
+ $self->apply_manualprops($m->{file_b}, $fbat);
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
}
@@ -322,10 +362,13 @@ sub R {
my ($self, $m, $deletions) = @_;
my ($dir, $file) = split_path($m->{file_b});
my $pbat = $self->ensure_path($dir, $deletions);
+ # workaround for a bug in svn serf backend, see comment in C() above
+ my $upa = $self->url_path($m->{file_a});
my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
- $self->url_path($m->{file_a}), $self->{r});
+ $upa, $self->{r});
print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $::_q;
$self->apply_autoprops($file, $fbat);
+ $self->apply_manualprops($m->{file_b}, $fbat);
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
@@ -341,11 +384,35 @@ sub M {
my $fbat = $self->open_file($self->repo_path($m->{file_b}),
$pbat,$self->{r},$self->{pool});
print "\t$m->{chg}\t$m->{file_b}\n" unless $::_q;
+ $self->apply_manualprops($m->{file_b}, $fbat);
$self->chg_file($fbat, $m);
$self->close_file($fbat,undef,$self->{pool});
}
-sub T { shift->M(@_) }
+sub T {
+ my ($self, $m, $deletions) = @_;
+
+ # Work around subversion issue 4091: toggling the "is a
+ # symlink" property requires removing and re-adding a
+ # file or else "svn up" on affected clients trips an
+ # assertion and aborts.
+ if (($m->{mode_b} =~ /^120/ && $m->{mode_a} !~ /^120/) ||
+ ($m->{mode_b} !~ /^120/ && $m->{mode_a} =~ /^120/)) {
+ $self->D({
+ mode_a => $m->{mode_a}, mode_b => '000000',
+ sha1_a => $m->{sha1_a}, sha1_b => '0' x 40,
+ chg => 'D', file_b => $m->{file_b}
+ }, $deletions);
+ $self->A({
+ mode_a => '000000', mode_b => $m->{mode_b},
+ sha1_a => '0' x 40, sha1_b => $m->{sha1_b},
+ chg => 'A', file_b => $m->{file_b}
+ }, $deletions);
+ return;
+ }
+
+ $self->M($m, $deletions);
+}
sub change_file_prop {
my ($self, $fbat, $pname, $pval) = @_;
@@ -475,6 +542,8 @@ sub apply_diff {
1;
__END__
+=head1 NAME
+
Git::SVN::Editor - commit driver for "git svn set-tree" and dcommit
=head1 SYNOPSIS
@@ -516,7 +585,7 @@ The interface will change as git-svn evolves.
=head1 DEPENDENCIES
Subversion perl bindings,
-the core L<Carp> and L<IO::File> modules,
+the core L<Carp> module,
and git's L<Git> helper module.
C<Git::SVN::Editor> has not been tested using callers other than
diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm
index 76fae9bce0..d8c21ad915 100644
--- a/perl/Git/SVN/Fetcher.pm
+++ b/perl/Git/SVN/Fetcher.pm
@@ -1,12 +1,12 @@
package Git::SVN::Fetcher;
-use vars qw/@ISA $_ignore_regex $_preserve_empty_dirs $_placeholder_filename
- @deleted_gpath %added_placeholder $repo_id/;
+use vars qw/@ISA $_ignore_regex $_include_regex $_preserve_empty_dirs
+ $_placeholder_filename @deleted_gpath %added_placeholder
+ $repo_id/;
use strict;
use warnings;
use SVN::Delta;
use Carp qw/croak/;
use File::Basename qw/dirname/;
-use IO::File qw//;
use Git qw/command command_oneline command_noisy command_output_pipe
command_input_pipe command_close_pipe
command_bidi_pipe command_close_bidi_pipe/;
@@ -33,6 +33,10 @@ sub new {
my $v = eval { command_oneline('config', '--get', $k) };
$self->{ignore_regex} = $v;
+ $k = "svn-remote.$repo_id.include-paths";
+ $v = eval { command_oneline('config', '--get', $k) };
+ $self->{include_regex} = $v;
+
$k = "svn-remote.$repo_id.preserve-empty-dirs";
$v = eval { command_oneline('config', '--get', '--bool', $k) };
if ($v && $v eq 'true') {
@@ -83,7 +87,7 @@ sub _mark_empty_symlinks {
chomp(my $empty_blob = `git hash-object -t blob --stdin < /dev/null`);
my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r -z/, $cmt);
local $/ = "\0";
- my $pfx = defined($switch_path) ? $switch_path : $git_svn->{path};
+ my $pfx = defined($switch_path) ? $switch_path : $git_svn->path;
$pfx .= '/' if length($pfx);
while (<$ls>) {
chomp;
@@ -117,11 +121,18 @@ sub in_dot_git {
}
# return value: 0 -- don't ignore, 1 -- ignore
+# This will also check whether the path is explicitly included
sub is_path_ignored {
my ($self, $path) = @_;
return 1 if in_dot_git($path);
return 1 if defined($self->{ignore_regex}) &&
$path =~ m!$self->{ignore_regex}!;
+ return 0 if defined($self->{include_regex}) &&
+ $path =~ m!$self->{include_regex}!;
+ return 0 if defined($_include_regex) &&
+ $path =~ m!$_include_regex!;
+ return 1 if defined($self->{include_regex});
+ return 1 if defined($_include_regex);
return 0 unless defined($_ignore_regex);
return 1 if $path =~ m!$_ignore_regex!o;
return 0;
@@ -303,11 +314,21 @@ sub change_file_prop {
sub apply_textdelta {
my ($self, $fb, $exp) = @_;
return undef if $self->is_path_ignored($fb->{path});
- my $fh = $::_repository->temp_acquire('svn_delta');
+ my $suffix = 0;
+ ++$suffix while $::_repository->temp_is_locked("svn_delta_${$}_$suffix");
+ my $fh = $::_repository->temp_acquire("svn_delta_${$}_$suffix");
# $fh gets auto-closed() by SVN::TxDelta::apply(),
# (but $base does not,) so dup() it for reading in close_file
open my $dup, '<&', $fh or croak $!;
- my $base = $::_repository->temp_acquire('git_blob');
+ my $base = $::_repository->temp_acquire("git_blob_${$}_$suffix");
+ # close_file may call temp_acquire on 'svn_hash', but because of the
+ # call chain, if the temp_acquire call from close_file ends up being the
+ # call that first creates the 'svn_hash' temp file, then the FileHandle
+ # that's created as a result will end up in an SVN::Pool that we clear
+ # in SVN::Ra::gs_fetch_loop_common. Avoid that by making sure the
+ # 'svn_hash' FileHandle is already created before close_file is called.
+ my $tmp_fh = $::_repository->temp_acquire('svn_hash');
+ $::_repository->temp_release($tmp_fh, 1);
if ($fb->{blob}) {
my ($base_is_link, $size);
@@ -512,6 +533,8 @@ sub stash_placeholder_list {
1;
__END__
+=head1 NAME
+
Git::SVN::Fetcher - tree delta consumer for "git svn fetch"
=head1 SYNOPSIS
@@ -584,7 +607,7 @@ developing git-svn.
=head1 DEPENDENCIES
L<SVN::Delta> from the Subversion perl bindings,
-the core L<Carp>, L<File::Basename>, and L<IO::File> modules,
+the core L<Carp> and L<File::Basename> modules,
and git's L<Git> helper module.
C<Git::SVN::Fetcher> has not been tested using callers other than
diff --git a/perl/Git/SVN/GlobSpec.pm b/perl/Git/SVN/GlobSpec.pm
index 96cfd9896e..c95f5d76ca 100644
--- a/perl/Git/SVN/GlobSpec.pm
+++ b/perl/Git/SVN/GlobSpec.pm
@@ -44,7 +44,9 @@ sub new {
my $right = join('/', @right);
$re = join('/', @patterns);
$re = join('\/',
- grep(length, quotemeta($left), "($re)", quotemeta($right)));
+ 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;
diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm
index 3cc1c6f081..664105357c 100644
--- a/perl/Git/SVN/Log.pm
+++ b/perl/Git/SVN/Log.pm
@@ -2,7 +2,11 @@ package Git::SVN::Log;
use strict;
use warnings;
use Git::SVN::Utils qw(fatal);
-use Git qw(command command_oneline command_output_pipe command_close_pipe);
+use Git qw(command
+ command_oneline
+ command_output_pipe
+ command_close_pipe
+ get_tz_offset);
use POSIX qw/strftime/;
use constant commit_log_separator => ('-' x 72) . "\n";
use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline
@@ -112,14 +116,15 @@ sub run_pager {
return;
}
open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!";
- $ENV{LESS} ||= 'FRSX';
+ $ENV{LESS} ||= 'FRX';
+ $ENV{LV} ||= '-c';
exec $pager or fatal "Can't run pager: $! ($pager)";
}
sub format_svn_date {
my $t = shift || time;
require Git::SVN;
- my $gmoff = Git::SVN::get_tz($t);
+ my $gmoff = get_tz_offset($t);
return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t));
}
diff --git a/perl/Git/SVN/Migration.pm b/perl/Git/SVN/Migration.pm
index 75d74298ea..cf6ffa7581 100644
--- a/perl/Git/SVN/Migration.pm
+++ b/perl/Git/SVN/Migration.pm
@@ -1,6 +1,6 @@
package Git::SVN::Migration;
# these version numbers do NOT correspond to actual version numbers
-# of git nor git-svn. They are just relative.
+# of git or git-svn. They are just relative.
#
# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD
#
@@ -177,14 +177,14 @@ sub minimize_connections {
my $ra = Git::SVN::Ra->new($url);
# skip existing cases where we already connect to the root
- if (($ra->{url} eq $ra->{repos_root}) ||
+ if (($ra->url eq $ra->{repos_root}) ||
($ra->{repos_root} eq $repo_id)) {
- $root_repos->{$ra->{url}} = $repo_id;
+ $root_repos->{$ra->url} = $repo_id;
next;
}
my $root_ra = Git::SVN::Ra->new($ra->{repos_root});
- my $root_path = $ra->{url};
+ my $root_path = $ra->url;
$root_path =~ s#^\Q$ra->{repos_root}\E(/|$)##;
foreach my $path (keys %$fetch) {
my $ref_id = $fetch->{$path};
diff --git a/perl/Git/SVN/Prompt.pm b/perl/Git/SVN/Prompt.pm
index 3a6f8af0d9..e940b08505 100644
--- a/perl/Git/SVN/Prompt.pm
+++ b/perl/Git/SVN/Prompt.pm
@@ -62,16 +62,16 @@ sub ssl_server_trust {
issuer_dname fingerprint);
my $choice;
prompt:
- print STDERR $may_save ?
+ my $options = $may_save ?
"(R)eject, accept (t)emporarily or accept (p)ermanently? " :
"(R)eject or accept (t)emporarily? ";
STDERR->flush;
- $choice = lc(substr(<STDIN> || 'R', 0, 1));
- if ($choice =~ /^t$/i) {
+ $choice = lc(substr(Git::prompt("Certificate problem.\n" . $options) || 'R', 0, 1));
+ if ($choice eq 't') {
$cred->may_save(undef);
- } elsif ($choice =~ /^r$/i) {
+ } elsif ($choice eq 'r') {
return -1;
- } elsif ($may_save && $choice =~ /^p$/i) {
+ } elsif ($may_save && $choice eq 'p') {
$cred->may_save($may_save);
} else {
goto prompt;
@@ -109,9 +109,7 @@ sub username {
if (defined $_username) {
$username = $_username;
} else {
- print STDERR "Username: ";
- STDERR->flush;
- chomp($username = <STDIN>);
+ $username = Git::prompt("Username: ");
}
$cred->username($username);
$cred->may_save($may_save);
@@ -120,31 +118,15 @@ sub username {
sub _read_password {
my ($prompt, $realm) = @_;
- my $password = '';
- 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;
- }
+ my $password = Git::prompt($prompt, 1);
$password;
}
1;
__END__
+=head1 NAME
+
Git::SVN::Prompt - authentication callbacks for git-svn
=head1 SYNOPSIS
diff --git a/perl/Git/SVN/Ra.pm b/perl/Git/SVN/Ra.pm
index 23ff43e86b..4a499fcb38 100644
--- a/perl/Git/SVN/Ra.pm
+++ b/perl/Git/SVN/Ra.pm
@@ -2,7 +2,13 @@ package Git::SVN::Ra;
use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/;
use strict;
use warnings;
-use SVN::Client;
+use Memoize;
+use Git::SVN::Utils qw(
+ canonicalize_url
+ canonicalize_path
+ add_path_to_url
+);
+
use SVN::Ra;
BEGIN {
@ISA = qw(SVN::Ra);
@@ -26,7 +32,16 @@ BEGIN {
}
}
+# serf has a bug that leads to a coredump upon termination if the
+# remote access object is left around (not fixed yet in serf 1.3.1).
+# Explicitly free it to work around the issue.
+END {
+ $RA = undef;
+ $ra_invalid = 1;
+}
+
sub _auth_providers () {
+ require SVN::Client;
my @rv = (
SVN::Client::get_simple_provider(),
SVN::Client::get_ssl_server_trust_file_provider(),
@@ -62,70 +77,77 @@ sub _auth_providers () {
\@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, $_;
+sub prepare_config_once {
+ 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);
+ 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"));
}
- 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";
+ 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;
}
- $url;
+
+ return ($config, $baton, $callbacks);
+} # no warnings 'once'
+
+INIT {
+ Memoize::memoize '_auth_providers';
+ Memoize::memoize 'prepare_config_once';
}
sub new {
my ($class, $url) = @_;
- $url =~ s!/+$!!;
- return $RA if ($RA && $RA->{url} eq $url);
+ $url = canonicalize_url($url);
+ 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,
+ my ($config, $baton, $callbacks) = prepare_config_once();
+ my $self = SVN::Ra->new(url => $url, auth => $baton,
config => $config,
pool => SVN::Pool->new,
auth_provider_callbacks => $callbacks);
- $self->{url} = $url;
+ $RA = bless $self, $class;
+
+ # Make sure its canonicalized
+ $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;
+
+ return $RA;
+}
+
+sub url {
+ my $self = shift;
+
+ if (@_) {
+ my $url = shift;
+ $self->{url} = canonicalize_url($url);
+ return;
+ }
+
+ return $self->{url};
}
sub check_path {
@@ -153,7 +175,17 @@ sub get_dir {
}
}
my $pool = SVN::Pool->new;
- my ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
+ my ($d, undef, $props);
+
+ if (::compare_svn_version('1.4.0') >= 0) {
+ # n.b. in addition to being potentially more efficient,
+ # this works around what appears to be a bug in some
+ # SVN 1.8 versions
+ my $kind = 1; # SVN_DIRENT_KIND
+ ($d, undef, $props) = $self->get_dir2($dir, $r, $kind, $pool);
+ } else {
+ ($d, undef, $props) = $self->SUPER::get_dir($dir, $r, $pool);
+ }
my %dirents = map { $_ => { kind => $d->{$_}->kind } } keys %$d;
$pool->clear;
if ($r != $cache->{r}) {
@@ -164,10 +196,6 @@ sub get_dir {
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 {
@@ -195,6 +223,7 @@ sub get_log {
qw/copyfrom_path copyfrom_rev action/;
if ($s{'copyfrom_path'}) {
$s{'copyfrom_path'} =~ s/$prefix_regex//;
+ $s{'copyfrom_path'} = canonicalize_path($s{'copyfrom_path'});
}
$_[0]{$p} = \%s;
}
@@ -218,7 +247,10 @@ sub get_log {
$ret;
}
+# uncommon, only for ancient SVN (<= 1.4.2)
sub trees_match {
+ require IO::File;
+ require SVN::Client;
my ($self, $url1, $rev1, $url2, $rev2) = @_;
my $ctx = SVN::Client->new(auth => _auth_providers);
my $out = IO::File->new_tmpfile;
@@ -246,7 +278,7 @@ sub get_commit_editor {
sub gs_do_update {
my ($self, $rev_a, $rev_b, $gs, $editor) = @_;
my $new = ($rev_a == $rev_b);
- my $path = $gs->{path};
+ my $path = $gs->path;
if ($new && -e $gs->{index}) {
unlink $gs->{index} or die
@@ -282,30 +314,33 @@ sub gs_do_update {
# 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 $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 $old_url = $self->url;
+ my $full_url = add_path_to_url( $self->url, $path );
my ($ra, $reparented);
- if ($old_url =~ m#^svn(\+ssh)?://# ||
+ if ($old_url =~ m#^svn(\+\w+)?://# ||
($full_url =~ m#^https?://# &&
- escape_url($full_url) ne $full_url)) {
+ canonicalize_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;
+ SVN::_Ra::svn_ra_reparent(
+ $self->{session},
+ canonicalize_url($full_url),
+ $pool
+ );
+ $self->url($full_url);
$reparented = 1;
}
$ra ||= $self;
- $url_b = escape_url($url_b);
+ $url_b = canonicalize_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);
@@ -313,7 +348,7 @@ sub gs_do_switch {
if ($reparented) {
SVN::_Ra::svn_ra_reparent($self->{session}, $old_url, $pool);
- $self->{url} = $old_url;
+ $self->url($old_url);
}
$pool->clear;
@@ -326,7 +361,7 @@ sub longest_common_path {
my $common_max = scalar @$gsv;
foreach my $gs (@$gsv) {
- my @tmp = split m#/#, $gs->{path};
+ my @tmp = split m#/#, $gs->path;
my $p = '';
foreach (@tmp) {
$p .= length($p) ? "/$_" : $_;
@@ -359,10 +394,22 @@ sub longest_common_path {
sub gs_fetch_loop_common {
my ($self, $base, $head, $gsv, $globs) = @_;
return if ($base > $head);
+ # Make sure the cat_blob open2 FileHandle is created before calling
+ # SVN::Pool::new_default so that it does not incorrectly end up in the pool.
+ $::_repository->_open_cat_blob_if_needed;
+ my $gpool = SVN::Pool->new_default;
+ my $ra_url = $self->url;
+ my $reload_ra = sub {
+ $_[0] = undef;
+ $self = undef;
+ $RA = undef;
+ $gpool->clear;
+ $self = Git::SVN::Ra->new($ra_url);
+ $ra_invalid = undef;
+ };
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;
@@ -407,9 +454,9 @@ sub gs_fetch_loop_common {
}
$SVN::Error::handler = $err_handler;
- my %exists = map { $_->{path} => $_ } @$gsv;
+ my %exists = map { $_->path => $_ } @$gsv;
foreach my $r (sort {$a <=> $b} keys %revs) {
- my ($paths, $logged) = @{$revs{$r}};
+ my ($paths, $logged) = @{delete $revs{$r}};
foreach my $gs ($self->match_globs(\%exists, $paths,
$globs, $r)) {
@@ -432,13 +479,7 @@ sub gs_fetch_loop_common {
"$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;
- }
+ $reload_ra->() if $ra_invalid;
}
# pre-fill the .rev_db since it'll eventually get filled in
# with '0' x40 if something new gets committed
@@ -455,6 +496,8 @@ sub gs_fetch_loop_common {
$min = $max + 1;
$max += $inc;
$max = $head if ($max > $head);
+
+ $reload_ra->();
}
Git::SVN::gc();
}
@@ -508,7 +551,7 @@ sub match_globs {
($self->check_path($p, $r) !=
$SVN::Node::dir));
next unless $p =~ /$g->{path}->{regex}/;
- $exists->{$p} = Git::SVN->init($self->{url}, $p, undef,
+ $exists->{$p} = Git::SVN->init($self->url, $p, undef,
$g->{ref}->full_path($de), 1);
}
}
@@ -532,7 +575,7 @@ sub match_globs {
next if ($self->check_path($pathname, $r) !=
$SVN::Node::dir);
$exists->{$pathname} = Git::SVN->init(
- $self->{url}, $pathname, undef,
+ $self->url, $pathname, undef,
$g->{ref}->full_path($p), 1);
}
my $c = '';
@@ -548,19 +591,20 @@ sub match_globs {
sub minimize_url {
my ($self) = @_;
- return $self->{url} if ($self->{url} eq $self->{repos_root});
+ 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;
+ $url = add_path_to_url($url, $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;
+
+ return canonicalize_url($url);
}
sub can_do_switch {
@@ -568,7 +612,7 @@ sub can_do_switch {
unless (defined $can_do_switch) {
my $pool = SVN::Pool->new;
my $rep = eval {
- $self->do_switch(1, '', 0, $self->{url},
+ $self->do_switch(1, '', 0, $self->url,
SVN::Delta::Editor->new, $pool);
};
if ($@) {
@@ -617,6 +661,8 @@ sub skip_unknown_revs {
1;
__END__
+=head1 NAME
+
Git::SVN::Ra - Subversion remote access functions for git-svn
=head1 SYNOPSIS
diff --git a/perl/Git/SVN/Utils.pm b/perl/Git/SVN/Utils.pm
index 496006bc7b..3d1a0933a2 100644
--- a/perl/Git/SVN/Utils.pm
+++ b/perl/Git/SVN/Utils.pm
@@ -3,9 +3,18 @@ package Git::SVN::Utils;
use strict;
use warnings;
+use SVN::Core;
+
use base qw(Exporter);
-our @EXPORT_OK = qw(fatal can_compress);
+our @EXPORT_OK = qw(
+ fatal
+ can_compress
+ canonicalize_path
+ canonicalize_url
+ join_paths
+ add_path_to_url
+);
=head1 NAME
@@ -56,4 +65,168 @@ sub can_compress {
}
+=head3 canonicalize_path
+
+ my $canoncalized_path = canonicalize_path($path);
+
+Converts $path into a canonical form which is safe to pass to the SVN
+API as a file path.
+
+=cut
+
+# Turn foo/../bar into bar
+sub _collapse_dotdot {
+ my $path = shift;
+
+ 1 while $path =~ s{/[^/]+/+\.\.}{};
+ 1 while $path =~ s{[^/]+/+\.\./}{};
+ 1 while $path =~ s{[^/]+/+\.\.}{};
+
+ return $path;
+}
+
+
+sub canonicalize_path {
+ my $path = shift;
+ my $rv;
+
+ # The 1.7 way to do it
+ if ( defined &SVN::_Core::svn_dirent_canonicalize ) {
+ $path = _collapse_dotdot($path);
+ $rv = SVN::_Core::svn_dirent_canonicalize($path);
+ }
+ # The 1.6 way to do it
+ # This can return undef on subversion-perl-1.4.2-2.el5 (CentOS 5.2)
+ elsif ( defined &SVN::_Core::svn_path_canonicalize ) {
+ $path = _collapse_dotdot($path);
+ $rv = SVN::_Core::svn_path_canonicalize($path);
+ }
+
+ return $rv if defined $rv;
+
+ # No SVN API canonicalization is available, or the SVN API
+ # didn't return a successful result, do it ourselves
+ return _canonicalize_path_ourselves($path);
+}
+
+
+sub _canonicalize_path_ourselves {
+ my ($path) = @_;
+ my $dot_slash_added = 0;
+ if (substr($path, 0, 1) ne "/") {
+ $path = "./" . $path;
+ $dot_slash_added = 1;
+ }
+ $path =~ s#/+#/#g;
+ $path =~ s#/\.(?:/|$)#/#g;
+ $path = _collapse_dotdot($path);
+ $path =~ s#/$##g;
+ $path =~ s#^\./## if $dot_slash_added;
+ $path =~ s#^\.$##;
+ return $path;
+}
+
+
+=head3 canonicalize_url
+
+ my $canonicalized_url = canonicalize_url($url);
+
+Converts $url into a canonical form which is safe to pass to the SVN
+API as a URL.
+
+=cut
+
+sub canonicalize_url {
+ my $url = shift;
+
+ # The 1.7 way to do it
+ if ( defined &SVN::_Core::svn_uri_canonicalize ) {
+ return SVN::_Core::svn_uri_canonicalize($url);
+ }
+ # There wasn't a 1.6 way to do it, so we do it ourself.
+ else {
+ return _canonicalize_url_ourselves($url);
+ }
+}
+
+
+sub _canonicalize_url_path {
+ my ($uri_path) = @_;
+
+ my @parts;
+ foreach my $part (split m{/+}, $uri_path) {
+ $part =~ s/([^!\$%&'()*+,.\/\w:=\@_`~-]|%(?![a-fA-F0-9]{2}))/sprintf("%%%02X",ord($1))/eg;
+ push @parts, $part;
+ }
+
+ return join('/', @parts);
+}
+
+sub _canonicalize_url_ourselves {
+ my ($url) = @_;
+ if ($url =~ m#^([^:]+)://([^/]*)(.*)$#) {
+ my ($scheme, $domain, $uri) = ($1, $2, _canonicalize_url_path(canonicalize_path($3)));
+ $url = "$scheme://$domain$uri";
+ }
+ $url;
+}
+
+
+=head3 join_paths
+
+ my $new_path = join_paths(@paths);
+
+Appends @paths together into a single path. Any empty paths are ignored.
+
+=cut
+
+sub join_paths {
+ my @paths = @_;
+
+ @paths = grep { defined $_ && length $_ } @paths;
+
+ return '' unless @paths;
+ return $paths[0] if @paths == 1;
+
+ my $new_path = shift @paths;
+ $new_path =~ s{/+$}{};
+
+ my $last_path = pop @paths;
+ $last_path =~ s{^/+}{};
+
+ for my $path (@paths) {
+ $path =~ s{^/+}{};
+ $path =~ s{/+$}{};
+ $new_path .= "/$path";
+ }
+
+ return $new_path .= "/$last_path";
+}
+
+
+=head3 add_path_to_url
+
+ my $new_url = add_path_to_url($url, $path);
+
+Appends $path onto the $url. If $path is empty, $url is returned unchanged.
+
+=cut
+
+sub add_path_to_url {
+ my($url, $path) = @_;
+
+ return $url if !defined $path or !length $path;
+
+ # Strip trailing and leading slashes so we don't
+ # wind up with http://x.com///path
+ $url =~ s{/+$}{};
+ $path =~ s{^/+}{};
+
+ # If a path has a % in it, URI escape it so it's not
+ # mistaken for a URI escape later.
+ $path =~ s{%}{%25}g;
+
+ return join '/', $url, $path;
+}
+
1;
generated by cgit v1.2.3 (git 2.25.1) at 2025-01-13 09:10:29 +0000