util/X86LINUX64/libexec/git-core/git-cvsimport

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