3 # This tool is copyright (c) 2005, Matthias Urlichs.
4 # It is released under the Gnu Public License, version 2.
6 # The basic idea is to aggregate CVS check-ins into related changes.
7 # Fortunately, "cvsps" does that for us; all we have to do is to parse
10 # Checking out the files is done by a single long-running CVS connection
13 # The head revision is on branch "origin" by default.
14 # You can change that with the '-o' option.
21 use File
::Temp
qw(tempfile tmpnam);
22 use File
::Path
qw(mkpath);
23 use File
::Basename
qw(basename dirname);
27 use POSIX
qw(strftime dup2 ENOENT);
30 $SIG{'PIPE'}="IGNORE";
33 our ($opt_h,$opt_o,$opt_v,$opt_k,$opt_u,$opt_d,$opt_p,$opt_C,$opt_z,$opt_i,$opt_P, $opt_s,$opt_m,@opt_M,$opt_A,$opt_S,$opt_L, $opt_a, $opt_r, $opt_R);
34 my (%conv_author_name, %conv_author_email);
38 print(STDERR
"Error: $msg\n") if $msg;
40 Usage: git cvsimport # fetch/update GIT from CVS
41 [-o branch-for-HEAD] [-h] [-v] [-d CVSROOT] [-A author-conv-file]
42 [-p opts-for-cvsps] [-P file] [-C GIT_repository] [-z fuzz] [-i] [-k]
43 [-u] [-s subst] [-a] [-m] [-M regex] [-S regex] [-L commitlimit]
44 [-r remote] [-R] [CVS_module]
49 sub read_author_info
($) {
52 open my $f, '<', "$file" or die("Failed to open $file: $!\n");
55 # Expected format is this:
56 # exon=Andreas Ericsson <ae@op5.se>
57 if (m/^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/) {
59 $conv_author_name{$user} = $2;
60 $conv_author_email{$user} = $3;
62 # However, we also read from CVSROOT/users format
64 elsif (/^(\w+):(['"]?)(.+?)\2\s*$/) {
66 ($user, $mapped) = ($1, $3);
67 if ($mapped =~ /^\s*(.*?)\s*<(.*)>\s*$/) {
68 $conv_author_name{$user} = $1;
69 $conv_author_email{$user} = $2;
71 elsif ($mapped =~ /^<?(.*)>?$/) {
72 $conv_author_name{$user} = $user;
73 $conv_author_email{$user} = $1;
76 # NEEDSWORK: Maybe warn on unrecognized lines?
81 sub write_author_info
($) {
83 open my $f, '>', $file or
84 die("Failed to open $file for writing: $!");
86 foreach (keys %conv_author_name) {
87 print $f "$_=$conv_author_name{$_} <$conv_author_email{$_}>\n";
92 # convert getopts specs for use by git config
94 'A:' => 'authors-file',
95 'M:' => 'merge-regex',
97 'R' => 'track-revisions',
98 'S:' => 'ignore-paths',
101 sub read_repo_config
{
102 # Split the string between characters, unless there is a ':'
103 # So "abc:de" becomes ["a", "b", "c:", "d", "e"]
104 my @opts = split(/ *(?!:)/, shift);
105 foreach my $o (@opts) {
108 my $arg = 'git config';
109 $arg .= ' --bool' if ($o !~ /:$/);
112 if (exists $longmap{$o}) {
113 # An uppercase option like -R cannot be
114 # expressed in the configuration, as the
115 # variable names are downcased.
116 $ckey = $longmap{$o};
117 next if (! defined $ckey);
120 chomp(my $tmp = `$arg --get cvsimport.$ckey`);
121 if ($tmp && !($arg =~ /--bool/ && $tmp eq 'false')) {
123 my $opt_name = "opt_" . $key;
131 my $opts = "haivmkuo:d:p:r:C:z:s:M:P:A:S:L:R";
132 read_repo_config
($opts);
133 Getopt
::Long
::Configure
( 'no_ignore_case', 'bundling' );
135 # turn the Getopt::Std specification in a Getopt::Long one,
136 # with support for multiple -M options
137 GetOptions
( map { s/:/=s/; /M/ ?
"$_\@" : $_ } split( /(?!:)/, $opts ) )
142 chomp(my $module = `git config --get cvsimport.module`);
143 push(@ARGV, $module) if $?
== 0;
145 @ARGV <= 1 or usage
("You can't specify more than one CVS module");
148 $ENV{"CVSROOT"} = $opt_d;
149 } elsif (-f
'CVS/Root') {
150 open my $f, '<', 'CVS/Root' or die 'Failed to open CVS/Root';
154 $ENV{"CVSROOT"} = $opt_d;
155 } elsif ($ENV{"CVSROOT"}) {
156 $opt_d = $ENV{"CVSROOT"};
158 usage
("CVSROOT needs to be set");
163 my $git_tree = $opt_C;
167 if (defined $opt_r) {
168 $remote = 'refs/remotes/' . $opt_r;
172 $remote = 'refs/heads';
177 $cvs_tree = $ARGV[0];
178 } elsif (-f
'CVS/Repository') {
179 open my $f, '<', 'CVS/Repository' or
180 die 'Failed to open CVS/Repository';
185 usage
("CVS module has to be specified");
190 @mergerx = ( qr/\b(?:from|of|merge|merging|merged) ([-\w]+)/i );
193 push (@mergerx, map { qr/$_/ } @opt_M);
196 # Remember UTC of our starting time
197 # we'll want to avoid importing commits
198 # that are too recent
199 our $starttime = time();
201 select(STDERR
); $|=1; select(STDOUT
);
206 # We're only interested in connecting and downloading, so ...
209 use File
::Temp
qw(tempfile);
210 use POSIX
qw(strftime dup2);
213 my ($what,$repo,$subdir) = @_;
214 $what=ref($what) if ref($what);
217 $self->{'buffer'} = "";
221 $self->{'fullrep'} = $repo;
224 $self->{'subdir'} = $subdir;
225 $self->{'lines'} = undef;
230 sub find_password_entry
{
231 my ($cvspass, @cvsroot) = @_;
232 my ($file, $delim) = @
$cvspass;
236 if (open(my $fh, $file)) {
237 # :pserver:cvs@mea.tmt.tele.fi:/cvsroot/zmailer Ah<Z
242 my ($w, $p) = split($delim,$_,2);
243 for my $cvsroot (@cvsroot) {
244 if ($w eq $cvsroot) {
257 my $repo = $self->{'fullrep'};
258 if ($repo =~ s/^:pserver(?:([^:]*)):(?:(.*?)(?::(.*?))?@)?([^:\/]*)(?::(\d*))?//) {
259 my ($param,$user,$pass,$serv,$port) = ($1,$2,$3,$4,$5);
261 my ($proxyhost,$proxyport);
262 if ($param && ($param =~ m/proxy=([^;]+)/)) {
264 # Default proxyport, if not specified, is 8080.
266 if ($ENV{"CVS_PROXY_PORT"}) {
267 $proxyport = $ENV{"CVS_PROXY_PORT"};
269 if ($param =~ m/proxyport=([^;]+)/) {
275 # if username is not explicit in CVSROOT, then use current user, as cvs would
276 $user=(getlogin() || $ENV{'LOGNAME'} || $ENV{'USER'} || "anonymous") unless $user;
279 $rr2 = ":pserver:$user\@$serv:$repo";
282 my $rr = ":pserver:$user\@$serv:$port$repo";
285 $pass = $self->_scramble($pass);
287 my @cvspass = ([$ENV{'HOME'}."/.cvspass", qr
/\s
/],
288 [$ENV{'HOME'}."/.cvs/cvspass", qr/=/]);
290 foreach my $cvspass (@cvspass) {
291 my $p = find_password_entry
($cvspass, $rr, $rr2);
293 push @loc, $cvspass->[0];
299 die("Multiple cvs password files have ".
300 "entries for CVSROOT $opt_d: @loc");
309 # Use a HTTP Proxy. Only works for HTTP proxies that
310 # don't require user authentication
312 # See: http://www.ietf.org/rfc/rfc2817.txt
314 $s = IO
::Socket
::INET
->new(PeerHost
=> $proxyhost, PeerPort
=> $proxyport);
315 die "Socket to $proxyhost: $!\n" unless defined $s;
316 $s->write("CONNECT $serv:$port HTTP/1.1\r\nHost: $serv:$port\r\n\r\n")
317 or die "Write to $proxyhost: $!\n";
322 # The answer should look like 'HTTP/1.x 2yy ....'
323 if (!($rep =~ m
#^HTTP/1\.. 2[0-9][0-9]#)) {
324 die "Proxy connect: $rep\n";
326 # Skip up to the empty line of the proxy server output
327 # including the response headers.
328 while ($rep = <$s>) {
329 last if (!defined $rep ||
334 $s = IO
::Socket
::INET
->new(PeerHost
=> $serv, PeerPort
=> $port);
335 die "Socket to $serv: $!\n" unless defined $s;
338 $s->write("BEGIN AUTH REQUEST\n$repo\n$user\n$pass\nEND AUTH REQUEST\n")
339 or die "Write to $serv: $!\n";
344 if ($rep ne "I LOVE YOU\n") {
345 $rep="<unknown>" unless $rep;
346 die "AuthReply: $rep\n";
348 $self->{'socketo'} = $s;
349 $self->{'socketi'} = $s;
350 } else { # local or ext: Fork off our own cvs server.
351 my $pr = IO
::Pipe
->new();
352 my $pw = IO
::Pipe
->new();
354 die "Fork: $!\n" unless defined $pid;
356 $cvs = $ENV{CVS_SERVER
} if exists $ENV{CVS_SERVER
};
358 $rsh = $ENV{CVS_RSH
} if exists $ENV{CVS_RSH
};
360 my @cvs = ($cvs, 'server');
361 my ($local, $user, $host);
362 $local = $repo =~ s/:local://;
365 $local = !($repo =~ s/^(?:([^\@:]+)\@)?([^:]+)://);
366 ($user, $host) = ($1, $2);
370 unshift @cvs, $rsh, '-l', $user, $host;
372 unshift @cvs, $rsh, $host;
379 dup2
($pw->fileno(),0);
380 dup2
($pr->fileno(),1);
387 $self->{'socketo'} = $pw;
388 $self->{'socketi'} = $pr;
390 $self->{'socketo'}->write("Root $repo\n");
392 # Trial and error says that this probably is the minimum set
393 $self->{'socketo'}->write("Valid-responses ok error Valid-requests Mode M Mbinary E Checked-in Created Updated Merged Removed\n");
395 $self->{'socketo'}->write("valid-requests\n");
396 $self->{'socketo'}->flush();
398 my $rep=$self->readline();
399 die "Failed to read from server" unless defined $rep;
401 if ($rep !~ s/^Valid-requests\s*//) {
402 $rep="<unknown>" unless $rep;
403 die "Expected Valid-requests from server, but got: $rep\n";
405 chomp(my $res=$self->readline());
406 die "validReply: $res\n" if $res ne "ok";
408 $self->{'socketo'}->write("UseUnchanged\n") if $rep =~ /\bUseUnchanged\b/;
409 $self->{'repo'} = $repo;
414 return $self->{'socketi'}->getline();
418 # Request a file with a given revision.
419 # Trial and error says this is a good way to do it. :-/
420 my ($self,$fn,$rev) = @_;
421 $self->{'socketo'}->write("Argument -N\n") or return undef;
422 $self->{'socketo'}->write("Argument -P\n") or return undef;
423 # -kk: Linus' version doesn't use it - defaults to off
425 $self->{'socketo'}->write("Argument -kk\n") or return undef;
427 $self->{'socketo'}->write("Argument -r\n") or return undef;
428 $self->{'socketo'}->write("Argument $rev\n") or return undef;
429 $self->{'socketo'}->write("Argument --\n") or return undef;
430 $self->{'socketo'}->write("Argument $self->{'subdir'}/$fn\n") or return undef;
431 $self->{'socketo'}->write("Directory .\n") or return undef;
432 $self->{'socketo'}->write("$self->{'repo'}\n") or return undef;
433 # $self->{'socketo'}->write("Sticky T1.0\n") or return undef;
434 $self->{'socketo'}->write("co\n") or return undef;
435 $self->{'socketo'}->flush() or return undef;
436 $self->{'lines'} = 0;
440 # Read a line from the server.
441 # ... except that 'line' may be an entire file. ;-)
442 my ($self, $fh) = @_;
443 die "Not in lines" unless defined $self->{'lines'};
447 while (defined($line = $self->readline())) {
448 # M U gnupg-cvs-rep/AUTHORS
449 # Updated gnupg-cvs-rep/
450 # /daten/src/rsync/gnupg-cvs-rep/AUTHORS
451 # /AUTHORS/1.1///T1.1
456 if ($line =~ s/^(?:Created|Updated) //) {
457 $line = $self->readline(); # path
458 $line = $self->readline(); # Entries line
459 my $mode = $self->readline(); chomp $mode;
460 $self->{'mode'} = $mode;
461 defined (my $cnt = $self->readline())
462 or die "EOF from server after 'Changed'\n";
464 die "Duh: Filesize $cnt" if $cnt !~ /^\d+$/;
466 $res = $self->_fetchfile($fh, $cnt);
467 } elsif ($line =~ s/^ //) {
469 $res += length($line);
470 } elsif ($line =~ /^M\b/) {
472 } elsif ($line =~ /^Mbinary\b/) {
474 die "EOF from server after 'Mbinary'" unless defined ($cnt = $self->readline());
476 die "Duh: Mbinary $cnt" if $cnt !~ /^\d+$/ or $cnt<1;
478 $res += $self->_fetchfile($fh, $cnt);
482 # print STDERR "S: ok (".length($res).")\n";
484 } elsif ($line =~ s/^E //) {
485 # print STDERR "S: $line\n";
486 } elsif ($line =~ /^(Remove-entry|Removed) /i) {
487 $line = $self->readline(); # filename
488 $line = $self->readline(); # OK
490 die "Unknown: $line" if $line ne "ok";
493 die "Unknown: $line\n";
500 my ($self,$fn,$rev) = @_;
503 my ($fh, $name) = tempfile
('gitcvs.XXXXXX',
504 DIR
=> File
::Spec
->tmpdir(), UNLINK
=> 1);
506 $self->_file($fn,$rev) and $res = $self->_line($fh);
509 print STDERR
"Server has gone away while fetching $fn $rev, retrying...\n";
512 $self->_file($fn,$rev) or die "No file command send";
513 $res = $self->_line($fh);
514 die "Retry failed" unless defined $res;
518 return ($name, $res);
521 my ($self, $fh, $cnt) = @_;
523 my $bufsize = 1024 * 1024;
525 if ($bufsize > $cnt) {
529 my $num = $self->{'socketi'}->read($buf,$bufsize);
530 die "Server: Filesize $cnt: $num: $!\n" if not defined $num or $num<=0;
539 my ($self, $pass) = @_;
542 return $scrambled unless $pass;
544 my $pass_len = length($pass);
545 my @pass_arr = split("", $pass);
548 # from cvs/src/scramble.c
550 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
551 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
552 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
553 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
554 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
555 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
556 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
557 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
558 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
559 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
560 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
561 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
562 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
563 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
564 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
565 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
568 for ($i = 0; $i < $pass_len; $i++) {
569 $scrambled .= pack("C", $shifts[ord($pass_arr[$i])]);
577 my $cvs = CVSconn
->new($opt_d, $cvs_tree);
582 m
#(\d{2,4})/(\d\d)/(\d\d)\s(\d\d):(\d\d)(?::(\d\d))?#
583 or die "Unparseable date: $d\n";
584 my $y=$1; $y-=1900 if $y>1900;
585 return timegm
($6||0,$5,$4,$3,$2-1,$y);
593 for my $x(split(//,$mode)) {
598 } elsif ($x eq "u") { $um |= 0700;
599 } elsif ($x eq "g") { $um |= 0070;
600 } elsif ($x eq "o") { $um |= 0007;
601 } elsif ($x eq "r") { $mm |= 0444;
602 } elsif ($x eq "w") { $mm |= 0222;
603 } elsif ($x eq "x") { $mm |= 0111;
604 } elsif ($x eq "=") { # do nothing
605 } else { die "Unknown mode: $mode\n";
620 return $s =~ /^[a-f0-9]{40}$/;
623 sub get_headref
($) {
625 my $r = `git rev-parse --verify '$name' 2>/dev/null`;
626 return undef unless $?
== 0;
631 my $user_filename_prepend = '';
632 sub munge_user_filename
{
634 return File
::Spec
->file_name_is_absolute($name) ?
636 $user_filename_prepend . $name;
640 or mkdir($git_tree,0777)
641 or die "Could not create $git_tree: $!";
642 if ($git_tree ne '.') {
643 $user_filename_prepend = getwd
() . '/';
647 my $last_branch = "";
648 my $orig_branch = "";
650 my $tip_at_start = undef;
652 my $git_dir = $ENV{"GIT_DIR"} || ".git";
653 $git_dir = getwd
()."/".$git_dir unless $git_dir =~ m
#^/#;
654 $ENV{"GIT_DIR"} = $git_dir;
656 $orig_git_index = $ENV{GIT_INDEX_FILE
} if exists $ENV{GIT_INDEX_FILE
};
658 my %index; # holds filenames of one index per branch
660 unless (-d
$git_dir) {
661 system(qw(git init));
662 die "Cannot init the GIT db at $git_tree: $?\n" if $?
;
663 system(qw(git read-tree --empty));
664 die "Cannot init an empty tree: $?\n" if $?
;
666 $last_branch = $opt_o;
669 open(F
, "-|", qw(git symbolic-ref HEAD)) or
670 die "Cannot run git symbolic-ref: $!\n";
671 chomp ($last_branch = <F
>);
672 $last_branch = basename
($last_branch);
674 unless ($last_branch) {
675 warn "Cannot read the last branch name: $! -- assuming 'master'\n";
676 $last_branch = "master";
678 $orig_branch = $last_branch;
679 $tip_at_start = `git rev-parse --verify HEAD`;
681 # Get the last import timestamps
682 my $fmt = '($ref, $author) = (%(refname), %(author));';
683 my @cmd = ('git', 'for-each-ref', '--perl', "--format=$fmt", $remote);
684 open(H
, "-|", @cmd) or die "Cannot run git for-each-ref: $!\n";
685 while (defined(my $entry = <H
>)) {
687 eval($entry) || die "cannot eval refs list: $@";
688 my ($head) = ($ref =~ m
|^$remote/(.*)|);
689 $author =~ /^.*\s(\d+)\s[-+]\d{4}$/;
690 $branch_date{$head} = $1;
693 if (!exists $branch_date{$opt_o}) {
694 die "Branch '$opt_o' does not exist.\n".
695 "Either use the correct '-o branch' option,\n".
696 "or import to a new repository.\n";
701 or die "Could not create git subdir ($git_dir).\n";
703 # now we read (and possibly save) author-info as well
704 -f
"$git_dir/cvs-authors" and
705 read_author_info
("$git_dir/cvs-authors");
707 read_author_info
(munge_user_filename
($opt_A));
708 write_author_info
("$git_dir/cvs-authors");
711 # open .git/cvs-revisions, if requested
712 open my $revision_map, '>>', "$git_dir/cvs-revisions"
713 or die "Can't open $git_dir/cvs-revisions for appending: $!\n"
718 # run cvsps into a file unless we are getting
719 # it passed as a file via $opt_P
723 print "Running cvsps...\n" if $opt_v;
724 my $pid = open(CVSPS
,"-|");
726 die "Cannot fork: $!\n" unless defined $pid;
729 @opt = split(/,/,$opt_p) if defined $opt_p;
730 unshift @opt, '-z', $opt_z if defined $opt_z;
731 unshift @opt, '-q' unless defined $opt_v;
732 unless (defined($opt_p) && $opt_p =~ m/--no-cvs-direct/) {
733 push @opt, '--cvs-direct';
735 exec("cvsps","--norc",@opt,"-u","-A",'--root',$opt_d,$cvs_tree);
736 die "Could not start cvsps: $!\n";
738 ($cvspsfh, $cvspsfile) = tempfile
('gitXXXXXX', SUFFIX
=> '.cvsps',
739 DIR
=> File
::Spec
->tmpdir());
744 $?
== 0 or die "git cvsimport: fatal: cvsps reported error\n";
747 $cvspsfile = munge_user_filename
($opt_P);
750 open(CVS
, "<$cvspsfile") or die $!;
753 #---------------------
755 #Date: 1999/09/18 13:03:59
757 #Branch: STABLE-BRANCH-1-0
758 #Ancestor branch: HEAD
761 # See ChangeLog: Sat Sep 18 13:03:28 CEST 1999 Werner Koch
763 # README:1.57->1.57.2.1
764 # VERSION:1.96->1.96.2.1
766 #---------------------
770 sub update_index
(\@\@
) {
773 open(my $fh, '|-', qw(git update-index -z --index-info))
774 or die "unable to open git update-index: $!";
776 (map { "0 0000000000000000000000000000000000000000\t$_\0" }
778 (map { '100' . sprintf('%o', $_->[0]) . " $_->[1]\t$_->[2]\0" }
780 or die "unable to write to git update-index: $!";
782 or die "unable to write to git update-index: $!";
783 $?
and die "git update-index reported error: $?";
787 open(my $fh, '-|', qw(git write-tree))
788 or die "unable to open git write-tree: $!";
789 chomp(my $tree = <$fh>);
791 or die "Cannot get tree id ($tree): $!";
793 or die "Error running git write-tree: $?\n";
794 print "Tree ID $tree\n" if $opt_v;
798 my ($patchset,$date,$author_name,$author_email,$branch,$ancestor,$tag,$logmsg);
799 my (@old,@new,@skipped,%ignorebranch,@commit_revisions);
801 # commits that cvsps cannot place anywhere...
802 $ignorebranch{'#CVSPS_NO_BRANCH'} = 1;
805 if ($branch eq $opt_o && !$index{branch
} &&
806 !get_headref
("$remote/$branch")) {
807 # looks like an initial commit
808 # use the index primed by git init
809 $ENV{GIT_INDEX_FILE
} = "$git_dir/index";
810 $index{$branch} = "$git_dir/index";
812 # use an index per branch to speed up
813 # imports of projects with many branches
814 unless ($index{$branch}) {
815 $index{$branch} = tmpnam
();
816 $ENV{GIT_INDEX_FILE
} = $index{$branch};
818 system("git", "read-tree", "$remote/$ancestor");
820 system("git", "read-tree", "$remote/$branch");
822 die "read-tree failed: $?\n" if $?
;
825 $ENV{GIT_INDEX_FILE
} = $index{$branch};
827 update_index
(@old, @new);
829 my $tree = write_tree
();
830 my $parent = get_headref
("$remote/$last_branch");
831 print "Parent ID " . ($parent ?
$parent : "(empty)") . "\n" if $opt_v;
834 push @commit_args, ("-p", $parent) if $parent;
836 # loose detection of merges
837 # based on the commit msg
838 foreach my $rx (@mergerx) {
839 next unless $logmsg =~ $rx && $1;
840 my $mparent = $1 eq 'HEAD' ?
$opt_o : $1;
841 if (my $sha1 = get_headref
("$remote/$mparent")) {
842 push @commit_args, '-p', "$remote/$mparent";
843 print "Merge parent branch: $mparent\n" if $opt_v;
847 my $commit_date = strftime
("+0000 %Y-%m-%d %H:%M:%S",gmtime($date));
848 $ENV{GIT_AUTHOR_NAME
} = $author_name;
849 $ENV{GIT_AUTHOR_EMAIL
} = $author_email;
850 $ENV{GIT_AUTHOR_DATE
} = $commit_date;
851 $ENV{GIT_COMMITTER_NAME
} = $author_name;
852 $ENV{GIT_COMMITTER_EMAIL
} = $author_email;
853 $ENV{GIT_COMMITTER_DATE
} = $commit_date;
854 my $pid = open2
(my $commit_read, my $commit_write,
855 'git', 'commit-tree', $tree, @commit_args);
857 # compatibility with git2cvs
858 substr($logmsg,32767) = "" if length($logmsg) > 32767;
859 $logmsg =~ s/[\s\n]+\z//;
862 $logmsg .= "\n\n\nSKIPPED:\n\t";
863 $logmsg .= join("\n\t", @skipped) . "\n";
867 print($commit_write "$logmsg\n") && close($commit_write)
868 or die "Error writing to git commit-tree: $!\n";
870 print "Committed patch $patchset ($branch $commit_date)\n" if $opt_v;
871 chomp(my $cid = <$commit_read>);
872 is_sha1
($cid) or die "Cannot get commit id ($cid): $!\n";
873 print "Commit ID $cid\n" if $opt_v;
877 die "Error running git commit-tree: $?\n" if $?
;
879 system('git' , 'update-ref', "$remote/$branch", $cid) == 0
880 or die "Cannot write branch $branch for update: $!\n";
883 print $revision_map "@$_ $cid\n" for @commit_revisions;
885 @commit_revisions = ();
889 $xtag =~ s/\s+\*\*.*$//; # Remove stuff like ** INVALID ** and ** FUNKY **
890 $xtag =~ tr/_/\./ if ( $opt_u );
891 $xtag =~ s/[\/]/$opt_s/g
;
893 # See refs.c for these rules.
894 # Tag cannot contain bad chars. (See bad_ref_char in refs.c.)
895 $xtag =~ s/[ ~\^:\\\*\?\[]//g;
896 # Other bad strings for tags:
897 # (See check_refname_component in refs.c.)
899 (?
: \
.\
. # Tag cannot contain '..'.
900 | \@
{ # Tag cannot contain '@{'.
901 | ^ - # Tag cannot begin with '-'.
902 | \
.lock $ # Tag cannot end with '.lock'.
903 | ^ \
. # Tag cannot begin...
904 | \
. $ # ...or end with '.'
906 # Tag cannot be empty.
908 warn("warning: ignoring tag '$tag'",
909 " with invalid tagname\n");
913 if (system('git' , 'tag', '-f', $xtag, $cid) != 0) {
914 # We did our best to sanitize the tag, but still failed
915 # for whatever reason. Bail out, and give the user
916 # enough information to understand if/how we should
917 # improve the translation in the future.
919 print "Translated '$tag' tag to '$xtag'\n";
921 die "Cannot create tag $xtag: $!\n";
924 print "Created tag '$xtag' on '$branch'\n" if $opt_v;
931 if ($state == 0 and /^-+$/) {
933 } elsif ($state == 0) {
936 } elsif (($state==0 or $state==1) and s/^PatchSet\s+//) {
939 } elsif ($state == 2 and s/^Date:\s+//) {
942 print STDERR
"Could not parse date: $_\n";
947 } elsif ($state == 3 and s/^Author:\s+//) {
949 if (/^(.*?)\s+<(.*)>/) {
950 ($author_name, $author_email) = ($1, $2);
951 } elsif ($conv_author_name{$_}) {
952 $author_name = $conv_author_name{$_};
953 $author_email = $conv_author_email{$_};
955 $author_name = $author_email = $_;
958 } elsif ($state == 4 and s/^Branch:\s+//) {
960 tr/_/\./ if ( $opt_u );
964 } elsif ($state == 5 and s/^Ancestor branch:\s+//) {
967 $ancestor = $opt_o if $ancestor eq "HEAD";
969 } elsif ($state == 5) {
973 } elsif ($state == 6 and s/^Tag:\s+//) {
975 if ($_ eq "(none)") {
981 } elsif ($state == 7 and /^Log:/) {
984 } elsif ($state == 8 and /^Members:/) {
985 $branch = $opt_o if $branch eq "HEAD";
986 if (defined $branch_date{$branch} and $branch_date{$branch} >= $date) {
988 print "skip patchset $patchset: $date before $branch_date{$branch}\n" if $opt_v;
992 if (!$opt_a && $starttime - 300 - (defined $opt_z ?
$opt_z : 300) <= $date) {
993 # skip if the commit is too recent
994 # given that the cvsps default fuzz is 300s, we give ourselves another
995 # 300s just in case -- this also prevents skipping commits
996 # due to server clock drift
997 print "skip patchset $patchset: $date too recent\n" if $opt_v;
1001 if (exists $ignorebranch{$branch}) {
1002 print STDERR
"Skipping $branch\n";
1007 if ($ancestor eq $branch) {
1008 print STDERR
"Branch $branch erroneously stems from itself -- changed ancestor to $opt_o\n";
1011 if (defined get_headref
("$remote/$branch")) {
1012 print STDERR
"Branch $branch already exists!\n";
1016 my $id = get_headref
("$remote/$ancestor");
1018 print STDERR
"Branch $ancestor does not exist!\n";
1019 $ignorebranch{$branch} = 1;
1024 system(qw(git update-ref -m cvsimport),
1025 "$remote/$branch", $id);
1027 print STDERR
"Could not create branch $branch\n";
1028 $ignorebranch{$branch} = 1;
1033 $last_branch = $branch if $branch ne $last_branch;
1035 } elsif ($state == 8) {
1037 } elsif ($state == 9 and /^\s+(.+?):(INITIAL|\d+(?:\.\d+)+)->(\d+(?:\.\d+)+)\s*$/) {
1038 # VERSION:1.96->1.96.2.1
1039 my $init = ($2 eq "INITIAL");
1043 if ($opt_S && $fn =~ m/$opt_S/) {
1044 print "SKIPPING $fn v $rev\n";
1045 push(@skipped, $fn);
1048 push @commit_revisions, [$fn, $rev];
1049 print "Fetching $fn v $rev\n" if $opt_v;
1050 my ($tmpname, $size) = $cvs->file($fn,$rev);
1053 print "Drop $fn\n" if $opt_v;
1055 print "".($init ?
"New" : "Update")." $fn: $size bytes\n" if $opt_v;
1056 my $pid = open(my $F, '-|');
1057 die $! unless defined $pid;
1059 exec("git", "hash-object", "-w", $tmpname)
1060 or die "Cannot create object: $!\n";
1065 my $mode = pmode
($cvs->{'mode'});
1066 push(@new,[$mode, $sha, $fn]); # may be resurrected!
1069 } elsif ($state == 9 and /^\s+(.+?):\d+(?:\.\d+)+->(\d+(?:\.\d+)+)\(DEAD\)\s*$/) {
1073 push @commit_revisions, [$fn, $rev];
1075 print "Delete $fn\n" if $opt_v;
1076 } elsif ($state == 9 and /^\s*$/) {
1078 } elsif (($state == 9 or $state == 10) and /^-+$/) {
1080 if ($opt_L && $commitcount > $opt_L) {
1084 if (($commitcount & 1023) == 0) {
1085 system(qw(git repack -a -d));
1088 } elsif ($state == 11 and /^-+$/) {
1090 } elsif (/^-+$/) { # end of unknown-line processing
1092 } elsif ($state != 11) { # ignore stuff when skipping
1093 print STDERR
"* UNKNOWN LINE * $_\n";
1096 commit
() if $branch and $state != 11;
1102 # The heuristic of repacking every 1024 commits can leave a
1103 # lot of unpacked data. If there is more than 1MB worth of
1104 # not-packed objects, repack once more.
1105 my $line = `git count-objects`;
1106 if ($line =~ /^(\d+) objects, (\d+) kilobytes$/) {
1107 my ($n_objects, $kb) = ($1, $2);
1109 and system(qw(git repack -a -d));
1112 foreach my $git_index (values %index) {
1113 if ($git_index ne "$git_dir/index") {
1118 if (defined $orig_git_index) {
1119 $ENV{GIT_INDEX_FILE
} = $orig_git_index;
1121 delete $ENV{GIT_INDEX_FILE
};
1124 # Now switch back to the branch we were in before all of this happened
1126 print "DONE.\n" if $opt_v;
1130 my $tip_at_end = `git rev-parse --verify HEAD`;
1131 if ($tip_at_start ne $tip_at_end) {
1132 for ($tip_at_start, $tip_at_end) { chomp; }
1133 print "Fetched into the current branch.\n" if $opt_v;
1134 system(qw(git read-tree -u -m),
1135 $tip_at_start, $tip_at_end);
1136 die "Fast-forward update failed: $?\n" if $?
;
1139 system(qw(git merge cvsimport HEAD), "$remote/$opt_o");
1140 die "Could not merge $opt_o into the current branch.\n" if $?
;
1143 $orig_branch = "master";
1144 print "DONE; creating $orig_branch branch\n" if $opt_v;
1145 system("git", "update-ref", "refs/heads/master", "$remote/$opt_o")
1146 unless defined get_headref
('refs/heads/master');
1147 system("git", "symbolic-ref", "$remote/HEAD", "$remote/$opt_o")
1148 if ($opt_r && $opt_o ne 'HEAD');
1149 system('git', 'update-ref', 'HEAD', "$orig_branch");
1151 system(qw(git checkout -f));
1152 die "checkout failed: $?\n" if $?
;