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                 $xtag =~ s/\[//g;
 893
 894                 system('git' , 'tag', '-f', $xtag, $cid) == 0
 895                         or die "Cannot create tag $xtag: $!\n";
 896
 897                 print "Created tag '$xtag' on '$branch'\n" if $opt_v;
 898         }
 899 };
 900
 901 my $commitcount = 1;
 902 while (<CVS>) {
 903         chomp;
 904         if ($state == 0 and /^-+$/) {
 905                 $state = 1;
 906         } elsif ($state == 0) {
 907                 $state = 1;
 908                 redo;
 909         } elsif (($state==0 or $state==1) and s/^PatchSet\s+//) {
 910                 $patchset = 0+$_;
 911                 $state=2;
 912         } elsif ($state == 2 and s/^Date:\s+//) {
 913                 $date = pdate($_);
 914                 unless ($date) {
 915                         print STDERR "Could not parse date: $_\n";
 916                         $state=0;
 917                         next;
 918                 }
 919                 $state=3;
 920         } elsif ($state == 3 and s/^Author:\s+//) {
 921                 s/\s+$//;
 922                 if (/^(.*?)\s+<(.*)>/) {
 923                     ($author_name, $author_email) = ($1, $2);
 924                 } elsif ($conv_author_name{$_}) {
 925                         $author_name = $conv_author_name{$_};
 926                         $author_email = $conv_author_email{$_};
 927                 } else {
 928                     $author_name = $author_email = $_;
 929                 }
 930                 $state = 4;
 931         } elsif ($state == 4 and s/^Branch:\s+//) {
 932                 s/\s+$//;
 933                 tr/_/\./ if ( $opt_u );
 934                 s/[\/]/$opt_s/g;
 935                 $branch = $_;
 936                 $state = 5;
 937         } elsif ($state == 5 and s/^Ancestor branch:\s+//) {
 938                 s/\s+$//;
 939                 $ancestor = $_;
 940                 $ancestor = $opt_o if $ancestor eq "HEAD";
 941                 $state = 6;
 942         } elsif ($state == 5) {
 943                 $ancestor = undef;
 944                 $state = 6;
 945                 redo;
 946         } elsif ($state == 6 and s/^Tag:\s+//) {
 947                 s/\s+$//;
 948                 if ($_ eq "(none)") {
 949                         $tag = undef;
 950                 } else {
 951                         $tag = $_;
 952                 }
 953                 $state = 7;
 954         } elsif ($state == 7 and /^Log:/) {
 955                 $logmsg = "";
 956                 $state = 8;
 957         } elsif ($state == 8 and /^Members:/) {
 958                 $branch = $opt_o if $branch eq "HEAD";
 959                 if (defined $branch_date{$branch} and $branch_date{$branch} >= $date) {
 960                         # skip
 961                         print "skip patchset $patchset: $date before $branch_date{$branch}\n" if $opt_v;
 962                         $state = 11;
 963                         next;
 964                 }
 965                 if (!$opt_a && $starttime - 300 - (defined $opt_z ? $opt_z : 300) <= $date) {
 966                         # skip if the commit is too recent
 967                         # given that the cvsps default fuzz is 300s, we give ourselves another
 968                         # 300s just in case -- this also prevents skipping commits
 969                         # due to server clock drift
 970                         print "skip patchset $patchset: $date too recent\n" if $opt_v;
 971                         $state = 11;
 972                         next;
 973                 }
 974                 if (exists $ignorebranch{$branch}) {
 975                         print STDERR "Skipping $branch\n";
 976                         $state = 11;
 977                         next;
 978                 }
 979                 if ($ancestor) {
 980                         if ($ancestor eq $branch) {
 981                                 print STDERR "Branch $branch erroneously stems from itself -- changed ancestor to $opt_o\n";
 982                                 $ancestor = $opt_o;
 983                         }
 984                         if (defined get_headref("$remote/$branch")) {
 985                                 print STDERR "Branch $branch already exists!\n";
 986                                 $state=11;
 987                                 next;
 988                         }
 989                         my $id = get_headref("$remote/$ancestor");
 990                         if (!$id) {
 991                                 print STDERR "Branch $ancestor does not exist!\n";
 992                                 $ignorebranch{$branch} = 1;
 993                                 $state=11;
 994                                 next;
 995                         }
 996
 997                         system(qw(git update-ref -m cvsimport),
 998                                 "$remote/$branch", $id);
 999                         if($? != 0) {
1000                                 print STDERR "Could not create branch $branch\n";
1001                                 $ignorebranch{$branch} = 1;
1002                                 $state=11;
1003                                 next;
1004                         }
1005                 }
1006                 $last_branch = $branch if $branch ne $last_branch;
1007                 $state = 9;
1008         } elsif ($state == 8) {
1009                 $logmsg .= "$_\n";
1010         } elsif ($state == 9 and /^\s+(.+?):(INITIAL|\d+(?:\.\d+)+)->(\d+(?:\.\d+)+)\s*$/) {
1011 #       VERSION:1.96->1.96.2.1
1012                 my $init = ($2 eq "INITIAL");
1013                 my $fn = $1;
1014                 my $rev = $3;
1015                 $fn =~ s#^/+##;
1016                 if ($opt_S && $fn =~ m/$opt_S/) {
1017                     print "SKIPPING $fn v $rev\n";
1018                     push(@skipped, $fn);
1019                     next;
1020                 }
1021                 push @commit_revisions, [$fn, $rev];
1022                 print "Fetching $fn   v $rev\n" if $opt_v;
1023                 my ($tmpname, $size) = $cvs->file($fn,$rev);
1024                 if ($size == -1) {
1025                         push(@old,$fn);
1026                         print "Drop $fn\n" if $opt_v;
1027                 } else {
1028                         print "".($init ? "New" : "Update")." $fn: $size bytes\n" if $opt_v;
1029                         my $pid = open(my $F, '-|');
1030                         die $! unless defined $pid;
1031                         if (!$pid) {
1032                             exec("git", "hash-object", "-w", $tmpname)
1033                                 or die "Cannot create object: $!\n";
1034                         }
1035                         my $sha = <$F>;
1036                         chomp $sha;
1037                         close $F;
1038                         my $mode = pmode($cvs->{'mode'});
1039                         push(@new,[$mode, $sha, $fn]); # may be resurrected!
1040                 }
1041                 unlink($tmpname);
1042         } elsif ($state == 9 and /^\s+(.+?):\d+(?:\.\d+)+->(\d+(?:\.\d+)+)\(DEAD\)\s*$/) {
1043                 my $fn = $1;
1044                 my $rev = $2;
1045                 $fn =~ s#^/+##;
1046                 push @commit_revisions, [$fn, $rev];
1047                 push(@old,$fn);
1048                 print "Delete $fn\n" if $opt_v;
1049         } elsif ($state == 9 and /^\s*$/) {
1050                 $state = 10;
1051         } elsif (($state == 9 or $state == 10) and /^-+$/) {
1052                 $commitcount++;
1053                 if ($opt_L && $commitcount > $opt_L) {
1054                         last;
1055                 }
1056                 commit();
1057                 if (($commitcount & 1023) == 0) {
1058                         system(qw(git repack -a -d));
1059                 }
1060                 $state = 1;
1061         } elsif ($state == 11 and /^-+$/) {
1062                 $state = 1;
1063         } elsif (/^-+$/) { # end of unknown-line processing
1064                 $state = 1;
1065         } elsif ($state != 11) { # ignore stuff when skipping
1066                 print STDERR "* UNKNOWN LINE * $_\n";
1067         }
1068 }
1069 commit() if $branch and $state != 11;
1070
1071 unless ($opt_P) {
1072         unlink($cvspsfile);
1073 }
1074
1075 # The heuristic of repacking every 1024 commits can leave a
1076 # lot of unpacked data.  If there is more than 1MB worth of
1077 # not-packed objects, repack once more.
1078 my $line = `git count-objects`;
1079 if ($line =~ /^(\d+) objects, (\d+) kilobytes$/) {
1080   my ($n_objects, $kb) = ($1, $2);
1081   1024 < $kb
1082     and system(qw(git repack -a -d));
1083 }
1084
1085 foreach my $git_index (values %index) {
1086     if ($git_index ne "$git_dir/index") {
1087         unlink($git_index);
1088     }
1089 }
1090
1091 if (defined $orig_git_index) {
1092         $ENV{GIT_INDEX_FILE} = $orig_git_index;
1093 } else {
1094         delete $ENV{GIT_INDEX_FILE};
1095 }
1096
1097 # Now switch back to the branch we were in before all of this happened
1098 if ($orig_branch) {
1099         print "DONE.\n" if $opt_v;
1100         if ($opt_i) {
1101                 exit 0;
1102         }
1103         my $tip_at_end = `git rev-parse --verify HEAD`;
1104         if ($tip_at_start ne $tip_at_end) {
1105                 for ($tip_at_start, $tip_at_end) { chomp; }
1106                 print "Fetched into the current branch.\n" if $opt_v;
1107                 system(qw(git read-tree -u -m),
1108                        $tip_at_start, $tip_at_end);
1109                 die "Fast-forward update failed: $?\n" if $?;
1110         }
1111         else {
1112                 system(qw(git merge cvsimport HEAD), "$remote/$opt_o");
1113                 die "Could not merge $opt_o into the current branch.\n" if $?;
1114         }
1115 } else {
1116         $orig_branch = "master";
1117         print "DONE; creating $orig_branch branch\n" if $opt_v;
1118         system("git", "update-ref", "refs/heads/master", "$remote/$opt_o")
1119                 unless defined get_headref('refs/heads/master');
1120         system("git", "symbolic-ref", "$remote/HEAD", "$remote/$opt_o")
1121                 if ($opt_r && $opt_o ne 'HEAD');
1122         system('git', 'update-ref', 'HEAD', "$orig_branch");
1123         unless ($opt_i) {
1124                 system(qw(git checkout -f));
1125                 die "checkout failed: $?\n" if $?;
1126         }
1127 }