diff options
Diffstat (limited to 'perl/Git/SVN')
-rw-r--r-- | perl/Git/SVN/Editor.pm | 25 | ||||
-rw-r--r-- | perl/Git/SVN/Fetcher.pm | 2 | ||||
-rw-r--r-- | perl/Git/SVN/GlobSpec.pm | 4 | ||||
-rw-r--r-- | perl/Git/SVN/Migration.pm | 6 | ||||
-rw-r--r-- | perl/Git/SVN/Prompt.pm | 34 | ||||
-rw-r--r-- | perl/Git/SVN/Ra.pm | 94 | ||||
-rw-r--r-- | perl/Git/SVN/Utils.pm | 175 |
7 files changed, 264 insertions, 76 deletions
diff --git a/perl/Git/SVN/Editor.pm b/perl/Git/SVN/Editor.pm index 755092fdff..3bbc20a054 100644 --- a/perl/Git/SVN/Editor.pm +++ b/perl/Git/SVN/Editor.pm @@ -345,7 +345,30 @@ sub 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} + }); + $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} + }); + return; + } + + $self->M($m, $deletions); +} sub change_file_prop { my ($self, $fbat, $pname, $pval) = @_; diff --git a/perl/Git/SVN/Fetcher.pm b/perl/Git/SVN/Fetcher.pm index 76fae9bce0..046a7a2f31 100644 --- a/perl/Git/SVN/Fetcher.pm +++ b/perl/Git/SVN/Fetcher.pm @@ -83,7 +83,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; 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/Migration.pm b/perl/Git/SVN/Migration.pm index 75d74298ea..30daf35465 100644 --- a/perl/Git/SVN/Migration.pm +++ b/perl/Git/SVN/Migration.pm @@ -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..74daa7a597 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,25 +118,7 @@ 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; } diff --git a/perl/Git/SVN/Ra.pm b/perl/Git/SVN/Ra.pm index 23ff43e86b..049c97bfaf 100644 --- a/perl/Git/SVN/Ra.pm +++ b/perl/Git/SVN/Ra.pm @@ -3,6 +3,12 @@ use vars qw/@ISA $config_dir $_ignore_refs_regex $_log_window_size/; use strict; use warnings; use SVN::Client; +use Git::SVN::Utils qw( + canonicalize_url + canonicalize_path + add_path_to_url +); + use SVN::Ra; BEGIN { @ISA = qw(SVN::Ra); @@ -62,29 +68,11 @@ 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, $_; - } - 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); + $url = canonicalize_url($url); + return $RA if ($RA && $RA->url eq $url); ::_req_svn(); @@ -115,17 +103,34 @@ sub new { $Git::SVN::Prompt::_no_auth_cache = 1; } } # no warnings 'once' - my $self = SVN::Ra->new(url => escape_url($url), auth => $baton, + + 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 { @@ -195,6 +200,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; } @@ -246,7 +252,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 +288,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)?://# || ($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 +322,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 +335,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) ? "/$_" : $_; @@ -362,7 +371,7 @@ sub gs_fetch_loop_common { 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 $ra_url = $self->url; my $find_trailing_edge; while (1) { my %revs; @@ -407,7 +416,7 @@ 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}}; @@ -508,7 +517,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 +541,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 +557,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 +578,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 ($@) { diff --git a/perl/Git/SVN/Utils.pm b/perl/Git/SVN/Utils.pm index 496006bc7b..8b8cf3755c 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; |