fcef05c2eec30a116cb7d7a44d3d5ebf087759a2
1#!/usr/bin/env perl
2# Copyright (C) 2006, Eric Wong <normalperson@yhbt.net>
3# License: GPL v2 or later
4use warnings;
5use strict;
6use vars qw/ $AUTHOR $VERSION
7 $SVN_URL $SVN_INFO $SVN_WC $SVN_UUID
8 $GIT_SVN_INDEX $GIT_SVN
9 $GIT_DIR $GIT_SVN_DIR $REVDB/;
10$AUTHOR = 'Eric Wong <normalperson@yhbt.net>';
11$VERSION = '@@GIT_VERSION@@';
12use Cwd qw/abs_path/;
14$GIT_DIR = abs_path($ENV{GIT_DIR} || '.git');
15$ENV{GIT_DIR} = $GIT_DIR;
16my $LC_ALL = $ENV{LC_ALL};
18my $TZ = $ENV{TZ};
19# make sure the svn binary gives consistent output between locales and TZs:
20$ENV{TZ} = 'UTC';
21$ENV{LC_ALL} = 'C';
22$| = 1; # unbuffer STDOUT
23# properties that we do not log:
25my %SKIP = ( 'svn:wc:ra_dav:version-url' => 1,
26 'svn:special' => 1,
27 'svn:executable' => 1,
28 'svn:entry:committed-rev' => 1,
29 'svn:entry:last-author' => 1,
30 'svn:entry:uuid' => 1,
31 'svn:entry:committed-date' => 1,
32);
33sub fatal (@) { print STDERR @_; exit 1 }
35require SVN::Core; # use()-ing this causes segfaults for me... *shrug*
36require SVN::Ra;
37require SVN::Delta;
38if ($SVN::Core::VERSION lt '1.1.0') {
39 fatal "Need SVN::Core 1.1.0 or better (got $SVN::Core::VERSION)\n";
40}
41push @SVN::Git::Editor::ISA, 'SVN::Delta::Editor';
42push @SVN::Git::Fetcher::ISA, 'SVN::Delta::Editor';
43use Carp qw/croak/;
44use IO::File qw//;
45use File::Basename qw/dirname basename/;
46use File::Path qw/mkpath/;
47use Getopt::Long qw/:config gnu_getopt no_ignore_case auto_abbrev pass_through/;
48use POSIX qw/strftime/;
49use IPC::Open3;
50use Memoize;
51use Git qw/command command_oneline command_noisy
52 command_output_pipe command_input_pipe command_close_pipe/;
53memoize('revisions_eq');
54memoize('cmt_metadata');
55memoize('get_commit_time');
56my ($SVN);
58my $_optimize_commits = 1 unless $ENV{GIT_SVN_NO_OPTIMIZE_COMMITS};
60my $sha1 = qr/[a-f\d]{40}/;
61my $sha1_short = qr/[a-f\d]{4,40}/;
62my $_esc_color = qr/(?:\033\[(?:(?:\d+;)*\d*)?m)*/;
63my ($_revision,$_stdin,$_no_ignore_ext,$_no_stop_copy,$_help,$_rmdir,$_edit,
64 $_find_copies_harder, $_l, $_cp_similarity, $_cp_remote,
65 $_repack, $_repack_nr, $_repack_flags, $_q,
66 $_message, $_file, $_follow_parent, $_no_metadata,
67 $_template, $_shared, $_no_default_regex, $_no_graft_copy,
68 $_limit, $_verbose, $_incremental, $_oneline, $_l_fmt, $_show_commit,
69 $_version, $_upgrade, $_authors, $_branch_all_refs, @_opt_m,
70 $_merge, $_strategy, $_dry_run, $_ignore_nodate, $_non_recursive,
71 $_config_dir,
72 $_pager, $_color, $_prefix);
73my (@_branch_from, %tree_map, %users, %rusers, %equiv);
74my ($_svn_can_do_switch);
75my @repo_path_split_cache;
76my %fc_opts = ( 'no-ignore-externals' => \$_no_ignore_ext,
78 'branch|b=s' => \@_branch_from,
79 'follow-parent|follow' => \$_follow_parent,
80 'branch-all-refs|B' => \$_branch_all_refs,
81 'authors-file|A=s' => \$_authors,
82 'repack:i' => \$_repack,
83 'no-metadata' => \$_no_metadata,
84 'quiet|q' => \$_q,
85 'username=s' => \$Git::SVN::Prompt::_username,
86 'config-dir=s' => \$_config_dir,
87 'no-auth-cache' => \$Git::SVN::Prompt::_no_auth_cache,
88 'ignore-nodate' => \$_ignore_nodate,
89 'repack-flags|repack-args|repack-opts=s' => \$_repack_flags);
90my ($_trunk, $_tags, $_branches);
92my %multi_opts = ( 'trunk|T=s' => \$_trunk,
93 'tags|t=s' => \$_tags,
94 'branches|b=s' => \$_branches );
95my %init_opts = ( 'template=s' => \$_template, 'shared' => \$_shared );
96my %cmt_opts = ( 'edit|e' => \$_edit,
97 'rmdir' => \$_rmdir,
98 'find-copies-harder' => \$_find_copies_harder,
99 'l=i' => \$_l,
100 'copy-similarity|C=i'=> \$_cp_similarity
101);
102my %cmd = (
104 fetch => [ \&cmd_fetch, "Download new revisions from SVN",
105 { 'revision|r=s' => \$_revision, %fc_opts } ],
106 init => [ \&init, "Initialize a repo for tracking" .
107 " (requires URL argument)",
108 \%init_opts ],
109 dcommit => [ \&dcommit, 'Commit several diffs to merge with upstream',
110 { 'merge|m|M' => \$_merge,
111 'strategy|s=s' => \$_strategy,
112 'dry-run|n' => \$_dry_run,
113 %cmt_opts, %fc_opts } ],
114 'set-tree' => [ \&commit, "Set an SVN repository to a git tree-ish",
115 { 'stdin|' => \$_stdin, %cmt_opts, %fc_opts, } ],
116 'show-ignore' => [ \&show_ignore, "Show svn:ignore listings",
117 { 'revision|r=i' => \$_revision } ],
118 rebuild => [ \&rebuild, "Rebuild git-svn metadata (after git clone)",
119 { 'no-ignore-externals' => \$_no_ignore_ext,
120 'copy-remote|remote=s' => \$_cp_remote,
121 'upgrade' => \$_upgrade } ],
122 'graft-branches' => [ \&graft_branches,
123 'Detect merges/branches from already imported history',
124 { 'merge-rx|m' => \@_opt_m,
125 'branch|b=s' => \@_branch_from,
126 'branch-all-refs|B' => \$_branch_all_refs,
127 'no-default-regex' => \$_no_default_regex,
128 'no-graft-copy' => \$_no_graft_copy } ],
129 'multi-init' => [ \&multi_init,
130 'Initialize multiple trees (like git-svnimport)',
131 { %multi_opts, %init_opts,
132 'revision|r=i' => \$_revision,
133 'username=s' => \$Git::SVN::Prompt::_username,
134 'config-dir=s' => \$_config_dir,
135 'no-auth-cache' => \$Git::SVN::Prompt::_no_auth_cache,
136 'prefix=s' => \$_prefix,
137 } ],
138 'multi-fetch' => [ \&multi_fetch,
139 'Fetch multiple trees (like git-svnimport)',
140 \%fc_opts ],
141 'log' => [ \&show_log, 'Show commit logs',
142 { 'limit=i' => \$_limit,
143 'revision|r=s' => \$_revision,
144 'verbose|v' => \$_verbose,
145 'incremental' => \$_incremental,
146 'oneline' => \$_oneline,
147 'show-commit' => \$_show_commit,
148 'non-recursive' => \$_non_recursive,
149 'authors-file|A=s' => \$_authors,
150 'color' => \$_color,
151 'pager=s' => \$_pager,
152 } ],
153 'commit-diff' => [ \&commit_diff, 'Commit a diff between two trees',
154 { 'message|m=s' => \$_message,
155 'file|F=s' => \$_file,
156 'revision|r=s' => \$_revision,
157 %cmt_opts } ],
158);
159my $cmd;
161for (my $i = 0; $i < @ARGV; $i++) {
162 if (defined $cmd{$ARGV[$i]}) {
163 $cmd = $ARGV[$i];
164 splice @ARGV, $i, 1;
165 last;
166 }
167};
168my %opts = %{$cmd{$cmd}->[2]} if (defined $cmd);
170read_repo_config(\%opts);
172my $rv = GetOptions(%opts, 'help|H|h' => \$_help,
173 'version|V' => \$_version,
174 'id|i=s' => \$GIT_SVN);
175exit 1 if (!$rv && $cmd ne 'log');
176set_default_vals();
178usage(0) if $_help;
179version() if $_version;
180usage(1) unless defined $cmd;
181init_vars();
182load_authors() if $_authors;
183load_all_refs() if $_branch_all_refs;
184migration_check() unless $cmd =~ /^(?:init|rebuild|multi-init|commit-diff)$/;
185$cmd{$cmd}->[0]->(@ARGV);
186exit 0;
187####################### primary functions ######################
189sub usage {
190 my $exit = shift || 0;
191 my $fd = $exit ? \*STDERR : \*STDOUT;
192 print $fd <<"";
193git-svn - bidirectional operations between a single Subversion tree and git
194Usage: $0 <command> [options] [arguments]\n
195 print $fd "Available commands:\n" unless $cmd;
197 foreach (sort keys %cmd) {
199 next if $cmd && $cmd ne $_;
200 print $fd ' ',pack('A17',$_),$cmd{$_}->[1],"\n";
201 foreach (keys %{$cmd{$_}->[2]}) {
202 # prints out arguments as they should be passed:
203 my $x = s#[:=]s$## ? '<arg>' : s#[:=]i$## ? '<num>' : '';
204 print $fd ' ' x 21, join(', ', map { length $_ > 1 ?
205 "--$_" : "-$_" }
206 split /\|/,$_)," $x\n";
207 }
208 }
209 print $fd <<"";
210\nGIT_SVN_ID may be set in the environment or via the --id/-i switch to an
211arbitrary identifier if you're tracking multiple SVN branches/repositories in
212one git repository and want to keep them separate. See git-svn(1) for more
213information.
214 exit $exit;
216}
217sub version {
219 print "git-svn version $VERSION (svn $SVN::Core::VERSION)\n";
220 exit 0;
221}
222sub rebuild {
224 if (!verify_ref("refs/remotes/$GIT_SVN^0")) {
225 copy_remote_ref();
226 }
227 $SVN_URL = shift or undef;
228 my $newest_rev = 0;
229 if ($_upgrade) {
230 command_noisy('update-ref',"refs/remotes/$GIT_SVN","
231 $GIT_SVN-HEAD");
232 } else {
233 check_upgrade_needed();
234 }
235 my ($rev_list, $ctx) = command_output_pipe("rev-list",
237 "refs/remotes/$GIT_SVN");
238 my $latest;
239 while (<$rev_list>) {
240 chomp;
241 my $c = $_;
242 croak "Non-SHA1: $c\n" unless $c =~ /^$sha1$/o;
243 my @commit = grep(/^git-svn-id: /,
244 command(qw/cat-file commit/, $c));
245 next if (!@commit); # skip merges
246 my ($url, $rev, $uuid) = extract_metadata($commit[$#commit]);
247 if (!defined $rev || !$uuid) {
248 croak "Unable to extract revision or UUID from ",
249 "$c, $commit[$#commit]\n";
250 }
251 # if we merged or otherwise started elsewhere, this is
253 # how we break out of it
254 next if (defined $SVN_UUID && ($uuid ne $SVN_UUID));
255 next if (defined $SVN_URL && defined $url && ($url ne $SVN_URL));
256 unless (defined $latest) {
258 if (!$SVN_URL && !$url) {
259 croak "SVN repository location required: $url\n";
260 }
261 $SVN_URL ||= $url;
262 $SVN_UUID ||= $uuid;
263 setup_git_svn();
264 $latest = $rev;
265 }
266 revdb_set($REVDB, $rev, $c);
267 print "r$rev = $c\n";
268 $newest_rev = $rev if ($rev > $newest_rev);
269 }
270 command_close_pipe($rev_list, $ctx);
271}
272sub init {
274 my $url = shift or die "SVN repository location required " .
275 "as a command-line argument\n";
276 $url =~ s!/+$!!; # strip trailing slash
277 if (my $repo_path = shift) {
279 unless (-d $repo_path) {
280 mkpath([$repo_path]);
281 }
282 $GIT_DIR = $ENV{GIT_DIR} = $repo_path . "/.git";
283 init_vars();
284 }
285 $SVN_URL = $url;
287 unless (-d $GIT_DIR) {
288 my @init_db = ('init');
289 push @init_db, "--template=$_template" if defined $_template;
290 push @init_db, "--shared" if defined $_shared;
291 command_noisy(@init_db);
292 }
293 setup_git_svn();
294}
295sub cmd_fetch {
297 fetch_child_id($GIT_SVN, @_);
298}
299sub fetch {
301 check_upgrade_needed();
302 $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
303 my $ret = fetch_lib(@_);
304 if ($ret->{commit} && !verify_ref('refs/heads/master^0')) {
305 command_noisy(qw(update-ref refs/heads/master),$ret->{commit});
306 }
307 return $ret;
308}
309sub fetch_lib {
311 my (@parents) = @_;
312 $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
313 $SVN ||= libsvn_connect($SVN_URL);
314 my ($last_rev, $last_commit) = svn_grab_base_rev();
315 my ($base, $head) = libsvn_parse_revision($last_rev);
316 if ($base > $head) {
317 return { revision => $last_rev, commit => $last_commit }
318 }
319 my $index = set_index($GIT_SVN_INDEX);
320 # limit ourselves and also fork() since get_log won't release memory
322 # after processing a revision and SVN stuff seems to leak
323 my $inc = 1000;
324 my ($min, $max) = ($base, $head < $base+$inc ? $head : $base+$inc);
325 read_uuid();
326 if (defined $last_commit) {
327 unless (-e $GIT_SVN_INDEX) {
328 command_noisy('read-tree', $last_commit);
329 }
330 my $x = command_oneline('write-tree');
331 my ($y) = (command(qw/cat-file commit/, $last_commit)
332 =~ /^tree ($sha1)/m);
333 if ($y ne $x) {
334 unlink $GIT_SVN_INDEX or croak $!;
335 command_noisy('read-tree', $last_commit);
336 }
337 $x = command_oneline('write-tree');
338 if ($y ne $x) {
339 print STDERR "trees ($last_commit) $y != $x\n",
340 "Something is seriously wrong...\n";
341 }
342 }
343 while (1) {
344 # fork, because using SVN::Pool with get_log() still doesn't
345 # seem to help enough to keep memory usage down.
346 defined(my $pid = fork) or croak $!;
347 if (!$pid) {
348 $SVN::Error::handler = \&libsvn_skip_unknown_revs;
349 # Yes I'm perfectly aware that the fourth argument
351 # below is the limit revisions number. Unfortunately
352 # performance sucks with it enabled, so it's much
353 # faster to fetch revision ranges instead of relying
354 # on the limiter.
355 libsvn_get_log(libsvn_dup_ra($SVN), [''],
356 $min, $max, 0, 1, 1,
357 sub {
358 my $log_msg;
359 if ($last_commit) {
360 $log_msg = libsvn_fetch(
361 $last_commit, @_);
362 $last_commit = git_commit(
363 $log_msg,
364 $last_commit,
365 @parents);
366 } else {
367 $log_msg = libsvn_new_tree(@_);
368 $last_commit = git_commit(
369 $log_msg, @parents);
370 }
371 });
372 exit 0;
373 }
374 waitpid $pid, 0;
375 croak $? if $?;
376 ($last_rev, $last_commit) = svn_grab_base_rev();
377 last if ($max >= $head);
378 $min = $max + 1;
379 $max += $inc;
380 $max = $head if ($max > $head);
381 $SVN = libsvn_connect($SVN_URL);
382 }
383 restore_index($index);
384 return { revision => $last_rev, commit => $last_commit };
385}
386sub commit {
388 my (@commits) = @_;
389 check_upgrade_needed();
390 if ($_stdin || !@commits) {
391 print "Reading from stdin...\n";
392 @commits = ();
393 while (<STDIN>) {
394 if (/\b($sha1_short)\b/o) {
395 unshift @commits, $1;
396 }
397 }
398 }
399 my @revs;
400 foreach my $c (@commits) {
401 my @tmp = command('rev-parse',$c);
402 if (scalar @tmp == 1) {
403 push @revs, $tmp[0];
404 } elsif (scalar @tmp > 1) {
405 push @revs, reverse(command('rev-list',@tmp));
406 } else {
407 die "Failed to rev-parse $c\n";
408 }
409 }
410 commit_lib(@revs);
411 print "Done committing ",scalar @revs," revisions to SVN\n";
412}
413sub commit_lib {
415 my (@revs) = @_;
416 my ($r_last, $cmt_last) = svn_grab_base_rev();
417 defined $r_last or die "Must have an existing revision to commit\n";
418 my $fetched = fetch();
419 if ($r_last != $fetched->{revision}) {
420 print STDERR "There are new revisions that were fetched ",
421 "and need to be merged (or acknowledged) ",
422 "before committing.\n",
423 "last rev: $r_last\n",
424 " current: $fetched->{revision}\n";
425 exit 1;
426 }
427 read_uuid();
428 my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : ();
429 my $commit_msg = "$GIT_SVN_DIR/.svn-commit.tmp.$$";
430 my $repo;
432 set_svn_commit_env();
433 foreach my $c (@revs) {
434 my $log_msg = get_commit_message($c, $commit_msg);
435 # fork for each commit because there's a memory leak I
437 # can't track down... (it's probably in the SVN code)
438 defined(my $pid = open my $fh, '-|') or croak $!;
439 if (!$pid) {
440 my $ed = SVN::Git::Editor->new(
441 { r => $r_last,
442 ra => libsvn_dup_ra($SVN),
443 c => $c,
444 svn_path => $SVN->{svn_path},
445 },
446 $SVN->get_commit_editor(
447 $log_msg->{msg},
448 sub {
449 libsvn_commit_cb(
450 @_, $c,
451 $log_msg->{msg},
452 $r_last,
453 $cmt_last)
454 },
455 @lock)
456 );
457 my $mods = libsvn_checkout_tree($cmt_last, $c, $ed);
458 if (@$mods == 0) {
459 print "No changes\nr$r_last = $cmt_last\n";
460 $ed->abort_edit;
461 } else {
462 $ed->close_edit;
463 }
464 exit 0;
465 }
466 my ($r_new, $cmt_new, $no);
467 while (<$fh>) {
468 print $_;
469 chomp;
470 if (/^r(\d+) = ($sha1)$/o) {
471 ($r_new, $cmt_new) = ($1, $2);
472 } elsif ($_ eq 'No changes') {
473 $no = 1;
474 }
475 }
476 close $fh or exit 1;
477 if (! defined $r_new && ! defined $cmt_new) {
478 unless ($no) {
479 die "Failed to parse revision information\n";
480 }
481 } else {
482 ($r_last, $cmt_last) = ($r_new, $cmt_new);
483 }
484 }
485 $ENV{LC_ALL} = 'C';
486 unlink $commit_msg;
487}
488sub dcommit {
490 my $head = shift || 'HEAD';
491 my $gs = "refs/remotes/$GIT_SVN";
492 my @refs = command(qw/rev-list --no-merges/, "$gs..$head");
493 my $last_rev;
494 foreach my $d (reverse @refs) {
495 if (!verify_ref("$d~1")) {
496 die "Commit $d\n",
497 "has no parent commit, and therefore ",
498 "nothing to diff against.\n",
499 "You should be working from a repository ",
500 "originally created by git-svn\n";
501 }
502 unless (defined $last_rev) {
503 (undef, $last_rev, undef) = cmt_metadata("$d~1");
504 unless (defined $last_rev) {
505 die "Unable to extract revision information ",
506 "from commit $d~1\n";
507 }
508 }
509 if ($_dry_run) {
510 print "diff-tree $d~1 $d\n";
511 } else {
512 if (my $r = commit_diff("$d~1", $d, undef, $last_rev)) {
513 $last_rev = $r;
514 } # else: no changes, same $last_rev
515 }
516 }
517 return if $_dry_run;
518 fetch();
519 my @diff = command('diff-tree', 'HEAD', $gs, '--');
520 my @finish;
521 if (@diff) {
522 @finish = qw/rebase/;
523 push @finish, qw/--merge/ if $_merge;
524 push @finish, "--strategy=$_strategy" if $_strategy;
525 print STDERR "W: HEAD and $gs differ, using @finish:\n", @diff;
526 } else {
527 print "No changes between current HEAD and $gs\n",
528 "Resetting to the latest $gs\n";
529 @finish = qw/reset --mixed/;
530 }
531 command_noisy(@finish, $gs);
532}
533sub show_ignore {
535 $SVN_URL ||= file_to_s("$GIT_SVN_DIR/info/url");
536 my $repo;
537 $SVN ||= libsvn_connect($SVN_URL);
538 my $r = defined $_revision ? $_revision : $SVN->get_latest_revnum;
539 libsvn_traverse_ignore(\*STDOUT, '', $r);
540}
541sub graft_branches {
543 my $gr_file = "$GIT_DIR/info/grafts";
544 my ($grafts, $comments) = read_grafts($gr_file);
545 my $gr_sha1;
546 if (%$grafts) {
548 # temporarily disable our grafts file to make this idempotent
549 chomp($gr_sha1 = command(qw/hash-object -w/,$gr_file));
550 rename $gr_file, "$gr_file~$gr_sha1" or croak $!;
551 }
552 my $l_map = read_url_paths();
554 my @re = map { qr/$_/is } @_opt_m if @_opt_m;
555 unless ($_no_default_regex) {
556 push @re, (qr/\b(?:merge|merging|merged)\s+with\s+([\w\.\-]+)/i,
557 qr/\b(?:merge|merging|merged)\s+([\w\.\-]+)/i,
558 qr/\b(?:from|of)\s+([\w\.\-]+)/i );
559 }
560 foreach my $u (keys %$l_map) {
561 if (@re) {
562 foreach my $p (keys %{$l_map->{$u}}) {
563 graft_merge_msg($grafts,$l_map,$u,$p,@re);
564 }
565 }
566 unless ($_no_graft_copy) {
567 graft_file_copy_lib($grafts,$l_map,$u);
568 }
569 }
570 graft_tree_joins($grafts);
571 write_grafts($grafts, $comments, $gr_file);
573 unlink "$gr_file~$gr_sha1" if $gr_sha1;
574}
575sub multi_init {
577 my $url = shift;
578 unless (defined $_trunk || defined $_branches || defined $_tags) {
579 usage(1);
580 }
581 if (defined $_trunk) {
582 my $trunk_url = complete_svn_url($url, $_trunk);
583 my $ch_id;
584 if ($GIT_SVN eq 'git-svn') {
585 $ch_id = 1;
586 $GIT_SVN = $ENV{GIT_SVN_ID} = 'trunk';
587 }
588 init_vars();
589 unless (-d $GIT_SVN_DIR) {
590 if ($ch_id) {
591 print "GIT_SVN_ID set to 'trunk' for ",
592 "$trunk_url ($_trunk)\n";
593 }
594 init($trunk_url);
595 command_noisy('config', 'svn.trunk', $trunk_url);
596 }
597 }
598 $_prefix = '' unless defined $_prefix;
599 complete_url_ls_init($url, $_branches, '--branches/-b', $_prefix);
600 complete_url_ls_init($url, $_tags, '--tags/-t', $_prefix . 'tags/');
601}
602sub multi_fetch {
604 # try to do trunk first, since branches/tags
605 # may be descended from it.
606 if (-e "$GIT_DIR/svn/trunk/info/url") {
607 fetch_child_id('trunk', @_);
608 }
609 rec_fetch('', "$GIT_DIR/svn", @_);
610}
611sub show_log {
613 my (@args) = @_;
614 my ($r_min, $r_max);
615 my $r_last = -1; # prevent dupes
616 rload_authors() if $_authors;
617 if (defined $TZ) {
618 $ENV{TZ} = $TZ;
619 } else {
620 delete $ENV{TZ};
621 }
622 if (defined $_revision) {
623 if ($_revision =~ /^(\d+):(\d+)$/) {
624 ($r_min, $r_max) = ($1, $2);
625 } elsif ($_revision =~ /^\d+$/) {
626 $r_min = $r_max = $_revision;
627 } else {
628 print STDERR "-r$_revision is not supported, use ",
629 "standard \'git log\' arguments instead\n";
630 exit 1;
631 }
632 }
633 config_pager();
635 @args = (git_svn_log_cmd($r_min, $r_max), @args);
636 my $log = command_output_pipe(@args);
637 run_pager();
638 my (@k, $c, $d);
639 while (<$log>) {
641 if (/^${_esc_color}commit ($sha1_short)/o) {
642 my $cmt = $1;
643 if ($c && cmt_showable($c) && $c->{r} != $r_last) {
644 $r_last = $c->{r};
645 process_commit($c, $r_min, $r_max, \@k) or
646 goto out;
647 }
648 $d = undef;
649 $c = { c => $cmt };
650 } elsif (/^${_esc_color}author (.+) (\d+) ([\-\+]?\d+)$/) {
651 get_author_info($c, $1, $2, $3);
652 } elsif (/^${_esc_color}(?:tree|parent|committer) /) {
653 # ignore
654 } elsif (/^${_esc_color}:\d{6} \d{6} $sha1_short/o) {
655 push @{$c->{raw}}, $_;
656 } elsif (/^${_esc_color}[ACRMDT]\t/) {
657 # we could add $SVN->{svn_path} here, but that requires
658 # remote access at the moment (repo_path_split)...
659 s#^(${_esc_color})([ACRMDT])\t#$1 $2 #;
660 push @{$c->{changed}}, $_;
661 } elsif (/^${_esc_color}diff /) {
662 $d = 1;
663 push @{$c->{diff}}, $_;
664 } elsif ($d) {
665 push @{$c->{diff}}, $_;
666 } elsif (/^${_esc_color} (git-svn-id:.+)$/) {
667 ($c->{url}, $c->{r}, undef) = extract_metadata($1);
668 } elsif (s/^${_esc_color} //) {
669 push @{$c->{l}}, $_;
670 }
671 }
672 if ($c && defined $c->{r} && $c->{r} != $r_last) {
673 $r_last = $c->{r};
674 process_commit($c, $r_min, $r_max, \@k);
675 }
676 if (@k) {
677 my $swap = $r_max;
678 $r_max = $r_min;
679 $r_min = $swap;
680 process_commit($_, $r_min, $r_max) foreach reverse @k;
681 }
682out:
683 close $log;
684 print '-' x72,"\n" unless $_incremental || $_oneline;
685}
686sub commit_diff_usage {
688 print STDERR "Usage: $0 commit-diff <tree-ish> <tree-ish> [<URL>]\n";
689 exit 1
690}
691sub commit_diff {
693 my $ta = shift or commit_diff_usage();
694 my $tb = shift or commit_diff_usage();
695 if (!eval { $SVN_URL = shift || file_to_s("$GIT_SVN_DIR/info/url") }) {
696 print STDERR "Needed URL or usable git-svn id command-line\n";
697 commit_diff_usage();
698 }
699 my $r = shift;
700 unless (defined $r) {
701 if (defined $_revision) {
702 $r = $_revision
703 } else {
704 die "-r|--revision is a required argument\n";
705 }
706 }
707 if (defined $_message && defined $_file) {
708 print STDERR "Both --message/-m and --file/-F specified ",
709 "for the commit message.\n",
710 "I have no idea what you mean\n";
711 exit 1;
712 }
713 if (defined $_file) {
714 $_message = file_to_s($_file);
715 } else {
716 $_message ||= get_commit_message($tb,
717 "$GIT_DIR/.svn-commit.tmp.$$")->{msg};
718 }
719 $SVN ||= libsvn_connect($SVN_URL);
720 if ($r eq 'HEAD') {
721 $r = $SVN->get_latest_revnum;
722 } elsif ($r !~ /^\d+$/) {
723 die "revision argument: $r not understood by git-svn\n";
724 }
725 my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : ();
726 my $rev_committed;
727 my $ed = SVN::Git::Editor->new({ r => $r,
728 ra => libsvn_dup_ra($SVN),
729 c => $tb,
730 svn_path => $SVN->{svn_path}
731 },
732 $SVN->get_commit_editor($_message,
733 sub {
734 $rev_committed = $_[0];
735 print "Committed $_[0]\n";
736 }, @lock)
737 );
738 eval {
739 my $mods = libsvn_checkout_tree($ta, $tb, $ed);
740 if (@$mods == 0) {
741 print "No changes\n$ta == $tb\n";
742 $ed->abort_edit;
743 } else {
744 $ed->close_edit;
745 }
746 };
747 fatal "$@\n" if $@;
748 $_message = $_file = undef;
749 return $rev_committed;
750}
751########################### utility functions #########################
753sub cmt_showable {
755 my ($c) = @_;
756 return 1 if defined $c->{r};
757 if ($c->{l} && $c->{l}->[-1] eq "...\n" &&
758 $c->{a_raw} =~ /\@([a-f\d\-]+)>$/) {
759 my @msg = command(qw/cat-file commit/, $c->{c});
760 shift @msg while ($msg[0] ne "\n");
761 shift @msg;
762 @{$c->{l}} = grep !/^git-svn-id: /, @msg;
763 (undef, $c->{r}, undef) = extract_metadata(
765 (grep(/^git-svn-id: /, @msg))[-1]);
766 }
767 return defined $c->{r};
768}
769sub log_use_color {
771 return 1 if $_color;
772 my ($dc, $dcvar);
773 $dcvar = 'color.diff';
774 $dc = `git-config --get $dcvar`;
775 if ($dc eq '') {
776 # nothing at all; fallback to "diff.color"
777 $dcvar = 'diff.color';
778 $dc = `git-config --get $dcvar`;
779 }
780 chomp($dc);
781 if ($dc eq 'auto') {
782 my $pc;
783 $pc = `git-config --get color.pager`;
784 if ($pc eq '') {
785 # does not have it -- fallback to pager.color
786 $pc = `git-config --bool --get pager.color`;
787 }
788 else {
789 $pc = `git-config --bool --get color.pager`;
790 if ($?) {
791 $pc = 'false';
792 }
793 }
794 chomp($pc);
795 if (-t *STDOUT || (defined $_pager && $pc eq 'true')) {
796 return ($ENV{TERM} && $ENV{TERM} ne 'dumb');
797 }
798 return 0;
799 }
800 return 0 if $dc eq 'never';
801 return 1 if $dc eq 'always';
802 chomp($dc = `git-config --bool --get $dcvar`);
803 return ($dc eq 'true');
804}
805sub git_svn_log_cmd {
807 my ($r_min, $r_max) = @_;
808 my @cmd = (qw/log --abbrev-commit --pretty=raw
809 --default/, "refs/remotes/$GIT_SVN");
810 push @cmd, '-r' unless $_non_recursive;
811 push @cmd, qw/--raw --name-status/ if $_verbose;
812 push @cmd, '--color' if log_use_color();
813 return @cmd unless defined $r_max;
814 if ($r_max == $r_min) {
815 push @cmd, '--max-count=1';
816 if (my $c = revdb_get($REVDB, $r_max)) {
817 push @cmd, $c;
818 }
819 } else {
820 my ($c_min, $c_max);
821 $c_max = revdb_get($REVDB, $r_max);
822 $c_min = revdb_get($REVDB, $r_min);
823 if (defined $c_min && defined $c_max) {
824 if ($r_max > $r_max) {
825 push @cmd, "$c_min..$c_max";
826 } else {
827 push @cmd, "$c_max..$c_min";
828 }
829 } elsif ($r_max > $r_min) {
830 push @cmd, $c_max;
831 } else {
832 push @cmd, $c_min;
833 }
834 }
835 return @cmd;
836}
837sub fetch_child_id {
839 my $id = shift;
840 print "Fetching $id\n";
841 my $ref = "$GIT_DIR/refs/remotes/$id";
842 defined(my $pid = open my $fh, '-|') or croak $!;
843 if (!$pid) {
844 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
845 init_vars();
846 fetch(@_);
847 exit 0;
848 }
849 while (<$fh>) {
850 print $_;
851 check_repack() if (/^r\d+ = $sha1/o);
852 }
853 close $fh or croak $?;
854}
855sub rec_fetch {
857 my ($pfx, $p, @args) = @_;
858 my @dir;
859 foreach (sort <$p/*>) {
860 if (-r "$_/info/url") {
861 $pfx .= '/' if $pfx && $pfx !~ m!/$!;
862 my $id = $pfx . basename $_;
863 next if $id eq 'trunk';
864 fetch_child_id($id, @args);
865 } elsif (-d $_) {
866 push @dir, $_;
867 }
868 }
869 foreach (@dir) {
870 my $x = $_;
871 $x =~ s!^\Q$GIT_DIR\E/svn/!!;
872 rec_fetch($x, $_);
873 }
874}
875sub complete_svn_url {
877 my ($url, $path) = @_;
878 $path =~ s#/+$##;
879 $url =~ s#/+$## if $url;
880 if ($path !~ m#^[a-z\+]+://#) {
881 $path = '/' . $path if ($path !~ m#^/#);
882 if (!defined $url || $url !~ m#^[a-z\+]+://#) {
883 fatal("E: '$path' is not a complete URL ",
884 "and a separate URL is not specified\n");
885 }
886 $path = $url . $path;
887 }
888 return $path;
889}
890sub complete_url_ls_init {
892 my ($url, $path, $switch, $pfx) = @_;
893 unless ($path) {
894 print STDERR "W: $switch not specified\n";
895 return;
896 }
897 my $full_url = complete_svn_url($url, $path);
898 my @ls = libsvn_ls_fullurl($full_url);
899 defined(my $pid = fork) or croak $!;
900 if (!$pid) {
901 foreach my $u (map { "$full_url/$_" } (grep m!/$!, @ls)) {
902 $u =~ s#/+$##;
903 if ($u !~ m!\Q$full_url\E/(.+)$!) {
904 print STDERR "W: Unrecognized URL: $u\n";
905 die "This should never happen\n";
906 }
907 # don't try to init already existing refs
908 my $id = $pfx.$1;
909 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
910 init_vars();
911 unless (-d $GIT_SVN_DIR) {
912 print "init $u => $id\n";
913 init($u);
914 }
915 }
916 exit 0;
917 }
918 waitpid $pid, 0;
919 croak $? if $?;
920 my ($n) = ($switch =~ /^--(\w+)/);
921 command_noisy('config', "svn.$n", $full_url);
922}
923sub common_prefix {
925 my $paths = shift;
926 my %common;
927 foreach (@$paths) {
928 my @tmp = split m#/#, $_;
929 my $p = '';
930 while (my $x = shift @tmp) {
931 $p .= "/$x";
932 $common{$p} ||= 0;
933 $common{$p}++;
934 }
935 }
936 foreach (sort {length $b <=> length $a} keys %common) {
937 if ($common{$_} == @$paths) {
938 return $_;
939 }
940 }
941 return '';
942}
943# grafts set here are 'stronger' in that they're based on actual tree
945# matches, and won't be deleted from merge-base checking in write_grafts()
946sub graft_tree_joins {
947 my $grafts = shift;
948 map_tree_joins() if (@_branch_from && !%tree_map);
949 return unless %tree_map;
950 git_svn_each(sub {
952 my $i = shift;
953 my @args = (qw/rev-list --pretty=raw/, "refs/remotes/$i");
954 my ($fh, $ctx) = command_output_pipe(@args);
955 while (<$fh>) {
956 next unless /^commit ($sha1)$/o;
957 my $c = $1;
958 my ($t) = (<$fh> =~ /^tree ($sha1)$/o);
959 next unless $tree_map{$t};
960 my $l;
962 do {
963 $l = readline $fh;
964 } until ($l =~ /^committer (?:.+) (\d+) ([\-\+]?\d+)$/);
965 my ($s, $tz) = ($1, $2);
967 if ($tz =~ s/^\+//) {
968 $s += tz_to_s_offset($tz);
969 } elsif ($tz =~ s/^\-//) {
970 $s -= tz_to_s_offset($tz);
971 }
972 my ($url_a, $r_a, $uuid_a) = cmt_metadata($c);
974 foreach my $p (@{$tree_map{$t}}) {
976 next if $p eq $c;
977 my $mb = eval { command('merge-base', $c, $p) };
978 next unless ($@ || $?);
979 if (defined $r_a) {
980 # see if SVN says it's a relative
981 my ($url_b, $r_b, $uuid_b) =
982 cmt_metadata($p);
983 next if (defined $url_b &&
984 defined $url_a &&
985 ($url_a eq $url_b) &&
986 ($uuid_a eq $uuid_b));
987 if ($uuid_a eq $uuid_b) {
988 if ($r_b < $r_a) {
989 $grafts->{$c}->{$p} = 2;
990 next;
991 } elsif ($r_b > $r_a) {
992 $grafts->{$p}->{$c} = 2;
993 next;
994 }
995 }
996 }
997 my $ct = get_commit_time($p);
998 if ($ct < $s) {
999 $grafts->{$c}->{$p} = 2;
1000 } elsif ($ct > $s) {
1001 $grafts->{$p}->{$c} = 2;
1002 }
1003 # what should we do when $ct == $s ?
1004 }
1005 }
1006 command_close_pipe($fh, $ctx);
1007 });
1008}
1009sub graft_file_copy_lib {
1011 my ($grafts, $l_map, $u) = @_;
1012 my $tree_paths = $l_map->{$u};
1013 my $pfx = common_prefix([keys %$tree_paths]);
1014 my ($repo, $path) = repo_path_split($u.$pfx);
1015 $SVN = libsvn_connect($repo);
1016 my ($base, $head) = libsvn_parse_revision();
1018 my $inc = 1000;
1019 my ($min, $max) = ($base, $head < $base+$inc ? $head : $base+$inc);
1020 my $eh = $SVN::Error::handler;
1021 $SVN::Error::handler = \&libsvn_skip_unknown_revs;
1022 while (1) {
1023 my $pool = SVN::Pool->new;
1024 libsvn_get_log(libsvn_dup_ra($SVN), [$path],
1025 $min, $max, 0, 2, 1,
1026 sub {
1027 libsvn_graft_file_copies($grafts, $tree_paths,
1028 $path, @_);
1029 }, $pool);
1030 $pool->clear;
1031 last if ($max >= $head);
1032 $min = $max + 1;
1033 $max += $inc;
1034 $max = $head if ($max > $head);
1035 }
1036 $SVN::Error::handler = $eh;
1037}
1038sub process_merge_msg_matches {
1040 my ($grafts, $l_map, $u, $p, $c, @matches) = @_;
1041 my (@strong, @weak);
1042 foreach (@matches) {
1043 # merging with ourselves is not interesting
1044 next if $_ eq $p;
1045 if ($l_map->{$u}->{$_}) {
1046 push @strong, $_;
1047 } else {
1048 push @weak, $_;
1049 }
1050 }
1051 foreach my $w (@weak) {
1052 last if @strong;
1053 # no exact match, use branch name as regexp.
1054 my $re = qr/\Q$w\E/i;
1055 foreach (keys %{$l_map->{$u}}) {
1056 if (/$re/) {
1057 push @strong, $l_map->{$u}->{$_};
1058 last;
1059 }
1060 }
1061 last if @strong;
1062 $w = basename($w);
1063 $re = qr/\Q$w\E/i;
1064 foreach (keys %{$l_map->{$u}}) {
1065 if (/$re/) {
1066 push @strong, $l_map->{$u}->{$_};
1067 last;
1068 }
1069 }
1070 }
1071 my ($rev) = ($c->{m} =~ /^git-svn-id:\s(?:\S+?)\@(\d+)
1072 \s(?:[a-f\d\-]+)$/xsm);
1073 unless (defined $rev) {
1074 ($rev) = ($c->{m} =~/^git-svn-id:\s(\d+)
1075 \@(?:[a-f\d\-]+)/xsm);
1076 return unless defined $rev;
1077 }
1078 foreach my $m (@strong) {
1079 my ($r0, $s0) = find_rev_before($rev, $m, 1);
1080 $grafts->{$c->{c}}->{$s0} = 1 if defined $s0;
1081 }
1082}
1083sub graft_merge_msg {
1085 my ($grafts, $l_map, $u, $p, @re) = @_;
1086 my $x = $l_map->{$u}->{$p};
1088 my $rl = rev_list_raw("refs/remotes/$x");
1089 while (my $c = next_rev_list_entry($rl)) {
1090 foreach my $re (@re) {
1091 my (@br) = ($c->{m} =~ /$re/g);
1092 next unless @br;
1093 process_merge_msg_matches($grafts,$l_map,$u,$p,$c,@br);
1094 }
1095 }
1096}
1097sub read_uuid {
1099 return if $SVN_UUID;
1100 my $pool = SVN::Pool->new;
1101 $SVN_UUID = $SVN->get_uuid($pool);
1102 $pool->clear;
1103}
1104sub verify_ref {
1106 my ($ref) = @_;
1107 eval { command_oneline([ 'rev-parse', '--verify', $ref ],
1108 { STDERR => 0 }); };
1109}
1110sub repo_path_split {
1112 my $full_url = shift;
1113 $full_url =~ s#/+$##;
1114 foreach (@repo_path_split_cache) {
1116 if ($full_url =~ s#$_##) {
1117 my $u = $1;
1118 $full_url =~ s#^/+##;
1119 return ($u, $full_url);
1120 }
1121 }
1122 my $tmp = libsvn_connect($full_url);
1123 return ($tmp->{repos_root}, $tmp->{svn_path});
1124}
1125sub setup_git_svn {
1127 defined $SVN_URL or croak "SVN repository location required\n";
1128 unless (-d $GIT_DIR) {
1129 croak "GIT_DIR=$GIT_DIR does not exist!\n";
1130 }
1131 mkpath([$GIT_SVN_DIR]);
1132 mkpath(["$GIT_SVN_DIR/info"]);
1133 open my $fh, '>>',$REVDB or croak $!;
1134 close $fh;
1135 s_to_file($SVN_URL,"$GIT_SVN_DIR/info/url");
1136}
1138sub get_tree_from_treeish {
1140 my ($treeish) = @_;
1141 croak "Not a sha1: $treeish\n" unless $treeish =~ /^$sha1$/o;
1142 my $type = command_oneline(qw/cat-file -t/, $treeish);
1143 my $expected;
1144 while ($type eq 'tag') {
1145 ($treeish, $type) = command(qw/cat-file tag/, $treeish);
1146 }
1147 if ($type eq 'commit') {
1148 $expected = (grep /^tree /, command(qw/cat-file commit/,
1149 $treeish))[0];
1150 ($expected) = ($expected =~ /^tree ($sha1)$/);
1151 die "Unable to get tree from $treeish\n" unless $expected;
1152 } elsif ($type eq 'tree') {
1153 $expected = $treeish;
1154 } else {
1155 die "$treeish is a $type, expected tree, tag or commit\n";
1156 }
1157 return $expected;
1158}
1159sub get_diff {
1161 my ($from, $treeish) = @_;
1162 print "diff-tree $from $treeish\n";
1163 my @diff_tree = qw(diff-tree -z -r);
1164 if ($_cp_similarity) {
1165 push @diff_tree, "-C$_cp_similarity";
1166 } else {
1167 push @diff_tree, '-C';
1168 }
1169 push @diff_tree, '--find-copies-harder' if $_find_copies_harder;
1170 push @diff_tree, "-l$_l" if defined $_l;
1171 push @diff_tree, $from, $treeish;
1172 my ($diff_fh, $ctx) = command_output_pipe(@diff_tree);
1173 local $/ = "\0";
1174 my $state = 'meta';
1175 my @mods;
1176 while (<$diff_fh>) {
1177 chomp $_; # this gets rid of the trailing "\0"
1178 if ($state eq 'meta' && /^:(\d{6})\s(\d{6})\s
1179 $sha1\s($sha1)\s([MTCRAD])\d*$/xo) {
1180 push @mods, { mode_a => $1, mode_b => $2,
1181 sha1_b => $3, chg => $4 };
1182 if ($4 =~ /^(?:C|R)$/) {
1183 $state = 'file_a';
1184 } else {
1185 $state = 'file_b';
1186 }
1187 } elsif ($state eq 'file_a') {
1188 my $x = $mods[$#mods] or croak "Empty array\n";
1189 if ($x->{chg} !~ /^(?:C|R)$/) {
1190 croak "Error parsing $_, $x->{chg}\n";
1191 }
1192 $x->{file_a} = $_;
1193 $state = 'file_b';
1194 } elsif ($state eq 'file_b') {
1195 my $x = $mods[$#mods] or croak "Empty array\n";
1196 if (exists $x->{file_a} && $x->{chg} !~ /^(?:C|R)$/) {
1197 croak "Error parsing $_, $x->{chg}\n";
1198 }
1199 if (!exists $x->{file_a} && $x->{chg} =~ /^(?:C|R)$/) {
1200 croak "Error parsing $_, $x->{chg}\n";
1201 }
1202 $x->{file_b} = $_;
1203 $state = 'meta';
1204 } else {
1205 croak "Error parsing $_\n";
1206 }
1207 }
1208 command_close_pipe($diff_fh, $ctx);
1209 return \@mods;
1210}
1211sub libsvn_checkout_tree {
1213 my ($from, $treeish, $ed) = @_;
1214 my $mods = get_diff($from, $treeish);
1215 return $mods unless (scalar @$mods);
1216 my %o = ( D => 1, R => 0, C => -1, A => 3, M => 3, T => 3 );
1217 foreach my $m (sort { $o{$a->{chg}} <=> $o{$b->{chg}} } @$mods) {
1218 my $f = $m->{chg};
1219 if (defined $o{$f}) {
1220 $ed->$f($m, $_q);
1221 } else {
1222 croak "Invalid change type: $f\n";
1223 }
1224 }
1225 $ed->rmdirs($_q) if $_rmdir;
1226 return $mods;
1227}
1228sub get_commit_message {
1230 my ($commit, $commit_msg) = (@_);
1231 my %log_msg = ( msg => '' );
1232 open my $msg, '>', $commit_msg or croak $!;
1233 my $type = command_oneline(qw/cat-file -t/, $commit);
1235 if ($type eq 'commit' || $type eq 'tag') {
1236 my ($msg_fh, $ctx) = command_output_pipe('cat-file',
1237 $type, $commit);
1238 my $in_msg = 0;
1239 while (<$msg_fh>) {
1240 if (!$in_msg) {
1241 $in_msg = 1 if (/^\s*$/);
1242 } elsif (/^git-svn-id: /) {
1243 # skip this, we regenerate the correct one
1244 # on re-fetch anyways
1245 } else {
1246 print $msg $_ or croak $!;
1247 }
1248 }
1249 command_close_pipe($msg_fh, $ctx);
1250 }
1251 close $msg or croak $!;
1252 if ($_edit || ($type eq 'tree')) {
1254 my $editor = $ENV{VISUAL} || $ENV{EDITOR} || 'vi';
1255 system($editor, $commit_msg);
1256 }
1257 # file_to_s removes all trailing newlines, so just use chomp() here:
1259 open $msg, '<', $commit_msg or croak $!;
1260 { local $/; chomp($log_msg{msg} = <$msg>); }
1261 close $msg or croak $!;
1262 return \%log_msg;
1264}
1265sub set_svn_commit_env {
1267 if (defined $LC_ALL) {
1268 $ENV{LC_ALL} = $LC_ALL;
1269 } else {
1270 delete $ENV{LC_ALL};
1271 }
1272}
1273sub rev_list_raw {
1275 my ($fh, $c) = command_output_pipe(qw/rev-list --pretty=raw/, @_);
1276 return { fh => $fh, ctx => $c, t => { } };
1277}
1278sub next_rev_list_entry {
1280 my $rl = shift;
1281 my $fh = $rl->{fh};
1282 my $x = $rl->{t};
1283 while (<$fh>) {
1284 if (/^commit ($sha1)$/o) {
1285 if ($x->{c}) {
1286 $rl->{t} = { c => $1 };
1287 return $x;
1288 } else {
1289 $x->{c} = $1;
1290 }
1291 } elsif (/^parent ($sha1)$/o) {
1292 $x->{p}->{$1} = 1;
1293 } elsif (s/^ //) {
1294 $x->{m} ||= '';
1295 $x->{m} .= $_;
1296 }
1297 }
1298 command_close_pipe($fh, $rl->{ctx});
1299 return ($x != $rl->{t}) ? $x : undef;
1300}
1301sub s_to_file {
1303 my ($str, $file, $mode) = @_;
1304 open my $fd,'>',$file or croak $!;
1305 print $fd $str,"\n" or croak $!;
1306 close $fd or croak $!;
1307 chmod ($mode &~ umask, $file) if (defined $mode);
1308}
1309sub file_to_s {
1311 my $file = shift;
1312 open my $fd,'<',$file or croak "$!: file: $file\n";
1313 local $/;
1314 my $ret = <$fd>;
1315 close $fd or croak $!;
1316 $ret =~ s/\s*$//s;
1317 return $ret;
1318}
1319sub assert_revision_unknown {
1321 my $r = shift;
1322 if (my $c = revdb_get($REVDB, $r)) {
1323 croak "$r = $c already exists! Why are we refetching it?";
1324 }
1325}
1326sub git_commit {
1328 my ($log_msg, @parents) = @_;
1329 assert_revision_unknown($log_msg->{revision});
1330 map_tree_joins() if (@_branch_from && !%tree_map);
1331 my (@tmp_parents, @exec_parents, %seen_parent);
1333 if (my $lparents = $log_msg->{parents}) {
1334 @tmp_parents = @$lparents
1335 }
1336 # commit parents can be conditionally bound to a particular
1337 # svn revision via: "svn_revno=commit_sha1", filter them out here:
1338 foreach my $p (@parents) {
1339 next unless defined $p;
1340 if ($p =~ /^(\d+)=($sha1_short)$/o) {
1341 if ($1 == $log_msg->{revision}) {
1342 push @tmp_parents, $2;
1343 }
1344 } else {
1345 push @tmp_parents, $p if $p =~ /$sha1_short/o;
1346 }
1347 }
1348 my $tree = $log_msg->{tree};
1349 if (!defined $tree) {
1350 my $index = set_index($GIT_SVN_INDEX);
1351 $tree = command_oneline('write-tree');
1352 croak $? if $?;
1353 restore_index($index);
1354 }
1355 # just in case we clobber the existing ref, we still want that ref
1356 # as our parent:
1357 if (my $cur = verify_ref("refs/remotes/$GIT_SVN^0")) {
1358 chomp $cur;
1359 push @tmp_parents, $cur;
1360 }
1361 if (exists $tree_map{$tree}) {
1363 foreach my $p (@{$tree_map{$tree}}) {
1364 my $skip;
1365 foreach (@tmp_parents) {
1366 # see if a common parent is found
1367 my $mb = eval { command('merge-base', $_, $p) };
1368 next if ($@ || $?);
1369 $skip = 1;
1370 last;
1371 }
1372 next if $skip;
1373 my ($url_p, $r_p, $uuid_p) = cmt_metadata($p);
1374 next if (($SVN_UUID eq $uuid_p) &&
1375 ($log_msg->{revision} > $r_p));
1376 next if (defined $url_p && defined $SVN_URL &&
1377 ($SVN_UUID eq $uuid_p) &&
1378 ($url_p eq $SVN_URL));
1379 push @tmp_parents, $p;
1380 }
1381 }
1382 foreach (@tmp_parents) {
1383 next if $seen_parent{$_};
1384 $seen_parent{$_} = 1;
1385 push @exec_parents, $_;
1386 # MAXPARENT is defined to 16 in commit-tree.c:
1387 last if @exec_parents > 16;
1388 }
1389 set_commit_env($log_msg);
1391 my @exec = ('git-commit-tree', $tree);
1392 push @exec, '-p', $_ foreach @exec_parents;
1393 defined(my $pid = open3(my $msg_fh, my $out_fh, '>&STDERR', @exec))
1394 or croak $!;
1395 print $msg_fh $log_msg->{msg} or croak $!;
1396 unless ($_no_metadata) {
1397 print $msg_fh "\ngit-svn-id: $SVN_URL\@$log_msg->{revision}",
1398 " $SVN_UUID\n" or croak $!;
1399 }
1400 $msg_fh->flush == 0 or croak $!;
1401 close $msg_fh or croak $!;
1402 chomp(my $commit = do { local $/; <$out_fh> });
1403 close $out_fh or croak $!;
1404 waitpid $pid, 0;
1405 croak $? if $?;
1406 if ($commit !~ /^$sha1$/o) {
1407 die "Failed to commit, invalid sha1: $commit\n";
1408 }
1409 command_noisy('update-ref',"refs/remotes/$GIT_SVN",$commit);
1410 revdb_set($REVDB, $log_msg->{revision}, $commit);
1411 # this output is read via pipe, do not change:
1413 print "r$log_msg->{revision} = $commit\n";
1414 return $commit;
1415}
1416sub check_repack {
1418 if ($_repack && (--$_repack_nr == 0)) {
1419 $_repack_nr = $_repack;
1420 # repack doesn't use any arguments with spaces in them, does it?
1421 command_noisy('repack', split(/\s+/, $_repack_flags));
1422 }
1423}
1424sub set_commit_env {
1426 my ($log_msg) = @_;
1427 my $author = $log_msg->{author};
1428 if (!defined $author || length $author == 0) {
1429 $author = '(no author)';
1430 }
1431 my ($name,$email) = defined $users{$author} ? @{$users{$author}}
1432 : ($author,"$author\@$SVN_UUID");
1433 $ENV{GIT_AUTHOR_NAME} = $ENV{GIT_COMMITTER_NAME} = $name;
1434 $ENV{GIT_AUTHOR_EMAIL} = $ENV{GIT_COMMITTER_EMAIL} = $email;
1435 $ENV{GIT_AUTHOR_DATE} = $ENV{GIT_COMMITTER_DATE} = $log_msg->{date};
1436}
1437sub check_upgrade_needed {
1439 if (!-r $REVDB) {
1440 -d $GIT_SVN_DIR or mkpath([$GIT_SVN_DIR]);
1441 open my $fh, '>>',$REVDB or croak $!;
1442 close $fh;
1443 }
1444 return unless eval {
1445 command([qw/rev-parse --verify/,"$GIT_SVN-HEAD^0"],
1446 {STDERR => 0});
1447 };
1448 my $head = eval { command('rev-parse',"refs/remotes/$GIT_SVN") };
1449 if ($@ || !$head) {
1450 print STDERR "Please run: $0 rebuild --upgrade\n";
1451 exit 1;
1452 }
1453}
1454# fills %tree_map with a reverse mapping of trees to commits. Useful
1456# for finding parents to commit on.
1457sub map_tree_joins {
1458 my %seen;
1459 foreach my $br (@_branch_from) {
1460 my $pipe = command_output_pipe(qw/rev-list
1461 --topo-order --pretty=raw/, $br);
1462 while (<$pipe>) {
1463 if (/^commit ($sha1)$/o) {
1464 my $commit = $1;
1465 # if we've seen a commit,
1467 # we've seen its parents
1468 last if $seen{$commit};
1469 my ($tree) = (<$pipe> =~ /^tree ($sha1)$/o);
1470 unless (defined $tree) {
1471 die "Failed to parse commit $commit\n";
1472 }
1473 push @{$tree_map{$tree}}, $commit;
1474 $seen{$commit} = 1;
1475 }
1476 }
1477 close $pipe;
1478 }
1479}
1480sub load_all_refs {
1482 if (@_branch_from) {
1483 print STDERR '--branch|-b parameters are ignored when ',
1484 "--branch-all-refs|-B is passed\n";
1485 }
1486 # don't worry about rev-list on non-commit objects/tags,
1488 # it shouldn't blow up if a ref is a blob or tree...
1489 @_branch_from = command(qw/rev-parse --symbolic --all/);
1490}
1491# '<svn username> = real-name <email address>' mapping based on git-svnimport:
1493sub load_authors {
1494 open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
1495 while (<$authors>) {
1496 chomp;
1497 next unless /^(\S+?|\(no author\))\s*=\s*(.+?)\s*<(.+)>\s*$/;
1498 my ($user, $name, $email) = ($1, $2, $3);
1499 $users{$user} = [$name, $email];
1500 }
1501 close $authors or croak $!;
1502}
1503sub rload_authors {
1505 open my $authors, '<', $_authors or die "Can't open $_authors $!\n";
1506 while (<$authors>) {
1507 chomp;
1508 next unless /^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/;
1509 my ($user, $name, $email) = ($1, $2, $3);
1510 $rusers{"$name <$email>"} = $user;
1511 }
1512 close $authors or croak $!;
1513}
1514sub git_svn_each {
1516 my $sub = shift;
1517 foreach (command(qw/rev-parse --symbolic --all/)) {
1518 next unless s#^refs/remotes/##;
1519 chomp $_;
1520 next unless -f "$GIT_DIR/svn/$_/info/url";
1521 &$sub($_);
1522 }
1523}
1524sub migrate_revdb {
1526 git_svn_each(sub {
1527 my $id = shift;
1528 defined(my $pid = fork) or croak $!;
1529 if (!$pid) {
1530 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
1531 init_vars();
1532 exit 0 if -r $REVDB;
1533 print "Upgrading svn => git mapping...\n";
1534 -d $GIT_SVN_DIR or mkpath([$GIT_SVN_DIR]);
1535 open my $fh, '>>',$REVDB or croak $!;
1536 close $fh;
1537 rebuild();
1538 print "Done upgrading. You may now delete the ",
1539 "deprecated $GIT_SVN_DIR/revs directory\n";
1540 exit 0;
1541 }
1542 waitpid $pid, 0;
1543 croak $? if $?;
1544 });
1545}
1546sub migration_check {
1548 migrate_revdb() unless (-e $REVDB);
1549 return if (-d "$GIT_DIR/svn" || !-d $GIT_DIR);
1550 print "Upgrading repository...\n";
1551 unless (-d "$GIT_DIR/svn") {
1552 mkdir "$GIT_DIR/svn" or croak $!;
1553 }
1554 print "Data from a previous version of git-svn exists, but\n\t",
1555 "$GIT_SVN_DIR\n\t(required for this version ",
1556 "($VERSION) of git-svn) does not.\n";
1557 foreach my $x (command(qw/rev-parse --symbolic --all/)) {
1559 next unless $x =~ s#^refs/remotes/##;
1560 chomp $x;
1561 next unless -f "$GIT_DIR/$x/info/url";
1562 my $u = eval { file_to_s("$GIT_DIR/$x/info/url") };
1563 next unless $u;
1564 my $dn = dirname("$GIT_DIR/svn/$x");
1565 mkpath([$dn]) unless -d $dn;
1566 rename "$GIT_DIR/$x", "$GIT_DIR/svn/$x" or croak "$!: $x";
1567 }
1568 migrate_revdb() if (-d $GIT_SVN_DIR && !-w $REVDB);
1569 print "Done upgrading.\n";
1570}
1571sub find_rev_before {
1573 my ($r, $id, $eq_ok) = @_;
1574 my $f = "$GIT_DIR/svn/$id/.rev_db";
1575 return (undef,undef) unless -r $f;
1576 --$r unless $eq_ok;
1577 while ($r > 0) {
1578 if (my $c = revdb_get($f, $r)) {
1579 return ($r, $c);
1580 }
1581 --$r;
1582 }
1583 return (undef, undef);
1584}
1585sub init_vars {
1587 $GIT_SVN ||= $ENV{GIT_SVN_ID} || 'git-svn';
1588 $GIT_SVN_DIR = "$GIT_DIR/svn/$GIT_SVN";
1589 $REVDB = "$GIT_SVN_DIR/.rev_db";
1590 $GIT_SVN_INDEX = "$GIT_SVN_DIR/index";
1591 $SVN_URL = undef;
1592 $SVN_WC = "$GIT_SVN_DIR/tree";
1593 %tree_map = ();
1594}
1595# convert GetOpt::Long specs for use by git-config
1597sub read_repo_config {
1598 return unless -d $GIT_DIR;
1599 my $opts = shift;
1600 foreach my $o (keys %$opts) {
1601 my $v = $opts->{$o};
1602 my ($key) = ($o =~ /^([a-z\-]+)/);
1603 $key =~ s/-//g;
1604 my $arg = 'git-config';
1605 $arg .= ' --int' if ($o =~ /[:=]i$/);
1606 $arg .= ' --bool' if ($o !~ /[:=][sfi]$/);
1607 if (ref $v eq 'ARRAY') {
1608 chomp(my @tmp = `$arg --get-all svn.$key`);
1609 @$v = @tmp if @tmp;
1610 } else {
1611 chomp(my $tmp = `$arg --get svn.$key`);
1612 if ($tmp && !($arg =~ / --bool/ && $tmp eq 'false')) {
1613 $$v = $tmp;
1614 }
1615 }
1616 }
1617}
1618sub set_default_vals {
1620 if (defined $_repack) {
1621 $_repack = 1000 if ($_repack <= 0);
1622 $_repack_nr = $_repack;
1623 $_repack_flags ||= '-d';
1624 }
1625}
1626sub read_grafts {
1628 my $gr_file = shift;
1629 my ($grafts, $comments) = ({}, {});
1630 if (open my $fh, '<', $gr_file) {
1631 my @tmp;
1632 while (<$fh>) {
1633 if (/^($sha1)\s+/) {
1634 my $c = $1;
1635 if (@tmp) {
1636 @{$comments->{$c}} = @tmp;
1637 @tmp = ();
1638 }
1639 foreach my $p (split /\s+/, $_) {
1640 $grafts->{$c}->{$p} = 1;
1641 }
1642 } else {
1643 push @tmp, $_;
1644 }
1645 }
1646 close $fh or croak $!;
1647 @{$comments->{'END'}} = @tmp if @tmp;
1648 }
1649 return ($grafts, $comments);
1650}
1651sub write_grafts {
1653 my ($grafts, $comments, $gr_file) = @_;
1654 open my $fh, '>', $gr_file or croak $!;
1656 foreach my $c (sort keys %$grafts) {
1657 if ($comments->{$c}) {
1658 print $fh $_ foreach @{$comments->{$c}};
1659 }
1660 my $p = $grafts->{$c};
1661 my %x; # real parents
1662 delete $p->{$c}; # commits are not self-reproducing...
1663 my $ch = command_output_pipe(qw/cat-file commit/, $c);
1664 while (<$ch>) {
1665 if (/^parent ($sha1)/) {
1666 $x{$1} = $p->{$1} = 1;
1667 } else {
1668 last unless /^\S/;
1669 }
1670 }
1671 close $ch; # breaking the pipe
1672 # if real parents are the only ones in the grafts, drop it
1674 next if join(' ',sort keys %$p) eq join(' ',sort keys %x);
1675 my (@ip, @jp, $mb);
1677 my %del = %x;
1678 @ip = @jp = keys %$p;
1679 foreach my $i (@ip) {
1680 next if $del{$i} || $p->{$i} == 2;
1681 foreach my $j (@jp) {
1682 next if $i eq $j || $del{$j} || $p->{$j} == 2;
1683 $mb = eval { command('merge-base', $i, $j) };
1684 next unless $mb;
1685 chomp $mb;
1686 next if $x{$mb};
1687 if ($mb eq $j) {
1688 delete $p->{$i};
1689 $del{$i} = 1;
1690 } elsif ($mb eq $i) {
1691 delete $p->{$j};
1692 $del{$j} = 1;
1693 }
1694 }
1695 }
1696 # if real parents are the only ones in the grafts, drop it
1698 next if join(' ',sort keys %$p) eq join(' ',sort keys %x);
1699 print $fh $c, ' ', join(' ', sort keys %$p),"\n";
1701 }
1702 if ($comments->{'END'}) {
1703 print $fh $_ foreach @{$comments->{'END'}};
1704 }
1705 close $fh or croak $!;
1706}
1707sub read_url_paths_all {
1709 my ($l_map, $pfx, $p) = @_;
1710 my @dir;
1711 foreach (<$p/*>) {
1712 if (-r "$_/info/url") {
1713 $pfx .= '/' if $pfx && $pfx !~ m!/$!;
1714 my $id = $pfx . basename $_;
1715 my $url = file_to_s("$_/info/url");
1716 my ($u, $p) = repo_path_split($url);
1717 $l_map->{$u}->{$p} = $id;
1718 } elsif (-d $_) {
1719 push @dir, $_;
1720 }
1721 }
1722 foreach (@dir) {
1723 my $x = $_;
1724 $x =~ s!^\Q$GIT_DIR\E/svn/!!o;
1725 read_url_paths_all($l_map, $x, $_);
1726 }
1727}
1728# this one only gets ids that have been imported, not new ones
1730sub read_url_paths {
1731 my $l_map = {};
1732 git_svn_each(sub { my $x = shift;
1733 my $url = file_to_s("$GIT_DIR/svn/$x/info/url");
1734 my ($u, $p) = repo_path_split($url);
1735 $l_map->{$u}->{$p} = $x;
1736 });
1737 return $l_map;
1738}
1739sub extract_metadata {
1741 my $id = shift or return (undef, undef, undef);
1742 my ($url, $rev, $uuid) = ($id =~ /^git-svn-id:\s(\S+?)\@(\d+)
1743 \s([a-f\d\-]+)$/x);
1744 if (!defined $rev || !$uuid || !$url) {
1745 # some of the original repositories I made had
1746 # identifiers like this:
1747 ($rev, $uuid) = ($id =~/^git-svn-id:\s(\d+)\@([a-f\d\-]+)/);
1748 }
1749 return ($url, $rev, $uuid);
1750}
1751sub cmt_metadata {
1753 return extract_metadata((grep(/^git-svn-id: /,
1754 command(qw/cat-file commit/, shift)))[-1]);
1755}
1756sub get_commit_time {
1758 my $cmt = shift;
1759 my $fh = command_output_pipe(qw/rev-list --pretty=raw -n1/, $cmt);
1760 while (<$fh>) {
1761 /^committer\s(?:.+) (\d+) ([\-\+]?\d+)$/ or next;
1762 my ($s, $tz) = ($1, $2);
1763 if ($tz =~ s/^\+//) {
1764 $s += tz_to_s_offset($tz);
1765 } elsif ($tz =~ s/^\-//) {
1766 $s -= tz_to_s_offset($tz);
1767 }
1768 close $fh;
1769 return $s;
1770 }
1771 die "Can't get commit time for commit: $cmt\n";
1772}
1773sub tz_to_s_offset {
1775 my ($tz) = @_;
1776 $tz =~ s/(\d\d)$//;
1777 return ($1 * 60) + ($tz * 3600);
1778}
1779# adapted from pager.c
1781sub config_pager {
1782 $_pager ||= $ENV{GIT_PAGER} || $ENV{PAGER};
1783 if (!defined $_pager) {
1784 $_pager = 'less';
1785 } elsif (length $_pager == 0 || $_pager eq 'cat') {
1786 $_pager = undef;
1787 }
1788}
1789sub run_pager {
1791 return unless -t *STDOUT;
1792 pipe my $rfd, my $wfd or return;
1793 defined(my $pid = fork) or croak $!;
1794 if (!$pid) {
1795 open STDOUT, '>&', $wfd or croak $!;
1796 return;
1797 }
1798 open STDIN, '<&', $rfd or croak $!;
1799 $ENV{LESS} ||= 'FRSX';
1800 exec $_pager or croak "Can't run pager: $! ($_pager)\n";
1801}
1802sub get_author_info {
1804 my ($dest, $author, $t, $tz) = @_;
1805 $author =~ s/(?:^\s*|\s*$)//g;
1806 $dest->{a_raw} = $author;
1807 my $_a;
1808 if ($_authors) {
1809 $_a = $rusers{$author} || undef;
1810 }
1811 if (!$_a) {
1812 ($_a) = ($author =~ /<([^>]+)\@[^>]+>$/);
1813 }
1814 $dest->{t} = $t;
1815 $dest->{tz} = $tz;
1816 $dest->{a} = $_a;
1817 # Date::Parse isn't in the standard Perl distro :(
1818 if ($tz =~ s/^\+//) {
1819 $t += tz_to_s_offset($tz);
1820 } elsif ($tz =~ s/^\-//) {
1821 $t -= tz_to_s_offset($tz);
1822 }
1823 $dest->{t_utc} = $t;
1824}
1825sub process_commit {
1827 my ($c, $r_min, $r_max, $defer) = @_;
1828 if (defined $r_min && defined $r_max) {
1829 if ($r_min == $c->{r} && $r_min == $r_max) {
1830 show_commit($c);
1831 return 0;
1832 }
1833 return 1 if $r_min == $r_max;
1834 if ($r_min < $r_max) {
1835 # we need to reverse the print order
1836 return 0 if (defined $_limit && --$_limit < 0);
1837 push @$defer, $c;
1838 return 1;
1839 }
1840 if ($r_min != $r_max) {
1841 return 1 if ($r_min < $c->{r});
1842 return 1 if ($r_max > $c->{r});
1843 }
1844 }
1845 return 0 if (defined $_limit && --$_limit < 0);
1846 show_commit($c);
1847 return 1;
1848}
1849sub show_commit {
1851 my $c = shift;
1852 if ($_oneline) {
1853 my $x = "\n";
1854 if (my $l = $c->{l}) {
1855 while ($l->[0] =~ /^\s*$/) { shift @$l }
1856 $x = $l->[0];
1857 }
1858 $_l_fmt ||= 'A' . length($c->{r});
1859 print 'r',pack($_l_fmt, $c->{r}),' | ';
1860 print "$c->{c} | " if $_show_commit;
1861 print $x;
1862 } else {
1863 show_commit_normal($c);
1864 }
1865}
1866sub show_commit_changed_paths {
1868 my ($c) = @_;
1869 return unless $c->{changed};
1870 print "Changed paths:\n", @{$c->{changed}};
1871}
1872sub show_commit_normal {
1874 my ($c) = @_;
1875 print '-' x72, "\nr$c->{r} | ";
1876 print "$c->{c} | " if $_show_commit;
1877 print "$c->{a} | ", strftime("%Y-%m-%d %H:%M:%S %z (%a, %d %b %Y)",
1878 localtime($c->{t_utc})), ' | ';
1879 my $nr_line = 0;
1880 if (my $l = $c->{l}) {
1882 while ($l->[$#$l] eq "\n" && $#$l > 0
1883 && $l->[($#$l - 1)] eq "\n") {
1884 pop @$l;
1885 }
1886 $nr_line = scalar @$l;
1887 if (!$nr_line) {
1888 print "1 line\n\n\n";
1889 } else {
1890 if ($nr_line == 1) {
1891 $nr_line = '1 line';
1892 } else {
1893 $nr_line .= ' lines';
1894 }
1895 print $nr_line, "\n";
1896 show_commit_changed_paths($c);
1897 print "\n";
1898 print $_ foreach @$l;
1899 }
1900 } else {
1901 print "1 line\n";
1902 show_commit_changed_paths($c);
1903 print "\n";
1904 }
1906 foreach my $x (qw/raw diff/) {
1907 if ($c->{$x}) {
1908 print "\n";
1909 print $_ foreach @{$c->{$x}}
1910 }
1911 }
1912}
1913package Git::SVN::Prompt;
1915use strict;
1916use warnings;
1917require SVN::Core;
1918use vars qw/$_no_auth_cache $_username/;
1919sub simple {
1921 my ($cred, $realm, $default_username, $may_save, $pool) = @_;
1922 $may_save = undef if $_no_auth_cache;
1923 $default_username = $_username if defined $_username;
1924 if (defined $default_username && length $default_username) {
1925 if (defined $realm && length $realm) {
1926 print STDERR "Authentication realm: $realm\n";
1927 STDERR->flush;
1928 }
1929 $cred->username($default_username);
1930 } else {
1931 username($cred, $realm, $may_save, $pool);
1932 }
1933 $cred->password(_read_password("Password for '" .
1934 $cred->username . "': ", $realm));
1935 $cred->may_save($may_save);
1936 $SVN::_Core::SVN_NO_ERROR;
1937}
1938sub ssl_server_trust {
1940 my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_;
1941 $may_save = undef if $_no_auth_cache;
1942 print STDERR "Error validating server certificate for '$realm':\n";
1943 if ($failures & $SVN::Auth::SSL::UNKNOWNCA) {
1944 print STDERR " - The certificate is not issued by a trusted ",
1945 "authority. Use the\n",
1946 " fingerprint to validate the certificate manually!\n";
1947 }
1948 if ($failures & $SVN::Auth::SSL::CNMISMATCH) {
1949 print STDERR " - The certificate hostname does not match.\n";
1950 }
1951 if ($failures & $SVN::Auth::SSL::NOTYETVALID) {
1952 print STDERR " - The certificate is not yet valid.\n";
1953 }
1954 if ($failures & $SVN::Auth::SSL::EXPIRED) {
1955 print STDERR " - The certificate has expired.\n";
1956 }
1957 if ($failures & $SVN::Auth::SSL::OTHER) {
1958 print STDERR " - The certificate has an unknown error.\n";
1959 }
1960 printf STDERR
1961 "Certificate information:\n".
1962 " - Hostname: %s\n".
1963 " - Valid: from %s until %s\n".
1964 " - Issuer: %s\n".
1965 " - Fingerprint: %s\n",
1966 map $cert_info->$_, qw(hostname valid_from valid_until
1967 issuer_dname fingerprint);
1968 my $choice;
1969prompt:
1970 print STDERR $may_save ?
1971 "(R)eject, accept (t)emporarily or accept (p)ermanently? " :
1972 "(R)eject or accept (t)emporarily? ";
1973 STDERR->flush;
1974 $choice = lc(substr(<STDIN> || 'R', 0, 1));
1975 if ($choice =~ /^t$/i) {
1976 $cred->may_save(undef);
1977 } elsif ($choice =~ /^r$/i) {
1978 return -1;
1979 } elsif ($may_save && $choice =~ /^p$/i) {
1980 $cred->may_save($may_save);
1981 } else {
1982 goto prompt;
1983 }
1984 $cred->accepted_failures($failures);
1985 $SVN::_Core::SVN_NO_ERROR;
1986}
1987sub ssl_client_cert {
1989 my ($cred, $realm, $may_save, $pool) = @_;
1990 $may_save = undef if $_no_auth_cache;
1991 print STDERR "Client certificate filename: ";
1992 STDERR->flush;
1993 chomp(my $filename = <STDIN>);
1994 $cred->cert_file($filename);
1995 $cred->may_save($may_save);
1996 $SVN::_Core::SVN_NO_ERROR;
1997}
1998sub ssl_client_cert_pw {
2000 my ($cred, $realm, $may_save, $pool) = @_;
2001 $may_save = undef if $_no_auth_cache;
2002 $cred->password(_read_password("Password: ", $realm));
2003 $cred->may_save($may_save);
2004 $SVN::_Core::SVN_NO_ERROR;
2005}
2006sub username {
2008 my ($cred, $realm, $may_save, $pool) = @_;
2009 $may_save = undef if $_no_auth_cache;
2010 if (defined $realm && length $realm) {
2011 print STDERR "Authentication realm: $realm\n";
2012 }
2013 my $username;
2014 if (defined $_username) {
2015 $username = $_username;
2016 } else {
2017 print STDERR "Username: ";
2018 STDERR->flush;
2019 chomp($username = <STDIN>);
2020 }
2021 $cred->username($username);
2022 $cred->may_save($may_save);
2023 $SVN::_Core::SVN_NO_ERROR;
2024}
2025sub _read_password {
2027 my ($prompt, $realm) = @_;
2028 print STDERR $prompt;
2029 STDERR->flush;
2030 require Term::ReadKey;
2031 Term::ReadKey::ReadMode('noecho');
2032 my $password = '';
2033 while (defined(my $key = Term::ReadKey::ReadKey(0))) {
2034 last if $key =~ /[\012\015]/; # \n\r
2035 $password .= $key;
2036 }
2037 Term::ReadKey::ReadMode('restore');
2038 print STDERR "\n";
2039 STDERR->flush;
2040 $password;
2041}
2042package main;
2044sub libsvn_connect {
2046 my ($url) = @_;
2047 SVN::_Core::svn_config_ensure($_config_dir, undef);
2048 my ($baton, $callbacks) = SVN::Core::auth_open_helper([
2049 SVN::Client::get_simple_provider(),
2050 SVN::Client::get_ssl_server_trust_file_provider(),
2051 SVN::Client::get_simple_prompt_provider(
2052 \&Git::SVN::Prompt::simple, 2),
2053 SVN::Client::get_ssl_client_cert_prompt_provider(
2054 \&Git::SVN::Prompt::ssl_client_cert, 2),
2055 SVN::Client::get_ssl_client_cert_pw_prompt_provider(
2056 \&Git::SVN::Prompt::ssl_client_cert_pw, 2),
2057 SVN::Client::get_username_provider(),
2058 SVN::Client::get_ssl_server_trust_prompt_provider(
2059 \&Git::SVN::Prompt::ssl_server_trust),
2060 SVN::Client::get_username_prompt_provider(
2061 \&Git::SVN::username, 2),
2062 ]);
2063 my $config = SVN::Core::config_get_config($_config_dir);
2064 my $ra = SVN::Ra->new(url => $url, auth => $baton,
2065 config => $config,
2066 pool => SVN::Pool->new,
2067 auth_provider_callbacks => $callbacks);
2068 $ra->{svn_path} = $url;
2069 $ra->{repos_root} = $ra->get_repos_root;
2070 $ra->{svn_path} =~ s#^\Q$ra->{repos_root}\E/*##;
2071 push @repo_path_split_cache, qr/^(\Q$ra->{repos_root}\E)/;
2072 return $ra;
2073}
2074sub libsvn_can_do_switch {
2076 unless (defined $_svn_can_do_switch) {
2077 my $pool = SVN::Pool->new;
2078 my $rep = eval {
2079 $SVN->do_switch(1, '', 0, $SVN->{url},
2080 SVN::Delta::Editor->new, $pool);
2081 };
2082 if ($@) {
2083 $_svn_can_do_switch = 0;
2084 } else {
2085 $rep->abort_report($pool);
2086 $_svn_can_do_switch = 1;
2087 }
2088 $pool->clear;
2089 }
2090 $_svn_can_do_switch;
2091}
2092sub libsvn_dup_ra {
2094 my ($ra) = @_;
2095 SVN::Ra->new(map { $_ => $ra->{$_} } qw/config url
2096 auth auth_provider_callbacks repos_root svn_path/);
2097}
2098sub uri_encode {
2100 my ($f) = @_;
2101 $f =~ s#([^a-zA-Z0-9\*!\:_\./\-])#uc sprintf("%%%02x",ord($1))#eg;
2102 $f
2103}
2104sub uri_decode {
2106 my ($f) = @_;
2107 $f =~ tr/+/ /;
2108 $f =~ s/%([A-F0-9]{2})/chr hex($1)/ge;
2109 $f
2110}
2111sub libsvn_log_entry {
2113 my ($rev, $author, $date, $msg, $parents, $untracked) = @_;
2114 my ($Y,$m,$d,$H,$M,$S) = ($date =~ /^(\d{4})\-(\d\d)\-(\d\d)T
2115 (\d\d)\:(\d\d)\:(\d\d).\d+Z$/x)
2116 or die "Unable to parse date: $date\n";
2117 if (defined $author && length $author > 0 &&
2118 defined $_authors && ! defined $users{$author}) {
2119 die "Author: $author not defined in $_authors file\n";
2120 }
2121 $msg = '' if ($rev == 0 && !defined $msg);
2122 open my $un, '>>', "$GIT_SVN_DIR/unhandled.log" or croak $!;
2124 my $h;
2125 print $un "r$rev\n" or croak $!;
2126 $h = $untracked->{empty};
2127 foreach (sort keys %$h) {
2128 my $act = $h->{$_} ? '+empty_dir' : '-empty_dir';
2129 print $un " $act: ", uri_encode($_), "\n" or croak $!;
2130 warn "W: $act: $_\n";
2131 }
2132 foreach my $t (qw/dir_prop file_prop/) {
2133 $h = $untracked->{$t} or next;
2134 foreach my $path (sort keys %$h) {
2135 my $ppath = $path eq '' ? '.' : $path;
2136 foreach my $prop (sort keys %{$h->{$path}}) {
2137 next if $SKIP{$prop};
2138 my $v = $h->{$path}->{$prop};
2139 if (defined $v) {
2140 print $un " +$t: ",
2141 uri_encode($ppath), ' ',
2142 uri_encode($prop), ' ',
2143 uri_encode($v), "\n"
2144 or croak $!;
2145 } else {
2146 print $un " -$t: ",
2147 uri_encode($ppath), ' ',
2148 uri_encode($prop), "\n"
2149 or croak $!;
2150 }
2151 }
2152 }
2153 }
2154 foreach my $t (qw/absent_file absent_directory/) {
2155 $h = $untracked->{$t} or next;
2156 foreach my $parent (sort keys %$h) {
2157 foreach my $path (sort @{$h->{$parent}}) {
2158 print $un " $t: ",
2159 uri_encode("$parent/$path"), "\n"
2160 or croak $!;
2161 warn "W: $t: $parent/$path ",
2162 "Insufficient permissions?\n";
2163 }
2164 }
2165 }
2166 # revprops (make this optional? it's an extra network trip...)
2168 my $pool = SVN::Pool->new;
2169 my $rp = $SVN->rev_proplist($rev, $pool);
2170 foreach (sort keys %$rp) {
2171 next if /^svn:(?:author|date|log)$/;
2172 print $un " rev_prop: ", uri_encode($_), ' ',
2173 uri_encode($rp->{$_}), "\n";
2174 }
2175 $pool->clear;
2176 close $un or croak $!;
2177 { revision => $rev, date => "+0000 $Y-$m-$d $H:$M:$S",
2179 author => $author, msg => $msg."\n", parents => $parents || [],
2180 revprops => $rp }
2181}
2182sub libsvn_fetch {
2184 my ($last_commit, $paths, $rev, $author, $date, $msg) = @_;
2185 my $pool = SVN::Pool->new;
2186 my $ed = SVN::Git::Fetcher->new({ c => $last_commit, q => $_q });
2187 my $reporter = $SVN->do_update($rev, '', 1, $ed, $pool);
2188 my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
2189 my (undef, $last_rev, undef) = cmt_metadata($last_commit);
2190 $reporter->set_path('', $last_rev, 0, @lock, $pool);
2191 $reporter->finish_report($pool);
2192 $pool->clear;
2193 unless ($ed->{git_commit_ok}) {
2194 die "SVN connection failed somewhere...\n";
2195 }
2196 libsvn_log_entry($rev, $author, $date, $msg, [$last_commit], $ed);
2197}
2198sub svn_grab_base_rev {
2200 my $c = eval { command_oneline([qw/rev-parse --verify/,
2201 "refs/remotes/$GIT_SVN^0"],
2202 { STDERR => 0 }) };
2203 if (defined $c && length $c) {
2204 my ($url, $rev, $uuid) = cmt_metadata($c);
2205 return ($rev, $c) if defined $rev;
2206 }
2207 if ($_no_metadata) {
2208 my $offset = -41; # from tail
2209 my $rl;
2210 open my $fh, '<', $REVDB or
2211 die "--no-metadata specified and $REVDB not readable\n";
2212 seek $fh, $offset, 2;
2213 $rl = readline $fh;
2214 defined $rl or return (undef, undef);
2215 chomp $rl;
2216 while ($c ne $rl && tell $fh != 0) {
2217 $offset -= 41;
2218 seek $fh, $offset, 2;
2219 $rl = readline $fh;
2220 defined $rl or return (undef, undef);
2221 chomp $rl;
2222 }
2223 my $rev = tell $fh;
2224 croak $! if ($rev < -1);
2225 $rev = ($rev - 41) / 41;
2226 close $fh or croak $!;
2227 return ($rev, $c);
2228 }
2229 return (undef, undef);
2230}
2231sub libsvn_parse_revision {
2233 my $base = shift;
2234 my $head = $SVN->get_latest_revnum();
2235 if (!defined $_revision || $_revision eq 'BASE:HEAD') {
2236 return ($base + 1, $head) if (defined $base);
2237 return (0, $head);
2238 }
2239 return ($1, $2) if ($_revision =~ /^(\d+):(\d+)$/);
2240 return ($_revision, $_revision) if ($_revision =~ /^\d+$/);
2241 if ($_revision =~ /^BASE:(\d+)$/) {
2242 return ($base + 1, $1) if (defined $base);
2243 return (0, $head);
2244 }
2245 return ($1, $head) if ($_revision =~ /^(\d+):HEAD$/);
2246 die "revision argument: $_revision not understood by git-svn\n",
2247 "Try using the command-line svn client instead\n";
2248}
2249sub libsvn_traverse_ignore {
2251 my ($fh, $path, $r) = @_;
2252 $path =~ s#^/+##g;
2253 my $pool = SVN::Pool->new;
2254 my ($dirent, undef, $props) = $SVN->get_dir($path, $r, $pool);
2255 my $p = $path;
2256 $p =~ s#^\Q$SVN->{svn_path}\E/##;
2257 print $fh length $p ? "\n# $p\n" : "\n# /\n";
2258 if (my $s = $props->{'svn:ignore'}) {
2259 $s =~ s/[\r\n]+/\n/g;
2260 chomp $s;
2261 if (length $p == 0) {
2262 $s =~ s#\n#\n/$p#g;
2263 print $fh "/$s\n";
2264 } else {
2265 $s =~ s#\n#\n/$p/#g;
2266 print $fh "/$p/$s\n";
2267 }
2268 }
2269 foreach (sort keys %$dirent) {
2270 next if $dirent->{$_}->kind != $SVN::Node::dir;
2271 libsvn_traverse_ignore($fh, "$path/$_", $r);
2272 }
2273 $pool->clear;
2274}
2275sub revisions_eq {
2277 my ($path, $r0, $r1) = @_;
2278 return 1 if $r0 == $r1;
2279 my $nr = 0;
2280 # should be OK to use Pool here (r1 - r0) should be small
2281 my $pool = SVN::Pool->new;
2282 libsvn_get_log($SVN, [$path], $r0, $r1,
2283 0, 0, 1, sub {$nr++}, $pool);
2284 $pool->clear;
2285 return 0 if ($nr > 1);
2286 return 1;
2287}
2288sub libsvn_find_parent_branch {
2290 my ($paths, $rev, $author, $date, $msg) = @_;
2291 my $svn_path = '/'.$SVN->{svn_path};
2292 # look for a parent from another branch:
2294 my $i = $paths->{$svn_path} or return;
2295 my $branch_from = $i->copyfrom_path or return;
2296 my $r = $i->copyfrom_rev;
2297 print STDERR "Found possible branch point: ",
2298 "$branch_from => $svn_path, $r\n";
2299 $branch_from =~ s#^/##;
2300 my $l_map = {};
2301 read_url_paths_all($l_map, '', "$GIT_DIR/svn");
2302 my $url = $SVN->{repos_root};
2303 defined $l_map->{$url} or return;
2304 my $id = $l_map->{$url}->{$branch_from};
2305 if (!defined $id && $_follow_parent) {
2306 print STDERR "Following parent: $branch_from\@$r\n";
2307 # auto create a new branch and follow it
2308 $id = basename($branch_from);
2309 $id .= '@'.$r if -r "$GIT_DIR/svn/$id";
2310 while (-r "$GIT_DIR/svn/$id") {
2311 # just grow a tail if we're not unique enough :x
2312 $id .= '-';
2313 }
2314 }
2315 return unless defined $id;
2316 my ($r0, $parent) = find_rev_before($r,$id,1);
2318 if ($_follow_parent && (!defined $r0 || !defined $parent)) {
2319 defined(my $pid = fork) or croak $!;
2320 if (!$pid) {
2321 $GIT_SVN = $ENV{GIT_SVN_ID} = $id;
2322 init_vars();
2323 $SVN_URL = "$url/$branch_from";
2324 $SVN = undef;
2325 setup_git_svn();
2326 # we can't assume SVN_URL exists at r+1:
2327 $_revision = "0:$r";
2328 fetch_lib();
2329 exit 0;
2330 }
2331 waitpid $pid, 0;
2332 croak $? if $?;
2333 ($r0, $parent) = find_rev_before($r,$id,1);
2334 }
2335 return unless (defined $r0 && defined $parent);
2336 if (revisions_eq($branch_from, $r0, $r)) {
2337 unlink $GIT_SVN_INDEX;
2338 print STDERR "Found branch parent: ($GIT_SVN) $parent\n";
2339 command_noisy('read-tree', $parent);
2340 unless (libsvn_can_do_switch()) {
2341 return _libsvn_new_tree($paths, $rev, $author, $date,
2342 $msg, [$parent]);
2343 }
2344 # do_switch works with svn/trunk >= r22312, but that is not
2345 # included with SVN 1.4.2 (the latest version at the moment),
2346 # so we can't rely on it.
2347 my $ra = libsvn_connect("$url/$branch_from");
2348 my $ed = SVN::Git::Fetcher->new({c => $parent, q => $_q });
2349 my $pool = SVN::Pool->new;
2350 my $reporter = $ra->do_switch($rev, '', 1, $SVN->{url},
2351 $ed, $pool);
2352 my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
2353 $reporter->set_path('', $r0, 0, @lock, $pool);
2354 $reporter->finish_report($pool);
2355 $pool->clear;
2356 unless ($ed->{git_commit_ok}) {
2357 die "SVN connection failed somewhere...\n";
2358 }
2359 return libsvn_log_entry($rev, $author, $date, $msg, [$parent]);
2360 }
2361 print STDERR "Nope, branch point not imported or unknown\n";
2362 return undef;
2363}
2364sub libsvn_get_log {
2366 my ($ra, @args) = @_;
2367 $args[4]-- if $args[4] && ! $_follow_parent;
2368 if ($SVN::Core::VERSION le '1.2.0') {
2369 splice(@args, 3, 1);
2370 }
2371 $ra->get_log(@args);
2372}
2373sub libsvn_new_tree {
2375 if (my $log_entry = libsvn_find_parent_branch(@_)) {
2376 return $log_entry;
2377 }
2378 my ($paths, $rev, $author, $date, $msg) = @_; # $pool is last
2379 _libsvn_new_tree($paths, $rev, $author, $date, $msg, []);
2380}
2381sub _libsvn_new_tree {
2383 my ($paths, $rev, $author, $date, $msg, $parents) = @_;
2384 my $pool = SVN::Pool->new;
2385 my $ed = SVN::Git::Fetcher->new({q => $_q});
2386 my $reporter = $SVN->do_update($rev, '', 1, $ed, $pool);
2387 my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : ();
2388 $reporter->set_path('', $rev, 1, @lock, $pool);
2389 $reporter->finish_report($pool);
2390 $pool->clear;
2391 unless ($ed->{git_commit_ok}) {
2392 die "SVN connection failed somewhere...\n";
2393 }
2394 libsvn_log_entry($rev, $author, $date, $msg, $parents, $ed);
2395}
2396sub find_graft_path_commit {
2398 my ($tree_paths, $p1, $r1) = @_;
2399 foreach my $x (keys %$tree_paths) {
2400 next unless ($p1 =~ /^\Q$x\E/);
2401 my $i = $tree_paths->{$x};
2402 my ($r0, $parent) = find_rev_before($r1,$i,1);
2403 return $parent if (defined $r0 && $r0 == $r1);
2404 print STDERR "r$r1 of $i not imported\n";
2405 next;
2406 }
2407 return undef;
2408}
2409sub find_graft_path_parents {
2411 my ($grafts, $tree_paths, $c, $p0, $r0) = @_;
2412 foreach my $x (keys %$tree_paths) {
2413 next unless ($p0 =~ /^\Q$x\E/);
2414 my $i = $tree_paths->{$x};
2415 my ($r, $parent) = find_rev_before($r0, $i, 1);
2416 if (defined $r && defined $parent && revisions_eq($x,$r,$r0)) {
2417 my ($url_b, undef, $uuid_b) = cmt_metadata($c);
2418 my ($url_a, undef, $uuid_a) = cmt_metadata($parent);
2419 next if ($url_a && $url_b && $url_a eq $url_b &&
2420 $uuid_b eq $uuid_a);
2421 $grafts->{$c}->{$parent} = 1;
2422 }
2423 }
2424}
2425sub libsvn_graft_file_copies {
2427 my ($grafts, $tree_paths, $path, $paths, $rev) = @_;
2428 foreach (keys %$paths) {
2429 my $i = $paths->{$_};
2430 my ($m, $p0, $r0) = ($i->action, $i->copyfrom_path,
2431 $i->copyfrom_rev);
2432 next unless (defined $p0 && defined $r0);
2433 my $p1 = $_;
2435 $p1 =~ s#^/##;
2436 $p0 =~ s#^/##;
2437 my $c = find_graft_path_commit($tree_paths, $p1, $rev);
2438 next unless $c;
2439 find_graft_path_parents($grafts, $tree_paths, $c, $p0, $r0);
2440 }
2441}
2442sub set_index {
2444 my $old = $ENV{GIT_INDEX_FILE};
2445 $ENV{GIT_INDEX_FILE} = shift;
2446 return $old;
2447}
2448sub restore_index {
2450 my ($old) = @_;
2451 if (defined $old) {
2452 $ENV{GIT_INDEX_FILE} = $old;
2453 } else {
2454 delete $ENV{GIT_INDEX_FILE};
2455 }
2456}
2457sub libsvn_commit_cb {
2459 my ($rev, $date, $committer, $c, $msg, $r_last, $cmt_last) = @_;
2460 if ($_optimize_commits && $rev == ($r_last + 1)) {
2461 my $log = libsvn_log_entry($rev,$committer,$date,$msg);
2462 $log->{tree} = get_tree_from_treeish($c);
2463 my $cmt = git_commit($log, $cmt_last, $c);
2464 my @diff = command('diff-tree', $cmt, $c);
2465 if (@diff) {
2466 print STDERR "Trees differ: $cmt $c\n",
2467 join('',@diff),"\n";
2468 exit 1;
2469 }
2470 } else {
2471 fetch("$rev=$c");
2472 }
2473}
2474sub libsvn_ls_fullurl {
2476 my $fullurl = shift;
2477 my $ra = libsvn_connect($fullurl);
2478 my @ret;
2479 my $pool = SVN::Pool->new;
2480 my $r = defined $_revision ? $_revision : $ra->get_latest_revnum;
2481 my ($dirent, undef, undef) = $ra->get_dir('', $r, $pool);
2482 foreach my $d (sort keys %$dirent) {
2483 if ($dirent->{$d}->kind == $SVN::Node::dir) {
2484 push @ret, "$d/"; # add '/' for compat with cli svn
2485 }
2486 }
2487 $pool->clear;
2488 return @ret;
2489}
2490sub libsvn_skip_unknown_revs {
2493 my $err = shift;
2494 my $errno = $err->apr_err();
2495 # Maybe the branch we're tracking didn't
2496 # exist when the repo started, so it's
2497 # not an error if it doesn't, just continue
2498 #
2499 # Wonderfully consistent library, eh?
2500 # 160013 - svn:// and file://
2501 # 175002 - http(s)://
2502 # 175007 - http(s):// (this repo required authorization, too...)
2503 # More codes may be discovered later...
2504 if ($errno == 175007 || $errno == 175002 || $errno == 160013) {
2505 return;
2506 }
2507 croak "Error from SVN, ($errno): ", $err->expanded_message,"\n";
2508};
2509# Tie::File seems to be prone to offset errors if revisions get sparse,
2511# it's not that fast, either. Tie::File is also not in Perl 5.6. So
2512# one of my favorite modules is out :< Next up would be one of the DBM
2513# modules, but I'm not sure which is most portable... So I'll just
2514# go with something that's plain-text, but still capable of
2515# being randomly accessed. So here's my ultra-simple fixed-width
2516# database. All records are 40 characters + "\n", so it's easy to seek
2517# to a revision: (41 * rev) is the byte offset.
2518# A record of 40 0s denotes an empty revision.
2519# And yes, it's still pretty fast (faster than Tie::File).
2520sub revdb_set {
2521 my ($file, $rev, $commit) = @_;
2522 length $commit == 40 or croak "arg3 must be a full SHA1 hexsum\n";
2523 open my $fh, '+<', $file or croak $!;
2524 my $offset = $rev * 41;
2525 # assume that append is the common case:
2526 seek $fh, 0, 2 or croak $!;
2527 my $pos = tell $fh;
2528 if ($pos < $offset) {
2529 print $fh (('0' x 40),"\n") x (($offset - $pos) / 41);
2530 }
2531 seek $fh, $offset, 0 or croak $!;
2532 print $fh $commit,"\n";
2533 close $fh or croak $!;
2534}
2535sub revdb_get {
2537 my ($file, $rev) = @_;
2538 my $ret;
2539 my $offset = $rev * 41;
2540 open my $fh, '<', $file or croak $!;
2541 seek $fh, $offset, 0;
2542 if (tell $fh == $offset) {
2543 $ret = readline $fh;
2544 if (defined $ret) {
2545 chomp $ret;
2546 $ret = undef if ($ret =~ /^0{40}$/);
2547 }
2548 }
2549 close $fh or croak $!;
2550 return $ret;
2551}
2552sub copy_remote_ref {
2554 my $origin = $_cp_remote ? $_cp_remote : 'origin';
2555 my $ref = "refs/remotes/$GIT_SVN";
2556 if (command('ls-remote', $origin, $ref)) {
2557 command_noisy('fetch', $origin, "$ref:$ref");
2558 } elsif ($_cp_remote && !$_upgrade) {
2559 die "Unable to find remote reference: ",
2560 "refs/remotes/$GIT_SVN on $origin\n";
2561 }
2562}
2563{
2565 my $kill_stupid_warnings = $SVN::Node::none.$SVN::Node::file.
2566 $SVN::Node::dir.$SVN::Node::unknown.
2567 $SVN::Node::none.$SVN::Node::file.
2568 $SVN::Node::dir.$SVN::Node::unknown.
2569 $SVN::Auth::SSL::CNMISMATCH.
2570 $SVN::Auth::SSL::NOTYETVALID.
2571 $SVN::Auth::SSL::EXPIRED.
2572 $SVN::Auth::SSL::UNKNOWNCA.
2573 $SVN::Auth::SSL::OTHER;
2574}
2575package SVN::Git::Fetcher;
2577use vars qw/@ISA/;
2578use strict;
2579use warnings;
2580use Carp qw/croak/;
2581use IO::File qw//;
2582use Git qw/command command_oneline command_noisy
2583 command_output_pipe command_input_pipe command_close_pipe/;
2584# file baton members: path, mode_a, mode_b, pool, fh, blob, base
2586sub new {
2587 my ($class, $git_svn) = @_;
2588 my $self = SVN::Delta::Editor->new;
2589 bless $self, $class;
2590 $self->{c} = $git_svn->{c} if exists $git_svn->{c};
2591 $self->{q} = $git_svn->{q};
2592 $self->{empty} = {};
2593 $self->{dir_prop} = {};
2594 $self->{file_prop} = {};
2595 $self->{absent_dir} = {};
2596 $self->{absent_file} = {};
2597 ($self->{gui}, $self->{ctx}) = command_input_pipe(
2598 qw/update-index -z --index-info/);
2599 require Digest::MD5;
2600 $self;
2601}
2602sub open_root {
2604 { path => '' };
2605}
2606sub open_directory {
2608 my ($self, $path, $pb, $rev) = @_;
2609 { path => $path };
2610}
2611sub delete_entry {
2613 my ($self, $path, $rev, $pb) = @_;
2614 my $gui = $self->{gui};
2615 # remove entire directories.
2617 if (command('ls-tree', $self->{c}, '--', $path) =~ /^040000 tree/) {
2618 my ($ls, $ctx) = command_output_pipe(qw/ls-tree
2619 -r --name-only -z/,
2620 $self->{c}, '--', $path);
2621 local $/ = "\0";
2622 while (<$ls>) {
2623 print $gui '0 ',0 x 40,"\t",$_ or croak $!;
2624 print "\tD\t$_\n" unless $self->{q};
2625 }
2626 print "\tD\t$path/\n" unless $self->{q};
2627 command_close_pipe($ls, $ctx);
2628 $self->{empty}->{$path} = 0
2629 } else {
2630 print $gui '0 ',0 x 40,"\t",$path,"\0" or croak $!;
2631 print "\tD\t$path\n" unless $self->{q};
2632 }
2633 undef;
2634}
2635sub open_file {
2637 my ($self, $path, $pb, $rev) = @_;
2638 my ($mode, $blob) = (command('ls-tree', $self->{c}, '--',$path)
2639 =~ /^(\d{6}) blob ([a-f\d]{40})\t/);
2640 unless (defined $mode && defined $blob) {
2641 die "$path was not found in commit $self->{c} (r$rev)\n";
2642 }
2643 { path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
2644 pool => SVN::Pool->new, action => 'M' };
2645}
2646sub add_file {
2648 my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
2649 my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
2650 delete $self->{empty}->{$dir};
2651 { path => $path, mode_a => 100644, mode_b => 100644,
2652 pool => SVN::Pool->new, action => 'A' };
2653}
2654sub add_directory {
2656 my ($self, $path, $cp_path, $cp_rev) = @_;
2657 my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
2658 delete $self->{empty}->{$dir};
2659 $self->{empty}->{$path} = 1;
2660 { path => $path };
2661}
2662sub change_dir_prop {
2664 my ($self, $db, $prop, $value) = @_;
2665 $self->{dir_prop}->{$db->{path}} ||= {};
2666 $self->{dir_prop}->{$db->{path}}->{$prop} = $value;
2667 undef;
2668}
2669sub absent_directory {
2671 my ($self, $path, $pb) = @_;
2672 $self->{absent_dir}->{$pb->{path}} ||= [];
2673 push @{$self->{absent_dir}->{$pb->{path}}}, $path;
2674 undef;
2675}
2676sub absent_file {
2678 my ($self, $path, $pb) = @_;
2679 $self->{absent_file}->{$pb->{path}} ||= [];
2680 push @{$self->{absent_file}->{$pb->{path}}}, $path;
2681 undef;
2682}
2683sub change_file_prop {
2685 my ($self, $fb, $prop, $value) = @_;
2686 if ($prop eq 'svn:executable') {
2687 if ($fb->{mode_b} != 120000) {
2688 $fb->{mode_b} = defined $value ? 100755 : 100644;
2689 }
2690 } elsif ($prop eq 'svn:special') {
2691 $fb->{mode_b} = defined $value ? 120000 : 100644;
2692 } else {
2693 $self->{file_prop}->{$fb->{path}} ||= {};
2694 $self->{file_prop}->{$fb->{path}}->{$prop} = $value;
2695 }
2696 undef;
2697}
2698sub apply_textdelta {
2700 my ($self, $fb, $exp) = @_;
2701 my $fh = IO::File->new_tmpfile;
2702 $fh->autoflush(1);
2703 # $fh gets auto-closed() by SVN::TxDelta::apply(),
2704 # (but $base does not,) so dup() it for reading in close_file
2705 open my $dup, '<&', $fh or croak $!;
2706 my $base = IO::File->new_tmpfile;
2707 $base->autoflush(1);
2708 if ($fb->{blob}) {
2709 defined (my $pid = fork) or croak $!;
2710 if (!$pid) {
2711 open STDOUT, '>&', $base or croak $!;
2712 print STDOUT 'link ' if ($fb->{mode_a} == 120000);
2713 exec qw/git-cat-file blob/, $fb->{blob} or croak $!;
2714 }
2715 waitpid $pid, 0;
2716 croak $? if $?;
2717 if (defined $exp) {
2719 seek $base, 0, 0 or croak $!;
2720 my $md5 = Digest::MD5->new;
2721 $md5->addfile($base);
2722 my $got = $md5->hexdigest;
2723 die "Checksum mismatch: $fb->{path} $fb->{blob}\n",
2724 "expected: $exp\n",
2725 " got: $got\n" if ($got ne $exp);
2726 }
2727 }
2728 seek $base, 0, 0 or croak $!;
2729 $fb->{fh} = $dup;
2730 $fb->{base} = $base;
2731 [ SVN::TxDelta::apply($base, $fh, undef, $fb->{path}, $fb->{pool}) ];
2732}
2733sub close_file {
2735 my ($self, $fb, $exp) = @_;
2736 my $hash;
2737 my $path = $fb->{path};
2738 if (my $fh = $fb->{fh}) {
2739 seek($fh, 0, 0) or croak $!;
2740 my $md5 = Digest::MD5->new;
2741 $md5->addfile($fh);
2742 my $got = $md5->hexdigest;
2743 die "Checksum mismatch: $path\n",
2744 "expected: $exp\n got: $got\n" if ($got ne $exp);
2745 seek($fh, 0, 0) or croak $!;
2746 if ($fb->{mode_b} == 120000) {
2747 read($fh, my $buf, 5) == 5 or croak $!;
2748 $buf eq 'link ' or die "$path has mode 120000",
2749 "but is not a link\n";
2750 }
2751 defined(my $pid = open my $out,'-|') or die "Can't fork: $!\n";
2752 if (!$pid) {
2753 open STDIN, '<&', $fh or croak $!;
2754 exec qw/git-hash-object -w --stdin/ or croak $!;
2755 }
2756 chomp($hash = do { local $/; <$out> });
2757 close $out or croak $!;
2758 close $fh or croak $!;
2759 $hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";
2760 close $fb->{base} or croak $!;
2761 } else {
2762 $hash = $fb->{blob} or die "no blob information\n";
2763 }
2764 $fb->{pool}->clear;
2765 my $gui = $self->{gui};
2766 print $gui "$fb->{mode_b} $hash\t$path\0" or croak $!;
2767 print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $self->{q};
2768 undef;
2769}
2770sub abort_edit {
2772 my $self = shift;
2773 eval { command_close_pipe($self->{gui}, $self->{ctx}) };
2774 $self->SUPER::abort_edit(@_);
2775}
2776sub close_edit {
2778 my $self = shift;
2779 command_close_pipe($self->{gui}, $self->{ctx});
2780 $self->{git_commit_ok} = 1;
2781 $self->SUPER::close_edit(@_);
2782}
2783package SVN::Git::Editor;
2785use vars qw/@ISA/;
2786use strict;
2787use warnings;
2788use Carp qw/croak/;
2789use IO::File;
2790use Git qw/command command_oneline command_noisy
2791 command_output_pipe command_input_pipe command_close_pipe/;
2792sub new {
2794 my $class = shift;
2795 my $git_svn = shift;
2796 my $self = SVN::Delta::Editor->new(@_);
2797 bless $self, $class;
2798 foreach (qw/svn_path c r ra /) {
2799 die "$_ required!\n" unless (defined $git_svn->{$_});
2800 $self->{$_} = $git_svn->{$_};
2801 }
2802 $self->{pool} = SVN::Pool->new;
2803 $self->{bat} = { '' => $self->open_root($self->{r}, $self->{pool}) };
2804 $self->{rm} = { };
2805 require Digest::MD5;
2806 return $self;
2807}
2808sub split_path {
2810 return ($_[0] =~ m#^(.*?)/?([^/]+)$#);
2811}
2812sub repo_path {
2814 (defined $_[1] && length $_[1]) ? $_[1] : ''
2815}
2816sub url_path {
2818 my ($self, $path) = @_;
2819 $self->{ra}->{url} . '/' . $self->repo_path($path);
2820}
2821sub rmdirs {
2823 my ($self, $q) = @_;
2824 my $rm = $self->{rm};
2825 delete $rm->{''}; # we never delete the url we're tracking
2826 return unless %$rm;
2827 foreach (keys %$rm) {
2829 my @d = split m#/#, $_;
2830 my $c = shift @d;
2831 $rm->{$c} = 1;
2832 while (@d) {
2833 $c .= '/' . shift @d;
2834 $rm->{$c} = 1;
2835 }
2836 }
2837 delete $rm->{$self->{svn_path}};
2838 delete $rm->{''}; # we never delete the url we're tracking
2839 return unless %$rm;
2840 my ($fh, $ctx) = command_output_pipe(
2842 qw/ls-tree --name-only -r -z/, $self->{c});
2843 local $/ = "\0";
2844 while (<$fh>) {
2845 chomp;
2846 my @dn = split m#/#, $_;
2847 while (pop @dn) {
2848 delete $rm->{join '/', @dn};
2849 }
2850 unless (%$rm) {
2851 close $fh;
2852 return;
2853 }
2854 }
2855 command_close_pipe($fh, $ctx);
2856 my ($r, $p, $bat) = ($self->{r}, $self->{pool}, $self->{bat});
2858 foreach my $d (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$rm) {
2859 $self->close_directory($bat->{$d}, $p);
2860 my ($dn) = ($d =~ m#^(.*?)/?(?:[^/]+)$#);
2861 print "\tD+\t$d/\n" unless $q;
2862 $self->SUPER::delete_entry($d, $r, $bat->{$dn}, $p);
2863 delete $bat->{$d};
2864 }
2865}
2866sub open_or_add_dir {
2868 my ($self, $full_path, $baton) = @_;
2869 my $p = SVN::Pool->new;
2870 my $t = $self->{ra}->check_path($full_path, $self->{r}, $p);
2871 $p->clear;
2872 if ($t == $SVN::Node::none) {
2873 return $self->add_directory($full_path, $baton,
2874 undef, -1, $self->{pool});
2875 } elsif ($t == $SVN::Node::dir) {
2876 return $self->open_directory($full_path, $baton,
2877 $self->{r}, $self->{pool});
2878 }
2879 print STDERR "$full_path already exists in repository at ",
2880 "r$self->{r} and it is not a directory (",
2881 ($t == $SVN::Node::file ? 'file' : 'unknown'),"/$t)\n";
2882 exit 1;
2883}
2884sub ensure_path {
2886 my ($self, $path) = @_;
2887 my $bat = $self->{bat};
2888 $path = $self->repo_path($path);
2889 return $bat->{''} unless (length $path);
2890 my @p = split m#/+#, $path;
2891 my $c = shift @p;
2892 $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{''});
2893 while (@p) {
2894 my $c0 = $c;
2895 $c .= '/' . shift @p;
2896 $bat->{$c} ||= $self->open_or_add_dir($c, $bat->{$c0});
2897 }
2898 return $bat->{$c};
2899}
2900sub A {
2902 my ($self, $m, $q) = @_;
2903 my ($dir, $file) = split_path($m->{file_b});
2904 my $pbat = $self->ensure_path($dir);
2905 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
2906 undef, -1);
2907 print "\tA\t$m->{file_b}\n" unless $q;
2908 $self->chg_file($fbat, $m);
2909 $self->close_file($fbat,undef,$self->{pool});
2910}
2911sub C {
2913 my ($self, $m, $q) = @_;
2914 my ($dir, $file) = split_path($m->{file_b});
2915 my $pbat = $self->ensure_path($dir);
2916 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
2917 $self->url_path($m->{file_a}), $self->{r});
2918 print "\tC\t$m->{file_a} => $m->{file_b}\n" unless $q;
2919 $self->chg_file($fbat, $m);
2920 $self->close_file($fbat,undef,$self->{pool});
2921}
2922sub delete_entry {
2924 my ($self, $path, $pbat) = @_;
2925 my $rpath = $self->repo_path($path);
2926 my ($dir, $file) = split_path($rpath);
2927 $self->{rm}->{$dir} = 1;
2928 $self->SUPER::delete_entry($rpath, $self->{r}, $pbat, $self->{pool});
2929}
2930sub R {
2932 my ($self, $m, $q) = @_;
2933 my ($dir, $file) = split_path($m->{file_b});
2934 my $pbat = $self->ensure_path($dir);
2935 my $fbat = $self->add_file($self->repo_path($m->{file_b}), $pbat,
2936 $self->url_path($m->{file_a}), $self->{r});
2937 print "\tR\t$m->{file_a} => $m->{file_b}\n" unless $q;
2938 $self->chg_file($fbat, $m);
2939 $self->close_file($fbat,undef,$self->{pool});
2940 ($dir, $file) = split_path($m->{file_a});
2942 $pbat = $self->ensure_path($dir);
2943 $self->delete_entry($m->{file_a}, $pbat);
2944}
2945sub M {
2947 my ($self, $m, $q) = @_;
2948 my ($dir, $file) = split_path($m->{file_b});
2949 my $pbat = $self->ensure_path($dir);
2950 my $fbat = $self->open_file($self->repo_path($m->{file_b}),
2951 $pbat,$self->{r},$self->{pool});
2952 print "\t$m->{chg}\t$m->{file_b}\n" unless $q;
2953 $self->chg_file($fbat, $m);
2954 $self->close_file($fbat,undef,$self->{pool});
2955}
2956sub T { shift->M(@_) }
2958sub change_file_prop {
2960 my ($self, $fbat, $pname, $pval) = @_;
2961 $self->SUPER::change_file_prop($fbat, $pname, $pval, $self->{pool});
2962}
2963sub chg_file {
2965 my ($self, $fbat, $m) = @_;
2966 if ($m->{mode_b} =~ /755$/ && $m->{mode_a} !~ /755$/) {
2967 $self->change_file_prop($fbat,'svn:executable','*');
2968 } elsif ($m->{mode_b} !~ /755$/ && $m->{mode_a} =~ /755$/) {
2969 $self->change_file_prop($fbat,'svn:executable',undef);
2970 }
2971 my $fh = IO::File->new_tmpfile or croak $!;
2972 if ($m->{mode_b} =~ /^120/) {
2973 print $fh 'link ' or croak $!;
2974 $self->change_file_prop($fbat,'svn:special','*');
2975 } elsif ($m->{mode_a} =~ /^120/ && $m->{mode_b} !~ /^120/) {
2976 $self->change_file_prop($fbat,'svn:special',undef);
2977 }
2978 defined(my $pid = fork) or croak $!;
2979 if (!$pid) {
2980 open STDOUT, '>&', $fh or croak $!;
2981 exec qw/git-cat-file blob/, $m->{sha1_b} or croak $!;
2982 }
2983 waitpid $pid, 0;
2984 croak $? if $?;
2985 $fh->flush == 0 or croak $!;
2986 seek $fh, 0, 0 or croak $!;
2987 my $md5 = Digest::MD5->new;
2989 $md5->addfile($fh) or croak $!;
2990 seek $fh, 0, 0 or croak $!;
2991 my $exp = $md5->hexdigest;
2993 my $pool = SVN::Pool->new;
2994 my $atd = $self->apply_textdelta($fbat, undef, $pool);
2995 my $got = SVN::TxDelta::send_stream($fh, @$atd, $pool);
2996 die "Checksum mismatch\nexpected: $exp\ngot: $got\n" if ($got ne $exp);
2997 $pool->clear;
2998 close $fh or croak $!;
3000}
3001sub D {
3003 my ($self, $m, $q) = @_;
3004 my ($dir, $file) = split_path($m->{file_b});
3005 my $pbat = $self->ensure_path($dir);
3006 print "\tD\t$m->{file_b}\n" unless $q;
3007 $self->delete_entry($m->{file_b}, $pbat);
3008}
3009sub close_edit {
3011 my ($self) = @_;
3012 my ($p,$bat) = ($self->{pool}, $self->{bat});
3013 foreach (sort { $b =~ tr#/#/# <=> $a =~ tr#/#/# } keys %$bat) {
3014 $self->close_directory($bat->{$_}, $p);
3015 }
3016 $self->SUPER::close_edit($p);
3017 $p->clear;
3018}
3019sub abort_edit {
3021 my ($self) = @_;
3022 $self->SUPER::abort_edit($self->{pool});
3023 $self->{pool}->clear;
3024}
3025__END__
3027Data structures:
3029$log_msg hashref as returned by libsvn_log_entry()
3031{
3032 msg => 'whitespace-formatted log entry
3033', # trailing newline is preserved
3034 revision => '8', # integer
3035 date => '2004-02-24T17:01:44.108345Z', # commit date
3036 author => 'committer name'
3037};
3038@mods = array of diff-index line hashes, each element represents one line
3040 of diff-index output
3041diff-index line ($m hash)
3043{
3044 mode_a => first column of diff-index output, no leading ':',
3045 mode_b => second column of diff-index output,
3046 sha1_b => sha1sum of the final blob,
3047 chg => change type [MCRADT],
3048 file_a => original file name of a file (iff chg is 'C' or 'R')
3049 file_b => new/current file name of a file (any chg)
3050}
3051;
3052# retval of read_url_paths{,_all}();
3054$l_map = {
3055 # repository root url
3056 'https://svn.musicpd.org' => {
3057 # repository path # GIT_SVN_ID
3058 'mpd/trunk' => 'trunk',
3059 'mpd/tags/0.11.5' => 'tags/0.11.5',
3060 },
3061}
3062Notes:
3064 I don't trust the each() function on unless I created %hash myself
3065 because the internal iterator may not have started at base.