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