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