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