]> git.ipfire.org Git - thirdparty/git.git/blame - git-cvsimport.perl
Merge branch 'maint'
[thirdparty/git.git] / git-cvsimport.perl
CommitLineData
a57a9493 1#!/usr/bin/perl -w
9718a00b 2
a57a9493
MU
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
16use strict;
17use warnings;
bc434e82 18use Getopt::Long;
79ee456c 19use File::Spec;
7ccd9009 20use File::Temp qw(tempfile tmpnam);
a57a9493
MU
21use File::Path qw(mkpath);
22use File::Basename qw(basename dirname);
23use Time::Local;
2a3e1a85
MU
24use IO::Socket;
25use IO::Pipe;
e49289df 26use POSIX qw(strftime dup2 ENOENT);
0d821d4d 27use IPC::Open2;
a57a9493
MU
28
29$SIG{'PIPE'}="IGNORE";
30$ENV{'TZ'}="UTC";
31
bc434e82 32our ($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);
ffd97f3a 33my (%conv_author_name, %conv_author_email);
a57a9493 34
7bf77644
FL
35sub usage(;$) {
36 my $msg = shift;
37 print(STDERR "Error: $msg\n") if $msg;
a57a9493 38 print STDERR <<END;
1b1dd23f 39Usage: git cvsimport # fetch/update GIT from CVS
ffd97f3a 40 [-o branch-for-HEAD] [-h] [-v] [-d CVSROOT] [-A author-conv-file]
edbe4466
FL
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]
cbc9be5c 43 [-r remote] [CVS_module]
a57a9493
MU
44END
45 exit(1);
46}
47
ffd97f3a
AE
48sub read_author_info($) {
49 my ($file) = @_;
50 my $user;
51 open my $f, '<', "$file" or die("Failed to open $file: $!\n");
52
53 while (<$f>) {
8cd16211 54 # Expected format is this:
ffd97f3a 55 # exon=Andreas Ericsson <ae@op5.se>
8cd16211 56 if (m/^(\S+?)\s*=\s*(.+?)\s*<(.+)>\s*$/) {
ffd97f3a 57 $user = $1;
8cd16211
JH
58 $conv_author_name{$user} = $2;
59 $conv_author_email{$user} = $3;
ffd97f3a 60 }
8cd16211
JH
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;
69 }
70 elsif ($mapped =~ /^<?(.*)>?$/) {
71 $conv_author_name{$user} = $user;
72 $conv_author_email{$user} = $1;
73 }
74 }
75 # NEEDSWORK: Maybe warn on unrecognized lines?
ffd97f3a
AE
76 }
77 close ($f);
78}
79
80sub write_author_info($) {
81 my ($file) = @_;
82 open my $f, '>', $file or
83 die("Failed to open $file for writing: $!");
84
85 foreach (keys %conv_author_name) {
8cd16211 86 print $f "$_=$conv_author_name{$_} <$conv_author_email{$_}>\n";
ffd97f3a
AE
87 }
88 close ($f);
89}
90
cfc44a12 91# convert getopts specs for use by git config
ed35dece
JB
92sub 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;
cfc44a12 99 my $arg = 'git config';
ed35dece
JB
100 $arg .= ' --bool' if ($o !~ /:$/);
101
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;
108 }
109 }
110 }
ed35dece
JB
111}
112
8b7f5fc1 113my $opts = "haivmkuo:d:p:r:C:z:s:M:P:A:S:L:";
ed35dece 114read_repo_config($opts);
bc434e82
PB
115Getopt::Long::Configure( 'no_ignore_case', 'bundling' );
116
117# turn the Getopt::Std specification in a Getopt::Long one,
118# with support for multiple -M options
119GetOptions( map { s/:/=s/; /M/ ? "$_\@" : $_ } split( /(?!:)/, $opts ) )
120 or usage();
a57a9493
MU
121usage if $opt_h;
122
67d23242 123if (@ARGV == 0) {
cfc44a12 124 chomp(my $module = `git config --get cvsimport.module`);
67d23242
JK
125 push(@ARGV, $module) if $? == 0;
126}
7bf77644 127@ARGV <= 1 or usage("You can't specify more than one CVS module");
a57a9493 128
86d11cf2 129if ($opt_d) {
2a3e1a85 130 $ENV{"CVSROOT"} = $opt_d;
86d11cf2 131} elsif (-f 'CVS/Root') {
f9714a4a
SV
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;
86d11cf2 137} elsif ($ENV{"CVSROOT"}) {
2a3e1a85
MU
138 $opt_d = $ENV{"CVSROOT"};
139} else {
7bf77644 140 usage("CVSROOT needs to be set");
2a3e1a85 141}
fbfd60d6 142$opt_s ||= "-";
ded9f400
ML
143$opt_a ||= 0;
144
f9714a4a 145my $git_tree = $opt_C;
2a3e1a85
MU
146$git_tree ||= ".";
147
8b7f5fc1
AW
148my $remote;
149if (defined $opt_r) {
150 $remote = 'refs/remotes/' . $opt_r;
151 $opt_o ||= "master";
152} else {
153 $opt_o ||= "origin";
154 $remote = 'refs/heads';
155}
156
f9714a4a
SV
157my $cvs_tree;
158if ($#ARGV == 0) {
159 $cvs_tree = $ARGV[0];
160} elsif (-f 'CVS/Repository') {
a6080a0a 161 open my $f, '<', 'CVS/Repository' or
f9714a4a
SV
162 die 'Failed to open CVS/Repository';
163 $cvs_tree = <$f>;
164 chomp $cvs_tree;
db4b6582 165 close $f;
f9714a4a 166} else {
7bf77644 167 usage("CVS module has to be specified");
f9714a4a
SV
168}
169
db4b6582
ML
170our @mergerx = ();
171if ($opt_m) {
fbbbc362 172 @mergerx = ( qr/\b(?:from|of|merge|merging|merged) ([-\w]+)/i );
db4b6582 173}
bc434e82
PB
174if (@opt_M) {
175 push (@mergerx, map { qr/$_/ } @opt_M);
db4b6582
ML
176}
177
6211988f
ML
178# Remember UTC of our starting time
179# we'll want to avoid importing commits
180# that are too recent
181our $starttime = time();
182
a57a9493
MU
183select(STDERR); $|=1; select(STDOUT);
184
185
186package CVSconn;
187# Basic CVS dialog.
2a3e1a85 188# We're only interested in connecting and downloading, so ...
a57a9493 189
2eb6d82e
SV
190use File::Spec;
191use File::Temp qw(tempfile);
f65ae603
MU
192use POSIX qw(strftime dup2);
193
a57a9493 194sub new {
86d11cf2 195 my ($what,$repo,$subdir) = @_;
a57a9493
MU
196 $what=ref($what) if ref($what);
197
198 my $self = {};
199 $self->{'buffer'} = "";
200 bless($self,$what);
201
202 $repo =~ s#/+$##;
203 $self->{'fullrep'} = $repo;
204 $self->conn();
205
206 $self->{'subdir'} = $subdir;
207 $self->{'lines'} = undef;
208
209 return $self;
210}
211
212sub conn {
213 my $self = shift;
214 my $repo = $self->{'fullrep'};
86d11cf2
JH
215 if ($repo =~ s/^:pserver(?:([^:]*)):(?:(.*?)(?::(.*?))?@)?([^:\/]*)(?::(\d*))?//) {
216 my ($param,$user,$pass,$serv,$port) = ($1,$2,$3,$4,$5);
73bcf533 217
86d11cf2
JH
218 my ($proxyhost,$proxyport);
219 if ($param && ($param =~ m/proxy=([^;]+)/)) {
73bcf533
IA
220 $proxyhost = $1;
221 # Default proxyport, if not specified, is 8080.
222 $proxyport = 8080;
86d11cf2 223 if ($ENV{"CVS_PROXY_PORT"}) {
73bcf533
IA
224 $proxyport = $ENV{"CVS_PROXY_PORT"};
225 }
86d11cf2 226 if ($param =~ m/proxyport=([^;]+)/) {
73bcf533
IA
227 $proxyport = $1;
228 }
229 }
8c372fb0 230 $repo ||= '/';
73bcf533 231
2e458e05
GH
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;
2a3e1a85 234 my $rr2 = "-";
86d11cf2 235 unless ($port) {
a57a9493
MU
236 $rr2 = ":pserver:$user\@$serv:$repo";
237 $port=2401;
238 }
239 my $rr = ":pserver:$user\@$serv:$port$repo";
240
86d11cf2 241 unless ($pass) {
a57a9493
MU
242 open(H,$ENV{'HOME'}."/.cvspass") and do {
243 # :pserver:cvs@mea.tmt.tele.fi:/cvsroot/zmailer Ah<Z
86d11cf2 244 while (<H>) {
a57a9493
MU
245 chomp;
246 s/^\/\d+\s+//;
247 my ($w,$p) = split(/\s/,$_,2);
86d11cf2 248 if ($w eq $rr or $w eq $rr2) {
a57a9493
MU
249 $pass = $p;
250 last;
251 }
252 }
253 };
254 }
b2139dbd
DH
255
256 $pass = $self->_scramble($pass);
a57a9493 257
73bcf533 258 my ($s, $rep);
86d11cf2 259 if ($proxyhost) {
73bcf533
IA
260
261 # Use a HTTP Proxy. Only works for HTTP proxies that
262 # don't require user authentication
263 #
264 # See: http://www.ietf.org/rfc/rfc2817.txt
265
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();
271
272 $rep = <$s>;
273
274 # The answer should look like 'HTTP/1.x 2yy ....'
86d11cf2 275 if (!($rep =~ m#^HTTP/1\.. 2[0-9][0-9]#)) {
73bcf533
IA
276 die "Proxy connect: $rep\n";
277 }
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");
284 }
285 } else {
286 $s = IO::Socket::INET->new(PeerHost => $serv, PeerPort => $port);
287 die "Socket to $serv: $!\n" unless defined $s;
288 }
289
a57a9493
MU
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();
293
73bcf533 294 $rep = <$s>;
a57a9493 295
86d11cf2 296 if ($rep ne "I LOVE YOU\n") {
a57a9493
MU
297 $rep="<unknown>" unless $rep;
298 die "AuthReply: $rep\n";
299 }
300 $self->{'socketo'} = $s;
301 $self->{'socketi'} = $s;
34155390 302 } else { # local or ext: Fork off our own cvs server.
a57a9493
MU
303 my $pr = IO::Pipe->new();
304 my $pw = IO::Pipe->new();
305 my $pid = fork();
306 die "Fork: $!\n" unless defined $pid;
8d0ea311
SV
307 my $cvs = 'cvs';
308 $cvs = $ENV{CVS_SERVER} if exists $ENV{CVS_SERVER};
34155390
SV
309 my $rsh = 'rsh';
310 $rsh = $ENV{CVS_RSH} if exists $ENV{CVS_RSH};
311
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);
319 }
320 if (!$local) {
321 if ($user) {
322 unshift @cvs, $rsh, '-l', $user, $host;
323 } else {
324 unshift @cvs, $rsh, $host;
325 }
326 }
327
86d11cf2 328 unless ($pid) {
a57a9493
MU
329 $pr->writer();
330 $pw->reader();
a57a9493
MU
331 dup2($pw->fileno(),0);
332 dup2($pr->fileno(),1);
333 $pr->close();
334 $pw->close();
34155390 335 exec(@cvs);
a57a9493
MU
336 }
337 $pw->writer();
338 $pr->reader();
339 $self->{'socketo'} = $pw;
340 $self->{'socketi'} = $pr;
341 }
342 $self->{'socketo'}->write("Root $repo\n");
343
344 # Trial and error says that this probably is the minimum set
b0921331 345 $self->{'socketo'}->write("Valid-responses ok error Valid-requests Mode M Mbinary E Checked-in Created Updated Merged Removed\n");
a57a9493
MU
346
347 $self->{'socketo'}->write("valid-requests\n");
348 $self->{'socketo'}->flush();
349
350 chomp(my $rep=$self->readline());
86d11cf2 351 if ($rep !~ s/^Valid-requests\s*//) {
a57a9493
MU
352 $rep="<unknown>" unless $rep;
353 die "Expected Valid-requests from server, but got: $rep\n";
354 }
355 chomp(my $res=$self->readline());
356 die "validReply: $res\n" if $res ne "ok";
357
358 $self->{'socketo'}->write("UseUnchanged\n") if $rep =~ /\bUseUnchanged\b/;
359 $self->{'repo'} = $repo;
360}
361
362sub readline {
86d11cf2 363 my ($self) = @_;
a57a9493
MU
364 return $self->{'socketi'}->getline();
365}
366
367sub _file {
368 # Request a file with a given revision.
369 # Trial and error says this is a good way to do it. :-/
86d11cf2 370 my ($self,$fn,$rev) = @_;
a57a9493
MU
371 $self->{'socketo'}->write("Argument -N\n") or return undef;
372 $self->{'socketo'}->write("Argument -P\n") or return undef;
abe05822
ML
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;
376 }
a57a9493
MU
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;
4f7c0caa 383 # $self->{'socketo'}->write("Sticky T1.0\n") or return undef;
a57a9493
MU
384 $self->{'socketo'}->write("co\n") or return undef;
385 $self->{'socketo'}->flush() or return undef;
386 $self->{'lines'} = 0;
387 return 1;
388}
389sub _line {
390 # Read a line from the server.
391 # ... except that 'line' may be an entire file. ;-)
86d11cf2 392 my ($self, $fh) = @_;
a57a9493
MU
393 die "Not in lines" unless defined $self->{'lines'};
394
395 my $line;
2eb6d82e 396 my $res=0;
86d11cf2 397 while (defined($line = $self->readline())) {
a57a9493
MU
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
403 # 0
404 # ok
405
86d11cf2 406 if ($line =~ s/^(?:Created|Updated) //) {
a57a9493
MU
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="";
55cad842 416 $res = $self->_fetchfile($fh, $cnt);
86d11cf2 417 } elsif ($line =~ s/^ //) {
2eb6d82e
SV
418 print $fh $line;
419 $res += length($line);
86d11cf2 420 } elsif ($line =~ /^M\b/) {
a57a9493 421 # output, do nothing
86d11cf2 422 } elsif ($line =~ /^Mbinary\b/) {
a57a9493
MU
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="";
55cad842 428 $res += $self->_fetchfile($fh, $cnt);
a57a9493
MU
429 } else {
430 chomp $line;
86d11cf2 431 if ($line eq "ok") {
a57a9493
MU
432 # print STDERR "S: ok (".length($res).")\n";
433 return $res;
86d11cf2 434 } elsif ($line =~ s/^E //) {
a57a9493 435 # print STDERR "S: $line\n";
86d11cf2 436 } elsif ($line =~ /^(Remove-entry|Removed) /i) {
8b8840e0
MU
437 $line = $self->readline(); # filename
438 $line = $self->readline(); # OK
439 chomp $line;
440 die "Unknown: $line" if $line ne "ok";
441 return -1;
a57a9493
MU
442 } else {
443 die "Unknown: $line\n";
444 }
445 }
446 }
39ba7d54 447 return undef;
a57a9493
MU
448}
449sub file {
86d11cf2 450 my ($self,$fn,$rev) = @_;
a57a9493
MU
451 my $res;
452
a6080a0a 453 my ($fh, $name) = tempfile('gitcvs.XXXXXX',
2eb6d82e
SV
454 DIR => File::Spec->tmpdir(), UNLINK => 1);
455
456 $self->_file($fn,$rev) and $res = $self->_line($fh);
457
458 if (!defined $res) {
39ba7d54
MM
459 print STDERR "Server has gone away while fetching $fn $rev, retrying...\n";
460 truncate $fh, 0;
2eb6d82e 461 $self->conn();
39ba7d54 462 $self->_file($fn,$rev) or die "No file command send";
2eb6d82e 463 $res = $self->_line($fh);
39ba7d54 464 die "Retry failed" unless defined $res;
a57a9493 465 }
c619ad51 466 close ($fh);
a57a9493 467
2eb6d82e 468 return ($name, $res);
a57a9493 469}
55cad842
ML
470sub _fetchfile {
471 my ($self, $fh, $cnt) = @_;
61efa5e3 472 my $res = 0;
55cad842 473 my $bufsize = 1024 * 1024;
86d11cf2 474 while ($cnt) {
55cad842
ML
475 if ($bufsize > $cnt) {
476 $bufsize = $cnt;
477 }
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;
484 }
485 return $res;
486}
a57a9493 487
b2139dbd
DH
488sub _scramble {
489 my ($self, $pass) = @_;
490 my $scrambled = "A";
491
492 return $scrambled unless $pass;
493
494 my $pass_len = length($pass);
495 my @pass_arr = split("", $pass);
496 my $i;
497
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
516 );
517
518 for ($i = 0; $i < $pass_len; $i++) {
519 $scrambled .= pack("C", $shifts[ord($pass_arr[$i])]);
520 }
521
522 return $scrambled;
523}
a57a9493
MU
524
525package main;
526
2a3e1a85 527my $cvs = CVSconn->new($opt_d, $cvs_tree);
a57a9493
MU
528
529
530sub pdate($) {
86d11cf2 531 my ($d) = @_;
a57a9493
MU
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);
9718a00b
TM
536}
537
a57a9493 538sub pmode($) {
86d11cf2 539 my ($mode) = @_;
a57a9493
MU
540 my $m = 0;
541 my $mm = 0;
542 my $um = 0;
543 for my $x(split(//,$mode)) {
86d11cf2 544 if ($x eq ",") {
a57a9493
MU
545 $m |= $mm&$um;
546 $mm = 0;
547 $um = 0;
86d11cf2
JH
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
a57a9493
MU
555 } else { die "Unknown mode: $mode\n";
556 }
557 }
558 $m |= $mm&$um;
559 return $m;
560}
d4f8b390 561
a57a9493
MU
562sub getwd() {
563 my $pwd = `pwd`;
564 chomp $pwd;
565 return $pwd;
d4f8b390
LT
566}
567
e73aefe4
JK
568sub is_sha1 {
569 my $s = shift;
570 return $s =~ /^[a-f0-9]{40}$/;
571}
db4b6582 572
9da0dabc
JK
573sub 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;
db4b6582
ML
579}
580
a57a9493
MU
581-d $git_tree
582 or mkdir($git_tree,0777)
583 or die "Could not create $git_tree: $!";
584chdir($git_tree);
d4f8b390 585
a57a9493 586my $last_branch = "";
46541669 587my $orig_branch = "";
a57a9493 588my %branch_date;
8a5f2eac 589my $tip_at_start = undef;
a57a9493
MU
590
591my $git_dir = $ENV{"GIT_DIR"} || ".git";
592$git_dir = getwd()."/".$git_dir unless $git_dir =~ m#^/#;
593$ENV{"GIT_DIR"} = $git_dir;
79ee456c
SV
594my $orig_git_index;
595$orig_git_index = $ENV{GIT_INDEX_FILE} if exists $ENV{GIT_INDEX_FILE};
8f732649
ML
596
597my %index; # holds filenames of one index per branch
061303f0 598
86d11cf2 599unless (-d $git_dir) {
5c94f87e 600 system("git-init");
a57a9493
MU
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 $?;
604
605 $last_branch = $opt_o;
46541669 606 $orig_branch = "";
a57a9493 607} else {
8366a10a
PR
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);
86d11cf2 613 unless ($last_branch) {
46541669
MU
614 warn "Cannot read the last branch name: $! -- assuming 'master'\n";
615 $last_branch = "master";
616 }
617 $orig_branch = $last_branch;
8a5f2eac 618 $tip_at_start = `git-rev-parse --verify HEAD`;
a57a9493
MU
619
620 # Get the last import timestamps
1f24c587 621 my $fmt = '($ref, $author) = (%(refname), %(author));';
8b7f5fc1 622 open(H, "git-for-each-ref --perl --format='$fmt' $remote |") or
1f24c587 623 die "Cannot run git-for-each-ref: $!\n";
86d11cf2 624 while (defined(my $entry = <H>)) {
1f24c587
AW
625 my ($ref, $author);
626 eval($entry) || die "cannot eval refs list: $@";
8b7f5fc1 627 my ($head) = ($ref =~ m|^$remote/(.*)|);
1f24c587
AW
628 $author =~ /^.*\s(\d+)\s[-+]\d{4}$/;
629 $branch_date{$head} = $1;
a57a9493 630 }
1f24c587 631 close(H);
7ca055f7
SS
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";
636 }
a57a9493
MU
637}
638
639-d $git_dir
640 or die "Could not create git subdir ($git_dir).\n";
641
ffd97f3a
AE
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");
645if ($opt_A) {
646 read_author_info($opt_A);
647 write_author_info("$git_dir/cvs-authors");
648}
649
2f57c697
ML
650
651#
652# run cvsps into a file unless we are getting
653# it passed as a file via $opt_P
654#
4083c2fc 655my $cvspsfile;
2f57c697
ML
656unless ($opt_P) {
657 print "Running cvsps...\n" if $opt_v;
658 my $pid = open(CVSPS,"-|");
4083c2fc 659 my $cvspsfh;
2f57c697 660 die "Cannot fork: $!\n" unless defined $pid;
86d11cf2 661 unless ($pid) {
2f57c697
ML
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';
668 }
669 exec("cvsps","--norc",@opt,"-u","-A",'--root',$opt_d,$cvs_tree);
670 die "Could not start cvsps: $!\n";
df73e9c6 671 }
4083c2fc
ML
672 ($cvspsfh, $cvspsfile) = tempfile('gitXXXXXX', SUFFIX => '.cvsps',
673 DIR => File::Spec->tmpdir());
2f57c697
ML
674 while (<CVSPS>) {
675 print $cvspsfh $_;
211dcac6 676 }
2f57c697 677 close CVSPS;
3a969ef1 678 $? == 0 or die "git-cvsimport: fatal: cvsps reported error\n";
2f57c697 679 close $cvspsfh;
4083c2fc
ML
680} else {
681 $cvspsfile = $opt_P;
a57a9493
MU
682}
683
4083c2fc 684open(CVS, "<$cvspsfile") or die $!;
2f57c697 685
a57a9493
MU
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
699#
700#---------------------
701
702my $state = 0;
703
e73aefe4
JK
704sub update_index (\@\@) {
705 my $old = shift;
706 my $new = shift;
6a1871e1
JK
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" }
e73aefe4 711 @$old),
6a1871e1 712 (map { '100' . sprintf('%o', $_->[0]) . " $_->[1]\t$_->[2]\0" }
e73aefe4 713 @$new)
6a1871e1
JK
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: $?";
e73aefe4 718}
a57a9493 719
e73aefe4
JK
720sub 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)
a57a9493
MU
727 or die "Error running git-write-tree: $?\n";
728 print "Tree ID $tree\n" if $opt_v;
e73aefe4
JK
729 return $tree;
730}
a57a9493 731
86d11cf2
JH
732my ($patchset,$date,$author_name,$author_email,$branch,$ancestor,$tag,$logmsg);
733my (@old,@new,@skipped,%ignorebranch);
71b08148
ML
734
735# commits that cvsps cannot place anywhere...
736$ignorebranch{'#CVSPS_NO_BRANCH'} = 1;
737
e73aefe4 738sub commit {
9da0dabc
JK
739 if ($branch eq $opt_o && !$index{branch} &&
740 !get_headref("$remote/$branch")) {
c5f448b0 741 # looks like an initial commit
5c94f87e 742 # use the index primed by git-init
23fcdc79
MM
743 $ENV{GIT_INDEX_FILE} = "$git_dir/index";
744 $index{$branch} = "$git_dir/index";
c5f448b0
ML
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) {
8b7f5fc1 752 system("git-read-tree", "$remote/$ancestor");
c5f448b0 753 } else {
8b7f5fc1 754 system("git-read-tree", "$remote/$branch");
c5f448b0
ML
755 }
756 die "read-tree failed: $?\n" if $?;
757 }
758 }
759 $ENV{GIT_INDEX_FILE} = $index{$branch};
760
e73aefe4
JK
761 update_index(@old, @new);
762 @old = @new = ();
763 my $tree = write_tree();
9da0dabc 764 my $parent = get_headref("$remote/$last_branch");
e73aefe4
JK
765 print "Parent ID " . ($parent ? $parent : "(empty)") . "\n" if $opt_v;
766
767 my @commit_args;
768 push @commit_args, ("-p", $parent) if $parent;
769
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;
9da0dabc 775 if (my $sha1 = get_headref("$remote/$mparent")) {
c36c5b84 776 push @commit_args, '-p', "$remote/$mparent";
e73aefe4 777 print "Merge parent branch: $mparent\n" if $opt_v;
db4b6582 778 }
a57a9493 779 }
e73aefe4
JK
780
781 my $commit_date = strftime("+0000 %Y-%m-%d %H:%M:%S",gmtime($date));
62bf0d96
JK
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;
e73aefe4 788 my $pid = open2(my $commit_read, my $commit_write,
e73aefe4 789 'git-commit-tree', $tree, @commit_args);
e371046b
MU
790
791 # compatibility with git2cvs
792 substr($logmsg,32767) = "" if length($logmsg) > 32767;
793 $logmsg =~ s/[\s\n]+\z//;
794
5179c8a5
ML
795 if (@skipped) {
796 $logmsg .= "\n\n\nSKIPPED:\n\t";
797 $logmsg .= join("\n\t", @skipped) . "\n";
f396f01f 798 @skipped = ();
5179c8a5
ML
799 }
800
e73aefe4 801 print($commit_write "$logmsg\n") && close($commit_write)
a57a9493 802 or die "Error writing to git-commit-tree: $!\n";
2a3e1a85 803
e73aefe4
JK
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";
a57a9493 807 print "Commit ID $cid\n" if $opt_v;
e73aefe4 808 close($commit_read);
2a3e1a85
MU
809
810 waitpid($pid,0);
811 die "Error running git-commit-tree: $?\n" if $?;
a57a9493 812
b3bb5f76 813 system('git-update-ref', "$remote/$branch", $cid) == 0
a57a9493
MU
814 or die "Cannot write branch $branch for update: $!\n";
815
86d11cf2 816 if ($tag) {
86d11cf2 817 my ($xtag) = $tag;
0d821d4d
PA
818 $xtag =~ s/\s+\*\*.*$//; # Remove stuff like ** INVALID ** and ** FUNKY **
819 $xtag =~ tr/_/\./ if ( $opt_u );
34c99da2 820 $xtag =~ s/[\/]/$opt_s/g;
509792b9 821 $xtag =~ s/\[//g;
a6080a0a 822
ee834cf0 823 system('git-tag', '-f', $xtag, $cid) == 0
0d821d4d 824 or die "Cannot create tag $xtag: $!\n";
0d821d4d
PA
825
826 print "Created tag '$xtag' on '$branch'\n" if $opt_v;
a57a9493 827 }
a57a9493
MU
828};
829
06918348 830my $commitcount = 1;
86d11cf2 831while (<CVS>) {
a57a9493 832 chomp;
86d11cf2 833 if ($state == 0 and /^-+$/) {
a57a9493 834 $state = 1;
86d11cf2 835 } elsif ($state == 0) {
a57a9493
MU
836 $state = 1;
837 redo;
86d11cf2 838 } elsif (($state==0 or $state==1) and s/^PatchSet\s+//) {
a57a9493
MU
839 $patchset = 0+$_;
840 $state=2;
86d11cf2 841 } elsif ($state == 2 and s/^Date:\s+//) {
a57a9493 842 $date = pdate($_);
86d11cf2 843 unless ($date) {
a57a9493
MU
844 print STDERR "Could not parse date: $_\n";
845 $state=0;
846 next;
847 }
848 $state=3;
86d11cf2 849 } elsif ($state == 3 and s/^Author:\s+//) {
a57a9493 850 s/\s+$//;
94c23343
JH
851 if (/^(.*?)\s+<(.*)>/) {
852 ($author_name, $author_email) = ($1, $2);
ffd97f3a
AE
853 } elsif ($conv_author_name{$_}) {
854 $author_name = $conv_author_name{$_};
855 $author_email = $conv_author_email{$_};
94c23343
JH
856 } else {
857 $author_name = $author_email = $_;
858 }
a57a9493 859 $state = 4;
86d11cf2 860 } elsif ($state == 4 and s/^Branch:\s+//) {
a57a9493 861 s/\s+$//;
a0554224 862 tr/_/\./ if ( $opt_u );
fbfd60d6 863 s/[\/]/$opt_s/g;
a57a9493
MU
864 $branch = $_;
865 $state = 5;
86d11cf2 866 } elsif ($state == 5 and s/^Ancestor branch:\s+//) {
a57a9493
MU
867 s/\s+$//;
868 $ancestor = $_;
0fa2824f 869 $ancestor = $opt_o if $ancestor eq "HEAD";
a57a9493 870 $state = 6;
86d11cf2 871 } elsif ($state == 5) {
a57a9493
MU
872 $ancestor = undef;
873 $state = 6;
874 redo;
86d11cf2 875 } elsif ($state == 6 and s/^Tag:\s+//) {
a57a9493 876 s/\s+$//;
86d11cf2 877 if ($_ eq "(none)") {
a57a9493
MU
878 $tag = undef;
879 } else {
880 $tag = $_;
881 }
882 $state = 7;
86d11cf2 883 } elsif ($state == 7 and /^Log:/) {
a57a9493
MU
884 $logmsg = "";
885 $state = 8;
86d11cf2 886 } elsif ($state == 8 and /^Members:/) {
a57a9493 887 $branch = $opt_o if $branch eq "HEAD";
86d11cf2 888 if (defined $branch_date{$branch} and $branch_date{$branch} >= $date) {
a57a9493 889 # skip
9da07f34 890 print "skip patchset $patchset: $date before $branch_date{$branch}\n" if $opt_v;
a57a9493
MU
891 $state = 11;
892 next;
893 }
ded9f400 894 if (!$opt_a && $starttime - 300 - (defined $opt_z ? $opt_z : 300) <= $date) {
6211988f 895 # skip if the commit is too recent
77190eb9 896 # given that the cvsps default fuzz is 300s, we give ourselves another
6211988f
ML
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;
902 }
71b08148
ML
903 if (exists $ignorebranch{$branch}) {
904 print STDERR "Skipping $branch\n";
905 $state = 11;
906 next;
907 }
86d11cf2
JH
908 if ($ancestor) {
909 if ($ancestor eq $branch) {
71b08148
ML
910 print STDERR "Branch $branch erroneously stems from itself -- changed ancestor to $opt_o\n";
911 $ancestor = $opt_o;
912 }
0750d751 913 if (defined get_headref("$remote/$branch")) {
a57a9493
MU
914 print STDERR "Branch $branch already exists!\n";
915 $state=11;
916 next;
917 }
0750d751
JK
918 my $id = get_headref("$remote/$ancestor");
919 if (!$id) {
a57a9493 920 print STDERR "Branch $ancestor does not exist!\n";
71b08148 921 $ignorebranch{$branch} = 1;
a57a9493
MU
922 $state=11;
923 next;
924 }
0750d751
JK
925
926 system(qw(git update-ref -m cvsimport),
927 "$remote/$branch", $id);
928 if($? != 0) {
929 print STDERR "Could not create branch $branch\n";
71b08148 930 $ignorebranch{$branch} = 1;
a57a9493
MU
931 $state=11;
932 next;
933 }
a57a9493 934 }
46e63efc 935 $last_branch = $branch if $branch ne $last_branch;
a57a9493 936 $state = 9;
86d11cf2 937 } elsif ($state == 8) {
a57a9493 938 $logmsg .= "$_\n";
86d11cf2 939 } elsif ($state == 9 and /^\s+(.+?):(INITIAL|\d+(?:\.\d+)+)->(\d+(?:\.\d+)+)\s*$/) {
a57a9493 940# VERSION:1.96->1.96.2.1
2a3e1a85 941 my $init = ($2 eq "INITIAL");
a57a9493 942 my $fn = $1;
f65ae603
MU
943 my $rev = $3;
944 $fn =~ s#^/+##;
5179c8a5
ML
945 if ($opt_S && $fn =~ m/$opt_S/) {
946 print "SKIPPING $fn v $rev\n";
947 push(@skipped, $fn);
948 next;
949 }
950 print "Fetching $fn v $rev\n" if $opt_v;
2eb6d82e 951 my ($tmpname, $size) = $cvs->file($fn,$rev);
86d11cf2 952 if ($size == -1) {
8b8840e0
MU
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;
dd27478f
JH
957 my $pid = open(my $F, '-|');
958 die $! unless defined $pid;
959 if (!$pid) {
960 exec("git-hash-object", "-w", $tmpname)
8b8840e0 961 or die "Cannot create object: $!\n";
dd27478f 962 }
8b8840e0
MU
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!
968 }
2eb6d82e 969 unlink($tmpname);
86d11cf2 970 } elsif ($state == 9 and /^\s+(.+?):\d+(?:\.\d+)+->(\d+(?:\.\d+)+)\(DEAD\)\s*$/) {
f65ae603
MU
971 my $fn = $1;
972 $fn =~ s#^/+##;
973 push(@old,$fn);
8b8840e0 974 print "Delete $fn\n" if $opt_v;
86d11cf2 975 } elsif ($state == 9 and /^\s*$/) {
a57a9493 976 $state = 10;
86d11cf2 977 } elsif (($state == 9 or $state == 10) and /^-+$/) {
4adcea99
LT
978 $commitcount++;
979 if ($opt_L && $commitcount > $opt_L) {
06918348
ML
980 last;
981 }
c4b16f8d 982 commit();
4adcea99
LT
983 if (($commitcount & 1023) == 0) {
984 system("git repack -a -d");
985 }
a57a9493 986 $state = 1;
86d11cf2 987 } elsif ($state == 11 and /^-+$/) {
a57a9493 988 $state = 1;
86d11cf2 989 } elsif (/^-+$/) { # end of unknown-line processing
a57a9493 990 $state = 1;
86d11cf2 991 } elsif ($state != 11) { # ignore stuff when skipping
3be39998 992 print STDERR "* UNKNOWN LINE * $_\n";
a57a9493
MU
993 }
994}
c4b16f8d 995commit() if $branch and $state != 11;
d4f8b390 996
4083c2fc
ML
997unless ($opt_P) {
998 unlink($cvspsfile);
999}
1000
efe4abd1
JM
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.
1004my $line = `git-count-objects`;
1005if ($line =~ /^(\d+) objects, (\d+) kilobytes$/) {
1006 my ($n_objects, $kb) = ($1, $2);
1007 1024 < $kb
1008 and system("git repack -a -d");
1009}
1010
8f732649 1011foreach my $git_index (values %index) {
23fcdc79 1012 if ($git_index ne "$git_dir/index") {
c5f448b0
ML
1013 unlink($git_index);
1014 }
8f732649 1015}
79ee456c 1016
210569f9
SV
1017if (defined $orig_git_index) {
1018 $ENV{GIT_INDEX_FILE} = $orig_git_index;
1019} else {
1020 delete $ENV{GIT_INDEX_FILE};
1021}
1022
46541669 1023# Now switch back to the branch we were in before all of this happened
86d11cf2 1024if ($orig_branch) {
8a5f2eac
JH
1025 print "DONE.\n" if $opt_v;
1026 if ($opt_i) {
1027 exit 0;
1028 }
1029 my $tip_at_end = `git-rev-parse --verify HEAD`;
1030 if ($tip_at_start ne $tip_at_end) {
cb9594e2 1031 for ($tip_at_start, $tip_at_end) { chomp; }
8a5f2eac
JH
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 $?;
1036 }
1037 else {
8b7f5fc1 1038 system(qw(git-merge cvsimport HEAD), "$remote/$opt_o");
8a5f2eac
JH
1039 die "Could not merge $opt_o into the current branch.\n" if $?;
1040 }
46541669
MU
1041} else {
1042 $orig_branch = "master";
1043 print "DONE; creating $orig_branch branch\n" if $opt_v;
8b7f5fc1 1044 system("git-update-ref", "refs/heads/master", "$remote/$opt_o")
0750d751 1045 unless defined get_headref('refs/heads/master');
06baffd3
AW
1046 system("git-symbolic-ref", "$remote/HEAD", "$remote/$opt_o")
1047 if ($opt_r && $opt_o ne 'HEAD');
8366a10a 1048 system('git-update-ref', 'HEAD', "$orig_branch");
c1c774e7 1049 unless ($opt_i) {
7051c3b1 1050 system('git checkout -f');
c1c774e7
SV
1051 die "checkout failed: $?\n" if $?;
1052 }
46541669 1053}