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