rebase -i: support --stat
[git] / git-cvsimport.perl
1 #!/usr/bin/perl
2
3 # This tool is copyright (c) 2005, Matthias Urlichs.
4 # It is released under the Gnu Public License, version 2.
5 #
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
8 # its output.
9 #
10 # Checking out the files is done by a single long-running CVS connection
11 # / server process.
12 #
13 # The head revision is on branch "origin" by default.
14 # You can change that with the '-o' option.
15
16 use 5.008;
17 use strict;
18 use warnings;
19 use Getopt::Long;
20 use File::Spec;
21 use File::Temp qw(tempfile tmpnam);
22 use File::Path qw(mkpath);
23 use File::Basename qw(basename dirname);
24 use Time::Local;
25 use IO::Socket;
26 use IO::Pipe;
27 use POSIX qw(strftime dup2 ENOENT);
28 use IPC::Open2;
29
30 $SIG{'PIPE'}="IGNORE";
31 $ENV{'TZ'}="UTC";
32
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);
35
36 sub usage(;$) {
37         my $msg = shift;
38         print(STDERR "Error: $msg\n") if $msg;
39         print STDERR <<END;
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]
45 END
46         exit(1);
47 }
48
49 sub read_author_info($) {
50         my ($file) = @_;
51         my $user;
52         open my $f, '<', "$file" or die("Failed to open $file: $!\n");
53
54         while (<$f>) {
55                 # Expected format is this:
56                 #   exon=Andreas Ericsson <ae@op5.se>
57                 if (m/^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/) {
58                         $user = $1;
59                         $conv_author_name{$user} = $2;
60                         $conv_author_email{$user} = $3;
61                 }
62                 # However, we also read from CVSROOT/users format
63                 # to ease migration.
64                 elsif (/^(\w+):(['"]?)(.+?)\2\s*$/) {
65                         my $mapped;
66                         ($user, $mapped) = ($1, $3);
67                         if ($mapped =~ /^\s*(.*?)\s*<(.*)>\s*$/) {
68                                 $conv_author_name{$user} = $1;
69                                 $conv_author_email{$user} = $2;
70                         }
71                         elsif ($mapped =~ /^<?(.*)>?$/) {
72                                 $conv_author_name{$user} = $user;
73                                 $conv_author_email{$user} = $1;
74                         }
75                 }
76                 # NEEDSWORK: Maybe warn on unrecognized lines?
77         }
78         close ($f);
79 }
80
81 sub write_author_info($) {
82         my ($file) = @_;
83         open my $f, '>', $file or
84           die("Failed to open $file for writing: $!");
85
86         foreach (keys %conv_author_name) {
87                 print $f "$_=$conv_author_name{$_} <$conv_author_email{$_}>\n";
88         }
89         close ($f);
90 }
91
92 # convert getopts specs for use by git config
93 my %longmap = (
94         'A:' => 'authors-file',
95         'M:' => 'merge-regex',
96         'P:' => undef,
97         'R' => 'track-revisions',
98         'S:' => 'ignore-paths',
99 );
100
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) {
106                 my $key = $o;
107                 $key =~ s/://g;
108                 my $arg = 'git config';
109                 $arg .= ' --bool' if ($o !~ /:$/);
110                 my $ckey = $key;
111
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);
118                         $ckey =~ s/-//g;
119                 }
120                 chomp(my $tmp = `$arg --get cvsimport.$ckey`);
121                 if ($tmp && !($arg =~ /--bool/ && $tmp eq 'false')) {
122                         no strict 'refs';
123                         my $opt_name = "opt_" . $key;
124                         if (!$$opt_name) {
125                                 $$opt_name = $tmp;
126                         }
127                 }
128         }
129 }
130
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' );
134
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 ) )
138     or usage();
139 usage if $opt_h;
140
141 if (@ARGV == 0) {
142                 chomp(my $module = `git config --get cvsimport.module`);
143                 push(@ARGV, $module) if $? == 0;
144 }
145 @ARGV <= 1 or usage("You can't specify more than one CVS module");
146
147 if ($opt_d) {
148         $ENV{"CVSROOT"} = $opt_d;
149 } elsif (-f 'CVS/Root') {
150         open my $f, '<', 'CVS/Root' or die 'Failed to open CVS/Root';
151         $opt_d = <$f>;
152         chomp $opt_d;
153         close $f;
154         $ENV{"CVSROOT"} = $opt_d;
155 } elsif ($ENV{"CVSROOT"}) {
156         $opt_d = $ENV{"CVSROOT"};
157 } else {
158         usage("CVSROOT needs to be set");
159 }
160 $opt_s ||= "-";
161 $opt_a ||= 0;
162
163 my $git_tree = $opt_C;
164 $git_tree ||= ".";
165
166 my $remote;
167 if (defined $opt_r) {
168         $remote = 'refs/remotes/' . $opt_r;
169         $opt_o ||= "master";
170 } else {
171         $opt_o ||= "origin";
172         $remote = 'refs/heads';
173 }
174
175 my $cvs_tree;
176 if ($#ARGV == 0) {
177         $cvs_tree = $ARGV[0];
178 } elsif (-f 'CVS/Repository') {
179         open my $f, '<', 'CVS/Repository' or
180             die 'Failed to open CVS/Repository';
181         $cvs_tree = <$f>;
182         chomp $cvs_tree;
183         close $f;
184 } else {
185         usage("CVS module has to be specified");
186 }
187
188 our @mergerx = ();
189 if ($opt_m) {
190         @mergerx = ( qr/\b(?:from|of|merge|merging|merged) ([-\w]+)/i );
191 }
192 if (@opt_M) {
193         push (@mergerx, map { qr/$_/ } @opt_M);
194 }
195
196 # Remember UTC of our starting time
197 # we'll want to avoid importing commits
198 # that are too recent
199 our $starttime = time();
200
201 select(STDERR); $|=1; select(STDOUT);
202
203
204 package CVSconn;
205 # Basic CVS dialog.
206 # We're only interested in connecting and downloading, so ...
207
208 use File::Spec;
209 use File::Temp qw(tempfile);
210 use POSIX qw(strftime dup2);
211
212 sub new {
213         my ($what,$repo,$subdir) = @_;
214         $what=ref($what) if ref($what);
215
216         my $self = {};
217         $self->{'buffer'} = "";
218         bless($self,$what);
219
220         $repo =~ s#/+$##;
221         $self->{'fullrep'} = $repo;
222         $self->conn();
223
224         $self->{'subdir'} = $subdir;
225         $self->{'lines'} = undef;
226
227         return $self;
228 }
229
230 sub conn {
231         my $self = shift;
232         my $repo = $self->{'fullrep'};
233         if ($repo =~ s/^:pserver(?:([^:]*)):(?:(.*?)(?::(.*?))?@)?([^:\/]*)(?::(\d*))?//) {
234                 my ($param,$user,$pass,$serv,$port) = ($1,$2,$3,$4,$5);
235
236                 my ($proxyhost,$proxyport);
237                 if ($param && ($param =~ m/proxy=([^;]+)/)) {
238                         $proxyhost = $1;
239                         # Default proxyport, if not specified, is 8080.
240                         $proxyport = 8080;
241                         if ($ENV{"CVS_PROXY_PORT"}) {
242                                 $proxyport = $ENV{"CVS_PROXY_PORT"};
243                         }
244                         if ($param =~ m/proxyport=([^;]+)/) {
245                                 $proxyport = $1;
246                         }
247                 }
248                 $repo ||= '/';
249
250                 # if username is not explicit in CVSROOT, then use current user, as cvs would
251                 $user=(getlogin() || $ENV{'LOGNAME'} || $ENV{'USER'} || "anonymous") unless $user;
252                 my $rr2 = "-";
253                 unless ($port) {
254                         $rr2 = ":pserver:$user\@$serv:$repo";
255                         $port=2401;
256                 }
257                 my $rr = ":pserver:$user\@$serv:$port$repo";
258
259                 if ($pass) {
260                         $pass = $self->_scramble($pass);
261                 } else {
262                         open(H,$ENV{'HOME'}."/.cvspass") and do {
263                                 # :pserver:cvs@mea.tmt.tele.fi:/cvsroot/zmailer Ah<Z
264                                 while (<H>) {
265                                         chomp;
266                                         s/^\/\d+\s+//;
267                                         my ($w,$p) = split(/\s/,$_,2);
268                                         if ($w eq $rr or $w eq $rr2) {
269                                                 $pass = $p;
270                                                 last;
271                                         }
272                                 }
273                         };
274                         $pass = "A" unless $pass;
275                 }
276
277                 my ($s, $rep);
278                 if ($proxyhost) {
279
280                         # Use a HTTP Proxy. Only works for HTTP proxies that
281                         # don't require user authentication
282                         #
283                         # See: http://www.ietf.org/rfc/rfc2817.txt
284
285                         $s = IO::Socket::INET->new(PeerHost => $proxyhost, PeerPort => $proxyport);
286                         die "Socket to $proxyhost: $!\n" unless defined $s;
287                         $s->write("CONNECT $serv:$port HTTP/1.1\r\nHost: $serv:$port\r\n\r\n")
288                                 or die "Write to $proxyhost: $!\n";
289                         $s->flush();
290
291                         $rep = <$s>;
292
293                         # The answer should look like 'HTTP/1.x 2yy ....'
294                         if (!($rep =~ m#^HTTP/1\.. 2[0-9][0-9]#)) {
295                                 die "Proxy connect: $rep\n";
296                         }
297                         # Skip up to the empty line of the proxy server output
298                         # including the response headers.
299                         while ($rep = <$s>) {
300                                 last if (!defined $rep ||
301                                          $rep eq "\n" ||
302                                          $rep eq "\r\n");
303                         }
304                 } else {
305                         $s = IO::Socket::INET->new(PeerHost => $serv, PeerPort => $port);
306                         die "Socket to $serv: $!\n" unless defined $s;
307                 }
308
309                 $s->write("BEGIN AUTH REQUEST\n$repo\n$user\n$pass\nEND AUTH REQUEST\n")
310                         or die "Write to $serv: $!\n";
311                 $s->flush();
312
313                 $rep = <$s>;
314
315                 if ($rep ne "I LOVE YOU\n") {
316                         $rep="<unknown>" unless $rep;
317                         die "AuthReply: $rep\n";
318                 }
319                 $self->{'socketo'} = $s;
320                 $self->{'socketi'} = $s;
321         } else { # local or ext: Fork off our own cvs server.
322                 my $pr = IO::Pipe->new();
323                 my $pw = IO::Pipe->new();
324                 my $pid = fork();
325                 die "Fork: $!\n" unless defined $pid;
326                 my $cvs = 'cvs';
327                 $cvs = $ENV{CVS_SERVER} if exists $ENV{CVS_SERVER};
328                 my $rsh = 'rsh';
329                 $rsh = $ENV{CVS_RSH} if exists $ENV{CVS_RSH};
330
331                 my @cvs = ($cvs, 'server');
332                 my ($local, $user, $host);
333                 $local = $repo =~ s/:local://;
334                 if (!$local) {
335                     $repo =~ s/:ext://;
336                     $local = !($repo =~ s/^(?:([^\@:]+)\@)?([^:]+)://);
337                     ($user, $host) = ($1, $2);
338                 }
339                 if (!$local) {
340                     if ($user) {
341                         unshift @cvs, $rsh, '-l', $user, $host;
342                     } else {
343                         unshift @cvs, $rsh, $host;
344                     }
345                 }
346
347                 unless ($pid) {
348                         $pr->writer();
349                         $pw->reader();
350                         dup2($pw->fileno(),0);
351                         dup2($pr->fileno(),1);
352                         $pr->close();
353                         $pw->close();
354                         exec(@cvs);
355                 }
356                 $pw->writer();
357                 $pr->reader();
358                 $self->{'socketo'} = $pw;
359                 $self->{'socketi'} = $pr;
360         }
361         $self->{'socketo'}->write("Root $repo\n");
362
363         # Trial and error says that this probably is the minimum set
364         $self->{'socketo'}->write("Valid-responses ok error Valid-requests Mode M Mbinary E Checked-in Created Updated Merged Removed\n");
365
366         $self->{'socketo'}->write("valid-requests\n");
367         $self->{'socketo'}->flush();
368
369         chomp(my $rep=$self->readline());
370         if ($rep !~ s/^Valid-requests\s*//) {
371                 $rep="<unknown>" unless $rep;
372                 die "Expected Valid-requests from server, but got: $rep\n";
373         }
374         chomp(my $res=$self->readline());
375         die "validReply: $res\n" if $res ne "ok";
376
377         $self->{'socketo'}->write("UseUnchanged\n") if $rep =~ /\bUseUnchanged\b/;
378         $self->{'repo'} = $repo;
379 }
380
381 sub readline {
382         my ($self) = @_;
383         return $self->{'socketi'}->getline();
384 }
385
386 sub _file {
387         # Request a file with a given revision.
388         # Trial and error says this is a good way to do it. :-/
389         my ($self,$fn,$rev) = @_;
390         $self->{'socketo'}->write("Argument -N\n") or return undef;
391         $self->{'socketo'}->write("Argument -P\n") or return undef;
392         # -kk: Linus' version doesn't use it - defaults to off
393         if ($opt_k) {
394             $self->{'socketo'}->write("Argument -kk\n") or return undef;
395         }
396         $self->{'socketo'}->write("Argument -r\n") or return undef;
397         $self->{'socketo'}->write("Argument $rev\n") or return undef;
398         $self->{'socketo'}->write("Argument --\n") or return undef;
399         $self->{'socketo'}->write("Argument $self->{'subdir'}/$fn\n") or return undef;
400         $self->{'socketo'}->write("Directory .\n") or return undef;
401         $self->{'socketo'}->write("$self->{'repo'}\n") or return undef;
402         # $self->{'socketo'}->write("Sticky T1.0\n") or return undef;
403         $self->{'socketo'}->write("co\n") or return undef;
404         $self->{'socketo'}->flush() or return undef;
405         $self->{'lines'} = 0;
406         return 1;
407 }
408 sub _line {
409         # Read a line from the server.
410         # ... except that 'line' may be an entire file. ;-)
411         my ($self, $fh) = @_;
412         die "Not in lines" unless defined $self->{'lines'};
413
414         my $line;
415         my $res=0;
416         while (defined($line = $self->readline())) {
417                 # M U gnupg-cvs-rep/AUTHORS
418                 # Updated gnupg-cvs-rep/
419                 # /daten/src/rsync/gnupg-cvs-rep/AUTHORS
420                 # /AUTHORS/1.1///T1.1
421                 # u=rw,g=rw,o=rw
422                 # 0
423                 # ok
424
425                 if ($line =~ s/^(?:Created|Updated) //) {
426                         $line = $self->readline(); # path
427                         $line = $self->readline(); # Entries line
428                         my $mode = $self->readline(); chomp $mode;
429                         $self->{'mode'} = $mode;
430                         defined (my $cnt = $self->readline())
431                                 or die "EOF from server after 'Changed'\n";
432                         chomp $cnt;
433                         die "Duh: Filesize $cnt" if $cnt !~ /^\d+$/;
434                         $line="";
435                         $res = $self->_fetchfile($fh, $cnt);
436                 } elsif ($line =~ s/^ //) {
437                         print $fh $line;
438                         $res += length($line);
439                 } elsif ($line =~ /^M\b/) {
440                         # output, do nothing
441                 } elsif ($line =~ /^Mbinary\b/) {
442                         my $cnt;
443                         die "EOF from server after 'Mbinary'" unless defined ($cnt = $self->readline());
444                         chomp $cnt;
445                         die "Duh: Mbinary $cnt" if $cnt !~ /^\d+$/ or $cnt<1;
446                         $line="";
447                         $res += $self->_fetchfile($fh, $cnt);
448                 } else {
449                         chomp $line;
450                         if ($line eq "ok") {
451                                 # print STDERR "S: ok (".length($res).")\n";
452                                 return $res;
453                         } elsif ($line =~ s/^E //) {
454                                 # print STDERR "S: $line\n";
455                         } elsif ($line =~ /^(Remove-entry|Removed) /i) {
456                                 $line = $self->readline(); # filename
457                                 $line = $self->readline(); # OK
458                                 chomp $line;
459                                 die "Unknown: $line" if $line ne "ok";
460                                 return -1;
461                         } else {
462                                 die "Unknown: $line\n";
463                         }
464                 }
465         }
466         return undef;
467 }
468 sub file {
469         my ($self,$fn,$rev) = @_;
470         my $res;
471
472         my ($fh, $name) = tempfile('gitcvs.XXXXXX',
473                     DIR => File::Spec->tmpdir(), UNLINK => 1);
474
475         $self->_file($fn,$rev) and $res = $self->_line($fh);
476
477         if (!defined $res) {
478             print STDERR "Server has gone away while fetching $fn $rev, retrying...\n";
479             truncate $fh, 0;
480             $self->conn();
481             $self->_file($fn,$rev) or die "No file command send";
482             $res = $self->_line($fh);
483             die "Retry failed" unless defined $res;
484         }
485         close ($fh);
486
487         return ($name, $res);
488 }
489 sub _fetchfile {
490         my ($self, $fh, $cnt) = @_;
491         my $res = 0;
492         my $bufsize = 1024 * 1024;
493         while ($cnt) {
494             if ($bufsize > $cnt) {
495                 $bufsize = $cnt;
496             }
497             my $buf;
498             my $num = $self->{'socketi'}->read($buf,$bufsize);
499             die "Server: Filesize $cnt: $num: $!\n" if not defined $num or $num<=0;
500             print $fh $buf;
501             $res += $num;
502             $cnt -= $num;
503         }
504         return $res;
505 }
506
507 sub _scramble {
508         my ($self, $pass) = @_;
509         my $scrambled = "A";
510
511         return $scrambled unless $pass;
512
513         my $pass_len = length($pass);
514         my @pass_arr = split("", $pass);
515         my $i;
516
517         # from cvs/src/scramble.c
518         my @shifts = (
519                   0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
520                  16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
521                 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
522                 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
523                  41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
524                 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
525                  36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
526                  58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
527                 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
528                 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
529                 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
530                 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
531                 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
532                 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
533                 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
534                 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
535         );
536
537         for ($i = 0; $i < $pass_len; $i++) {
538                 $scrambled .= pack("C", $shifts[ord($pass_arr[$i])]);
539         }
540
541         return $scrambled;
542 }
543
544 package main;
545
546 my $cvs = CVSconn->new($opt_d, $cvs_tree);
547
548
549 sub pdate($) {
550         my ($d) = @_;
551         m#(\d{2,4})/(\d\d)/(\d\d)\s(\d\d):(\d\d)(?::(\d\d))?#
552                 or die "Unparseable date: $d\n";
553         my $y=$1; $y-=1900 if $y>1900;
554         return timegm($6||0,$5,$4,$3,$2-1,$y);
555 }
556
557 sub pmode($) {
558         my ($mode) = @_;
559         my $m = 0;
560         my $mm = 0;
561         my $um = 0;
562         for my $x(split(//,$mode)) {
563                 if ($x eq ",") {
564                         $m |= $mm&$um;
565                         $mm = 0;
566                         $um = 0;
567                 } elsif ($x eq "u") { $um |= 0700;
568                 } elsif ($x eq "g") { $um |= 0070;
569                 } elsif ($x eq "o") { $um |= 0007;
570                 } elsif ($x eq "r") { $mm |= 0444;
571                 } elsif ($x eq "w") { $mm |= 0222;
572                 } elsif ($x eq "x") { $mm |= 0111;
573                 } elsif ($x eq "=") { # do nothing
574                 } else { die "Unknown mode: $mode\n";
575                 }
576         }
577         $m |= $mm&$um;
578         return $m;
579 }
580
581 sub getwd() {
582         my $pwd = `pwd`;
583         chomp $pwd;
584         return $pwd;
585 }
586
587 sub is_sha1 {
588         my $s = shift;
589         return $s =~ /^[a-f0-9]{40}$/;
590 }
591
592 sub get_headref ($) {
593         my $name = shift;
594         my $r = `git rev-parse --verify '$name' 2>/dev/null`;
595         return undef unless $? == 0;
596         chomp $r;
597         return $r;
598 }
599
600 my $user_filename_prepend = '';
601 sub munge_user_filename {
602         my $name = shift;
603         return File::Spec->file_name_is_absolute($name) ?
604                 $name :
605                 $user_filename_prepend . $name;
606 }
607
608 -d $git_tree
609         or mkdir($git_tree,0777)
610         or die "Could not create $git_tree: $!";
611 if ($git_tree ne '.') {
612         $user_filename_prepend = getwd() . '/';
613         chdir($git_tree);
614 }
615
616 my $last_branch = "";
617 my $orig_branch = "";
618 my %branch_date;
619 my $tip_at_start = undef;
620
621 my $git_dir = $ENV{"GIT_DIR"} || ".git";
622 $git_dir = getwd()."/".$git_dir unless $git_dir =~ m#^/#;
623 $ENV{"GIT_DIR"} = $git_dir;
624 my $orig_git_index;
625 $orig_git_index = $ENV{GIT_INDEX_FILE} if exists $ENV{GIT_INDEX_FILE};
626
627 my %index; # holds filenames of one index per branch
628
629 unless (-d $git_dir) {
630         system(qw(git init));
631         die "Cannot init the GIT db at $git_tree: $?\n" if $?;
632         system(qw(git read-tree --empty));
633         die "Cannot init an empty tree: $?\n" if $?;
634
635         $last_branch = $opt_o;
636         $orig_branch = "";
637 } else {
638         open(F, "-|", qw(git symbolic-ref HEAD)) or
639                 die "Cannot run git symbolic-ref: $!\n";
640         chomp ($last_branch = <F>);
641         $last_branch = basename($last_branch);
642         close(F);
643         unless ($last_branch) {
644                 warn "Cannot read the last branch name: $! -- assuming 'master'\n";
645                 $last_branch = "master";
646         }
647         $orig_branch = $last_branch;
648         $tip_at_start = `git rev-parse --verify HEAD`;
649
650         # Get the last import timestamps
651         my $fmt = '($ref, $author) = (%(refname), %(author));';
652         my @cmd = ('git', 'for-each-ref', '--perl', "--format=$fmt", $remote);
653         open(H, "-|", @cmd) or die "Cannot run git for-each-ref: $!\n";
654         while (defined(my $entry = <H>)) {
655                 my ($ref, $author);
656                 eval($entry) || die "cannot eval refs list: $@";
657                 my ($head) = ($ref =~ m|^$remote/(.*)|);
658                 $author =~ /^.*\s(\d+)\s[-+]\d{4}$/;
659                 $branch_date{$head} = $1;
660         }
661         close(H);
662         if (!exists $branch_date{$opt_o}) {
663                 die "Branch '$opt_o' does not exist.\n".
664                        "Either use the correct '-o branch' option,\n".
665                        "or import to a new repository.\n";
666         }
667 }
668
669 -d $git_dir
670         or die "Could not create git subdir ($git_dir).\n";
671
672 # now we read (and possibly save) author-info as well
673 -f "$git_dir/cvs-authors" and
674   read_author_info("$git_dir/cvs-authors");
675 if ($opt_A) {
676         read_author_info(munge_user_filename($opt_A));
677         write_author_info("$git_dir/cvs-authors");
678 }
679
680 # open .git/cvs-revisions, if requested
681 open my $revision_map, '>>', "$git_dir/cvs-revisions"
682     or die "Can't open $git_dir/cvs-revisions for appending: $!\n"
683         if defined $opt_R;
684
685
686 #
687 # run cvsps into a file unless we are getting
688 # it passed as a file via $opt_P
689 #
690 my $cvspsfile;
691 unless ($opt_P) {
692         print "Running cvsps...\n" if $opt_v;
693         my $pid = open(CVSPS,"-|");
694         my $cvspsfh;
695         die "Cannot fork: $!\n" unless defined $pid;
696         unless ($pid) {
697                 my @opt;
698                 @opt = split(/,/,$opt_p) if defined $opt_p;
699                 unshift @opt, '-z', $opt_z if defined $opt_z;
700                 unshift @opt, '-q'         unless defined $opt_v;
701                 unless (defined($opt_p) && $opt_p =~ m/--no-cvs-direct/) {
702                         push @opt, '--cvs-direct';
703                 }
704                 exec("cvsps","--norc",@opt,"-u","-A",'--root',$opt_d,$cvs_tree);
705                 die "Could not start cvsps: $!\n";
706         }
707         ($cvspsfh, $cvspsfile) = tempfile('gitXXXXXX', SUFFIX => '.cvsps',
708                                           DIR => File::Spec->tmpdir());
709         while (<CVSPS>) {
710             print $cvspsfh $_;
711         }
712         close CVSPS;
713         $? == 0 or die "git cvsimport: fatal: cvsps reported error\n";
714         close $cvspsfh;
715 } else {
716         $cvspsfile = munge_user_filename($opt_P);
717 }
718
719 open(CVS, "<$cvspsfile") or die $!;
720
721 ## cvsps output:
722 #---------------------
723 #PatchSet 314
724 #Date: 1999/09/18 13:03:59
725 #Author: wkoch
726 #Branch: STABLE-BRANCH-1-0
727 #Ancestor branch: HEAD
728 #Tag: (none)
729 #Log:
730 #    See ChangeLog: Sat Sep 18 13:03:28 CEST 1999  Werner Koch
731 #Members:
732 #       README:1.57->1.57.2.1
733 #       VERSION:1.96->1.96.2.1
734 #
735 #---------------------
736
737 my $state = 0;
738
739 sub update_index (\@\@) {
740         my $old = shift;
741         my $new = shift;
742         open(my $fh, '|-', qw(git update-index -z --index-info))
743                 or die "unable to open git update-index: $!";
744         print $fh
745                 (map { "0 0000000000000000000000000000000000000000\t$_\0" }
746                         @$old),
747                 (map { '100' . sprintf('%o', $_->[0]) . " $_->[1]\t$_->[2]\0" }
748                         @$new)
749                 or die "unable to write to git update-index: $!";
750         close $fh
751                 or die "unable to write to git update-index: $!";
752         $? and die "git update-index reported error: $?";
753 }
754
755 sub write_tree () {
756         open(my $fh, '-|', qw(git write-tree))
757                 or die "unable to open git write-tree: $!";
758         chomp(my $tree = <$fh>);
759         is_sha1($tree)
760                 or die "Cannot get tree id ($tree): $!";
761         close($fh)
762                 or die "Error running git write-tree: $?\n";
763         print "Tree ID $tree\n" if $opt_v;
764         return $tree;
765 }
766
767 my ($patchset,$date,$author_name,$author_email,$branch,$ancestor,$tag,$logmsg);
768 my (@old,@new,@skipped,%ignorebranch,@commit_revisions);
769
770 # commits that cvsps cannot place anywhere...
771 $ignorebranch{'#CVSPS_NO_BRANCH'} = 1;
772
773 sub commit {
774         if ($branch eq $opt_o && !$index{branch} &&
775                 !get_headref("$remote/$branch")) {
776             # looks like an initial commit
777             # use the index primed by git init
778             $ENV{GIT_INDEX_FILE} = "$git_dir/index";
779             $index{$branch} = "$git_dir/index";
780         } else {
781             # use an index per branch to speed up
782             # imports of projects with many branches
783             unless ($index{$branch}) {
784                 $index{$branch} = tmpnam();
785                 $ENV{GIT_INDEX_FILE} = $index{$branch};
786                 if ($ancestor) {
787                     system("git", "read-tree", "$remote/$ancestor");
788                 } else {
789                     system("git", "read-tree", "$remote/$branch");
790                 }
791                 die "read-tree failed: $?\n" if $?;
792             }
793         }
794         $ENV{GIT_INDEX_FILE} = $index{$branch};
795
796         update_index(@old, @new);
797         @old = @new = ();
798         my $tree = write_tree();
799         my $parent = get_headref("$remote/$last_branch");
800         print "Parent ID " . ($parent ? $parent : "(empty)") . "\n" if $opt_v;
801
802         my @commit_args;
803         push @commit_args, ("-p", $parent) if $parent;
804
805         # loose detection of merges
806         # based on the commit msg
807         foreach my $rx (@mergerx) {
808                 next unless $logmsg =~ $rx && $1;
809                 my $mparent = $1 eq 'HEAD' ? $opt_o : $1;
810                 if (my $sha1 = get_headref("$remote/$mparent")) {
811                         push @commit_args, '-p', "$remote/$mparent";
812                         print "Merge parent branch: $mparent\n" if $opt_v;
813                 }
814         }
815
816         my $commit_date = strftime("+0000 %Y-%m-%d %H:%M:%S",gmtime($date));
817         $ENV{GIT_AUTHOR_NAME} = $author_name;
818         $ENV{GIT_AUTHOR_EMAIL} = $author_email;
819         $ENV{GIT_AUTHOR_DATE} = $commit_date;
820         $ENV{GIT_COMMITTER_NAME} = $author_name;
821         $ENV{GIT_COMMITTER_EMAIL} = $author_email;
822         $ENV{GIT_COMMITTER_DATE} = $commit_date;
823         my $pid = open2(my $commit_read, my $commit_write,
824                 'git', 'commit-tree', $tree, @commit_args);
825
826         # compatibility with git2cvs
827         substr($logmsg,32767) = "" if length($logmsg) > 32767;
828         $logmsg =~ s/[\s\n]+\z//;
829
830         if (@skipped) {
831             $logmsg .= "\n\n\nSKIPPED:\n\t";
832             $logmsg .= join("\n\t", @skipped) . "\n";
833             @skipped = ();
834         }
835
836         print($commit_write "$logmsg\n") && close($commit_write)
837                 or die "Error writing to git commit-tree: $!\n";
838
839         print "Committed patch $patchset ($branch $commit_date)\n" if $opt_v;
840         chomp(my $cid = <$commit_read>);
841         is_sha1($cid) or die "Cannot get commit id ($cid): $!\n";
842         print "Commit ID $cid\n" if $opt_v;
843         close($commit_read);
844
845         waitpid($pid,0);
846         die "Error running git commit-tree: $?\n" if $?;
847
848         system('git' , 'update-ref', "$remote/$branch", $cid) == 0
849                 or die "Cannot write branch $branch for update: $!\n";
850
851         if ($revision_map) {
852                 print $revision_map "@$_ $cid\n" for @commit_revisions;
853         }
854         @commit_revisions = ();
855
856         if ($tag) {
857                 my ($xtag) = $tag;
858                 $xtag =~ s/\s+\*\*.*$//; # Remove stuff like ** INVALID ** and ** FUNKY **
859                 $xtag =~ tr/_/\./ if ( $opt_u );
860                 $xtag =~ s/[\/]/$opt_s/g;
861                 $xtag =~ s/\[//g;
862
863                 system('git' , 'tag', '-f', $xtag, $cid) == 0
864                         or die "Cannot create tag $xtag: $!\n";
865
866                 print "Created tag '$xtag' on '$branch'\n" if $opt_v;
867         }
868 };
869
870 my $commitcount = 1;
871 while (<CVS>) {
872         chomp;
873         if ($state == 0 and /^-+$/) {
874                 $state = 1;
875         } elsif ($state == 0) {
876                 $state = 1;
877                 redo;
878         } elsif (($state==0 or $state==1) and s/^PatchSet\s+//) {
879                 $patchset = 0+$_;
880                 $state=2;
881         } elsif ($state == 2 and s/^Date:\s+//) {
882                 $date = pdate($_);
883                 unless ($date) {
884                         print STDERR "Could not parse date: $_\n";
885                         $state=0;
886                         next;
887                 }
888                 $state=3;
889         } elsif ($state == 3 and s/^Author:\s+//) {
890                 s/\s+$//;
891                 if (/^(.*?)\s+<(.*)>/) {
892                     ($author_name, $author_email) = ($1, $2);
893                 } elsif ($conv_author_name{$_}) {
894                         $author_name = $conv_author_name{$_};
895                         $author_email = $conv_author_email{$_};
896                 } else {
897                     $author_name = $author_email = $_;
898                 }
899                 $state = 4;
900         } elsif ($state == 4 and s/^Branch:\s+//) {
901                 s/\s+$//;
902                 tr/_/\./ if ( $opt_u );
903                 s/[\/]/$opt_s/g;
904                 $branch = $_;
905                 $state = 5;
906         } elsif ($state == 5 and s/^Ancestor branch:\s+//) {
907                 s/\s+$//;
908                 $ancestor = $_;
909                 $ancestor = $opt_o if $ancestor eq "HEAD";
910                 $state = 6;
911         } elsif ($state == 5) {
912                 $ancestor = undef;
913                 $state = 6;
914                 redo;
915         } elsif ($state == 6 and s/^Tag:\s+//) {
916                 s/\s+$//;
917                 if ($_ eq "(none)") {
918                         $tag = undef;
919                 } else {
920                         $tag = $_;
921                 }
922                 $state = 7;
923         } elsif ($state == 7 and /^Log:/) {
924                 $logmsg = "";
925                 $state = 8;
926         } elsif ($state == 8 and /^Members:/) {
927                 $branch = $opt_o if $branch eq "HEAD";
928                 if (defined $branch_date{$branch} and $branch_date{$branch} >= $date) {
929                         # skip
930                         print "skip patchset $patchset: $date before $branch_date{$branch}\n" if $opt_v;
931                         $state = 11;
932                         next;
933                 }
934                 if (!$opt_a && $starttime - 300 - (defined $opt_z ? $opt_z : 300) <= $date) {
935                         # skip if the commit is too recent
936                         # given that the cvsps default fuzz is 300s, we give ourselves another
937                         # 300s just in case -- this also prevents skipping commits
938                         # due to server clock drift
939                         print "skip patchset $patchset: $date too recent\n" if $opt_v;
940                         $state = 11;
941                         next;
942                 }
943                 if (exists $ignorebranch{$branch}) {
944                         print STDERR "Skipping $branch\n";
945                         $state = 11;
946                         next;
947                 }
948                 if ($ancestor) {
949                         if ($ancestor eq $branch) {
950                                 print STDERR "Branch $branch erroneously stems from itself -- changed ancestor to $opt_o\n";
951                                 $ancestor = $opt_o;
952                         }
953                         if (defined get_headref("$remote/$branch")) {
954                                 print STDERR "Branch $branch already exists!\n";
955                                 $state=11;
956                                 next;
957                         }
958                         my $id = get_headref("$remote/$ancestor");
959                         if (!$id) {
960                                 print STDERR "Branch $ancestor does not exist!\n";
961                                 $ignorebranch{$branch} = 1;
962                                 $state=11;
963                                 next;
964                         }
965
966                         system(qw(git update-ref -m cvsimport),
967                                 "$remote/$branch", $id);
968                         if($? != 0) {
969                                 print STDERR "Could not create branch $branch\n";
970                                 $ignorebranch{$branch} = 1;
971                                 $state=11;
972                                 next;
973                         }
974                 }
975                 $last_branch = $branch if $branch ne $last_branch;
976                 $state = 9;
977         } elsif ($state == 8) {
978                 $logmsg .= "$_\n";
979         } elsif ($state == 9 and /^\s+(.+?):(INITIAL|\d+(?:\.\d+)+)->(\d+(?:\.\d+)+)\s*$/) {
980 #       VERSION:1.96->1.96.2.1
981                 my $init = ($2 eq "INITIAL");
982                 my $fn = $1;
983                 my $rev = $3;
984                 $fn =~ s#^/+##;
985                 if ($opt_S && $fn =~ m/$opt_S/) {
986                     print "SKIPPING $fn v $rev\n";
987                     push(@skipped, $fn);
988                     next;
989                 }
990                 push @commit_revisions, [$fn, $rev];
991                 print "Fetching $fn   v $rev\n" if $opt_v;
992                 my ($tmpname, $size) = $cvs->file($fn,$rev);
993                 if ($size == -1) {
994                         push(@old,$fn);
995                         print "Drop $fn\n" if $opt_v;
996                 } else {
997                         print "".($init ? "New" : "Update")." $fn: $size bytes\n" if $opt_v;
998                         my $pid = open(my $F, '-|');
999                         die $! unless defined $pid;
1000                         if (!$pid) {
1001                             exec("git", "hash-object", "-w", $tmpname)
1002                                 or die "Cannot create object: $!\n";
1003                         }
1004                         my $sha = <$F>;
1005                         chomp $sha;
1006                         close $F;
1007                         my $mode = pmode($cvs->{'mode'});
1008                         push(@new,[$mode, $sha, $fn]); # may be resurrected!
1009                 }
1010                 unlink($tmpname);
1011         } elsif ($state == 9 and /^\s+(.+?):\d+(?:\.\d+)+->(\d+(?:\.\d+)+)\(DEAD\)\s*$/) {
1012                 my $fn = $1;
1013                 my $rev = $2;
1014                 $fn =~ s#^/+##;
1015                 push @commit_revisions, [$fn, $rev];
1016                 push(@old,$fn);
1017                 print "Delete $fn\n" if $opt_v;
1018         } elsif ($state == 9 and /^\s*$/) {
1019                 $state = 10;
1020         } elsif (($state == 9 or $state == 10) and /^-+$/) {
1021                 $commitcount++;
1022                 if ($opt_L && $commitcount > $opt_L) {
1023                         last;
1024                 }
1025                 commit();
1026                 if (($commitcount & 1023) == 0) {
1027                         system(qw(git repack -a -d));
1028                 }
1029                 $state = 1;
1030         } elsif ($state == 11 and /^-+$/) {
1031                 $state = 1;
1032         } elsif (/^-+$/) { # end of unknown-line processing
1033                 $state = 1;
1034         } elsif ($state != 11) { # ignore stuff when skipping
1035                 print STDERR "* UNKNOWN LINE * $_\n";
1036         }
1037 }
1038 commit() if $branch and $state != 11;
1039
1040 unless ($opt_P) {
1041         unlink($cvspsfile);
1042 }
1043
1044 # The heuristic of repacking every 1024 commits can leave a
1045 # lot of unpacked data.  If there is more than 1MB worth of
1046 # not-packed objects, repack once more.
1047 my $line = `git count-objects`;
1048 if ($line =~ /^(\d+) objects, (\d+) kilobytes$/) {
1049   my ($n_objects, $kb) = ($1, $2);
1050   1024 < $kb
1051     and system(qw(git repack -a -d));
1052 }
1053
1054 foreach my $git_index (values %index) {
1055     if ($git_index ne "$git_dir/index") {
1056         unlink($git_index);
1057     }
1058 }
1059
1060 if (defined $orig_git_index) {
1061         $ENV{GIT_INDEX_FILE} = $orig_git_index;
1062 } else {
1063         delete $ENV{GIT_INDEX_FILE};
1064 }
1065
1066 # Now switch back to the branch we were in before all of this happened
1067 if ($orig_branch) {
1068         print "DONE.\n" if $opt_v;
1069         if ($opt_i) {
1070                 exit 0;
1071         }
1072         my $tip_at_end = `git rev-parse --verify HEAD`;
1073         if ($tip_at_start ne $tip_at_end) {
1074                 for ($tip_at_start, $tip_at_end) { chomp; }
1075                 print "Fetched into the current branch.\n" if $opt_v;
1076                 system(qw(git read-tree -u -m),
1077                        $tip_at_start, $tip_at_end);
1078                 die "Fast-forward update failed: $?\n" if $?;
1079         }
1080         else {
1081                 system(qw(git merge cvsimport HEAD), "$remote/$opt_o");
1082                 die "Could not merge $opt_o into the current branch.\n" if $?;
1083         }
1084 } else {
1085         $orig_branch = "master";
1086         print "DONE; creating $orig_branch branch\n" if $opt_v;
1087         system("git", "update-ref", "refs/heads/master", "$remote/$opt_o")
1088                 unless defined get_headref('refs/heads/master');
1089         system("git", "symbolic-ref", "$remote/HEAD", "$remote/$opt_o")
1090                 if ($opt_r && $opt_o ne 'HEAD');
1091         system('git', 'update-ref', 'HEAD', "$orig_branch");
1092         unless ($opt_i) {
1093                 system(qw(git checkout -f));
1094                 die "checkout failed: $?\n" if $?;
1095         }
1096 }