Andrew's git - gitweb.git/blob

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