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 | 3 | ||||
| -rw-r--r-- | perl/Git/SVN/GlobSpec.pm | 61 | ||||
| -rw-r--r-- | perl/Git/SVN/Log.pm | 395 | ||||
| -rw-r--r-- | perl/Git/SVN/Migration.pm | 258 | ||||
| -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 | 232 |
8 files changed, 1031 insertions, 71 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 ef8e9ed2a5..046a7a2f31 100644 --- a/perl/Git/SVN/Fetcher.pm +++ b/perl/Git/SVN/Fetcher.pm @@ -57,6 +57,7 @@ sub new { $self->{file_prop} = {}; $self->{absent_dir} = {}; $self->{absent_file} = {}; + require Git::IndexInfo; $self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new }); $self->{pathnameencoding} = Git::config('svn.pathnameencoding'); $self; @@ -82,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 new file mode 100644 index 0000000000..c95f5d76ca --- /dev/null +++ b/perl/Git/SVN/GlobSpec.pm @@ -0,0 +1,61 @@ +package Git::SVN::GlobSpec; +use strict; +use warnings; + +sub new { + my ($class, $glob, $pattern_ok) = @_; + my $re = $glob; + $re =~ s!/+$!!g; # no need for trailing slashes + my (@left, @right, @patterns); + my $state = "left"; + my $die_msg = "Only one set of wildcard directories " . + "(e.g. '*' or '*/*/*') is supported: '$glob'\n"; + for my $part (split(m|/|, $glob)) { + if ($part =~ /\*/ && $part ne "*") { + die "Invalid pattern in '$glob': $part\n"; + } elsif ($pattern_ok && $part =~ /[{}]/ && + $part !~ /^\{[^{}]+\}/) { + die "Invalid pattern in '$glob': $part\n"; + } + if ($part eq "*") { + die $die_msg if $state eq "right"; + $state = "pattern"; + push(@patterns, "[^/]*"); + } elsif ($pattern_ok && $part =~ /^\{(.*)\}$/) { + die $die_msg if $state eq "right"; + $state = "pattern"; + my $p = quotemeta($1); + $p =~ s/\\,/|/g; + push(@patterns, "(?:$p)"); + } else { + if ($state eq "left") { + push(@left, $part); + } else { + push(@right, $part); + $state = "right"; + } + } + } + my $depth = @patterns; + if ($depth == 0) { + die "One '*' is needed in glob: '$glob'\n"; + } + my $left = join('/', @left); + my $right = join('/', @right); + $re = join('/', @patterns); + $re = join('\/', + 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; +} + +sub full_path { + my ($self, $path) = @_; + return (length $self->{left} ? "$self->{left}/" : '') . + $path . (length $self->{right} ? "/$self->{right}" : ''); +} + +1; diff --git a/perl/Git/SVN/Log.pm b/perl/Git/SVN/Log.pm new file mode 100644 index 0000000000..3cc1c6f081 --- /dev/null +++ b/perl/Git/SVN/Log.pm @@ -0,0 +1,395 @@ +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 POSIX qw/strftime/; +use constant commit_log_separator => ('-' x 72) . "\n"; +use vars qw/$TZ $limit $color $pager $non_recursive $verbose $oneline + %rusers $show_commit $incremental/; + +# Option set in git-svn +our $_git_format; + +sub cmt_showable { + my ($c) = @_; + return 1 if defined $c->{r}; + + # big commit message got truncated by the 16k pretty buffer in rev-list + if ($c->{l} && $c->{l}->[-1] eq "...\n" && + $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) { + @{$c->{l}} = (); + my @log = command(qw/cat-file commit/, $c->{c}); + + # shift off the headers + shift @log while ($log[0] ne ''); + shift @log; + + # TODO: make $c->{l} not have a trailing newline in the future + @{$c->{l}} = map { "$_\n" } grep !/^git-svn-id: /, @log; + + (undef, $c->{r}, undef) = ::extract_metadata( + (grep(/^git-svn-id: /, @log))[-1]); + } + return defined $c->{r}; +} + +sub log_use_color { + return $color || Git->repository->get_colorbool('color.diff'); +} + +sub git_svn_log_cmd { + my ($r_min, $r_max, @args) = @_; + my $head = 'HEAD'; + my (@files, @log_opts); + foreach my $x (@args) { + if ($x eq '--' || @files) { + push @files, $x; + } else { + if (::verify_ref("$x^0")) { + $head = $x; + } else { + push @log_opts, $x; + } + } + } + + my ($url, $rev, $uuid, $gs) = ::working_head_info($head); + + require Git::SVN; + $gs ||= Git::SVN->_new; + my @cmd = (qw/log --abbrev-commit --pretty=raw --default/, + $gs->refname); + push @cmd, '-r' unless $non_recursive; + push @cmd, qw/--raw --name-status/ if $verbose; + push @cmd, '--color' if log_use_color(); + push @cmd, @log_opts; + if (defined $r_max && $r_max == $r_min) { + push @cmd, '--max-count=1'; + if (my $c = $gs->rev_map_get($r_max)) { + push @cmd, $c; + } + } elsif (defined $r_max) { + if ($r_max < $r_min) { + ($r_min, $r_max) = ($r_max, $r_min); + } + my (undef, $c_max) = $gs->find_rev_before($r_max, 1, $r_min); + my (undef, $c_min) = $gs->find_rev_after($r_min, 1, $r_max); + # If there are no commits in the range, both $c_max and $c_min + # will be undefined. If there is at least 1 commit in the + # range, both will be defined. + return () if !defined $c_min || !defined $c_max; + if ($c_min eq $c_max) { + push @cmd, '--max-count=1', $c_min; + } else { + push @cmd, '--boundary', "$c_min..$c_max"; + } + } + return (@cmd, @files); +} + +# adapted from pager.c +sub config_pager { + if (! -t *STDOUT) { + $ENV{GIT_PAGER_IN_USE} = 'false'; + $pager = undef; + return; + } + chomp($pager = command_oneline(qw(var GIT_PAGER))); + if ($pager eq 'cat') { + $pager = undef; + } + $ENV{GIT_PAGER_IN_USE} = defined($pager); +} + +sub run_pager { + return unless defined $pager; + pipe my ($rfd, $wfd) or return; + defined(my $pid = fork) or fatal "Can't fork: $!"; + if (!$pid) { + open STDOUT, '>&', $wfd or + fatal "Can't redirect to stdout: $!"; + return; + } + open STDIN, '<&', $rfd or fatal "Can't redirect stdin: $!"; + $ENV{LESS} ||= 'FRSX'; + 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); + return strftime("%Y-%m-%d %H:%M:%S $gmoff (%a, %d %b %Y)", localtime($t)); +} + +sub parse_git_date { + my ($t, $tz) = @_; + # Date::Parse isn't in the standard Perl distro :( + if ($tz =~ s/^\+//) { + $t += tz_to_s_offset($tz); + } elsif ($tz =~ s/^\-//) { + $t -= tz_to_s_offset($tz); + } + return $t; +} + +sub set_local_timezone { + if (defined $TZ) { + $ENV{TZ} = $TZ; + } else { + delete $ENV{TZ}; + } +} + +sub tz_to_s_offset { + my ($tz) = @_; + $tz =~ s/(\d\d)$//; + return ($1 * 60) + ($tz * 3600); +} + +sub get_author_info { + my ($dest, $author, $t, $tz) = @_; + $author =~ s/(?:^\s*|\s*$)//g; + $dest->{a_raw} = $author; + my $au; + if ($::_authors) { + $au = $rusers{$author} || undef; + } + if (!$au) { + ($au) = ($author =~ /<([^>]+)\@[^>]+>$/); + } + $dest->{t} = $t; + $dest->{tz} = $tz; + $dest->{a} = $au; + $dest->{t_utc} = parse_git_date($t, $tz); +} + +sub process_commit { + my ($c, $r_min, $r_max, $defer) = @_; + if (defined $r_min && defined $r_max) { + if ($r_min == $c->{r} && $r_min == $r_max) { + show_commit($c); + return 0; + } + return 1 if $r_min == $r_max; + if ($r_min < $r_max) { + # we need to reverse the print order + return 0 if (defined $limit && --$limit < 0); + push @$defer, $c; + return 1; + } + if ($r_min != $r_max) { + return 1 if ($r_min < $c->{r}); + return 1 if ($r_max > $c->{r}); + } + } + return 0 if (defined $limit && --$limit < 0); + show_commit($c); + return 1; +} + +my $l_fmt; +sub show_commit { + my $c = shift; + if ($oneline) { + my $x = "\n"; + if (my $l = $c->{l}) { + while ($l->[0] =~ /^\s*$/) { shift @$l } + $x = $l->[0]; + } + $l_fmt ||= 'A' . length($c->{r}); + print 'r',pack($l_fmt, $c->{r}),' | '; + print "$c->{c} | " if $show_commit; + print $x; + } else { + show_commit_normal($c); + } +} + +sub show_commit_changed_paths { + my ($c) = @_; + return unless $c->{changed}; + print "Changed paths:\n", @{$c->{changed}}; +} + +sub show_commit_normal { + my ($c) = @_; + print commit_log_separator, "r$c->{r} | "; + print "$c->{c} | " if $show_commit; + print "$c->{a} | ", format_svn_date($c->{t_utc}), ' | '; + my $nr_line = 0; + + if (my $l = $c->{l}) { + while ($l->[$#$l] eq "\n" && $#$l > 0 + && $l->[($#$l - 1)] eq "\n") { + pop @$l; + } + $nr_line = scalar @$l; + if (!$nr_line) { + print "1 line\n\n\n"; + } else { + if ($nr_line == 1) { + $nr_line = '1 line'; + } else { + $nr_line .= ' lines'; + } + print $nr_line, "\n"; + show_commit_changed_paths($c); + print "\n"; + print $_ foreach @$l; + } + } else { + print "1 line\n"; + show_commit_changed_paths($c); + print "\n"; + + } + foreach my $x (qw/raw stat diff/) { + if ($c->{$x}) { + print "\n"; + print $_ foreach @{$c->{$x}} + } + } +} + +sub cmd_show_log { + my (@args) = @_; + my ($r_min, $r_max); + my $r_last = -1; # prevent dupes + set_local_timezone(); + if (defined $::_revision) { + if ($::_revision =~ /^(\d+):(\d+)$/) { + ($r_min, $r_max) = ($1, $2); + } elsif ($::_revision =~ /^\d+$/) { + $r_min = $r_max = $::_revision; + } else { + fatal "-r$::_revision is not supported, use ", + "standard 'git log' arguments instead"; + } + } + + config_pager(); + @args = git_svn_log_cmd($r_min, $r_max, @args); + if (!@args) { + print commit_log_separator unless $incremental || $oneline; + return; + } + my $log = command_output_pipe(@args); + run_pager(); + my (@k, $c, $d, $stat); + my $esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/; + while (<$log>) { + if (/^${esc_color}commit (?:- )?($::sha1_short)/o) { + my $cmt = $1; + if ($c && cmt_showable($c) && $c->{r} != $r_last) { + $r_last = $c->{r}; + process_commit($c, $r_min, $r_max, \@k) or + goto out; + } + $d = undef; + $c = { c => $cmt }; + } elsif (/^${esc_color}author (.+) (\d+) ([\-\+]?\d+)$/o) { + get_author_info($c, $1, $2, $3); + } elsif (/^${esc_color}(?:tree|parent|committer) /o) { + # ignore + } elsif (/^${esc_color}:\d{6} \d{6} $::sha1_short/o) { + push @{$c->{raw}}, $_; + } elsif (/^${esc_color}[ACRMDT]\t/) { + # we could add $SVN->{svn_path} here, but that requires + # remote access at the moment (repo_path_split)... + s#^(${esc_color})([ACRMDT])\t#$1 $2 #o; + push @{$c->{changed}}, $_; + } elsif (/^${esc_color}diff /o) { + $d = 1; + push @{$c->{diff}}, $_; + } elsif ($d) { + push @{$c->{diff}}, $_; + } elsif (/^\ .+\ \|\s*\d+\ $esc_color[\+\-]* + $esc_color*[\+\-]*$esc_color$/x) { + $stat = 1; + push @{$c->{stat}}, $_; + } elsif ($stat && /^ \d+ files changed, \d+ insertions/) { + push @{$c->{stat}}, $_; + $stat = undef; + } elsif (/^${esc_color} (git-svn-id:.+)$/o) { + ($c->{url}, $c->{r}, undef) = ::extract_metadata($1); + } elsif (s/^${esc_color} //o) { + push @{$c->{l}}, $_; + } + } + if ($c && defined $c->{r} && $c->{r} != $r_last) { + $r_last = $c->{r}; + process_commit($c, $r_min, $r_max, \@k); + } + if (@k) { + ($r_min, $r_max) = ($r_max, $r_min); + process_commit($_, $r_min, $r_max) foreach reverse @k; + } +out: + close $log; + print commit_log_separator unless $incremental || $oneline; +} + +sub cmd_blame { + my $path = pop; + + config_pager(); + run_pager(); + + my ($fh, $ctx, $rev); + + if ($_git_format) { + ($fh, $ctx) = command_output_pipe('blame', @_, $path); + while (my $line = <$fh>) { + if ($line =~ /^\^?([[:xdigit:]]+)\s/) { + # Uncommitted edits show up as a rev ID of + # all zeros, which we can't look up with + # cmt_metadata + if ($1 !~ /^0+$/) { + (undef, $rev, undef) = + ::cmt_metadata($1); + $rev = '0' if (!$rev); + } else { + $rev = '0'; + } + $rev = sprintf('%-10s', $rev); + $line =~ s/^\^?[[:xdigit:]]+(\s)/$rev$1/; + } + print $line; + } + } else { + ($fh, $ctx) = command_output_pipe('blame', '-p', @_, 'HEAD', + '--', $path); + my ($sha1); + my %authors; + my @buffer; + my %dsha; #distinct sha keys + + while (my $line = <$fh>) { + push @buffer, $line; + if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { + $dsha{$1} = 1; + } + } + + my $s2r = ::cmt_sha2rev_batch([keys %dsha]); + + foreach my $line (@buffer) { + if ($line =~ /^([[:xdigit:]]{40})\s\d+\s\d+/) { + $rev = $s2r->{$1}; + $rev = '0' if (!$rev) + } + elsif ($line =~ /^author (.*)/) { + $authors{$rev} = $1; + $authors{$rev} =~ s/\s/_/g; + } + elsif ($line =~ /^\t(.*)$/) { + printf("%6s %10s %s\n", $rev, $authors{$rev}, $1); + } + } + } + command_close_pipe($fh, $ctx); +} + +1; diff --git a/perl/Git/SVN/Migration.pm b/perl/Git/SVN/Migration.pm new file mode 100644 index 0000000000..30daf35465 --- /dev/null +++ b/perl/Git/SVN/Migration.pm @@ -0,0 +1,258 @@ +package Git::SVN::Migration; +# these version numbers do NOT correspond to actual version numbers +# of git nor git-svn. They are just relative. +# +# v0 layout: .git/$id/info/url, refs/heads/$id-HEAD +# +# v1 layout: .git/$id/info/url, refs/remotes/$id +# +# v2 layout: .git/svn/$id/info/url, refs/remotes/$id +# +# v3 layout: .git/svn/$id, refs/remotes/$id +# - info/url may remain for backwards compatibility +# - this is what we migrate up to this layout automatically, +# - this will be used by git svn init on single branches +# v3.1 layout (auto migrated): +# - .rev_db => .rev_db.$UUID, .rev_db will remain as a symlink +# for backwards compatibility +# +# v4 layout: .git/svn/$repo_id/$id, refs/remotes/$repo_id/$id +# - this is only created for newly multi-init-ed +# repositories. Similar in spirit to the +# --use-separate-remotes option in git-clone (now default) +# - we do not automatically migrate to this (following +# the example set by core git) +# +# v5 layout: .rev_db.$UUID => .rev_map.$UUID +# - newer, more-efficient format that uses 24-bytes per record +# with no filler space. +# - use xxd -c24 < .rev_map.$UUID to view and debug +# - This is a one-way migration, repositories updated to the +# new format will not be able to use old git-svn without +# rebuilding the .rev_db. Rebuilding the rev_db is not +# possible if noMetadata or useSvmProps are set; but should +# be no problem for users that use the (sensible) defaults. +use strict; +use warnings; +use Carp qw/croak/; +use File::Path qw/mkpath/; +use File::Basename qw/dirname basename/; + +our $_minimize; +use Git qw( + command + command_noisy + command_output_pipe + command_close_pipe +); + +sub migrate_from_v0 { + my $git_dir = $ENV{GIT_DIR}; + return undef unless -d $git_dir; + my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); + my $migrated = 0; + while (<$fh>) { + chomp; + my ($id, $orig_ref) = ($_, $_); + next unless $id =~ s#^refs/heads/(.+)-HEAD$#$1#; + next unless -f "$git_dir/$id/info/url"; + my $new_ref = "refs/remotes/$id"; + if (::verify_ref("$new_ref^0")) { + print STDERR "W: $orig_ref is probably an old ", + "branch used by an ancient version of ", + "git-svn.\n", + "However, $new_ref also exists.\n", + "We will not be able ", + "to use this branch until this ", + "ambiguity is resolved.\n"; + next; + } + print STDERR "Migrating from v0 layout...\n" if !$migrated; + print STDERR "Renaming ref: $orig_ref => $new_ref\n"; + command_noisy('update-ref', $new_ref, $orig_ref); + command_noisy('update-ref', '-d', $orig_ref, $orig_ref); + $migrated++; + } + command_close_pipe($fh, $ctx); + print STDERR "Done migrating from v0 layout...\n" if $migrated; + $migrated; +} + +sub migrate_from_v1 { + my $git_dir = $ENV{GIT_DIR}; + my $migrated = 0; + return $migrated unless -d $git_dir; + my $svn_dir = "$git_dir/svn"; + + # just in case somebody used 'svn' as their $id at some point... + return $migrated if -d $svn_dir && ! -f "$svn_dir/info/url"; + + print STDERR "Migrating from a git-svn v1 layout...\n"; + mkpath([$svn_dir]); + print STDERR "Data from a previous version of git-svn exists, but\n\t", + "$svn_dir\n\t(required for this version ", + "($::VERSION) of git-svn) does not exist.\n"; + my ($fh, $ctx) = command_output_pipe(qw/rev-parse --symbolic --all/); + while (<$fh>) { + my $x = $_; + next unless $x =~ s#^refs/remotes/##; + chomp $x; + next unless -f "$git_dir/$x/info/url"; + my $u = eval { ::file_to_s("$git_dir/$x/info/url") }; + next unless $u; + my $dn = dirname("$git_dir/svn/$x"); + mkpath([$dn]) unless -d $dn; + if ($x eq 'svn') { # they used 'svn' as GIT_SVN_ID: + mkpath(["$git_dir/svn/svn"]); + print STDERR " - $git_dir/$x/info => ", + "$git_dir/svn/$x/info\n"; + rename "$git_dir/$x/info", "$git_dir/svn/$x/info" or + croak "$!: $x"; + # don't worry too much about these, they probably + # don't exist with repos this old (save for index, + # and we can easily regenerate that) + foreach my $f (qw/unhandled.log index .rev_db/) { + rename "$git_dir/$x/$f", "$git_dir/svn/$x/$f"; + } + } else { + print STDERR " - $git_dir/$x => $git_dir/svn/$x\n"; + rename "$git_dir/$x", "$git_dir/svn/$x" or + croak "$!: $x"; + } + $migrated++; + } + command_close_pipe($fh, $ctx); + print STDERR "Done migrating from a git-svn v1 layout\n"; + $migrated; +} + +sub read_old_urls { + my ($l_map, $pfx, $path) = @_; + my @dir; + foreach (<$path/*>) { + if (-r "$_/info/url") { + $pfx .= '/' if $pfx && $pfx !~ m!/$!; + my $ref_id = $pfx . basename $_; + my $url = ::file_to_s("$_/info/url"); + $l_map->{$ref_id} = $url; + } elsif (-d $_) { + push @dir, $_; + } + } + foreach (@dir) { + my $x = $_; + $x =~ s!^\Q$ENV{GIT_DIR}\E/svn/!!o; + read_old_urls($l_map, $x, $_); + } +} + +sub migrate_from_v2 { + my @cfg = command(qw/config -l/); + return if grep /^svn-remote\..+\.url=/, @cfg; + my %l_map; + read_old_urls(\%l_map, '', "$ENV{GIT_DIR}/svn"); + my $migrated = 0; + + require Git::SVN; + foreach my $ref_id (sort keys %l_map) { + eval { Git::SVN->init($l_map{$ref_id}, '', undef, $ref_id) }; + if ($@) { + Git::SVN->init($l_map{$ref_id}, '', $ref_id, $ref_id); + } + $migrated++; + } + $migrated; +} + +sub minimize_connections { + require Git::SVN; + require Git::SVN::Ra; + + my $r = Git::SVN::read_all_remotes(); + my $new_urls = {}; + my $root_repos = {}; + foreach my $repo_id (keys %$r) { + my $url = $r->{$repo_id}->{url} or next; + my $fetch = $r->{$repo_id}->{fetch} or next; + my $ra = Git::SVN::Ra->new($url); + + # skip existing cases where we already connect to the root + if (($ra->url eq $ra->{repos_root}) || + ($ra->{repos_root} eq $repo_id)) { + $root_repos->{$ra->url} = $repo_id; + next; + } + + my $root_ra = Git::SVN::Ra->new($ra->{repos_root}); + my $root_path = $ra->url; + $root_path =~ s#^\Q$ra->{repos_root}\E(/|$)##; + foreach my $path (keys %$fetch) { + my $ref_id = $fetch->{$path}; + my $gs = Git::SVN->new($ref_id, $repo_id, $path); + + # make sure we can read when connecting to + # a higher level of a repository + my ($last_rev, undef) = $gs->last_rev_commit; + if (!defined $last_rev) { + $last_rev = eval { + $root_ra->get_latest_revnum; + }; + next if $@; + } + my $new = $root_path; + $new .= length $path ? "/$path" : ''; + eval { + $root_ra->get_log([$new], $last_rev, $last_rev, + 0, 0, 1, sub { }); + }; + next if $@; + $new_urls->{$ra->{repos_root}}->{$new} = + { ref_id => $ref_id, + old_repo_id => $repo_id, + old_path => $path }; + } + } + + my @emptied; + foreach my $url (keys %$new_urls) { + # see if we can re-use an existing [svn-remote "repo_id"] + # instead of creating a(n ugly) new section: + my $repo_id = $root_repos->{$url} || $url; + + my $fetch = $new_urls->{$url}; + foreach my $path (keys %$fetch) { + my $x = $fetch->{$path}; + Git::SVN->init($url, $path, $repo_id, $x->{ref_id}); + my $pfx = "svn-remote.$x->{old_repo_id}"; + + my $old_fetch = quotemeta("$x->{old_path}:". + "$x->{ref_id}"); + command_noisy(qw/config --unset/, + "$pfx.fetch", '^'. $old_fetch . '$'); + delete $r->{$x->{old_repo_id}}-> + {fetch}->{$x->{old_path}}; + if (!keys %{$r->{$x->{old_repo_id}}->{fetch}}) { + command_noisy(qw/config --unset/, + "$pfx.url"); + push @emptied, $x->{old_repo_id} + } + } + } + if (@emptied) { + my $file = $ENV{GIT_CONFIG} || "$ENV{GIT_DIR}/config"; + print STDERR <<EOF; +The following [svn-remote] sections in your config file ($file) are empty +and can be safely removed: +EOF + print STDERR "[svn-remote \"$_\"]\n" foreach @emptied; + } +} + +sub migration_check { + migrate_from_v0(); + migrate_from_v1(); + migrate_from_v2(); + minimize_connections() if $_minimize; +} + +1; 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 new file mode 100644 index 0000000000..8b8cf3755c --- /dev/null +++ b/perl/Git/SVN/Utils.pm @@ -0,0 +1,232 @@ +package Git::SVN::Utils; + +use strict; +use warnings; + +use SVN::Core; + +use base qw(Exporter); + +our @EXPORT_OK = qw( + fatal + can_compress + canonicalize_path + canonicalize_url + join_paths + add_path_to_url +); + + +=head1 NAME + +Git::SVN::Utils - utility functions used across Git::SVN + +=head1 SYNOPSIS + + use Git::SVN::Utils qw(functions to import); + +=head1 DESCRIPTION + +This module contains functions which are useful across many different +parts of Git::SVN. Mostly it's a place to put utility functions +rather than duplicate the code or have classes grabbing at other +classes. + +=head1 FUNCTIONS + +All functions can be imported only on request. + +=head3 fatal + + fatal(@message); + +Display a message and exit with a fatal error code. + +=cut + +# Note: not certain why this is in use instead of die. Probably because +# the exit code of die is 255? Doesn't appear to be used consistently. +sub fatal (@) { print STDERR "@_\n"; exit 1 } + + +=head3 can_compress + + my $can_compress = can_compress; + +Returns true if Compress::Zlib is available, false otherwise. + +=cut + +my $can_compress; +sub can_compress { + return $can_compress if defined $can_compress; + + return $can_compress = eval { require Compress::Zlib; }; +} + + +=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; |