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.
 
   8 #### Copyright The Open University UK - 2006.
 
  10 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
 
  11 ####          Martin Langhoff <martin@laptop.org>
 
  14 #### Released under the GNU Public License, version 2.
 
  24 use File::Temp qw/tempdir tempfile/;
 
  25 use File::Path qw/rmtree/;
 
  27 use Getopt::Long qw(:config require_order no_ignore_case);
 
  29 my $VERSION = '@@GIT_VERSION@@';
 
  31 my $log = GITCVS::log->new();
 
  49 # Enable autoflush for STDOUT (otherwise the whole thing falls apart)
 
  52 #### Definition and mappings of functions ####
 
  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?
 
  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,
 
  72     'remove'          => \&req_remove,
 
  74     'update'          => \&req_update,
 
  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,
 
  90 ##############################################
 
  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 => '' };
 
  97 # Work is for managing temporary working directory
 
 100         state => undef,  # undef, 1 (empty), 2 (with stuff)
 
 107 $log->info("--------------- STARTING -----------------");
 
 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".
 
 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";
 
 123 my @opts = ( 'h|H', 'version|V',
 
 124              'base-path=s', 'strict-paths', 'export-all' );
 
 125 GetOptions( $state, @opts )
 
 128 if ($state->{version}) {
 
 129     print "git-cvsserver version $VERSION\n";
 
 132 if ($state->{help}) {
 
 137 my $TEMP_DIR = tempdir( CLEANUP => 1 );
 
 138 $log->debug("Temporary directory is '$TEMP_DIR'");
 
 140 $state->{method} = 'ext';
 
 142     if ($ARGV[0] eq 'pserver') {
 
 143         $state->{method} = 'pserver';
 
 145     } elsif ($ARGV[0] eq 'server') {
 
 150 # everything else is a directory
 
 151 $state->{allowed_roots} = [ @ARGV ];
 
 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";
 
 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";
 
 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");
 
 167 if (exists $ENV{GIT_CVSSERVER_ROOT}) {
 
 168     if (@{$state->{allowed_roots}}) {
 
 169         die "Cannot specify roots both ways: @ARGV\n";
 
 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");
 
 176 # if we are called with a pserver argument,
 
 177 # deal with the authentication cat before entering the
 
 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";
 
 185     $line = <STDIN>; chomp $line;
 
 186     unless (req_Root('root', $line)) { # reuse Root
 
 187        print "E Invalid root $line \n";
 
 190     $line = <STDIN>; chomp $line;
 
 192     $line = <STDIN>; chomp $line;
 
 193     my $password = $line;
 
 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";
 
 204         # Fall through to LOVE
 
 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";
 
 213         my $authdb = $cfg->{gitcvs}->{authdb};
 
 215         unless (-e $authdb) {
 
 216             print "E The authentication database specified in [gitcvs.authdb] does not exist\n";
 
 217             print "I HATE YOU\n";
 
 222         open my $passwd, "<", $authdb or die $!;
 
 224             if (m{^\Q$user\E:(.*)}) {
 
 225                 if (crypt($user, descramble($password)) eq $1) {
 
 233             print "I HATE YOU\n";
 
 237         # Fall through to LOVE
 
 240     # For checking whether the user is anonymous on commit
 
 241     $state->{user} = $user;
 
 243     $line = <STDIN>; chomp $line;
 
 244     unless ($line eq "END $request REQUEST") {
 
 245        die "E Do not understand $line -- expecting END $request REQUEST\n";
 
 247     print "I LOVE YOU\n";
 
 248     exit if $request eq 'VERIFICATION'; # cvs login
 
 249     # and now back to our regular programme...
 
 252 # Keep going until the client closes the connection
 
 257     # Check to see if we've seen this method, and call appropriate function.
 
 258     if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
 
 260         # use the $methods hash to call the appropriate sub for this command
 
 261         #$log->info("Method : $1");
 
 262         &{$methods->{$1}}($1,$2);
 
 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 $_");
 
 273 $log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
 
 274 $log->info("--------------- FINISH -----------------");
 
 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.
 
 285     my ( $cmd, $data ) = @_;
 
 286     $log->warn("Unhandled command : req_$cmd : $data");
 
 289 # This method invariably succeeds with an empty response.
 
 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.
 
 306     my ( $cmd, $data ) = @_;
 
 307     $log->debug("req_Root : $data");
 
 309     unless ($data =~ m#^/#) {
 
 310         print "error 1 Root must be an absolute pathname\n";
 
 314     my $cvsroot = $state->{'base-path'} || '';
 
 318     if ($state->{CVSROOT}
 
 319         && ($state->{CVSROOT} ne $cvsroot)) {
 
 320         print "error 1 Conflicting roots specified\n";
 
 324     $state->{CVSROOT} = $cvsroot;
 
 326     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 
 328     if (@{$state->{allowed_roots}}) {
 
 330         foreach my $dir (@{$state->{allowed_roots}}) {
 
 331             next unless $dir =~ m#^/#;
 
 333             if ($state->{'strict-paths'}) {
 
 334                 if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
 
 338             } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
 
 345             print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
 
 347             print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
 
 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";
 
 355        print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
 
 359     my @gitvars = safe_pipe_capture(qw(git config -l));
 
 361        print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
 
 363         print "error 1 - problem executing git-config\n";
 
 366     foreach my $line ( @gitvars )
 
 368         next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
 
 372             $cfg->{$1}{$2}{$3} = $4;
 
 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";
 
 383         print "error 1 GITCVS emulation disabled\n";
 
 387     my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
 
 390         $log->setfile($logfile);
 
 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
 
 407     my ( $cmd, $data ) = @_;
 
 408     $log->debug("req_Globaloption : $data");
 
 409     $state->{globaloptions}{$data} = 1;
 
 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
 
 417     my ( $cmd, $data ) = @_;
 
 418     $log->debug("req_Validresponses : $data");
 
 420     # TODO : re-enable this, currently it's not particularly useful
 
 421     #$state->{validresponses} = [ split /\s+/, $data ];
 
 425 #     Response expected: yes. Ask the server to send back a Valid-requests
 
 427 sub req_validrequests
 
 429     my ( $cmd, $data ) = @_;
 
 431     $log->debug("req_validrequests");
 
 433     $log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
 
 434     $log->debug("SEND : ok");
 
 436     print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
 
 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
 
 453     my ( $cmd, $data ) = @_;
 
 455     my $repository = <STDIN>;
 
 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/ );
 
 466     $state->{directory} = $state->{localdir};
 
 467     $state->{directory} = "" if ( $state->{directory} eq "." );
 
 468     $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
 
 470     if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
 
 472         $log->info("Setting prepend to '$state->{path}'");
 
 473         $state->{prependdir} = $state->{path};
 
 475         foreach my $entry ( keys %{$state->{entries}} )
 
 477             $entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
 
 479         $state->{entries}=\%entries;
 
 482         foreach my $dir ( keys %{$state->{dirMap}} )
 
 484             $dirMap{$state->{prependdir} . $dir} = $state->{dirMap}{$dir};
 
 486         $state->{dirMap}=\%dirMap;
 
 489     if ( defined ( $state->{prependdir} ) )
 
 491         $log->debug("Prepending '$state->{prependdir}' to state|directory");
 
 492         $state->{directory} = $state->{prependdir} . $state->{directory}
 
 495     if ( ! defined($state->{dirMap}{$state->{directory}}) )
 
 497         $state->{dirMap}{$state->{directory}} =
 
 504     $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
 
 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
 
 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.
 
 522     my ( $cmd, $tagspec ) = @_;
 
 529     elsif($tagspec=~/^T([^ ]+)\s*$/)
 
 531         $stickyInfo = { 'tag' => $1 };
 
 533     elsif($tagspec=~/^D([0-9.]+)\s*$/)
 
 535         $stickyInfo= { 'date' => $1 };
 
 539         die "Unknown tag_or_date format\n";
 
 541     $state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;
 
 543     $log->debug("req_Sticky : tagspec=$tagspec repository=$state->{repository}"
 
 544                 . " path=$state->{path} directory=$state->{directory}"
 
 545                 . " module=$state->{module}");
 
 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
 
 561     my ( $cmd, $data ) = @_;
 
 563     #$log->debug("req_Entry : $data");
 
 565     my @data = split(/\//, $data, -1);
 
 567     $state->{entries}{$state->{directory}.$data[1]} = {
 
 568         revision    => $data[2],
 
 569         conflict    => $data[3],
 
 571         tag_or_date => $data[5],
 
 574     $state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';
 
 576     $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
 
 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.
 
 587     my ( $cmd, $data ) = @_;
 
 589     $log->debug("req_Questionable : $data");
 
 590     $state->{entries}{$state->{directory}.$data}{questionable} = 1;
 
 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.
 
 601     my ( $cmd, $data ) = @_;
 
 605     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
 610     foreach my $filename ( @{$state->{args}} )
 
 612         $filename = filecleanup($filename);
 
 614         # no -r, -A, or -D with add
 
 615         my $stickyInfo = resolveStickyInfo($filename);
 
 617         my $meta = $updater->getmeta($filename,$stickyInfo);
 
 618         my $wrev = revparse($filename);
 
 620         if ($wrev && $meta && ($wrev=~/^-/))
 
 622             # previously removed file, add back
 
 623             $log->info("added file $filename was previously removed, send $meta->{revision}");
 
 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";
 
 631             unless ( $state->{globaloptions}{-n} )
 
 633                 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 
 635                 print "Created $dirpart\n";
 
 636                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 
 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";
 
 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";
 
 648                 transmitfile($meta->{filehash});
 
 654         unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
 
 656             print "E cvs add: nothing known about `$filename'\n";
 
 659         # TODO : check we're not squashing an already existing file
 
 660         if ( defined ( $state->{entries}{$filename}{revision} ) )
 
 662             print "E cvs add: `$filename' has already been entered\n";
 
 666         my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
 
 668         print "E cvs add: scheduling file `$filename' for addition\n";
 
 670         print "Checked-in $dirpart\n";
 
 672         my $kopts = kopts_from_path($filename,"file",
 
 673                         $state->{entries}{$filename}{modified_filename});
 
 674         print "/$filepart/0//$kopts/" .
 
 675               getStickyTagOrDate($stickyInfo) . "\n";
 
 677         my $requestedKopts = $state->{opt}{k};
 
 678         if(defined($requestedKopts))
 
 680             $requestedKopts = "-k$requestedKopts";
 
 684             $requestedKopts = "";
 
 686         if( $kopts ne $requestedKopts )
 
 688             $log->warn("Ignoring requested -k='$requestedKopts'"
 
 689                         . " for '$filename'; detected -k='$kopts' instead");
 
 690             #TODO: Also have option to send warning to user?
 
 696     if ( $addcount == 1 )
 
 698         print "E cvs add: use `cvs commit' to add this file permanently\n";
 
 700     elsif ( $addcount > 1 )
 
 702         print "E cvs add: use `cvs commit' to add these files permanently\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.
 
 721     my ( $cmd, $data ) = @_;
 
 725     # Grab a handle to the SQLite db and do any necessary updates
 
 726     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
 729     #$log->debug("add state : " . Dumper($state));
 
 733     foreach my $filename ( @{$state->{args}} )
 
 735         $filename = filecleanup($filename);
 
 737         if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
 
 739             print "E cvs remove: file `$filename' still in working directory\n";
 
 744         my $stickyInfo = resolveStickyInfo($filename);
 
 746         my $meta = $updater->getmeta($filename,$stickyInfo);
 
 747         my $wrev = revparse($filename);
 
 749         unless ( defined ( $wrev ) )
 
 751             print "E cvs remove: nothing known about `$filename'\n";
 
 755         if ( defined($wrev) and ($wrev=~/^-/) )
 
 757             print "E cvs remove: file `$filename' already scheduled for removal\n";
 
 761         unless ( $wrev eq $meta->{revision} )
 
 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";
 
 769         my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
 
 771         print "E cvs remove: scheduling `$filename' for removal\n";
 
 773         print "Checked-in $dirpart\n";
 
 775         my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
 
 776         print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
 
 783         print "E cvs remove: use `cvs commit' to remove this file permanently\n";
 
 785     elsif ( $rmcount > 1 )
 
 787         print "E cvs remove: use `cvs commit' to remove these files permanently\n";
 
 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.
 
 802     my ( $cmd, $data ) = @_;
 
 806         or (print "E end of file reading mode for $data\n"), return;
 
 810         or (print "E end of file reading size of $data\n"), return;
 
 813     # Grab config information
 
 814     my $blocksize = 8192;
 
 815     my $bytesleft = $size;
 
 818     # Get a filehandle/name to write it to
 
 819     my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
 
 821     # Loop over file data writing out to temporary file.
 
 824         $blocksize = $bytesleft if ( $bytesleft < $blocksize );
 
 825         read STDIN, $tmp, $blocksize;
 
 827         $bytesleft -= $blocksize;
 
 831         or (print "E failed to write temporary, $filename: $!\n"), return;
 
 833     # Ensure we have something sensible for the file mode
 
 834     if ( $mode =~ /u=(\w+)/ )
 
 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} = safe_pipe_capture('git','hash-object',$filename);
 
 845     $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
 
 847     #$log->debug("req_Modified : file=$data mode=$mode size=$size");
 
 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 `/'.
 
 856     my ( $cmd, $data ) = @_;
 
 858     $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
 
 860     #$log->debug("req_Unchanged : $data");
 
 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.
 
 868 #     Response expected: no. Append \n followed by text to the current argument
 
 872     my ( $cmd, $data ) = @_;
 
 874     # Argumentx means: append to last Argument (with a newline in front)
 
 876     $log->debug("$cmd : $data");
 
 878     if ( $cmd eq 'Argumentx') {
 
 879         ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
 
 881         push @{$state->{arguments}}, $data;
 
 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
 
 909     my ( $cmd, $data ) = @_;
 
 913     $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
 
 915     unless ( ref $state->{arguments} eq "ARRAY" )
 
 921     foreach my $module ( @{$state->{arguments}} )
 
 923         $log->debug("SEND : Module-expansion $module");
 
 924         print "Module-expansion $module\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.
 
 940     my ( $cmd, $data ) = @_;
 
 944     # Provide list of modules, if -c was used.
 
 945     if (exists $state->{opt}{c}) {
 
 946         my $showref = safe_pipe_capture(qw(git show-ref --heads));
 
 947         for my $line (split '\n', $showref) {
 
 948             if ( $line =~ m% refs/heads/(.*)$% ) {
 
 956     my $stickyInfo = { 'tag' => $state->{opt}{r},
 
 957                        'date' => $state->{opt}{D} };
 
 959     my $module = $state->{args}[0];
 
 960     $state->{module} = $module;
 
 961     my $checkout_path = $module;
 
 963     # use the user specified directory if we're given it
 
 964     $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
 
 966     $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
 
 968     $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
 
 970     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 
 972     # Grab a handle to the SQLite db and do any necessary updates
 
 973     my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
 
 977     if( defined($stickyInfo) && defined($stickyInfo->{tag}) )
 
 979         $headHash = $updater->lookupCommitRef($stickyInfo->{tag});
 
 980         if( !defined($headHash) )
 
 982             print "error 1 no such tag `$stickyInfo->{tag}'\n";
 
 988     $checkout_path =~ s|/$||; # get rid of trailing slashes
 
 995             $state->{CVSROOT} . "/$module",
 
1001     foreach my $git ( @{$updater->getAnyHead($headHash)} )
 
1003         # Don't want to check out deleted files
 
1004         next if ( $git->{filehash} eq "deleted" );
 
1006         my $fullName = $git->{name};
 
1007         ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
 
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;
 
1017         # modification time of this file
 
1018         print "Mod-time $git->{modified}\n";
 
1020         # print some information to the client
 
1021         if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
 
1023             print "M U $checkout_path/$git->{dir}$git->{name}\n";
 
1025             print "M U $checkout_path/$git->{name}\n";
 
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";
 
1031        print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
 
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";
 
1038         print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
 
1041         transmitfile($git->{filehash});
 
1049 # used by req_co and req_update to set up directories for files
 
1050 # recursively handles parents
 
1051 sub prepDirForOutput
 
1053     my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;
 
1055     my $parent = dirname($dir);
 
1057     $repodir   =~ s|/+$||;
 
1058     $remotedir =~ s|/+$||;
 
1061     if ($parent eq '.' || $parent eq './')
 
1065     # recurse to announce unseen parents first
 
1066     if( length($parent) &&
 
1067         !exists($seendirs->{$parent}) &&
 
1068         ( $request eq "checkout" ||
 
1069           exists($dirArgs->{$parent}) ) )
 
1071         prepDirForOutput($parent, $repodir, $remotedir,
 
1072                          $seendirs, $request, $dirArgs);
 
1074     # Announce that we are going to modify at the parent level
 
1075     if ($dir eq '.' || $dir eq './')
 
1079     if(exists($seendirs->{$dir}))
 
1083     $log->debug("announcedir $dir, $repodir, $remotedir" );
 
1084     my($thisRemoteDir,$thisRepoDir);
 
1087         $thisRepoDir="$repodir/$dir";
 
1088         if($remotedir eq ".")
 
1090             $thisRemoteDir=$dir;
 
1094             $thisRemoteDir="$remotedir/$dir";
 
1099         $thisRepoDir=$repodir;
 
1100         $thisRemoteDir=$remotedir;
 
1102     unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
 
1104         print "E cvs $request: Updating $thisRemoteDir\n";
 
1107     my ($opt_r)=$state->{opt}{r};
 
1109     if(exists($state->{opt}{A}))
 
1111         # $stickyInfo=undef;
 
1113     elsif( defined($opt_r) && $opt_r ne "" )
 
1114            # || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO
 
1116         $stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };
 
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) };
 
1126         $stickyInfo=getDirStickyInfo($state->{prependdir} . $dir);
 
1130     if(defined($stickyInfo))
 
1132         $stickyResponse = "Set-sticky $thisRemoteDir/\n" .
 
1134                           getStickyTagOrDate($stickyInfo) . "\n";
 
1138         $stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
 
1142     unless ( $state->{globaloptions}{-n} )
 
1144         print $stickyResponse;
 
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";
 
1154     $seendirs->{$dir} = 1;
 
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 processing all files.
 
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.
 
1171     my ( $cmd, $data ) = @_;
 
1173     $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
 
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.
 
1183     if ($state->{module} eq '') {
 
1184         my $showref = safe_pipe_capture(qw(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";
 
1196     # Grab a handle to the SQLite db and do any necessary updates
 
1197     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
1201     argsfromdir($updater);
 
1203     #$log->debug("update state : " . Dumper($state));
 
1206     $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
 
1210     # foreach file specified on the command line ...
 
1211     foreach my $argsFilename ( @{$state->{args}} )
 
1214         $filename = filecleanup($argsFilename);
 
1216         $log->debug("Processing file $filename");
 
1218         # if we have a -C we should pretend we never saw modified stuff
 
1219         if ( exists ( $state->{opt}{C} ) )
 
1221             delete $state->{entries}{$filename}{modified_hash};
 
1222             delete $state->{entries}{$filename}{modified_filename};
 
1223             $state->{entries}{$filename}{unchanged} = 1;
 
1226         my $stickyInfo = resolveStickyInfo($filename,
 
1229                                            exists($state->{opt}{A}));
 
1230         my $meta = $updater->getmeta($filename, $stickyInfo);
 
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});
 
1237                 transmitfile($meta->{filehash}, { print => 1 });
 
1245                 dirname($argsFilename),
 
1250                 $state->{dirArgs} );
 
1252         my $wrev = revparse($filename);
 
1254         if ( ! defined $meta )
 
1263                 $meta->{filehash}='deleted';
 
1267         my $oldmeta = $meta;
 
1269         # If the working copy is an old revision, lets get that version too for comparison.
 
1271         if(defined($oldWrev))
 
1274             if($oldWrev ne $meta->{revision})
 
1276                 $oldmeta = $updater->getmeta($filename, $oldWrev);
 
1280         #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
 
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} ) );
 
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}
 
1296              and defined($state->{entries}{$filename}{modified_hash})
 
1297              and not exists ( $state->{opt}{C} ) )
 
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";
 
1306         if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
 
1308             # TODO: If it has been modified in the sandbox, error out
 
1309             #   with the appropriate message, rather than deleting a modified
 
1312             my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 
1314             $log->info("Removing '$filename' from working copy (no longer in the repo)");
 
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";
 
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' )
 
1327             # normal update, just send the new revision (either U=Update,
 
1328             # or A=Add, or R=Remove)
 
1329             if ( defined($wrev) && ($wrev=~/^-/) )
 
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";
 
1337             elsif ( (!defined($wrev) || $wrev eq '0') &&
 
1338                     (!defined($meta->{revision}) || $meta->{revision} eq '0') )
 
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";
 
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";
 
1356             my ( $filepart, $dirpart ) = filenamesplit($filename,1);
 
1358             # Don't want to actually _DO_ the update if -n specified
 
1359             unless ( $state->{globaloptions}{-n} )
 
1361                 if ( defined ( $wrev ) )
 
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'");
 
1367                     # instruct client we're sending a file to put in this path as a new file
 
1369                     $log->debug("Creating new file 'Created $dirpart'");
 
1370                     print "Created $dirpart\n";
 
1372                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 
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";
 
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";
 
1386                 transmitfile($meta->{filehash});
 
1389             my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
 
1391             my $mergeDir = setupTmpDir();
 
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 });
 
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";
 
1405             $log->debug("Temporary directory for merge is $mergeDir");
 
1407             my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
 
1414                 $log->info("Merged successfully");
 
1415                 print "M M $filename\n";
 
1416                 $log->debug("Merged $dirpart");
 
1418                 # Don't want to actually _DO_ the update if -n specified
 
1419                 unless ( $state->{globaloptions}{-n} )
 
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";
 
1432             elsif ( $return == 1 )
 
1434                 $log->info("Merged with conflicts");
 
1435                 print "E cvs update: conflicts found in $filename\n";
 
1436                 print "M C $filename\n";
 
1438                 # Don't want to actually _DO_ the update if -n specified
 
1439                 unless ( $state->{globaloptions}{-n} )
 
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";
 
1452                 $log->warn("Merge failed");
 
1456             # Don't want to actually _DO_ the update if -n specified
 
1457             unless ( $state->{globaloptions}{-n} )
 
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";
 
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 = safe_pipe_capture('cat', $mergedFile);
 
1467                 $log->debug("File size : " . length($data));
 
1468                 print length($data) . "\n";
 
1475     # prepDirForOutput() any other existing directories unless they already
 
1476     # have the right sticky tag:
 
1477     unless ( $state->{globaloptions}{n} )
 
1480         foreach $dir (keys(%{$state->{dirMap}}))
 
1482             if( ! $seendirs{$dir} &&
 
1483                 exists($state->{dirArgs}{$dir}) )
 
1486                 $oldTag=$state->{dirMap}{$dir}{tagspec};
 
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...
 
1504                         $state->{dirArgs} );
 
1507             # TODO?: Consider sending a final duplicate Sticky response
 
1508             #   to more closely mimic real CVS.
 
1517     my ( $cmd, $data ) = @_;
 
1521     #$log->debug("State : " . Dumper($state));
 
1523     $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
 
1525     if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
 
1527         print "error 1 anonymous user cannot commit via pserver\n";
 
1532     if ( -e $state->{CVSROOT} . "/index" )
 
1534         $log->warn("file 'index' already exists in the git repository");
 
1535         print "error 1 Index already exists in git repo\n";
 
1540     # Grab a handle to the SQLite db and do any necessary updates
 
1541     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
1544     my @committedfiles = ();
 
1550     # foreach file specified on the command line ...
 
1551     foreach my $filename ( @{$state->{args}} )
 
1553         my $committedfile = $filename;
 
1554         $filename = filecleanup($filename);
 
1556         next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
 
1559         # Figure out which branch and parenthash we are committing
 
1560         # to, and setup worktree:
 
1562         # should always come from entries:
 
1563         my $fileStickyInfo = resolveStickyInfo($filename);
 
1564         if( !defined($branchRef) )
 
1566             $stickyInfo = $fileStickyInfo;
 
1567             if( defined($stickyInfo) &&
 
1568                 ( defined($stickyInfo->{date}) ||
 
1569                   !defined($stickyInfo->{tag}) ) )
 
1571                 print "error 1 cannot commit with sticky date for file `$filename'\n";
 
1576             $branchRef = "refs/heads/$state->{module}";
 
1577             if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
 
1579                 $branchRef = "refs/heads/$stickyInfo->{tag}";
 
1582             $parenthash = safe_pipe_capture('git', 'show-ref', '-s', $branchRef);
 
1584             if ($parenthash !~ /^[0-9a-f]{40}$/)
 
1586                 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
 
1588                     print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
 
1592                     print "error 1 pserver cannot find the current HEAD of module";
 
1598             setupWorkTree($parenthash);
 
1600             $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
 
1602             $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
 
1604         elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )
 
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";
 
1616         # Process this file:
 
1618         my $meta = $updater->getmeta($filename,$stickyInfo);
 
1619         $oldmeta{$filename} = $meta;
 
1621         my $wrev = revparse($filename);
 
1623         my ( $filepart, $dirpart ) = filenamesplit($filename);
 
1625         # do a checkout of the file if it is part of this tree
 
1627             system('git', 'checkout-index', '-f', '-u', $filename);
 
1629                 die "Error running git-checkout-index -f -u $filename : $!";
 
1635         $rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
 
1636         $addflag = 1 unless ( -e $filename );
 
1638         # Do up to date checking
 
1639         unless ( $addflag or $wrev eq $meta->{revision} or
 
1640                  ( $rmflag and $wrev eq "-$meta->{revision}" ) )
 
1642             # fail everything if an up to date check fails
 
1643             print "error 1 Up to date check failed for $filename\n";
 
1648         push @committedfiles, $committedfile;
 
1649         $log->info("Committing $filename");
 
1651         system("mkdir","-p",$dirpart) unless ( -d $dirpart );
 
1655             $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
 
1656             rename $state->{entries}{$filename}{modified_filename},$filename;
 
1658             # Calculate modes to remove
 
1660             foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
 
1662             $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
 
1663             system("chmod","u+" .  $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
 
1668             $log->info("Removing file '$filename'");
 
1670             system("git", "update-index", "--remove", $filename);
 
1674             $log->info("Adding file '$filename'");
 
1675             system("git", "update-index", "--add", $filename);
 
1677             $log->info("UpdatingX2 file '$filename'");
 
1678             system("git", "update-index", $filename);
 
1682     unless ( scalar(@committedfiles) > 0 )
 
1684         print "E No files to commit\n";
 
1690     my $treehash = safe_pipe_capture(qw(git write-tree));
 
1693     $log->debug("Treehash : $treehash, Parenthash : $parenthash");
 
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"
 
1703         print $msg_fh "\n\nvia git-CVS emulator\n";
 
1707     my $commithash = safe_pipe_capture('git', 'commit-tree', $treehash, '-p', $parenthash, '-F', $msg_filename);
 
1709     $log->info("Commit hash : $commithash");
 
1711     unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
 
1713         $log->warn("Commit failed (Invalid commit hash)");
 
1714         print "error 1 Commit failed (unknown reason)\n";
 
1719         ### Emulate git-receive-pack by running hooks/update
 
1720         my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
 
1721                         $parenthash, $commithash );
 
1723                 unless( system( @hook ) == 0 )
 
1725                         $log->warn("Commit failed (update hook declined to update ref)");
 
1726                         print "error 1 Commit failed (update hook declined)\n";
 
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";
 
1741         ### Emulate git-receive-pack by running hooks/post-receive
 
1742         my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
 
1744                 open(my $pipe, "| $hook") || die "can't fork $!";
 
1746                 local $SIG{PIPE} = sub { die 'pipe broke' };
 
1748                 print $pipe "$parenthash $commithash $branchRef\n";
 
1750                 close $pipe || die "bad pipe: $! $?";
 
1755         ### Then hooks/post-update
 
1756         $hook = $ENV{GIT_DIR}.'hooks/post-update';
 
1758                 system($hook, $branchRef);
 
1761     # foreach file specified on the command line ...
 
1762     foreach my $filename ( @committedfiles )
 
1764         $filename = filecleanup($filename);
 
1766         my $meta = $updater->getmeta($filename,$stickyInfo);
 
1767         unless (defined $meta->{revision}) {
 
1768           $meta->{revision} = "1.1";
 
1771         my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
 
1773         $log->debug("Checked-in $dirpart : $filename");
 
1775         print "M $state->{CVSROOT}/$state->{module}/$filename,v  <--  $dirpart$filepart\n";
 
1776         if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
 
1778             print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
 
1779             print "Remove-entry $dirpart\n";
 
1780             print "$filename\n";
 
1782             if ($meta->{revision} eq "1.1") {
 
1783                 print "M initial revision: 1.1\n";
 
1785                 print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
 
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";
 
1801     my ( $cmd, $data ) = @_;
 
1805     $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
 
1806     #$log->debug("status state : " . Dumper($state));
 
1808     # Grab a handle to the SQLite db and do any necessary updates
 
1810     $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
1813     # if no files were specified, we need to work out what files we should
 
1814     # be providing status on ...
 
1815     argsfromdir($updater);
 
1817     # foreach file specified on the command line ...
 
1818     foreach my $filename ( @{$state->{args}} )
 
1820         $filename = filecleanup($filename);
 
1822         if ( exists($state->{opt}{l}) &&
 
1823              index($filename, '/', length($state->{prependdir})) >= 0 )
 
1828         my $wrev = revparse($filename);
 
1830         my $stickyInfo = resolveStickyInfo($filename);
 
1831         my $meta = $updater->getmeta($filename,$stickyInfo);
 
1832         my $oldmeta = $meta;
 
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} )
 
1840             $oldmeta = $updater->getmeta($filename, $rmRev);
 
1843         # TODO : All possible statuses aren't yet implemented
 
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} ) ) )
 
1856             $status = "Up-to-date"
 
1859         # Need checkout if the working copy has a different (usually
 
1860         # older) revision than the repo copy, and the working copy is
 
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} ) ) )
 
1869             $status ||= "Needs Checkout";
 
1872         # Need checkout if it exists in the repo but doesn't have a working
 
1874         if ( not defined ( $wrev ) and defined ( $meta->{revision} ) )
 
1876             $status ||= "Needs Checkout";
 
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
 
1884              $state->{entries}{$filename}{modified_filename} )
 
1886             $status ||= "Locally Modified";
 
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} )
 
1895             $status ||= "Needs Merge";
 
1898         if ( defined ( $state->{entries}{$filename}{revision} ) and
 
1899              ( !defined($meta->{revision}) ||
 
1900                $meta->{revision} eq "0" ) )
 
1902             $status ||= "Locally Added";
 
1904         if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
 
1905              $wrev eq "-$meta->{revision}" )
 
1907             $status ||= "Locally Removed";
 
1909         if ( defined ( $state->{entries}{$filename}{conflict} ) and
 
1910              $state->{entries}{$filename}{conflict} =~ /^\+=/ )
 
1912             $status ||= "Unresolved Conflict";
 
1916             $status ||= "File had conflicts on merge";
 
1919         $status ||= "Unknown";
 
1921         my ($filepart) = filenamesplit($filename);
 
1923         print "M =======" . ( "=" x 60 ) . "\n";
 
1924         print "M File: $filepart\tStatus: $status\n";
 
1925         if ( defined($state->{entries}{$filename}{revision}) )
 
1927             print "M Working revision:\t" .
 
1928                   $state->{entries}{$filename}{revision} . "\n";
 
1930             print "M Working revision:\tNo entry for $filename\n";
 
1932         if ( defined($meta->{revision}) )
 
1934             print "M Repository revision:\t" .
 
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) )
 
1943             print "M Sticky Tag:\t\t$tag\n";
 
1944             my($date)=($tagOrDate=~m/^D(.+)$/);
 
1945             if( !defined($date) )
 
1949             print "M Sticky Date:\t\t$date\n";
 
1950             my($options)=$state->{entries}{$filename}{options};
 
1951             if( $options eq "" )
 
1955             print "M Sticky Options:\t\t$options\n";
 
1957             print "M Repository revision:\tNo revision control file\n";
 
1967     my ( $cmd, $data ) = @_;
 
1971     $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
 
1972     #$log->debug("status state : " . Dumper($state));
 
1974     my ($revision1, $revision2);
 
1975     if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
 
1977         $revision1 = $state->{opt}{r}[0];
 
1978         $revision2 = $state->{opt}{r}[1];
 
1980         $revision1 = $state->{opt}{r};
 
1983     $log->debug("Diffing revisions " .
 
1984                 ( defined($revision1) ? $revision1 : "[NULL]" ) .
 
1985                 " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
 
1987     # Grab a handle to the SQLite db and do any necessary updates
 
1989     $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
1992     # if no files were specified, we need to work out what files we should
 
1993     # be providing status on ...
 
1994     argsfromdir($updater);
 
1998     # foreach file specified on the command line ...
 
1999     foreach my $argFilename ( @{$state->{args}} )
 
2001         my($filename) = filecleanup($argFilename);
 
2003         my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
 
2005         my $wrev = revparse($filename);
 
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
 
2014         if ( defined ( $revision1 ) )
 
2016             $meta1 = $updater->getmeta($filename, $revision1);
 
2018         elsif( defined($wrev) && $wrev ne "0" )
 
2022             $meta1 = $updater->getmeta($filename, $rmRev);
 
2024         if ( !defined($meta1) ||
 
2025              $meta1->{filehash} eq "deleted" )
 
2027             if( !exists($state->{opt}{N}) )
 
2029                 if(!defined($revision1))
 
2031                     print "E File $filename at revision $revision1 doesn't exist\n";
 
2035             elsif( !defined($meta1) )
 
2040                     filehash => 'deleted'
 
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
 
2052         # if we have a second -r switch, use it too
 
2053         if ( defined ( $revision2 ) )
 
2055             $meta2 = $updater->getmeta($filename, $revision2);
 
2057         elsif(defined($state->{entries}{$filename}{modified_filename}))
 
2059             $file2 = $state->{entries}{$filename}{modified_filename};
 
2063                 filehash => 'modified'
 
2066         elsif( defined($wrev) && ($wrev!~/^-/) )
 
2068             if(!defined($revision1))  # no revision and no modifications:
 
2072             $meta2 = $updater->getmeta($filename, $wrev);
 
2074         if(!defined($file2))
 
2076             if ( !defined($meta2) ||
 
2077                  $meta2->{filehash} eq "deleted" )
 
2079                 if( !exists($state->{opt}{N}) )
 
2081                     if(!defined($revision2))
 
2083                         print "E File $filename at revision $revision2 doesn't exist\n";
 
2087                 elsif( !defined($meta2) )
 
2092                         filehash => 'deleted'
 
2098         if( $meta1->{filehash} eq $meta2->{filehash} )
 
2100             $log->info("unchanged $filename");
 
2104         # Retrieve revision contents:
 
2105         ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
 
2106         transmitfile($meta1->{filehash}, { targetfile => $file1 });
 
2108         if(!defined($file2))
 
2110             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
 
2111             transmitfile($meta2->{filehash}, { targetfile => $file2 });
 
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" )
 
2120             print "M retrieving revision $meta1->{revision}\n"
 
2122         if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
 
2124             print "M retrieving revision $meta2->{revision}\n"
 
2127         foreach my $opt ( sort keys %{$state->{opt}} )
 
2129             if ( ref $state->{opt}{$opt} eq "ARRAY" )
 
2131                 foreach my $value ( @{$state->{opt}{$opt}} )
 
2133                     print "-$opt $value ";
 
2137                 if ( defined ( $state->{opt}{$opt} ) )
 
2139                     print "$state->{opt}{$opt} "
 
2143         print "$argFilename\n";
 
2145         $log->info("Diffing $filename -r $meta1->{revision} -r " .
 
2146                    ( $meta2->{revision} or "workingcopy" ));
 
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.)
 
2160         my (@diffCmd) = ( 'diff' );
 
2161         if ( exists($state->{opt}{N}) )
 
2165         if ( exists $state->{opt}{u} )
 
2167             push @diffCmd,("-u","-L");
 
2168             if( $meta1->{filehash} eq "deleted" )
 
2170                 push @diffCmd,"/dev/null";
 
2172                 push @diffCmd,("$argFilename\trevision $meta1->{revision}");
 
2175             if( defined($meta2->{filehash}) )
 
2177                 if( $meta2->{filehash} eq "deleted" )
 
2179                     push @diffCmd,("-L","/dev/null");
 
2181                     push @diffCmd,("-L",
 
2182                                    "$argFilename\trevision $meta2->{revision}");
 
2185                 push @diffCmd,("-L","$argFilename\tworking copy");
 
2188         push @diffCmd,($file1,$file2);
 
2189         if(!open(DIFF,"-|",@diffCmd))
 
2191             $log->warn("Unable to run diff: $!");
 
2194         while(defined($diffLine=<DIFF>))
 
2196             print "M $diffLine";
 
2214     my ( $cmd, $data ) = @_;
 
2218     $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
 
2219     #$log->debug("log state : " . Dumper($state));
 
2222     if ( defined ( $state->{opt}{r} ) )
 
2224         $revFilter = $state->{opt}{r};
 
2227     # Grab a handle to the SQLite db and do any necessary updates
 
2229     $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
2232     # if no files were specified, we need to work out what files we
 
2233     # should be providing status on ...
 
2234     argsfromdir($updater);
 
2236     # foreach file specified on the command line ...
 
2237     foreach my $filename ( @{$state->{args}} )
 
2239         $filename = filecleanup($filename);
 
2241         my $headmeta = $updater->getmeta($filename);
 
2243         my ($revisions,$totalrevisions) = $updater->getlog($filename,
 
2246         next unless ( scalar(@$revisions) );
 
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";
 
2261         foreach my $revision ( @$revisions )
 
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}) )
 
2269                 $revision->{modified} = sprintf('%04d/%02d/%02d %s',
 
2270                                             $3, $DATE_LIST->{$2}, $1, $4 );
 
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" ) .
 
2278             $commitmessage = $updater->commitmessage($revision->{commithash});
 
2279             $commitmessage =~ s/^/M /mg;
 
2280             print $commitmessage . "\n";
 
2282         print "M =======" . ( "=" x 70 ) . "\n";
 
2290     my ( $cmd, $data ) = @_;
 
2292     argsplit("annotate");
 
2294     $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
 
2295     #$log->debug("status state : " . Dumper($state));
 
2297     # Grab a handle to the SQLite db and do any necessary updates
 
2298     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
2301     # if no files were specified, we need to work out what files we should be providing annotate on ...
 
2302     argsfromdir($updater);
 
2304     # we'll need a temporary checkout dir
 
2307     $log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
 
2309     # foreach file specified on the command line ...
 
2310     foreach my $filename ( @{$state->{args}} )
 
2312         $filename = filecleanup($filename);
 
2314         my $meta = $updater->getmeta($filename);
 
2316         next unless ( $meta->{revision} );
 
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];
 
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);
 
2331             print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
 
2334         $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
 
2336         # do a checkout of the file
 
2337         system('git', 'checkout-index', '-f', '-u', $filename);
 
2339             print "E error running git-checkout-index -f -u $filename : $!\n";
 
2343         $log->info("Annotate $filename");
 
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
 
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";
 
2355         for (my $i=0; $i < @$revisions; $i++)
 
2357             print ANNOTATEHINTS $revisions->[$i][2];
 
2358             if ($i+1 < @$revisions) { # have we got a parent?
 
2359                 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
 
2361             print ANNOTATEHINTS "\n";
 
2364         print ANNOTATEHINTS "\n";
 
2366             or (print "E failed to write $a_hints: $!\n"), return;
 
2368         my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
 
2369         if (!open(ANNOTATE, "-|", @cmd)) {
 
2370             print "E error invoking ". join(' ',@cmd) .": $!\n";
 
2374         print "E Annotations for $filename\n";
 
2375         print "E ***************\n";
 
2376         while ( <ANNOTATE> )
 
2378             if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
 
2380                 my $commithash = $1;
 
2382                 unless ( defined ( $metadata->{$commithash} ) )
 
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)/ );
 
2388                 printf("M %-7s      (%-8s %10s): %s\n",
 
2389                     $metadata->{$commithash}{revision},
 
2390                     $metadata->{$commithash}{author},
 
2391                     $metadata->{$commithash}{modified},
 
2395                 $log->warn("Error in annotate output! LINE: $_");
 
2396                 print "E Annotate error \n";
 
2403     # done; get out of the tempdir
 
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.
 
2415     $state->{args} = [];
 
2416     $state->{files} = [];
 
2419     return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
 
2423     if ( defined($type) )
 
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" );
 
2436         while ( scalar ( @{$state->{arguments}} ) > 0 )
 
2438             my $arg = shift @{$state->{arguments}};
 
2440             next if ( $arg eq "--" );
 
2441             next unless ( $arg =~ /\S/ );
 
2443             # if the argument looks like a switch
 
2444             if ( $arg =~ /^-(\w)(.*)/ )
 
2446                 # if it's a switch that takes an argument
 
2449                     # If this switch has already been provided
 
2450                     if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
 
2452                         $state->{opt}{$1} = [ $state->{opt}{$1} ];
 
2453                         if ( length($2) > 0 )
 
2455                             push @{$state->{opt}{$1}},$2;
 
2457                             push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
 
2460                         # if there's extra data in the arg, use that as the argument for the switch
 
2461                         if ( length($2) > 0 )
 
2463                             $state->{opt}{$1} = $2;
 
2465                             $state->{opt}{$1} = shift @{$state->{arguments}};
 
2469                     $state->{opt}{$1} = undef;
 
2474                 push @{$state->{args}}, $arg;
 
2482         foreach my $value ( @{$state->{arguments}} )
 
2484             if ( $value eq "--" )
 
2489             push @{$state->{args}}, $value if ( $mode == 0 );
 
2490             push @{$state->{files}}, $value if ( $mode == 1 );
 
2495 # Used by argsfromdir
 
2498     my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
 
2500     my $fullPath = filecleanup($path);
 
2502       # Is it a directory?
 
2503     if( defined($state->{dirMap}{$fullPath}) ||
 
2504         defined($state->{dirMap}{"$fullPath/"}) )
 
2506           # It is a directory in the user's sandbox.
 
2509         if(defined($state->{entries}{$fullPath}))
 
2511             $log->fatal("Inconsistent file/dir type");
 
2512             die "Inconsistent file/dir type";
 
2515     elsif(defined($state->{entries}{$fullPath}))
 
2517           # It is a file in the user's sandbox.
 
2520     my($revDirMap,$otherRevDirMap);
 
2521     if(!defined($isDir) || $isDir)
 
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)
 
2528           # Order of precedence of sticky tags:
 
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]
 
2535           # Also, -r may appear twice (for diff).
 
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.
 
2541         if(exists($state->{opt}{A}))
 
2543             $revDirMap=$updater->getRevisionDirMap();
 
2545         elsif( defined($state->{opt}{r}) and
 
2546                ref $state->{opt}{r} eq "ARRAY" )
 
2548             $revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
 
2549             $otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
 
2551         elsif(defined($state->{opt}{r}))
 
2553             $revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
 
2557             my($sticky)=getDirStickyInfo($fullPath);
 
2558             $revDirMap=$updater->getRevisionDirMap($sticky->{tag});
 
2561           # Is it a directory?
 
2562         if( defined($revDirMap->{$fullPath}) ||
 
2563             defined($otherRevDirMap->{$fullPath}) )
 
2569       # What to do with it?
 
2572         $outNameMap->{$fullPath}=1;
 
2576         $outDirMap->{$fullPath}=1;
 
2578         if(defined($revDirMap->{$fullPath}))
 
2580             addDirMapFiles($updater,$outNameMap,$outDirMap,
 
2581                            $revDirMap->{$fullPath});
 
2583         if( defined($otherRevDirMap) &&
 
2584             defined($otherRevDirMap->{$fullPath}) )
 
2586             addDirMapFiles($updater,$outNameMap,$outDirMap,
 
2587                            $otherRevDirMap->{$fullPath});
 
2592 # Used by argsfromdir
 
2593 # Add entries from dirMap to outNameMap.  Also recurse into entries
 
2594 # that are subdirectories.
 
2597     my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
 
2600     foreach $fullName (keys(%$dirMap))
 
2602         my $cleanName=$fullName;
 
2603         if(defined($state->{prependdir}))
 
2605             if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
 
2607                 $log->fatal("internal error stripping prependdir");
 
2608                 die "internal error stripping prependdir";
 
2612         if($dirMap->{$fullName} eq "F")
 
2614             $outNameMap->{$cleanName}=1;
 
2616         elsif($dirMap->{$fullName} eq "D")
 
2618             if(!$state->{opt}{l})
 
2620                 expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
 
2625             $log->fatal("internal error in addDirMapFiles");
 
2626             die "internal error in addDirMapFiles";
 
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
 
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.
 
2642     my $updater = shift;
 
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
 
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)
 
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
 
2668     #   ci # HERE: Similar to remove...
 
2669     #      # Don't try to implement the confusing/weird
 
2670     #      # ci -r bug er.."feature".
 
2672     if(scalar(@{$state->{args}})==0)
 
2674         $state->{args} = [ "." ];
 
2678     for my $file (@{$state->{args}})
 
2680         expandArg($updater,\%allArgs,\%allDirs,$file);
 
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}})
 
2687         $allArgs{remove_prependdir($file)} = 1;
 
2690     $state->{dirArgs} = \%allDirs;
 
2693                 # Sort priority: by directory depth, then actual file name:
 
2694             my @piecesA=split('/',$a);
 
2695             my @piecesB=split('/',$b);
 
2697             my $count=scalar(@piecesA);
 
2698             my $tmp=scalar(@piecesB);
 
2699             return $count<=>$tmp if($count!=$tmp);
 
2701             for($tmp=0;$tmp<$count;$tmp++)
 
2703                 if($piecesA[$tmp] ne $piecesB[$tmp])
 
2705                     return $piecesA[$tmp] cmp $piecesB[$tmp]
 
2712 ## look up directory sticky tag, of either fullPath or a parent:
 
2713 sub getDirStickyInfo
 
2718     while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
 
2720         $fullPath=~s%/?[^/]*$%%;
 
2723     if( !defined($state->{dirMap}{"$fullPath/"}) &&
 
2724         ( $fullPath eq "" ||
 
2725           $fullPath eq "." ) )
 
2727         return $state->{dirMap}{""}{stickyInfo};
 
2731         return $state->{dirMap}{"$fullPath/"}{stickyInfo};
 
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
 
2740     my($filename,$stickyTag,$stickyDate,$reset) = @_;
 
2742     # Order of precedence of sticky tags:
 
2745     #    [file entry sticky tag]
 
2746     #    [the tag specified in dir req_Sticky]
 
2747     #    [the tag specified in a parent dir req_Sticky]
 
2755     elsif( defined($stickyTag) && $stickyTag ne "" )
 
2756            # || ( defined($stickyDate) && $stickyDate ne "" )   # TODO
 
2758         $result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
 
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) };
 
2766     elsif( defined($state->{entries}{$filename}) &&
 
2767            defined($state->{entries}{$filename}{tag_or_date}) &&
 
2768            $state->{entries}{$filename}{tag_or_date} ne "" )
 
2770         my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
 
2771         if($tagOrDate=~/^T([^ ]+)\s*$/)
 
2773             $result = { 'tag' => $1 };
 
2775         elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
 
2777             $result= { 'date' => $1 };
 
2781             die "Unknown tag_or_date format\n";
 
2786         $result=getDirStickyInfo($filename);
 
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
 
2800     if(defined($stickyInfo) && defined($stickyInfo->{tag}))
 
2802         $result="T$stickyInfo->{tag}";
 
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").
 
2815 # This method cleans up the $state variable after a command that uses arguments has run
 
2818     $state->{files} = [];
 
2819     $state->{dirArgs} = {};
 
2820     $state->{args} = [];
 
2821     $state->{arguments} = [];
 
2822     $state->{entries} = {};
 
2823     $state->{dirMap} = {};
 
2826 # Return working directory CVS revision "1.X" out
 
2827 # of 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.
 
2832     my $filename = shift;
 
2834     return $state->{entries}{$filename}{revision};
 
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
 
2842 # - Otherwise, transmit the size of the file, followed by the file
 
2846     my $filehash = shift;
 
2847     my $options = shift;
 
2849     if ( defined ( $filehash ) and $filehash eq "deleted" )
 
2851         $log->warn("filehash is 'deleted'");
 
2855     die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
 
2857     my $type = safe_pipe_capture('git', 'cat-file', '-t', $filehash);
 
2860     die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
 
2862     my $size = safe_pipe_capture('git', 'cat-file', '-s', $filehash);
 
2865     $log->debug("transmitfile($filehash) size=$size, type=$type");
 
2867     if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
 
2869         if ( defined ( $options->{targetfile} ) )
 
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} ) {
 
2880                     print 'MT text ', $_, "\n";
 
2885             print while ( <$fh> );
 
2887         close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
 
2889         die("Couldn't execute git-cat-file");
 
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
 
2898     my $filename = shift;
 
2899     my $fixforlocaldir = shift;
 
2901     my ( $filepart, $dirpart ) = ( $filename, "." );
 
2902     ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
 
2905     if ( $fixforlocaldir )
 
2907         $dirpart =~ s/^$state->{prependdir}//;
 
2910     return ( $filepart, $dirpart );
 
2913 # Cleanup various junk in filename (try to canonicalize it), and
 
2914 # add prependdir to accommodate running CVS client from a
 
2915 # subdirectory (so the output is relative to top directory of the project).
 
2918     my $filename = shift;
 
2920     return undef unless(defined($filename));
 
2921     if ( $filename =~ /^\// )
 
2923         print "E absolute filenames '$filename' not supported by server\n";
 
2927     if($filename eq ".")
 
2931     $filename =~ s/^\.\///g;
 
2932     $filename =~ s%/+%/%g;
 
2933     $filename = $state->{prependdir} . $filename;
 
2934     $filename =~ s%/$%%;
 
2938 # Remove prependdir from the path, so that it 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
 
2944     if(defined($state->{prependdir}) && $state->{prependdir} ne "")
 
2946         my($pre)=$state->{prependdir};
 
2948         if(!($path=~s%^\Q$pre\E/?%%))
 
2950             $log->fatal("internal error missing prependdir");
 
2951             die("internal error missing prependdir");
 
2959     if( !defined($state->{CVSROOT}) )
 
2961         print "error 1 CVSROOT not specified\n";
 
2965     if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
 
2967         print "error 1 Internally inconsistent CVSROOT\n";
 
2973 # Setup working directory in a work tree with the requested version
 
2974 # loaded in the index.
 
2981     if( ( defined($work->{state}) && $work->{state} != 1 ) ||
 
2982         defined($work->{tmpDir}) )
 
2984         $log->warn("Bad work tree state management");
 
2985         print "error 1 Internal setup multiple work trees without cleanup\n";
 
2990     $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
 
2992     if( !defined($work->{index}) )
 
2994         (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
 
2997     chdir $work->{workDir} or
 
2998         die "Unable to chdir to $work->{workDir}\n";
 
3000     $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
 
3002     $ENV{GIT_WORK_TREE} = ".";
 
3003     $ENV{GIT_INDEX_FILE} = $work->{index};
 
3008         system("git","read-tree",$ver);
 
3011             $log->warn("Error running git-read-tree");
 
3012             die "Error running git-read-tree $ver in $work->{workDir} $!\n";
 
3015     # else # req_annotate reads tree for each file
 
3018 # Ensure current directory is in some kind of working directory,
 
3019 # with a recent version loaded in the index.
 
3022     if( defined($work->{tmpDir}) )
 
3024         $log->warn("Bad work tree state management [ensureWorkTree()]");
 
3025         print "error 1 Internal setup multiple dirs without cleanup\n";
 
3029     if( $work->{state} )
 
3036     if( !defined($work->{emptyDir}) )
 
3038         $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
 
3040     chdir $work->{emptyDir} or
 
3041         die "Unable to chdir to $work->{emptyDir}\n";
 
3043     my $ver = safe_pipe_capture('git', 'show-ref', '-s', "refs/heads/$state->{module}");
 
3045     if ($ver !~ /^[0-9a-f]{40}$/)
 
3047         $log->warn("Error from git show-ref -s refs/head$state->{module}");
 
3048         print "error 1 cannot find the current HEAD of module";
 
3053     if( !defined($work->{index}) )
 
3055         (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
 
3058     $ENV{GIT_WORK_TREE} = ".";
 
3059     $ENV{GIT_INDEX_FILE} = $work->{index};
 
3062     system("git","read-tree",$ver);
 
3065         die "Error running git-read-tree $ver $!\n";
 
3069 # Cleanup working directory that is not needed any longer.
 
3072     if( ! $work->{state} )
 
3077     chdir "/" or die "Unable to chdir '/'\n";
 
3079     if( defined($work->{workDir}) )
 
3081         rmtree( $work->{workDir} );
 
3082         undef $work->{workDir};
 
3084     undef $work->{state};
 
3087 # Setup a temporary directory (not a working tree), typically for
 
3088 # merging dirty state as in req_update.
 
3091     $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
 
3092     chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
 
3094     return $work->{tmpDir};
 
3097 # Clean up a previously setupTmpDir.  Restore previous work tree if
 
3101     if ( !defined($work->{tmpDir}) )
 
3103         $log->warn("cleanup tmpdir that has not been setup");
 
3104         die "Cleanup tmpDir that has not been setup\n";
 
3106     if( defined($work->{state}) )
 
3108         if( $work->{state} == 1 )
 
3110             chdir $work->{emptyDir} or
 
3111                 die "Unable to chdir to $work->{emptyDir}\n";
 
3113         elsif( $work->{state} == 2 )
 
3115             chdir $work->{workDir} or
 
3116                 die "Unable to chdir to $work->{emptyDir}\n";
 
3120             $log->warn("Inconsistent work dir state");
 
3121             die "Inconsistent work dir state\n";
 
3126         chdir "/" or die "Unable to chdir '/'\n";
 
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.
 
3135     my ($path, $srcType, $name) = @_;
 
3137     if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
 
3138          $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
 
3140         my ($val) = check_attr( "text", $path );
 
3141         if ( $val eq "unspecified" )
 
3143             $val = check_attr( "crlf", $path );
 
3145         if ( $val eq "unset" )
 
3149         elsif ( check_attr( "eol", $path ) ne "unspecified" ||
 
3150                 $val eq "set" || $val eq "input" )
 
3156             $log->info("Unrecognized check_attr crlf $path : $val");
 
3160     if ( defined ( $cfg->{gitcvs}{allbinary} ) )
 
3162         if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
 
3166         elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
 
3168             if( is_binary($srcType,$name) )
 
3170                 $log->debug("... as binary");
 
3175                 $log->debug("... as text");
 
3179     # Return "" to give no special treatment to any path
 
3185     my ($attr,$path) = @_;
 
3187     if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
 
3191         $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
 
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.
 
3204     my ($srcType,$name) = @_;
 
3205     $log->debug("is_binary($srcType,$name)");
 
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.
 
3212     for($i=0;$i<256;$i++)
 
3217     my $fh = open_blob_or_die($srcType,$name);
 
3219     while( defined($line=<$fh>) )
 
3221         # Any '\0' and bare CR are considered binary.
 
3222         if( $line =~ /\0|(\r[^\n])/ )
 
3228         # Count up each character in the line:
 
3229         my $len=length($line);
 
3230         for($i=0;$i<$len;$i++)
 
3232             $counts[ord(substr($line,$i,1))]++;
 
3237     # Don't count CR and LF as either printable/nonprintable
 
3238     $counts[ord("\n")]=0;
 
3239     $counts[ord("\r")]=0;
 
3241     # Categorize individual character count into printable and nonprintable:
 
3244     for($i=0;$i<256;$i++)
 
3252             $nonprintable+=$counts[$i];
 
3254         elsif( $i==127 )  # DEL
 
3256             $nonprintable+=$counts[$i];
 
3260             $printable+=$counts[$i];
 
3264     return ($printable >> 7) < $nonprintable;
 
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
 
3272     my ($srcType,$name) = @_;
 
3274     if( $srcType eq "file" )
 
3276         if( !open $fh,"<",$name )
 
3278             $log->warn("Unable to open file $name: $!");
 
3279             die "Unable to open file $name: $!\n";
 
3282     elsif( $srcType eq "sha1" )
 
3284         unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{40}$/ )
 
3286             $log->warn("Need filehash");
 
3287             die "Need filehash\n";
 
3290         my $type = safe_pipe_capture('git', 'cat-file', '-t', $name);
 
3293         unless ( defined ( $type ) and $type eq "blob" )
 
3295             $log->warn("Invalid type '$type' for '$name'");
 
3296             die ( "Invalid type '$type' (expected 'blob')" )
 
3299         my $size = safe_pipe_capture('git', 'cat-file', '-s', $name);
 
3302         $log->debug("open_blob_or_die($name) size=$size, type=$type");
 
3304         unless( open $fh, '-|', "git", "cat-file", "blob", $name )
 
3306             $log->warn("Unable to open sha1 $name");
 
3307             die "Unable to open sha1 $name\n";
 
3312         $log->warn("Unknown type of blob source: $srcType");
 
3313         die "Unknown type of blob source: $srcType\n";
 
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
 
3325     my $author_line = shift;
 
3326     (my $author) = $author_line =~ /<([^@>]*)/;
 
3328     $author =~ s/[^-a-zA-Z0-9_.]/_/g;
 
3337     # This table is from src/scramble.c in the CVS source
 
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
 
3358     # This should never happen, the same password format (A) has been
 
3359     # used by CVS since the beginning of time
 
3361         my $fmt = substr($str, 0, 1);
 
3362         die "invalid password format `$fmt'" unless $fmt eq 'A';
 
3365     my @str = unpack "C*", substr($str, 1);
 
3366     my $ret = join '', map { chr $SHIFTS[$_] } @str;
 
3370 # Test if the (deep) values of two references to a hash are the same.
 
3383     elsif( !defined($v2) ||
 
3384            scalar(keys(%{$v1})) != scalar(keys(%{$v2})) )
 
3393         foreach $key (keys(%{$v1}))
 
3395             if( !exists($v2->{$key}) ||
 
3396                 defined($v1->{$key}) ne defined($v2->{$key}) ||
 
3397                 ( defined($v1->{$key}) &&
 
3398                   $v1->{$key} ne $v2->{$key} ) )
 
3409 # an alternative to `command` that allows input to be passed as an array
 
3410 # to work around shell problems with weird characters in arguments
 
3412 sub safe_pipe_capture {
 
3416     if (my $pid = open my $child, '-|') {
 
3417         @output = (<$child>);
 
3418         close $child or die join(' ',@_).": $! $?";
 
3420         exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
 
3422     return wantarray ? @output : join('',@output);
 
3426 package GITCVS::log;
 
3429 #### Copyright The Open University UK - 2006.
 
3431 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
 
3432 ####          Martin Langhoff <martin@laptop.org>
 
3445 This module provides very crude logging with a similar interface to
 
3454 Creates a new log object, optionally you can specify a filename here to
 
3455 indicate the file to log to. If no log file is specified, you can specify one
 
3456 later with method setfile, or indicate you no longer want logging with method
 
3459 Until one of these methods is called, all log calls will buffer messages ready
 
3466     my $filename = shift;
 
3470     bless $self, $class;
 
3472     if ( defined ( $filename ) )
 
3474         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
 
3482 This methods takes a filename, and attempts to open that file as the log file.
 
3483 If successful, all buffered data is written out to the file, and any further
 
3484 logging is written directly to the file.
 
3490     my $filename = shift;
 
3492     if ( defined ( $filename ) )
 
3494         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
 
3497     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
 
3499     while ( my $line = shift @{$self->{buffer}} )
 
3501         print {$self->{fh}} $line;
 
3507 This method indicates no logging is going to be used. It flushes any entries in
 
3508 the internal buffer, and sets a flag to ensure no further data is put there.
 
3517     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
 
3519     $self->{buffer} = [];
 
3524 Internal method. Returns true if the log file is open, false otherwise.
 
3531     return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
 
3535 =head2 debug info warn fatal
 
3537 These four methods are wrappers to _log. They provide the actual interface for
 
3541 sub debug { my $self = shift; $self->_log("debug", @_); }
 
3542 sub info  { my $self = shift; $self->_log("info" , @_); }
 
3543 sub warn  { my $self = shift; $self->_log("warn" , @_); }
 
3544 sub fatal { my $self = shift; $self->_log("fatal", @_); }
 
3548 This is an internal method called by the logging functions. It generates a
 
3549 timestamp and pushes the logged line either to file, or internal buffer.
 
3557     return if ( $self->{nolog} );
 
3559     my @time = localtime;
 
3560     my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
 
3570     if ( $self->_logopen )
 
3572         print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
 
3574         push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
 
3580 This method simply closes the file handle if one is open
 
3587     if ( $self->_logopen )
 
3593 package GITCVS::updater;
 
3596 #### Copyright The Open University UK - 2006.
 
3598 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
 
3599 ####          Martin Langhoff <martin@laptop.org>
 
3621     die "Need to specify a git repository" unless ( defined($config) and -d $config );
 
3622     die "Need to specify a module" unless ( defined($module) );
 
3624     $class = ref($class) || $class;
 
3628     bless $self, $class;
 
3630     $self->{valid_tables} = {'revision' => 1,
 
3631                              'revision_ix1' => 1,
 
3632                              'revision_ix2' => 1,
 
3638     $self->{module} = $module;
 
3639     $self->{git_path} = $config . "/";
 
3641     $self->{log} = $log;
 
3643     die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
 
3645     # Stores full sha1's for various branch/tag names, abbreviations, etc:
 
3646     $self->{commitRefCache} = {};
 
3648     $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
 
3649         $cfg->{gitcvs}{dbdriver} || "SQLite";
 
3650     $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
 
3651         $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
 
3652     $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
 
3653         $cfg->{gitcvs}{dbuser} || "";
 
3654     $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
 
3655         $cfg->{gitcvs}{dbpass} || "";
 
3656     $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
 
3657         $cfg->{gitcvs}{dbtablenameprefix} || "";
 
3658     my %mapping = ( m => $module,
 
3659                     a => $state->{method},
 
3660                     u => getlogin || getpwuid($<) || $<,
 
3661                     G => $self->{git_path},
 
3662                     g => mangle_dirname($self->{git_path}),
 
3664     $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
 
3665     $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
 
3666     $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
 
3667     $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
 
3669     die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
 
3670     die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
 
3671     $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
 
3674     die "Error connecting to database\n" unless defined $self->{dbh};
 
3676     $self->{tables} = {};
 
3677     foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
 
3679         $self->{tables}{$table} = 1;
 
3682     # Construct the revision table if required
 
3683     # The revision table stores an entry for each file, each time that file
 
3685     #   numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
 
3686     # This is not sufficient to support "-r {commithash}" for any
 
3687     # files except files that were modified by that commit (also,
 
3688     # some places in the code ignore/effectively strip out -r in
 
3689     # some cases, before it gets passed to getmeta()).
 
3690     # The "filehash" field typically has a git blob hash, but can also
 
3691     # be set to "dead" to indicate that the given version of the file
 
3692     # should not exist in the sandbox.
 
3693     unless ( $self->{tables}{$self->tablename("revision")} )
 
3695         my $tablename = $self->tablename("revision");
 
3696         my $ix1name = $self->tablename("revision_ix1");
 
3697         my $ix2name = $self->tablename("revision_ix2");
 
3699             CREATE TABLE $tablename (
 
3701                 revision   INTEGER NOT NULL,
 
3702                 filehash   TEXT NOT NULL,
 
3703                 commithash TEXT NOT NULL,
 
3704                 author     TEXT NOT NULL,
 
3705                 modified   TEXT NOT NULL,
 
3710             CREATE INDEX $ix1name
 
3711             ON $tablename (name,revision)
 
3714             CREATE INDEX $ix2name
 
3715             ON $tablename (name,commithash)
 
3719     # Construct the head table if required
 
3720     # The head table (along with the "last_commit" entry in the property
 
3721     # table) is the persisted working state of the "sub update" subroutine.
 
3722     # All of it's data is read entirely first, and completely recreated
 
3723     # last, every time "sub update" runs.
 
3724     # This is also used by "sub getmeta" when it is asked for the latest
 
3725     # version of a file (as opposed to some specific version).
 
3726     # Another way of thinking about it is as a single slice out of
 
3727     # "revisions", giving just the most recent revision information for
 
3729     unless ( $self->{tables}{$self->tablename("head")} )
 
3731         my $tablename = $self->tablename("head");
 
3732         my $ix1name = $self->tablename("head_ix1");
 
3734             CREATE TABLE $tablename (
 
3736                 revision   INTEGER NOT NULL,
 
3737                 filehash   TEXT NOT NULL,
 
3738                 commithash TEXT NOT NULL,
 
3739                 author     TEXT NOT NULL,
 
3740                 modified   TEXT NOT NULL,
 
3745             CREATE INDEX $ix1name
 
3746             ON $tablename (name)
 
3750     # Construct the properties table if required
 
3751     #  - "last_commit" - Used by "sub update".
 
3752     unless ( $self->{tables}{$self->tablename("properties")} )
 
3754         my $tablename = $self->tablename("properties");
 
3756             CREATE TABLE $tablename (
 
3757                 key        TEXT NOT NULL PRIMARY KEY,
 
3763     # Construct the commitmsgs table if required
 
3764     # The commitmsgs table is only used for merge commits, since
 
3765     # "sub update" will only keep one branch of parents.  Shortlogs
 
3766     # for ignored commits (i.e. not on the chosen branch) will be used
 
3767     # to construct a replacement "collapsed" merge commit message,
 
3768     # which will be stored in this table.  See also "sub commitmessage".
 
3769     unless ( $self->{tables}{$self->tablename("commitmsgs")} )
 
3771         my $tablename = $self->tablename("commitmsgs");
 
3773             CREATE TABLE $tablename (
 
3774                 key        TEXT NOT NULL PRIMARY KEY,
 
3791     if (exists $self->{valid_tables}{$name}) {
 
3792         return $self->{dbtablenameprefix} . $name;
 
3800 Bring the database up to date with the latest changes from
 
3803 Internal working state is read out of the "head" table and the
 
3804 "last_commit" property, then it updates "revisions" based on that, and
 
3805 finally it writes the new internal state back to the "head" table
 
3806 so it can be used as a starting point the next time update is called.
 
3813     # first lets get the commit list
 
3814     $ENV{GIT_DIR} = $self->{git_path};
 
3816     my $commitsha1 = ::safe_pipe_capture('git', 'rev-parse', $self->{module});
 
3819     my $commitinfo = ::safe_pipe_capture('git', 'cat-file', 'commit', $self->{module});
 
3820     unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
 
3822         die("Invalid module '$self->{module}'");
 
3827     my $lastcommit = $self->_get_prop("last_commit");
 
3829     if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
 
3830          # invalidate the gethead cache
 
3831          $self->clearCommitRefCaches();
 
3835     # Start exclusive lock here...
 
3836     $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
 
3838     # TODO: log processing is memory bound
 
3839     # if we can parse into a 2nd file that is in reverse order
 
3840     # we can probably do something really efficient
 
3841     my @git_log_params = ('--pretty', '--parents', '--topo-order');
 
3843     if (defined $lastcommit) {
 
3844         push @git_log_params, "$lastcommit..$self->{module}";
 
3846         push @git_log_params, $self->{module};
 
3848     # git-rev-list is the backend / plumbing version of git-log
 
3849     open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
 
3850                 or die "Cannot call git-rev-list: $!";
 
3851     my @commits=readCommits($gitLogPipe);
 
3854     # Now all the commits are in the @commits bucket
 
3855     # ordered by time DESC. for each commit that needs processing,
 
3856     # determine whether it's following the last head we've seen or if
 
3857     # it's on its own branch, grab a file list, and add whatever's changed
 
3858     # NOTE: $lastcommit refers to the last commit from previous run
 
3859     #       $lastpicked is the last commit we picked in this run
 
3862     if (defined $lastcommit) {
 
3863         $lastpicked = $lastcommit;
 
3866     my $committotal = scalar(@commits);
 
3867     my $commitcount = 0;
 
3869     # Load the head table into $head (for cached lookups during the update process)
 
3870     foreach my $file ( @{$self->gethead(1)} )
 
3872         $head->{$file->{name}} = $file;
 
3875     foreach my $commit ( @commits )
 
3877         $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
 
3878         if (defined $lastpicked)
 
3880             if (!in_array($lastpicked, @{$commit->{parents}}))
 
3882                 # skip, we'll see this delta
 
3883                 # as part of a merge later
 
3884                 # warn "skipping off-track  $commit->{hash}\n";
 
3886             } elsif (@{$commit->{parents}} > 1) {
 
3887                 # it is a merge commit, for each parent that is
 
3888                 # not $lastpicked (not given a CVS revision number),
 
3889                 # see if we can get a log
 
3890                 # from the merge-base to that parent to put it
 
3891                 # in the message as a merge summary.
 
3892                 my @parents = @{$commit->{parents}};
 
3893                 foreach my $parent (@parents) {
 
3894                     if ($parent eq $lastpicked) {
 
3897                     # git-merge-base can potentially (but rarely) throw
 
3898                     # several candidate merge bases. let's assume
 
3899                     # that the first one is the best one.
 
3901                             ::safe_pipe_capture('git', 'merge-base',
 
3902                                                  $lastpicked, $parent);
 
3904                     # The two branches may not be related at all,
 
3905                     # in which case merge base simply fails to find
 
3906                     # any, but that's Ok.
 
3912                         # print "want to log between  $base $parent \n";
 
3913                         open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
 
3914                           or die "Cannot call git-log: $!";
 
3918                             if (!defined $mergedhash) {
 
3919                                 if (m/^commit\s+(.+)$/) {
 
3925                                 # grab the first line that looks non-rfc822
 
3926                                 # aka has content after leading space
 
3927                                 if (m/^\s+(\S.*)$/) {
 
3929                                     $title = substr($title,0,100); # truncate
 
3930                                     unshift @merged, "$mergedhash $title";
 
3937                             $commit->{mergemsg} = $commit->{message};
 
3938                             $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
 
3939                             foreach my $summary (@merged) {
 
3940                                 $commit->{mergemsg} .= "\t$summary\n";
 
3942                             $commit->{mergemsg} .= "\n\n";
 
3943                             # print "Message for $commit->{hash} \n$commit->{mergemsg}";
 
3950         # convert the date to CVS-happy format
 
3951         my $cvsDate = convertToCvsDate($commit->{date});
 
3953         if ( defined ( $lastpicked ) )
 
3955             my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
 
3957             while ( <FILELIST> )
 
3960                 unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/o )
 
3962                     die("Couldn't process git-diff-tree line : $_");
 
3964                 my ($mode, $hash, $change) = ($1, $2, $3);
 
3965                 my $name = <FILELIST>;
 
3968                 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
 
3970                 my $dbMode = convertToDbMode($mode);
 
3972                 if ( $change eq "D" )
 
3974                     #$log->debug("DELETE   $name");
 
3977                         revision => $head->{$name}{revision} + 1,
 
3978                         filehash => "deleted",
 
3979                         commithash => $commit->{hash},
 
3980                         modified => $cvsDate,
 
3981                         author => $commit->{author},
 
3984                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
 
3986                 elsif ( $change eq "M" || $change eq "T" )
 
3988                     #$log->debug("MODIFIED $name");
 
3991                         revision => $head->{$name}{revision} + 1,
 
3993                         commithash => $commit->{hash},
 
3994                         modified => $cvsDate,
 
3995                         author => $commit->{author},
 
3998                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
 
4000                 elsif ( $change eq "A" )
 
4002                     #$log->debug("ADDED    $name");
 
4005                         revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
 
4007                         commithash => $commit->{hash},
 
4008                         modified => $cvsDate,
 
4009                         author => $commit->{author},
 
4012                     $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
 
4016                     $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
 
4022             # this is used to detect files removed from the repo
 
4023             my $seen_files = {};
 
4025             my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
 
4027             while ( <FILELIST> )
 
4030                 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
 
4032                     die("Couldn't process git-ls-tree line : $_");
 
4035                 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
 
4037                 $seen_files->{$git_filename} = 1;
 
4039                 my ( $oldhash, $oldrevision, $oldmode ) = (
 
4040                     $head->{$git_filename}{filehash},
 
4041                     $head->{$git_filename}{revision},
 
4042                     $head->{$git_filename}{mode}
 
4045                 my $dbMode = convertToDbMode($mode);
 
4047                 # unless the file exists with the same hash, we need to update it ...
 
4048                 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
 
4050                     my $newrevision = ( $oldrevision or 0 ) + 1;
 
4052                     $head->{$git_filename} = {
 
4053                         name => $git_filename,
 
4054                         revision => $newrevision,
 
4055                         filehash => $git_hash,
 
4056                         commithash => $commit->{hash},
 
4057                         modified => $cvsDate,
 
4058                         author => $commit->{author},
 
4063                     $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
 
4068             # Detect deleted files
 
4069             foreach my $file ( sort keys %$head )
 
4071                 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
 
4073                     $head->{$file}{revision}++;
 
4074                     $head->{$file}{filehash} = "deleted";
 
4075                     $head->{$file}{commithash} = $commit->{hash};
 
4076                     $head->{$file}{modified} = $cvsDate;
 
4077                     $head->{$file}{author} = $commit->{author};
 
4079                     $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $cvsDate, $commit->{author}, $head->{$file}{mode});
 
4082             # END : "Detect deleted files"
 
4086         if (exists $commit->{mergemsg})
 
4088             $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
 
4091         $lastpicked = $commit->{hash};
 
4093         $self->_set_prop("last_commit", $commit->{hash});
 
4096     $self->delete_head();
 
4097     foreach my $file ( sort keys %$head )
 
4101             $head->{$file}{revision},
 
4102             $head->{$file}{filehash},
 
4103             $head->{$file}{commithash},
 
4104             $head->{$file}{modified},
 
4105             $head->{$file}{author},
 
4106             $head->{$file}{mode},
 
4109     # invalidate the gethead cache
 
4110     $self->clearCommitRefCaches();
 
4113     # Ending exclusive lock here
 
4114     $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
 
4119     my $pipeHandle = shift;
 
4124     while ( <$pipeHandle> )
 
4127         if (m/^commit\s+(.*)$/) {
 
4128             # on ^commit lines put the just seen commit in the stack
 
4129             # and prime things for the next one
 
4132                 unshift @commits, \%copy;
 
4135             my @parents = split(m/\s+/, $1);
 
4136             $commit{hash} = shift @parents;
 
4137             $commit{parents} = \@parents;
 
4138         } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
 
4139             # on rfc822-like lines seen before we see any message,
 
4140             # lowercase the entry and put it in the hash as key-value
 
4141             $commit{lc($1)} = $2;
 
4143             # message lines - skip initial empty line
 
4144             # and trim whitespace
 
4145             if (!exists($commit{message}) && m/^\s*$/) {
 
4146                 # define it to mark the end of headers
 
4147                 $commit{message} = '';
 
4150             s/^\s+//; s/\s+$//; # trim ws
 
4151             $commit{message} .= $_ . "\n";
 
4155     unshift @commits, \%commit if ( keys %commit );
 
4160 sub convertToCvsDate
 
4163     # Convert from: "git rev-list --pretty" formatted date
 
4164     # Convert to: "the format specified by RFC822 as modified by RFC1123."
 
4165     # Example: 26 May 1997 13:01:40 -0400
 
4166     if( $date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ )
 
4168         $date = "$2 $1 $4 $3 $5";
 
4178     # NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",
 
4179     #  but the database "mode" column historically (and currently)
 
4180     #  only stores the "rw" (for user) part of the string.
 
4181     #    FUTURE: It might make more sense to persist the raw
 
4182     #  octal mode (or perhaps the final full CVS form) instead of
 
4183     #  this half-converted form, but it isn't currently worth the
 
4184     #  backwards compatibility headaches.
 
4186     $mode=~/^\d{3}(\d)\d\d$/;
 
4190     $dbMode .= "r" if ( $userBits & 4 );
 
4191     $dbMode .= "w" if ( $userBits & 2 );
 
4192     $dbMode .= "x" if ( $userBits & 1 );
 
4193     $dbMode = "rw" if ( $dbMode eq "" );
 
4202     my $revision = shift;
 
4203     my $filehash = shift;
 
4204     my $commithash = shift;
 
4205     my $modified = shift;
 
4208     my $tablename = $self->tablename("revision");
 
4210     my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
 
4211     $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
 
4219     my $tablename = $self->tablename("commitmsgs");
 
4221     my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
 
4222     $insert_mergelog->execute($key, $value);
 
4228     my $tablename = $self->tablename("head");
 
4230     my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
 
4231     $delete_head->execute();
 
4238     my $revision = shift;
 
4239     my $filehash = shift;
 
4240     my $commithash = shift;
 
4241     my $modified = shift;
 
4244     my $tablename = $self->tablename("head");
 
4246     my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
 
4247     $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
 
4254     my $tablename = $self->tablename("properties");
 
4256     my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
 
4257     $db_query->execute($key);
 
4258     my ( $value ) = $db_query->fetchrow_array;
 
4268     my $tablename = $self->tablename("properties");
 
4270     my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
 
4271     $db_query->execute($value, $key);
 
4273     unless ( $db_query->rows )
 
4275         $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
 
4276         $db_query->execute($key, $value);
 
4290     my $tablename = $self->tablename("head");
 
4292     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
 
4294     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
 
4295     $db_query->execute();
 
4298     while ( my $file = $db_query->fetchrow_hashref )
 
4302             $file->{revision} = "1.$file->{revision}"
 
4307     $self->{gethead_cache} = $tree;
 
4314 Returns a reference to an array of getmeta structures, one
 
4315 per file in the specified tree hash.
 
4321     my ($self,$hash) = @_;
 
4325         return $self->gethead();
 
4330         open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
 
4331                 or die("Cannot call git-ls-tree : $!");
 
4339     foreach $line (@files)
 
4342         unless ( $line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
 
4344             die("Couldn't process git-ls-tree line : $_");
 
4347         my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
 
4348         push @$tree, $self->getMetaFromCommithash($git_filename,$hash);
 
4354 =head2 getRevisionDirMap
 
4356 A "revision dir map" contains all the plain-file filenames associated
 
4357 with a particular revision (tree-ish), organized by directory:
 
4359   $type = $out->{$dir}{$fullName}
 
4361 The type of each is "F" (for ordinary file) or "D" (for directory,
 
4362 for which the map $out->{$fullName} will also exist).
 
4366 sub getRevisionDirMap
 
4370     if(!defined($self->{revisionDirMapCache}))
 
4372         $self->{revisionDirMapCache}={};
 
4375         # Get file list (previously cached results are dependent on HEAD,
 
4376         # but are early in each case):
 
4379     if( !defined($ver) || $ver eq "" )
 
4382         if( defined($self->{revisionDirMapCache}{$cacheKey}) )
 
4384             return $self->{revisionDirMapCache}{$cacheKey};
 
4387         my @head = @{$self->gethead()};
 
4388         foreach my $file ( @head )
 
4390             next if ( $file->{filehash} eq "deleted" );
 
4392             push @fileList,$file->{name};
 
4397         my ($hash)=$self->lookupCommitRef($ver);
 
4398         if( !defined($hash) )
 
4404         if( defined($self->{revisionDirMapCache}{$cacheKey}) )
 
4406             return $self->{revisionDirMapCache}{$cacheKey};
 
4409         open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
 
4410                 or die("Cannot call git-ls-tree : $!");
 
4412         while ( <$filePipe> )
 
4415             unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
 
4417                 die("Couldn't process git-ls-tree line : $_");
 
4420             my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
 
4422             push @fileList, $git_filename;
 
4427         # Convert to normalized form:
 
4430     foreach $file (@fileList)
 
4432         my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);
 
4433         $dir='' if(!defined($dir));
 
4435             # parent directories:
 
4436             # ... create empty dir maps for parent dirs:
 
4438         while(!defined($revMap{$td}))
 
4442             my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
 
4443             $tp='' if(!defined($tp));
 
4446             # ... add children to parent maps (now that they exist):
 
4450             my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
 
4451             $tp='' if(!defined($tp));
 
4453             if(defined($revMap{$tp}{$td}))
 
4455                 if($revMap{$tp}{$td} ne 'D')
 
4457                     die "Weird file/directory inconsistency in $cacheKey";
 
4461             $revMap{$tp}{$td}='D';
 
4467         $revMap{$dir}{$file}='F';
 
4471     $self->{revisionDirMapCache}{$cacheKey}=\%revMap;
 
4472     return $self->{revisionDirMapCache}{$cacheKey};
 
4477 See also gethistorydense().
 
4484     my $filename = shift;
 
4485     my $revFilter = shift;
 
4487     my $tablename = $self->tablename("revision");
 
4490     # TODO: date, state, or by specific logins filters?
 
4491     # TODO: Handle comma-separated list of revFilter items, each item
 
4492     #   can be a range [only case currently handled] or individual
 
4493     #   rev or branch or "branch.".
 
4494     # TODO: Adjust $db_query WHERE clause based on revFilter, instead of
 
4495     #   manually filtering the results of the query?
 
4496     my ( $minrev, $maxrev );
 
4497     if( defined($revFilter) and
 
4498         $state->{opt}{r} =~ /^(1.(\d+))?(::?)(1.(\d.+))?$/ )
 
4503         $minrev++ if ( defined($minrev) and $control eq "::" );
 
4506     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
 
4507     $db_query->execute($filename);
 
4511     while ( my $file = $db_query->fetchrow_hashref )
 
4514         if( defined($minrev) and $file->{revision} < $minrev )
 
4518         if( defined($maxrev) and $file->{revision} > $maxrev )
 
4523         $file->{revision} = "1." . $file->{revision};
 
4527     return ($tree,$totalRevs);
 
4532 This function takes a filename (with path) argument and returns a hashref of
 
4533 metadata for that file.
 
4535 There are several ways $revision can be specified:
 
4537    - A reference to hash that contains a "tag" that is the
 
4538      actual revision (one of the below).  TODO: Also allow it to
 
4539      specify a "date" in the hash.
 
4540    - undef, to refer to the latest version on the main branch.
 
4541    - Full CVS client revision number (mapped to integer in DB, without the
 
4543    - Complex CVS-compatible "special" revision number for
 
4544      non-linear history (see comment below)
 
4545    - git commit sha1 hash
 
4546    - branch or tag name
 
4553     my $filename = shift;
 
4554     my $revision = shift;
 
4555     my $tablename_rev = $self->tablename("revision");
 
4556     my $tablename_head = $self->tablename("head");
 
4558     if ( ref($revision) eq "HASH" )
 
4560         $revision = $revision->{tag};
 
4563     # Overview of CVS revision numbers:
 
4565     # General CVS numbering scheme:
 
4566     #   - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.
 
4567     #   - Result of "cvs checkin -r" (possible, but not really
 
4568     #     recommended): "2.1", "2.2", etc
 
4569     #   - Branch tag: "1.2.0.n", where "1.2" is revision it was branched
 
4570     #     from, "0" is a magic placeholder that identifies it as a
 
4571     #     branch tag instead of a version tag, and n is 2 times the
 
4572     #     branch number off of "1.2", starting with "2".
 
4573     #   - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"
 
4574     #     is branch number off of "1.2" (like n above), and "x" is
 
4575     #     the version number on the branch.
 
4576     #   - Branches can branch off of branches: "1.3.2.7.4.1" (even number
 
4578     #   - Odd "n"s are used by "vendor branches" that result
 
4579     #     from "cvs import".  Vendor branches have additional
 
4580     #     strangeness in the sense that the main rcs "head" of the main
 
4581     #     branch will (temporarily until first normal commit) point
 
4582     #     to the version on the vendor branch, rather than the actual
 
4583     #     main branch.  (FUTURE: This may provide an opportunity
 
4584     #     to use "strange" revision numbers for fast-forward-merged
 
4585     #     branch tip when CVS client is asking for the main branch.)
 
4587     # git-cvsserver CVS-compatible special numbering schemes:
 
4588     #   - Currently git-cvsserver only tries to be identical to CVS for
 
4589     #     simple "1.x" numbers on the "main" branch (as identified
 
4590     #     by the module name that was originally cvs checkout'ed).
 
4591     #   - The database only stores the "x" part, for historical reasons.
 
4592     #     But most of the rest of the cvsserver preserves
 
4593     #     and thinks using the full revision number.
 
4594     #   - To handle non-linear history, it uses a version of the form
 
4595     #     "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely
 
4596     #     identify this as a special revision number, and there are
 
4597     #     20 b's that together encode the sha1 git commit from which
 
4598     #     this version of this file originated.  Each b is
 
4599     #     the numerical value of the corresponding byte plus
 
4601     #      - "plus 100" avoids "0"s, and also reduces the
 
4602     #        likelihood of a collision in the case that someone someday
 
4603     #        writes an import tool that tries to preserve original
 
4604     #        CVS revision numbers, and the original CVS data had done
 
4605     #        lots of branches off of branches and other strangeness to
 
4606     #        end up with a real version number that just happens to look
 
4607     #        like this special revision number form.  Also, if needed
 
4608     #        there are several ways to extend/identify alternative encodings
 
4609     #        within the "2.1.1.2000" part if necessary.
 
4610     #      - Unlike real CVS revisions, you can't really reconstruct what
 
4611     #        relation a revision of this form has to other revisions.
 
4612     #   - FUTURE: TODO: Rework database somehow to make up and remember
 
4613     #     fully-CVS-compatible branches and branch version numbers.
 
4616     if ( defined($revision) )
 
4618         if ( $revision =~ /^1\.(\d+)$/ )
 
4622             $db_query = $self->{dbh}->prepare_cached(
 
4623                 "SELECT * FROM $tablename_rev WHERE name=? AND revision=?",
 
4625             $db_query->execute($filename, $intRev);
 
4626             $meta = $db_query->fetchrow_hashref;
 
4628         elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){20}$/ )
 
4630             my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
 
4631             $commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
 
4632             if($commitHash=~/^[0-9a-f]{40}$/)
 
4634                 return $self->getMetaFromCommithash($filename,$commitHash);
 
4637             # error recovery: fall back on head version below
 
4638             print "E Failed to find $filename version=$revision or commit=$commitHash\n";
 
4639             $log->warning("failed get $revision with commithash=$commitHash");
 
4642         elsif ( $revision =~ /^[0-9a-f]{40}$/ )
 
4644             # Try DB first.  This is mostly only useful for req_annotate(),
 
4645             # which only calls this for stuff that should already be in
 
4646             # the DB.  It is fairly likely to be a waste of time
 
4647             # in most other cases [unless the file happened to be
 
4648             # modified in $revision specifically], but
 
4649             # it is probably in the noise compared to how long
 
4650             # getMetaFromCommithash() will take.
 
4652             $db_query = $self->{dbh}->prepare_cached(
 
4653                 "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
 
4655             $db_query->execute($filename, $revision);
 
4656             $meta = $db_query->fetchrow_hashref;
 
4660                 my($revCommit)=$self->lookupCommitRef($revision);
 
4661                 if($revCommit=~/^[0-9a-f]{40}$/)
 
4663                     return $self->getMetaFromCommithash($filename,$revCommit);
 
4666                 # error recovery: nothing found:
 
4667                 print "E Failed to find $filename version=$revision\n";
 
4668                 $log->warning("failed get $revision");
 
4674             my($revCommit)=$self->lookupCommitRef($revision);
 
4675             if($revCommit=~/^[0-9a-f]{40}$/)
 
4677                 return $self->getMetaFromCommithash($filename,$revCommit);
 
4680             # error recovery: fall back on head version below
 
4681             print "E Failed to find $filename version=$revision\n";
 
4682             $log->warning("failed get $revision");
 
4683             undef $revision;  # Allow fallback
 
4687     if(!defined($revision))
 
4690         $db_query = $self->{dbh}->prepare_cached(
 
4691                 "SELECT * FROM $tablename_head WHERE name=?",{},1);
 
4692         $db_query->execute($filename);
 
4693         $meta = $db_query->fetchrow_hashref;
 
4698         $meta->{revision} = "1.$meta->{revision}";
 
4703 sub getMetaFromCommithash
 
4706     my $filename = shift;
 
4707     my $revCommit = shift;
 
4709     # NOTE: This function doesn't scale well (lots of forks), especially
 
4710     #   if you have many files that have not been modified for many commits
 
4711     #   (each git-rev-parse redoes a lot of work for each file
 
4712     #   that theoretically could be done in parallel by smarter
 
4715     # TODO: Possible optimization strategies:
 
4716     #   - Solve the issue of assigning and remembering "real" CVS
 
4717     #     revision numbers for branches, and ensure the
 
4718     #     data structure can do this efficiently.  Perhaps something
 
4719     #     similar to "git notes", and carefully structured to take
 
4720     #     advantage same-sha1-is-same-contents, to roll the same
 
4721     #     unmodified subdirectory data onto multiple commits?
 
4722     #   - Write and use a C tool that is like git-blame, but
 
4723     #     operates on multiple files with file granularity, instead
 
4724     #     of one file with line granularity.  Cache
 
4725     #     most-recently-modified in $self->{commitRefCache}{$revCommit}.
 
4726     #     Try to be intelligent about how many files we do with
 
4727     #     one fork (perhaps one directory at a time, without recursion,
 
4728     #     and/or include directory as one line item, recurse from here
 
4729     #     instead of in C tool?).
 
4730     #   - Perhaps we could ask the DB for (filename,fileHash),
 
4731     #     and just guess that it is correct (that the file hadn't
 
4732     #     changed between $revCommit and the found commit, then
 
4733     #     changed back, confusing anything trying to interpret
 
4734     #     history).  Probably need to add another index to revisions
 
4735     #     DB table for this.
 
4736     #   - NOTE: Trying to store all (commit,file) keys in DB [to
 
4737     #     find "lastModfiedCommit] (instead of
 
4738     #     just files that changed in each commit as we do now) is
 
4739     #     probably not practical from a disk space perspective.
 
4741         # Does the file exist in $revCommit?
 
4742     # TODO: Include file hash in dirmap cache.
 
4743     my($dirMap)=$self->getRevisionDirMap($revCommit);
 
4744     my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);
 
4749     if( !defined($dirMap->{$dir}) ||
 
4750         !defined($dirMap->{$dir}{$filename}) )
 
4752         my($fileHash)="deleted";
 
4755         $retVal->{name}=$filename;
 
4756         $retVal->{filehash}=$fileHash;
 
4758             # not needed and difficult to compute:
 
4759         $retVal->{revision}="0";  # $revision;
 
4760         $retVal->{commithash}=$revCommit;
 
4761         #$retVal->{author}=$commit->{author};
 
4762         #$retVal->{modified}=convertToCvsDate($commit->{date});
 
4763         #$retVal->{mode}=convertToDbMode($mode);
 
4768     my($fileHash) = ::safe_pipe_capture("git","rev-parse","$revCommit:$filename");
 
4770     if(!($fileHash=~/^[0-9a-f]{40}$/))
 
4772         die "Invalid fileHash '$fileHash' looking up"
 
4773                     ." '$revCommit:$filename'\n";
 
4776     # information about most recent commit to modify $filename:
 
4777     open(my $gitLogPipe, '-|', 'git', 'rev-list',
 
4778          '--max-count=1', '--pretty', '--parents',
 
4779          $revCommit, '--', $filename)
 
4780                 or die "Cannot call git-rev-list: $!";
 
4781     my @commits=readCommits($gitLogPipe);
 
4783     if(scalar(@commits)!=1)
 
4785         die "Can't find most recent commit changing $filename\n";
 
4787     my($commit)=$commits[0];
 
4788     if( !defined($commit) || !defined($commit->{hash}) )
 
4793     # does this (commit,file) have a real assigned CVS revision number?
 
4794     my $tablename_rev = $self->tablename("revision");
 
4796     $db_query = $self->{dbh}->prepare_cached(
 
4797         "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
 
4799     $db_query->execute($filename, $commit->{hash});
 
4800     my($meta)=$db_query->fetchrow_hashref;
 
4803         $meta->{revision} = "1.$meta->{revision}";
 
4807     # fall back on special revision number
 
4808     my($revision)=$commit->{hash};
 
4809     $revision=~s/(..)/'.' . (hex($1)+100)/eg;
 
4810     $revision="2.1.1.2000$revision";
 
4812     # meta data about $filename:
 
4813     open(my $filePipe, '-|', 'git', 'ls-tree', '-z',
 
4814                 $commit->{hash}, '--', $filename)
 
4815             or die("Cannot call git-ls-tree : $!");
 
4819     if(defined(<$filePipe>))
 
4821         die "Expected only a single file for git-ls-tree $filename\n";
 
4826     unless ( $line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
 
4828         die("Couldn't process git-ls-tree line : $line\n");
 
4830     my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
 
4834     $retVal->{name}=$filename;
 
4835     $retVal->{revision}=$revision;
 
4836     $retVal->{filehash}=$fileHash;
 
4837     $retVal->{commithash}=$revCommit;
 
4838     $retVal->{author}=$commit->{author};
 
4839     $retVal->{modified}=convertToCvsDate($commit->{date});
 
4840     $retVal->{mode}=convertToDbMode($mode);
 
4845 =head2 lookupCommitRef
 
4847 Convert tag/branch/abbreviation/etc into a commit sha1 hash.  Caches
 
4848 the result so looking it up again is fast.
 
4857     my $commitHash = $self->{commitRefCache}{$ref};
 
4858     if(defined($commitHash))
 
4863     $commitHash = ::safe_pipe_capture("git","rev-parse","--verify","--quiet",
 
4864                                       $self->unescapeRefName($ref));
 
4865     $commitHash=~s/\s*$//;
 
4866     if(!($commitHash=~/^[0-9a-f]{40}$/))
 
4871     if( defined($commitHash) )
 
4873         my $type = ::safe_pipe_capture("git","cat-file","-t",$commitHash);
 
4874         if( ! ($type=~/^commit\s*$/ ) )
 
4879     if(defined($commitHash))
 
4881         $self->{commitRefCache}{$ref}=$commitHash;
 
4886 =head2 clearCommitRefCaches
 
4888 Clears cached commit cache (sha1's for various tags/abbeviations/etc),
 
4893 sub clearCommitRefCaches
 
4896     $self->{commitRefCache} = {};
 
4897     $self->{revisionDirMapCache} = undef;
 
4898     $self->{gethead_cache} = undef;
 
4901 =head2 commitmessage
 
4903 this function takes a commithash and returns the commit message for that commit
 
4909     my $commithash = shift;
 
4910     my $tablename = $self->tablename("commitmsgs");
 
4912     die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
 
4915     $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
 
4916     $db_query->execute($commithash);
 
4918     my ( $message ) = $db_query->fetchrow_array;
 
4920     if ( defined ( $message ) )
 
4922         $message .= " " if ( $message =~ /\n$/ );
 
4926     my @lines = ::safe_pipe_capture("git", "cat-file", "commit", $commithash);
 
4927     shift @lines while ( $lines[0] =~ /\S/ );
 
4928     $message = join("",@lines);
 
4929     $message .= " " if ( $message =~ /\n$/ );
 
4933 =head2 gethistorydense
 
4935 This function takes a filename (with path) argument and returns an arrayofarrays
 
4936 containing revision,filehash,commithash ordered by revision descending.
 
4938 This version of gethistory skips deleted entries -- so it is useful for annotate.
 
4939 The 'dense' part is a reference to a '--dense' option available for git-rev-list
 
4940 and other git tools that depend on it.
 
4948     my $filename = shift;
 
4949     my $tablename = $self->tablename("revision");
 
4952     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
 
4953     $db_query->execute($filename);
 
4955     my $result = $db_query->fetchall_arrayref;
 
4958     for($i=0 ; $i<scalar(@$result) ; $i++)
 
4960         $result->[$i][0]="1." . $result->[$i][0];
 
4966 =head2 escapeRefName
 
4968 Apply an escape mechanism to compensate for characters that
 
4969 git ref names can have that CVS tags can not.
 
4974     my($self,$refName)=@_;
 
4976     # CVS officially only allows [-_A-Za-z0-9] in tag names (or in
 
4977     # many contexts it can also be a CVS revision number).
 
4979     # Git tags commonly use '/' and '.' as well, but also handle
 
4980     # anything else just in case:
 
4984     #   = "_-u-"  For underscore, in case someone wants a literal "_-" in
 
4986     #   = "_-xx-" Where "xx" is the hexadecimal representation of the
 
4987     #     desired ASCII character byte. (for anything else)
 
4989     if(! $refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)
 
4991         $refName=~s/_-/_-u--/g;
 
4992         $refName=~s/\./_-p-/g;
 
4993         $refName=~s%/%_-s-%g;
 
4994         $refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;
 
4998 =head2 unescapeRefName
 
5000 Undo an escape mechanism to compensate for characters that
 
5001 git ref names can have that CVS tags can not.
 
5006     my($self,$refName)=@_;
 
5008     # see escapeRefName() for description of escape mechanism.
 
5010     $refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;
 
5013     # TODO: Perhaps use git check-ref-format, with an in-process cache of
 
5015     if( !( $refName=~m%^[^-][-a-zA-Z0-9_/.]*$% ) ||
 
5016         ( $refName=~m%[/.]$% ) ||
 
5017         ( $refName=~/\.lock$/ ) ||
 
5018         ( $refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) )  # matching }
 
5021         $log->warn("illegal refName: $refName");
 
5027 sub unescapeRefNameChar
 
5043     elsif($char=~/^[0-9a-f][0-9a-f]$/)
 
5045         $char=chr(hex($char));
 
5049         # Error case: Maybe it has come straight from user, and
 
5050         # wasn't supposed to be escaped?  Restore it the way we got it:
 
5059 from Array::PAT - mimics the in_array() function
 
5060 found in PHP. Yuck but works for small arrays.
 
5065     my ($check, @array) = @_;
 
5067     foreach my $test (@array){
 
5068         if($check eq $test){
 
5075 =head2 mangle_dirname
 
5077 create a string from a directory name that is suitable to use as
 
5078 part of a filename, mainly by converting all chars except \w.- to _
 
5081 sub mangle_dirname {
 
5082     my $dirname = shift;
 
5083     return unless defined $dirname;
 
5085     $dirname =~ s/[^\w.-]/_/g;
 
5090 =head2 mangle_tablename
 
5092 create a string from a that is suitable to use as part of an SQL table
 
5093 name, mainly by converting all chars except \w to _
 
5096 sub mangle_tablename {
 
5097     my $tablename = shift;
 
5098     return unless defined $tablename;
 
5100     $tablename =~ s/[^\w_]/_/g;