Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1 | package Git::SVN; |
| 2 | use strict; |
Jeff King | 5338ed2 | 2020-10-21 23:24:00 -0400 | [diff] [blame] | 3 | use warnings $ENV{GIT_PERL_FATAL_WARNINGS} ? qw(FATAL all) : (); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 4 | use Fcntl qw/:DEFAULT :seek/; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 5 | use constant rev_map_fmt => 'NH*'; |
Michael G. Schwern | 5c71028 | 2012-07-26 16:22:25 -0700 | [diff] [blame] | 6 | use vars qw/$_no_metadata |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 7 | $_repack $_repack_flags $_use_svm_props $_head |
Michael G. Schwern | 5c71028 | 2012-07-26 16:22:25 -0700 | [diff] [blame] | 8 | $_use_svnsync_props $no_reuse_existing |
Eric Wong | 412e4ca | 2021-10-29 00:15:52 +0000 | [diff] [blame] | 9 | $_use_log_author $_add_author_from $_localtime $_use_fsync/; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 10 | use Carp qw/croak/; |
| 11 | use File::Path qw/mkpath/; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 12 | use IPC::Open3; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 13 | use Memoize; # core since 5.8.0, Jul 2002 |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 14 | use POSIX qw(:signal_h); |
Ryuichi Kokubo | 45c956b | 2015-02-26 01:04:41 +0900 | [diff] [blame] | 15 | use Time::Local; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 16 | |
| 17 | use Git qw( |
| 18 | command |
| 19 | command_oneline |
| 20 | command_noisy |
| 21 | command_output_pipe |
| 22 | command_close_pipe |
Ben Walton | 68868ff | 2013-02-09 21:46:56 +0000 | [diff] [blame] | 23 | get_tz_offset |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 24 | ); |
Michael G. Schwern | ca475a6 | 2012-07-28 02:38:29 -0700 | [diff] [blame] | 25 | use Git::SVN::Utils qw( |
| 26 | fatal |
| 27 | can_compress |
| 28 | join_paths |
Michael G. Schwern | 565e56c | 2012-07-28 02:38:32 -0700 | [diff] [blame] | 29 | canonicalize_path |
| 30 | canonicalize_url |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 31 | add_path_to_url |
Michael G. Schwern | ca475a6 | 2012-07-28 02:38:29 -0700 | [diff] [blame] | 32 | ); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 33 | |
Eric Wong | 47092c1 | 2015-01-15 08:54:22 +0000 | [diff] [blame] | 34 | my $memo_backend; |
Michael G. Schwern | 5c71028 | 2012-07-26 16:22:25 -0700 | [diff] [blame] | 35 | our $_follow_parent = 1; |
| 36 | our $_minimize_url = 'unset'; |
| 37 | our $default_repo_id = 'svn'; |
| 38 | our $default_ref_id = $ENV{GIT_SVN_ID} || 'git-svn'; |
| 39 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 40 | my ($_gc_nr, $_gc_period); |
| 41 | |
| 42 | # properties that we do not log: |
| 43 | my %SKIP_PROP; |
| 44 | BEGIN { |
| 45 | %SKIP_PROP = map { $_ => 1 } qw/svn:wc:ra_dav:version-url |
| 46 | svn:special svn:executable |
| 47 | svn:entry:committed-rev |
| 48 | svn:entry:last-author |
| 49 | svn:entry:uuid |
| 50 | svn:entry:committed-date/; |
| 51 | |
| 52 | # some options are read globally, but can be overridden locally |
| 53 | # per [svn-remote "..."] section. Command-line options will *NOT* |
| 54 | # override options set in an [svn-remote "..."] section |
| 55 | no strict 'refs'; |
| 56 | for my $option (qw/follow_parent no_metadata use_svm_props |
| 57 | use_svnsync_props/) { |
| 58 | my $key = $option; |
| 59 | $key =~ tr/_//d; |
| 60 | my $prop = "-$option"; |
| 61 | *$option = sub { |
| 62 | my ($self) = @_; |
| 63 | return $self->{$prop} if exists $self->{$prop}; |
| 64 | my $k = "svn-remote.$self->{repo_id}.$key"; |
| 65 | eval { command_oneline(qw/config --get/, $k) }; |
| 66 | if ($@) { |
| 67 | $self->{$prop} = ${"Git::SVN::_$option"}; |
| 68 | } else { |
| 69 | my $v = command_oneline(qw/config --bool/,$k); |
| 70 | $self->{$prop} = $v eq 'false' ? 0 : 1; |
| 71 | } |
| 72 | return $self->{$prop}; |
| 73 | } |
| 74 | } |
| 75 | } |
| 76 | |
| 77 | |
| 78 | my (%LOCKFILES, %INDEX_FILES); |
| 79 | END { |
| 80 | unlink keys %LOCKFILES if %LOCKFILES; |
| 81 | unlink keys %INDEX_FILES if %INDEX_FILES; |
| 82 | } |
| 83 | |
| 84 | sub resolve_local_globs { |
| 85 | my ($url, $fetch, $glob_spec) = @_; |
| 86 | return unless defined $glob_spec; |
| 87 | my $ref = $glob_spec->{ref}; |
| 88 | my $path = $glob_spec->{path}; |
| 89 | foreach (command(qw#for-each-ref --format=%(refname) refs/#)) { |
| 90 | next unless m#^$ref->{regex}$#; |
| 91 | my $p = $1; |
| 92 | my $pathname = desanitize_refname($path->full_path($p)); |
| 93 | my $refname = desanitize_refname($ref->full_path($p)); |
| 94 | if (my $existing = $fetch->{$pathname}) { |
| 95 | if ($existing ne $refname) { |
| 96 | die "Refspec conflict:\n", |
| 97 | "existing: $existing\n", |
| 98 | " globbed: $refname\n"; |
| 99 | } |
Eric Wong | 2af7da9 | 2016-07-02 10:33:18 +0000 | [diff] [blame] | 100 | my $u = (::cmt_metadata("$refname"))[0]; |
| 101 | if (!defined($u)) { |
| 102 | warn |
| 103 | "W: $refname: no associated commit metadata from SVN, skipping\n"; |
| 104 | next; |
| 105 | } |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 106 | $u =~ s!^\Q$url\E(/|$)!! or die |
| 107 | "$refname: '$url' not found in '$u'\n"; |
| 108 | if ($pathname ne $u) { |
| 109 | warn "W: Refspec glob conflict ", |
| 110 | "(ref: $refname):\n", |
| 111 | "expected path: $pathname\n", |
| 112 | " real path: $u\n", |
| 113 | "Continuing ahead with $u\n"; |
| 114 | next; |
| 115 | } |
| 116 | } else { |
| 117 | $fetch->{$pathname} = $refname; |
| 118 | } |
| 119 | } |
| 120 | } |
| 121 | |
| 122 | sub parse_revision_argument { |
| 123 | my ($base, $head) = @_; |
| 124 | if (!defined $::_revision || $::_revision eq 'BASE:HEAD') { |
| 125 | return ($base, $head); |
| 126 | } |
| 127 | return ($1, $2) if ($::_revision =~ /^(\d+):(\d+)$/); |
| 128 | return ($::_revision, $::_revision) if ($::_revision =~ /^\d+$/); |
| 129 | return ($head, $head) if ($::_revision eq 'HEAD'); |
| 130 | return ($base, $1) if ($::_revision =~ /^BASE:(\d+)$/); |
| 131 | return ($1, $head) if ($::_revision =~ /^(\d+):HEAD$/); |
| 132 | die "revision argument: $::_revision not understood by git-svn\n"; |
| 133 | } |
| 134 | |
| 135 | sub fetch_all { |
| 136 | my ($repo_id, $remotes) = @_; |
| 137 | if (ref $repo_id) { |
| 138 | my $gs = $repo_id; |
| 139 | $repo_id = undef; |
| 140 | $repo_id = $gs->{repo_id}; |
| 141 | } |
| 142 | $remotes ||= read_all_remotes(); |
| 143 | my $remote = $remotes->{$repo_id} or |
| 144 | die "[svn-remote \"$repo_id\"] unknown\n"; |
| 145 | my $fetch = $remote->{fetch}; |
| 146 | my $url = $remote->{url} or die "svn-remote.$repo_id.url not defined\n"; |
| 147 | my (@gs, @globs); |
| 148 | my $ra = Git::SVN::Ra->new($url); |
| 149 | my $uuid = $ra->get_uuid; |
| 150 | my $head = $ra->get_latest_revnum; |
| 151 | |
| 152 | # ignore errors, $head revision may not even exist anymore |
| 153 | eval { $ra->get_log("", $head, 0, 1, 0, 1, sub { $head = $_[1] }) }; |
| 154 | warn "W: $@\n" if $@; |
| 155 | |
| 156 | my $base = defined $fetch ? $head : 0; |
| 157 | |
| 158 | # read the max revs for wildcard expansion (branches/*, tags/*) |
| 159 | foreach my $t (qw/branches tags/) { |
| 160 | defined $remote->{$t} or next; |
| 161 | push @globs, @{$remote->{$t}}; |
| 162 | |
| 163 | my $max_rev = eval { tmp_config(qw/--int --get/, |
| 164 | "svn-remote.$repo_id.${t}-maxRev") }; |
| 165 | if (defined $max_rev && ($max_rev < $base)) { |
| 166 | $base = $max_rev; |
| 167 | } elsif (!defined $max_rev) { |
| 168 | $base = 0; |
| 169 | } |
| 170 | } |
| 171 | |
| 172 | if ($fetch) { |
| 173 | foreach my $p (sort keys %$fetch) { |
| 174 | my $gs = Git::SVN->new($fetch->{$p}, $repo_id, $p); |
| 175 | my $lr = $gs->rev_map_max; |
| 176 | if (defined $lr) { |
| 177 | $base = $lr if ($lr < $base); |
| 178 | } |
| 179 | push @gs, $gs; |
| 180 | } |
| 181 | } |
| 182 | |
| 183 | ($base, $head) = parse_revision_argument($base, $head); |
| 184 | $ra->gs_fetch_loop_common($base, $head, \@gs, \@globs); |
| 185 | } |
| 186 | |
| 187 | sub read_all_remotes { |
| 188 | my $r = {}; |
| 189 | my $use_svm_props = eval { command_oneline(qw/config --bool |
| 190 | svn.useSvmProps/) }; |
| 191 | $use_svm_props = $use_svm_props eq 'true' if $use_svm_props; |
| 192 | my $svn_refspec = qr{\s*(.*?)\s*:\s*(.+?)\s*}; |
| 193 | foreach (grep { s/^svn-remote\.// } command(qw/config -l/)) { |
| 194 | if (m!^(.+)\.fetch=$svn_refspec$!) { |
| 195 | my ($remote, $local_ref, $remote_ref) = ($1, $2, $3); |
| 196 | die("svn-remote.$remote: remote ref '$remote_ref' " |
| 197 | . "must start with 'refs/'\n") |
| 198 | unless $remote_ref =~ m{^refs/}; |
| 199 | $local_ref = uri_decode($local_ref); |
| 200 | $r->{$remote}->{fetch}->{$local_ref} = $remote_ref; |
| 201 | $r->{$remote}->{svm} = {} if $use_svm_props; |
| 202 | } elsif (m!^(.+)\.usesvmprops=\s*(.*)\s*$!) { |
| 203 | $r->{$1}->{svm} = {}; |
| 204 | } elsif (m!^(.+)\.url=\s*(.*)\s*$!) { |
Michael G. Schwern | 93c3fcb | 2012-07-28 02:47:47 -0700 | [diff] [blame] | 205 | $r->{$1}->{url} = canonicalize_url($2); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 206 | } elsif (m!^(.+)\.pushurl=\s*(.*)\s*$!) { |
Michael G. Schwern | 93c3fcb | 2012-07-28 02:47:47 -0700 | [diff] [blame] | 207 | $r->{$1}->{pushurl} = canonicalize_url($2); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 208 | } elsif (m!^(.+)\.ignore-refs=\s*(.*)\s*$!) { |
| 209 | $r->{$1}->{ignore_refs_regex} = $2; |
| 210 | } elsif (m!^(.+)\.(branches|tags)=$svn_refspec$!) { |
| 211 | my ($remote, $t, $local_ref, $remote_ref) = |
| 212 | ($1, $2, $3, $4); |
| 213 | die("svn-remote.$remote: remote ref '$remote_ref' ($t) " |
| 214 | . "must start with 'refs/'\n") |
| 215 | unless $remote_ref =~ m{^refs/}; |
| 216 | $local_ref = uri_decode($local_ref); |
Michael G. Schwern | 3d9be15 | 2012-07-26 17:26:06 -0700 | [diff] [blame] | 217 | |
| 218 | require Git::SVN::GlobSpec; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 219 | my $rs = { |
| 220 | t => $t, |
| 221 | remote => $remote, |
| 222 | path => Git::SVN::GlobSpec->new($local_ref, 1), |
| 223 | ref => Git::SVN::GlobSpec->new($remote_ref, 0) }; |
| 224 | if (length($rs->{ref}->{right}) != 0) { |
| 225 | die "The '*' glob character must be the last ", |
| 226 | "character of '$remote_ref'\n"; |
| 227 | } |
| 228 | push @{ $r->{$remote}->{$t} }, $rs; |
| 229 | } |
| 230 | } |
| 231 | |
| 232 | map { |
| 233 | if (defined $r->{$_}->{svm}) { |
| 234 | my $svm; |
| 235 | eval { |
| 236 | my $section = "svn-remote.$_"; |
| 237 | $svm = { |
| 238 | source => tmp_config('--get', |
| 239 | "$section.svm-source"), |
| 240 | replace => tmp_config('--get', |
| 241 | "$section.svm-replace"), |
| 242 | } |
| 243 | }; |
| 244 | $r->{$_}->{svm} = $svm; |
| 245 | } |
| 246 | } keys %$r; |
| 247 | |
| 248 | foreach my $remote (keys %$r) { |
| 249 | foreach ( grep { defined $_ } |
| 250 | map { $r->{$remote}->{$_} } qw(branches tags) ) { |
| 251 | foreach my $rs ( @$_ ) { |
| 252 | $rs->{ignore_refs_regex} = |
| 253 | $r->{$remote}->{ignore_refs_regex}; |
| 254 | } |
| 255 | } |
| 256 | } |
| 257 | |
| 258 | $r; |
| 259 | } |
| 260 | |
| 261 | sub init_vars { |
| 262 | $_gc_nr = $_gc_period = 1000; |
| 263 | if (defined $_repack || defined $_repack_flags) { |
| 264 | warn "Repack options are obsolete; they have no effect.\n"; |
| 265 | } |
| 266 | } |
| 267 | |
| 268 | sub verify_remotes_sanity { |
| 269 | return unless -d $ENV{GIT_DIR}; |
| 270 | my %seen; |
| 271 | foreach (command(qw/config -l/)) { |
| 272 | if (m!^svn-remote\.(?:.+)\.fetch=.*:refs/remotes/(\S+)\s*$!) { |
| 273 | if ($seen{$1}) { |
| 274 | die "Remote ref refs/remote/$1 is tracked by", |
| 275 | "\n \"$_\"\nand\n \"$seen{$1}\"\n", |
| 276 | "Please resolve this ambiguity in ", |
| 277 | "your git configuration file before ", |
| 278 | "continuing\n"; |
| 279 | } |
| 280 | $seen{$1} = $_; |
| 281 | } |
| 282 | } |
| 283 | } |
| 284 | |
| 285 | sub find_existing_remote { |
| 286 | my ($url, $remotes) = @_; |
| 287 | return undef if $no_reuse_existing; |
| 288 | my $existing; |
| 289 | foreach my $repo_id (keys %$remotes) { |
| 290 | my $u = $remotes->{$repo_id}->{url} or next; |
| 291 | next if $u ne $url; |
| 292 | $existing = $repo_id; |
| 293 | last; |
| 294 | } |
| 295 | $existing; |
| 296 | } |
| 297 | |
| 298 | sub init_remote_config { |
| 299 | my ($self, $url, $no_write) = @_; |
Michael G. Schwern | 9c27a57 | 2012-07-28 02:47:48 -0700 | [diff] [blame] | 300 | $url = canonicalize_url($url); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 301 | my $r = read_all_remotes(); |
| 302 | my $existing = find_existing_remote($url, $r); |
| 303 | if ($existing) { |
| 304 | unless ($no_write) { |
| 305 | print STDERR "Using existing ", |
| 306 | "[svn-remote \"$existing\"]\n"; |
| 307 | } |
| 308 | $self->{repo_id} = $existing; |
| 309 | } elsif ($_minimize_url) { |
| 310 | my $min_url = Git::SVN::Ra->new($url)->minimize_url; |
| 311 | $existing = find_existing_remote($min_url, $r); |
| 312 | if ($existing) { |
| 313 | unless ($no_write) { |
| 314 | print STDERR "Using existing ", |
| 315 | "[svn-remote \"$existing\"]\n"; |
| 316 | } |
| 317 | $self->{repo_id} = $existing; |
| 318 | } |
| 319 | if ($min_url ne $url) { |
| 320 | unless ($no_write) { |
| 321 | print STDERR "Using higher level of URL: ", |
| 322 | "$url => $min_url\n"; |
| 323 | } |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 324 | my $old_path = $self->path; |
| 325 | $url =~ s!^\Q$min_url\E(/|$)!!; |
Michael G. Schwern | ca475a6 | 2012-07-28 02:38:29 -0700 | [diff] [blame] | 326 | $url = join_paths($url, $old_path); |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 327 | $self->path($url); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 328 | $url = $min_url; |
| 329 | } |
| 330 | } |
| 331 | my $orig_url; |
| 332 | if (!$existing) { |
| 333 | # verify that we aren't overwriting anything: |
| 334 | $orig_url = eval { |
| 335 | command_oneline('config', '--get', |
| 336 | "svn-remote.$self->{repo_id}.url") |
| 337 | }; |
| 338 | if ($orig_url && ($orig_url ne $url)) { |
| 339 | die "svn-remote.$self->{repo_id}.url already set: ", |
| 340 | "$orig_url\nwanted to set to: $url\n"; |
| 341 | } |
| 342 | } |
| 343 | my ($xrepo_id, $xpath) = find_ref($self->refname); |
| 344 | if (!$no_write && defined $xpath) { |
| 345 | die "svn-remote.$xrepo_id.fetch already set to track ", |
| 346 | "$xpath:", $self->refname, "\n"; |
| 347 | } |
| 348 | unless ($no_write) { |
| 349 | command_noisy('config', |
| 350 | "svn-remote.$self->{repo_id}.url", $url); |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 351 | my $path = $self->path; |
| 352 | $path =~ s{^/}{}; |
| 353 | $path =~ s{%([0-9A-F]{2})}{chr hex($1)}ieg; |
| 354 | $self->path($path); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 355 | command_noisy('config', '--add', |
| 356 | "svn-remote.$self->{repo_id}.fetch", |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 357 | $self->path.":".$self->refname); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 358 | } |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 359 | $self->url($url); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 360 | } |
| 361 | |
| 362 | sub find_by_url { # repos_root and, path are optional |
| 363 | my ($class, $full_url, $repos_root, $path) = @_; |
| 364 | |
Michael G. Schwern | 705b49c | 2012-07-28 02:47:51 -0700 | [diff] [blame] | 365 | $full_url = canonicalize_url($full_url); |
| 366 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 367 | return undef unless defined $full_url; |
| 368 | remove_username($full_url); |
| 369 | remove_username($repos_root) if defined $repos_root; |
| 370 | my $remotes = read_all_remotes(); |
| 371 | if (defined $full_url && defined $repos_root && !defined $path) { |
| 372 | $path = $full_url; |
| 373 | $path =~ s#^\Q$repos_root\E(?:/|$)##; |
| 374 | } |
| 375 | foreach my $repo_id (keys %$remotes) { |
| 376 | my $u = $remotes->{$repo_id}->{url} or next; |
| 377 | remove_username($u); |
| 378 | next if defined $repos_root && $repos_root ne $u; |
| 379 | |
| 380 | my $fetch = $remotes->{$repo_id}->{fetch} || {}; |
| 381 | foreach my $t (qw/branches tags/) { |
| 382 | foreach my $globspec (@{$remotes->{$repo_id}->{$t}}) { |
| 383 | resolve_local_globs($u, $fetch, $globspec); |
| 384 | } |
| 385 | } |
| 386 | my $p = $path; |
| 387 | my $rwr = rewrite_root({repo_id => $repo_id}); |
| 388 | my $svm = $remotes->{$repo_id}->{svm} |
| 389 | if defined $remotes->{$repo_id}->{svm}; |
| 390 | unless (defined $p) { |
| 391 | $p = $full_url; |
| 392 | my $z = $u; |
| 393 | my $prefix = ''; |
| 394 | if ($rwr) { |
| 395 | $z = $rwr; |
| 396 | remove_username($z); |
| 397 | } elsif (defined $svm) { |
| 398 | $z = $svm->{source}; |
| 399 | $prefix = $svm->{replace}; |
| 400 | $prefix =~ s#^\Q$u\E(?:/|$)##; |
| 401 | $prefix =~ s#/$##; |
| 402 | } |
| 403 | $p =~ s#^\Q$z\E(?:/|$)#$prefix# or next; |
| 404 | } |
Michael G. Schwern | 705b49c | 2012-07-28 02:47:51 -0700 | [diff] [blame] | 405 | |
| 406 | # remote fetch paths are not URI escaped. Decode ours |
| 407 | # so they match |
| 408 | $p = uri_decode($p); |
| 409 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 410 | foreach my $f (keys %$fetch) { |
| 411 | next if $f ne $p; |
| 412 | return Git::SVN->new($fetch->{$f}, $repo_id, $f); |
| 413 | } |
| 414 | } |
| 415 | undef; |
| 416 | } |
| 417 | |
| 418 | sub init { |
| 419 | my ($class, $url, $path, $repo_id, $ref_id, $no_write) = @_; |
| 420 | my $self = _new($class, $repo_id, $ref_id, $path); |
| 421 | if (defined $url) { |
| 422 | $self->init_remote_config($url, $no_write); |
| 423 | } |
| 424 | $self; |
| 425 | } |
| 426 | |
| 427 | sub find_ref { |
| 428 | my ($ref_id) = @_; |
| 429 | foreach (command(qw/config -l/)) { |
| 430 | next unless m!^svn-remote\.(.+)\.fetch= |
| 431 | \s*(.*?)\s*:\s*(.+?)\s*$!x; |
| 432 | my ($repo_id, $path, $ref) = ($1, $2, $3); |
| 433 | if ($ref eq $ref_id) { |
| 434 | $path = '' if ($path =~ m#^\./?#); |
| 435 | return ($repo_id, $path); |
| 436 | } |
| 437 | } |
| 438 | (undef, undef, undef); |
| 439 | } |
| 440 | |
| 441 | sub new { |
| 442 | my ($class, $ref_id, $repo_id, $path) = @_; |
| 443 | if (defined $ref_id && !defined $repo_id && !defined $path) { |
| 444 | ($repo_id, $path) = find_ref($ref_id); |
| 445 | if (!defined $repo_id) { |
| 446 | die "Could not find a \"svn-remote.*.fetch\" key ", |
| 447 | "in the repository configuration matching: ", |
| 448 | "$ref_id\n"; |
| 449 | } |
| 450 | } |
| 451 | my $self = _new($class, $repo_id, $ref_id, $path); |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 452 | if (!defined $self->path || !length $self->path) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 453 | my $fetch = command_oneline('config', '--get', |
| 454 | "svn-remote.$repo_id.fetch", |
| 455 | ":$ref_id\$") or |
| 456 | die "Failed to read \"svn-remote.$repo_id.fetch\" ", |
| 457 | "\":$ref_id\$\" in config\n"; |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 458 | my($path) = split(/\s*:\s*/, $fetch); |
| 459 | $self->path($path); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 460 | } |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 461 | { |
| 462 | my $path = $self->path; |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 463 | $path =~ s{\A/}{}; |
| 464 | $path =~ s{/\z}{}; |
| 465 | $self->path($path); |
| 466 | } |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 467 | my $url = command_oneline('config', '--get', |
| 468 | "svn-remote.$repo_id.url") or |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 469 | die "Failed to read \"svn-remote.$repo_id.url\" in config\n"; |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 470 | $self->url($url); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 471 | $self->{pushurl} = eval { command_oneline('config', '--get', |
| 472 | "svn-remote.$repo_id.pushurl") }; |
| 473 | $self->rebuild; |
| 474 | $self; |
| 475 | } |
| 476 | |
| 477 | sub refname { |
| 478 | my ($refname) = $_[0]->{ref_id} ; |
| 479 | |
| 480 | # It cannot end with a slash /, we'll throw up on this because |
| 481 | # SVN can't have directories with a slash in their name, either: |
| 482 | if ($refname =~ m{/$}) { |
Justin Lebar | 235e8d5 | 2014-03-31 15:11:47 -0700 | [diff] [blame] | 483 | die "ref: '$refname' ends with a trailing slash; this is ", |
| 484 | "not permitted by git or Subversion\n"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 485 | } |
| 486 | |
| 487 | # It cannot have ASCII control character space, tilde ~, caret ^, |
| 488 | # colon :, question-mark ?, asterisk *, space, or open bracket [ |
| 489 | # anywhere. |
| 490 | # |
| 491 | # Additionally, % must be escaped because it is used for escaping |
| 492 | # and we want our escaped refname to be reversible |
Eric Wong | 22af6fe | 2016-12-23 01:14:01 +0000 | [diff] [blame] | 493 | $refname =~ s{([ \%~\^:\?\*\[\t\\])}{sprintf('%%%02X',ord($1))}eg; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 494 | |
| 495 | # no slash-separated component can begin with a dot . |
| 496 | # /.* becomes /%2E* |
| 497 | $refname =~ s{/\.}{/%2E}g; |
| 498 | |
| 499 | # It cannot have two consecutive dots .. anywhere |
| 500 | # .. becomes %2E%2E |
| 501 | $refname =~ s{\.\.}{%2E%2E}g; |
| 502 | |
| 503 | # trailing dots and .lock are not allowed |
| 504 | # .$ becomes %2E and .lock becomes %2Elock |
| 505 | $refname =~ s{\.(?=$|lock$)}{%2E}; |
| 506 | |
| 507 | # the sequence @{ is used to access the reflog |
| 508 | # @{ becomes %40{ |
| 509 | $refname =~ s{\@\{}{%40\{}g; |
| 510 | |
| 511 | return $refname; |
| 512 | } |
| 513 | |
| 514 | sub desanitize_refname { |
| 515 | my ($refname) = @_; |
| 516 | $refname =~ s{%(?:([0-9A-F]{2}))}{chr hex($1)}eg; |
| 517 | return $refname; |
| 518 | } |
| 519 | |
| 520 | sub svm_uuid { |
| 521 | my ($self) = @_; |
| 522 | return $self->{svm}->{uuid} if $self->svm; |
| 523 | $self->ra; |
| 524 | unless ($self->{svm}) { |
| 525 | die "SVM UUID not cached, and reading remotely failed\n"; |
| 526 | } |
| 527 | $self->{svm}->{uuid}; |
| 528 | } |
| 529 | |
| 530 | sub svm { |
| 531 | my ($self) = @_; |
| 532 | return $self->{svm} if $self->{svm}; |
| 533 | my $svm; |
| 534 | # see if we have it in our config, first: |
| 535 | eval { |
| 536 | my $section = "svn-remote.$self->{repo_id}"; |
| 537 | $svm = { |
| 538 | source => tmp_config('--get', "$section.svm-source"), |
| 539 | uuid => tmp_config('--get', "$section.svm-uuid"), |
| 540 | replace => tmp_config('--get', "$section.svm-replace"), |
| 541 | } |
| 542 | }; |
| 543 | if ($svm && $svm->{source} && $svm->{uuid} && $svm->{replace}) { |
| 544 | $self->{svm} = $svm; |
| 545 | } |
| 546 | $self->{svm}; |
| 547 | } |
| 548 | |
| 549 | sub _set_svm_vars { |
| 550 | my ($self, $ra) = @_; |
| 551 | return $ra if $self->svm; |
| 552 | |
| 553 | my @err = ( "useSvmProps set, but failed to read SVM properties\n", |
| 554 | "(svm:source, svm:uuid) ", |
| 555 | "from the following URLs:\n" ); |
| 556 | sub read_svm_props { |
| 557 | my ($self, $ra, $path, $r) = @_; |
| 558 | my $props = ($ra->get_dir($path, $r))[2]; |
| 559 | my $src = $props->{'svm:source'}; |
| 560 | my $uuid = $props->{'svm:uuid'}; |
| 561 | return undef if (!$src || !$uuid); |
| 562 | |
| 563 | chomp($src, $uuid); |
| 564 | |
| 565 | $uuid =~ m{^[0-9a-f\-]{30,}$}i |
| 566 | or die "doesn't look right - svm:uuid is '$uuid'\n"; |
| 567 | |
| 568 | # the '!' is used to mark the repos_root!/relative/path |
| 569 | $src =~ s{/?!/?}{/}; |
| 570 | $src =~ s{/+$}{}; # no trailing slashes please |
| 571 | # username is of no interest |
| 572 | $src =~ s{(^[a-z\+]*://)[^/@]*@}{$1}; |
| 573 | |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 574 | my $replace = add_path_to_url($ra->url, $path); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 575 | |
| 576 | my $section = "svn-remote.$self->{repo_id}"; |
| 577 | tmp_config("$section.svm-source", $src); |
| 578 | tmp_config("$section.svm-replace", $replace); |
| 579 | tmp_config("$section.svm-uuid", $uuid); |
| 580 | $self->{svm} = { |
| 581 | source => $src, |
| 582 | uuid => $uuid, |
| 583 | replace => $replace |
| 584 | }; |
| 585 | } |
| 586 | |
| 587 | my $r = $ra->get_latest_revnum; |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 588 | my $path = $self->path; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 589 | my %tried; |
| 590 | while (length $path) { |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 591 | my $try = add_path_to_url($self->url, $path); |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 592 | unless ($tried{$try}) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 593 | return $ra if $self->read_svm_props($ra, $path, $r); |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 594 | $tried{$try} = 1; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 595 | } |
| 596 | $path =~ s#/?[^/]+$##; |
| 597 | } |
| 598 | die "Path: '$path' should be ''\n" if $path ne ''; |
| 599 | return $ra if $self->read_svm_props($ra, $path, $r); |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 600 | $tried{ add_path_to_url($self->url, $path) } = 1; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 601 | |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 602 | if ($ra->{repos_root} eq $self->url) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 603 | die @err, (map { " $_\n" } keys %tried), "\n"; |
| 604 | } |
| 605 | |
| 606 | # nope, make sure we're connected to the repository root: |
| 607 | my $ok; |
| 608 | my @tried_b; |
| 609 | $path = $ra->{svn_path}; |
| 610 | $ra = Git::SVN::Ra->new($ra->{repos_root}); |
| 611 | while (length $path) { |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 612 | my $try = add_path_to_url($ra->url, $path); |
Michael G. Schwern | b1ea6c3 | 2012-07-27 13:00:52 -0700 | [diff] [blame] | 613 | unless ($tried{$try}) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 614 | $ok = $self->read_svm_props($ra, $path, $r); |
| 615 | last if $ok; |
Michael G. Schwern | b1ea6c3 | 2012-07-27 13:00:52 -0700 | [diff] [blame] | 616 | $tried{$try} = 1; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 617 | } |
| 618 | $path =~ s#/?[^/]+$##; |
| 619 | } |
| 620 | die "Path: '$path' should be ''\n" if $path ne ''; |
| 621 | $ok ||= $self->read_svm_props($ra, $path, $r); |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 622 | $tried{ add_path_to_url($ra->url, $path) } = 1; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 623 | if (!$ok) { |
| 624 | die @err, (map { " $_\n" } keys %tried), "\n"; |
| 625 | } |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 626 | Git::SVN::Ra->new($self->url); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 627 | } |
| 628 | |
| 629 | sub svnsync { |
| 630 | my ($self) = @_; |
| 631 | return $self->{svnsync} if $self->{svnsync}; |
| 632 | |
| 633 | if ($self->no_metadata) { |
| 634 | die "Can't have both 'noMetadata' and ", |
| 635 | "'useSvnsyncProps' options set!\n"; |
| 636 | } |
| 637 | if ($self->rewrite_root) { |
| 638 | die "Can't have both 'useSvnsyncProps' and 'rewriteRoot' ", |
| 639 | "options set!\n"; |
| 640 | } |
| 641 | if ($self->rewrite_uuid) { |
| 642 | die "Can't have both 'useSvnsyncProps' and 'rewriteUUID' ", |
| 643 | "options set!\n"; |
| 644 | } |
| 645 | |
| 646 | my $svnsync; |
| 647 | # see if we have it in our config, first: |
| 648 | eval { |
| 649 | my $section = "svn-remote.$self->{repo_id}"; |
| 650 | |
| 651 | my $url = tmp_config('--get', "$section.svnsync-url"); |
| 652 | ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or |
| 653 | die "doesn't look right - svn:sync-from-url is '$url'\n"; |
| 654 | |
| 655 | my $uuid = tmp_config('--get', "$section.svnsync-uuid"); |
| 656 | ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or |
| 657 | die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; |
| 658 | |
| 659 | $svnsync = { url => $url, uuid => $uuid } |
| 660 | }; |
| 661 | if ($svnsync && $svnsync->{url} && $svnsync->{uuid}) { |
| 662 | return $self->{svnsync} = $svnsync; |
| 663 | } |
| 664 | |
| 665 | my $err = "useSvnsyncProps set, but failed to read " . |
| 666 | "svnsync property: svn:sync-from-"; |
| 667 | my $rp = $self->ra->rev_proplist(0); |
| 668 | |
| 669 | my $url = $rp->{'svn:sync-from-url'} or die $err . "url\n"; |
| 670 | ($url) = ($url =~ m{^([a-z\+]+://\S+)$}) or |
| 671 | die "doesn't look right - svn:sync-from-url is '$url'\n"; |
| 672 | |
| 673 | my $uuid = $rp->{'svn:sync-from-uuid'} or die $err . "uuid\n"; |
| 674 | ($uuid) = ($uuid =~ m{^([0-9a-f\-]{30,})$}i) or |
| 675 | die "doesn't look right - svn:sync-from-uuid is '$uuid'\n"; |
| 676 | |
| 677 | my $section = "svn-remote.$self->{repo_id}"; |
| 678 | tmp_config('--add', "$section.svnsync-uuid", $uuid); |
| 679 | tmp_config('--add', "$section.svnsync-url", $url); |
| 680 | return $self->{svnsync} = { url => $url, uuid => $uuid }; |
| 681 | } |
| 682 | |
| 683 | # this allows us to memoize our SVN::Ra UUID locally and avoid a |
| 684 | # remote lookup (useful for 'git svn log'). |
| 685 | sub ra_uuid { |
| 686 | my ($self) = @_; |
| 687 | unless ($self->{ra_uuid}) { |
| 688 | my $key = "svn-remote.$self->{repo_id}.uuid"; |
| 689 | my $uuid = eval { tmp_config('--get', $key) }; |
| 690 | if (!$@ && $uuid && $uuid =~ /^([a-f\d\-]{30,})$/i) { |
| 691 | $self->{ra_uuid} = $uuid; |
| 692 | } else { |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 693 | die "ra_uuid called without URL\n" unless $self->url; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 694 | $self->{ra_uuid} = $self->ra->get_uuid; |
| 695 | tmp_config('--add', $key, $self->{ra_uuid}); |
| 696 | } |
| 697 | } |
| 698 | $self->{ra_uuid}; |
| 699 | } |
| 700 | |
| 701 | sub _set_repos_root { |
| 702 | my ($self, $repos_root) = @_; |
| 703 | my $k = "svn-remote.$self->{repo_id}.reposRoot"; |
| 704 | $repos_root ||= $self->ra->{repos_root}; |
| 705 | tmp_config($k, $repos_root); |
| 706 | $repos_root; |
| 707 | } |
| 708 | |
| 709 | sub repos_root { |
| 710 | my ($self) = @_; |
| 711 | my $k = "svn-remote.$self->{repo_id}.reposRoot"; |
| 712 | eval { tmp_config('--get', $k) } || $self->_set_repos_root; |
| 713 | } |
| 714 | |
| 715 | sub ra { |
| 716 | my ($self) = shift; |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 717 | my $ra = Git::SVN::Ra->new($self->url); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 718 | $self->_set_repos_root($ra->{repos_root}); |
| 719 | if ($self->use_svm_props && !$self->{svm}) { |
| 720 | if ($self->no_metadata) { |
| 721 | die "Can't have both 'noMetadata' and ", |
| 722 | "'useSvmProps' options set!\n"; |
| 723 | } elsif ($self->use_svnsync_props) { |
| 724 | die "Can't have both 'useSvnsyncProps' and ", |
| 725 | "'useSvmProps' options set!\n"; |
| 726 | } |
| 727 | $ra = $self->_set_svm_vars($ra); |
| 728 | $self->{-want_revprops} = 1; |
| 729 | } |
| 730 | $ra; |
| 731 | } |
| 732 | |
| 733 | # prop_walk(PATH, REV, SUB) |
| 734 | # ------------------------- |
| 735 | # Recursively traverse PATH at revision REV and invoke SUB for each |
| 736 | # directory that contains a SVN property. SUB will be invoked as |
| 737 | # follows: &SUB(gs, path, props); where `gs' is this instance of |
| 738 | # Git::SVN, `path' the path to the directory where the properties |
| 739 | # `props' were found. The `path' will be relative to point of checkout, |
| 740 | # that is, if url://repo/trunk is the current Git branch, and that |
| 741 | # directory contains a sub-directory `d', SUB will be invoked with `/d/' |
| 742 | # as `path' (note the trailing `/'). |
| 743 | sub prop_walk { |
| 744 | my ($self, $path, $rev, $sub) = @_; |
| 745 | |
| 746 | $path =~ s#^/##; |
| 747 | my ($dirent, undef, $props) = $self->ra->get_dir($path, $rev); |
| 748 | $path =~ s#^/*#/#g; |
| 749 | my $p = $path; |
| 750 | # Strip the irrelevant part of the path. |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 751 | $p =~ s#^/+\Q@{[$self->path]}\E(/|$)#/#; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 752 | # Ensure the path is terminated by a `/'. |
| 753 | $p =~ s#/*$#/#; |
| 754 | |
| 755 | # The properties contain all the internal SVN stuff nobody |
| 756 | # (usually) cares about. |
| 757 | my $interesting_props = 0; |
| 758 | foreach (keys %{$props}) { |
| 759 | # If it doesn't start with `svn:', it must be a |
| 760 | # user-defined property. |
| 761 | ++$interesting_props and next if $_ !~ /^svn:/; |
| 762 | # FIXME: Fragile, if SVN adds new public properties, |
| 763 | # this needs to be updated. |
| 764 | ++$interesting_props if /^svn:(?:ignore|keywords|executable |
| 765 | |eol-style|mime-type |
| 766 | |externals|needs-lock)$/x; |
| 767 | } |
| 768 | &$sub($self, $p, $props) if $interesting_props; |
| 769 | |
| 770 | foreach (sort keys %$dirent) { |
| 771 | next if $dirent->{$_}->{kind} != $SVN::Node::dir; |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 772 | $self->prop_walk($self->path . $p . $_, $rev, $sub); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 773 | } |
| 774 | } |
| 775 | |
| 776 | sub last_rev { ($_[0]->last_rev_commit)[0] } |
| 777 | sub last_commit { ($_[0]->last_rev_commit)[1] } |
| 778 | |
| 779 | # returns the newest SVN revision number and newest commit SHA1 |
| 780 | sub last_rev_commit { |
| 781 | my ($self) = @_; |
| 782 | if (defined $self->{last_rev} && defined $self->{last_commit}) { |
| 783 | return ($self->{last_rev}, $self->{last_commit}); |
| 784 | } |
| 785 | my $c = ::verify_ref($self->refname.'^0'); |
| 786 | if ($c && !$self->use_svm_props && !$self->no_metadata) { |
| 787 | my $rev = (::cmt_metadata($c))[1]; |
| 788 | if (defined $rev) { |
| 789 | ($self->{last_rev}, $self->{last_commit}) = ($rev, $c); |
| 790 | return ($rev, $c); |
| 791 | } |
| 792 | } |
| 793 | my $map_path = $self->map_path; |
| 794 | unless (-e $map_path) { |
| 795 | ($self->{last_rev}, $self->{last_commit}) = (undef, undef); |
| 796 | return (undef, undef); |
| 797 | } |
| 798 | my ($rev, $commit) = $self->rev_map_max(1); |
| 799 | ($self->{last_rev}, $self->{last_commit}) = ($rev, $commit); |
| 800 | return ($rev, $commit); |
| 801 | } |
| 802 | |
| 803 | sub get_fetch_range { |
| 804 | my ($self, $min, $max) = @_; |
| 805 | $max ||= $self->ra->get_latest_revnum; |
| 806 | $min ||= $self->rev_map_max; |
| 807 | (++$min, $max); |
| 808 | } |
| 809 | |
Eric Wong | 112423e | 2016-10-14 00:27:54 +0000 | [diff] [blame] | 810 | sub svn_dir { |
| 811 | command_oneline(qw(rev-parse --git-path svn)); |
| 812 | } |
| 813 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 814 | sub tmp_config { |
| 815 | my (@args) = @_; |
Eric Wong | 112423e | 2016-10-14 00:27:54 +0000 | [diff] [blame] | 816 | my $svn_dir = svn_dir(); |
| 817 | my $old_def_config = "$svn_dir/config"; |
| 818 | my $config = "$svn_dir/.metadata"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 819 | if (! -f $config && -f $old_def_config) { |
| 820 | rename $old_def_config, $config or |
| 821 | die "Failed rename $old_def_config => $config: $!\n"; |
| 822 | } |
| 823 | my $old_config = $ENV{GIT_CONFIG}; |
| 824 | $ENV{GIT_CONFIG} = $config; |
| 825 | $@ = undef; |
| 826 | my @ret = eval { |
| 827 | unless (-f $config) { |
| 828 | mkfile($config); |
| 829 | open my $fh, '>', $config or |
| 830 | die "Can't open $config: $!\n"; |
| 831 | print $fh "; This file is used internally by ", |
| 832 | "git-svn\n" or die |
| 833 | "Couldn't write to $config: $!\n"; |
| 834 | print $fh "; You should not have to edit it\n" or |
| 835 | die "Couldn't write to $config: $!\n"; |
| 836 | close $fh or die "Couldn't close $config: $!\n"; |
| 837 | } |
| 838 | command('config', @args); |
| 839 | }; |
| 840 | my $err = $@; |
| 841 | if (defined $old_config) { |
| 842 | $ENV{GIT_CONFIG} = $old_config; |
| 843 | } else { |
| 844 | delete $ENV{GIT_CONFIG}; |
| 845 | } |
| 846 | die $err if $err; |
| 847 | wantarray ? @ret : $ret[0]; |
| 848 | } |
| 849 | |
| 850 | sub tmp_index_do { |
| 851 | my ($self, $sub) = @_; |
| 852 | my $old_index = $ENV{GIT_INDEX_FILE}; |
| 853 | $ENV{GIT_INDEX_FILE} = $self->{index}; |
| 854 | $@ = undef; |
| 855 | my @ret = eval { |
| 856 | my ($dir, $base) = ($self->{index} =~ m#^(.*?)/?([^/]+)$#); |
| 857 | mkpath([$dir]) unless -d $dir; |
| 858 | &$sub; |
| 859 | }; |
| 860 | my $err = $@; |
| 861 | if (defined $old_index) { |
| 862 | $ENV{GIT_INDEX_FILE} = $old_index; |
| 863 | } else { |
| 864 | delete $ENV{GIT_INDEX_FILE}; |
| 865 | } |
| 866 | die $err if $err; |
| 867 | wantarray ? @ret : $ret[0]; |
| 868 | } |
| 869 | |
| 870 | sub assert_index_clean { |
| 871 | my ($self, $treeish) = @_; |
| 872 | |
| 873 | $self->tmp_index_do(sub { |
| 874 | command_noisy('read-tree', $treeish) unless -e $self->{index}; |
| 875 | my $x = command_oneline('write-tree'); |
| 876 | my ($y) = (command(qw/cat-file commit/, $treeish) =~ |
brian m. carlson | 9ab3315 | 2020-06-22 18:04:12 +0000 | [diff] [blame] | 877 | /^tree ($::oid)/mo); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 878 | return if $y eq $x; |
| 879 | |
| 880 | warn "Index mismatch: $y != $x\nrereading $treeish\n"; |
| 881 | unlink $self->{index} or die "unlink $self->{index}: $!\n"; |
| 882 | command_noisy('read-tree', $treeish); |
| 883 | $x = command_oneline('write-tree'); |
| 884 | if ($y ne $x) { |
| 885 | fatal "trees ($treeish) $y != $x\n", |
| 886 | "Something is seriously wrong..."; |
| 887 | } |
| 888 | }); |
| 889 | } |
| 890 | |
| 891 | sub get_commit_parents { |
| 892 | my ($self, $log_entry) = @_; |
| 893 | my (%seen, @ret, @tmp); |
| 894 | # legacy support for 'set-tree'; this is only used by set_tree_cb: |
| 895 | if (my $ip = $self->{inject_parents}) { |
| 896 | if (my $commit = delete $ip->{$log_entry->{revision}}) { |
| 897 | push @tmp, $commit; |
| 898 | } |
| 899 | } |
| 900 | if (my $cur = ::verify_ref($self->refname.'^0')) { |
| 901 | push @tmp, $cur; |
| 902 | } |
| 903 | if (my $ipd = $self->{inject_parents_dcommit}) { |
| 904 | if (my $commit = delete $ipd->{$log_entry->{revision}}) { |
| 905 | push @tmp, @$commit; |
| 906 | } |
| 907 | } |
| 908 | push @tmp, $_ foreach (@{$log_entry->{parents}}, @tmp); |
| 909 | while (my $p = shift @tmp) { |
| 910 | next if $seen{$p}; |
| 911 | $seen{$p} = 1; |
| 912 | push @ret, $p; |
| 913 | } |
| 914 | @ret; |
| 915 | } |
| 916 | |
| 917 | sub rewrite_root { |
| 918 | my ($self) = @_; |
| 919 | return $self->{-rewrite_root} if exists $self->{-rewrite_root}; |
| 920 | my $k = "svn-remote.$self->{repo_id}.rewriteRoot"; |
| 921 | my $rwr = eval { command_oneline(qw/config --get/, $k) }; |
| 922 | if ($rwr) { |
| 923 | $rwr =~ s#/+$##; |
| 924 | if ($rwr !~ m#^[a-z\+]+://#) { |
| 925 | die "$rwr is not a valid URL (key: $k)\n"; |
| 926 | } |
| 927 | } |
| 928 | $self->{-rewrite_root} = $rwr; |
| 929 | } |
| 930 | |
| 931 | sub rewrite_uuid { |
| 932 | my ($self) = @_; |
| 933 | return $self->{-rewrite_uuid} if exists $self->{-rewrite_uuid}; |
| 934 | my $k = "svn-remote.$self->{repo_id}.rewriteUUID"; |
| 935 | my $rwid = eval { command_oneline(qw/config --get/, $k) }; |
| 936 | if ($rwid) { |
| 937 | $rwid =~ s#/+$##; |
| 938 | if ($rwid !~ m#^[a-f0-9]{8}-(?:[a-f0-9]{4}-){3}[a-f0-9]{12}$#) { |
| 939 | die "$rwid is not a valid UUID (key: $k)\n"; |
| 940 | } |
| 941 | } |
| 942 | $self->{-rewrite_uuid} = $rwid; |
| 943 | } |
| 944 | |
| 945 | sub metadata_url { |
| 946 | my ($self) = @_; |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 947 | my $url = $self->rewrite_root || $self->url; |
Michael G. Schwern | 705b49c | 2012-07-28 02:47:51 -0700 | [diff] [blame] | 948 | return canonicalize_url( add_path_to_url( $url, $self->path ) ); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 949 | } |
| 950 | |
| 951 | sub full_url { |
| 952 | my ($self) = @_; |
Michael G. Schwern | 705b49c | 2012-07-28 02:47:51 -0700 | [diff] [blame] | 953 | return canonicalize_url( add_path_to_url( $self->url, $self->path ) ); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 954 | } |
| 955 | |
| 956 | sub full_pushurl { |
| 957 | my ($self) = @_; |
| 958 | if ($self->{pushurl}) { |
Michael G. Schwern | 705b49c | 2012-07-28 02:47:51 -0700 | [diff] [blame] | 959 | return canonicalize_url( add_path_to_url( $self->{pushurl}, $self->path ) ); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 960 | } else { |
| 961 | return $self->full_url; |
| 962 | } |
| 963 | } |
| 964 | |
| 965 | sub set_commit_header_env { |
| 966 | my ($log_entry) = @_; |
| 967 | my %env; |
| 968 | foreach my $ned (qw/NAME EMAIL DATE/) { |
| 969 | foreach my $ac (qw/AUTHOR COMMITTER/) { |
| 970 | $env{"GIT_${ac}_${ned}"} = $ENV{"GIT_${ac}_${ned}"}; |
| 971 | } |
| 972 | } |
| 973 | |
| 974 | $ENV{GIT_AUTHOR_NAME} = $log_entry->{name}; |
| 975 | $ENV{GIT_AUTHOR_EMAIL} = $log_entry->{email}; |
| 976 | $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_entry->{date}; |
| 977 | |
| 978 | $ENV{GIT_COMMITTER_NAME} = (defined $log_entry->{commit_name}) |
| 979 | ? $log_entry->{commit_name} |
| 980 | : $log_entry->{name}; |
| 981 | $ENV{GIT_COMMITTER_EMAIL} = (defined $log_entry->{commit_email}) |
| 982 | ? $log_entry->{commit_email} |
| 983 | : $log_entry->{email}; |
| 984 | \%env; |
| 985 | } |
| 986 | |
| 987 | sub restore_commit_header_env { |
| 988 | my ($env) = @_; |
| 989 | foreach my $ned (qw/NAME EMAIL DATE/) { |
| 990 | foreach my $ac (qw/AUTHOR COMMITTER/) { |
| 991 | my $k = "GIT_${ac}_${ned}"; |
| 992 | if (defined $env->{$k}) { |
| 993 | $ENV{$k} = $env->{$k}; |
| 994 | } else { |
| 995 | delete $ENV{$k}; |
| 996 | } |
| 997 | } |
| 998 | } |
| 999 | } |
| 1000 | |
| 1001 | sub gc { |
| 1002 | command_noisy('gc', '--auto'); |
| 1003 | }; |
| 1004 | |
| 1005 | sub do_git_commit { |
| 1006 | my ($self, $log_entry) = @_; |
| 1007 | my $lr = $self->last_rev; |
| 1008 | if (defined $lr && $lr >= $log_entry->{revision}) { |
| 1009 | die "Last fetched revision of ", $self->refname, |
| 1010 | " was r$lr, but we are about to fetch: ", |
| 1011 | "r$log_entry->{revision}!\n"; |
| 1012 | } |
| 1013 | if (my $c = $self->rev_map_get($log_entry->{revision})) { |
| 1014 | croak "$log_entry->{revision} = $c already exists! ", |
| 1015 | "Why are we refetching it?\n"; |
| 1016 | } |
| 1017 | my $old_env = set_commit_header_env($log_entry); |
| 1018 | my $tree = $log_entry->{tree}; |
| 1019 | if (!defined $tree) { |
| 1020 | $tree = $self->tmp_index_do(sub { |
| 1021 | command_oneline('write-tree') }); |
| 1022 | } |
brian m. carlson | 9ab3315 | 2020-06-22 18:04:12 +0000 | [diff] [blame] | 1023 | die "Tree is not a valid oid $tree\n" if $tree !~ /^$::oid$/o; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1024 | |
| 1025 | my @exec = ('git', 'commit-tree', $tree); |
| 1026 | foreach ($self->get_commit_parents($log_entry)) { |
| 1027 | push @exec, '-p', $_; |
| 1028 | } |
| 1029 | defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec)) |
| 1030 | or croak $!; |
| 1031 | binmode $msg_fh; |
| 1032 | |
| 1033 | # we always get UTF-8 from SVN, but we may want our commits in |
| 1034 | # a different encoding. |
| 1035 | if (my $enc = Git::config('i18n.commitencoding')) { |
| 1036 | require Encode; |
| 1037 | Encode::from_to($log_entry->{log}, 'UTF-8', $enc); |
| 1038 | } |
| 1039 | print $msg_fh $log_entry->{log} or croak $!; |
| 1040 | restore_commit_header_env($old_env); |
| 1041 | unless ($self->no_metadata) { |
| 1042 | print $msg_fh "\ngit-svn-id: $log_entry->{metadata}\n" |
| 1043 | or croak $!; |
| 1044 | } |
| 1045 | $msg_fh->flush == 0 or croak $!; |
| 1046 | close $msg_fh or croak $!; |
| 1047 | chomp(my $commit = do { local $/; <$out_fh> }); |
| 1048 | close $out_fh or croak $!; |
| 1049 | waitpid $pid, 0; |
| 1050 | croak $? if $?; |
brian m. carlson | 9ab3315 | 2020-06-22 18:04:12 +0000 | [diff] [blame] | 1051 | if ($commit !~ /^$::oid$/o) { |
| 1052 | die "Failed to commit, invalid oid: $commit\n"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1053 | } |
| 1054 | |
| 1055 | $self->rev_map_set($log_entry->{revision}, $commit, 1); |
| 1056 | |
| 1057 | $self->{last_rev} = $log_entry->{revision}; |
| 1058 | $self->{last_commit} = $commit; |
| 1059 | print "r$log_entry->{revision}" unless $::_q > 1; |
| 1060 | if (defined $log_entry->{svm_revision}) { |
| 1061 | print " (\@$log_entry->{svm_revision})" unless $::_q > 1; |
| 1062 | $self->rev_map_set($log_entry->{svm_revision}, $commit, |
| 1063 | 0, $self->svm_uuid); |
| 1064 | } |
| 1065 | print " = $commit ($self->{ref_id})\n" unless $::_q > 1; |
| 1066 | if (--$_gc_nr == 0) { |
| 1067 | $_gc_nr = $_gc_period; |
| 1068 | gc(); |
| 1069 | } |
| 1070 | return $commit; |
| 1071 | } |
| 1072 | |
| 1073 | sub match_paths { |
| 1074 | my ($self, $paths, $r) = @_; |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 1075 | return 1 if $self->path eq ''; |
| 1076 | if (my $path = $paths->{"/".$self->path}) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1077 | return ($path->{action} eq 'D') ? 0 : 1; |
| 1078 | } |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 1079 | $self->{path_regex} ||= qr{^/\Q@{[$self->path]}\E/}; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1080 | if (grep /$self->{path_regex}/, keys %$paths) { |
| 1081 | return 1; |
| 1082 | } |
| 1083 | my $c = ''; |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 1084 | foreach (split m#/#, $self->path) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1085 | $c .= "/$_"; |
| 1086 | next unless ($paths->{$c} && |
| 1087 | ($paths->{$c}->{action} =~ /^[AR]$/)); |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 1088 | if ($self->ra->check_path($self->path, $r) == |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1089 | $SVN::Node::dir) { |
| 1090 | return 1; |
| 1091 | } |
| 1092 | } |
| 1093 | return 0; |
| 1094 | } |
| 1095 | |
| 1096 | sub find_parent_branch { |
| 1097 | my ($self, $paths, $rev) = @_; |
| 1098 | return undef unless $self->follow_parent; |
| 1099 | unless (defined $paths) { |
| 1100 | my $err_handler = $SVN::Error::handler; |
| 1101 | $SVN::Error::handler = \&Git::SVN::Ra::skip_unknown_revs; |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 1102 | $self->ra->get_log([$self->path], $rev, $rev, 0, 1, 1, |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1103 | sub { $paths = $_[0] }); |
| 1104 | $SVN::Error::handler = $err_handler; |
| 1105 | } |
| 1106 | return undef unless defined $paths; |
| 1107 | |
| 1108 | # look for a parent from another branch: |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 1109 | my @b_path_components = split m#/#, $self->path; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1110 | my @a_path_components; |
| 1111 | my $i; |
| 1112 | while (@b_path_components) { |
| 1113 | $i = $paths->{'/'.join('/', @b_path_components)}; |
| 1114 | last if $i && defined $i->{copyfrom_path}; |
| 1115 | unshift(@a_path_components, pop(@b_path_components)); |
| 1116 | } |
| 1117 | return undef unless defined $i && defined $i->{copyfrom_path}; |
| 1118 | my $branch_from = $i->{copyfrom_path}; |
| 1119 | if (@a_path_components) { |
| 1120 | print STDERR "branch_from: $branch_from => "; |
| 1121 | $branch_from .= '/'.join('/', @a_path_components); |
| 1122 | print STDERR $branch_from, "\n"; |
| 1123 | } |
| 1124 | my $r = $i->{copyfrom_rev}; |
| 1125 | my $repos_root = $self->ra->{repos_root}; |
Michael G. Schwern | b1ea6c3 | 2012-07-27 13:00:52 -0700 | [diff] [blame] | 1126 | my $url = $self->ra->url; |
Michael G. Schwern | 705b49c | 2012-07-28 02:47:51 -0700 | [diff] [blame] | 1127 | my $new_url = canonicalize_url( add_path_to_url( $url, $branch_from ) ); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1128 | print STDERR "Found possible branch point: ", |
| 1129 | "$new_url => ", $self->full_url, ", $r\n" |
| 1130 | unless $::_q > 1; |
| 1131 | $branch_from =~ s#^/##; |
| 1132 | my $gs = $self->other_gs($new_url, $url, |
| 1133 | $branch_from, $r, $self->{ref_id}); |
| 1134 | my ($r0, $parent) = $gs->find_rev_before($r, 1); |
| 1135 | { |
| 1136 | my ($base, $head); |
| 1137 | if (!defined $r0 || !defined $parent) { |
| 1138 | ($base, $head) = parse_revision_argument(0, $r); |
| 1139 | } else { |
| 1140 | if ($r0 < $r) { |
Michael G. Schwern | 6a8d999 | 2012-07-27 13:00:51 -0700 | [diff] [blame] | 1141 | $gs->ra->get_log([$gs->path], $r0 + 1, $r, 1, |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1142 | 0, 1, sub { $base = $_[1] - 1 }); |
| 1143 | } |
| 1144 | } |
| 1145 | if (defined $base && $base <= $r) { |
| 1146 | $gs->fetch($base, $r); |
| 1147 | } |
| 1148 | ($r0, $parent) = $gs->find_rev_before($r, 1); |
| 1149 | } |
| 1150 | if (defined $r0 && defined $parent) { |
| 1151 | print STDERR "Found branch parent: ($self->{ref_id}) $parent\n" |
| 1152 | unless $::_q > 1; |
| 1153 | my $ed; |
| 1154 | if ($self->ra->can_do_switch) { |
| 1155 | $self->assert_index_clean($parent); |
| 1156 | print STDERR "Following parent with do_switch\n" |
| 1157 | unless $::_q > 1; |
| 1158 | # do_switch works with svn/trunk >= r22312, but that |
| 1159 | # is not included with SVN 1.4.3 (the latest version |
| 1160 | # at the moment), so we can't rely on it |
| 1161 | $self->{last_rev} = $r0; |
| 1162 | $self->{last_commit} = $parent; |
Michael G. Schwern | 6a8d999 | 2012-07-27 13:00:51 -0700 | [diff] [blame] | 1163 | $ed = Git::SVN::Fetcher->new($self, $gs->path); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1164 | $gs->ra->gs_do_switch($r0, $rev, $gs, |
| 1165 | $self->full_url, $ed) |
| 1166 | or die "SVN connection failed somewhere...\n"; |
| 1167 | } elsif ($self->ra->trees_match($new_url, $r0, |
| 1168 | $self->full_url, $rev)) { |
| 1169 | print STDERR "Trees match:\n", |
| 1170 | " $new_url\@$r0\n", |
| 1171 | " ${\$self->full_url}\@$rev\n", |
| 1172 | "Following parent with no changes\n" |
| 1173 | unless $::_q > 1; |
| 1174 | $self->tmp_index_do(sub { |
| 1175 | command_noisy('read-tree', $parent); |
| 1176 | }); |
| 1177 | $self->{last_commit} = $parent; |
| 1178 | } else { |
| 1179 | print STDERR "Following parent with do_update\n" |
| 1180 | unless $::_q > 1; |
| 1181 | $ed = Git::SVN::Fetcher->new($self); |
| 1182 | $self->ra->gs_do_update($rev, $rev, $self, $ed) |
| 1183 | or die "SVN connection failed somewhere...\n"; |
| 1184 | } |
| 1185 | print STDERR "Successfully followed parent\n" unless $::_q > 1; |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1186 | return $self->make_log_entry($rev, [$parent], $ed, $r0, $branch_from); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1187 | } |
| 1188 | return undef; |
| 1189 | } |
| 1190 | |
| 1191 | sub do_fetch { |
| 1192 | my ($self, $paths, $rev) = @_; |
| 1193 | my $ed; |
| 1194 | my ($last_rev, @parents); |
| 1195 | if (my $lc = $self->last_commit) { |
| 1196 | # we can have a branch that was deleted, then re-added |
| 1197 | # under the same name but copied from another path, in |
| 1198 | # which case we'll have multiple parents (we don't |
Justin Lebar | 0168990 | 2014-03-31 15:11:46 -0700 | [diff] [blame] | 1199 | # want to break the original ref or lose copypath info): |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1200 | if (my $log_entry = $self->find_parent_branch($paths, $rev)) { |
| 1201 | push @{$log_entry->{parents}}, $lc; |
| 1202 | return $log_entry; |
| 1203 | } |
| 1204 | $ed = Git::SVN::Fetcher->new($self); |
| 1205 | $last_rev = $self->{last_rev}; |
| 1206 | $ed->{c} = $lc; |
| 1207 | @parents = ($lc); |
| 1208 | } else { |
| 1209 | $last_rev = $rev; |
| 1210 | if (my $log_entry = $self->find_parent_branch($paths, $rev)) { |
| 1211 | return $log_entry; |
| 1212 | } |
| 1213 | $ed = Git::SVN::Fetcher->new($self); |
| 1214 | } |
| 1215 | unless ($self->ra->gs_do_update($last_rev, $rev, $self, $ed)) { |
| 1216 | die "SVN connection failed somewhere...\n"; |
| 1217 | } |
Jakob Stoklund Olesen | 9ee13a9 | 2014-04-16 23:54:06 -0700 | [diff] [blame] | 1218 | $self->make_log_entry($rev, \@parents, $ed, $last_rev, $self->path); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1219 | } |
| 1220 | |
| 1221 | sub mkemptydirs { |
| 1222 | my ($self, $r) = @_; |
| 1223 | |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1224 | # add/remove/collect a paths table |
| 1225 | # |
| 1226 | # Paths are split into a tree of nodes, stored as a hash of hashes. |
| 1227 | # |
| 1228 | # Each node contains a 'path' entry for the path (if any) associated |
| 1229 | # with that node and a 'children' entry for any nodes under that |
| 1230 | # location. |
| 1231 | # |
| 1232 | # Removing a path requires a hash lookup for each component then |
| 1233 | # dropping that node (and anything under it), which is substantially |
| 1234 | # faster than a grep slice into a single hash of paths for large |
| 1235 | # numbers of paths. |
| 1236 | # |
| 1237 | # For a large (200K) number of empty_dir directives this reduces |
| 1238 | # scanning time to 3 seconds vs 10 minutes for grep+delete on a single |
| 1239 | # hash of paths. |
| 1240 | sub add_path { |
| 1241 | my ($paths_table, $path) = @_; |
| 1242 | my $node_ref; |
| 1243 | |
| 1244 | foreach my $x (split('/', $path)) { |
| 1245 | if (!exists($paths_table->{$x})) { |
| 1246 | $paths_table->{$x} = { children => {} }; |
| 1247 | } |
| 1248 | |
| 1249 | $node_ref = $paths_table->{$x}; |
| 1250 | $paths_table = $paths_table->{$x}->{children}; |
| 1251 | } |
| 1252 | |
| 1253 | $node_ref->{path} = $path; |
| 1254 | } |
| 1255 | |
| 1256 | sub remove_path { |
| 1257 | my ($paths_table, $path) = @_; |
| 1258 | my $nodes_ref; |
| 1259 | my $node_name; |
| 1260 | |
| 1261 | foreach my $x (split('/', $path)) { |
| 1262 | if (!exists($paths_table->{$x})) { |
| 1263 | return; |
| 1264 | } |
| 1265 | |
| 1266 | $nodes_ref = $paths_table; |
| 1267 | $node_name = $x; |
| 1268 | |
| 1269 | $paths_table = $paths_table->{$x}->{children}; |
| 1270 | } |
| 1271 | |
| 1272 | delete($nodes_ref->{$node_name}); |
| 1273 | } |
| 1274 | |
| 1275 | sub collect_paths { |
| 1276 | my ($paths_table, $paths_ref) = @_; |
| 1277 | |
| 1278 | foreach my $v (values %$paths_table) { |
| 1279 | my $p = $v->{path}; |
| 1280 | my $c = $v->{children}; |
| 1281 | |
| 1282 | collect_paths($c, $paths_ref); |
| 1283 | |
| 1284 | if (defined($p)) { |
| 1285 | push(@$paths_ref, $p); |
| 1286 | } |
| 1287 | } |
| 1288 | } |
| 1289 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1290 | sub scan { |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1291 | my ($r, $paths_table, $line) = @_; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1292 | if (defined $r && $line =~ /^r(\d+)$/) { |
| 1293 | return 0 if $1 > $r; |
| 1294 | } elsif ($line =~ /^ \+empty_dir: (.+)$/) { |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1295 | add_path($paths_table, $1); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1296 | } elsif ($line =~ /^ \-empty_dir: (.+)$/) { |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1297 | remove_path($paths_table, $1); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1298 | } |
| 1299 | 1; # continue |
| 1300 | }; |
| 1301 | |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1302 | my @empty_dirs; |
| 1303 | my %paths_table; |
| 1304 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1305 | my $gz_file = "$self->{dir}/unhandled.log.gz"; |
| 1306 | if (-f $gz_file) { |
| 1307 | if (!can_compress()) { |
| 1308 | warn "Compress::Zlib could not be found; ", |
| 1309 | "empty directories in $gz_file will not be read\n"; |
| 1310 | } else { |
| 1311 | my $gz = Compress::Zlib::gzopen($gz_file, "rb") or |
| 1312 | die "Unable to open $gz_file: $!\n"; |
| 1313 | my $line; |
| 1314 | while ($gz->gzreadline($line) > 0) { |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1315 | scan($r, \%paths_table, $line) or last; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1316 | } |
| 1317 | $gz->gzclose; |
| 1318 | } |
| 1319 | } |
| 1320 | |
| 1321 | if (open my $fh, '<', "$self->{dir}/unhandled.log") { |
| 1322 | binmode $fh or croak "binmode: $!"; |
| 1323 | while (<$fh>) { |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1324 | scan($r, \%paths_table, $_) or last; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1325 | } |
| 1326 | close $fh; |
| 1327 | } |
| 1328 | |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1329 | collect_paths(\%paths_table, \@empty_dirs); |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 1330 | my $strip = qr/\A\Q@{[$self->path]}\E(?:\/|$)/; |
Dair Grant | 8262574 | 2015-11-05 10:26:15 +0000 | [diff] [blame] | 1331 | foreach my $d (sort @empty_dirs) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1332 | $d = uri_decode($d); |
| 1333 | $d =~ s/$strip//; |
| 1334 | next unless length($d); |
| 1335 | next if -d $d; |
| 1336 | if (-e $d) { |
| 1337 | warn "$d exists but is not a directory\n"; |
| 1338 | } else { |
| 1339 | print "creating empty directory: $d\n"; |
| 1340 | mkpath([$d]); |
| 1341 | } |
| 1342 | } |
| 1343 | } |
| 1344 | |
| 1345 | sub get_untracked { |
| 1346 | my ($self, $ed) = @_; |
| 1347 | my @out; |
| 1348 | my $h = $ed->{empty}; |
| 1349 | foreach (sort keys %$h) { |
| 1350 | my $act = $h->{$_} ? '+empty_dir' : '-empty_dir'; |
| 1351 | push @out, " $act: " . uri_encode($_); |
| 1352 | warn "W: $act: $_\n"; |
| 1353 | } |
| 1354 | foreach my $t (qw/dir_prop file_prop/) { |
| 1355 | $h = $ed->{$t} or next; |
| 1356 | foreach my $path (sort keys %$h) { |
| 1357 | my $ppath = $path eq '' ? '.' : $path; |
| 1358 | foreach my $prop (sort keys %{$h->{$path}}) { |
| 1359 | next if $SKIP_PROP{$prop}; |
| 1360 | my $v = $h->{$path}->{$prop}; |
| 1361 | my $t_ppath_prop = "$t: " . |
| 1362 | uri_encode($ppath) . ' ' . |
| 1363 | uri_encode($prop); |
| 1364 | if (defined $v) { |
| 1365 | push @out, " +$t_ppath_prop " . |
| 1366 | uri_encode($v); |
| 1367 | } else { |
| 1368 | push @out, " -$t_ppath_prop"; |
| 1369 | } |
| 1370 | } |
| 1371 | } |
| 1372 | } |
| 1373 | foreach my $t (qw/absent_file absent_directory/) { |
| 1374 | $h = $ed->{$t} or next; |
| 1375 | foreach my $parent (sort keys %$h) { |
| 1376 | foreach my $path (sort @{$h->{$parent}}) { |
| 1377 | push @out, " $t: " . |
| 1378 | uri_encode("$parent/$path"); |
| 1379 | warn "W: $t: $parent/$path ", |
| 1380 | "Insufficient permissions?\n"; |
| 1381 | } |
| 1382 | } |
| 1383 | } |
| 1384 | \@out; |
| 1385 | } |
| 1386 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1387 | # parse_svn_date(DATE) |
| 1388 | # -------------------- |
| 1389 | # Given a date (in UTC) from Subversion, return a string in the format |
| 1390 | # "<TZ Offset> <local date/time>" that Git will use. |
| 1391 | # |
| 1392 | # By default the parsed date will be in UTC; if $Git::SVN::_localtime |
| 1393 | # is true we'll convert it to the local timezone instead. |
| 1394 | sub parse_svn_date { |
| 1395 | my $date = shift || return '+0000 1970-01-01 00:00:00'; |
| 1396 | my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T |
RomanBelinsky | 784f4b6 | 2014-02-11 18:23:02 +0200 | [diff] [blame] | 1397 | (\d\d?)\:(\d\d)\:(\d\d)\.\d*Z$/x) or |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1398 | croak "Unable to parse date: $date\n"; |
| 1399 | my $parsed_date; # Set next. |
| 1400 | |
| 1401 | if ($Git::SVN::_localtime) { |
| 1402 | # Translate the Subversion datetime to an epoch time. |
| 1403 | # Begin by switching ourselves to $date's timezone, UTC. |
| 1404 | my $old_env_TZ = $ENV{TZ}; |
| 1405 | $ENV{TZ} = 'UTC'; |
| 1406 | |
| 1407 | my $epoch_in_UTC = |
Bernhard M. Wiedemann | a40e06e | 2018-02-23 18:20:45 +0100 | [diff] [blame] | 1408 | Time::Local::timelocal($S, $M, $H, $d, $m - 1, $Y); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1409 | |
| 1410 | # Determine our local timezone (including DST) at the |
| 1411 | # time of $epoch_in_UTC. $Git::SVN::Log::TZ stored the |
| 1412 | # value of TZ, if any, at the time we were run. |
| 1413 | if (defined $Git::SVN::Log::TZ) { |
| 1414 | $ENV{TZ} = $Git::SVN::Log::TZ; |
| 1415 | } else { |
| 1416 | delete $ENV{TZ}; |
| 1417 | } |
| 1418 | |
Urs Thuermann | 1adc4b9 | 2017-08-05 02:12:15 +0200 | [diff] [blame] | 1419 | my $our_TZ = get_tz_offset($epoch_in_UTC); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1420 | |
| 1421 | # This converts $epoch_in_UTC into our local timezone. |
| 1422 | my ($sec, $min, $hour, $mday, $mon, $year, |
| 1423 | $wday, $yday, $isdst) = localtime($epoch_in_UTC); |
| 1424 | |
| 1425 | $parsed_date = sprintf('%s %04d-%02d-%02d %02d:%02d:%02d', |
| 1426 | $our_TZ, $year + 1900, $mon + 1, |
| 1427 | $mday, $hour, $min, $sec); |
| 1428 | |
| 1429 | # Reset us to the timezone in effect when we entered |
| 1430 | # this routine. |
| 1431 | if (defined $old_env_TZ) { |
| 1432 | $ENV{TZ} = $old_env_TZ; |
| 1433 | } else { |
| 1434 | delete $ENV{TZ}; |
| 1435 | } |
| 1436 | } else { |
| 1437 | $parsed_date = "+0000 $Y-$m-$d $H:$M:$S"; |
| 1438 | } |
| 1439 | |
| 1440 | return $parsed_date; |
| 1441 | } |
| 1442 | |
| 1443 | sub other_gs { |
| 1444 | my ($self, $new_url, $url, |
| 1445 | $branch_from, $r, $old_ref_id) = @_; |
| 1446 | my $gs = Git::SVN->find_by_url($new_url, $url, $branch_from); |
| 1447 | unless ($gs) { |
| 1448 | my $ref_id = $old_ref_id; |
| 1449 | $ref_id =~ s/\@\d+-*$//; |
| 1450 | $ref_id .= "\@$r"; |
| 1451 | # just grow a tail if we're not unique enough :x |
| 1452 | $ref_id .= '-' while find_ref($ref_id); |
| 1453 | my ($u, $p, $repo_id) = ($new_url, '', $ref_id); |
| 1454 | if ($u =~ s#^\Q$url\E(/|$)##) { |
| 1455 | $p = $u; |
| 1456 | $u = $url; |
| 1457 | $repo_id = $self->{repo_id}; |
| 1458 | } |
| 1459 | while (1) { |
| 1460 | # It is possible to tag two different subdirectories at |
| 1461 | # the same revision. If the url for an existing ref |
| 1462 | # does not match, we must either find a ref with a |
| 1463 | # matching url or create a new ref by growing a tail. |
| 1464 | $gs = Git::SVN->init($u, $p, $repo_id, $ref_id, 1); |
| 1465 | my (undef, $max_commit) = $gs->rev_map_max(1); |
| 1466 | last if (!$max_commit); |
| 1467 | my ($url) = ::cmt_metadata($max_commit); |
| 1468 | last if ($url eq $gs->metadata_url); |
| 1469 | $ref_id .= '-'; |
| 1470 | } |
| 1471 | print STDERR "Initializing parent: $ref_id\n" unless $::_q > 1; |
| 1472 | } |
| 1473 | $gs |
| 1474 | } |
| 1475 | |
| 1476 | sub call_authors_prog { |
| 1477 | my ($orig_author) = @_; |
| 1478 | $orig_author = command_oneline('rev-parse', '--sq-quote', $orig_author); |
| 1479 | my $author = `$::_authors_prog $orig_author`; |
| 1480 | if ($? != 0) { |
| 1481 | die "$::_authors_prog failed with exit code $?\n" |
| 1482 | } |
| 1483 | if ($author =~ /^\s*(.+?)\s*<(.*)>\s*$/) { |
| 1484 | my ($name, $email) = ($1, $2); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1485 | return [$name, $email]; |
| 1486 | } else { |
| 1487 | die "Author: $orig_author: $::_authors_prog returned " |
| 1488 | . "invalid author format: $author\n"; |
| 1489 | } |
| 1490 | } |
| 1491 | |
| 1492 | sub check_author { |
| 1493 | my ($author) = @_; |
Tobias Klauser | 4ddd4bd | 2019-09-23 11:55:54 +0200 | [diff] [blame] | 1494 | if (defined $author) { |
| 1495 | $author =~ s/^\s+//g; |
| 1496 | $author =~ s/\s+$//g; |
| 1497 | } |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1498 | if (!defined $author || length $author == 0) { |
| 1499 | $author = '(no author)'; |
| 1500 | } |
| 1501 | if (!defined $::users{$author}) { |
| 1502 | if (defined $::_authors_prog) { |
| 1503 | $::users{$author} = call_authors_prog($author); |
| 1504 | } elsif (defined $::_authors) { |
| 1505 | die "Author: $author not defined in $::_authors file\n"; |
| 1506 | } |
| 1507 | } |
| 1508 | $author; |
| 1509 | } |
| 1510 | |
| 1511 | sub find_extra_svk_parents { |
Eric Wong | 4ae9a7b | 2014-10-29 20:10:29 +0000 | [diff] [blame] | 1512 | my ($self, $tickets, $parents) = @_; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1513 | # aha! svk:merge property changed... |
| 1514 | my @tickets = split "\n", $tickets; |
| 1515 | my @known_parents; |
| 1516 | for my $ticket ( @tickets ) { |
| 1517 | my ($uuid, $path, $rev) = split /:/, $ticket; |
| 1518 | if ( $uuid eq $self->ra_uuid ) { |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 1519 | my $repos_root = $self->url; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1520 | my $branch_from = $path; |
| 1521 | $branch_from =~ s{^/}{}; |
Michael G. Schwern | d2fd119 | 2012-07-28 02:47:50 -0700 | [diff] [blame] | 1522 | my $gs = $self->other_gs(add_path_to_url( $repos_root, $branch_from ), |
| 1523 | $repos_root, |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1524 | $branch_from, |
| 1525 | $rev, |
| 1526 | $self->{ref_id}); |
| 1527 | if ( my $commit = $gs->rev_map_get($rev, $uuid) ) { |
| 1528 | # wahey! we found it, but it might be |
| 1529 | # an old one (!) |
| 1530 | push @known_parents, [ $rev, $commit ]; |
| 1531 | } |
| 1532 | } |
| 1533 | } |
| 1534 | # Ordering matters; highest-numbered commit merge tickets |
| 1535 | # first, as they may account for later merge ticket additions |
| 1536 | # or changes. |
| 1537 | @known_parents = map {$_->[1]} sort {$b->[0] <=> $a->[0]} @known_parents; |
| 1538 | for my $parent ( @known_parents ) { |
| 1539 | my @cmd = ('rev-list', $parent, map { "^$_" } @$parents ); |
| 1540 | my ($msg_fh, $ctx) = command_output_pipe(@cmd); |
| 1541 | my $new; |
| 1542 | while ( <$msg_fh> ) { |
| 1543 | $new=1;last; |
| 1544 | } |
| 1545 | command_close_pipe($msg_fh, $ctx); |
| 1546 | if ( $new ) { |
| 1547 | print STDERR |
| 1548 | "Found merge parent (svk:merge ticket): $parent\n"; |
| 1549 | push @$parents, $parent; |
| 1550 | } |
| 1551 | } |
| 1552 | } |
| 1553 | |
| 1554 | sub lookup_svn_merge { |
| 1555 | my $uuid = shift; |
| 1556 | my $url = shift; |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1557 | my $source = shift; |
| 1558 | my $revs = shift; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1559 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1560 | my $path = $source; |
| 1561 | $path =~ s{^/}{}; |
| 1562 | my $gs = Git::SVN->find_by_url($url.$source, $url, $path); |
| 1563 | if ( !$gs ) { |
| 1564 | warn "Couldn't find revmap for $url$source\n"; |
| 1565 | return; |
| 1566 | } |
| 1567 | my @ranges = split ",", $revs; |
| 1568 | my ($tip, $tip_commit); |
| 1569 | my @merged_commit_ranges; |
| 1570 | # find the tip |
| 1571 | for my $range ( @ranges ) { |
Jan Pešta | 47543d1 | 2013-03-07 12:28:14 +0100 | [diff] [blame] | 1572 | if ($range =~ /[*]$/) { |
| 1573 | warn "W: Ignoring partial merge in svn:mergeinfo " |
| 1574 | ."dirprop: $source:$range\n"; |
| 1575 | next; |
| 1576 | } |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1577 | my ($bottom, $top) = split "-", $range; |
| 1578 | $top ||= $bottom; |
| 1579 | my $bottom_commit = $gs->find_rev_after( $bottom, 1, $top ); |
| 1580 | my $top_commit = $gs->find_rev_before( $top, 1, $bottom ); |
| 1581 | |
| 1582 | unless ($top_commit and $bottom_commit) { |
Eric Wong | eae6cf5 | 2013-03-08 09:46:41 +0000 | [diff] [blame] | 1583 | warn "W: unknown path/rev in svn:mergeinfo " |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1584 | ."dirprop: $source:$range\n"; |
| 1585 | next; |
| 1586 | } |
| 1587 | |
| 1588 | if (scalar(command('rev-parse', "$bottom_commit^@"))) { |
| 1589 | push @merged_commit_ranges, |
| 1590 | "$bottom_commit^..$top_commit"; |
| 1591 | } else { |
| 1592 | push @merged_commit_ranges, "$top_commit"; |
| 1593 | } |
| 1594 | |
| 1595 | if ( !defined $tip or $top > $tip ) { |
| 1596 | $tip = $top; |
| 1597 | $tip_commit = $top_commit; |
| 1598 | } |
| 1599 | } |
| 1600 | return ($tip_commit, @merged_commit_ranges); |
| 1601 | } |
| 1602 | |
| 1603 | sub _rev_list { |
| 1604 | my ($msg_fh, $ctx) = command_output_pipe( |
| 1605 | "rev-list", @_, |
| 1606 | ); |
| 1607 | my @rv; |
| 1608 | while ( <$msg_fh> ) { |
| 1609 | chomp; |
| 1610 | push @rv, $_; |
| 1611 | } |
| 1612 | command_close_pipe($msg_fh, $ctx); |
| 1613 | @rv; |
| 1614 | } |
| 1615 | |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1616 | sub check_cherry_pick2 { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1617 | my $base = shift; |
| 1618 | my $tip = shift; |
| 1619 | my $parents = shift; |
| 1620 | my @ranges = @_; |
| 1621 | my %commits = map { $_ => 1 } |
| 1622 | _rev_list("--no-merges", $tip, "--not", $base, @$parents, "--"); |
| 1623 | for my $range ( @ranges ) { |
| 1624 | delete @commits{_rev_list($range, "--")}; |
| 1625 | } |
| 1626 | for my $commit (keys %commits) { |
| 1627 | if (has_no_changes($commit)) { |
| 1628 | delete $commits{$commit}; |
| 1629 | } |
| 1630 | } |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1631 | my @k = (keys %commits); |
| 1632 | return (scalar @k, $k[0]); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1633 | } |
| 1634 | |
| 1635 | sub has_no_changes { |
| 1636 | my $commit = shift; |
| 1637 | |
| 1638 | my @revs = split / /, command_oneline( |
Sergey Organov | 23f6d40 | 2021-05-21 00:47:00 +0300 | [diff] [blame] | 1639 | qw(rev-list --parents -1), $commit); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1640 | |
| 1641 | # Commits with no parents, e.g. the start of a partial branch, |
| 1642 | # have changes by definition. |
| 1643 | return 1 if (@revs < 2); |
| 1644 | |
| 1645 | # Commits with multiple parents, e.g a merge, have no changes |
| 1646 | # by definition. |
| 1647 | return 0 if (@revs > 2); |
| 1648 | |
| 1649 | return (command_oneline("rev-parse", "$commit^{tree}") eq |
| 1650 | command_oneline("rev-parse", "$commit~1^{tree}")); |
| 1651 | } |
| 1652 | |
| 1653 | sub tie_for_persistent_memoization { |
| 1654 | my $hash = shift; |
| 1655 | my $path = shift; |
| 1656 | |
Eric Wong | 47092c1 | 2015-01-15 08:54:22 +0000 | [diff] [blame] | 1657 | unless ($memo_backend) { |
| 1658 | if (eval { require Git::SVN::Memoize::YAML; 1}) { |
| 1659 | $memo_backend = 1; |
| 1660 | } else { |
| 1661 | require Memoize::Storable; |
| 1662 | $memo_backend = -1; |
| 1663 | } |
| 1664 | } |
| 1665 | |
| 1666 | if ($memo_backend > 0) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1667 | tie %$hash => 'Git::SVN::Memoize::YAML', "$path.yaml"; |
| 1668 | } else { |
Gavin Lambert | a2c761c | 2016-10-25 17:30:11 +0200 | [diff] [blame] | 1669 | # first verify that any existing file can actually be loaded |
| 1670 | # (it may have been saved by an incompatible version) |
| 1671 | my $db = "$path.db"; |
| 1672 | if (-e $db) { |
| 1673 | use Storable qw(retrieve); |
| 1674 | |
| 1675 | if (!eval { retrieve($db); 1 }) { |
| 1676 | unlink $db or die "unlink $db failed: $!"; |
| 1677 | } |
| 1678 | } |
| 1679 | tie %$hash => 'Memoize::Storable', $db, 'nstore'; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1680 | } |
| 1681 | } |
| 1682 | |
| 1683 | # The GIT_DIR environment variable is not always set until after the command |
| 1684 | # line arguments are processed, so we can't memoize in a BEGIN block. |
| 1685 | { |
| 1686 | my $memoized = 0; |
| 1687 | |
| 1688 | sub memoize_svn_mergeinfo_functions { |
| 1689 | return if $memoized; |
| 1690 | $memoized = 1; |
| 1691 | |
Eric Wong | 112423e | 2016-10-14 00:27:54 +0000 | [diff] [blame] | 1692 | my $cache_path = svn_dir() . '/.caches/'; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1693 | mkpath([$cache_path]) unless -d $cache_path; |
| 1694 | |
| 1695 | my %lookup_svn_merge_cache; |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1696 | my %check_cherry_pick2_cache; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1697 | my %has_no_changes_cache; |
| 1698 | |
| 1699 | tie_for_persistent_memoization(\%lookup_svn_merge_cache, |
| 1700 | "$cache_path/lookup_svn_merge"); |
| 1701 | memoize 'lookup_svn_merge', |
| 1702 | SCALAR_CACHE => 'FAULT', |
| 1703 | LIST_CACHE => ['HASH' => \%lookup_svn_merge_cache], |
| 1704 | ; |
| 1705 | |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1706 | tie_for_persistent_memoization(\%check_cherry_pick2_cache, |
| 1707 | "$cache_path/check_cherry_pick2"); |
| 1708 | memoize 'check_cherry_pick2', |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1709 | SCALAR_CACHE => 'FAULT', |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1710 | LIST_CACHE => ['HASH' => \%check_cherry_pick2_cache], |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1711 | ; |
| 1712 | |
| 1713 | tie_for_persistent_memoization(\%has_no_changes_cache, |
| 1714 | "$cache_path/has_no_changes"); |
| 1715 | memoize 'has_no_changes', |
| 1716 | SCALAR_CACHE => ['HASH' => \%has_no_changes_cache], |
| 1717 | LIST_CACHE => 'FAULT', |
| 1718 | ; |
| 1719 | } |
| 1720 | |
| 1721 | sub unmemoize_svn_mergeinfo_functions { |
| 1722 | return if not $memoized; |
| 1723 | $memoized = 0; |
| 1724 | |
| 1725 | Memoize::unmemoize 'lookup_svn_merge'; |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1726 | Memoize::unmemoize 'check_cherry_pick2'; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1727 | Memoize::unmemoize 'has_no_changes'; |
| 1728 | } |
| 1729 | |
Peter Baumann | 61b472e | 2012-08-09 08:42:53 +0200 | [diff] [blame] | 1730 | sub clear_memoized_mergeinfo_caches { |
| 1731 | die "Only call this method in non-memoized context" if ($memoized); |
| 1732 | |
Eric Wong | 112423e | 2016-10-14 00:27:54 +0000 | [diff] [blame] | 1733 | my $cache_path = svn_dir() . '/.caches/'; |
Peter Baumann | 61b472e | 2012-08-09 08:42:53 +0200 | [diff] [blame] | 1734 | return unless -d $cache_path; |
| 1735 | |
| 1736 | for my $cache_file (("$cache_path/lookup_svn_merge", |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1737 | "$cache_path/check_cherry_pick", # old |
| 1738 | "$cache_path/check_cherry_pick2", |
Peter Baumann | 61b472e | 2012-08-09 08:42:53 +0200 | [diff] [blame] | 1739 | "$cache_path/has_no_changes")) { |
| 1740 | for my $suffix (qw(yaml db)) { |
| 1741 | my $file = "$cache_file.$suffix"; |
| 1742 | next unless -e $file; |
| 1743 | unlink($file) or die "unlink($file) failed: $!\n"; |
| 1744 | } |
| 1745 | } |
| 1746 | } |
| 1747 | |
| 1748 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1749 | Memoize::memoize 'Git::SVN::repos_root'; |
| 1750 | } |
| 1751 | |
| 1752 | END { |
| 1753 | # Force cache writeout explicitly instead of waiting for |
| 1754 | # global destruction to avoid segfault in Storable: |
Josh Soref | d05b08c | 2023-11-24 03:35:13 +0000 | [diff] [blame] | 1755 | # https://rt.cpan.org/Public/Bug/Display.html?id=36087 |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1756 | unmemoize_svn_mergeinfo_functions(); |
| 1757 | } |
| 1758 | |
| 1759 | sub parents_exclude { |
| 1760 | my $parents = shift; |
| 1761 | my @commits = @_; |
| 1762 | return unless @commits; |
| 1763 | |
| 1764 | my @excluded; |
| 1765 | my $excluded; |
| 1766 | do { |
| 1767 | my @cmd = ('rev-list', "-1", @commits, "--not", @$parents ); |
| 1768 | $excluded = command_oneline(@cmd); |
| 1769 | if ( $excluded ) { |
| 1770 | my @new; |
| 1771 | my $found; |
| 1772 | for my $commit ( @commits ) { |
| 1773 | if ( $commit eq $excluded ) { |
| 1774 | push @excluded, $commit; |
| 1775 | $found++; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1776 | } |
| 1777 | else { |
| 1778 | push @new, $commit; |
| 1779 | } |
| 1780 | } |
| 1781 | die "saw commit '$excluded' in rev-list output, " |
| 1782 | ."but we didn't ask for that commit (wanted: @commits --not @$parents)" |
| 1783 | unless $found; |
| 1784 | @commits = @new; |
| 1785 | } |
| 1786 | } |
| 1787 | while ($excluded and @commits); |
| 1788 | |
| 1789 | return @excluded; |
| 1790 | } |
| 1791 | |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1792 | # Compute what's new in svn:mergeinfo. |
| 1793 | sub mergeinfo_changes { |
| 1794 | my ($self, $old_path, $old_rev, $path, $rev, $mergeinfo_prop) = @_; |
| 1795 | my %minfo = map {split ":", $_ } split "\n", $mergeinfo_prop; |
| 1796 | my $old_minfo = {}; |
| 1797 | |
Eric Wong | 2b6c613 | 2014-10-21 06:23:22 +0000 | [diff] [blame] | 1798 | my $ra = $self->ra; |
| 1799 | # Give up if $old_path isn't in the repo. |
| 1800 | # This is probably a merge on a subtree. |
| 1801 | if ($ra->check_path($old_path, $old_rev) != $SVN::Node::dir) { |
| 1802 | warn "W: ignoring svn:mergeinfo on $old_path, ", |
| 1803 | "directory didn't exist in r$old_rev\n"; |
| 1804 | return {}; |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1805 | } |
Eric Wong | 2b6c613 | 2014-10-21 06:23:22 +0000 | [diff] [blame] | 1806 | my (undef, undef, $props) = $ra->get_dir($old_path, $old_rev); |
Eric Wong | 54b9534 | 2014-10-20 01:02:53 +0000 | [diff] [blame] | 1807 | if (defined $props->{"svn:mergeinfo"}) { |
| 1808 | my %omi = map {split ":", $_ } split "\n", |
| 1809 | $props->{"svn:mergeinfo"}; |
| 1810 | $old_minfo = \%omi; |
| 1811 | } |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1812 | |
| 1813 | my %changes = (); |
| 1814 | foreach my $p (keys %minfo) { |
| 1815 | my $a = $old_minfo->{$p} || ""; |
| 1816 | my $b = $minfo{$p}; |
| 1817 | # Omit merged branches whose ranges lists are unchanged. |
| 1818 | next if $a eq $b; |
| 1819 | # Remove any common range list prefix. |
| 1820 | ($a ^ $b) =~ /^[\0]*/; |
| 1821 | my $common_prefix = rindex $b, ",", $+[0] - 1; |
| 1822 | $changes{$p} = substr $b, $common_prefix + 1; |
| 1823 | } |
| 1824 | print STDERR "Checking svn:mergeinfo changes since r$old_rev: ", |
| 1825 | scalar(keys %minfo), " sources, ", |
| 1826 | scalar(keys %changes), " changed\n"; |
| 1827 | |
| 1828 | return \%changes; |
| 1829 | } |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1830 | |
| 1831 | # note: this function should only be called if the various dirprops |
| 1832 | # have actually changed |
| 1833 | sub find_extra_svn_parents { |
Eric Wong | 4ae9a7b | 2014-10-29 20:10:29 +0000 | [diff] [blame] | 1834 | my ($self, $mergeinfo, $parents) = @_; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1835 | # aha! svk:merge property changed... |
| 1836 | |
| 1837 | memoize_svn_mergeinfo_functions(); |
| 1838 | |
| 1839 | # We first search for merged tips which are not in our |
| 1840 | # history. Then, we figure out which git revisions are in |
| 1841 | # that tip, but not this revision. If all of those revisions |
| 1842 | # are now marked as merge, we can add the tip as a parent. |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1843 | my @merges = sort keys %$mergeinfo; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1844 | my @merge_tips; |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 1845 | my $url = $self->url; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1846 | my $uuid = $self->ra_uuid; |
Steven Walter | f271fad | 2012-08-19 21:39:40 -0400 | [diff] [blame] | 1847 | my @all_ranges; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1848 | for my $merge ( @merges ) { |
| 1849 | my ($tip_commit, @ranges) = |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1850 | lookup_svn_merge( $uuid, $url, |
| 1851 | $merge, $mergeinfo->{$merge} ); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1852 | unless (!$tip_commit or |
| 1853 | grep { $_ eq $tip_commit } @$parents ) { |
| 1854 | push @merge_tips, $tip_commit; |
Steven Walter | f271fad | 2012-08-19 21:39:40 -0400 | [diff] [blame] | 1855 | push @all_ranges, @ranges; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1856 | } else { |
| 1857 | push @merge_tips, undef; |
| 1858 | } |
| 1859 | } |
| 1860 | |
| 1861 | my %excluded = map { $_ => 1 } |
| 1862 | parents_exclude($parents, grep { defined } @merge_tips); |
| 1863 | |
| 1864 | # check merge tips for new parents |
| 1865 | my @new_parents; |
| 1866 | for my $merge_tip ( @merge_tips ) { |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1867 | my $merge = shift @merges; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1868 | next unless $merge_tip and $excluded{$merge_tip}; |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1869 | my $spec = "$merge:$mergeinfo->{$merge}"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1870 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1871 | # check out 'new' tips |
| 1872 | my $merge_base; |
| 1873 | eval { |
| 1874 | $merge_base = command_oneline( |
| 1875 | "merge-base", |
| 1876 | @$parents, $merge_tip, |
| 1877 | ); |
| 1878 | }; |
| 1879 | if ($@) { |
| 1880 | die "An error occurred during merge-base" |
| 1881 | unless $@->isa("Git::Error::Command"); |
| 1882 | |
| 1883 | warn "W: Cannot find common ancestor between ". |
| 1884 | "@$parents and $merge_tip. Ignoring merge info.\n"; |
| 1885 | next; |
| 1886 | } |
| 1887 | |
| 1888 | # double check that there are no missing non-merge commits |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1889 | my ($ninc, $ifirst) = check_cherry_pick2( |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1890 | $merge_base, $merge_tip, |
| 1891 | $parents, |
Steven Walter | f271fad | 2012-08-19 21:39:40 -0400 | [diff] [blame] | 1892 | @all_ranges, |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1893 | ); |
| 1894 | |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1895 | if ($ninc) { |
Eric Wong | da0bc94 | 2014-10-30 08:31:28 +0000 | [diff] [blame] | 1896 | warn "W: svn cherry-pick ignored ($spec) - missing " . |
Eric Wong | d0b34f2 | 2014-10-19 04:08:31 +0000 | [diff] [blame] | 1897 | "$ninc commit(s) (eg $ifirst)\n"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1898 | } else { |
Eric Wong | da0bc94 | 2014-10-30 08:31:28 +0000 | [diff] [blame] | 1899 | warn "Found merge parent ($spec): ", $merge_tip, "\n"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1900 | push @new_parents, $merge_tip; |
| 1901 | } |
| 1902 | } |
| 1903 | |
| 1904 | # cater for merges which merge commits from multiple branches |
| 1905 | if ( @new_parents > 1 ) { |
| 1906 | for ( my $i = 0; $i <= $#new_parents; $i++ ) { |
| 1907 | for ( my $j = 0; $j <= $#new_parents; $j++ ) { |
| 1908 | next if $i == $j; |
| 1909 | next unless $new_parents[$i]; |
| 1910 | next unless $new_parents[$j]; |
| 1911 | my $revs = command_oneline( |
| 1912 | "rev-list", "-1", |
| 1913 | "$new_parents[$i]..$new_parents[$j]", |
| 1914 | ); |
| 1915 | if ( !$revs ) { |
| 1916 | undef($new_parents[$j]); |
| 1917 | } |
| 1918 | } |
| 1919 | } |
| 1920 | } |
| 1921 | push @$parents, grep { defined } @new_parents; |
| 1922 | } |
| 1923 | |
| 1924 | sub make_log_entry { |
Jakob Stoklund Olesen | abfef3b | 2014-04-16 23:54:05 -0700 | [diff] [blame] | 1925 | my ($self, $rev, $parents, $ed, $parent_rev, $parent_path) = @_; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1926 | my $untracked = $self->get_untracked($ed); |
| 1927 | |
| 1928 | my @parents = @$parents; |
Jakob Stoklund Olesen | 9ee13a9 | 2014-04-16 23:54:06 -0700 | [diff] [blame] | 1929 | my $props = $ed->{dir_prop}{$self->path}; |
Eric Wong | 6d523a3 | 2016-06-20 21:52:53 +0000 | [diff] [blame] | 1930 | if ($self->follow_parent) { |
| 1931 | my $tickets = $props->{"svk:merge"}; |
| 1932 | if ($tickets) { |
| 1933 | $self->find_extra_svk_parents($tickets, \@parents); |
| 1934 | } |
| 1935 | |
| 1936 | my $mergeinfo_prop = $props->{"svn:mergeinfo"}; |
| 1937 | if ($mergeinfo_prop) { |
| 1938 | my $mi_changes = $self->mergeinfo_changes( |
| 1939 | $parent_path, |
| 1940 | $parent_rev, |
| 1941 | $self->path, |
| 1942 | $rev, |
| 1943 | $mergeinfo_prop); |
| 1944 | $self->find_extra_svn_parents($mi_changes, \@parents); |
| 1945 | } |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 1946 | } |
| 1947 | |
| 1948 | open my $un, '>>', "$self->{dir}/unhandled.log" or croak $!; |
| 1949 | print $un "r$rev\n" or croak $!; |
| 1950 | print $un $_, "\n" foreach @$untracked; |
| 1951 | my %log_entry = ( parents => \@parents, revision => $rev, |
| 1952 | log => ''); |
| 1953 | |
| 1954 | my $headrev; |
| 1955 | my $logged = delete $self->{logged_rev_props}; |
| 1956 | if (!$logged || $self->{-want_revprops}) { |
| 1957 | my $rp = $self->ra->rev_proplist($rev); |
| 1958 | foreach (sort keys %$rp) { |
| 1959 | my $v = $rp->{$_}; |
| 1960 | if (/^svn:(author|date|log)$/) { |
| 1961 | $log_entry{$1} = $v; |
| 1962 | } elsif ($_ eq 'svm:headrev') { |
| 1963 | $headrev = $v; |
| 1964 | } else { |
| 1965 | print $un " rev_prop: ", uri_encode($_), ' ', |
| 1966 | uri_encode($v), "\n"; |
| 1967 | } |
| 1968 | } |
| 1969 | } else { |
| 1970 | map { $log_entry{$_} = $logged->{$_} } keys %$logged; |
| 1971 | } |
| 1972 | close $un or croak $!; |
| 1973 | |
| 1974 | $log_entry{date} = parse_svn_date($log_entry{date}); |
| 1975 | $log_entry{log} .= "\n"; |
| 1976 | my $author = $log_entry{author} = check_author($log_entry{author}); |
| 1977 | my ($name, $email) = defined $::users{$author} ? @{$::users{$author}} |
| 1978 | : ($author, undef); |
| 1979 | |
| 1980 | my ($commit_name, $commit_email) = ($name, $email); |
| 1981 | if ($_use_log_author) { |
| 1982 | my $name_field; |
| 1983 | if ($log_entry{log} =~ /From:\s+(.*\S)\s*\n/i) { |
| 1984 | $name_field = $1; |
| 1985 | } elsif ($log_entry{log} =~ /Signed-off-by:\s+(.*\S)\s*\n/i) { |
| 1986 | $name_field = $1; |
| 1987 | } |
| 1988 | if (!defined $name_field) { |
| 1989 | if (!defined $email) { |
| 1990 | $email = $name; |
| 1991 | } |
| 1992 | } elsif ($name_field =~ /(.*?)\s+<(.*)>/) { |
| 1993 | ($name, $email) = ($1, $2); |
| 1994 | } elsif ($name_field =~ /(.*)@/) { |
| 1995 | ($name, $email) = ($1, $name_field); |
| 1996 | } else { |
| 1997 | ($name, $email) = ($name_field, $name_field); |
| 1998 | } |
| 1999 | } |
| 2000 | if (defined $headrev && $self->use_svm_props) { |
| 2001 | if ($self->rewrite_root) { |
| 2002 | die "Can't have both 'useSvmProps' and 'rewriteRoot' ", |
| 2003 | "options set!\n"; |
| 2004 | } |
| 2005 | if ($self->rewrite_uuid) { |
| 2006 | die "Can't have both 'useSvmProps' and 'rewriteUUID' ", |
| 2007 | "options set!\n"; |
| 2008 | } |
| 2009 | my ($uuid, $r) = $headrev =~ m{^([a-f\d\-]{30,}):(\d+)$}i; |
| 2010 | # we don't want "SVM: initializing mirror for junk" ... |
| 2011 | return undef if $r == 0; |
| 2012 | my $svm = $self->svm; |
| 2013 | if ($uuid ne $svm->{uuid}) { |
| 2014 | die "UUID mismatch on SVM path:\n", |
| 2015 | "expected: $svm->{uuid}\n", |
| 2016 | " got: $uuid\n"; |
| 2017 | } |
| 2018 | my $full_url = $self->full_url; |
| 2019 | $full_url =~ s#^\Q$svm->{replace}\E(/|$)#$svm->{source}$1# or |
| 2020 | die "Failed to replace '$svm->{replace}' with ", |
| 2021 | "'$svm->{source}' in $full_url\n"; |
| 2022 | # throw away username for storing in records |
| 2023 | remove_username($full_url); |
| 2024 | $log_entry{metadata} = "$full_url\@$r $uuid"; |
| 2025 | $log_entry{svm_revision} = $r; |
Andreas Heiduk | cb427e9 | 2018-03-24 11:20:46 +0100 | [diff] [blame] | 2026 | $email = "$author\@$uuid" unless defined $email; |
| 2027 | $commit_email = "$author\@$uuid" unless defined $commit_email; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2028 | } elsif ($self->use_svnsync_props) { |
Michael G. Schwern | 705b49c | 2012-07-28 02:47:51 -0700 | [diff] [blame] | 2029 | my $full_url = canonicalize_url( |
| 2030 | add_path_to_url( $self->svnsync->{url}, $self->path ) |
| 2031 | ); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2032 | remove_username($full_url); |
| 2033 | my $uuid = $self->svnsync->{uuid}; |
| 2034 | $log_entry{metadata} = "$full_url\@$rev $uuid"; |
Andreas Heiduk | cb427e9 | 2018-03-24 11:20:46 +0100 | [diff] [blame] | 2035 | $email = "$author\@$uuid" unless defined $email; |
| 2036 | $commit_email = "$author\@$uuid" unless defined $commit_email; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2037 | } else { |
| 2038 | my $url = $self->metadata_url; |
| 2039 | remove_username($url); |
| 2040 | my $uuid = $self->rewrite_uuid || $self->ra->get_uuid; |
| 2041 | $log_entry{metadata} = "$url\@$rev " . $uuid; |
Andreas Heiduk | cb427e9 | 2018-03-24 11:20:46 +0100 | [diff] [blame] | 2042 | $email = "$author\@$uuid" unless defined $email; |
| 2043 | $commit_email = "$author\@$uuid" unless defined $commit_email; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2044 | } |
| 2045 | $log_entry{name} = $name; |
| 2046 | $log_entry{email} = $email; |
| 2047 | $log_entry{commit_name} = $commit_name; |
| 2048 | $log_entry{commit_email} = $commit_email; |
| 2049 | \%log_entry; |
| 2050 | } |
| 2051 | |
| 2052 | sub fetch { |
| 2053 | my ($self, $min_rev, $max_rev, @parents) = @_; |
| 2054 | my ($last_rev, $last_commit) = $self->last_rev_commit; |
| 2055 | my ($base, $head) = $self->get_fetch_range($min_rev, $max_rev); |
| 2056 | $self->ra->gs_fetch_loop_common($base, $head, [$self]); |
| 2057 | } |
| 2058 | |
| 2059 | sub set_tree_cb { |
| 2060 | my ($self, $log_entry, $tree, $rev, $date, $author) = @_; |
| 2061 | $self->{inject_parents} = { $rev => $tree }; |
| 2062 | $self->fetch(undef, undef); |
| 2063 | } |
| 2064 | |
| 2065 | sub set_tree { |
| 2066 | my ($self, $tree) = (shift, shift); |
| 2067 | my $log_entry = ::get_commit_entry($tree); |
| 2068 | unless ($self->{last_rev}) { |
| 2069 | fatal("Must have an existing revision to commit"); |
| 2070 | } |
| 2071 | my %ed_opts = ( r => $self->{last_rev}, |
| 2072 | log => $log_entry->{log}, |
| 2073 | ra => $self->ra, |
| 2074 | tree_a => $self->{last_commit}, |
| 2075 | tree_b => $tree, |
| 2076 | editor_cb => sub { |
| 2077 | $self->set_tree_cb($log_entry, $tree, @_) }, |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 2078 | svn_path => $self->path ); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2079 | if (!Git::SVN::Editor->new(\%ed_opts)->apply_diff) { |
| 2080 | print "No changes\nr$self->{last_rev} = $tree\n"; |
| 2081 | } |
| 2082 | } |
| 2083 | |
| 2084 | sub rebuild_from_rev_db { |
| 2085 | my ($self, $path) = @_; |
| 2086 | my $r = -1; |
| 2087 | open my $fh, '<', $path or croak "open: $!"; |
| 2088 | binmode $fh or croak "binmode: $!"; |
| 2089 | while (<$fh>) { |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2090 | length($_) == $::oid_length + 1 or croak "inconsistent size in ($_)"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2091 | chomp($_); |
| 2092 | ++$r; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2093 | next if $_ eq ('0' x $::oid_length); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2094 | $self->rev_map_set($r, $_); |
| 2095 | print "r$r = $_\n"; |
| 2096 | } |
| 2097 | close $fh or croak "close: $!"; |
| 2098 | unlink $path or croak "unlink: $!"; |
| 2099 | } |
| 2100 | |
lin zuojian | ab0bcec | 2014-01-23 10:15:19 +0800 | [diff] [blame] | 2101 | #define a global associate map to record rebuild status |
| 2102 | my %rebuild_status; |
| 2103 | #define a global associate map to record rebuild verify status |
| 2104 | my %rebuild_verify_status; |
| 2105 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2106 | sub rebuild { |
| 2107 | my ($self) = @_; |
| 2108 | my $map_path = $self->map_path; |
| 2109 | my $partial = (-e $map_path && ! -z $map_path); |
lin zuojian | ab0bcec | 2014-01-23 10:15:19 +0800 | [diff] [blame] | 2110 | my $verify_key = $self->refname.'^0'; |
| 2111 | if (!$rebuild_verify_status{$verify_key}) { |
| 2112 | my $verify_result = ::verify_ref($verify_key); |
| 2113 | if ($verify_result) { |
| 2114 | $rebuild_verify_status{$verify_key} = 1; |
| 2115 | } |
| 2116 | } |
| 2117 | if (!$rebuild_verify_status{$verify_key}) { |
| 2118 | return; |
| 2119 | } |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2120 | if (!$partial && ($self->use_svm_props || $self->no_metadata)) { |
| 2121 | my $rev_db = $self->rev_db_path; |
| 2122 | $self->rebuild_from_rev_db($rev_db); |
| 2123 | if ($self->use_svm_props) { |
| 2124 | my $svm_rev_db = $self->rev_db_path($self->svm_uuid); |
| 2125 | $self->rebuild_from_rev_db($svm_rev_db); |
| 2126 | } |
| 2127 | $self->unlink_rev_db_symlink; |
| 2128 | return; |
| 2129 | } |
| 2130 | print "Rebuilding $map_path ...\n" if (!$partial); |
| 2131 | my ($base_rev, $head) = ($partial ? $self->rev_map_max_norebuild(1) : |
| 2132 | (undef, undef)); |
lin zuojian | ab0bcec | 2014-01-23 10:15:19 +0800 | [diff] [blame] | 2133 | my $key_value = ($head ? "$head.." : "") . $self->refname; |
| 2134 | if (exists $rebuild_status{$key_value}) { |
| 2135 | print "Done rebuilding $map_path\n" if (!$partial || !$head); |
| 2136 | my $rev_db_path = $self->rev_db_path; |
| 2137 | if (-f $self->rev_db_path) { |
| 2138 | unlink $self->rev_db_path or croak "unlink: $!"; |
| 2139 | } |
| 2140 | $self->unlink_rev_db_symlink; |
| 2141 | return; |
| 2142 | } |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2143 | my ($log, $ctx) = |
lin zuojian | ab0bcec | 2014-01-23 10:15:19 +0800 | [diff] [blame] | 2144 | command_output_pipe(qw/rev-list --pretty=raw --reverse/, |
| 2145 | $key_value, |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2146 | '--'); |
lin zuojian | ab0bcec | 2014-01-23 10:15:19 +0800 | [diff] [blame] | 2147 | $rebuild_status{$key_value} = 1; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2148 | my $metadata_url = $self->metadata_url; |
| 2149 | remove_username($metadata_url); |
| 2150 | my $svn_uuid = $self->rewrite_uuid || $self->ra_uuid; |
| 2151 | my $c; |
| 2152 | while (<$log>) { |
brian m. carlson | 9ab3315 | 2020-06-22 18:04:12 +0000 | [diff] [blame] | 2153 | if ( m{^commit ($::oid)$} ) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2154 | $c = $1; |
| 2155 | next; |
| 2156 | } |
| 2157 | next unless s{^\s*(git-svn-id:)}{$1}; |
| 2158 | my ($url, $rev, $uuid) = ::extract_metadata($_); |
| 2159 | remove_username($url); |
| 2160 | |
| 2161 | # ignore merges (from set-tree) |
| 2162 | next if (!defined $rev || !$uuid); |
| 2163 | |
| 2164 | # if we merged or otherwise started elsewhere, this is |
| 2165 | # how we break out of it |
| 2166 | if (($uuid ne $svn_uuid) || |
| 2167 | ($metadata_url && $url && ($url ne $metadata_url))) { |
| 2168 | next; |
| 2169 | } |
| 2170 | if ($partial && $head) { |
| 2171 | print "Partial-rebuilding $map_path ...\n"; |
| 2172 | print "Currently at $base_rev = $head\n"; |
| 2173 | $head = undef; |
| 2174 | } |
| 2175 | |
| 2176 | $self->rev_map_set($rev, $c); |
| 2177 | print "r$rev = $c\n"; |
| 2178 | } |
| 2179 | command_close_pipe($log, $ctx); |
| 2180 | print "Done rebuilding $map_path\n" if (!$partial || !$head); |
| 2181 | my $rev_db_path = $self->rev_db_path; |
| 2182 | if (-f $self->rev_db_path) { |
| 2183 | unlink $self->rev_db_path or croak "unlink: $!"; |
| 2184 | } |
| 2185 | $self->unlink_rev_db_symlink; |
| 2186 | } |
| 2187 | |
| 2188 | # rev_map: |
| 2189 | # Tie::File seems to be prone to offset errors if revisions get sparse, |
| 2190 | # it's not that fast, either. Tie::File is also not in Perl 5.6. So |
| 2191 | # one of my favorite modules is out :< Next up would be one of the DBM |
| 2192 | # modules, but I'm not sure which is most portable... |
| 2193 | # |
| 2194 | # This is the replacement for the rev_db format, which was too big |
| 2195 | # and inefficient for large repositories with a lot of sparse history |
| 2196 | # (mainly tags) |
| 2197 | # |
| 2198 | # The format is this: |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2199 | # - 24 or 36 bytes for every record, |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2200 | # * 4 bytes for the integer representing an SVN revision number |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2201 | # * 20 or 32 bytes representing the oid of a git commit |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2202 | # - No empty padding records like the old format |
| 2203 | # (except the last record, which can be overwritten) |
| 2204 | # - new records are written append-only since SVN revision numbers |
| 2205 | # increase monotonically |
| 2206 | # - lookups on SVN revision number are done via a binary search |
| 2207 | # - Piping the file to xxd -c24 is a good way of dumping it for |
| 2208 | # viewing or editing (piped back through xxd -r), should the need |
| 2209 | # ever arise. |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2210 | # - The last record can be padding revision with an all-zero oid |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2211 | # This is used to optimize fetch performance when using multiple |
| 2212 | # "fetch" directives in .git/config |
| 2213 | # |
| 2214 | # These files are disposable unless noMetadata or useSvmProps is set |
| 2215 | |
| 2216 | sub _rev_map_set { |
| 2217 | my ($fh, $rev, $commit) = @_; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2218 | my $record_size = ($::oid_length / 2) + 4; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2219 | |
| 2220 | binmode $fh or croak "binmode: $!"; |
| 2221 | my $size = (stat($fh))[7]; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2222 | ($size % $record_size) == 0 or croak "inconsistent size: $size"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2223 | |
| 2224 | my $wr_offset = 0; |
| 2225 | if ($size > 0) { |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2226 | sysseek($fh, -$record_size, SEEK_END) or croak "seek: $!"; |
| 2227 | my $read = sysread($fh, my $buf, $record_size) or croak "read: $!"; |
| 2228 | $read == $record_size or croak "read only $read bytes (!= $record_size)"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2229 | my ($last_rev, $last_commit) = unpack(rev_map_fmt, $buf); |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2230 | if ($last_commit eq ('0' x $::oid_length)) { |
| 2231 | if ($size >= ($record_size * 2)) { |
| 2232 | sysseek($fh, -($record_size * 2), SEEK_END) or croak "seek: $!"; |
| 2233 | $read = sysread($fh, $buf, $record_size) or |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2234 | croak "read: $!"; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2235 | $read == $record_size or |
| 2236 | croak "read only $read bytes (!= $record_size)"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2237 | ($last_rev, $last_commit) = |
| 2238 | unpack(rev_map_fmt, $buf); |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2239 | if ($last_commit eq ('0' x $::oid_length)) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2240 | croak "inconsistent .rev_map\n"; |
| 2241 | } |
| 2242 | } |
| 2243 | if ($last_rev >= $rev) { |
| 2244 | croak "last_rev is higher!: $last_rev >= $rev"; |
| 2245 | } |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2246 | $wr_offset = -$record_size; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2247 | } |
| 2248 | } |
| 2249 | sysseek($fh, $wr_offset, SEEK_END) or croak "seek: $!"; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2250 | syswrite($fh, pack(rev_map_fmt, $rev, $commit), $record_size) == $record_size or |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2251 | croak "write: $!"; |
| 2252 | } |
| 2253 | |
| 2254 | sub _rev_map_reset { |
| 2255 | my ($fh, $rev, $commit) = @_; |
| 2256 | my $c = _rev_map_get($fh, $rev); |
| 2257 | $c eq $commit or die "_rev_map_reset(@_) commit $c does not match!\n"; |
| 2258 | my $offset = sysseek($fh, 0, SEEK_CUR) or croak "seek: $!"; |
| 2259 | truncate $fh, $offset or croak "truncate: $!"; |
| 2260 | } |
| 2261 | |
| 2262 | sub mkfile { |
| 2263 | my ($path) = @_; |
| 2264 | unless (-e $path) { |
| 2265 | my ($dir, $base) = ($path =~ m#^(.*?)/?([^/]+)$#); |
| 2266 | mkpath([$dir]) unless -d $dir; |
| 2267 | open my $fh, '>>', $path or die "Couldn't create $path: $!\n"; |
| 2268 | close $fh or die "Couldn't close (create) $path: $!\n"; |
| 2269 | } |
| 2270 | } |
| 2271 | |
Eric Wong | 412e4ca | 2021-10-29 00:15:52 +0000 | [diff] [blame] | 2272 | # TODO: move this to Git.pm? |
| 2273 | sub use_fsync { |
| 2274 | if (!defined($_use_fsync)) { |
| 2275 | my $x = $ENV{GIT_TEST_FSYNC}; |
| 2276 | if (defined $x) { |
| 2277 | my $v = command_oneline('-c', "test.fsync=$x", |
| 2278 | qw(config --type=bool test.fsync)); |
| 2279 | $_use_fsync = defined($v) ? ($v eq "true\n") : 1; |
| 2280 | } |
| 2281 | } |
| 2282 | $_use_fsync; |
| 2283 | } |
| 2284 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2285 | sub rev_map_set { |
| 2286 | my ($self, $rev, $commit, $update_ref, $uuid) = @_; |
| 2287 | defined $commit or die "missing arg3\n"; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2288 | $commit =~ /^$::oid$/ or die "arg3 must be a full hex object ID\n"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2289 | my $db = $self->map_path($uuid); |
| 2290 | my $db_lock = "$db.lock"; |
| 2291 | my $sigmask; |
| 2292 | $update_ref ||= 0; |
| 2293 | if ($update_ref) { |
| 2294 | $sigmask = POSIX::SigSet->new(); |
| 2295 | my $signew = POSIX::SigSet->new(SIGINT, SIGHUP, SIGTERM, |
| 2296 | SIGALRM, SIGUSR1, SIGUSR2); |
| 2297 | sigprocmask(SIG_BLOCK, $signew, $sigmask) or |
| 2298 | croak "Can't block signals: $!"; |
| 2299 | } |
| 2300 | mkfile($db); |
| 2301 | |
| 2302 | $LOCKFILES{$db_lock} = 1; |
| 2303 | my $sync; |
| 2304 | # both of these options make our .rev_db file very, very important |
| 2305 | # and we can't afford to lose it because rebuild() won't work |
Eric Wong | 412e4ca | 2021-10-29 00:15:52 +0000 | [diff] [blame] | 2306 | if (($self->use_svm_props || $self->no_metadata) && use_fsync()) { |
Eric Wong | 47092c1 | 2015-01-15 08:54:22 +0000 | [diff] [blame] | 2307 | require File::Copy; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2308 | $sync = 1; |
Eric Wong | 47092c1 | 2015-01-15 08:54:22 +0000 | [diff] [blame] | 2309 | File::Copy::copy($db, $db_lock) or die "rev_map_set(@_): ", |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2310 | "Failed to copy: ", |
| 2311 | "$db => $db_lock ($!)\n"; |
| 2312 | } else { |
| 2313 | rename $db, $db_lock or die "rev_map_set(@_): ", |
| 2314 | "Failed to rename: ", |
| 2315 | "$db => $db_lock ($!)\n"; |
| 2316 | } |
| 2317 | |
| 2318 | sysopen(my $fh, $db_lock, O_RDWR | O_CREAT) |
| 2319 | or croak "Couldn't open $db_lock: $!\n"; |
Peter Baumann | 61b472e | 2012-08-09 08:42:53 +0200 | [diff] [blame] | 2320 | if ($update_ref eq 'reset') { |
| 2321 | clear_memoized_mergeinfo_caches(); |
| 2322 | _rev_map_reset($fh, $rev, $commit); |
| 2323 | } else { |
| 2324 | _rev_map_set($fh, $rev, $commit); |
| 2325 | } |
| 2326 | |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2327 | if ($sync) { |
| 2328 | $fh->flush or die "Couldn't flush $db_lock: $!\n"; |
| 2329 | $fh->sync or die "Couldn't sync $db_lock: $!\n"; |
| 2330 | } |
| 2331 | close $fh or croak $!; |
| 2332 | if ($update_ref) { |
| 2333 | $_head = $self; |
| 2334 | my $note = ""; |
| 2335 | $note = " ($update_ref)" if ($update_ref !~ /^\d*$/); |
| 2336 | command_noisy('update-ref', '-m', "r$rev$note", |
| 2337 | $self->refname, $commit); |
| 2338 | } |
| 2339 | rename $db_lock, $db or die "rev_map_set(@_): ", "Failed to rename: ", |
| 2340 | "$db_lock => $db ($!)\n"; |
| 2341 | delete $LOCKFILES{$db_lock}; |
| 2342 | if ($update_ref) { |
| 2343 | sigprocmask(SIG_SETMASK, $sigmask) or |
| 2344 | croak "Can't restore signal mask: $!"; |
| 2345 | } |
| 2346 | } |
| 2347 | |
| 2348 | # If want_commit, this will return an array of (rev, commit) where |
| 2349 | # commit _must_ be a valid commit in the archive. |
| 2350 | # Otherwise, it'll return the max revision (whether or not the |
| 2351 | # commit is valid or just a 0x40 placeholder). |
| 2352 | sub rev_map_max { |
| 2353 | my ($self, $want_commit) = @_; |
| 2354 | $self->rebuild; |
| 2355 | my ($r, $c) = $self->rev_map_max_norebuild($want_commit); |
| 2356 | $want_commit ? ($r, $c) : $r; |
| 2357 | } |
| 2358 | |
| 2359 | sub rev_map_max_norebuild { |
| 2360 | my ($self, $want_commit) = @_; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2361 | my $record_size = ($::oid_length / 2) + 4; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2362 | my $map_path = $self->map_path; |
| 2363 | stat $map_path or return $want_commit ? (0, undef) : 0; |
| 2364 | sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!"; |
| 2365 | binmode $fh or croak "binmode: $!"; |
| 2366 | my $size = (stat($fh))[7]; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2367 | ($size % $record_size) == 0 or croak "inconsistent size: $size"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2368 | |
| 2369 | if ($size == 0) { |
| 2370 | close $fh or croak "close: $!"; |
| 2371 | return $want_commit ? (0, undef) : 0; |
| 2372 | } |
| 2373 | |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2374 | sysseek($fh, -$record_size, SEEK_END) or croak "seek: $!"; |
| 2375 | sysread($fh, my $buf, $record_size) == $record_size or croak "read: $!"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2376 | my ($r, $c) = unpack(rev_map_fmt, $buf); |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2377 | if ($want_commit && $c eq ('0' x $::oid_length)) { |
| 2378 | if ($size < $record_size * 2) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2379 | return $want_commit ? (0, undef) : 0; |
| 2380 | } |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2381 | sysseek($fh, -($record_size * 2), SEEK_END) or croak "seek: $!"; |
| 2382 | sysread($fh, $buf, $record_size) == $record_size or croak "read: $!"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2383 | ($r, $c) = unpack(rev_map_fmt, $buf); |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2384 | if ($c eq ('0' x $::oid_length)) { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2385 | croak "Penultimate record is all-zeroes in $map_path"; |
| 2386 | } |
| 2387 | } |
| 2388 | close $fh or croak "close: $!"; |
| 2389 | $want_commit ? ($r, $c) : $r; |
| 2390 | } |
| 2391 | |
| 2392 | sub rev_map_get { |
| 2393 | my ($self, $rev, $uuid) = @_; |
| 2394 | my $map_path = $self->map_path($uuid); |
| 2395 | return undef unless -e $map_path; |
| 2396 | |
| 2397 | sysopen(my $fh, $map_path, O_RDONLY) or croak "open: $!"; |
| 2398 | my $c = _rev_map_get($fh, $rev); |
| 2399 | close($fh) or croak "close: $!"; |
| 2400 | $c |
| 2401 | } |
| 2402 | |
| 2403 | sub _rev_map_get { |
| 2404 | my ($fh, $rev) = @_; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2405 | my $record_size = ($::oid_length / 2) + 4; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2406 | |
| 2407 | binmode $fh or croak "binmode: $!"; |
| 2408 | my $size = (stat($fh))[7]; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2409 | ($size % $record_size) == 0 or croak "inconsistent size: $size"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2410 | |
| 2411 | if ($size == 0) { |
| 2412 | return undef; |
| 2413 | } |
| 2414 | |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2415 | my ($l, $u) = (0, $size - $record_size); |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2416 | my ($r, $c, $buf); |
| 2417 | |
| 2418 | while ($l <= $u) { |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2419 | my $i = int(($l/$record_size + $u/$record_size) / 2) * $record_size; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2420 | sysseek($fh, $i, SEEK_SET) or croak "seek: $!"; |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2421 | sysread($fh, my $buf, $record_size) == $record_size or croak "read: $!"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2422 | my ($r, $c) = unpack(rev_map_fmt, $buf); |
| 2423 | |
| 2424 | if ($r < $rev) { |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2425 | $l = $i + $record_size; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2426 | } elsif ($r > $rev) { |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2427 | $u = $i - $record_size; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2428 | } else { # $r == $rev |
brian m. carlson | 94b2ee1 | 2020-06-22 18:04:14 +0000 | [diff] [blame] | 2429 | return $c eq ('0' x $::oid_length) ? undef : $c; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2430 | } |
| 2431 | } |
| 2432 | undef; |
| 2433 | } |
| 2434 | |
| 2435 | # Finds the first svn revision that exists on (if $eq_ok is true) or |
| 2436 | # before $rev for the current branch. It will not search any lower |
| 2437 | # than $min_rev. Returns the git commit hash and svn revision number |
| 2438 | # if found, else (undef, undef). |
| 2439 | sub find_rev_before { |
| 2440 | my ($self, $rev, $eq_ok, $min_rev) = @_; |
| 2441 | --$rev unless $eq_ok; |
| 2442 | $min_rev ||= 1; |
| 2443 | my $max_rev = $self->rev_map_max; |
| 2444 | $rev = $max_rev if ($rev > $max_rev); |
| 2445 | while ($rev >= $min_rev) { |
| 2446 | if (my $c = $self->rev_map_get($rev)) { |
| 2447 | return ($rev, $c); |
| 2448 | } |
| 2449 | --$rev; |
| 2450 | } |
| 2451 | return (undef, undef); |
| 2452 | } |
| 2453 | |
| 2454 | # Finds the first svn revision that exists on (if $eq_ok is true) or |
| 2455 | # after $rev for the current branch. It will not search any higher |
| 2456 | # than $max_rev. Returns the git commit hash and svn revision number |
| 2457 | # if found, else (undef, undef). |
| 2458 | sub find_rev_after { |
| 2459 | my ($self, $rev, $eq_ok, $max_rev) = @_; |
| 2460 | ++$rev unless $eq_ok; |
| 2461 | $max_rev ||= $self->rev_map_max; |
| 2462 | while ($rev <= $max_rev) { |
| 2463 | if (my $c = $self->rev_map_get($rev)) { |
| 2464 | return ($rev, $c); |
| 2465 | } |
| 2466 | ++$rev; |
| 2467 | } |
| 2468 | return (undef, undef); |
| 2469 | } |
| 2470 | |
| 2471 | sub _new { |
| 2472 | my ($class, $repo_id, $ref_id, $path) = @_; |
| 2473 | unless (defined $repo_id && length $repo_id) { |
| 2474 | $repo_id = $default_repo_id; |
| 2475 | } |
| 2476 | unless (defined $ref_id && length $ref_id) { |
| 2477 | # Access the prefix option from the git-svn main program if it's loaded. |
| 2478 | my $prefix = defined &::opt_prefix ? ::opt_prefix() : ""; |
| 2479 | $_[2] = $ref_id = |
| 2480 | "refs/remotes/$prefix$default_ref_id"; |
| 2481 | } |
| 2482 | $_[1] = $repo_id; |
Eric Wong | 112423e | 2016-10-14 00:27:54 +0000 | [diff] [blame] | 2483 | my $svn_dir = svn_dir(); |
| 2484 | my $dir = "$svn_dir/$ref_id"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2485 | |
Eric Wong | 112423e | 2016-10-14 00:27:54 +0000 | [diff] [blame] | 2486 | # Older repos imported by us used $svn_dir/foo instead of |
| 2487 | # $svn_dir/refs/remotes/foo when tracking refs/remotes/foo |
Ramkumar Ramachandra | 9a2bb05 | 2015-01-10 09:35:10 -0500 | [diff] [blame] | 2488 | if ($ref_id =~ m{^refs/remotes/(.+)}) { |
Eric Wong | 112423e | 2016-10-14 00:27:54 +0000 | [diff] [blame] | 2489 | my $old_dir = "$svn_dir/$1"; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2490 | if (-d $old_dir && ! -d $dir) { |
| 2491 | $dir = $old_dir; |
| 2492 | } |
| 2493 | } |
| 2494 | |
| 2495 | $_[3] = $path = '' unless (defined $path); |
| 2496 | mkpath([$dir]); |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 2497 | my $obj = bless { |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2498 | ref_id => $ref_id, dir => $dir, index => "$dir/index", |
Eric Wong | 112423e | 2016-10-14 00:27:54 +0000 | [diff] [blame] | 2499 | config => "$svn_dir/config", |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2500 | map_root => "$dir/.rev_map", repo_id => $repo_id }, $class; |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 2501 | |
| 2502 | # Ensure it gets canonicalized |
| 2503 | $obj->path($path); |
| 2504 | |
| 2505 | return $obj; |
| 2506 | } |
| 2507 | |
| 2508 | sub path { |
| 2509 | my $self = shift; |
| 2510 | |
| 2511 | if (@_) { |
| 2512 | my $path = shift; |
Jonathan Nieder | 52de6fa | 2012-09-17 02:13:31 -0700 | [diff] [blame] | 2513 | $self->{_path} = canonicalize_path($path); |
Michael G. Schwern | 5578ed7 | 2012-07-27 13:00:48 -0700 | [diff] [blame] | 2514 | return; |
| 2515 | } |
| 2516 | |
Jonathan Nieder | 52de6fa | 2012-09-17 02:13:31 -0700 | [diff] [blame] | 2517 | return $self->{_path}; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2518 | } |
| 2519 | |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 2520 | sub url { |
| 2521 | my $self = shift; |
| 2522 | |
| 2523 | if (@_) { |
| 2524 | my $url = shift; |
Michael G. Schwern | 565e56c | 2012-07-28 02:38:32 -0700 | [diff] [blame] | 2525 | $self->{url} = canonicalize_url($url); |
Michael G. Schwern | 06ee19e | 2012-07-27 13:00:49 -0700 | [diff] [blame] | 2526 | return; |
| 2527 | } |
| 2528 | |
| 2529 | return $self->{url}; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2530 | } |
| 2531 | |
| 2532 | # for read-only access of old .rev_db formats |
| 2533 | sub unlink_rev_db_symlink { |
| 2534 | my ($self) = @_; |
| 2535 | my $link = $self->rev_db_path; |
| 2536 | $link =~ s/\.[\w-]+$// or croak "missing UUID at the end of $link"; |
| 2537 | if (-l $link) { |
| 2538 | unlink $link or croak "unlink: $link failed!"; |
| 2539 | } |
| 2540 | } |
| 2541 | |
| 2542 | sub rev_db_path { |
| 2543 | my ($self, $uuid) = @_; |
| 2544 | my $db_path = $self->map_path($uuid); |
| 2545 | $db_path =~ s{/\.rev_map\.}{/\.rev_db\.} |
| 2546 | or croak "map_path: $db_path does not contain '/.rev_map.' !"; |
| 2547 | $db_path; |
| 2548 | } |
| 2549 | |
| 2550 | # the new replacement for .rev_db |
| 2551 | sub map_path { |
| 2552 | my ($self, $uuid) = @_; |
| 2553 | $uuid ||= $self->ra_uuid; |
| 2554 | "$self->{map_root}.$uuid"; |
| 2555 | } |
| 2556 | |
| 2557 | sub uri_encode { |
| 2558 | my ($f) = @_; |
Eric Wong | 1b67bef | 2013-01-24 00:23:44 +0000 | [diff] [blame] | 2559 | $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#sprintf("%%%02X",ord($1))#eg; |
Michael G. Schwern | 29499c0 | 2012-07-26 16:22:24 -0700 | [diff] [blame] | 2560 | $f |
| 2561 | } |
| 2562 | |
| 2563 | sub uri_decode { |
| 2564 | my ($f) = @_; |
| 2565 | $f =~ s#%([0-9a-fA-F]{2})#chr(hex($1))#eg; |
| 2566 | $f |
| 2567 | } |
| 2568 | |
| 2569 | sub remove_username { |
| 2570 | $_[0] =~ s{^([^:]*://)[^@]+@}{$1}; |
| 2571 | } |
| 2572 | |
| 2573 | 1; |