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