git

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.008001;
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
use Git qw(get_tz_offset);
30

31
$SIG{'PIPE'}="IGNORE";
32
set_timezone('UTC');
33

34
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);
35
my (%conv_author_name, %conv_author_email, %conv_author_tz);
36

37
sub usage(;$) {
38
	my $msg = shift;
39
	print(STDERR "Error: $msg\n") if $msg;
40
	print STDERR <<END;
41
usage: git cvsimport     # fetch/update GIT from CVS
42
       [-o branch-for-HEAD] [-h] [-v] [-d CVSROOT] [-A author-conv-file]
43
       [-p opts-for-cvsps] [-P file] [-C GIT_repository] [-z fuzz] [-i] [-k]
44
       [-u] [-s subst] [-a] [-m] [-M regex] [-S regex] [-L commitlimit]
45
       [-r remote] [-R] [CVS_module]
46
END
47
	exit(1);
48
}
49

50
sub read_author_info($) {
51
	my ($file) = @_;
52
	my $user;
53
	open my $f, '<', "$file" or die("Failed to open $file: $!\n");
54

55
	while (<$f>) {
56
		# Expected format is this:
57
		#   exon=Andreas Ericsson <ae@op5.se>
58
		if (m/^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/) {
59
			$user = $1;
60
			$conv_author_name{$user} = $2;
61
			$conv_author_email{$user} = $3;
62
		}
63
		# or with an optional timezone:
64
		#   spawn=Simon Pawn <spawn@frog-pond.org> America/Chicago
65
		elsif (m/^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*(\S+?)\s*$/) {
66
			$user = $1;
67
			$conv_author_name{$user} = $2;
68
			$conv_author_email{$user} = $3;
69
			$conv_author_tz{$user} = $4;
70
		}
71
		# However, we also read from CVSROOT/users format
72
		# to ease migration.
73
		elsif (/^(\w+):(['"]?)(.+?)\2\s*$/) {
74
			my $mapped;
75
			($user, $mapped) = ($1, $3);
76
			if ($mapped =~ /^\s*(.*?)\s*<(.*)>\s*$/) {
77
				$conv_author_name{$user} = $1;
78
				$conv_author_email{$user} = $2;
79
			}
80
			elsif ($mapped =~ /^<?(.*)>?$/) {
81
				$conv_author_name{$user} = $user;
82
				$conv_author_email{$user} = $1;
83
			}
84
		}
85
		# NEEDSWORK: Maybe warn on unrecognized lines?
86
	}
87
	close ($f);
88
}
89

90
sub write_author_info($) {
91
	my ($file) = @_;
92
	open my $f, '>', $file or
93
	  die("Failed to open $file for writing: $!");
94

95
	foreach (keys %conv_author_name) {
96
		print $f "$_=$conv_author_name{$_} <$conv_author_email{$_}>";
97
		print $f " $conv_author_tz{$_}" if ($conv_author_tz{$_});
98
		print $f "\n";
99
	}
100
	close ($f);
101
}
102

103
# Versions of perl before 5.10.0 may not automatically check $TZ each
104
# time localtime is run (most platforms will do so only the first time).
105
# We can work around this by using tzset() to update the internal
106
# variable whenever we change the environment.
107
sub set_timezone {
108
	$ENV{TZ} = shift;
109
	tzset();
110
}
111

112
# convert getopts specs for use by git config
113
my %longmap = (
114
	'A:' => 'authors-file',
115
	'M:' => 'merge-regex',
116
	'P:' => undef,
117
	'R' => 'track-revisions',
118
	'S:' => 'ignore-paths',
119
);
120

121
sub read_repo_config {
122
	# Split the string between characters, unless there is a ':'
123
	# So "abc:de" becomes ["a", "b", "c:", "d", "e"]
124
	my @opts = split(/ *(?!:)/, shift);
125
	foreach my $o (@opts) {
126
		my $key = $o;
127
		$key =~ s/://g;
128
		my $arg = 'git config';
129
		$arg .= ' --bool' if ($o !~ /:$/);
130
		my $ckey = $key;
131

132
		if (exists $longmap{$o}) {
133
			# An uppercase option like -R cannot be
134
			# expressed in the configuration, as the
135
			# variable names are downcased.
136
			$ckey = $longmap{$o};
137
			next if (! defined $ckey);
138
			$ckey =~ s/-//g;
139
		}
140
		chomp(my $tmp = `$arg --get cvsimport.$ckey`);
141
		if ($tmp && !($arg =~ /--bool/ && $tmp eq 'false')) {
142
			no strict 'refs';
143
			my $opt_name = "opt_" . $key;
144
			if (!$$opt_name) {
145
				$$opt_name = $tmp;
146
			}
147
		}
148
	}
149
}
150

151
my $opts = "haivmkuo:d:p:r:C:z:s:M:P:A:S:L:R";
152
read_repo_config($opts);
153
Getopt::Long::Configure( 'no_ignore_case', 'bundling' );
154

155
# turn the Getopt::Std specification in a Getopt::Long one,
156
# with support for multiple -M options
157
GetOptions( map { s/:/=s/; /M/ ? "$_\@" : $_ } split( /(?!:)/, $opts ) )
158
    or usage();
159
usage if $opt_h;
160

161
if (@ARGV == 0) {
162
		chomp(my $module = `git config --get cvsimport.module`);
163
		push(@ARGV, $module) if $? == 0;
164
}
165
@ARGV <= 1 or usage("You can't specify more than one CVS module");
166

167
if ($opt_d) {
168
	$ENV{"CVSROOT"} = $opt_d;
169
} elsif (-f 'CVS/Root') {
170
	open my $f, '<', 'CVS/Root' or die 'Failed to open CVS/Root';
171
	$opt_d = <$f>;
172
	chomp $opt_d;
173
	close $f;
174
	$ENV{"CVSROOT"} = $opt_d;
175
} elsif ($ENV{"CVSROOT"}) {
176
	$opt_d = $ENV{"CVSROOT"};
177
} else {
178
	usage("CVSROOT needs to be set");
179
}
180
$opt_s ||= "-";
181
$opt_a ||= 0;
182

183
my $git_tree = $opt_C;
184
$git_tree ||= ".";
185

186
my $remote;
187
if (defined $opt_r) {
188
	$remote = 'refs/remotes/' . $opt_r;
189
	$opt_o ||= "master";
190
} else {
191
	$opt_o ||= "origin";
192
	$remote = 'refs/heads';
193
}
194

195
my $cvs_tree;
196
if ($#ARGV == 0) {
197
	$cvs_tree = $ARGV[0];
198
} elsif (-f 'CVS/Repository') {
199
	open my $f, '<', 'CVS/Repository' or
200
	    die 'Failed to open CVS/Repository';
201
	$cvs_tree = <$f>;
202
	chomp $cvs_tree;
203
	close $f;
204
} else {
205
	usage("CVS module has to be specified");
206
}
207

208
our @mergerx = ();
209
if ($opt_m) {
210
	@mergerx = ( qr/\b(?:from|of|merge|merging|merged) ([-\w]+)/i );
211
}
212
if (@opt_M) {
213
	push (@mergerx, map { qr/$_/ } @opt_M);
214
}
215

216
# Remember UTC of our starting time
217
# we'll want to avoid importing commits
218
# that are too recent
219
our $starttime = time();
220

221
select(STDERR); $|=1; select(STDOUT);
222

223

224
package CVSconn;
225
# Basic CVS dialog.
226
# We're only interested in connecting and downloading, so ...
227

228
use File::Spec;
229
use File::Temp qw(tempfile);
230
use POSIX qw(strftime dup2);
231

232
sub new {
233
	my ($what,$repo,$subdir) = @_;
234
	$what=ref($what) if ref($what);
235

236
	my $self = {};
237
	$self->{'buffer'} = "";
238
	bless($self,$what);
239

240
	$repo =~ s#/+$##;
241
	$self->{'fullrep'} = $repo;
242
	$self->conn();
243

244
	$self->{'subdir'} = $subdir;
245
	$self->{'lines'} = undef;
246

247
	return $self;
248
}
249

250
sub find_password_entry {
251
	my ($cvspass, @cvsroot) = @_;
252
	my ($file, $delim) = @$cvspass;
253
	my $pass;
254
	local ($_);
255

256
	if (open(my $fh, $file)) {
257
		# :pserver:cvs@mea.tmt.tele.fi:/cvsroot/zmailer Ah<Z
258
		CVSPASSFILE:
259
		while (<$fh>) {
260
			chomp;
261
			s/^\/\d+\s+//;
262
			my ($w, $p) = split($delim,$_,2);
263
			for my $cvsroot (@cvsroot) {
264
				if ($w eq $cvsroot) {
265
					$pass = $p;
266
					last CVSPASSFILE;
267
				}
268
			}
269
		}
270
		close($fh);
271
	}
272
	return $pass;
273
}
274

275
sub conn {
276
	my $self = shift;
277
	my $repo = $self->{'fullrep'};
278
	if ($repo =~ s/^:pserver(?:([^:]*)):(?:(.*?)(?::(.*?))?@)?([^:\/]*)(?::(\d*))?//) {
279
		my ($param,$user,$pass,$serv,$port) = ($1,$2,$3,$4,$5);
280

281
		my ($proxyhost,$proxyport);
282
		if ($param && ($param =~ m/proxy=([^;]+)/)) {
283
			$proxyhost = $1;
284
			# Default proxyport, if not specified, is 8080.
285
			$proxyport = 8080;
286
			if ($ENV{"CVS_PROXY_PORT"}) {
287
				$proxyport = $ENV{"CVS_PROXY_PORT"};
288
			}
289
			if ($param =~ m/proxyport=([^;]+)/) {
290
				$proxyport = $1;
291
			}
292
		}
293
		$repo ||= '/';
294

295
		# if username is not explicit in CVSROOT, then use current user, as cvs would
296
		$user=(getlogin() || $ENV{'LOGNAME'} || $ENV{'USER'} || "anonymous") unless $user;
297
		my $rr2 = "-";
298
		unless ($port) {
299
			$rr2 = ":pserver:$user\@$serv:$repo";
300
			$port=2401;
301
		}
302
		my $rr = ":pserver:$user\@$serv:$port$repo";
303

304
		if ($pass) {
305
			$pass = $self->_scramble($pass);
306
		} else {
307
			my @cvspass = ([$ENV{'HOME'}."/.cvspass", qr/\s/],
308
				       [$ENV{'HOME'}."/.cvs/cvspass", qr/=/]);
309
			my @loc = ();
310
			foreach my $cvspass (@cvspass) {
311
				my $p = find_password_entry($cvspass, $rr, $rr2);
312
				if ($p) {
313
					push @loc, $cvspass->[0];
314
					$pass = $p;
315
				}
316
			}
317

318
			if (1 < @loc) {
319
				die("Multiple cvs password files have ".
320
				    "entries for CVSROOT $opt_d: @loc");
321
			} elsif (!$pass) {
322
				$pass = "A";
323
			}
324
		}
325

326
		my ($s, $rep);
327
		if ($proxyhost) {
328

329
			# Use a HTTP Proxy. Only works for HTTP proxies that
330
			# don't require user authentication
331
			#
332
			# See: https://www.ietf.org/rfc/rfc2817.txt
333

334
			$s = IO::Socket::INET->new(PeerHost => $proxyhost, PeerPort => $proxyport);
335
			die "Socket to $proxyhost: $!\n" unless defined $s;
336
			$s->write("CONNECT $serv:$port HTTP/1.1\r\nHost: $serv:$port\r\n\r\n")
337
	                        or die "Write to $proxyhost: $!\n";
338
	                $s->flush();
339

340
			$rep = <$s>;
341

342
			# The answer should look like 'HTTP/1.x 2yy ....'
343
			if (!($rep =~ m#^HTTP/1\.. 2[0-9][0-9]#)) {
344
				die "Proxy connect: $rep\n";
345
			}
346
			# Skip up to the empty line of the proxy server output
347
			# including the response headers.
348
			while ($rep = <$s>) {
349
				last if (!defined $rep ||
350
					 $rep eq "\n" ||
351
					 $rep eq "\r\n");
352
			}
353
		} else {
354
			$s = IO::Socket::INET->new(PeerHost => $serv, PeerPort => $port);
355
			die "Socket to $serv: $!\n" unless defined $s;
356
		}
357

358
		$s->write("BEGIN AUTH REQUEST\n$repo\n$user\n$pass\nEND AUTH REQUEST\n")
359
			or die "Write to $serv: $!\n";
360
		$s->flush();
361

362
		$rep = <$s>;
363

364
		if ($rep ne "I LOVE YOU\n") {
365
			$rep="<unknown>" unless $rep;
366
			die "AuthReply: $rep\n";
367
		}
368
		$self->{'socketo'} = $s;
369
		$self->{'socketi'} = $s;
370
	} else { # local or ext: Fork off our own cvs server.
371
		my $pr = IO::Pipe->new();
372
		my $pw = IO::Pipe->new();
373
		my $pid = fork();
374
		die "Fork: $!\n" unless defined $pid;
375
		my $cvs = 'cvs';
376
		$cvs = $ENV{CVS_SERVER} if exists $ENV{CVS_SERVER};
377
		my $rsh = 'rsh';
378
		$rsh = $ENV{CVS_RSH} if exists $ENV{CVS_RSH};
379

380
		my @cvs = ($cvs, 'server');
381
		my ($local, $user, $host);
382
		$local = $repo =~ s/:local://;
383
		if (!$local) {
384
		    $repo =~ s/:ext://;
385
		    $local = !($repo =~ s/^(?:([^\@:]+)\@)?([^:]+)://);
386
		    ($user, $host) = ($1, $2);
387
		}
388
		if (!$local) {
389
		    if ($user) {
390
			unshift @cvs, $rsh, '-l', $user, $host;
391
		    } else {
392
			unshift @cvs, $rsh, $host;
393
		    }
394
		}
395

396
		unless ($pid) {
397
			$pr->writer();
398
			$pw->reader();
399
			dup2($pw->fileno(),0);
400
			dup2($pr->fileno(),1);
401
			$pr->close();
402
			$pw->close();
403
			exec(@cvs);
404
		}
405
		$pw->writer();
406
		$pr->reader();
407
		$self->{'socketo'} = $pw;
408
		$self->{'socketi'} = $pr;
409
	}
410
	$self->{'socketo'}->write("Root $repo\n");
411

412
	# Trial and error says that this probably is the minimum set
413
	$self->{'socketo'}->write("Valid-responses ok error Valid-requests Mode M Mbinary E Checked-in Created Updated Merged Removed\n");
414

415
	$self->{'socketo'}->write("valid-requests\n");
416
	$self->{'socketo'}->flush();
417

418
	my $rep=$self->readline();
419
	die "Failed to read from server" unless defined $rep;
420
	chomp($rep);
421
	if ($rep !~ s/^Valid-requests\s*//) {
422
		$rep="<unknown>" unless $rep;
423
		die "Expected Valid-requests from server, but got: $rep\n";
424
	}
425
	chomp(my $res=$self->readline());
426
	die "validReply: $res\n" if $res ne "ok";
427

428
	$self->{'socketo'}->write("UseUnchanged\n") if $rep =~ /\bUseUnchanged\b/;
429
	$self->{'repo'} = $repo;
430
}
431

432
sub readline {
433
	my ($self) = @_;
434
	return $self->{'socketi'}->getline();
435
}
436

437
sub _file {
438
	# Request a file with a given revision.
439
	# Trial and error says this is a good way to do it. :-/
440
	my ($self,$fn,$rev) = @_;
441
	$self->{'socketo'}->write("Argument -N\n") or return undef;
442
	$self->{'socketo'}->write("Argument -P\n") or return undef;
443
	# -kk: Linus' version doesn't use it - defaults to off
444
	if ($opt_k) {
445
	    $self->{'socketo'}->write("Argument -kk\n") or return undef;
446
	}
447
	$self->{'socketo'}->write("Argument -r\n") or return undef;
448
	$self->{'socketo'}->write("Argument $rev\n") or return undef;
449
	$self->{'socketo'}->write("Argument --\n") or return undef;
450
	$self->{'socketo'}->write("Argument $self->{'subdir'}/$fn\n") or return undef;
451
	$self->{'socketo'}->write("Directory .\n") or return undef;
452
	$self->{'socketo'}->write("$self->{'repo'}\n") or return undef;
453
	# $self->{'socketo'}->write("Sticky T1.0\n") or return undef;
454
	$self->{'socketo'}->write("co\n") or return undef;
455
	$self->{'socketo'}->flush() or return undef;
456
	$self->{'lines'} = 0;
457
	return 1;
458
}
459
sub _line {
460
	# Read a line from the server.
461
	# ... except that 'line' may be an entire file. ;-)
462
	my ($self, $fh) = @_;
463
	die "Not in lines" unless defined $self->{'lines'};
464

465
	my $line;
466
	my $res=0;
467
	while (defined($line = $self->readline())) {
468
		# M U gnupg-cvs-rep/AUTHORS
469
		# Updated gnupg-cvs-rep/
470
		# /daten/src/rsync/gnupg-cvs-rep/AUTHORS
471
		# /AUTHORS/1.1///T1.1
472
		# u=rw,g=rw,o=rw
473
		# 0
474
		# ok
475

476
		if ($line =~ s/^(?:Created|Updated) //) {
477
			$line = $self->readline(); # path
478
			$line = $self->readline(); # Entries line
479
			my $mode = $self->readline(); chomp $mode;
480
			$self->{'mode'} = $mode;
481
			defined (my $cnt = $self->readline())
482
				or die "EOF from server after 'Changed'\n";
483
			chomp $cnt;
484
			die "Duh: Filesize $cnt" if $cnt !~ /^\d+$/;
485
			$line="";
486
			$res = $self->_fetchfile($fh, $cnt);
487
		} elsif ($line =~ s/^ //) {
488
			print $fh $line;
489
			$res += length($line);
490
		} elsif ($line =~ /^M\b/) {
491
			# output, do nothing
492
		} elsif ($line =~ /^Mbinary\b/) {
493
			my $cnt;
494
			die "EOF from server after 'Mbinary'" unless defined ($cnt = $self->readline());
495
			chomp $cnt;
496
			die "Duh: Mbinary $cnt" if $cnt !~ /^\d+$/ or $cnt<1;
497
			$line="";
498
			$res += $self->_fetchfile($fh, $cnt);
499
		} else {
500
			chomp $line;
501
			if ($line eq "ok") {
502
				# print STDERR "S: ok (".length($res).")\n";
503
				return $res;
504
			} elsif ($line =~ s/^E //) {
505
				# print STDERR "S: $line\n";
506
			} elsif ($line =~ /^(Remove-entry|Removed) /i) {
507
				$line = $self->readline(); # filename
508
				$line = $self->readline(); # OK
509
				chomp $line;
510
				die "Unknown: $line" if $line ne "ok";
511
				return -1;
512
			} else {
513
				die "Unknown: $line\n";
514
			}
515
		}
516
	}
517
	return undef;
518
}
519
sub file {
520
	my ($self,$fn,$rev) = @_;
521
	my $res;
522

523
	my ($fh, $name) = tempfile('gitcvs.XXXXXX',
524
		    DIR => File::Spec->tmpdir(), UNLINK => 1);
525

526
	$self->_file($fn,$rev) and $res = $self->_line($fh);
527

528
	if (!defined $res) {
529
	    print STDERR "Server has gone away while fetching $fn $rev, retrying...\n";
530
	    truncate $fh, 0;
531
	    $self->conn();
532
	    $self->_file($fn,$rev) or die "No file command send";
533
	    $res = $self->_line($fh);
534
	    die "Retry failed" unless defined $res;
535
	}
536
	close ($fh);
537

538
	return ($name, $res);
539
}
540
sub _fetchfile {
541
	my ($self, $fh, $cnt) = @_;
542
	my $res = 0;
543
	my $bufsize = 1024 * 1024;
544
	while ($cnt) {
545
	    if ($bufsize > $cnt) {
546
		$bufsize = $cnt;
547
	    }
548
	    my $buf;
549
	    my $num = $self->{'socketi'}->read($buf,$bufsize);
550
	    die "Server: Filesize $cnt: $num: $!\n" if not defined $num or $num<=0;
551
	    print $fh $buf;
552
	    $res += $num;
553
	    $cnt -= $num;
554
	}
555
	return $res;
556
}
557

558
sub _scramble {
559
	my ($self, $pass) = @_;
560
	my $scrambled = "A";
561

562
	return $scrambled unless $pass;
563

564
	my $pass_len = length($pass);
565
	my @pass_arr = split("", $pass);
566
	my $i;
567

568
	# from cvs/src/scramble.c
569
	my @shifts = (
570
		  0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
571
		 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
572
		114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
573
		111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
574
		 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
575
		125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
576
		 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
577
		 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
578
		225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
579
		199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
580
		174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
581
		207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
582
		192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
583
		227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
584
		182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
585
		243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
586
	);
587

588
	for ($i = 0; $i < $pass_len; $i++) {
589
		$scrambled .= pack("C", $shifts[ord($pass_arr[$i])]);
590
	}
591

592
	return $scrambled;
593
}
594

595
package main;
596

597
my $cvs = CVSconn->new($opt_d, $cvs_tree);
598

599

600
sub pdate($) {
601
	my ($d) = @_;
602
	m#(\d{2,4})/(\d\d)/(\d\d)\s(\d\d):(\d\d)(?::(\d\d))?#
603
		or die "Unparsable date: $d\n";
604
	my $y=$1;
605
	$y+=100 if $y<70;
606
	$y+=1900 if $y<1000;
607
	return timegm($6||0,$5,$4,$3,$2-1,$y);
608
}
609

610
sub pmode($) {
611
	my ($mode) = @_;
612
	my $m = 0;
613
	my $mm = 0;
614
	my $um = 0;
615
	for my $x(split(//,$mode)) {
616
		if ($x eq ",") {
617
			$m |= $mm&$um;
618
			$mm = 0;
619
			$um = 0;
620
		} elsif ($x eq "u") { $um |= 0700;
621
		} elsif ($x eq "g") { $um |= 0070;
622
		} elsif ($x eq "o") { $um |= 0007;
623
		} elsif ($x eq "r") { $mm |= 0444;
624
		} elsif ($x eq "w") { $mm |= 0222;
625
		} elsif ($x eq "x") { $mm |= 0111;
626
		} elsif ($x eq "=") { # do nothing
627
		} else { die "Unknown mode: $mode\n";
628
		}
629
	}
630
	$m |= $mm&$um;
631
	return $m;
632
}
633

634
sub getwd() {
635
	my $pwd = `pwd`;
636
	chomp $pwd;
637
	return $pwd;
638
}
639

640
sub is_oid {
641
	my $s = shift;
642
	return $s =~ /^[a-f0-9]{40}(?:[a-f0-9]{24})?$/;
643
}
644

645
sub get_headref ($) {
646
	my $name = shift;
647
	$name =~ s/'/'\\''/g;
648
	my $r = `git rev-parse --verify '$name' 2>/dev/null`;
649
	return undef unless $? == 0;
650
	chomp $r;
651
	return $r;
652
}
653

654
my $user_filename_prepend = '';
655
sub munge_user_filename {
656
	my $name = shift;
657
	return File::Spec->file_name_is_absolute($name) ?
658
		$name :
659
		$user_filename_prepend . $name;
660
}
661

662
-d $git_tree
663
	or mkdir($git_tree,0777)
664
	or die "Could not create $git_tree: $!";
665
if ($git_tree ne '.') {
666
	$user_filename_prepend = getwd() . '/';
667
	chdir($git_tree);
668
}
669

670
my $last_branch = "";
671
my $orig_branch = "";
672
my %branch_date;
673
my $tip_at_start = undef;
674

675
my $git_dir = $ENV{"GIT_DIR"} || ".git";
676
$git_dir = getwd()."/".$git_dir unless $git_dir =~ m#^/#;
677
$ENV{"GIT_DIR"} = $git_dir;
678
my $orig_git_index;
679
$orig_git_index = $ENV{GIT_INDEX_FILE} if exists $ENV{GIT_INDEX_FILE};
680

681
my %index; # holds filenames of one index per branch
682

683
unless (-d $git_dir) {
684
	system(qw(git init));
685
	die "Cannot init the GIT db at $git_tree: $?\n" if $?;
686
	system(qw(git read-tree --empty));
687
	die "Cannot init an empty tree: $?\n" if $?;
688

689
	$last_branch = $opt_o;
690
	$orig_branch = "";
691
} else {
692
	open(F, "-|", qw(git symbolic-ref HEAD)) or
693
		die "Cannot run git symbolic-ref: $!\n";
694
	chomp ($last_branch = <F>);
695
	$last_branch = basename($last_branch);
696
	close(F);
697
	unless ($last_branch) {
698
		warn "Cannot read the last branch name: $! -- assuming 'master'\n";
699
		$last_branch = "master";
700
	}
701
	$orig_branch = $last_branch;
702
	$tip_at_start = `git rev-parse --verify HEAD`;
703

704
	# Get the last import timestamps
705
	my $fmt = '($ref, $author) = (%(refname), %(author));';
706
	my @cmd = ('git', 'for-each-ref', '--perl', "--format=$fmt", $remote);
707
	open(H, "-|", @cmd) or die "Cannot run git for-each-ref: $!\n";
708
	while (defined(my $entry = <H>)) {
709
		my ($ref, $author);
710
		eval($entry) || die "cannot eval refs list: $@";
711
		my ($head) = ($ref =~ m|^$remote/(.*)|);
712
		$author =~ /^.*\s(\d+)\s[-+]\d{4}$/;
713
		$branch_date{$head} = $1;
714
	}
715
	close(H);
716
        if (!exists $branch_date{$opt_o}) {
717
		die "Branch '$opt_o' does not exist.\n".
718
		       "Either use the correct '-o branch' option,\n".
719
		       "or import to a new repository.\n";
720
        }
721
}
722

723
-d $git_dir
724
	or die "Could not create git subdir ($git_dir).\n";
725

726
# now we read (and possibly save) author-info as well
727
-f "$git_dir/cvs-authors" and
728
  read_author_info("$git_dir/cvs-authors");
729
if ($opt_A) {
730
	read_author_info(munge_user_filename($opt_A));
731
	write_author_info("$git_dir/cvs-authors");
732
}
733

734
# open .git/cvs-revisions, if requested
735
open my $revision_map, '>>', "$git_dir/cvs-revisions"
736
    or die "Can't open $git_dir/cvs-revisions for appending: $!\n"
737
	if defined $opt_R;
738

739

740
#
741
# run cvsps into a file unless we are getting
742
# it passed as a file via $opt_P
743
#
744
my $cvspsfile;
745
unless ($opt_P) {
746
	print "Running cvsps...\n" if $opt_v;
747
	my $pid = open(CVSPS,"-|");
748
	my $cvspsfh;
749
	die "Cannot fork: $!\n" unless defined $pid;
750
	unless ($pid) {
751
		my @opt;
752
		@opt = split(/,/,$opt_p) if defined $opt_p;
753
		unshift @opt, '-z', $opt_z if defined $opt_z;
754
		unshift @opt, '-q'         unless defined $opt_v;
755
		unless (defined($opt_p) && $opt_p =~ m/--no-cvs-direct/) {
756
			push @opt, '--cvs-direct';
757
		}
758
		exec("cvsps","--norc",@opt,"-u","-A",'--root',$opt_d,$cvs_tree);
759
		die "Could not start cvsps: $!\n";
760
	}
761
	($cvspsfh, $cvspsfile) = tempfile('gitXXXXXX', SUFFIX => '.cvsps',
762
					  DIR => File::Spec->tmpdir());
763
	while (<CVSPS>) {
764
	    print $cvspsfh $_;
765
	}
766
	close CVSPS;
767
	$? == 0 or die "git cvsimport: fatal: cvsps reported error\n";
768
	close $cvspsfh;
769
} else {
770
	$cvspsfile = munge_user_filename($opt_P);
771
}
772

773
open(CVS, "<$cvspsfile") or die $!;
774

775
## cvsps output:
776
#---------------------
777
#PatchSet 314
778
#Date: 1999/09/18 13:03:59
779
#Author: wkoch
780
#Branch: STABLE-BRANCH-1-0
781
#Ancestor branch: HEAD
782
#Tag: (none)
783
#Log:
784
#    See ChangeLog: Sat Sep 18 13:03:28 CEST 1999  Werner Koch
785
#Members:
786
#	README:1.57->1.57.2.1
787
#	VERSION:1.96->1.96.2.1
788
#
789
#---------------------
790

791
my $state = 0;
792

793
sub update_index (\@\@) {
794
	my $old = shift;
795
	my $new = shift;
796
	open(my $fh, '|-', qw(git update-index -z --index-info))
797
		or die "unable to open git update-index: $!";
798
	print $fh
799
		(map { "0 0000000000000000000000000000000000000000\t$_\0" }
800
			@$old),
801
		(map { '100' . sprintf('%o', $_->[0]) . " $_->[1]\t$_->[2]\0" }
802
			@$new)
803
		or die "unable to write to git update-index: $!";
804
	close $fh
805
		or die "unable to write to git update-index: $!";
806
	$? and die "git update-index reported error: $?";
807
}
808

809
sub write_tree () {
810
	open(my $fh, '-|', qw(git write-tree))
811
		or die "unable to open git write-tree: $!";
812
	chomp(my $tree = <$fh>);
813
	is_oid($tree)
814
		or die "Cannot get tree id ($tree): $!";
815
	close($fh)
816
		or die "Error running git write-tree: $?\n";
817
	print "Tree ID $tree\n" if $opt_v;
818
	return $tree;
819
}
820

821
my ($patchset,$date,$author_name,$author_email,$author_tz,$branch,$ancestor,$tag,$logmsg);
822
my (@old,@new,@skipped,%ignorebranch,@commit_revisions);
823

824
# commits that cvsps cannot place anywhere...
825
$ignorebranch{'#CVSPS_NO_BRANCH'} = 1;
826

827
sub commit {
828
	if ($branch eq $opt_o && !$index{branch} &&
829
		!get_headref("$remote/$branch")) {
830
	    # looks like an initial commit
831
	    # use the index primed by git init
832
	    $ENV{GIT_INDEX_FILE} = "$git_dir/index";
833
	    $index{$branch} = "$git_dir/index";
834
	} else {
835
	    # use an index per branch to speed up
836
	    # imports of projects with many branches
837
	    unless ($index{$branch}) {
838
		$index{$branch} = tmpnam();
839
		$ENV{GIT_INDEX_FILE} = $index{$branch};
840
		if ($ancestor) {
841
		    system("git", "read-tree", "$remote/$ancestor");
842
		} else {
843
		    system("git", "read-tree", "$remote/$branch");
844
		}
845
		die "read-tree failed: $?\n" if $?;
846
	    }
847
	}
848
        $ENV{GIT_INDEX_FILE} = $index{$branch};
849

850
	update_index(@old, @new);
851
	@old = @new = ();
852
	my $tree = write_tree();
853
	my $parent = get_headref("$remote/$last_branch");
854
	print "Parent ID " . ($parent ? $parent : "(empty)") . "\n" if $opt_v;
855

856
	my @commit_args;
857
	push @commit_args, ("-p", $parent) if $parent;
858

859
	# loose detection of merges
860
	# based on the commit msg
861
	foreach my $rx (@mergerx) {
862
		next unless $logmsg =~ $rx && $1;
863
		my $mparent = $1 eq 'HEAD' ? $opt_o : $1;
864
		if (my $sha1 = get_headref("$remote/$mparent")) {
865
			push @commit_args, '-p', "$remote/$mparent";
866
			print "Merge parent branch: $mparent\n" if $opt_v;
867
		}
868
	}
869

870
	set_timezone($author_tz);
871
	# $date is in the seconds since epoch format
872
	my $tz_offset = get_tz_offset($date);
873
	my $commit_date = "$date $tz_offset";
874
	set_timezone('UTC');
875
	$ENV{GIT_AUTHOR_NAME} = $author_name;
876
	$ENV{GIT_AUTHOR_EMAIL} = $author_email;
877
	$ENV{GIT_AUTHOR_DATE} = $commit_date;
878
	$ENV{GIT_COMMITTER_NAME} = $author_name;
879
	$ENV{GIT_COMMITTER_EMAIL} = $author_email;
880
	$ENV{GIT_COMMITTER_DATE} = $commit_date;
881
	my $pid = open2(my $commit_read, my $commit_write,
882
		'git', 'commit-tree', $tree, @commit_args);
883

884
	# compatibility with git2cvs
885
	substr($logmsg,32767) = "" if length($logmsg) > 32767;
886
	$logmsg =~ s/[\s\n]+\z//;
887

888
	if (@skipped) {
889
	    $logmsg .= "\n\n\nSKIPPED:\n\t";
890
	    $logmsg .= join("\n\t", @skipped) . "\n";
891
	    @skipped = ();
892
	}
893

894
	print($commit_write "$logmsg\n") && close($commit_write)
895
		or die "Error writing to git commit-tree: $!\n";
896

897
	print "Committed patch $patchset ($branch $commit_date)\n" if $opt_v;
898
	chomp(my $cid = <$commit_read>);
899
	is_oid($cid) or die "Cannot get commit id ($cid): $!\n";
900
	print "Commit ID $cid\n" if $opt_v;
901
	close($commit_read);
902

903
	waitpid($pid,0);
904
	die "Error running git commit-tree: $?\n" if $?;
905

906
	system('git' , 'update-ref', "$remote/$branch", $cid) == 0
907
		or die "Cannot write branch $branch for update: $!\n";
908

909
	if ($revision_map) {
910
		print $revision_map "@$_ $cid\n" for @commit_revisions;
911
	}
912
	@commit_revisions = ();
913

914
	if ($tag) {
915
	        my ($xtag) = $tag;
916
		$xtag =~ s/\s+\*\*.*$//; # Remove stuff like ** INVALID ** and ** FUNKY **
917
		$xtag =~ tr/_/\./ if ( $opt_u );
918
		$xtag =~ s/[\/]/$opt_s/g;
919

920
		# See refs.c for these rules.
921
		# Tag cannot contain bad chars. (See bad_ref_char in refs.c.)
922
		$xtag =~ s/[ ~\^:\\\*\?\[]//g;
923
		# Other bad strings for tags:
924
		# (See check_refname_component in refs.c.)
925
		1 while $xtag =~ s/
926
			(?: \.\.        # Tag cannot contain '..'.
927
			|   \@\{        # Tag cannot contain '@{'.
928
			| ^ -           # Tag cannot begin with '-'.
929
			|   \.lock $    # Tag cannot end with '.lock'.
930
			| ^ \.          # Tag cannot begin...
931
			|   \. $        # ...or end with '.'
932
			)//xg;
933
		# Tag cannot be empty.
934
		if ($xtag eq '') {
935
			warn("warning: ignoring tag '$tag'",
936
			" with invalid tagname\n");
937
			return;
938
		}
939

940
		if (system('git' , 'tag', '-f', $xtag, $cid) != 0) {
941
			# We did our best to sanitize the tag, but still failed
942
			# for whatever reason. Bail out, and give the user
943
			# enough information to understand if/how we should
944
			# improve the translation in the future.
945
			if ($tag ne $xtag) {
946
				print "Translated '$tag' tag to '$xtag'\n";
947
			}
948
			die "Cannot create tag $xtag: $!\n";
949
		}
950

951
		print "Created tag '$xtag' on '$branch'\n" if $opt_v;
952
	}
953
};
954

955
my $commitcount = 1;
956
while (<CVS>) {
957
	chomp;
958
	if ($state == 0 and /^-+$/) {
959
		$state = 1;
960
	} elsif ($state == 0) {
961
		$state = 1;
962
		redo;
963
	} elsif (($state==0 or $state==1) and s/^PatchSet\s+//) {
964
		$patchset = 0+$_;
965
		$state=2;
966
	} elsif ($state == 2 and s/^Date:\s+//) {
967
		$date = pdate($_);
968
		unless ($date) {
969
			print STDERR "Could not parse date: $_\n";
970
			$state=0;
971
			next;
972
		}
973
		$state=3;
974
	} elsif ($state == 3 and s/^Author:\s+//) {
975
		$author_tz = "UTC";
976
		s/\s+$//;
977
		if (/^(.*?)\s+<(.*)>/) {
978
		    ($author_name, $author_email) = ($1, $2);
979
		} elsif ($conv_author_name{$_}) {
980
			$author_name = $conv_author_name{$_};
981
			$author_email = $conv_author_email{$_};
982
			$author_tz = $conv_author_tz{$_} if ($conv_author_tz{$_});
983
		} else {
984
		    $author_name = $author_email = $_;
985
		}
986
		$state = 4;
987
	} elsif ($state == 4 and s/^Branch:\s+//) {
988
		s/\s+$//;
989
		tr/_/\./ if ( $opt_u );
990
		s/[\/]/$opt_s/g;
991
		$branch = $_;
992
		$state = 5;
993
	} elsif ($state == 5 and s/^Ancestor branch:\s+//) {
994
		s/\s+$//;
995
		$ancestor = $_;
996
		$ancestor = $opt_o if $ancestor eq "HEAD";
997
		$state = 6;
998
	} elsif ($state == 5) {
999
		$ancestor = undef;
1000
		$state = 6;
1001
		redo;
1002
	} elsif ($state == 6 and s/^Tag:\s+//) {
1003
		s/\s+$//;
1004
		if ($_ eq "(none)") {
1005
			$tag = undef;
1006
		} else {
1007
			$tag = $_;
1008
		}
1009
		$state = 7;
1010
	} elsif ($state == 7 and /^Log:/) {
1011
		$logmsg = "";
1012
		$state = 8;
1013
	} elsif ($state == 8 and /^Members:/) {
1014
		$branch = $opt_o if $branch eq "HEAD";
1015
		if (defined $branch_date{$branch} and $branch_date{$branch} >= $date) {
1016
			# skip
1017
			print "skip patchset $patchset: $date before $branch_date{$branch}\n" if $opt_v;
1018
			$state = 11;
1019
			next;
1020
		}
1021
		if (!$opt_a && $starttime - 300 - (defined $opt_z ? $opt_z : 300) <= $date) {
1022
			# skip if the commit is too recent
1023
			# given that the cvsps default fuzz is 300s, we give ourselves another
1024
			# 300s just in case -- this also prevents skipping commits
1025
			# due to server clock drift
1026
			print "skip patchset $patchset: $date too recent\n" if $opt_v;
1027
			$state = 11;
1028
			next;
1029
		}
1030
		if (exists $ignorebranch{$branch}) {
1031
			print STDERR "Skipping $branch\n";
1032
			$state = 11;
1033
			next;
1034
		}
1035
		if ($ancestor) {
1036
			if ($ancestor eq $branch) {
1037
				print STDERR "Branch $branch erroneously stems from itself -- changed ancestor to $opt_o\n";
1038
				$ancestor = $opt_o;
1039
			}
1040
			if (defined get_headref("$remote/$branch")) {
1041
				print STDERR "Branch $branch already exists!\n";
1042
				$state=11;
1043
				next;
1044
			}
1045
			my $id = get_headref("$remote/$ancestor");
1046
			if (!$id) {
1047
				print STDERR "Branch $ancestor does not exist!\n";
1048
				$ignorebranch{$branch} = 1;
1049
				$state=11;
1050
				next;
1051
			}
1052

1053
			system(qw(git update-ref -m cvsimport),
1054
				"$remote/$branch", $id);
1055
			if($? != 0) {
1056
				print STDERR "Could not create branch $branch\n";
1057
				$ignorebranch{$branch} = 1;
1058
				$state=11;
1059
				next;
1060
			}
1061
		}
1062
		$last_branch = $branch if $branch ne $last_branch;
1063
		$state = 9;
1064
	} elsif ($state == 8) {
1065
		$logmsg .= "$_\n";
1066
	} elsif ($state == 9 and /^\s+(.+?):(INITIAL|\d+(?:\.\d+)+)->(\d+(?:\.\d+)+)\s*$/) {
1067
#	VERSION:1.96->1.96.2.1
1068
		my $init = ($2 eq "INITIAL");
1069
		my $fn = $1;
1070
		my $rev = $3;
1071
		$fn =~ s#^/+##;
1072
		if ($opt_S && $fn =~ m/$opt_S/) {
1073
		    print "SKIPPING $fn v $rev\n";
1074
		    push(@skipped, $fn);
1075
		    next;
1076
		}
1077
		push @commit_revisions, [$fn, $rev];
1078
		print "Fetching $fn   v $rev\n" if $opt_v;
1079
		my ($tmpname, $size) = $cvs->file($fn,$rev);
1080
		if ($size == -1) {
1081
			push(@old,$fn);
1082
			print "Drop $fn\n" if $opt_v;
1083
		} else {
1084
			print "".($init ? "New" : "Update")." $fn: $size bytes\n" if $opt_v;
1085
			my $pid = open(my $F, '-|');
1086
			die $! unless defined $pid;
1087
			if (!$pid) {
1088
			    exec("git", "hash-object", "-w", $tmpname)
1089
				or die "Cannot create object: $!\n";
1090
			}
1091
			my $sha = <$F>;
1092
			chomp $sha;
1093
			close $F;
1094
			my $mode = pmode($cvs->{'mode'});
1095
			push(@new,[$mode, $sha, $fn]); # may be resurrected!
1096
		}
1097
		unlink($tmpname);
1098
	} elsif ($state == 9 and /^\s+(.+?):\d+(?:\.\d+)+->(\d+(?:\.\d+)+)\(DEAD\)\s*$/) {
1099
		my $fn = $1;
1100
		my $rev = $2;
1101
		$fn =~ s#^/+##;
1102
		push @commit_revisions, [$fn, $rev];
1103
		push(@old,$fn);
1104
		print "Delete $fn\n" if $opt_v;
1105
	} elsif ($state == 9 and /^\s*$/) {
1106
		$state = 10;
1107
	} elsif (($state == 9 or $state == 10) and /^-+$/) {
1108
		$commitcount++;
1109
		if ($opt_L && $commitcount > $opt_L) {
1110
			last;
1111
		}
1112
		commit();
1113
		if (($commitcount & 1023) == 0) {
1114
			system(qw(git repack -a -d));
1115
		}
1116
		$state = 1;
1117
	} elsif ($state == 11 and /^-+$/) {
1118
		$state = 1;
1119
	} elsif (/^-+$/) { # end of unknown-line processing
1120
		$state = 1;
1121
	} elsif ($state != 11) { # ignore stuff when skipping
1122
		print STDERR "* UNKNOWN LINE * $_\n";
1123
	}
1124
}
1125
commit() if $branch and $state != 11;
1126

1127
unless ($opt_P) {
1128
	unlink($cvspsfile);
1129
}
1130

1131
# The heuristic of repacking every 1024 commits can leave a
1132
# lot of unpacked data.  If there is more than 1MB worth of
1133
# not-packed objects, repack once more.
1134
my $line = `git count-objects`;
1135
if ($line =~ /^(\d+) objects, (\d+) kilobytes$/) {
1136
  my ($n_objects, $kb) = ($1, $2);
1137
  1024 < $kb
1138
    and system(qw(git repack -a -d));
1139
}
1140

1141
foreach my $git_index (values %index) {
1142
    if ($git_index ne "$git_dir/index") {
1143
	unlink($git_index);
1144
    }
1145
}
1146

1147
if (defined $orig_git_index) {
1148
	$ENV{GIT_INDEX_FILE} = $orig_git_index;
1149
} else {
1150
	delete $ENV{GIT_INDEX_FILE};
1151
}
1152

1153
# Now switch back to the branch we were in before all of this happened
1154
if ($orig_branch) {
1155
	print "DONE.\n" if $opt_v;
1156
	if ($opt_i) {
1157
		exit 0;
1158
	}
1159
	my $tip_at_end = `git rev-parse --verify HEAD`;
1160
	if ($tip_at_start ne $tip_at_end) {
1161
		for ($tip_at_start, $tip_at_end) { chomp; }
1162
		print "Fetched into the current branch.\n" if $opt_v;
1163
		system(qw(git read-tree -u -m),
1164
		       $tip_at_start, $tip_at_end);
1165
		die "Fast-forward update failed: $?\n" if $?;
1166
	}
1167
	else {
1168
		system(qw(git merge -m cvsimport), "$remote/$opt_o");
1169
		die "Could not merge $opt_o into the current branch.\n" if $?;
1170
	}
1171
} else {
1172
	$orig_branch = "master";
1173
	print "DONE; creating $orig_branch branch\n" if $opt_v;
1174
	system("git", "update-ref", "refs/heads/master", "$remote/$opt_o")
1175
		unless defined get_headref('refs/heads/master');
1176
	system("git", "symbolic-ref", "$remote/HEAD", "$remote/$opt_o")
1177
		if ($opt_r && $opt_o ne 'HEAD');
1178
	system('git', 'update-ref', 'HEAD', "$orig_branch");
1179
	unless ($opt_i) {
1180
		system(qw(git checkout -f));
1181
		die "checkout failed: $?\n" if $?;
1182
	}
1183
}
1184