git.oblomov.eu Git - git/blob - git-cvsimport.perl

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