git-cvsserver.perl

   1 #!/usr/bin/perl
   2
   3 ####
   4 #### This application is a CVS emulation layer for git.
   5 #### It is intended for clients to connect over SSH.
   6 #### See the documentation for more details.
   7 ####
   8 #### Copyright The Open University UK - 2006.
   9 ####
  10 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
  11 ####          Martin Langhoff <martin@laptop.org>
  12 ####
  13 ####
  14 #### Released under the GNU Public License, version 2.
  15 ####
  16 ####
  17
  18 use 5.008;
  19 use strict;
  20 use warnings;
  21 use bytes;
  22
  23 use Fcntl;
  24 use File::Temp qw/tempdir tempfile/;
  25 use File::Path qw/rmtree/;
  26 use File::Basename;
  27 use Getopt::Long qw(:config require_order no_ignore_case);
  28
  29 my $VERSION = '@@GIT_VERSION@@';
  30
  31 my $log = GITCVS::log->new();
  32 my $cfg;
  33
  34 my $DATE_LIST = {
  35     Jan => "01",
  36     Feb => "02",
  37     Mar => "03",
  38     Apr => "04",
  39     May => "05",
  40     Jun => "06",
  41     Jul => "07",
  42     Aug => "08",
  43     Sep => "09",
  44     Oct => "10",
  45     Nov => "11",
  46     Dec => "12",
  47 };
  48
  49 # Enable autoflush for STDOUT (otherwise the whole thing falls apart)
  50 $| = 1;
  51
  52 #### Definition and mappings of functions ####
  53
  54 # NOTE: Despite the existence of req_CATCHALL and req_EMPTY unimplemented
  55 #  requests, this list is incomplete.  It is missing many rarer/optional
  56 #  requests.  Perhaps some clients require a claim of support for
  57 #  these specific requests for main functionality to work?
  58 my $methods = {
  59     'Root'            => \&req_Root,
  60     'Valid-responses' => \&req_Validresponses,
  61     'valid-requests'  => \&req_validrequests,
  62     'Directory'       => \&req_Directory,
  63     'Sticky'          => \&req_Sticky,
  64     'Entry'           => \&req_Entry,
  65     'Modified'        => \&req_Modified,
  66     'Unchanged'       => \&req_Unchanged,
  67     'Questionable'    => \&req_Questionable,
  68     'Argument'        => \&req_Argument,
  69     'Argumentx'       => \&req_Argument,
  70     'expand-modules'  => \&req_expandmodules,
  71     'add'             => \&req_add,
  72     'remove'          => \&req_remove,
  73     'co'              => \&req_co,
  74     'update'          => \&req_update,
  75     'ci'              => \&req_ci,
  76     'diff'            => \&req_diff,
  77     'log'             => \&req_log,
  78     'rlog'            => \&req_log,
  79     'tag'             => \&req_CATCHALL,
  80     'status'          => \&req_status,
  81     'admin'           => \&req_CATCHALL,
  82     'history'         => \&req_CATCHALL,
  83     'watchers'        => \&req_EMPTY,
  84     'editors'         => \&req_EMPTY,
  85     'noop'            => \&req_EMPTY,
  86     'annotate'        => \&req_annotate,
  87     'Global_option'   => \&req_Globaloption,
  88 };
  89
  90 ##############################################
  91
  92
  93 # $state holds all the bits of information the clients sends us that could
  94 # potentially be useful when it comes to actually _doing_ something.
  95 my $state = { prependdir => '' };
  96
  97 # Work is for managing temporary working directory
  98 my $work =
  99     {
 100         state => undef,  # undef, 1 (empty), 2 (with stuff)
 101         workDir => undef,
 102         index => undef,
 103         emptyDir => undef,
 104         tmpDir => undef
 105     };
 106
 107 $log->info("--------------- STARTING -----------------");
 108
 109 my $usage =
 110     "Usage: git cvsserver [options] [pserver|server] [<directory> ...]\n".
 111     "    --base-path <path>  : Prepend to requested CVSROOT\n".
 112     "                          Can be read from GIT_CVSSERVER_BASE_PATH\n".
 113     "    --strict-paths      : Don't allow recursing into subdirectories\n".
 114     "    --export-all        : Don't check for gitcvs.enabled in config\n".
 115     "    --version, -V       : Print version information and exit\n".
 116     "    -h, -H              : Print usage information and exit\n".
 117     "\n".
 118     "<directory> ... is a list of allowed directories. If no directories\n".
 119     "are given, all are allowed. This is an additional restriction, gitcvs\n".
 120     "access still needs to be enabled by the gitcvs.enabled config option.\n".
 121     "Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n";
 122
 123 my @opts = ( 'h|H', 'version|V',
 124              'base-path=s', 'strict-paths', 'export-all' );
 125 GetOptions( $state, @opts )
 126     or die $usage;
 127
 128 if ($state->{version}) {
 129     print "git-cvsserver version $VERSION\n";
 130     exit;
 131 }
 132 if ($state->{help}) {
 133     print $usage;
 134     exit;
 135 }
 136
 137 my $TEMP_DIR = tempdir( CLEANUP => 1 );
 138 $log->debug("Temporary directory is '$TEMP_DIR'");
 139
 140 $state->{method} = 'ext';
 141 if (@ARGV) {
 142     if ($ARGV[0] eq 'pserver') {
 143         $state->{method} = 'pserver';
 144         shift @ARGV;
 145     } elsif ($ARGV[0] eq 'server') {
 146         shift @ARGV;
 147     }
 148 }
 149
 150 # everything else is a directory
 151 $state->{allowed_roots} = [ @ARGV ];
 152
 153 # don't export the whole system unless the users requests it
 154 if ($state->{'export-all'} && !@{$state->{allowed_roots}}) {
 155     die "--export-all can only be used together with an explicit whitelist\n";
 156 }
 157
 158 # Environment handling for running under git-shell
 159 if (exists $ENV{GIT_CVSSERVER_BASE_PATH}) {
 160     if ($state->{'base-path'}) {
 161         die "Cannot specify base path both ways.\n";
 162     }
 163     my $base_path = $ENV{GIT_CVSSERVER_BASE_PATH};
 164     $state->{'base-path'} = $base_path;
 165     $log->debug("Picked up base path '$base_path' from environment.\n");
 166 }
 167 if (exists $ENV{GIT_CVSSERVER_ROOT}) {
 168     if (@{$state->{allowed_roots}}) {
 169         die "Cannot specify roots both ways: @ARGV\n";
 170     }
 171     my $allowed_root = $ENV{GIT_CVSSERVER_ROOT};
 172     $state->{allowed_roots} = [ $allowed_root ];
 173     $log->debug("Picked up allowed root '$allowed_root' from environment.\n");
 174 }
 175
 176 # if we are called with a pserver argument,
 177 # deal with the authentication cat before entering the
 178 # main loop
 179 if ($state->{method} eq 'pserver') {
 180     my $line = <STDIN>; chomp $line;
 181     unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
 182        die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
 183     }
 184     my $request = $1;
 185     $line = <STDIN>; chomp $line;
 186     unless (req_Root('root', $line)) { # reuse Root
 187        print "E Invalid root $line \n";
 188        exit 1;
 189     }
 190     $line = <STDIN>; chomp $line;
 191     my $user = $line;
 192     $line = <STDIN>; chomp $line;
 193     my $password = $line;
 194
 195     if ($user eq 'anonymous') {
 196         # "A" will be 1 byte, use length instead in case the
 197         # encryption method ever changes (yeah, right!)
 198         if (length($password) > 1 ) {
 199             print "E Don't supply a password for the `anonymous' user\n";
 200             print "I HATE YOU\n";
 201             exit 1;
 202         }
 203
 204         # Fall through to LOVE
 205     } else {
 206         # Trying to authenticate a user
 207         if (not exists $cfg->{gitcvs}->{authdb}) {
 208             print "E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n";
 209             print "I HATE YOU\n";
 210             exit 1;
 211         }
 212
 213         my $authdb = $cfg->{gitcvs}->{authdb};
 214
 215         unless (-e $authdb) {
 216             print "E The authentication database specified in [gitcvs.authdb] does not exist\n";
 217             print "I HATE YOU\n";
 218             exit 1;
 219         }
 220
 221         my $auth_ok;
 222         open my $passwd, "<", $authdb or die $!;
 223         while (<$passwd>) {
 224             if (m{^\Q$user\E:(.*)}) {
 225                 if (crypt($user, descramble($password)) eq $1) {
 226                     $auth_ok = 1;
 227                 }
 228             };
 229         }
 230         close $passwd;
 231
 232         unless ($auth_ok) {
 233             print "I HATE YOU\n";
 234             exit 1;
 235         }
 236
 237         # Fall through to LOVE
 238     }
 239
 240     # For checking whether the user is anonymous on commit
 241     $state->{user} = $user;
 242
 243     $line = <STDIN>; chomp $line;
 244     unless ($line eq "END $request REQUEST") {
 245        die "E Do not understand $line -- expecting END $request REQUEST\n";
 246     }
 247     print "I LOVE YOU\n";
 248     exit if $request eq 'VERIFICATION'; # cvs login
 249     # and now back to our regular programme...
 250 }
 251
 252 # Keep going until the client closes the connection
 253 while (<STDIN>)
 254 {
 255     chomp;
 256
 257     # Check to see if we've seen this method, and call appropriate function.
 258     if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
 259     {
 260         # use the $methods hash to call the appropriate sub for this command
 261         #$log->info("Method : $1");
 262         &{$methods->{$1}}($1,$2);
 263     } else {
 264         # log fatal because we don't understand this function. If this happens
 265         # we're fairly screwed because we don't know if the client is expecting
 266         # a response. If it is, the client will hang, we'll hang, and the whole
 267         # thing will be custard.
 268         $log->fatal("Don't understand command $_\n");
 269         die("Unknown command $_");
 270     }
 271 }
 272
 273 $log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
 274 $log->info("--------------- FINISH -----------------");
 275
 276 chdir '/';
 277 exit 0;
 278
 279 # Magic catchall method.
 280 #    This is the method that will handle all commands we haven't yet
 281 #    implemented. It simply sends a warning to the log file indicating a
 282 #    command that hasn't been implemented has been invoked.
 283 sub req_CATCHALL
 284 {
 285     my ( $cmd, $data ) = @_;
 286     $log->warn("Unhandled command : req_$cmd : $data");
 287 }
 288
 289 # This method invariably succeeds with an empty response.
 290 sub req_EMPTY
 291 {
 292     print "ok\n";
 293 }
 294
 295 # Root pathname \n
 296 #     Response expected: no. Tell the server which CVSROOT to use. Note that
 297 #     pathname is a local directory and not a fully qualified CVSROOT variable.
 298 #     pathname must already exist; if creating a new root, use the init
 299 #     request, not Root. pathname does not include the hostname of the server,
 300 #     how to access the server, etc.; by the time the CVS protocol is in use,
 301 #     connection, authentication, etc., are already taken care of. The Root
 302 #     request must be sent only once, and it must be sent before any requests
 303 #     other than Valid-responses, valid-requests, UseUnchanged, Set or init.
 304 sub req_Root
 305 {
 306     my ( $cmd, $data ) = @_;
 307     $log->debug("req_Root : $data");
 308
 309     unless ($data =~ m#^/#) {
 310         print "error 1 Root must be an absolute pathname\n";
 311         return 0;
 312     }
 313
 314     my $cvsroot = $state->{'base-path'} || '';
 315     $cvsroot =~ s#/+$##;
 316     $cvsroot .= $data;
 317
 318     if ($state->{CVSROOT}
 319         && ($state->{CVSROOT} ne $cvsroot)) {
 320         print "error 1 Conflicting roots specified\n";
 321         return 0;
 322     }
 323
 324     $state->{CVSROOT} = $cvsroot;
 325
 326     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 327
 328     if (@{$state->{allowed_roots}}) {
 329         my $allowed = 0;
 330         foreach my $dir (@{$state->{allowed_roots}}) {
 331             next unless $dir =~ m#^/#;
 332             $dir =~ s#/+$##;
 333             if ($state->{'strict-paths'}) {
 334                 if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
 335                     $allowed = 1;
 336                     last;
 337                 }
 338             } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
 339                 $allowed = 1;
 340                 last;
 341             }
 342         }
 343
 344         unless ($allowed) {
 345             print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
 346             print "E \n";
 347             print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
 348             return 0;
 349         }
 350     }
 351
 352     unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
 353        print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
 354        print "E \n";
 355        print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
 356        return 0;
 357     }
 358
 359     my @gitvars = `git config -l`;
 360     if ($?) {
 361        print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
 362         print "E \n";
 363         print "error 1 - problem executing git-config\n";
 364        return 0;
 365     }
 366     foreach my $line ( @gitvars )
 367     {
 368         next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
 369         unless ($2) {
 370             $cfg->{$1}{$3} = $4;
 371         } else {
 372             $cfg->{$1}{$2}{$3} = $4;
 373         }
 374     }
 375
 376     my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
 377                    || $cfg->{gitcvs}{enabled});
 378     unless ($state->{'export-all'} ||
 379             ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
 380         print "E GITCVS emulation needs to be enabled on this repo\n";
 381         print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
 382         print "E \n";
 383         print "error 1 GITCVS emulation disabled\n";
 384         return 0;
 385     }
 386
 387     my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
 388     if ( $logfile )
 389     {
 390         $log->setfile($logfile);
 391     } else {
 392         $log->nofile();
 393     }
 394
 395     return 1;
 396 }
 397
 398 # Global_option option \n
 399 #     Response expected: no. Transmit one of the global options `-q', `-Q',
 400 #     `-l', `-t', `-r', or `-n'. option must be one of those strings, no
 401 #     variations (such as combining of options) are allowed. For graceful
 402 #     handling of valid-requests, it is probably better to make new global
 403 #     options separate requests, rather than trying to add them to this
 404 #     request.
 405 sub req_Globaloption
 406 {
 407     my ( $cmd, $data ) = @_;
 408     $log->debug("req_Globaloption : $data");
 409     $state->{globaloptions}{$data} = 1;
 410 }
 411
 412 # Valid-responses request-list \n
 413 #     Response expected: no. Tell the server what responses the client will
 414 #     accept. request-list is a space separated list of tokens.
 415 sub req_Validresponses
 416 {
 417     my ( $cmd, $data ) = @_;
 418     $log->debug("req_Validresponses : $data");
 419
 420     # TODO : re-enable this, currently it's not particularly useful
 421     #$state->{validresponses} = [ split /\s+/, $data ];
 422 }
 423
 424 # valid-requests \n
 425 #     Response expected: yes. Ask the server to send back a Valid-requests
 426 #     response.
 427 sub req_validrequests
 428 {
 429     my ( $cmd, $data ) = @_;
 430
 431     $log->debug("req_validrequests");
 432
 433     $log->debug("SEND : Valid-requests " . join(" ",keys %$methods));
 434     $log->debug("SEND : ok");
 435
 436     print "Valid-requests " . join(" ",keys %$methods) . "\n";
 437     print "ok\n";
 438 }
 439
 440 # Directory local-directory \n
 441 #     Additional data: repository \n. Response expected: no. Tell the server
 442 #     what directory to use. The repository should be a directory name from a
 443 #     previous server response. Note that this both gives a default for Entry
 444 #     and Modified and also for ci and the other commands; normal usage is to
 445 #     send Directory for each directory in which there will be an Entry or
 446 #     Modified, and then a final Directory for the original directory, then the
 447 #     command. The local-directory is relative to the top level at which the
 448 #     command is occurring (i.e. the last Directory which is sent before the
 449 #     command); to indicate that top level, `.' should be sent for
 450 #     local-directory.
 451 sub req_Directory
 452 {
 453     my ( $cmd, $data ) = @_;
 454
 455     my $repository = <STDIN>;
 456     chomp $repository;
 457
 458
 459     $state->{localdir} = $data;
 460     $state->{repository} = $repository;
 461     $state->{path} = $repository;
 462     $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
 463     $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
 464     $state->{path} .= "/" if ( $state->{path} =~ /\S/ );
 465
 466     $state->{directory} = $state->{localdir};
 467     $state->{directory} = "" if ( $state->{directory} eq "." );
 468     $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
 469
 470     if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
 471     {
 472         $log->info("Setting prepend to '$state->{path}'");
 473         $state->{prependdir} = $state->{path};
 474         my %entries;
 475         foreach my $entry ( keys %{$state->{entries}} )
 476         {
 477             $entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
 478         }
 479         $state->{entries}=\%entries;
 480
 481         my %dirMap;
 482         foreach my $dir ( keys %{$state->{dirMap}} )
 483         {
 484             $dirMap{$state->{prependdir} . $dir} = $state->{dirMap}{$dir};
 485         }
 486         $state->{dirMap}=\%dirMap;
 487     }
 488
 489     if ( defined ( $state->{prependdir} ) )
 490     {
 491         $log->debug("Prepending '$state->{prependdir}' to state|directory");
 492         $state->{directory} = $state->{prependdir} . $state->{directory}
 493     }
 494
 495     if ( ! defined($state->{dirMap}{$state->{directory}}) )
 496     {
 497         $state->{dirMap}{$state->{directory}} =
 498             {
 499                 'names' => {}
 500                 #'tagspec' => undef
 501             };
 502     }
 503
 504     $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
 505 }
 506
 507 # Sticky tagspec \n
 508 #     Response expected: no. Tell the server that the directory most
 509 #     recently specified with Directory has a sticky tag or date
 510 #     tagspec. The first character of tagspec is T for a tag, D for
 511 #     a date, or some other character supplied by a Set-sticky
 512 #     response from a previous request to the server. The remainder
 513 #     of tagspec contains the actual tag or date, again as supplied
 514 #     by Set-sticky.
 515 #          The server should remember Static-directory and Sticky requests
 516 #     for a particular directory; the client need not resend them each
 517 #     time it sends a Directory request for a given directory. However,
 518 #     the server is not obliged to remember them beyond the context
 519 #     of a single command.
 520 sub req_Sticky
 521 {
 522     my ( $cmd, $tagspec ) = @_;
 523
 524     my ( $stickyInfo );
 525     if($tagspec eq "")
 526     {
 527         # nothing
 528     }
 529     elsif($tagspec=~/^T([^ ]+)\s*$/)
 530     {
 531         $stickyInfo = { 'tag' => $1 };
 532     }
 533     elsif($tagspec=~/^D([0-9.]+)\s*$/)
 534     {
 535         $stickyInfo= { 'date' => $1 };
 536     }
 537     else
 538     {
 539         die "Unknown tag_or_date format\n";
 540     }
 541     $state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;
 542
 543     $log->debug("req_Sticky : tagspec=$tagspec repository=$state->{repository}"
 544                 . " path=$state->{path} directory=$state->{directory}"
 545                 . " module=$state->{module}");
 546 }
 547
 548 # Entry entry-line \n
 549 #     Response expected: no. Tell the server what version of a file is on the
 550 #     local machine. The name in entry-line is a name relative to the directory
 551 #     most recently specified with Directory. If the user is operating on only
 552 #     some files in a directory, Entry requests for only those files need be
 553 #     included. If an Entry request is sent without Modified, Is-modified, or
 554 #     Unchanged, it means the file is lost (does not exist in the working
 555 #     directory). If both Entry and one of Modified, Is-modified, or Unchanged
 556 #     are sent for the same file, Entry must be sent first. For a given file,
 557 #     one can send Modified, Is-modified, or Unchanged, but not more than one
 558 #     of these three.
 559 sub req_Entry
 560 {
 561     my ( $cmd, $data ) = @_;
 562
 563     #$log->debug("req_Entry : $data");
 564
 565     my @data = split(/\//, $data, -1);
 566
 567     $state->{entries}{$state->{directory}.$data[1]} = {
 568         revision    => $data[2],
 569         conflict    => $data[3],
 570         options     => $data[4],
 571         tag_or_date => $data[5],
 572     };
 573
 574     $state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';
 575
 576     $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
 577 }
 578
 579 # Questionable filename \n
 580 #     Response expected: no. Additional data: no. Tell the server to check
 581 #     whether filename should be ignored, and if not, next time the server
 582 #     sends responses, send (in a M response) `?' followed by the directory and
 583 #     filename. filename must not contain `/'; it needs to be a file in the
 584 #     directory named by the most recent Directory request.
 585 sub req_Questionable
 586 {
 587     my ( $cmd, $data ) = @_;
 588
 589     $log->debug("req_Questionable : $data");
 590     $state->{entries}{$state->{directory}.$data}{questionable} = 1;
 591 }
 592
 593 # add \n
 594 #     Response expected: yes. Add a file or directory. This uses any previous
 595 #     Argument, Directory, Entry, or Modified requests, if they have been sent.
 596 #     The last Directory sent specifies the working directory at the time of
 597 #     the operation. To add a directory, send the directory to be added using
 598 #     Directory and Argument requests.
 599 sub req_add
 600 {
 601     my ( $cmd, $data ) = @_;
 602
 603     argsplit("add");
 604
 605     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 606     $updater->update();
 607
 608     my $addcount = 0;
 609
 610     foreach my $filename ( @{$state->{args}} )
 611     {
 612         $filename = filecleanup($filename);
 613
 614         # no -r, -A, or -D with add
 615         my $stickyInfo = resolveStickyInfo($filename);
 616
 617         my $meta = $updater->getmeta($filename,$stickyInfo);
 618         my $wrev = revparse($filename);
 619
 620         if ($wrev && $meta && ($wrev=~/^-/))
 621         {
 622             # previously removed file, add back
 623             $log->info("added file $filename was previously removed, send $meta->{revision}");
 624
 625             print "MT +updated\n";
 626             print "MT text U \n";
 627             print "MT fname $filename\n";
 628             print "MT newline\n";
 629             print "MT -updated\n";
 630
 631             unless ( $state->{globaloptions}{-n} )
 632             {
 633                 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 634
 635                 print "Created $dirpart\n";
 636                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 637
 638                 # this is an "entries" line
 639                 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
 640                 my $entryLine = "/$filepart/$meta->{revision}//$kopts/";
 641                 $entryLine .= getStickyTagOrDate($stickyInfo);
 642                 $log->debug($entryLine);
 643                 print "$entryLine\n";
 644                 # permissions
 645                 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
 646                 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
 647                 # transmit file
 648                 transmitfile($meta->{filehash});
 649             }
 650
 651             next;
 652         }
 653
 654         unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
 655         {
 656             print "E cvs add: nothing known about `$filename'\n";
 657             next;
 658         }
 659         # TODO : check we're not squashing an already existing file
 660         if ( defined ( $state->{entries}{$filename}{revision} ) )
 661         {
 662             print "E cvs add: `$filename' has already been entered\n";
 663             next;
 664         }
 665
 666         my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
 667
 668         print "E cvs add: scheduling file `$filename' for addition\n";
 669
 670         print "Checked-in $dirpart\n";
 671         print "$filename\n";
 672         my $kopts = kopts_from_path($filename,"file",
 673                         $state->{entries}{$filename}{modified_filename});
 674         print "/$filepart/0//$kopts/" .
 675               getStickyTagOrDate($stickyInfo) . "\n";
 676
 677         my $requestedKopts = $state->{opt}{k};
 678         if(defined($requestedKopts))
 679         {
 680             $requestedKopts = "-k$requestedKopts";
 681         }
 682         else
 683         {
 684             $requestedKopts = "";
 685         }
 686         if( $kopts ne $requestedKopts )
 687         {
 688             $log->warn("Ignoring requested -k='$requestedKopts'"
 689                         . " for '$filename'; detected -k='$kopts' instead");
 690             #TODO: Also have option to send warning to user?
 691         }
 692
 693         $addcount++;
 694     }
 695
 696     if ( $addcount == 1 )
 697     {
 698         print "E cvs add: use `cvs commit' to add this file permanently\n";
 699     }
 700     elsif ( $addcount > 1 )
 701     {
 702         print "E cvs add: use `cvs commit' to add these files permanently\n";
 703     }
 704
 705     print "ok\n";
 706 }
 707
 708 # remove \n
 709 #     Response expected: yes. Remove a file. This uses any previous Argument,
 710 #     Directory, Entry, or Modified requests, if they have been sent. The last
 711 #     Directory sent specifies the working directory at the time of the
 712 #     operation. Note that this request does not actually do anything to the
 713 #     repository; the only effect of a successful remove request is to supply
 714 #     the client with a new entries line containing `-' to indicate a removed
 715 #     file. In fact, the client probably could perform this operation without
 716 #     contacting the server, although using remove may cause the server to
 717 #     perform a few more checks. The client sends a subsequent ci request to
 718 #     actually record the removal in the repository.
 719 sub req_remove
 720 {
 721     my ( $cmd, $data ) = @_;
 722
 723     argsplit("remove");
 724
 725     # Grab a handle to the SQLite db and do any necessary updates
 726     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 727     $updater->update();
 728
 729     #$log->debug("add state : " . Dumper($state));
 730
 731     my $rmcount = 0;
 732
 733     foreach my $filename ( @{$state->{args}} )
 734     {
 735         $filename = filecleanup($filename);
 736
 737         if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
 738         {
 739             print "E cvs remove: file `$filename' still in working directory\n";
 740             next;
 741         }
 742
 743         # only from entries
 744         my $stickyInfo = resolveStickyInfo($filename);
 745
 746         my $meta = $updater->getmeta($filename,$stickyInfo);
 747         my $wrev = revparse($filename);
 748
 749         unless ( defined ( $wrev ) )
 750         {
 751             print "E cvs remove: nothing known about `$filename'\n";
 752             next;
 753         }
 754
 755         if ( defined($wrev) and ($wrev=~/^-/) )
 756         {
 757             print "E cvs remove: file `$filename' already scheduled for removal\n";
 758             next;
 759         }
 760
 761         unless ( $wrev eq $meta->{revision} )
 762         {
 763             # TODO : not sure if the format of this message is quite correct.
 764             print "E cvs remove: Up to date check failed for `$filename'\n";
 765             next;
 766         }
 767
 768
 769         my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
 770
 771         print "E cvs remove: scheduling `$filename' for removal\n";
 772
 773         print "Checked-in $dirpart\n";
 774         print "$filename\n";
 775         my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
 776         print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
 777
 778         $rmcount++;
 779     }
 780
 781     if ( $rmcount == 1 )
 782     {
 783         print "E cvs remove: use `cvs commit' to remove this file permanently\n";
 784     }
 785     elsif ( $rmcount > 1 )
 786     {
 787         print "E cvs remove: use `cvs commit' to remove these files permanently\n";
 788     }
 789
 790     print "ok\n";
 791 }
 792
 793 # Modified filename \n
 794 #     Response expected: no. Additional data: mode, \n, file transmission. Send
 795 #     the server a copy of one locally modified file. filename is a file within
 796 #     the most recent directory sent with Directory; it must not contain `/'.
 797 #     If the user is operating on only some files in a directory, only those
 798 #     files need to be included. This can also be sent without Entry, if there
 799 #     is no entry for the file.
 800 sub req_Modified
 801 {
 802     my ( $cmd, $data ) = @_;
 803
 804     my $mode = <STDIN>;
 805     defined $mode
 806         or (print "E end of file reading mode for $data\n"), return;
 807     chomp $mode;
 808     my $size = <STDIN>;
 809     defined $size
 810         or (print "E end of file reading size of $data\n"), return;
 811     chomp $size;
 812
 813     # Grab config information
 814     my $blocksize = 8192;
 815     my $bytesleft = $size;
 816     my $tmp;
 817
 818     # Get a filehandle/name to write it to
 819     my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
 820
 821     # Loop over file data writing out to temporary file.
 822     while ( $bytesleft )
 823     {
 824         $blocksize = $bytesleft if ( $bytesleft < $blocksize );
 825         read STDIN, $tmp, $blocksize;
 826         print $fh $tmp;
 827         $bytesleft -= $blocksize;
 828     }
 829
 830     close $fh
 831         or (print "E failed to write temporary, $filename: $!\n"), return;
 832
 833     # Ensure we have something sensible for the file mode
 834     if ( $mode =~ /u=(\w+)/ )
 835     {
 836         $mode = $1;
 837     } else {
 838         $mode = "rw";
 839     }
 840
 841     # Save the file data in $state
 842     $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
 843     $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
 844     $state->{entries}{$state->{directory}.$data}{modified_hash} = `git hash-object $filename`;
 845     $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
 846
 847     #$log->debug("req_Modified : file=$data mode=$mode size=$size");
 848 }
 849
 850 # Unchanged filename \n
 851 #     Response expected: no. Tell the server that filename has not been
 852 #     modified in the checked out directory. The filename is a file within the
 853 #     most recent directory sent with Directory; it must not contain `/'.
 854 sub req_Unchanged
 855 {
 856     my ( $cmd, $data ) = @_;
 857
 858     $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
 859
 860     #$log->debug("req_Unchanged : $data");
 861 }
 862
 863 # Argument text \n
 864 #     Response expected: no. Save argument for use in a subsequent command.
 865 #     Arguments accumulate until an argument-using command is given, at which
 866 #     point they are forgotten.
 867 # Argumentx text \n
 868 #     Response expected: no. Append \n followed by text to the current argument
 869 #     being saved.
 870 sub req_Argument
 871 {
 872     my ( $cmd, $data ) = @_;
 873
 874     # Argumentx means: append to last Argument (with a newline in front)
 875
 876     $log->debug("$cmd : $data");
 877
 878     if ( $cmd eq 'Argumentx') {
 879         ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
 880     } else {
 881         push @{$state->{arguments}}, $data;
 882     }
 883 }
 884
 885 # expand-modules \n
 886 #     Response expected: yes. Expand the modules which are specified in the
 887 #     arguments. Returns the data in Module-expansion responses. Note that the
 888 #     server can assume that this is checkout or export, not rtag or rdiff; the
 889 #     latter do not access the working directory and thus have no need to
 890 #     expand modules on the client side. Expand may not be the best word for
 891 #     what this request does. It does not necessarily tell you all the files
 892 #     contained in a module, for example. Basically it is a way of telling you
 893 #     which working directories the server needs to know about in order to
 894 #     handle a checkout of the specified modules. For example, suppose that the
 895 #     server has a module defined by
 896 #   aliasmodule -a 1dir
 897 #     That is, one can check out aliasmodule and it will take 1dir in the
 898 #     repository and check it out to 1dir in the working directory. Now suppose
 899 #     the client already has this module checked out and is planning on using
 900 #     the co request to update it. Without using expand-modules, the client
 901 #     would have two bad choices: it could either send information about all
 902 #     working directories under the current directory, which could be
 903 #     unnecessarily slow, or it could be ignorant of the fact that aliasmodule
 904 #     stands for 1dir, and neglect to send information for 1dir, which would
 905 #     lead to incorrect operation. With expand-modules, the client would first
 906 #     ask for the module to be expanded:
 907 sub req_expandmodules
 908 {
 909     my ( $cmd, $data ) = @_;
 910
 911     argsplit();
 912
 913     $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
 914
 915     unless ( ref $state->{arguments} eq "ARRAY" )
 916     {
 917         print "ok\n";
 918         return;
 919     }
 920
 921     foreach my $module ( @{$state->{arguments}} )
 922     {
 923         $log->debug("SEND : Module-expansion $module");
 924         print "Module-expansion $module\n";
 925     }
 926
 927     print "ok\n";
 928     statecleanup();
 929 }
 930
 931 # co \n
 932 #     Response expected: yes. Get files from the repository. This uses any
 933 #     previous Argument, Directory, Entry, or Modified requests, if they have
 934 #     been sent. Arguments to this command are module names; the client cannot
 935 #     know what directories they correspond to except by (1) just sending the
 936 #     co request, and then seeing what directory names the server sends back in
 937 #     its responses, and (2) the expand-modules request.
 938 sub req_co
 939 {
 940     my ( $cmd, $data ) = @_;
 941
 942     argsplit("co");
 943
 944     # Provide list of modules, if -c was used.
 945     if (exists $state->{opt}{c}) {
 946         my $showref = `git show-ref --heads`;
 947         for my $line (split '\n', $showref) {
 948             if ( $line =~ m% refs/heads/(.*)$% ) {
 949                 print "M $1\t$1\n";
 950             }
 951         }
 952         print "ok\n";
 953         return 1;
 954     }
 955
 956     my $stickyInfo = { 'tag' => $state->{opt}{r},
 957                        'date' => $state->{opt}{D} };
 958
 959     my $module = $state->{args}[0];
 960     $state->{module} = $module;
 961     my $checkout_path = $module;
 962
 963     # use the user specified directory if we're given it
 964     $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
 965
 966     $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
 967
 968     $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
 969
 970     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 971
 972     # Grab a handle to the SQLite db and do any necessary updates
 973     my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
 974     $updater->update();
 975
 976     my $headHash;
 977     if( defined($stickyInfo) && defined($stickyInfo->{tag}) )
 978     {
 979         $headHash = $updater->lookupCommitRef($stickyInfo->{tag});
 980         if( !defined($headHash) )
 981         {
 982             print "error 1 no such tag `$stickyInfo->{tag}'\n";
 983             cleanupWorkTree();
 984             exit;
 985         }
 986     }
 987
 988     $checkout_path =~ s|/$||; # get rid of trailing slashes
 989
 990     my %seendirs = ();
 991     my $lastdir ='';
 992
 993     prepDirForOutput(
 994             ".",
 995             $state->{CVSROOT} . "/$module",
 996             $checkout_path,
 997             \%seendirs,
 998             'checkout',
 999             $state->{dirArgs} );
1000
1001     foreach my $git ( @{$updater->getAnyHead($headHash)} )
1002     {
1003         # Don't want to check out deleted files
1004         next if ( $git->{filehash} eq "deleted" );
1005
1006         my $fullName = $git->{name};
1007         ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
1008
1009         unless (exists($seendirs{$git->{dir}})) {
1010             prepDirForOutput($git->{dir}, $state->{CVSROOT} . "/$module/",
1011                              $checkout_path, \%seendirs, 'checkout',
1012                              $state->{dirArgs} );
1013             $lastdir = $git->{dir};
1014             $seendirs{$git->{dir}} = 1;
1015         }
1016
1017         # modification time of this file
1018         print "Mod-time $git->{modified}\n";
1019
1020         # print some information to the client
1021         if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
1022         {
1023             print "M U $checkout_path/$git->{dir}$git->{name}\n";
1024         } else {
1025             print "M U $checkout_path/$git->{name}\n";
1026         }
1027
1028        # instruct client we're sending a file to put in this path
1029        print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
1030
1031        print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
1032
1033         # this is an "entries" line
1034         my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
1035         print "/$git->{name}/$git->{revision}//$kopts/" .
1036                         getStickyTagOrDate($stickyInfo) . "\n";
1037         # permissions
1038         print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
1039
1040         # transmit file
1041         transmitfile($git->{filehash});
1042     }
1043
1044     print "ok\n";
1045
1046     statecleanup();
1047 }
1048
1049 # used by req_co and req_update to set up directories for files
1050 # recursively handles parents
1051 sub prepDirForOutput
1052 {
1053     my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;
1054
1055     my $parent = dirname($dir);
1056     $dir       =~ s|/+$||;
1057     $repodir   =~ s|/+$||;
1058     $remotedir =~ s|/+$||;
1059     $parent    =~ s|/+$||;
1060
1061     if ($parent eq '.' || $parent eq './')
1062     {
1063         $parent = '';
1064     }
1065     # recurse to announce unseen parents first
1066     if( length($parent) &&
1067         !exists($seendirs->{$parent}) &&
1068         ( $request eq "checkout" ||
1069           exists($dirArgs->{$parent}) ) )
1070     {
1071         prepDirForOutput($parent, $repodir, $remotedir,
1072                          $seendirs, $request, $dirArgs);
1073     }
1074     # Announce that we are going to modify at the parent level
1075     if ($dir eq '.' || $dir eq './')
1076     {
1077         $dir = '';
1078     }
1079     if(exists($seendirs->{$dir}))
1080     {
1081         return;
1082     }
1083     $log->debug("announcedir $dir, $repodir, $remotedir" );
1084     my($thisRemoteDir,$thisRepoDir);
1085     if ($dir ne "")
1086     {
1087         $thisRepoDir="$repodir/$dir";
1088         if($remotedir eq ".")
1089         {
1090             $thisRemoteDir=$dir;
1091         }
1092         else
1093         {
1094             $thisRemoteDir="$remotedir/$dir";
1095         }
1096     }
1097     else
1098     {
1099         $thisRepoDir=$repodir;
1100         $thisRemoteDir=$remotedir;
1101     }
1102     unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
1103     {
1104         print "E cvs $request: Updating $thisRemoteDir\n";
1105     }
1106
1107     my ($opt_r)=$state->{opt}{r};
1108     my $stickyInfo;
1109     if(exists($state->{opt}{A}))
1110     {
1111         # $stickyInfo=undef;
1112     }
1113     elsif( defined($opt_r) && $opt_r ne "" )
1114            # || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO
1115     {
1116         $stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };
1117
1118         # TODO: Convert -D value into the form 2011.04.10.04.46.57,
1119         #   similar to an entry line's sticky date, without the D prefix.
1120         #   It sometimes (always?) arrives as something more like
1121         #   '10 Apr 2011 04:46:57 -0000'...
1122         # $stickyInfo={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
1123     }
1124     else
1125     {
1126         $stickyInfo=getDirStickyInfo($state->{prependdir} . $dir);
1127     }
1128
1129     my $stickyResponse;
1130     if(defined($stickyInfo))
1131     {
1132         $stickyResponse = "Set-sticky $thisRemoteDir/\n" .
1133                           "$thisRepoDir/\n" .
1134                           getStickyTagOrDate($stickyInfo) . "\n";
1135     }
1136     else
1137     {
1138         $stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
1139                           "$thisRepoDir/\n";
1140     }
1141
1142     unless ( $state->{globaloptions}{-n} )
1143     {
1144         print $stickyResponse;
1145
1146         print "Clear-static-directory $thisRemoteDir/\n";
1147         print "$thisRepoDir/\n";
1148         print $stickyResponse; # yes, twice
1149         print "Template $thisRemoteDir/\n";
1150         print "$thisRepoDir/\n";
1151         print "0\n";
1152     }
1153
1154     $seendirs->{$dir} = 1;
1155
1156     # FUTURE: This would more accurately emulate CVS by sending
1157     #   another copy of sticky after processing the files in that
1158     #   directory.  Or intermediate: perhaps send all sticky's for
1159     #   $seendirs after after processing all files.
1160 }
1161
1162 # update \n
1163 #     Response expected: yes. Actually do a cvs update command. This uses any
1164 #     previous Argument, Directory, Entry, or Modified requests, if they have
1165 #     been sent. The last Directory sent specifies the working directory at the
1166 #     time of the operation. The -I option is not used--files which the client
1167 #     can decide whether to ignore are not mentioned and the client sends the
1168 #     Questionable request for others.
1169 sub req_update
1170 {
1171     my ( $cmd, $data ) = @_;
1172
1173     $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
1174
1175     argsplit("update");
1176
1177     #
1178     # It may just be a client exploring the available heads/modules
1179     # in that case, list them as top level directories and leave it
1180     # at that. Eclipse uses this technique to offer you a list of
1181     # projects (heads in this case) to checkout.
1182     #
1183     if ($state->{module} eq '') {
1184         my $showref = `git show-ref --heads`;
1185         print "E cvs update: Updating .\n";
1186         for my $line (split '\n', $showref) {
1187             if ( $line =~ m% refs/heads/(.*)$% ) {
1188                 print "E cvs update: New directory `$1'\n";
1189             }
1190         }
1191         print "ok\n";
1192         return 1;
1193     }
1194
1195
1196     # Grab a handle to the SQLite db and do any necessary updates
1197     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1198
1199     $updater->update();
1200
1201     argsfromdir($updater);
1202
1203     #$log->debug("update state : " . Dumper($state));
1204
1205     my($repoDir);
1206     $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
1207
1208     my %seendirs = ();
1209
1210     # foreach file specified on the command line ...
1211     foreach my $argsFilename ( @{$state->{args}} )
1212     {
1213         my $filename;
1214         $filename = filecleanup($argsFilename);
1215
1216         $log->debug("Processing file $filename");
1217
1218         # if we have a -C we should pretend we never saw modified stuff
1219         if ( exists ( $state->{opt}{C} ) )
1220         {
1221             delete $state->{entries}{$filename}{modified_hash};
1222             delete $state->{entries}{$filename}{modified_filename};
1223             $state->{entries}{$filename}{unchanged} = 1;
1224         }
1225
1226         my $stickyInfo = resolveStickyInfo($filename,
1227                                            $state->{opt}{r},
1228                                            $state->{opt}{D},
1229                                            exists($state->{opt}{A}));
1230         my $meta = $updater->getmeta($filename, $stickyInfo);
1231
1232         # If -p was given, "print" the contents of the requested revision.
1233         if ( exists ( $state->{opt}{p} ) ) {
1234             if ( defined ( $meta->{revision} ) ) {
1235                 $log->info("Printing '$filename' revision " . $meta->{revision});
1236
1237                 transmitfile($meta->{filehash}, { print => 1 });
1238             }
1239
1240             next;
1241         }
1242
1243         # Directories:
1244         prepDirForOutput(
1245                 dirname($argsFilename),
1246                 $repoDir,
1247                 ".",
1248                 \%seendirs,
1249                 "update",
1250                 $state->{dirArgs} );
1251
1252         my $wrev = revparse($filename);
1253
1254         if ( ! defined $meta )
1255         {
1256             $meta = {
1257                 name => $filename,
1258                 revision => '0',
1259                 filehash => 'added'
1260             };
1261             if($wrev ne "0")
1262             {
1263                 $meta->{filehash}='deleted';
1264             }
1265         }
1266
1267         my $oldmeta = $meta;
1268
1269         # If the working copy is an old revision, lets get that version too for comparison.
1270         my $oldWrev=$wrev;
1271         if(defined($oldWrev))
1272         {
1273             $oldWrev=~s/^-//;
1274             if($oldWrev ne $meta->{revision})
1275             {
1276                 $oldmeta = $updater->getmeta($filename, $oldWrev);
1277             }
1278         }
1279
1280         #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
1281
1282         # Files are up to date if the working copy and repo copy have the same revision,
1283         # and the working copy is unmodified _and_ the user hasn't specified -C
1284         next if ( defined ( $wrev )
1285                   and defined($meta->{revision})
1286                   and $wrev eq $meta->{revision}
1287                   and $state->{entries}{$filename}{unchanged}
1288                   and not exists ( $state->{opt}{C} ) );
1289
1290         # If the working copy and repo copy have the same revision,
1291         # but the working copy is modified, tell the client it's modified
1292         if ( defined ( $wrev )
1293              and defined($meta->{revision})
1294              and $wrev eq $meta->{revision}
1295              and $wrev ne "0"
1296              and defined($state->{entries}{$filename}{modified_hash})
1297              and not exists ( $state->{opt}{C} ) )
1298         {
1299             $log->info("Tell the client the file is modified");
1300             print "MT text M \n";
1301             print "MT fname $filename\n";
1302             print "MT newline\n";
1303             next;
1304         }
1305
1306         if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
1307         {
1308             # TODO: If it has been modified in the sandbox, error out
1309             #   with the appropriate message, rather than deleting a modified
1310             #   file.
1311
1312             my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1313
1314             $log->info("Removing '$filename' from working copy (no longer in the repo)");
1315
1316             print "E cvs update: `$filename' is no longer in the repository\n";
1317             # Don't want to actually _DO_ the update if -n specified
1318             unless ( $state->{globaloptions}{-n} ) {
1319                 print "Removed $dirpart\n";
1320                 print "$filepart\n";
1321             }
1322         }
1323         elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
1324                 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
1325                 or $meta->{filehash} eq 'added' )
1326         {
1327             # normal update, just send the new revision (either U=Update,
1328             # or A=Add, or R=Remove)
1329             if ( defined($wrev) && ($wrev=~/^-/) )
1330             {
1331                 $log->info("Tell the client the file is scheduled for removal");
1332                 print "MT text R \n";
1333                 print "MT fname $filename\n";
1334                 print "MT newline\n";
1335                 next;
1336             }
1337             elsif ( (!defined($wrev) || $wrev eq '0') &&
1338                     (!defined($meta->{revision}) || $meta->{revision} eq '0') )
1339             {
1340                 $log->info("Tell the client the file is scheduled for addition");
1341                 print "MT text A \n";
1342                 print "MT fname $filename\n";
1343                 print "MT newline\n";
1344                 next;
1345
1346             }
1347             else {
1348                 $log->info("UpdatingX3 '$filename' to ".$meta->{revision});
1349                 print "MT +updated\n";
1350                 print "MT text U \n";
1351                 print "MT fname $filename\n";
1352                 print "MT newline\n";
1353                 print "MT -updated\n";
1354             }
1355
1356             my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1357
1358             # Don't want to actually _DO_ the update if -n specified
1359             unless ( $state->{globaloptions}{-n} )
1360             {
1361                 if ( defined ( $wrev ) )
1362                 {
1363                     # instruct client we're sending a file to put in this path as a replacement
1364                     print "Update-existing $dirpart\n";
1365                     $log->debug("Updating existing file 'Update-existing $dirpart'");
1366                 } else {
1367                     # instruct client we're sending a file to put in this path as a new file
1368
1369                     $log->debug("Creating new file 'Created $dirpart'");
1370                     print "Created $dirpart\n";
1371                 }
1372                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1373
1374                 # this is an "entries" line
1375                 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
1376                 my $entriesLine = "/$filepart/$meta->{revision}//$kopts/";
1377                 $entriesLine .= getStickyTagOrDate($stickyInfo);
1378                 $log->debug($entriesLine);
1379                 print "$entriesLine\n";
1380
1381                 # permissions
1382                 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1383                 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1384
1385                 # transmit file
1386                 transmitfile($meta->{filehash});
1387             }
1388         } else {
1389             my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
1390
1391             my $mergeDir = setupTmpDir();
1392
1393             my $file_local = $filepart . ".mine";
1394             my $mergedFile = "$mergeDir/$file_local";
1395             system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
1396             my $file_old = $filepart . "." . $oldmeta->{revision};
1397             transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
1398             my $file_new = $filepart . "." . $meta->{revision};
1399             transmitfile($meta->{filehash}, { targetfile => $file_new });
1400
1401             # we need to merge with the local changes ( M=successful merge, C=conflict merge )
1402             $log->info("Merging $file_local, $file_old, $file_new");
1403             print "M Merging differences between $oldmeta->{revision} and $meta->{revision} into $filename\n";
1404
1405             $log->debug("Temporary directory for merge is $mergeDir");
1406
1407             my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
1408             $return >>= 8;
1409
1410             cleanupTmpDir();
1411
1412             if ( $return == 0 )
1413             {
1414                 $log->info("Merged successfully");
1415                 print "M M $filename\n";
1416                 $log->debug("Merged $dirpart");
1417
1418                 # Don't want to actually _DO_ the update if -n specified
1419                 unless ( $state->{globaloptions}{-n} )
1420                 {
1421                     print "Merged $dirpart\n";
1422                     $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
1423                     print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1424                     my $kopts = kopts_from_path("$dirpart/$filepart",
1425                                                 "file",$mergedFile);
1426                     $log->debug("/$filepart/$meta->{revision}//$kopts/");
1427                     my $entriesLine="/$filepart/$meta->{revision}//$kopts/";
1428                     $entriesLine .= getStickyTagOrDate($stickyInfo);
1429                     print "$entriesLine\n";
1430                 }
1431             }
1432             elsif ( $return == 1 )
1433             {
1434                 $log->info("Merged with conflicts");
1435                 print "E cvs update: conflicts found in $filename\n";
1436                 print "M C $filename\n";
1437
1438                 # Don't want to actually _DO_ the update if -n specified
1439                 unless ( $state->{globaloptions}{-n} )
1440                 {
1441                     print "Merged $dirpart\n";
1442                     print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1443                     my $kopts = kopts_from_path("$dirpart/$filepart",
1444                                                 "file",$mergedFile);
1445                     my $entriesLine = "/$filepart/$meta->{revision}/+/$kopts/";
1446                     $entriesLine .= getStickyTagOrDate($stickyInfo);
1447                     print "$entriesLine\n";
1448                 }
1449             }
1450             else
1451             {
1452                 $log->warn("Merge failed");
1453                 next;
1454             }
1455
1456             # Don't want to actually _DO_ the update if -n specified
1457             unless ( $state->{globaloptions}{-n} )
1458             {
1459                 # permissions
1460                 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1461                 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1462
1463                 # transmit file, format is single integer on a line by itself (file
1464                 # size) followed by the file contents
1465                 # TODO : we should copy files in blocks
1466                 my $data = `cat $mergedFile`;
1467                 $log->debug("File size : " . length($data));
1468                 print length($data) . "\n";
1469                 print $data;
1470             }
1471         }
1472
1473     }
1474
1475     # prepDirForOutput() any other existing directories unless they already
1476     # have the right sticky tag:
1477     unless ( $state->{globaloptions}{n} )
1478     {
1479         my $dir;
1480         foreach $dir (keys(%{$state->{dirMap}}))
1481         {
1482             if( ! $seendirs{$dir} &&
1483                 exists($state->{dirArgs}{$dir}) )
1484             {
1485                 my($oldTag);
1486                 $oldTag=$state->{dirMap}{$dir}{tagspec};
1487
1488                 unless( ( exists($state->{opt}{A}) &&
1489                           defined($oldTag) ) ||
1490                           ( defined($state->{opt}{r}) &&
1491                             ( !defined($oldTag) ||
1492                               $state->{opt}{r} ne $oldTag ) ) )
1493                         # TODO?: OR sticky dir is different...
1494                 {
1495                     next;
1496                 }
1497
1498                 prepDirForOutput(
1499                         $dir,
1500                         $repoDir,
1501                         ".",
1502                         \%seendirs,
1503                         'update',
1504                         $state->{dirArgs} );
1505             }
1506
1507             # TODO?: Consider sending a final duplicate Sticky response
1508             #   to more closely mimic real CVS.
1509         }
1510     }
1511
1512     print "ok\n";
1513 }
1514
1515 sub req_ci
1516 {
1517     my ( $cmd, $data ) = @_;
1518
1519     argsplit("ci");
1520
1521     #$log->debug("State : " . Dumper($state));
1522
1523     $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1524
1525     if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
1526     {
1527         print "error 1 anonymous user cannot commit via pserver\n";
1528         cleanupWorkTree();
1529         exit;
1530     }
1531
1532     if ( -e $state->{CVSROOT} . "/index" )
1533     {
1534         $log->warn("file 'index' already exists in the git repository");
1535         print "error 1 Index already exists in git repo\n";
1536         cleanupWorkTree();
1537         exit;
1538     }
1539
1540     # Grab a handle to the SQLite db and do any necessary updates
1541     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1542     $updater->update();
1543
1544     my @committedfiles = ();
1545     my %oldmeta;
1546     my $stickyInfo;
1547     my $branchRef;
1548     my $parenthash;
1549
1550     # foreach file specified on the command line ...
1551     foreach my $filename ( @{$state->{args}} )
1552     {
1553         my $committedfile = $filename;
1554         $filename = filecleanup($filename);
1555
1556         next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1557
1558         #####
1559         # Figure out which branch and parenthash we are committing
1560         # to, and setup worktree:
1561
1562         # should always come from entries:
1563         my $fileStickyInfo = resolveStickyInfo($filename);
1564         if( !defined($branchRef) )
1565         {
1566             $stickyInfo = $fileStickyInfo;
1567             if( defined($stickyInfo) &&
1568                 ( defined($stickyInfo->{date}) ||
1569                   !defined($stickyInfo->{tag}) ) )
1570             {
1571                 print "error 1 cannot commit with sticky date for file `$filename'\n";
1572                 cleanupWorkTree();
1573                 exit;
1574             }
1575
1576             $branchRef = "refs/heads/$state->{module}";
1577             if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1578             {
1579                 $branchRef = "refs/heads/$stickyInfo->{tag}";
1580             }
1581
1582             $parenthash = `git show-ref -s $branchRef`;
1583             chomp $parenthash;
1584             if ($parenthash !~ /^[0-9a-f]{40}$/)
1585             {
1586                 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1587                 {
1588                     print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
1589                 }
1590                 else
1591                 {
1592                     print "error 1 pserver cannot find the current HEAD of module";
1593                 }
1594                 cleanupWorkTree();
1595                 exit;
1596             }
1597
1598             setupWorkTree($parenthash);
1599
1600             $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
1601
1602             $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
1603         }
1604         elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )
1605         {
1606             #TODO: We could split the cvs commit into multiple
1607             #  git commits by distinct stickyTag values, but that
1608             #  is lowish priority.
1609             print "error 1 Committing different files to different"
1610                   . " branches is not currently supported\n";
1611             cleanupWorkTree();
1612             exit;
1613         }
1614
1615         #####
1616         # Process this file:
1617
1618         my $meta = $updater->getmeta($filename,$stickyInfo);
1619         $oldmeta{$filename} = $meta;
1620
1621         my $wrev = revparse($filename);
1622
1623         my ( $filepart, $dirpart ) = filenamesplit($filename);
1624
1625         # do a checkout of the file if it is part of this tree
1626         if ($wrev) {
1627             system('git', 'checkout-index', '-f', '-u', $filename);
1628             unless ($? == 0) {
1629                 die "Error running git-checkout-index -f -u $filename : $!";
1630             }
1631         }
1632
1633         my $addflag = 0;
1634         my $rmflag = 0;
1635         $rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
1636         $addflag = 1 unless ( -e $filename );
1637
1638         # Do up to date checking
1639         unless ( $addflag or $wrev eq $meta->{revision} or
1640                  ( $rmflag and $wrev eq "-$meta->{revision}" ) )
1641         {
1642             # fail everything if an up to date check fails
1643             print "error 1 Up to date check failed for $filename\n";
1644             cleanupWorkTree();
1645             exit;
1646         }
1647
1648         push @committedfiles, $committedfile;
1649         $log->info("Committing $filename");
1650
1651         system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1652
1653         unless ( $rmflag )
1654         {
1655             $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1656             rename $state->{entries}{$filename}{modified_filename},$filename;
1657
1658             # Calculate modes to remove
1659             my $invmode = "";
1660             foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1661
1662             $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1663             system("chmod","u+" .  $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1664         }
1665
1666         if ( $rmflag )
1667         {
1668             $log->info("Removing file '$filename'");
1669             unlink($filename);
1670             system("git", "update-index", "--remove", $filename);
1671         }
1672         elsif ( $addflag )
1673         {
1674             $log->info("Adding file '$filename'");
1675             system("git", "update-index", "--add", $filename);
1676         } else {
1677             $log->info("UpdatingX2 file '$filename'");
1678             system("git", "update-index", $filename);
1679         }
1680     }
1681
1682     unless ( scalar(@committedfiles) > 0 )
1683     {
1684         print "E No files to commit\n";
1685         print "ok\n";
1686         cleanupWorkTree();
1687         return;
1688     }
1689
1690     my $treehash = `git write-tree`;
1691     chomp $treehash;
1692
1693     $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1694
1695     # write our commit message out if we have one ...
1696     my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1697     print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1698     if ( defined ( $cfg->{gitcvs}{commitmsgannotation} ) ) {
1699         if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/ ) {
1700             print $msg_fh "\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"
1701         }
1702     } else {
1703         print $msg_fh "\n\nvia git-CVS emulator\n";
1704     }
1705     close $msg_fh;
1706
1707     my $commithash = `git commit-tree $treehash -p $parenthash < $msg_filename`;
1708     chomp($commithash);
1709     $log->info("Commit hash : $commithash");
1710
1711     unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1712     {
1713         $log->warn("Commit failed (Invalid commit hash)");
1714         print "error 1 Commit failed (unknown reason)\n";
1715         cleanupWorkTree();
1716         exit;
1717     }
1718
1719         ### Emulate git-receive-pack by running hooks/update
1720         my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
1721                         $parenthash, $commithash );
1722         if( -x $hook[0] ) {
1723                 unless( system( @hook ) == 0 )
1724                 {
1725                         $log->warn("Commit failed (update hook declined to update ref)");
1726                         print "error 1 Commit failed (update hook declined)\n";
1727                         cleanupWorkTree();
1728                         exit;
1729                 }
1730         }
1731
1732         ### Update the ref
1733         if (system(qw(git update-ref -m), "cvsserver ci",
1734                         $branchRef, $commithash, $parenthash)) {
1735                 $log->warn("update-ref for $state->{module} failed.");
1736                 print "error 1 Cannot commit -- update first\n";
1737                 cleanupWorkTree();
1738                 exit;
1739         }
1740
1741         ### Emulate git-receive-pack by running hooks/post-receive
1742         my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
1743         if( -x $hook ) {
1744                 open(my $pipe, "| $hook") || die "can't fork $!";
1745
1746                 local $SIG{PIPE} = sub { die 'pipe broke' };
1747
1748                 print $pipe "$parenthash $commithash $branchRef\n";
1749
1750                 close $pipe || die "bad pipe: $! $?";
1751         }
1752
1753     $updater->update();
1754
1755         ### Then hooks/post-update
1756         $hook = $ENV{GIT_DIR}.'hooks/post-update';
1757         if (-x $hook) {
1758                 system($hook, $branchRef);
1759         }
1760
1761     # foreach file specified on the command line ...
1762     foreach my $filename ( @committedfiles )
1763     {
1764         $filename = filecleanup($filename);
1765
1766         my $meta = $updater->getmeta($filename,$stickyInfo);
1767         unless (defined $meta->{revision}) {
1768           $meta->{revision} = "1.1";
1769         }
1770
1771         my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
1772
1773         $log->debug("Checked-in $dirpart : $filename");
1774
1775         print "M $state->{CVSROOT}/$state->{module}/$filename,v  <--  $dirpart$filepart\n";
1776         if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
1777         {
1778             print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
1779             print "Remove-entry $dirpart\n";
1780             print "$filename\n";
1781         } else {
1782             if ($meta->{revision} eq "1.1") {
1783                 print "M initial revision: 1.1\n";
1784             } else {
1785                 print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
1786             }
1787             print "Checked-in $dirpart\n";
1788             print "$filename\n";
1789             my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
1790             print "/$filepart/$meta->{revision}//$kopts/" .
1791                   getStickyTagOrDate($stickyInfo) . "\n";
1792         }
1793     }
1794
1795     cleanupWorkTree();
1796     print "ok\n";
1797 }
1798
1799 sub req_status
1800 {
1801     my ( $cmd, $data ) = @_;
1802
1803     argsplit("status");
1804
1805     $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1806     #$log->debug("status state : " . Dumper($state));
1807
1808     # Grab a handle to the SQLite db and do any necessary updates
1809     my $updater;
1810     $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1811     $updater->update();
1812
1813     # if no files were specified, we need to work out what files we should
1814     # be providing status on ...
1815     argsfromdir($updater);
1816
1817     # foreach file specified on the command line ...
1818     foreach my $filename ( @{$state->{args}} )
1819     {
1820         $filename = filecleanup($filename);
1821
1822         if ( exists($state->{opt}{l}) &&
1823              index($filename, '/', length($state->{prependdir})) >= 0 )
1824         {
1825            next;
1826         }
1827
1828         my $wrev = revparse($filename);
1829
1830         my $stickyInfo = resolveStickyInfo($filename);
1831         my $meta = $updater->getmeta($filename,$stickyInfo);
1832         my $oldmeta = $meta;
1833
1834         # If the working copy is an old revision, lets get that
1835         # version too for comparison.
1836         if ( defined($wrev) and $wrev ne $meta->{revision} )
1837         {
1838             my($rmRev)=$wrev;
1839             $rmRev=~s/^-//;
1840             $oldmeta = $updater->getmeta($filename, $rmRev);
1841         }
1842
1843         # TODO : All possible statuses aren't yet implemented
1844         my $status;
1845         # Files are up to date if the working copy and repo copy have
1846         # the same revision, and the working copy is unmodified
1847         if ( defined ( $wrev ) and defined($meta->{revision}) and
1848              $wrev eq $meta->{revision} and
1849              ( ( $state->{entries}{$filename}{unchanged} and
1850                  ( not defined ( $state->{entries}{$filename}{conflict} ) or
1851                    $state->{entries}{$filename}{conflict} !~ /^\+=/ ) ) or
1852                ( defined($state->{entries}{$filename}{modified_hash}) and
1853                  $state->{entries}{$filename}{modified_hash} eq
1854                         $meta->{filehash} ) ) )
1855         {
1856             $status = "Up-to-date"
1857         }
1858
1859         # Need checkout if the working copy has a different (usually
1860         # older) revision than the repo copy, and the working copy is
1861         # unmodified
1862         if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
1863              $meta->{revision} ne $wrev and
1864              ( $state->{entries}{$filename}{unchanged} or
1865                ( defined($state->{entries}{$filename}{modified_hash}) and
1866                  $state->{entries}{$filename}{modified_hash} eq
1867                                 $oldmeta->{filehash} ) ) )
1868         {
1869             $status ||= "Needs Checkout";
1870         }
1871
1872         # Need checkout if it exists in the repo but doesn't have a working
1873         # copy
1874         if ( not defined ( $wrev ) and defined ( $meta->{revision} ) )
1875         {
1876             $status ||= "Needs Checkout";
1877         }
1878
1879         # Locally modified if working copy and repo copy have the
1880         # same revision but there are local changes
1881         if ( defined ( $wrev ) and defined($meta->{revision}) and
1882              $wrev eq $meta->{revision} and
1883              $wrev ne "0" and
1884              $state->{entries}{$filename}{modified_filename} )
1885         {
1886             $status ||= "Locally Modified";
1887         }
1888
1889         # Needs Merge if working copy revision is different
1890         # (usually older) than repo copy and there are local changes
1891         if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
1892              $meta->{revision} ne $wrev and
1893              $state->{entries}{$filename}{modified_filename} )
1894         {
1895             $status ||= "Needs Merge";
1896         }
1897
1898         if ( defined ( $state->{entries}{$filename}{revision} ) and
1899              ( !defined($meta->{revision}) ||
1900                $meta->{revision} eq "0" ) )
1901         {
1902             $status ||= "Locally Added";
1903         }
1904         if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
1905              $wrev eq "-$meta->{revision}" )
1906         {
1907             $status ||= "Locally Removed";
1908         }
1909         if ( defined ( $state->{entries}{$filename}{conflict} ) and
1910              $state->{entries}{$filename}{conflict} =~ /^\+=/ )
1911         {
1912             $status ||= "Unresolved Conflict";
1913         }
1914         if ( 0 )
1915         {
1916             $status ||= "File had conflicts on merge";
1917         }
1918
1919         $status ||= "Unknown";
1920
1921         my ($filepart) = filenamesplit($filename);
1922
1923         print "M =======" . ( "=" x 60 ) . "\n";
1924         print "M File: $filepart\tStatus: $status\n";
1925         if ( defined($state->{entries}{$filename}{revision}) )
1926         {
1927             print "M Working revision:\t" .
1928                   $state->{entries}{$filename}{revision} . "\n";
1929         } else {
1930             print "M Working revision:\tNo entry for $filename\n";
1931         }
1932         if ( defined($meta->{revision}) )
1933         {
1934             print "M Repository revision:\t" .
1935                    $meta->{revision} .
1936                    "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
1937             my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
1938             my($tag)=($tagOrDate=~m/^T(.+)$/);
1939             if( !defined($tag) )
1940             {
1941                 $tag="(none)";
1942             }
1943             print "M Sticky Tag:\t\t$tag\n";
1944             my($date)=($tagOrDate=~m/^D(.+)$/);
1945             if( !defined($date) )
1946             {
1947                 $date="(none)";
1948             }
1949             print "M Sticky Date:\t\t$date\n";
1950             my($options)=$state->{entries}{$filename}{options};
1951             if( $options eq "" )
1952             {
1953                 $options="(none)";
1954             }
1955             print "M Sticky Options:\t\t$options\n";
1956         } else {
1957             print "M Repository revision:\tNo revision control file\n";
1958         }
1959         print "M\n";
1960     }
1961
1962     print "ok\n";
1963 }
1964
1965 sub req_diff
1966 {
1967     my ( $cmd, $data ) = @_;
1968
1969     argsplit("diff");
1970
1971     $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1972     #$log->debug("status state : " . Dumper($state));
1973
1974     my ($revision1, $revision2);
1975     if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1976     {
1977         $revision1 = $state->{opt}{r}[0];
1978         $revision2 = $state->{opt}{r}[1];
1979     } else {
1980         $revision1 = $state->{opt}{r};
1981     }
1982
1983     $log->debug("Diffing revisions " .
1984                 ( defined($revision1) ? $revision1 : "[NULL]" ) .
1985                 " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1986
1987     # Grab a handle to the SQLite db and do any necessary updates
1988     my $updater;
1989     $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1990     $updater->update();
1991
1992     # if no files were specified, we need to work out what files we should
1993     # be providing status on ...
1994     argsfromdir($updater);
1995
1996     my($foundDiff);
1997
1998     # foreach file specified on the command line ...
1999     foreach my $argFilename ( @{$state->{args}} )
2000     {
2001         my($filename) = filecleanup($argFilename);
2002
2003         my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
2004
2005         my $wrev = revparse($filename);
2006
2007         # Priority for revision1:
2008         #  1. First -r (missing file: check -N)
2009         #  2. wrev from client's Entry line
2010         #      - missing line/file: check -N
2011         #      - "0": added file not committed (empty contents for rev1)
2012         #      - Prefixed with dash (to be removed): check -N
2013
2014         if ( defined ( $revision1 ) )
2015         {
2016             $meta1 = $updater->getmeta($filename, $revision1);
2017         }
2018         elsif( defined($wrev) && $wrev ne "0" )
2019         {
2020             my($rmRev)=$wrev;
2021             $rmRev=~s/^-//;
2022             $meta1 = $updater->getmeta($filename, $rmRev);
2023         }
2024         if ( !defined($meta1) ||
2025              $meta1->{filehash} eq "deleted" )
2026         {
2027             if( !exists($state->{opt}{N}) )
2028             {
2029                 if(!defined($revision1))
2030                 {
2031                     print "E File $filename at revision $revision1 doesn't exist\n";
2032                 }
2033                 next;
2034             }
2035             elsif( !defined($meta1) )
2036             {
2037                 $meta1 = {
2038                     name => $filename,
2039                     revision => '0',
2040                     filehash => 'deleted'
2041                 };
2042             }
2043         }
2044
2045         # Priority for revision2:
2046         #  1. Second -r (missing file: check -N)
2047         #  2. Modified file contents from client
2048         #  3. wrev from client's Entry line
2049         #      - missing line/file: check -N
2050         #      - Prefixed with dash (to be removed): check -N
2051
2052         # if we have a second -r switch, use it too
2053         if ( defined ( $revision2 ) )
2054         {
2055             $meta2 = $updater->getmeta($filename, $revision2);
2056         }
2057         elsif(defined($state->{entries}{$filename}{modified_filename}))
2058         {
2059             $file2 = $state->{entries}{$filename}{modified_filename};
2060             $meta2 = {
2061                 name => $filename,
2062                 revision => '0',
2063                 filehash => 'modified'
2064             };
2065         }
2066         elsif( defined($wrev) && ($wrev!~/^-/) )
2067         {
2068             if(!defined($revision1))  # no revision and no modifications:
2069             {
2070                 next;
2071             }
2072             $meta2 = $updater->getmeta($filename, $wrev);
2073         }
2074         if(!defined($file2))
2075         {
2076             if ( !defined($meta2) ||
2077                  $meta2->{filehash} eq "deleted" )
2078             {
2079                 if( !exists($state->{opt}{N}) )
2080                 {
2081                     if(!defined($revision2))
2082                     {
2083                         print "E File $filename at revision $revision2 doesn't exist\n";
2084                     }
2085                     next;
2086                 }
2087                 elsif( !defined($meta2) )
2088                 {
2089                     $meta2 = {
2090                         name => $filename,
2091                         revision => '0',
2092                         filehash => 'deleted'
2093                     };
2094                 }
2095             }
2096         }
2097
2098         if( $meta1->{filehash} eq $meta2->{filehash} )
2099         {
2100             $log->info("unchanged $filename");
2101             next;
2102         }
2103
2104         # Retrieve revision contents:
2105         ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2106         transmitfile($meta1->{filehash}, { targetfile => $file1 });
2107
2108         if(!defined($file2))
2109         {
2110             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2111             transmitfile($meta2->{filehash}, { targetfile => $file2 });
2112         }
2113
2114         # Generate the actual diff:
2115         print "M Index: $argFilename\n";
2116         print "M =======" . ( "=" x 60 ) . "\n";
2117         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
2118         if ( defined ( $meta1 ) && $meta1->{revision} ne "0" )
2119         {
2120             print "M retrieving revision $meta1->{revision}\n"
2121         }
2122         if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
2123         {
2124             print "M retrieving revision $meta2->{revision}\n"
2125         }
2126         print "M diff ";
2127         foreach my $opt ( keys %{$state->{opt}} )
2128         {
2129             if ( ref $state->{opt}{$opt} eq "ARRAY" )
2130             {
2131                 foreach my $value ( @{$state->{opt}{$opt}} )
2132                 {
2133                     print "-$opt $value ";
2134                 }
2135             } else {
2136                 print "-$opt ";
2137                 if ( defined ( $state->{opt}{$opt} ) )
2138                 {
2139                     print "$state->{opt}{$opt} "
2140                 }
2141             }
2142         }
2143         print "$argFilename\n";
2144
2145         $log->info("Diffing $filename -r $meta1->{revision} -r " .
2146                    ( $meta2->{revision} or "workingcopy" ));
2147
2148         # TODO: Use --label instead of -L because -L is no longer
2149         #  documented and may go away someday.  Not sure if there there are
2150         #  versions that only support -L, which would make this change risky?
2151         #  http://osdir.com/ml/bug-gnu-utils-gnu/2010-12/msg00060.html
2152         #    ("man diff" should actually document the best migration strategy,
2153         #  [current behavior, future changes, old compatibility issues
2154         #  or lack thereof, etc], not just stop mentioning the option...)
2155         # TODO: Real CVS seems to include a date in the label, before
2156         #  the revision part, without the keyword "revision".  The following
2157         #  has minimal changes compared to original versions of
2158         #  git-cvsserver.perl.  (Mostly tab vs space after filename.)
2159
2160         my (@diffCmd) = ( 'diff' );
2161         if ( exists($state->{opt}{N}) )
2162         {
2163             push @diffCmd,"-N";
2164         }
2165         if ( exists $state->{opt}{u} )
2166         {
2167             push @diffCmd,("-u","-L");
2168             if( $meta1->{filehash} eq "deleted" )
2169             {
2170                 push @diffCmd,"/dev/null";
2171             } else {
2172                 push @diffCmd,("$argFilename\trevision $meta1->{revision}");
2173             }
2174
2175             if( defined($meta2->{filehash}) )
2176             {
2177                 if( $meta2->{filehash} eq "deleted" )
2178                 {
2179                     push @diffCmd,("-L","/dev/null");
2180                 } else {
2181                     push @diffCmd,("-L",
2182                                    "$argFilename\trevision $meta2->{revision}");
2183                 }
2184             } else {
2185                 push @diffCmd,("-L","$argFilename\tworking copy");
2186             }
2187         }
2188         push @diffCmd,($file1,$file2);
2189         if(!open(DIFF,"-|",@diffCmd))
2190         {
2191             $log->warn("Unable to run diff: $!");
2192         }
2193         my($diffLine);
2194         while(defined($diffLine=<DIFF>))
2195         {
2196             print "M $diffLine";
2197             $foundDiff=1;
2198         }
2199         close(DIFF);
2200     }
2201
2202     if($foundDiff)
2203     {
2204         print "error  \n";
2205     }
2206     else
2207     {
2208         print "ok\n";
2209     }
2210 }
2211
2212 sub req_log
2213 {
2214     my ( $cmd, $data ) = @_;
2215
2216     argsplit("log");
2217
2218     $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
2219     #$log->debug("log state : " . Dumper($state));
2220
2221     my ( $revFilter );
2222     if ( defined ( $state->{opt}{r} ) )
2223     {
2224         $revFilter = $state->{opt}{r};
2225     }
2226
2227     # Grab a handle to the SQLite db and do any necessary updates
2228     my $updater;
2229     $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
2230     $updater->update();
2231
2232     # if no files were specified, we need to work out what files we
2233     # should be providing status on ...
2234     argsfromdir($updater);
2235
2236     # foreach file specified on the command line ...
2237     foreach my $filename ( @{$state->{args}} )
2238     {
2239         $filename = filecleanup($filename);
2240
2241         my $headmeta = $updater->getmeta($filename);
2242
2243         my ($revisions,$totalrevisions) = $updater->getlog($filename,
2244                                                            $revFilter);
2245
2246         next unless ( scalar(@$revisions) );
2247
2248         print "M \n";
2249         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
2250         print "M Working file: $filename\n";
2251         print "M head: $headmeta->{revision}\n";
2252         print "M branch:\n";
2253         print "M locks: strict\n";
2254         print "M access list:\n";
2255         print "M symbolic names:\n";
2256         print "M keyword substitution: kv\n";
2257         print "M total revisions: $totalrevisions;\tselected revisions: " .
2258               scalar(@$revisions) . "\n";
2259         print "M description:\n";
2260
2261         foreach my $revision ( @$revisions )
2262         {
2263             print "M ----------------------------\n";
2264             print "M revision $revision->{revision}\n";
2265             # reformat the date for log output
2266             if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and
2267                  defined($DATE_LIST->{$2}) )
2268             {
2269                 $revision->{modified} = sprintf('%04d/%02d/%02d %s',
2270                                             $3, $DATE_LIST->{$2}, $1, $4 );
2271             }
2272             $revision->{author} = cvs_author($revision->{author});
2273             print "M date: $revision->{modified};" .
2274                   "  author: $revision->{author};  state: " .
2275                   ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) .
2276                   ";  lines: +2 -3\n";
2277             my $commitmessage;
2278             $commitmessage = $updater->commitmessage($revision->{commithash});
2279             $commitmessage =~ s/^/M /mg;
2280             print $commitmessage . "\n";
2281         }
2282         print "M =======" . ( "=" x 70 ) . "\n";
2283     }
2284
2285     print "ok\n";
2286 }
2287
2288 sub req_annotate
2289 {
2290     my ( $cmd, $data ) = @_;
2291
2292     argsplit("annotate");
2293
2294     $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
2295     #$log->debug("status state : " . Dumper($state));
2296
2297     # Grab a handle to the SQLite db and do any necessary updates
2298     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
2299     $updater->update();
2300
2301     # if no files were specified, we need to work out what files we should be providing annotate on ...
2302     argsfromdir($updater);
2303
2304     # we'll need a temporary checkout dir
2305     setupWorkTree();
2306
2307     $log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
2308
2309     # foreach file specified on the command line ...
2310     foreach my $filename ( @{$state->{args}} )
2311     {
2312         $filename = filecleanup($filename);
2313
2314         my $meta = $updater->getmeta($filename);
2315
2316         next unless ( $meta->{revision} );
2317
2318         # get all the commits that this file was in
2319         # in dense format -- aka skip dead revisions
2320         my $revisions   = $updater->gethistorydense($filename);
2321         my $lastseenin  = $revisions->[0][2];
2322
2323         # populate the temporary index based on the latest commit were we saw
2324         # the file -- but do it cheaply without checking out any files
2325         # TODO: if we got a revision from the client, use that instead
2326         # to look up the commithash in sqlite (still good to default to
2327         # the current head as we do now)
2328         system("git", "read-tree", $lastseenin);
2329         unless ($? == 0)
2330         {
2331             print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
2332             return;
2333         }
2334         $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
2335
2336         # do a checkout of the file
2337         system('git', 'checkout-index', '-f', '-u', $filename);
2338         unless ($? == 0) {
2339             print "E error running git-checkout-index -f -u $filename : $!\n";
2340             return;
2341         }
2342
2343         $log->info("Annotate $filename");
2344
2345         # Prepare a file with the commits from the linearized
2346         # history that annotate should know about. This prevents
2347         # git-jsannotate telling us about commits we are hiding
2348         # from the client.
2349
2350         my $a_hints = "$work->{workDir}/.annotate_hints";
2351         if (!open(ANNOTATEHINTS, '>', $a_hints)) {
2352             print "E failed to open '$a_hints' for writing: $!\n";
2353             return;
2354         }
2355         for (my $i=0; $i < @$revisions; $i++)
2356         {
2357             print ANNOTATEHINTS $revisions->[$i][2];
2358             if ($i+1 < @$revisions) { # have we got a parent?
2359                 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
2360             }
2361             print ANNOTATEHINTS "\n";
2362         }
2363
2364         print ANNOTATEHINTS "\n";
2365         close ANNOTATEHINTS
2366             or (print "E failed to write $a_hints: $!\n"), return;
2367
2368         my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
2369         if (!open(ANNOTATE, "-|", @cmd)) {
2370             print "E error invoking ". join(' ',@cmd) .": $!\n";
2371             return;
2372         }
2373         my $metadata = {};
2374         print "E Annotations for $filename\n";
2375         print "E ***************\n";
2376         while ( <ANNOTATE> )
2377         {
2378             if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
2379             {
2380                 my $commithash = $1;
2381                 my $data = $2;
2382                 unless ( defined ( $metadata->{$commithash} ) )
2383                 {
2384                     $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
2385                     $metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
2386                     $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
2387                 }
2388                 printf("M %-7s      (%-8s %10s): %s\n",
2389                     $metadata->{$commithash}{revision},
2390                     $metadata->{$commithash}{author},
2391                     $metadata->{$commithash}{modified},
2392                     $data
2393                 );
2394             } else {
2395                 $log->warn("Error in annotate output! LINE: $_");
2396                 print "E Annotate error \n";
2397                 next;
2398             }
2399         }
2400         close ANNOTATE;
2401     }
2402
2403     # done; get out of the tempdir
2404     cleanupWorkTree();
2405
2406     print "ok\n";
2407
2408 }
2409
2410 # This method takes the state->{arguments} array and produces two new arrays.
2411 # The first is $state->{args} which is everything before the '--' argument, and
2412 # the second is $state->{files} which is everything after it.
2413 sub argsplit
2414 {
2415     $state->{args} = [];
2416     $state->{files} = [];
2417     $state->{opt} = {};
2418
2419     return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
2420
2421     my $type = shift;
2422
2423     if ( defined($type) )
2424     {
2425         my $opt = {};
2426         $opt = { A => 0, N => 0, P => 0, R => 0, c => 0, f => 0, l => 0, n => 0, p => 0, s => 0, r => 1, D => 1, d => 1, k => 1, j => 1, } if ( $type eq "co" );
2427         $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
2428         $opt = { A => 0, P => 0, C => 0, d => 0, f => 0, l => 0, R => 0, p => 0, k => 1, r => 1, D => 1, j => 1, I => 1, W => 1 } if ( $type eq "update" );
2429         $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2, N => 0 } if ( $type eq "diff" );
2430         $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
2431         $opt = { k => 1, m => 1 } if ( $type eq "add" );
2432         $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
2433         $opt = { l => 0, b => 0, h => 0, R => 0, t => 0, N => 0, S => 0, r => 1, d => 1, s => 1, w => 1 } if ( $type eq "log" );
2434
2435
2436         while ( scalar ( @{$state->{arguments}} ) > 0 )
2437         {
2438             my $arg = shift @{$state->{arguments}};
2439
2440             next if ( $arg eq "--" );
2441             next unless ( $arg =~ /\S/ );
2442
2443             # if the argument looks like a switch
2444             if ( $arg =~ /^-(\w)(.*)/ )
2445             {
2446                 # if it's a switch that takes an argument
2447                 if ( $opt->{$1} )
2448                 {
2449                     # If this switch has already been provided
2450                     if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
2451                     {
2452                         $state->{opt}{$1} = [ $state->{opt}{$1} ];
2453                         if ( length($2) > 0 )
2454                         {
2455                             push @{$state->{opt}{$1}},$2;
2456                         } else {
2457                             push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
2458                         }
2459                     } else {
2460                         # if there's extra data in the arg, use that as the argument for the switch
2461                         if ( length($2) > 0 )
2462                         {
2463                             $state->{opt}{$1} = $2;
2464                         } else {
2465                             $state->{opt}{$1} = shift @{$state->{arguments}};
2466                         }
2467                     }
2468                 } else {
2469                     $state->{opt}{$1} = undef;
2470                 }
2471             }
2472             else
2473             {
2474                 push @{$state->{args}}, $arg;
2475             }
2476         }
2477     }
2478     else
2479     {
2480         my $mode = 0;
2481
2482         foreach my $value ( @{$state->{arguments}} )
2483         {
2484             if ( $value eq "--" )
2485             {
2486                 $mode++;
2487                 next;
2488             }
2489             push @{$state->{args}}, $value if ( $mode == 0 );
2490             push @{$state->{files}}, $value if ( $mode == 1 );
2491         }
2492     }
2493 }
2494
2495 # Used by argsfromdir
2496 sub expandArg
2497 {
2498     my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
2499
2500     my $fullPath = filecleanup($path);
2501
2502       # Is it a directory?
2503     if( defined($state->{dirMap}{$fullPath}) ||
2504         defined($state->{dirMap}{"$fullPath/"}) )
2505     {
2506           # It is a directory in the user's sandbox.
2507         $isDir=1;
2508
2509         if(defined($state->{entries}{$fullPath}))
2510         {
2511             $log->fatal("Inconsistent file/dir type");
2512             die "Inconsistent file/dir type";
2513         }
2514     }
2515     elsif(defined($state->{entries}{$fullPath}))
2516     {
2517           # It is a file in the user's sandbox.
2518         $isDir=0;
2519     }
2520     my($revDirMap,$otherRevDirMap);
2521     if(!defined($isDir) || $isDir)
2522     {
2523           # Resolve version tree for sticky tag:
2524           # (for now we only want list of files for the version, not
2525           # particular versions of those files: assume it is a directory
2526           # for the moment; ignore Entry's stick tag)
2527
2528           # Order of precedence of sticky tags:
2529           #    -A       [head]
2530           #    -r /tag/
2531           #    [file entry sticky tag, but that is only relevant to files]
2532           #    [the tag specified in dir req_Sticky]
2533           #    [the tag specified in a parent dir req_Sticky]
2534           #    [head]
2535           # Also, -r may appear twice (for diff).
2536           #
2537           # FUTURE: When/if -j (merges) are supported, we also
2538           #  need to add relevant files from one or two
2539           #  versions specified with -j.
2540
2541         if(exists($state->{opt}{A}))
2542         {
2543             $revDirMap=$updater->getRevisionDirMap();
2544         }
2545         elsif( defined($state->{opt}{r}) and
2546                ref $state->{opt}{r} eq "ARRAY" )
2547         {
2548             $revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
2549             $otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
2550         }
2551         elsif(defined($state->{opt}{r}))
2552         {
2553             $revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
2554         }
2555         else
2556         {
2557             my($sticky)=getDirStickyInfo($fullPath);
2558             $revDirMap=$updater->getRevisionDirMap($sticky->{tag});
2559         }
2560
2561           # Is it a directory?
2562         if( defined($revDirMap->{$fullPath}) ||
2563             defined($otherRevDirMap->{$fullPath}) )
2564         {
2565             $isDir=1;
2566         }
2567     }
2568
2569       # What to do with it?
2570     if(!$isDir)
2571     {
2572         $outNameMap->{$fullPath}=1;
2573     }
2574     else
2575     {
2576         $outDirMap->{$fullPath}=1;
2577
2578         if(defined($revDirMap->{$fullPath}))
2579         {
2580             addDirMapFiles($updater,$outNameMap,$outDirMap,
2581                            $revDirMap->{$fullPath});
2582         }
2583         if( defined($otherRevDirMap) &&
2584             defined($otherRevDirMap->{$fullPath}) )
2585         {
2586             addDirMapFiles($updater,$outNameMap,$outDirMap,
2587                            $otherRevDirMap->{$fullPath});
2588         }
2589     }
2590 }
2591
2592 # Used by argsfromdir
2593 # Add entries from dirMap to outNameMap.  Also recurse into entries
2594 # that are subdirectories.
2595 sub addDirMapFiles
2596 {
2597     my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
2598
2599     my($fullName);
2600     foreach $fullName (keys(%$dirMap))
2601     {
2602         my $cleanName=$fullName;
2603         if(defined($state->{prependdir}))
2604         {
2605             if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
2606             {
2607                 $log->fatal("internal error stripping prependdir");
2608                 die "internal error stripping prependdir";
2609             }
2610         }
2611
2612         if($dirMap->{$fullName} eq "F")
2613         {
2614             $outNameMap->{$cleanName}=1;
2615         }
2616         elsif($dirMap->{$fullName} eq "D")
2617         {
2618             if(!$state->{opt}{l})
2619             {
2620                 expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
2621             }
2622         }
2623         else
2624         {
2625             $log->fatal("internal error in addDirMapFiles");
2626             die "internal error in addDirMapFiles";
2627         }
2628     }
2629 }
2630
2631 # This method replaces $state->{args} with a directory-expanded
2632 # list of all relevant filenames (recursively unless -d), based
2633 # on $state->{entries}, and the "current" list of files in
2634 # each directory.  "Current" files as determined by
2635 # either the requested (-r/-A) or "req_Sticky" version of
2636 # that directory.
2637 #    Both the input args and the new output args are relative
2638 # to the cvs-client's CWD, although some of the internal
2639 # computations are relative to the top of the project.
2640 sub argsfromdir
2641 {
2642     my $updater = shift;
2643
2644     # Notes about requirements for specific callers:
2645     #   update # "standard" case (entries; a single -r/-A/default; -l)
2646     #          # Special case: -d for create missing directories.
2647     #   diff # 0 or 1 -r's: "standard" case.
2648     #        # 2 -r's: We could ignore entries (just use the two -r's),
2649     #        # but it doesn't really matter.
2650     #   annotate # "standard" case
2651     #   log # Punting: log -r has a more complex non-"standard"
2652     #       # meaning, and we don't currently try to support log'ing
2653     #       # branches at all (need a lot of work to
2654     #       # support CVS-consistent branch relative version
2655     #       # numbering).
2656 #HERE: But we still want to expand directories.  Maybe we should
2657 #  essentially force "-A".
2658     #   status # "standard", except that -r/-A/default are not possible.
2659     #          # Mostly only used to expand entries only)
2660     #
2661     # Don't use argsfromdir at all:
2662     #   add # Explicit arguments required.  Directory args imply add
2663     #       # the directory itself, not the files in it.
2664     #   co  # Obtain list directly.
2665     #   remove # HERE: TEST: MAYBE client does the recursion for us,
2666     #          # since it only makes sense to remove stuff already in
2667     #          # the sandobx?
2668     #   ci # HERE: Similar to remove...
2669     #      # Don't try to implement the confusing/weird
2670     #      # ci -r bug er.."feature".
2671
2672     if(scalar(@{$state->{args}})==0)
2673     {
2674         $state->{args} = [ "." ];
2675     }
2676     my %allArgs;
2677     my %allDirs;
2678     for my $file (@{$state->{args}})
2679     {
2680         expandArg($updater,\%allArgs,\%allDirs,$file);
2681     }
2682
2683     # Include any entries from sandbox.  Generally client won't
2684     # send entries that shouldn't be used.
2685     foreach my $file (keys %{$state->{entries}})
2686     {
2687         $allArgs{remove_prependdir($file)} = 1;
2688     }
2689
2690     $state->{dirArgs} = \%allDirs;
2691     $state->{args} = [
2692         sort {
2693                 # Sort priority: by directory depth, then actual file name:
2694             my @piecesA=split('/',$a);
2695             my @piecesB=split('/',$b);
2696
2697             my $count=scalar(@piecesA);
2698             my $tmp=scalar(@piecesB);
2699             return $count<=>$tmp if($count!=$tmp);
2700
2701             for($tmp=0;$tmp<$count;$tmp++)
2702             {
2703                 if($piecesA[$tmp] ne $piecesB[$tmp])
2704                 {
2705                     return $piecesA[$tmp] cmp $piecesB[$tmp]
2706                 }
2707             }
2708             return 0;
2709         } keys(%allArgs) ];
2710 }
2711
2712 ## look up directory sticky tag, of either fullPath or a parent:
2713 sub getDirStickyInfo
2714 {
2715     my($fullPath)=@_;
2716
2717     $fullPath=~s%/+$%%;
2718     while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
2719     {
2720         $fullPath=~s%/?[^/]*$%%;
2721     }
2722
2723     if( !defined($state->{dirMap}{"$fullPath/"}) &&
2724         ( $fullPath eq "" ||
2725           $fullPath eq "." ) )
2726     {
2727         return $state->{dirMap}{""}{stickyInfo};
2728     }
2729     else
2730     {
2731         return $state->{dirMap}{"$fullPath/"}{stickyInfo};
2732     }
2733 }
2734
2735 # Resolve precedence of various ways of specifying which version of
2736 # a file you want.  Returns undef (for default head), or a ref to a hash
2737 # that contains "tag" and/or "date" keys.
2738 sub resolveStickyInfo
2739 {
2740     my($filename,$stickyTag,$stickyDate,$reset) = @_;
2741
2742     # Order of precedence of sticky tags:
2743     #    -A       [head]
2744     #    -r /tag/
2745     #    [file entry sticky tag]
2746     #    [the tag specified in dir req_Sticky]
2747     #    [the tag specified in a parent dir req_Sticky]
2748     #    [head]
2749
2750     my $result;
2751     if($reset)
2752     {
2753         # $result=undef;
2754     }
2755     elsif( defined($stickyTag) && $stickyTag ne "" )
2756            # || ( defined($stickyDate) && $stickyDate ne "" )   # TODO
2757     {
2758         $result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
2759
2760         # TODO: Convert -D value into the form 2011.04.10.04.46.57,
2761         #   similar to an entry line's sticky date, without the D prefix.
2762         #   It sometimes (always?) arrives as something more like
2763         #   '10 Apr 2011 04:46:57 -0000'...
2764         # $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
2765     }
2766     elsif( defined($state->{entries}{$filename}) &&
2767            defined($state->{entries}{$filename}{tag_or_date}) &&
2768            $state->{entries}{$filename}{tag_or_date} ne "" )
2769     {
2770         my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
2771         if($tagOrDate=~/^T([^ ]+)\s*$/)
2772         {
2773             $result = { 'tag' => $1 };
2774         }
2775         elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
2776         {
2777             $result= { 'date' => $1 };
2778         }
2779         else
2780         {
2781             die "Unknown tag_or_date format\n";
2782         }
2783     }
2784     else
2785     {
2786         $result=getDirStickyInfo($filename);
2787     }
2788
2789     return $result;
2790 }
2791
2792 # Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into
2793 # a form appropriate for the sticky tag field of an Entries
2794 # line (field index 5, 0-based).
2795 sub getStickyTagOrDate
2796 {
2797     my($stickyInfo)=@_;
2798
2799     my $result;
2800     if(defined($stickyInfo) && defined($stickyInfo->{tag}))
2801     {
2802         $result="T$stickyInfo->{tag}";
2803     }
2804     # TODO: When/if we actually pick versions by {date} properly,
2805     #   also handle it here:
2806     #   "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").
2807     else
2808     {
2809         $result="";
2810     }
2811
2812     return $result;
2813 }
2814
2815 # This method cleans up the $state variable after a command that uses arguments has run
2816 sub statecleanup
2817 {
2818     $state->{files} = [];
2819     $state->{dirArgs} = {};
2820     $state->{args} = [];
2821     $state->{arguments} = [];
2822     $state->{entries} = {};
2823     $state->{dirMap} = {};
2824 }
2825
2826 # Return working directory CVS revision "1.X" out
2827 # of the the working directory "entries" state, for the given filename.
2828 # This is prefixed with a dash if the file is scheduled for removal
2829 # when it is committed.
2830 sub revparse
2831 {
2832     my $filename = shift;
2833
2834     return $state->{entries}{$filename}{revision};
2835 }
2836
2837 # This method takes a file hash and does a CVS "file transfer".  Its
2838 # exact behaviour depends on a second, optional hash table argument:
2839 # - If $options->{targetfile}, dump the contents to that file;
2840 # - If $options->{print}, use M/MT to transmit the contents one line
2841 #   at a time;
2842 # - Otherwise, transmit the size of the file, followed by the file
2843 #   contents.
2844 sub transmitfile
2845 {
2846     my $filehash = shift;
2847     my $options = shift;
2848
2849     if ( defined ( $filehash ) and $filehash eq "deleted" )
2850     {
2851         $log->warn("filehash is 'deleted'");
2852         return;
2853     }
2854
2855     die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
2856
2857     my $type = `git cat-file -t $filehash`;
2858     chomp $type;
2859
2860     die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2861
2862     my $size = `git cat-file -s $filehash`;
2863     chomp $size;
2864
2865     $log->debug("transmitfile($filehash) size=$size, type=$type");
2866
2867     if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
2868     {
2869         if ( defined ( $options->{targetfile} ) )
2870         {
2871             my $targetfile = $options->{targetfile};
2872             open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2873             print NEWFILE $_ while ( <$fh> );
2874             close NEWFILE or die("Failed to write '$targetfile': $!");
2875         } elsif ( defined ( $options->{print} ) && $options->{print} ) {
2876             while ( <$fh> ) {
2877                 if( /\n\z/ ) {
2878                     print 'M ', $_;
2879                 } else {
2880                     print 'MT text ', $_, "\n";
2881                 }
2882             }
2883         } else {
2884             print "$size\n";
2885             print while ( <$fh> );
2886         }
2887         close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
2888     } else {
2889         die("Couldn't execute git-cat-file");
2890     }
2891 }
2892
2893 # This method takes a file name, and returns ( $dirpart, $filepart ) which
2894 # refers to the directory portion and the file portion of the filename
2895 # respectively
2896 sub filenamesplit
2897 {
2898     my $filename = shift;
2899     my $fixforlocaldir = shift;
2900
2901     my ( $filepart, $dirpart ) = ( $filename, "." );
2902     ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2903     $dirpart .= "/";
2904
2905     if ( $fixforlocaldir )
2906     {
2907         $dirpart =~ s/^$state->{prependdir}//;
2908     }
2909
2910     return ( $filepart, $dirpart );
2911 }
2912
2913 # Cleanup various junk in filename (try to canonicalize it), and
2914 # add prependdir to accomodate running CVS client from a
2915 # subdirectory (so the output is relative to top directory of the project).
2916 sub filecleanup
2917 {
2918     my $filename = shift;
2919
2920     return undef unless(defined($filename));
2921     if ( $filename =~ /^\// )
2922     {
2923         print "E absolute filenames '$filename' not supported by server\n";
2924         return undef;
2925     }
2926
2927     if($filename eq ".")
2928     {
2929         $filename="";
2930     }
2931     $filename =~ s/^\.\///g;
2932     $filename =~ s%/+%/%g;
2933     $filename = $state->{prependdir} . $filename;
2934     $filename =~ s%/$%%;
2935     return $filename;
2936 }
2937
2938 # Remove prependdir from the path, so that is is relative to the directory
2939 # the CVS client was started from, rather than the top of the project.
2940 # Essentially the inverse of filecleanup().
2941 sub remove_prependdir
2942 {
2943     my($path) = @_;
2944     if(defined($state->{prependdir}) && $state->{prependdir} ne "")
2945     {
2946         my($pre)=$state->{prependdir};
2947         $pre=~s%/$%%;
2948         if(!($path=~s%^\Q$pre\E/?%%))
2949         {
2950             $log->fatal("internal error missing prependdir");
2951             die("internal error missing prependdir");
2952         }
2953     }
2954     return $path;
2955 }
2956
2957 sub validateGitDir
2958 {
2959     if( !defined($state->{CVSROOT}) )
2960     {
2961         print "error 1 CVSROOT not specified\n";
2962         cleanupWorkTree();
2963         exit;
2964     }
2965     if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
2966     {
2967         print "error 1 Internally inconsistent CVSROOT\n";
2968         cleanupWorkTree();
2969         exit;
2970     }
2971 }
2972
2973 # Setup working directory in a work tree with the requested version
2974 # loaded in the index.
2975 sub setupWorkTree
2976 {
2977     my ($ver) = @_;
2978
2979     validateGitDir();
2980
2981     if( ( defined($work->{state}) && $work->{state} != 1 ) ||
2982         defined($work->{tmpDir}) )
2983     {
2984         $log->warn("Bad work tree state management");
2985         print "error 1 Internal setup multiple work trees without cleanup\n";
2986         cleanupWorkTree();
2987         exit;
2988     }
2989
2990     $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
2991
2992     if( !defined($work->{index}) )
2993     {
2994         (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2995     }
2996
2997     chdir $work->{workDir} or
2998         die "Unable to chdir to $work->{workDir}\n";
2999
3000     $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
3001
3002     $ENV{GIT_WORK_TREE} = ".";
3003     $ENV{GIT_INDEX_FILE} = $work->{index};
3004     $work->{state} = 2;
3005
3006     if($ver)
3007     {
3008         system("git","read-tree",$ver);
3009         unless ($? == 0)
3010         {
3011             $log->warn("Error running git-read-tree");
3012             die "Error running git-read-tree $ver in $work->{workDir} $!\n";
3013         }
3014     }
3015     # else # req_annotate reads tree for each file
3016 }
3017
3018 # Ensure current directory is in some kind of working directory,
3019 # with a recent version loaded in the index.
3020 sub ensureWorkTree
3021 {
3022     if( defined($work->{tmpDir}) )
3023     {
3024         $log->warn("Bad work tree state management [ensureWorkTree()]");
3025         print "error 1 Internal setup multiple dirs without cleanup\n";
3026         cleanupWorkTree();
3027         exit;
3028     }
3029     if( $work->{state} )
3030     {
3031         return;
3032     }
3033
3034     validateGitDir();
3035
3036     if( !defined($work->{emptyDir}) )
3037     {
3038         $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
3039     }
3040     chdir $work->{emptyDir} or
3041         die "Unable to chdir to $work->{emptyDir}\n";
3042
3043     my $ver = `git show-ref -s refs/heads/$state->{module}`;
3044     chomp $ver;
3045     if ($ver !~ /^[0-9a-f]{40}$/)
3046     {
3047         $log->warn("Error from git show-ref -s refs/head$state->{module}");
3048         print "error 1 cannot find the current HEAD of module";
3049         cleanupWorkTree();
3050         exit;
3051     }
3052
3053     if( !defined($work->{index}) )
3054     {
3055         (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
3056     }
3057
3058     $ENV{GIT_WORK_TREE} = ".";
3059     $ENV{GIT_INDEX_FILE} = $work->{index};
3060     $work->{state} = 1;
3061
3062     system("git","read-tree",$ver);
3063     unless ($? == 0)
3064     {
3065         die "Error running git-read-tree $ver $!\n";
3066     }
3067 }
3068
3069 # Cleanup working directory that is not needed any longer.
3070 sub cleanupWorkTree
3071 {
3072     if( ! $work->{state} )
3073     {
3074         return;
3075     }
3076
3077     chdir "/" or die "Unable to chdir '/'\n";
3078
3079     if( defined($work->{workDir}) )
3080     {
3081         rmtree( $work->{workDir} );
3082         undef $work->{workDir};
3083     }
3084     undef $work->{state};
3085 }
3086
3087 # Setup a temporary directory (not a working tree), typically for
3088 # merging dirty state as in req_update.
3089 sub setupTmpDir
3090 {
3091     $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
3092     chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
3093
3094     return $work->{tmpDir};
3095 }
3096
3097 # Clean up a previously setupTmpDir.  Restore previous work tree if
3098 # appropriate.
3099 sub cleanupTmpDir
3100 {
3101     if ( !defined($work->{tmpDir}) )
3102     {
3103         $log->warn("cleanup tmpdir that has not been setup");
3104         die "Cleanup tmpDir that has not been setup\n";
3105     }
3106     if( defined($work->{state}) )
3107     {
3108         if( $work->{state} == 1 )
3109         {
3110             chdir $work->{emptyDir} or
3111                 die "Unable to chdir to $work->{emptyDir}\n";
3112         }
3113         elsif( $work->{state} == 2 )
3114         {
3115             chdir $work->{workDir} or
3116                 die "Unable to chdir to $work->{emptyDir}\n";
3117         }
3118         else
3119         {
3120             $log->warn("Inconsistent work dir state");
3121             die "Inconsistent work dir state\n";
3122         }
3123     }
3124     else
3125     {
3126         chdir "/" or die "Unable to chdir '/'\n";
3127     }
3128 }
3129
3130 # Given a path, this function returns a string containing the kopts
3131 # that should go into that path's Entries line.  For example, a binary
3132 # file should get -kb.
3133 sub kopts_from_path
3134 {
3135     my ($path, $srcType, $name) = @_;
3136
3137     if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
3138          $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
3139     {
3140         my ($val) = check_attr( "text", $path );
3141         if ( $val eq "unspecified" )
3142         {
3143             $val = check_attr( "crlf", $path );
3144         }
3145         if ( $val eq "unset" )
3146         {
3147             return "-kb"
3148         }
3149         elsif ( check_attr( "eol", $path ) ne "unspecified" ||
3150                 $val eq "set" || $val eq "input" )
3151         {
3152             return "";
3153         }
3154         else
3155         {
3156             $log->info("Unrecognized check_attr crlf $path : $val");
3157         }
3158     }
3159
3160     if ( defined ( $cfg->{gitcvs}{allbinary} ) )
3161     {
3162         if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
3163         {
3164             return "-kb";
3165         }
3166         elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
3167         {
3168             if( is_binary($srcType,$name) )
3169             {
3170                 $log->debug("... as binary");
3171                 return "-kb";
3172             }
3173             else
3174             {
3175                 $log->debug("... as text");
3176             }
3177         }
3178     }
3179     # Return "" to give no special treatment to any path
3180     return "";
3181 }
3182
3183 sub check_attr
3184 {
3185     my ($attr,$path) = @_;
3186     ensureWorkTree();
3187     if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
3188     {
3189         my $val = <$fh>;
3190         close $fh;
3191         $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
3192         return $val;
3193     }
3194     else
3195     {
3196         return undef;
3197     }
3198 }
3199
3200 # This should have the same heuristics as convert.c:is_binary() and related.
3201 # Note that the bare CR test is done by callers in convert.c.
3202 sub is_binary
3203 {
3204     my ($srcType,$name) = @_;
3205     $log->debug("is_binary($srcType,$name)");
3206
3207     # Minimize amount of interpreted code run in the inner per-character
3208     # loop for large files, by totalling each character value and
3209     # then analyzing the totals.
3210     my @counts;
3211     my $i;
3212     for($i=0;$i<256;$i++)
3213     {
3214         $counts[$i]=0;
3215     }
3216
3217     my $fh = open_blob_or_die($srcType,$name);
3218     my $line;
3219     while( defined($line=<$fh>) )
3220     {
3221         # Any '\0' and bare CR are considered binary.
3222         if( $line =~ /\0|(\r[^\n])/ )
3223         {
3224             close($fh);
3225             return 1;
3226         }
3227
3228         # Count up each character in the line:
3229         my $len=length($line);
3230         for($i=0;$i<$len;$i++)
3231         {
3232             $counts[ord(substr($line,$i,1))]++;
3233         }
3234     }
3235     close $fh;
3236
3237     # Don't count CR and LF as either printable/nonprintable
3238     $counts[ord("\n")]=0;
3239     $counts[ord("\r")]=0;
3240
3241     # Categorize individual character count into printable and nonprintable:
3242     my $printable=0;
3243     my $nonprintable=0;
3244     for($i=0;$i<256;$i++)
3245     {
3246         if( $i < 32 &&
3247             $i != ord("\b") &&
3248             $i != ord("\t") &&
3249             $i != 033 &&       # ESC
3250             $i != 014 )        # FF
3251         {
3252             $nonprintable+=$counts[$i];
3253         }
3254         elsif( $i==127 )  # DEL
3255         {
3256             $nonprintable+=$counts[$i];
3257         }
3258         else
3259         {
3260             $printable+=$counts[$i];
3261         }
3262     }
3263
3264     return ($printable >> 7) < $nonprintable;
3265 }
3266
3267 # Returns open file handle.  Possible invocations:
3268 #  - open_blob_or_die("file",$filename);
3269 #  - open_blob_or_die("sha1",$filehash);
3270 sub open_blob_or_die
3271 {
3272     my ($srcType,$name) = @_;
3273     my ($fh);
3274     if( $srcType eq "file" )
3275     {
3276         if( !open $fh,"<",$name )
3277         {
3278             $log->warn("Unable to open file $name: $!");
3279             die "Unable to open file $name: $!\n";
3280         }
3281     }
3282     elsif( $srcType eq "sha1" )
3283     {
3284         unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{40}$/ )
3285         {
3286             $log->warn("Need filehash");
3287             die "Need filehash\n";
3288         }
3289
3290         my $type = `git cat-file -t $name`;
3291         chomp $type;
3292
3293         unless ( defined ( $type ) and $type eq "blob" )
3294         {
3295             $log->warn("Invalid type '$type' for '$name'");
3296             die ( "Invalid type '$type' (expected 'blob')" )
3297         }
3298
3299         my $size = `git cat-file -s $name`;
3300         chomp $size;
3301
3302         $log->debug("open_blob_or_die($name) size=$size, type=$type");
3303
3304         unless( open $fh, '-|', "git", "cat-file", "blob", $name )
3305         {
3306             $log->warn("Unable to open sha1 $name");
3307             die "Unable to open sha1 $name\n";
3308         }
3309     }
3310     else
3311     {
3312         $log->warn("Unknown type of blob source: $srcType");
3313         die "Unknown type of blob source: $srcType\n";
3314     }
3315     return $fh;
3316 }
3317
3318 # Generate a CVS author name from Git author information, by taking the local
3319 # part of the email address and replacing characters not in the Portable
3320 # Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS
3321 # Login names are Unix login names, which should be restricted to this
3322 # character set.
3323 sub cvs_author
3324 {
3325     my $author_line = shift;
3326     (my $author) = $author_line =~ /<([^@>]*)/;
3327
3328     $author =~ s/[^-a-zA-Z0-9_.]/_/g;
3329     $author =~ s/^-/_/;
3330
3331     $author;
3332 }
3333
3334
3335 sub descramble
3336 {
3337     # This table is from src/scramble.c in the CVS source
3338     my @SHIFTS = (
3339         0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
3340         16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
3341         114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
3342         111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
3343         41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
3344         125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
3345         36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
3346         58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
3347         225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
3348         199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
3349         174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
3350         207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
3351         192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
3352         227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
3353         182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
3354         243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
3355     );
3356     my ($str) = @_;
3357
3358     # This should never happen, the same password format (A) has been
3359     # used by CVS since the beginning of time
3360     {
3361         my $fmt = substr($str, 0, 1);
3362         die "invalid password format `$fmt'" unless $fmt eq 'A';
3363     }
3364
3365     my @str = unpack "C*", substr($str, 1);
3366     my $ret = join '', map { chr $SHIFTS[$_] } @str;
3367     return $ret;
3368 }
3369
3370 # Test if the (deep) values of two references to a hash are the same.
3371 sub refHashEqual
3372 {
3373     my($v1,$v2) = @_;
3374
3375     my $out;
3376     if(!defined($v1))
3377     {
3378         if(!defined($v2))
3379         {
3380             $out=1;
3381         }
3382     }
3383     elsif( !defined($v2) ||
3384            scalar(keys(%{$v1})) != scalar(keys(%{$v2})) )
3385     {
3386         # $out=undef;
3387     }
3388     else
3389     {
3390         $out=1;
3391
3392         my $key;
3393         foreach $key (keys(%{$v1}))
3394         {
3395             if( !exists($v2->{$key}) ||
3396                 defined($v1->{$key}) ne defined($v2->{$key}) ||
3397                 ( defined($v1->{$key}) &&
3398                   $v1->{$key} ne $v2->{$key} ) )
3399             {
3400                $out=undef;
3401                last;
3402             }
3403         }
3404     }
3405
3406     return $out;
3407 }
3408
3409
3410 package GITCVS::log;
3411
3412 ####
3413 #### Copyright The Open University UK - 2006.
3414 ####
3415 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
3416 ####          Martin Langhoff <martin@laptop.org>
3417 ####
3418 ####
3419
3420 use strict;
3421 use warnings;
3422
3423 =head1 NAME
3424
3425 GITCVS::log
3426
3427 =head1 DESCRIPTION
3428
3429 This module provides very crude logging with a similar interface to
3430 Log::Log4perl
3431
3432 =head1 METHODS
3433
3434 =cut
3435
3436 =head2 new
3437
3438 Creates a new log object, optionally you can specify a filename here to
3439 indicate the file to log to. If no log file is specified, you can specify one
3440 later with method setfile, or indicate you no longer want logging with method
3441 nofile.
3442
3443 Until one of these methods is called, all log calls will buffer messages ready
3444 to write out.
3445
3446 =cut
3447 sub new
3448 {
3449     my $class = shift;
3450     my $filename = shift;
3451
3452     my $self = {};
3453
3454     bless $self, $class;
3455
3456     if ( defined ( $filename ) )
3457     {
3458         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3459     }
3460
3461     return $self;
3462 }
3463
3464 =head2 setfile
3465
3466 This methods takes a filename, and attempts to open that file as the log file.
3467 If successful, all buffered data is written out to the file, and any further
3468 logging is written directly to the file.
3469
3470 =cut
3471 sub setfile
3472 {
3473     my $self = shift;
3474     my $filename = shift;
3475
3476     if ( defined ( $filename ) )
3477     {
3478         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3479     }
3480
3481     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3482
3483     while ( my $line = shift @{$self->{buffer}} )
3484     {
3485         print {$self->{fh}} $line;
3486     }
3487 }
3488
3489 =head2 nofile
3490
3491 This method indicates no logging is going to be used. It flushes any entries in
3492 the internal buffer, and sets a flag to ensure no further data is put there.
3493
3494 =cut
3495 sub nofile
3496 {
3497     my $self = shift;
3498
3499     $self->{nolog} = 1;
3500
3501     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3502
3503     $self->{buffer} = [];
3504 }
3505
3506 =head2 _logopen
3507
3508 Internal method. Returns true if the log file is open, false otherwise.
3509
3510 =cut
3511 sub _logopen
3512 {
3513     my $self = shift;
3514
3515     return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
3516     return 0;
3517 }
3518
3519 =head2 debug info warn fatal
3520
3521 These four methods are wrappers to _log. They provide the actual interface for
3522 logging data.
3523
3524 =cut
3525 sub debug { my $self = shift; $self->_log("debug", @_); }
3526 sub info  { my $self = shift; $self->_log("info" , @_); }
3527 sub warn  { my $self = shift; $self->_log("warn" , @_); }
3528 sub fatal { my $self = shift; $self->_log("fatal", @_); }
3529
3530 =head2 _log
3531
3532 This is an internal method called by the logging functions. It generates a
3533 timestamp and pushes the logged line either to file, or internal buffer.
3534
3535 =cut
3536 sub _log
3537 {
3538     my $self = shift;
3539     my $level = shift;
3540
3541     return if ( $self->{nolog} );
3542
3543     my @time = localtime;
3544     my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
3545         $time[5] + 1900,
3546         $time[4] + 1,
3547         $time[3],
3548         $time[2],
3549         $time[1],
3550         $time[0],
3551         uc $level,
3552     );
3553
3554     if ( $self->_logopen )
3555     {
3556         print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
3557     } else {
3558         push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
3559     }
3560 }
3561
3562 =head2 DESTROY
3563
3564 This method simply closes the file handle if one is open
3565
3566 =cut
3567 sub DESTROY
3568 {
3569     my $self = shift;
3570
3571     if ( $self->_logopen )
3572     {
3573         close $self->{fh};
3574     }
3575 }
3576
3577 package GITCVS::updater;
3578
3579 ####
3580 #### Copyright The Open University UK - 2006.
3581 ####
3582 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
3583 ####          Martin Langhoff <martin@laptop.org>
3584 ####
3585 ####
3586
3587 use strict;
3588 use warnings;
3589 use DBI;
3590
3591 =head1 METHODS
3592
3593 =cut
3594
3595 =head2 new
3596
3597 =cut
3598 sub new
3599 {
3600     my $class = shift;
3601     my $config = shift;
3602     my $module = shift;
3603     my $log = shift;
3604
3605     die "Need to specify a git repository" unless ( defined($config) and -d $config );
3606     die "Need to specify a module" unless ( defined($module) );
3607
3608     $class = ref($class) || $class;
3609
3610     my $self = {};
3611
3612     bless $self, $class;
3613
3614     $self->{valid_tables} = {'revision' => 1,
3615                              'revision_ix1' => 1,
3616                              'revision_ix2' => 1,
3617                              'head' => 1,
3618                              'head_ix1' => 1,
3619                              'properties' => 1,
3620                              'commitmsgs' => 1};
3621
3622     $self->{module} = $module;
3623     $self->{git_path} = $config . "/";
3624
3625     $self->{log} = $log;
3626
3627     die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
3628
3629     # Stores full sha1's for various branch/tag names, abbreviations, etc:
3630     $self->{commitRefCache} = {};
3631
3632     $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
3633         $cfg->{gitcvs}{dbdriver} || "SQLite";
3634     $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
3635         $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
3636     $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
3637         $cfg->{gitcvs}{dbuser} || "";
3638     $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
3639         $cfg->{gitcvs}{dbpass} || "";
3640     $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
3641         $cfg->{gitcvs}{dbtablenameprefix} || "";
3642     my %mapping = ( m => $module,
3643                     a => $state->{method},
3644                     u => getlogin || getpwuid($<) || $<,
3645                     G => $self->{git_path},
3646                     g => mangle_dirname($self->{git_path}),
3647                     );
3648     $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
3649     $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
3650     $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
3651     $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
3652
3653     die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
3654     die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
3655     $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
3656                                 $self->{dbuser},
3657                                 $self->{dbpass});
3658     die "Error connecting to database\n" unless defined $self->{dbh};
3659
3660     $self->{tables} = {};
3661     foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
3662     {
3663         $self->{tables}{$table} = 1;
3664     }
3665
3666     # Construct the revision table if required
3667     # The revision table stores an entry for each file, each time that file
3668     # changes.
3669     #   numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
3670     # This is not sufficient to support "-r {commithash}" for any
3671     # files except files that were modified by that commit (also,
3672     # some places in the code ignore/effectively strip out -r in
3673     # some cases, before it gets passed to getmeta()).
3674     # The "filehash" field typically has a git blob hash, but can also
3675     # be set to "dead" to indicate that the given version of the file
3676     # should not exist in the sandbox.
3677     unless ( $self->{tables}{$self->tablename("revision")} )
3678     {
3679         my $tablename = $self->tablename("revision");
3680         my $ix1name = $self->tablename("revision_ix1");
3681         my $ix2name = $self->tablename("revision_ix2");
3682         $self->{dbh}->do("
3683             CREATE TABLE $tablename (
3684                 name       TEXT NOT NULL,
3685                 revision   INTEGER NOT NULL,
3686                 filehash   TEXT NOT NULL,
3687                 commithash TEXT NOT NULL,
3688                 author     TEXT NOT NULL,
3689                 modified   TEXT NOT NULL,
3690                 mode       TEXT NOT NULL
3691             )
3692         ");
3693         $self->{dbh}->do("
3694             CREATE INDEX $ix1name
3695             ON $tablename (name,revision)
3696         ");
3697         $self->{dbh}->do("
3698             CREATE INDEX $ix2name
3699             ON $tablename (name,commithash)
3700         ");
3701     }
3702
3703     # Construct the head table if required
3704     # The head table (along with the "last_commit" entry in the property
3705     # table) is the persisted working state of the "sub update" subroutine.
3706     # All of it's data is read entirely first, and completely recreated
3707     # last, every time "sub update" runs.
3708     # This is also used by "sub getmeta" when it is asked for the latest
3709     # version of a file (as opposed to some specific version).
3710     # Another way of thinking about it is as a single slice out of
3711     # "revisions", giving just the most recent revision information for
3712     # each file.
3713     unless ( $self->{tables}{$self->tablename("head")} )
3714     {
3715         my $tablename = $self->tablename("head");
3716         my $ix1name = $self->tablename("head_ix1");
3717         $self->{dbh}->do("
3718             CREATE TABLE $tablename (
3719                 name       TEXT NOT NULL,
3720                 revision   INTEGER NOT NULL,
3721                 filehash   TEXT NOT NULL,
3722                 commithash TEXT NOT NULL,
3723                 author     TEXT NOT NULL,
3724                 modified   TEXT NOT NULL,
3725                 mode       TEXT NOT NULL
3726             )
3727         ");
3728         $self->{dbh}->do("
3729             CREATE INDEX $ix1name
3730             ON $tablename (name)
3731         ");
3732     }
3733
3734     # Construct the properties table if required
3735     #  - "last_commit" - Used by "sub update".
3736     unless ( $self->{tables}{$self->tablename("properties")} )
3737     {
3738         my $tablename = $self->tablename("properties");
3739         $self->{dbh}->do("
3740             CREATE TABLE $tablename (
3741                 key        TEXT NOT NULL PRIMARY KEY,
3742                 value      TEXT
3743             )
3744         ");
3745     }
3746
3747     # Construct the commitmsgs table if required
3748     # The commitmsgs table is only used for merge commits, since
3749     # "sub update" will only keep one branch of parents.  Shortlogs
3750     # for ignored commits (i.e. not on the chosen branch) will be used
3751     # to construct a replacement "collapsed" merge commit message,
3752     # which will be stored in this table.  See also "sub commitmessage".
3753     unless ( $self->{tables}{$self->tablename("commitmsgs")} )
3754     {
3755         my $tablename = $self->tablename("commitmsgs");
3756         $self->{dbh}->do("
3757             CREATE TABLE $tablename (
3758                 key        TEXT NOT NULL PRIMARY KEY,
3759                 value      TEXT
3760             )
3761         ");
3762     }
3763
3764     return $self;
3765 }
3766
3767 =head2 tablename
3768
3769 =cut
3770 sub tablename
3771 {
3772     my $self = shift;
3773     my $name = shift;
3774
3775     if (exists $self->{valid_tables}{$name}) {
3776         return $self->{dbtablenameprefix} . $name;
3777     } else {
3778         return undef;
3779     }
3780 }
3781
3782 =head2 update
3783
3784 Bring the database up to date with the latest changes from
3785 the git repository.
3786
3787 Internal working state is read out of the "head" table and the
3788 "last_commit" property, then it updates "revisions" based on that, and
3789 finally it writes the new internal state back to the "head" table
3790 so it can be used as a starting point the next time update is called.
3791
3792 =cut
3793 sub update
3794 {
3795     my $self = shift;
3796
3797     # first lets get the commit list
3798     $ENV{GIT_DIR} = $self->{git_path};
3799
3800     my $commitsha1 = `git rev-parse $self->{module}`;
3801     chomp $commitsha1;
3802
3803     my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
3804     unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
3805     {
3806         die("Invalid module '$self->{module}'");
3807     }
3808
3809
3810     my $git_log;
3811     my $lastcommit = $self->_get_prop("last_commit");
3812
3813     if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
3814          # invalidate the gethead cache
3815          $self->clearCommitRefCaches();
3816          return 1;
3817     }
3818
3819     # Start exclusive lock here...
3820     $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
3821
3822     # TODO: log processing is memory bound
3823     # if we can parse into a 2nd file that is in reverse order
3824     # we can probably do something really efficient
3825     my @git_log_params = ('--pretty', '--parents', '--topo-order');
3826
3827     if (defined $lastcommit) {
3828         push @git_log_params, "$lastcommit..$self->{module}";
3829     } else {
3830         push @git_log_params, $self->{module};
3831     }
3832     # git-rev-list is the backend / plumbing version of git-log
3833     open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
3834                 or die "Cannot call git-rev-list: $!";
3835     my @commits=readCommits($gitLogPipe);
3836     close $gitLogPipe;
3837
3838     # Now all the commits are in the @commits bucket
3839     # ordered by time DESC. for each commit that needs processing,
3840     # determine whether it's following the last head we've seen or if
3841     # it's on its own branch, grab a file list, and add whatever's changed
3842     # NOTE: $lastcommit refers to the last commit from previous run
3843     #       $lastpicked is the last commit we picked in this run
3844     my $lastpicked;
3845     my $head = {};
3846     if (defined $lastcommit) {
3847         $lastpicked = $lastcommit;
3848     }
3849
3850     my $committotal = scalar(@commits);
3851     my $commitcount = 0;
3852
3853     # Load the head table into $head (for cached lookups during the update process)
3854     foreach my $file ( @{$self->gethead(1)} )
3855     {
3856         $head->{$file->{name}} = $file;
3857     }
3858
3859     foreach my $commit ( @commits )
3860     {
3861         $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
3862         if (defined $lastpicked)
3863         {
3864             if (!in_array($lastpicked, @{$commit->{parents}}))
3865             {
3866                 # skip, we'll see this delta
3867                 # as part of a merge later
3868                 # warn "skipping off-track  $commit->{hash}\n";
3869                 next;
3870             } elsif (@{$commit->{parents}} > 1) {
3871                 # it is a merge commit, for each parent that is
3872                 # not $lastpicked (not given a CVS revision number),
3873                 # see if we can get a log
3874                 # from the merge-base to that parent to put it
3875                 # in the message as a merge summary.
3876                 my @parents = @{$commit->{parents}};
3877                 foreach my $parent (@parents) {
3878                     if ($parent eq $lastpicked) {
3879                         next;
3880                     }
3881                     # git-merge-base can potentially (but rarely) throw
3882                     # several candidate merge bases. let's assume
3883                     # that the first one is the best one.
3884                     my $base = eval {
3885                             safe_pipe_capture('git', 'merge-base',
3886                                                  $lastpicked, $parent);
3887                     };
3888                     # The two branches may not be related at all,
3889                     # in which case merge base simply fails to find
3890                     # any, but that's Ok.
3891                     next if ($@);
3892
3893                     chomp $base;
3894                     if ($base) {
3895                         my @merged;
3896                         # print "want to log between  $base $parent \n";
3897                         open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
3898                           or die "Cannot call git-log: $!";
3899                         my $mergedhash;
3900                         while (<GITLOG>) {
3901                             chomp;
3902                             if (!defined $mergedhash) {
3903                                 if (m/^commit\s+(.+)$/) {
3904                                     $mergedhash = $1;
3905                                 } else {
3906                                     next;
3907                                 }
3908                             } else {
3909                                 # grab the first line that looks non-rfc822
3910                                 # aka has content after leading space
3911                                 if (m/^\s+(\S.*)$/) {
3912                                     my $title = $1;
3913                                     $title = substr($title,0,100); # truncate
3914                                     unshift @merged, "$mergedhash $title";
3915                                     undef $mergedhash;
3916                                 }
3917                             }
3918                         }
3919                         close GITLOG;
3920                         if (@merged) {
3921                             $commit->{mergemsg} = $commit->{message};
3922                             $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
3923                             foreach my $summary (@merged) {
3924                                 $commit->{mergemsg} .= "\t$summary\n";
3925                             }
3926                             $commit->{mergemsg} .= "\n\n";
3927                             # print "Message for $commit->{hash} \n$commit->{mergemsg}";
3928                         }
3929                     }
3930                 }
3931             }
3932         }
3933
3934         # convert the date to CVS-happy format
3935         my $cvsDate = convertToCvsDate($commit->{date});
3936
3937         if ( defined ( $lastpicked ) )
3938         {
3939             my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
3940             local ($/) = "\0";
3941             while ( <FILELIST> )
3942             {
3943                 chomp;
3944                 unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/o )
3945                 {
3946                     die("Couldn't process git-diff-tree line : $_");
3947                 }
3948                 my ($mode, $hash, $change) = ($1, $2, $3);
3949                 my $name = <FILELIST>;
3950                 chomp($name);
3951
3952                 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
3953
3954                 my $dbMode = convertToDbMode($mode);
3955
3956                 if ( $change eq "D" )
3957                 {
3958                     #$log->debug("DELETE   $name");
3959                     $head->{$name} = {
3960                         name => $name,
3961                         revision => $head->{$name}{revision} + 1,
3962                         filehash => "deleted",
3963                         commithash => $commit->{hash},
3964                         modified => $cvsDate,
3965                         author => $commit->{author},
3966                         mode => $dbMode,
3967                     };
3968                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
3969                 }
3970                 elsif ( $change eq "M" || $change eq "T" )
3971                 {
3972                     #$log->debug("MODIFIED $name");
3973                     $head->{$name} = {
3974                         name => $name,
3975                         revision => $head->{$name}{revision} + 1,
3976                         filehash => $hash,
3977                         commithash => $commit->{hash},
3978                         modified => $cvsDate,
3979                         author => $commit->{author},
3980                         mode => $dbMode,
3981                     };
3982                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
3983                 }
3984                 elsif ( $change eq "A" )
3985                 {
3986                     #$log->debug("ADDED    $name");
3987                     $head->{$name} = {
3988                         name => $name,
3989                         revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
3990                         filehash => $hash,
3991                         commithash => $commit->{hash},
3992                         modified => $cvsDate,
3993                         author => $commit->{author},
3994                         mode => $dbMode,
3995                     };
3996                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
3997                 }
3998                 else
3999                 {
4000                     $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
4001                     die;
4002                 }
4003             }
4004             close FILELIST;
4005         } else {
4006             # this is used to detect files removed from the repo
4007             my $seen_files = {};
4008
4009             my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
4010             local $/ = "\0";
4011             while ( <FILELIST> )
4012             {
4013                 chomp;
4014                 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4015                 {
4016                     die("Couldn't process git-ls-tree line : $_");
4017                 }
4018
4019                 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
4020
4021                 $seen_files->{$git_filename} = 1;
4022
4023                 my ( $oldhash, $oldrevision, $oldmode ) = (
4024                     $head->{$git_filename}{filehash},
4025                     $head->{$git_filename}{revision},
4026                     $head->{$git_filename}{mode}
4027                 );
4028
4029                 my $dbMode = convertToDbMode($mode);
4030
4031                 # unless the file exists with the same hash, we need to update it ...
4032                 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
4033                 {
4034                     my $newrevision = ( $oldrevision or 0 ) + 1;
4035
4036                     $head->{$git_filename} = {
4037                         name => $git_filename,
4038                         revision => $newrevision,
4039                         filehash => $git_hash,
4040                         commithash => $commit->{hash},
4041                         modified => $cvsDate,
4042                         author => $commit->{author},
4043                         mode => $dbMode,
4044                     };
4045
4046
4047                     $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
4048                 }
4049             }
4050             close FILELIST;
4051
4052             # Detect deleted files
4053             foreach my $file ( keys %$head )
4054             {
4055                 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
4056                 {
4057                     $head->{$file}{revision}++;
4058                     $head->{$file}{filehash} = "deleted";
4059                     $head->{$file}{commithash} = $commit->{hash};
4060                     $head->{$file}{modified} = $cvsDate;
4061                     $head->{$file}{author} = $commit->{author};
4062
4063                     $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $cvsDate, $commit->{author}, $head->{$file}{mode});
4064                 }
4065             }
4066             # END : "Detect deleted files"
4067         }
4068
4069
4070         if (exists $commit->{mergemsg})
4071         {
4072             $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
4073         }
4074
4075         $lastpicked = $commit->{hash};
4076
4077         $self->_set_prop("last_commit", $commit->{hash});
4078     }
4079
4080     $self->delete_head();
4081     foreach my $file ( keys %$head )
4082     {
4083         $self->insert_head(
4084             $file,
4085             $head->{$file}{revision},
4086             $head->{$file}{filehash},
4087             $head->{$file}{commithash},
4088             $head->{$file}{modified},
4089             $head->{$file}{author},
4090             $head->{$file}{mode},
4091         );
4092     }
4093     # invalidate the gethead cache
4094     $self->clearCommitRefCaches();
4095
4096
4097     # Ending exclusive lock here
4098     $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
4099 }
4100
4101 sub readCommits
4102 {
4103     my $pipeHandle = shift;
4104     my @commits;
4105
4106     my %commit = ();
4107
4108     while ( <$pipeHandle> )
4109     {
4110         chomp;
4111         if (m/^commit\s+(.*)$/) {
4112             # on ^commit lines put the just seen commit in the stack
4113             # and prime things for the next one
4114             if (keys %commit) {
4115                 my %copy = %commit;
4116                 unshift @commits, \%copy;
4117                 %commit = ();
4118             }
4119             my @parents = split(m/\s+/, $1);
4120             $commit{hash} = shift @parents;
4121             $commit{parents} = \@parents;
4122         } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
4123             # on rfc822-like lines seen before we see any message,
4124             # lowercase the entry and put it in the hash as key-value
4125             $commit{lc($1)} = $2;
4126         } else {
4127             # message lines - skip initial empty line
4128             # and trim whitespace
4129             if (!exists($commit{message}) && m/^\s*$/) {
4130                 # define it to mark the end of headers
4131                 $commit{message} = '';
4132                 next;
4133             }
4134             s/^\s+//; s/\s+$//; # trim ws
4135             $commit{message} .= $_ . "\n";
4136         }
4137     }
4138
4139     unshift @commits, \%commit if ( keys %commit );
4140
4141     return @commits;
4142 }
4143
4144 sub convertToCvsDate
4145 {
4146     my $date = shift;
4147     # Convert from: "git rev-list --pretty" formatted date
4148     # Convert to: "the format specified by RFC822 as modified by RFC1123."
4149     # Example: 26 May 1997 13:01:40 -0400
4150     if( $date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ )
4151     {
4152         $date = "$2 $1 $4 $3 $5";
4153     }
4154
4155     return $date;
4156 }
4157
4158 sub convertToDbMode
4159 {
4160     my $mode = shift;
4161
4162     # NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",
4163     #  but the database "mode" column historically (and currently)
4164     #  only stores the "rw" (for user) part of the string.
4165     #    FUTURE: It might make more sense to persist the raw
4166     #  octal mode (or perhaps the final full CVS form) instead of
4167     #  this half-converted form, but it isn't currently worth the
4168     #  backwards compatibility headaches.
4169
4170     $mode=~/^\d\d(\d)\d{3}$/;
4171     my $userBits=$1;
4172
4173     my $dbMode = "";
4174     $dbMode .= "r" if ( $userBits & 4 );
4175     $dbMode .= "w" if ( $userBits & 2 );
4176     $dbMode .= "x" if ( $userBits & 1 );
4177     $dbMode = "rw" if ( $dbMode eq "" );
4178
4179     return $dbMode;
4180 }
4181
4182 sub insert_rev
4183 {
4184     my $self = shift;
4185     my $name = shift;
4186     my $revision = shift;
4187     my $filehash = shift;
4188     my $commithash = shift;
4189     my $modified = shift;
4190     my $author = shift;
4191     my $mode = shift;
4192     my $tablename = $self->tablename("revision");
4193
4194     my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
4195     $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4196 }
4197
4198 sub insert_mergelog
4199 {
4200     my $self = shift;
4201     my $key = shift;
4202     my $value = shift;
4203     my $tablename = $self->tablename("commitmsgs");
4204
4205     my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
4206     $insert_mergelog->execute($key, $value);
4207 }
4208
4209 sub delete_head
4210 {
4211     my $self = shift;
4212     my $tablename = $self->tablename("head");
4213
4214     my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
4215     $delete_head->execute();
4216 }
4217
4218 sub insert_head
4219 {
4220     my $self = shift;
4221     my $name = shift;
4222     my $revision = shift;
4223     my $filehash = shift;
4224     my $commithash = shift;
4225     my $modified = shift;
4226     my $author = shift;
4227     my $mode = shift;
4228     my $tablename = $self->tablename("head");
4229
4230     my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
4231     $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4232 }
4233
4234 sub _get_prop
4235 {
4236     my $self = shift;
4237     my $key = shift;
4238     my $tablename = $self->tablename("properties");
4239
4240     my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
4241     $db_query->execute($key);
4242     my ( $value ) = $db_query->fetchrow_array;
4243
4244     return $value;
4245 }
4246
4247 sub _set_prop
4248 {
4249     my $self = shift;
4250     my $key = shift;
4251     my $value = shift;
4252     my $tablename = $self->tablename("properties");
4253
4254     my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
4255     $db_query->execute($value, $key);
4256
4257     unless ( $db_query->rows )
4258     {
4259         $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
4260         $db_query->execute($key, $value);
4261     }
4262
4263     return $value;
4264 }
4265
4266 =head2 gethead
4267
4268 =cut
4269
4270 sub gethead
4271 {
4272     my $self = shift;
4273     my $intRev = shift;
4274     my $tablename = $self->tablename("head");
4275
4276     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
4277
4278     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
4279     $db_query->execute();
4280
4281     my $tree = [];
4282     while ( my $file = $db_query->fetchrow_hashref )
4283     {
4284         if(!$intRev)
4285         {
4286             $file->{revision} = "1.$file->{revision}"
4287         }
4288         push @$tree, $file;
4289     }
4290
4291     $self->{gethead_cache} = $tree;
4292
4293     return $tree;
4294 }
4295
4296 =head2 getAnyHead
4297
4298 Returns a reference to an array of getmeta structures, one
4299 per file in the specified tree hash.
4300
4301 =cut
4302
4303 sub getAnyHead
4304 {
4305     my ($self,$hash) = @_;
4306
4307     if(!defined($hash))
4308     {
4309         return $self->gethead();
4310     }
4311
4312     my @files;
4313     {
4314         open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4315                 or die("Cannot call git-ls-tree : $!");
4316         local $/ = "\0";
4317         @files=<$filePipe>;
4318         close $filePipe;
4319     }
4320
4321     my $tree=[];
4322     my($line);
4323     foreach $line (@files)
4324     {
4325         $line=~s/\0$//;
4326         unless ( $line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4327         {
4328             die("Couldn't process git-ls-tree line : $_");
4329         }
4330
4331         my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4332         push @$tree, $self->getMetaFromCommithash($git_filename,$hash);
4333     }
4334
4335     return $tree;
4336 }
4337
4338 =head2 getRevisionDirMap
4339
4340 A "revision dir map" contains all the plain-file filenames associated
4341 with a particular revision (treeish), organized by directory:
4342
4343   $type = $out->{$dir}{$fullName}
4344
4345 The type of each is "F" (for ordinary file) or "D" (for directory,
4346 for which the map $out->{$fullName} will also exist).
4347
4348 =cut
4349
4350 sub getRevisionDirMap
4351 {
4352     my ($self,$ver)=@_;
4353
4354     if(!defined($self->{revisionDirMapCache}))
4355     {
4356         $self->{revisionDirMapCache}={};
4357     }
4358
4359         # Get file list (previously cached results are dependent on HEAD,
4360         # but are early in each case):
4361     my $cacheKey;
4362     my (@fileList);
4363     if( !defined($ver) || $ver eq "" )
4364     {
4365         $cacheKey="";
4366         if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4367         {
4368             return $self->{revisionDirMapCache}{$cacheKey};
4369         }
4370
4371         my @head = @{$self->gethead()};
4372         foreach my $file ( @head )
4373         {
4374             next if ( $file->{filehash} eq "deleted" );
4375
4376             push @fileList,$file->{name};
4377         }
4378     }
4379     else
4380     {
4381         my ($hash)=$self->lookupCommitRef($ver);
4382         if( !defined($hash) )
4383         {
4384             return undef;
4385         }
4386
4387         $cacheKey=$hash;
4388         if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4389         {
4390             return $self->{revisionDirMapCache}{$cacheKey};
4391         }
4392
4393         open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4394                 or die("Cannot call git-ls-tree : $!");
4395         local $/ = "\0";
4396         while ( <$filePipe> )
4397         {
4398             chomp;
4399             unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4400             {
4401                 die("Couldn't process git-ls-tree line : $_");
4402             }
4403
4404             my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4405
4406             push @fileList, $git_filename;
4407         }
4408         close $filePipe;
4409     }
4410
4411         # Convert to normalized form:
4412     my %revMap;
4413     my $file;
4414     foreach $file (@fileList)
4415     {
4416         my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);
4417         $dir='' if(!defined($dir));
4418
4419             # parent directories:
4420             # ... create empty dir maps for parent dirs:
4421         my($td)=$dir;
4422         while(!defined($revMap{$td}))
4423         {
4424             $revMap{$td}={};
4425
4426             my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4427             $tp='' if(!defined($tp));
4428             $td=$tp;
4429         }
4430             # ... add children to parent maps (now that they exist):
4431         $td=$dir;
4432         while($td ne "")
4433         {
4434             my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4435             $tp='' if(!defined($tp));
4436
4437             if(defined($revMap{$tp}{$td}))
4438             {
4439                 if($revMap{$tp}{$td} ne 'D')
4440                 {
4441                     die "Weird file/directory inconsistency in $cacheKey";
4442                 }
4443                 last;   # loop exit
4444             }
4445             $revMap{$tp}{$td}='D';
4446
4447             $td=$tp;
4448         }
4449
4450             # file
4451         $revMap{$dir}{$file}='F';
4452     }
4453
4454         # Save in cache:
4455     $self->{revisionDirMapCache}{$cacheKey}=\%revMap;
4456     return $self->{revisionDirMapCache}{$cacheKey};
4457 }
4458
4459 =head2 getlog
4460
4461 See also gethistorydense().
4462
4463 =cut
4464
4465 sub getlog
4466 {
4467     my $self = shift;
4468     my $filename = shift;
4469     my $revFilter = shift;
4470
4471     my $tablename = $self->tablename("revision");
4472
4473     # Filters:
4474     # TODO: date, state, or by specific logins filters?
4475     # TODO: Handle comma-separated list of revFilter items, each item
4476     #   can be a range [only case currently handled] or individual
4477     #   rev or branch or "branch.".
4478     # TODO: Adjust $db_query WHERE clause based on revFilter, instead of
4479     #   manually filtering the results of the query?
4480     my ( $minrev, $maxrev );
4481     if( defined($revFilter) and
4482         $state->{opt}{r} =~ /^(1.(\d+))?(::?)(1.(\d.+))?$/ )
4483     {
4484         my $control = $3;
4485         $minrev = $2;
4486         $maxrev = $5;
4487         $minrev++ if ( defined($minrev) and $control eq "::" );
4488     }
4489
4490     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
4491     $db_query->execute($filename);
4492
4493     my $totalRevs=0;
4494     my $tree = [];
4495     while ( my $file = $db_query->fetchrow_hashref )
4496     {
4497         $totalRevs++;
4498         if( defined($minrev) and $file->{revision} < $minrev )
4499         {
4500             next;
4501         }
4502         if( defined($maxrev) and $file->{revision} > $maxrev )
4503         {
4504             next;
4505         }
4506
4507         $file->{revision} = "1." . $file->{revision};
4508         push @$tree, $file;
4509     }
4510
4511     return ($tree,$totalRevs);
4512 }
4513
4514 =head2 getmeta
4515
4516 This function takes a filename (with path) argument and returns a hashref of
4517 metadata for that file.
4518
4519 There are several ways $revision can be specified:
4520
4521    - A reference to hash that contains a "tag" that is the
4522      actual revision (one of the below).  TODO: Also allow it to
4523      specify a "date" in the hash.
4524    - undef, to refer to the latest version on the main branch.
4525    - Full CVS client revision number (mapped to integer in DB, without the
4526      "1." prefix),
4527    - Complex CVS-compatible "special" revision number for
4528      non-linear history (see comment below)
4529    - git commit sha1 hash
4530    - branch or tag name
4531
4532 =cut
4533
4534 sub getmeta
4535 {
4536     my $self = shift;
4537     my $filename = shift;
4538     my $revision = shift;
4539     my $tablename_rev = $self->tablename("revision");
4540     my $tablename_head = $self->tablename("head");
4541
4542     if ( ref($revision) eq "HASH" )
4543     {
4544         $revision = $revision->{tag};
4545     }
4546
4547     # Overview of CVS revision numbers:
4548     #
4549     # General CVS numbering scheme:
4550     #   - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.
4551     #   - Result of "cvs checkin -r" (possible, but not really
4552     #     recommended): "2.1", "2.2", etc
4553     #   - Branch tag: "1.2.0.n", where "1.2" is revision it was branched
4554     #     from, "0" is a magic placeholder that identifies it as a
4555     #     branch tag instead of a version tag, and n is 2 times the
4556     #     branch number off of "1.2", starting with "2".
4557     #   - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"
4558     #     is branch number off of "1.2" (like n above), and "x" is
4559     #     the version number on the branch.
4560     #   - Branches can branch off of branches: "1.3.2.7.4.1" (even number
4561     #     of components).
4562     #   - Odd "n"s are used by "vendor branches" that result
4563     #     from "cvs import".  Vendor branches have additional
4564     #     strangeness in the sense that the main rcs "head" of the main
4565     #     branch will (temporarily until first normal commit) point
4566     #     to the version on the vendor branch, rather than the actual
4567     #     main branch.  (FUTURE: This may provide an opportunity
4568     #     to use "strange" revision numbers for fast-forward-merged
4569     #     branch tip when CVS client is asking for the main branch.)
4570     #
4571     # git-cvsserver CVS-compatible special numbering schemes:
4572     #   - Currently git-cvsserver only tries to be identical to CVS for
4573     #     simple "1.x" numbers on the "main" branch (as identified
4574     #     by the module name that was originally cvs checkout'ed).
4575     #   - The database only stores the "x" part, for historical reasons.
4576     #     But most of the rest of the cvsserver preserves
4577     #     and thinks using the full revision number.
4578     #   - To handle non-linear history, it uses a version of the form
4579     #     "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely
4580     #     identify this as a special revision number, and there are
4581     #     20 b's that together encode the sha1 git commit from which
4582     #     this version of this file originated.  Each b is
4583     #     the numerical value of the corresponding byte plus
4584     #     100.
4585     #      - "plus 100" avoids "0"s, and also reduces the
4586     #        likelyhood of a collision in the case that someone someday
4587     #        writes an import tool that tries to preserve original
4588     #        CVS revision numbers, and the original CVS data had done
4589     #        lots of branches off of branches and other strangeness to
4590     #        end up with a real version number that just happens to look
4591     #        like this special revision number form.  Also, if needed
4592     #        there are several ways to extend/identify alternative encodings
4593     #        within the "2.1.1.2000" part if necessary.
4594     #      - Unlike real CVS revisions, you can't really reconstruct what
4595     #        relation a revision of this form has to other revisions.
4596     #   - FUTURE: TODO: Rework database somehow to make up and remember
4597     #     fully-CVS-compatible branches and branch version numbers.
4598
4599     my $meta;
4600     if ( defined($revision) )
4601     {
4602         if ( $revision =~ /^1\.(\d+)$/ )
4603         {
4604             my ($intRev) = $1;
4605             my $db_query;
4606             $db_query = $self->{dbh}->prepare_cached(
4607                 "SELECT * FROM $tablename_rev WHERE name=? AND revision=?",
4608                 {},1);
4609             $db_query->execute($filename, $intRev);
4610             $meta = $db_query->fetchrow_hashref;
4611         }
4612         elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){20}$/ )
4613         {
4614             my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
4615             $commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
4616             if($commitHash=~/^[0-9a-f]{40}$/)
4617             {
4618                 return $self->getMetaFromCommithash($filename,$commitHash);
4619             }
4620
4621             # error recovery: fall back on head version below
4622             print "E Failed to find $filename version=$revision or commit=$commitHash\n";
4623             $log->warning("failed get $revision with commithash=$commitHash");
4624             undef $revision;
4625         }
4626         elsif ( $revision =~ /^[0-9a-f]{40}$/ )
4627         {
4628             # Try DB first.  This is mostly only useful for req_annotate(),
4629             # which only calls this for stuff that should already be in
4630             # the DB.  It is fairly likely to be a waste of time
4631             # in most other cases [unless the file happened to be
4632             # modified in $revision specifically], but
4633             # it is probably in the noise compared to how long
4634             # getMetaFromCommithash() will take.
4635             my $db_query;
4636             $db_query = $self->{dbh}->prepare_cached(
4637                 "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4638                 {},1);
4639             $db_query->execute($filename, $revision);
4640             $meta = $db_query->fetchrow_hashref;
4641
4642             if(! $meta)
4643             {
4644                 my($revCommit)=$self->lookupCommitRef($revision);
4645                 if($revCommit=~/^[0-9a-f]{40}$/)
4646                 {
4647                     return $self->getMetaFromCommithash($filename,$revCommit);
4648                 }
4649
4650                 # error recovery: nothing found:
4651                 print "E Failed to find $filename version=$revision\n";
4652                 $log->warning("failed get $revision");
4653                 return $meta;
4654             }
4655         }
4656         else
4657         {
4658             my($revCommit)=$self->lookupCommitRef($revision);
4659             if($revCommit=~/^[0-9a-f]{40}$/)
4660             {
4661                 return $self->getMetaFromCommithash($filename,$revCommit);
4662             }
4663
4664             # error recovery: fall back on head version below
4665             print "E Failed to find $filename version=$revision\n";
4666             $log->warning("failed get $revision");
4667             undef $revision;  # Allow fallback
4668         }
4669     }
4670
4671     if(!defined($revision))
4672     {
4673         my $db_query;
4674         $db_query = $self->{dbh}->prepare_cached(
4675                 "SELECT * FROM $tablename_head WHERE name=?",{},1);
4676         $db_query->execute($filename);
4677         $meta = $db_query->fetchrow_hashref;
4678     }
4679
4680     if($meta)
4681     {
4682         $meta->{revision} = "1.$meta->{revision}";
4683     }
4684     return $meta;
4685 }
4686
4687 sub getMetaFromCommithash
4688 {
4689     my $self = shift;
4690     my $filename = shift;
4691     my $revCommit = shift;
4692
4693     # NOTE: This function doesn't scale well (lots of forks), especially
4694     #   if you have many files that have not been modified for many commits
4695     #   (each git-rev-parse redoes a lot of work for each file
4696     #   that theoretically could be done in parallel by smarter
4697     #   graph traversal).
4698     #
4699     # TODO: Possible optimization strategies:
4700     #   - Solve the issue of assigning and remembering "real" CVS
4701     #     revision numbers for branches, and ensure the
4702     #     data structure can do this efficiently.  Perhaps something
4703     #     similar to "git notes", and carefully structured to take
4704     #     advantage same-sha1-is-same-contents, to roll the same
4705     #     unmodified subdirectory data onto multiple commits?
4706     #   - Write and use a C tool that is like git-blame, but
4707     #     operates on multiple files with file granularity, instead
4708     #     of one file with line granularity.  Cache
4709     #     most-recently-modified in $self->{commitRefCache}{$revCommit}.
4710     #     Try to be intelligent about how many files we do with
4711     #     one fork (perhaps one directory at a time, without recursion,
4712     #     and/or include directory as one line item, recurse from here
4713     #     instead of in C tool?).
4714     #   - Perhaps we could ask the DB for (filename,fileHash),
4715     #     and just guess that it is correct (that the file hadn't
4716     #     changed between $revCommit and the found commit, then
4717     #     changed back, confusing anything trying to interpret
4718     #     history).  Probably need to add another index to revisions
4719     #     DB table for this.
4720     #   - NOTE: Trying to store all (commit,file) keys in DB [to
4721     #     find "lastModfiedCommit] (instead of
4722     #     just files that changed in each commit as we do now) is
4723     #     probably not practical from a disk space perspective.
4724
4725         # Does the file exist in $revCommit?
4726     # TODO: Include file hash in dirmap cache.
4727     my($dirMap)=$self->getRevisionDirMap($revCommit);
4728     my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);
4729     if(!defined($dir))
4730     {
4731         $dir="";
4732     }
4733     if( !defined($dirMap->{$dir}) ||
4734         !defined($dirMap->{$dir}{$filename}) )
4735     {
4736         my($fileHash)="deleted";
4737
4738         my($retVal)={};
4739         $retVal->{name}=$filename;
4740         $retVal->{filehash}=$fileHash;
4741
4742             # not needed and difficult to compute:
4743         $retVal->{revision}="0";  # $revision;
4744         $retVal->{commithash}=$revCommit;
4745         #$retVal->{author}=$commit->{author};
4746         #$retVal->{modified}=convertToCvsDate($commit->{date});
4747         #$retVal->{mode}=convertToDbMode($mode);
4748
4749         return $retVal;
4750     }
4751
4752     my($fileHash)=safe_pipe_capture("git","rev-parse","$revCommit:$filename");
4753     chomp $fileHash;
4754     if(!($fileHash=~/^[0-9a-f]{40}$/))
4755     {
4756         die "Invalid fileHash '$fileHash' looking up"
4757                     ." '$revCommit:$filename'\n";
4758     }
4759
4760     # information about most recent commit to modify $filename:
4761     open(my $gitLogPipe, '-|', 'git', 'rev-list',
4762          '--max-count=1', '--pretty', '--parents',
4763          $revCommit, '--', $filename)
4764                 or die "Cannot call git-rev-list: $!";
4765     my @commits=readCommits($gitLogPipe);
4766     close $gitLogPipe;
4767     if(scalar(@commits)!=1)
4768     {
4769         die "Can't find most recent commit changing $filename\n";
4770     }
4771     my($commit)=$commits[0];
4772     if( !defined($commit) || !defined($commit->{hash}) )
4773     {
4774         return undef;
4775     }
4776
4777     # does this (commit,file) have a real assigned CVS revision number?
4778     my $tablename_rev = $self->tablename("revision");
4779     my $db_query;
4780     $db_query = $self->{dbh}->prepare_cached(
4781         "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4782         {},1);
4783     $db_query->execute($filename, $commit->{hash});
4784     my($meta)=$db_query->fetchrow_hashref;
4785     if($meta)
4786     {
4787         $meta->{revision} = "1.$meta->{revision}";
4788         return $meta;
4789     }
4790
4791     # fall back on special revision number
4792     my($revision)=$commit->{hash};
4793     $revision=~s/(..)/'.' . (hex($1)+100)/eg;
4794     $revision="2.1.1.2000$revision";
4795
4796     # meta data about $filename:
4797     open(my $filePipe, '-|', 'git', 'ls-tree', '-z',
4798                 $commit->{hash}, '--', $filename)
4799             or die("Cannot call git-ls-tree : $!");
4800     local $/ = "\0";
4801     my $line;
4802     $line=<$filePipe>;
4803     if(defined(<$filePipe>))
4804     {
4805         die "Expected only a single file for git-ls-tree $filename\n";
4806     }
4807     close $filePipe;
4808
4809     chomp $line;
4810     unless ( $line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4811     {
4812         die("Couldn't process git-ls-tree line : $line\n");
4813     }
4814     my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
4815
4816     # save result:
4817     my($retVal)={};
4818     $retVal->{name}=$filename;
4819     $retVal->{revision}=$revision;
4820     $retVal->{filehash}=$fileHash;
4821     $retVal->{commithash}=$revCommit;
4822     $retVal->{author}=$commit->{author};
4823     $retVal->{modified}=convertToCvsDate($commit->{date});
4824     $retVal->{mode}=convertToDbMode($mode);
4825
4826     return $retVal;
4827 }
4828
4829 =head2 lookupCommitRef
4830
4831 Convert tag/branch/abbreviation/etc into a commit sha1 hash.  Caches
4832 the result so looking it up again is fast.
4833
4834 =cut
4835
4836 sub lookupCommitRef
4837 {
4838     my $self = shift;
4839     my $ref = shift;
4840
4841     my $commitHash = $self->{commitRefCache}{$ref};
4842     if(defined($commitHash))
4843     {
4844         return $commitHash;
4845     }
4846
4847     $commitHash=safe_pipe_capture("git","rev-parse","--verify","--quiet",
4848                                   $self->unescapeRefName($ref));
4849     $commitHash=~s/\s*$//;
4850     if(!($commitHash=~/^[0-9a-f]{40}$/))
4851     {
4852         $commitHash=undef;
4853     }
4854
4855     if( defined($commitHash) )
4856     {
4857         my $type=safe_pipe_capture("git","cat-file","-t",$commitHash);
4858         if( ! ($type=~/^commit\s*$/ ) )
4859         {
4860             $commitHash=undef;
4861         }
4862     }
4863     if(defined($commitHash))
4864     {
4865         $self->{commitRefCache}{$ref}=$commitHash;
4866     }
4867     return $commitHash;
4868 }
4869
4870 =head2 clearCommitRefCaches
4871
4872 Clears cached commit cache (sha1's for various tags/abbeviations/etc),
4873 and related caches.
4874
4875 =cut
4876
4877 sub clearCommitRefCaches
4878 {
4879     my $self = shift;
4880     $self->{commitRefCache} = {};
4881     $self->{revisionDirMapCache} = undef;
4882     $self->{gethead_cache} = undef;
4883 }
4884
4885 =head2 commitmessage
4886
4887 this function takes a commithash and returns the commit message for that commit
4888
4889 =cut
4890 sub commitmessage
4891 {
4892     my $self = shift;
4893     my $commithash = shift;
4894     my $tablename = $self->tablename("commitmsgs");
4895
4896     die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
4897
4898     my $db_query;
4899     $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
4900     $db_query->execute($commithash);
4901
4902     my ( $message ) = $db_query->fetchrow_array;
4903
4904     if ( defined ( $message ) )
4905     {
4906         $message .= " " if ( $message =~ /\n$/ );
4907         return $message;
4908     }
4909
4910     my @lines = safe_pipe_capture("git", "cat-file", "commit", $commithash);
4911     shift @lines while ( $lines[0] =~ /\S/ );
4912     $message = join("",@lines);
4913     $message .= " " if ( $message =~ /\n$/ );
4914     return $message;
4915 }
4916
4917 =head2 gethistorydense
4918
4919 This function takes a filename (with path) argument and returns an arrayofarrays
4920 containing revision,filehash,commithash ordered by revision descending.
4921
4922 This version of gethistory skips deleted entries -- so it is useful for annotate.
4923 The 'dense' part is a reference to a '--dense' option available for git-rev-list
4924 and other git tools that depend on it.
4925
4926 See also getlog().
4927
4928 =cut
4929 sub gethistorydense
4930 {
4931     my $self = shift;
4932     my $filename = shift;
4933     my $tablename = $self->tablename("revision");
4934
4935     my $db_query;
4936     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
4937     $db_query->execute($filename);
4938
4939     my $result = $db_query->fetchall_arrayref;
4940
4941     my $i;
4942     for($i=0 ; $i<scalar(@$result) ; $i++)
4943     {
4944         $result->[$i][0]="1." . $result->[$i][0];
4945     }
4946
4947     return $result;
4948 }
4949
4950 =head2 escapeRefName
4951
4952 Apply an escape mechanism to compensate for characters that
4953 git ref names can have that CVS tags can not.
4954
4955 =cut
4956 sub escapeRefName
4957 {
4958     my($self,$refName)=@_;
4959
4960     # CVS officially only allows [-_A-Za-z0-9] in tag names (or in
4961     # many contexts it can also be a CVS revision number).
4962     #
4963     # Git tags commonly use '/' and '.' as well, but also handle
4964     # anything else just in case:
4965     #
4966     #   = "_-s-"  For '/'.
4967     #   = "_-p-"  For '.'.
4968     #   = "_-u-"  For underscore, in case someone wants a literal "_-" in
4969     #     a tag name.
4970     #   = "_-xx-" Where "xx" is the hexadecimal representation of the
4971     #     desired ASCII character byte. (for anything else)
4972
4973     if(! $refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)
4974     {
4975         $refName=~s/_-/_-u--/g;
4976         $refName=~s/\./_-p-/g;
4977         $refName=~s%/%_-s-%g;
4978         $refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;
4979     }
4980 }
4981
4982 =head2 unescapeRefName
4983
4984 Undo an escape mechanism to compensate for characters that
4985 git ref names can have that CVS tags can not.
4986
4987 =cut
4988 sub unescapeRefName
4989 {
4990     my($self,$refName)=@_;
4991
4992     # see escapeRefName() for description of escape mechanism.
4993
4994     $refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;
4995
4996     # allowed tag names
4997     # TODO: Perhaps use git check-ref-format, with an in-process cache of
4998     #  validated names?
4999     if( !( $refName=~m%^[^-][-a-zA-Z0-9_/.]*$% ) ||
5000         ( $refName=~m%[/.]$% ) ||
5001         ( $refName=~/\.lock$/ ) ||
5002         ( $refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) )  # matching }
5003     {
5004         # Error:
5005         $log->warn("illegal refName: $refName");
5006         $refName=undef;
5007     }
5008     return $refName;
5009 }
5010
5011 sub unescapeRefNameChar
5012 {
5013     my($char)=@_;
5014
5015     if($char eq "s")
5016     {
5017         $char="/";
5018     }
5019     elsif($char eq "p")
5020     {
5021         $char=".";
5022     }
5023     elsif($char eq "u")
5024     {
5025         $char="_";
5026     }
5027     elsif($char=~/^[0-9a-f][0-9a-f]$/)
5028     {
5029         $char=chr(hex($char));
5030     }
5031     else
5032     {
5033         # Error case: Maybe it has come straight from user, and
5034         # wasn't supposed to be escaped?  Restore it the way we got it:
5035         $char="_-$char-";
5036     }
5037
5038     return $char;
5039 }
5040
5041 =head2 in_array()
5042
5043 from Array::PAT - mimics the in_array() function
5044 found in PHP. Yuck but works for small arrays.
5045
5046 =cut
5047 sub in_array
5048 {
5049     my ($check, @array) = @_;
5050     my $retval = 0;
5051     foreach my $test (@array){
5052         if($check eq $test){
5053             $retval =  1;
5054         }
5055     }
5056     return $retval;
5057 }
5058
5059 =head2 safe_pipe_capture
5060
5061 an alternative to `command` that allows input to be passed as an array
5062 to work around shell problems with weird characters in arguments
5063
5064 =cut
5065 sub safe_pipe_capture {
5066
5067     my @output;
5068
5069     if (my $pid = open my $child, '-|') {
5070         @output = (<$child>);
5071         close $child or die join(' ',@_).": $! $?";
5072     } else {
5073         exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
5074     }
5075     return wantarray ? @output : join('',@output);
5076 }
5077
5078 =head2 mangle_dirname
5079
5080 create a string from a directory name that is suitable to use as
5081 part of a filename, mainly by converting all chars except \w.- to _
5082
5083 =cut
5084 sub mangle_dirname {
5085     my $dirname = shift;
5086     return unless defined $dirname;
5087
5088     $dirname =~ s/[^\w.-]/_/g;
5089
5090     return $dirname;
5091 }
5092
5093 =head2 mangle_tablename
5094
5095 create a string from a that is suitable to use as part of an SQL table
5096 name, mainly by converting all chars except \w to _
5097
5098 =cut
5099 sub mangle_tablename {
5100     my $tablename = shift;
5101     return unless defined $tablename;
5102
5103     $tablename =~ s/[^\w_]/_/g;
5104
5105     return $tablename;
5106 }
5107
5108 1;