git-cvsserver.perl 159 KB
Newer Older
1 2 3 4 5 6 7 8 9 10
#!/usr/bin/perl

####
#### This application is a CVS emulation layer for git.
#### It is intended for clients to connect over SSH.
#### See the documentation for more details.
####
#### Copyright The Open University UK - 2006.
####
#### Authors: Martyn Smith    <martyn@catalyst.net.nz>
11
####          Martin Langhoff <martin@laptop.org>
12 13 14 15 16 17
####
####
#### Released under the GNU Public License, version 2.
####
####

18
use 5.008;
19 20
use strict;
use warnings;
21
use bytes;
22 23 24

use Fcntl;
use File::Temp qw/tempdir tempfile/;
25
use File::Path qw/rmtree/;
26
use File::Basename;
27 28 29
use Getopt::Long qw(:config require_order no_ignore_case);

my $VERSION = '@@GIT_VERSION@@';
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53

my $log = GITCVS::log->new();
my $cfg;

my $DATE_LIST = {
    Jan => "01",
    Feb => "02",
    Mar => "03",
    Apr => "04",
    May => "05",
    Jun => "06",
    Jul => "07",
    Aug => "08",
    Sep => "09",
    Oct => "10",
    Nov => "11",
    Dec => "12",
};

# Enable autoflush for STDOUT (otherwise the whole thing falls apart)
$| = 1;

#### Definition and mappings of functions ####

54 55 56 57
# NOTE: Despite the existence of req_CATCHALL and req_EMPTY unimplemented
#  requests, this list is incomplete.  It is missing many rarer/optional
#  requests.  Perhaps some clients require a claim of support for
#  these specific requests for main functionality to work?
58 59 60 61 62
my $methods = {
    'Root'            => \&req_Root,
    'Valid-responses' => \&req_Validresponses,
    'valid-requests'  => \&req_validrequests,
    'Directory'       => \&req_Directory,
63
    'Sticky'          => \&req_Sticky,
64 65 66
    'Entry'           => \&req_Entry,
    'Modified'        => \&req_Modified,
    'Unchanged'       => \&req_Unchanged,
67
    'Questionable'    => \&req_Questionable,
68 69 70 71 72 73 74 75 76 77
    'Argument'        => \&req_Argument,
    'Argumentx'       => \&req_Argument,
    'expand-modules'  => \&req_expandmodules,
    'add'             => \&req_add,
    'remove'          => \&req_remove,
    'co'              => \&req_co,
    'update'          => \&req_update,
    'ci'              => \&req_ci,
    'diff'            => \&req_diff,
    'log'             => \&req_log,
78
    'rlog'            => \&req_log,
79 80 81 82
    'tag'             => \&req_CATCHALL,
    'status'          => \&req_status,
    'admin'           => \&req_CATCHALL,
    'history'         => \&req_CATCHALL,
83 84
    'watchers'        => \&req_EMPTY,
    'editors'         => \&req_EMPTY,
85
    'noop'            => \&req_EMPTY,
86 87 88 89 90 91 92 93 94
    'annotate'        => \&req_annotate,
    'Global_option'   => \&req_Globaloption,
};

##############################################


# $state holds all the bits of information the clients sends us that could
# potentially be useful when it comes to actually _doing_ something.
95
my $state = { prependdir => '' };
96 97 98 99 100 101 102 103 104 105 106

# Work is for managing temporary working directory
my $work =
    {
        state => undef,  # undef, 1 (empty), 2 (with stuff)
        workDir => undef,
        index => undef,
        emptyDir => undef,
        tmpDir => undef
    };

107 108
$log->info("--------------- STARTING -----------------");

109
my $usage =
110
    "usage: git cvsserver [options] [pserver|server] [<directory> ...]\n".
111
    "    --base-path <path>  : Prepend to requested CVSROOT\n".
112
    "                          Can be read from GIT_CVSSERVER_BASE_PATH\n".
113 114 115
    "    --strict-paths      : Don't allow recursing into subdirectories\n".
    "    --export-all        : Don't check for gitcvs.enabled in config\n".
    "    --version, -V       : Print version information and exit\n".
116
    "    -h, -H              : Print usage information and exit\n".
117 118 119
    "\n".
    "<directory> ... is a list of allowed directories. If no directories\n".
    "are given, all are allowed. This is an additional restriction, gitcvs\n".
120 121
    "access still needs to be enabled by the gitcvs.enabled config option.\n".
    "Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n";
122

123
my @opts = ( 'h|H', 'version|V',
124 125 126 127 128 129 130 131 132 133 134 135 136
	     'base-path=s', 'strict-paths', 'export-all' );
GetOptions( $state, @opts )
    or die $usage;

if ($state->{version}) {
    print "git-cvsserver version $VERSION\n";
    exit;
}
if ($state->{help}) {
    print $usage;
    exit;
}

137 138 139
my $TEMP_DIR = tempdir( CLEANUP => 1 );
$log->debug("Temporary directory is '$TEMP_DIR'");

140 141 142 143 144 145 146 147 148 149 150 151 152
$state->{method} = 'ext';
if (@ARGV) {
    if ($ARGV[0] eq 'pserver') {
	$state->{method} = 'pserver';
	shift @ARGV;
    } elsif ($ARGV[0] eq 'server') {
	shift @ARGV;
    }
}

# everything else is a directory
$state->{allowed_roots} = [ @ARGV ];

153 154 155 156 157
# don't export the whole system unless the users requests it
if ($state->{'export-all'} && !@{$state->{allowed_roots}}) {
    die "--export-all can only be used together with an explicit whitelist\n";
}

158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175
# Environment handling for running under git-shell
if (exists $ENV{GIT_CVSSERVER_BASE_PATH}) {
    if ($state->{'base-path'}) {
	die "Cannot specify base path both ways.\n";
    }
    my $base_path = $ENV{GIT_CVSSERVER_BASE_PATH};
    $state->{'base-path'} = $base_path;
    $log->debug("Picked up base path '$base_path' from environment.\n");
}
if (exists $ENV{GIT_CVSSERVER_ROOT}) {
    if (@{$state->{allowed_roots}}) {
	die "Cannot specify roots both ways: @ARGV\n";
    }
    my $allowed_root = $ENV{GIT_CVSSERVER_ROOT};
    $state->{allowed_roots} = [ $allowed_root ];
    $log->debug("Picked up allowed root '$allowed_root' from environment.\n");
}

176
# if we are called with a pserver argument,
177
# deal with the authentication cat before entering the
178
# main loop
179
if ($state->{method} eq 'pserver') {
180
    my $line = <STDIN>; chomp $line;
181
    unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
182 183
       die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
    }
184
    my $request = $1;
185
    $line = <STDIN>; chomp $line;
186 187 188 189
    unless (req_Root('root', $line)) { # reuse Root
       print "E Invalid root $line \n";
       exit 1;
    }
190
    $line = <STDIN>; chomp $line;
191 192 193 194
    my $user = $line;
    $line = <STDIN>; chomp $line;
    my $password = $line;

195 196 197 198 199 200 201 202 203 204 205
    if ($user eq 'anonymous') {
        # "A" will be 1 byte, use length instead in case the
        # encryption method ever changes (yeah, right!)
        if (length($password) > 1 ) {
            print "E Don't supply a password for the `anonymous' user\n";
            print "I HATE YOU\n";
            exit 1;
        }

        # Fall through to LOVE
    } else {
206
        # Trying to authenticate a user
207
        if (not exists $cfg->{gitcvs}->{authdb}) {
208 209 210 211 212 213 214 215 216
            print "E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n";
            print "I HATE YOU\n";
            exit 1;
        }

        my $authdb = $cfg->{gitcvs}->{authdb};

        unless (-e $authdb) {
            print "E The authentication database specified in [gitcvs.authdb] does not exist\n";
217 218
            print "I HATE YOU\n";
            exit 1;
219
        }
220 221

        my $auth_ok;
222
        open my $passwd, "<", $authdb or die $!;
223 224
        while (<$passwd>) {
            if (m{^\Q$user\E:(.*)}) {
225
                if (crypt($user, descramble($password)) eq $1) {
226 227 228 229 230 231 232
                    $auth_ok = 1;
                }
            };
        }
        close $passwd;

        unless ($auth_ok) {
233 234 235
            print "I HATE YOU\n";
            exit 1;
        }
236 237

        # Fall through to LOVE
238
    }
239 240 241 242

    # For checking whether the user is anonymous on commit
    $state->{user} = $user;

243
    $line = <STDIN>; chomp $line;
244 245
    unless ($line eq "END $request REQUEST") {
       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 250 251
    # and now back to our regular programme...
}

252 253 254 255 256
# Keep going until the client closes the connection
while (<STDIN>)
{
    chomp;

257
    # Check to see if we've seen this method, and call appropriate function.
258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275
    if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
    {
        # use the $methods hash to call the appropriate sub for this command
        #$log->info("Method : $1");
        &{$methods->{$1}}($1,$2);
    } else {
        # log fatal because we don't understand this function. If this happens
        # we're fairly screwed because we don't know if the client is expecting
        # a response. If it is, the client will hang, we'll hang, and the whole
        # thing will be custard.
        $log->fatal("Don't understand command $_\n");
        die("Unknown command $_");
    }
}

$log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
$log->info("--------------- FINISH -----------------");

276 277 278
chdir '/';
exit 0;

279 280 281 282 283 284 285 286 287 288
# Magic catchall method.
#    This is the method that will handle all commands we haven't yet
#    implemented. It simply sends a warning to the log file indicating a
#    command that hasn't been implemented has been invoked.
sub req_CATCHALL
{
    my ( $cmd, $data ) = @_;
    $log->warn("Unhandled command : req_$cmd : $data");
}

289 290 291 292 293
# This method invariably succeeds with an empty response.
sub req_EMPTY
{
    print "ok\n";
}
294 295 296 297 298 299 300 301 302 303 304 305 306 307 308

# Root pathname \n
#     Response expected: no. Tell the server which CVSROOT to use. Note that
#     pathname is a local directory and not a fully qualified CVSROOT variable.
#     pathname must already exist; if creating a new root, use the init
#     request, not Root. pathname does not include the hostname of the server,
#     how to access the server, etc.; by the time the CVS protocol is in use,
#     connection, authentication, etc., are already taken care of. The Root
#     request must be sent only once, and it must be sent before any requests
#     other than Valid-responses, valid-requests, UseUnchanged, Set or init.
sub req_Root
{
    my ( $cmd, $data ) = @_;
    $log->debug("req_Root : $data");

309 310 311 312 313
    unless ($data =~ m#^/#) {
	print "error 1 Root must be an absolute pathname\n";
	return 0;
    }

314 315 316 317
    my $cvsroot = $state->{'base-path'} || '';
    $cvsroot =~ s#/+$##;
    $cvsroot .= $data;

318
    if ($state->{CVSROOT}
319
	&& ($state->{CVSROOT} ne $cvsroot)) {
320 321 322 323
	print "error 1 Conflicting roots specified\n";
	return 0;
    }

324
    $state->{CVSROOT} = $cvsroot;
325 326

    $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351

    if (@{$state->{allowed_roots}}) {
	my $allowed = 0;
	foreach my $dir (@{$state->{allowed_roots}}) {
	    next unless $dir =~ m#^/#;
	    $dir =~ s#/+$##;
	    if ($state->{'strict-paths'}) {
		if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
		    $allowed = 1;
		    last;
		}
	    } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
		$allowed = 1;
		last;
	    }
	}

	unless ($allowed) {
	    print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
	    print "E \n";
	    print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
	    return 0;
	}
    }

352 353
    unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
       print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
354 355
       print "E \n";
       print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
356 357
       return 0;
    }
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 365 366
       return 0;
    }
    foreach my $line ( @gitvars )
367
    {
368
        next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
369 370
        unless ($2) {
            $cfg->{$1}{$3} = $4;
371 372 373
        } else {
            $cfg->{$1}{$2}{$3} = $4;
        }
374 375
    }

376 377
    my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
		   || $cfg->{gitcvs}{enabled});
378 379
    unless ($state->{'export-all'} ||
	    ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
380 381 382 383
        print "E GITCVS emulation needs to be enabled on this repo\n";
        print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
        print "E \n";
        print "error 1 GITCVS emulation disabled\n";
384
        return 0;
385 386
    }

387 388
    my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
    if ( $logfile )
389
    {
390
        $log->setfile($logfile);
391 392 393
    } else {
        $log->nofile();
    }
394 395

    return 1;
396 397 398 399 400 401 402 403 404 405 406 407 408
}

# Global_option option \n
#     Response expected: no. Transmit one of the global options `-q', `-Q',
#     `-l', `-t', `-r', or `-n'. option must be one of those strings, no
#     variations (such as combining of options) are allowed. For graceful
#     handling of valid-requests, it is probably better to make new global
#     options separate requests, rather than trying to add them to this
#     request.
sub req_Globaloption
{
    my ( $cmd, $data ) = @_;
    $log->debug("req_Globaloption : $data");
409
    $state->{globaloptions}{$data} = 1;
410 411 412 413 414 415 416 417
}

# Valid-responses request-list \n
#     Response expected: no. Tell the server what responses the client will
#     accept. request-list is a space separated list of tokens.
sub req_Validresponses
{
    my ( $cmd, $data ) = @_;
418
    $log->debug("req_Validresponses : $data");
419 420 421 422 423 424 425 426 427 428 429 430 431 432

    # TODO : re-enable this, currently it's not particularly useful
    #$state->{validresponses} = [ split /\s+/, $data ];
}

# valid-requests \n
#     Response expected: yes. Ask the server to send back a Valid-requests
#     response.
sub req_validrequests
{
    my ( $cmd, $data ) = @_;

    $log->debug("req_validrequests");

433
    $log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
434 435
    $log->debug("SEND : ok");

436
    print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460
    print "ok\n";
}

# Directory local-directory \n
#     Additional data: repository \n. Response expected: no. Tell the server
#     what directory to use. The repository should be a directory name from a
#     previous server response. Note that this both gives a default for Entry
#     and Modified and also for ci and the other commands; normal usage is to
#     send Directory for each directory in which there will be an Entry or
#     Modified, and then a final Directory for the original directory, then the
#     command. The local-directory is relative to the top level at which the
#     command is occurring (i.e. the last Directory which is sent before the
#     command); to indicate that top level, `.' should be sent for
#     local-directory.
sub req_Directory
{
    my ( $cmd, $data ) = @_;

    my $repository = <STDIN>;
    chomp $repository;


    $state->{localdir} = $data;
    $state->{repository} = $repository;
461
    $state->{path} = $repository;
462
    $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
463 464 465 466 467
    $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
    $state->{path} .= "/" if ( $state->{path} =~ /\S/ );

    $state->{directory} = $state->{localdir};
    $state->{directory} = "" if ( $state->{directory} eq "." );
468 469
    $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );

470
    if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
471 472 473
    {
        $log->info("Setting prepend to '$state->{path}'");
        $state->{prependdir} = $state->{path};
474
        my %entries;
475 476
        foreach my $entry ( keys %{$state->{entries}} )
        {
477
            $entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
478
        }
479 480 481 482 483 484 485 486
        $state->{entries}=\%entries;

        my %dirMap;
        foreach my $dir ( keys %{$state->{dirMap}} )
        {
            $dirMap{$state->{prependdir} . $dir} = $state->{dirMap}{$dir};
        }
        $state->{dirMap}=\%dirMap;
487 488 489 490 491 492 493
    }

    if ( defined ( $state->{prependdir} ) )
    {
        $log->debug("Prepending '$state->{prependdir}' to state|directory");
        $state->{directory} = $state->{prependdir} . $state->{directory}
    }
494 495 496 497 498 499 500 501 502 503

    if ( ! defined($state->{dirMap}{$state->{directory}}) )
    {
        $state->{dirMap}{$state->{directory}} =
            {
                'names' => {}
                #'tagspec' => undef
            };
    }

504
    $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
505 506
}

507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547
# Sticky tagspec \n
#     Response expected: no. Tell the server that the directory most
#     recently specified with Directory has a sticky tag or date
#     tagspec. The first character of tagspec is T for a tag, D for
#     a date, or some other character supplied by a Set-sticky
#     response from a previous request to the server. The remainder
#     of tagspec contains the actual tag or date, again as supplied
#     by Set-sticky.
#          The server should remember Static-directory and Sticky requests
#     for a particular directory; the client need not resend them each
#     time it sends a Directory request for a given directory. However,
#     the server is not obliged to remember them beyond the context
#     of a single command.
sub req_Sticky
{
    my ( $cmd, $tagspec ) = @_;

    my ( $stickyInfo );
    if($tagspec eq "")
    {
        # nothing
    }
    elsif($tagspec=~/^T([^ ]+)\s*$/)
    {
        $stickyInfo = { 'tag' => $1 };
    }
    elsif($tagspec=~/^D([0-9.]+)\s*$/)
    {
        $stickyInfo= { 'date' => $1 };
    }
    else
    {
        die "Unknown tag_or_date format\n";
    }
    $state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;

    $log->debug("req_Sticky : tagspec=$tagspec repository=$state->{repository}"
                . " path=$state->{path} directory=$state->{directory}"
                . " module=$state->{module}");
}

548 549 550 551 552 553 554 555 556 557 558 559 560 561 562
# Entry entry-line \n
#     Response expected: no. Tell the server what version of a file is on the
#     local machine. The name in entry-line is a name relative to the directory
#     most recently specified with Directory. If the user is operating on only
#     some files in a directory, Entry requests for only those files need be
#     included. If an Entry request is sent without Modified, Is-modified, or
#     Unchanged, it means the file is lost (does not exist in the working
#     directory). If both Entry and one of Modified, Is-modified, or Unchanged
#     are sent for the same file, Entry must be sent first. For a given file,
#     one can send Modified, Is-modified, or Unchanged, but not more than one
#     of these three.
sub req_Entry
{
    my ( $cmd, $data ) = @_;

563
    #$log->debug("req_Entry : $data");
564

565
    my @data = split(/\//, $data, -1);
566 567 568 569 570 571 572

    $state->{entries}{$state->{directory}.$data[1]} = {
        revision    => $data[2],
        conflict    => $data[3],
        options     => $data[4],
        tag_or_date => $data[5],
    };
573

574 575
    $state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';

576 577 578 579 580 581 582 583 584 585 586 587 588 589 590
    $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
}

# Questionable filename \n
#     Response expected: no. Additional data: no. Tell the server to check
#     whether filename should be ignored, and if not, next time the server
#     sends responses, send (in a M response) `?' followed by the directory and
#     filename. filename must not contain `/'; it needs to be a file in the
#     directory named by the most recent Directory request.
sub req_Questionable
{
    my ( $cmd, $data ) = @_;

    $log->debug("req_Questionable : $data");
    $state->{entries}{$state->{directory}.$data}{questionable} = 1;
591 592 593 594 595 596 597 598 599 600 601 602 603 604
}

# add \n
#     Response expected: yes. Add a file or directory. This uses any previous
#     Argument, Directory, Entry, or Modified requests, if they have been sent.
#     The last Directory sent specifies the working directory at the time of
#     the operation. To add a directory, send the directory to be added using
#     Directory and Argument requests.
sub req_add
{
    my ( $cmd, $data ) = @_;

    argsplit("add");

605 606 607
    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
    $updater->update();

608 609 610 611 612 613
    my $addcount = 0;

    foreach my $filename ( @{$state->{args}} )
    {
        $filename = filecleanup($filename);

614 615 616 617
        # no -r, -A, or -D with add
        my $stickyInfo = resolveStickyInfo($filename);

        my $meta = $updater->getmeta($filename,$stickyInfo);
618 619
        my $wrev = revparse($filename);

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 626 627 628 629 630 631 632 633 634 635 636 637 638

            print "MT +updated\n";
            print "MT text U \n";
            print "MT fname $filename\n";
            print "MT newline\n";
            print "MT -updated\n";

            unless ( $state->{globaloptions}{-n} )
            {
                my ( $filepart, $dirpart ) = filenamesplit($filename,1);

                print "Created $dirpart\n";
                print $state->{CVSROOT} . "/$state->{module}/$filename\n";

                # this is an "entries" line
639
                my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
640 641 642 643
                my $entryLine = "/$filepart/$meta->{revision}//$kopts/";
                $entryLine .= getStickyTagOrDate($stickyInfo);
                $log->debug($entryLine);
                print "$entryLine\n";
644 645 646 647 648 649 650 651 652 653
                # permissions
                $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
                print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
                # transmit file
                transmitfile($meta->{filehash});
            }

            next;
        }

654 655 656 657 658 659 660 661 662 663 664 665
        unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
        {
            print "E cvs add: nothing known about `$filename'\n";
            next;
        }
        # TODO : check we're not squashing an already existing file
        if ( defined ( $state->{entries}{$filename}{revision} ) )
        {
            print "E cvs add: `$filename' has already been entered\n";
            next;
        }

666
        my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
667 668 669 670 671

        print "E cvs add: scheduling file `$filename' for addition\n";

        print "Checked-in $dirpart\n";
        print "$filename\n";
672 673
        my $kopts = kopts_from_path($filename,"file",
                        $state->{entries}{$filename}{modified_filename});
674 675
        print "/$filepart/0//$kopts/" .
              getStickyTagOrDate($stickyInfo) . "\n";
676

677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692
        my $requestedKopts = $state->{opt}{k};
        if(defined($requestedKopts))
        {
            $requestedKopts = "-k$requestedKopts";
        }
        else
        {
            $requestedKopts = "";
        }
        if( $kopts ne $requestedKopts )
        {
            $log->warn("Ignoring requested -k='$requestedKopts'"
                        . " for '$filename'; detected -k='$kopts' instead");
            #TODO: Also have option to send warning to user?
        }

693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714 715 716 717 718 719 720 721 722 723 724 725 726 727 728 729 730 731 732 733 734 735 736 737 738 739 740 741 742
        $addcount++;
    }

    if ( $addcount == 1 )
    {
        print "E cvs add: use `cvs commit' to add this file permanently\n";
    }
    elsif ( $addcount > 1 )
    {
        print "E cvs add: use `cvs commit' to add these files permanently\n";
    }

    print "ok\n";
}

# remove \n
#     Response expected: yes. Remove a file. This uses any previous Argument,
#     Directory, Entry, or Modified requests, if they have been sent. The last
#     Directory sent specifies the working directory at the time of the
#     operation. Note that this request does not actually do anything to the
#     repository; the only effect of a successful remove request is to supply
#     the client with a new entries line containing `-' to indicate a removed
#     file. In fact, the client probably could perform this operation without
#     contacting the server, although using remove may cause the server to
#     perform a few more checks. The client sends a subsequent ci request to
#     actually record the removal in the repository.
sub req_remove
{
    my ( $cmd, $data ) = @_;

    argsplit("remove");

    # Grab a handle to the SQLite db and do any necessary updates
    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
    $updater->update();

    #$log->debug("add state : " . Dumper($state));

    my $rmcount = 0;

    foreach my $filename ( @{$state->{args}} )
    {
        $filename = filecleanup($filename);

        if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
        {
            print "E cvs remove: file `$filename' still in working directory\n";
            next;
        }

743 744 745 746
        # only from entries
        my $stickyInfo = resolveStickyInfo($filename);

        my $meta = $updater->getmeta($filename,$stickyInfo);
747 748 749 750 751 752 753 754
        my $wrev = revparse($filename);

        unless ( defined ( $wrev ) )
        {
            print "E cvs remove: nothing known about `$filename'\n";
            next;
        }

755
        if ( defined($wrev) and ($wrev=~/^-/) )
756 757 758 759 760
        {
            print "E cvs remove: file `$filename' already scheduled for removal\n";
            next;
        }

761
        unless ( $wrev eq $meta->{revision} )
762 763 764 765 766 767 768
        {
            # TODO : not sure if the format of this message is quite correct.
            print "E cvs remove: Up to date check failed for `$filename'\n";
            next;
        }


769
        my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
770 771 772 773 774

        print "E cvs remove: scheduling `$filename' for removal\n";

        print "Checked-in $dirpart\n";
        print "$filename\n";
775
        my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
776
        print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800 801 802 803 804

        $rmcount++;
    }

    if ( $rmcount == 1 )
    {
        print "E cvs remove: use `cvs commit' to remove this file permanently\n";
    }
    elsif ( $rmcount > 1 )
    {
        print "E cvs remove: use `cvs commit' to remove these files permanently\n";
    }

    print "ok\n";
}

# Modified filename \n
#     Response expected: no. Additional data: mode, \n, file transmission. Send
#     the server a copy of one locally modified file. filename is a file within
#     the most recent directory sent with Directory; it must not contain `/'.
#     If the user is operating on only some files in a directory, only those
#     files need to be included. This can also be sent without Entry, if there
#     is no entry for the file.
sub req_Modified
{
    my ( $cmd, $data ) = @_;

    my $mode = <STDIN>;
805 806
    defined $mode
        or (print "E end of file reading mode for $data\n"), return;
807 808
    chomp $mode;
    my $size = <STDIN>;
809 810
    defined $size
        or (print "E end of file reading size of $data\n"), return;
811 812 813 814 815 816 817 818 819 820 821 822 823 824 825 826 827 828 829
    chomp $size;

    # Grab config information
    my $blocksize = 8192;
    my $bytesleft = $size;
    my $tmp;

    # Get a filehandle/name to write it to
    my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );

    # Loop over file data writing out to temporary file.
    while ( $bytesleft )
    {
        $blocksize = $bytesleft if ( $bytesleft < $blocksize );
        read STDIN, $tmp, $blocksize;
        print $fh $tmp;
        $bytesleft -= $blocksize;
    }

830 831
    close $fh
        or (print "E failed to write temporary, $filename: $!\n"), return;
832 833 834 835 836 837 838 839 840 841 842 843

    # Ensure we have something sensible for the file mode
    if ( $mode =~ /u=(\w+)/ )
    {
        $mode = $1;
    } else {
        $mode = "rw";
    }

    # Save the file data in $state
    $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
    $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
844
    $state->{entries}{$state->{directory}.$data}{modified_hash} = safe_pipe_capture('git','hash-object',$filename);
845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873
    $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;

    #$log->debug("req_Modified : file=$data mode=$mode size=$size");
}

# Unchanged filename \n
#     Response expected: no. Tell the server that filename has not been
#     modified in the checked out directory. The filename is a file within the
#     most recent directory sent with Directory; it must not contain `/'.
sub req_Unchanged
{
    my ( $cmd, $data ) = @_;

    $state->{entries}{$state->{directory}.$data}{unchanged} = 1;

    #$log->debug("req_Unchanged : $data");
}

# Argument text \n
#     Response expected: no. Save argument for use in a subsequent command.
#     Arguments accumulate until an argument-using command is given, at which
#     point they are forgotten.
# Argumentx text \n
#     Response expected: no. Append \n followed by text to the current argument
#     being saved.
sub req_Argument
{
    my ( $cmd, $data ) = @_;

874
    # Argumentx means: append to last Argument (with a newline in front)
875 876 877

    $log->debug("$cmd : $data");

878 879 880 881 882
    if ( $cmd eq 'Argumentx') {
        ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
    } else {
        push @{$state->{arguments}}, $data;
    }
883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934 935 936 937 938 939 940 941 942 943
}

# expand-modules \n
#     Response expected: yes. Expand the modules which are specified in the
#     arguments. Returns the data in Module-expansion responses. Note that the
#     server can assume that this is checkout or export, not rtag or rdiff; the
#     latter do not access the working directory and thus have no need to
#     expand modules on the client side. Expand may not be the best word for
#     what this request does. It does not necessarily tell you all the files
#     contained in a module, for example. Basically it is a way of telling you
#     which working directories the server needs to know about in order to
#     handle a checkout of the specified modules. For example, suppose that the
#     server has a module defined by
#   aliasmodule -a 1dir
#     That is, one can check out aliasmodule and it will take 1dir in the
#     repository and check it out to 1dir in the working directory. Now suppose
#     the client already has this module checked out and is planning on using
#     the co request to update it. Without using expand-modules, the client
#     would have two bad choices: it could either send information about all
#     working directories under the current directory, which could be
#     unnecessarily slow, or it could be ignorant of the fact that aliasmodule
#     stands for 1dir, and neglect to send information for 1dir, which would
#     lead to incorrect operation. With expand-modules, the client would first
#     ask for the module to be expanded:
sub req_expandmodules
{
    my ( $cmd, $data ) = @_;

    argsplit();

    $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );

    unless ( ref $state->{arguments} eq "ARRAY" )
    {
        print "ok\n";
        return;
    }

    foreach my $module ( @{$state->{arguments}} )
    {
        $log->debug("SEND : Module-expansion $module");
        print "Module-expansion $module\n";
    }

    print "ok\n";
    statecleanup();
}

# co \n
#     Response expected: yes. Get files from the repository. This uses any
#     previous Argument, Directory, Entry, or Modified requests, if they have
#     been sent. Arguments to this command are module names; the client cannot
#     know what directories they correspond to except by (1) just sending the
#     co request, and then seeing what directory names the server sends back in
#     its responses, and (2) the expand-modules request.
sub req_co
{
    my ( $cmd, $data ) = @_;

    argsplit("co");

944 945
    # Provide list of modules, if -c was used.
    if (exists $state->{opt}{c}) {
946
        my $showref = safe_pipe_capture(qw(git show-ref --heads));
947 948 949 950 951 952 953 954 955
        for my $line (split '\n', $showref) {
            if ( $line =~ m% refs/heads/(.*)$% ) {
                print "M $1\t$1\n";
            }
        }
        print "ok\n";
        return 1;
    }

956 957 958
    my $stickyInfo = { 'tag' => $state->{opt}{r},
                       'date' => $state->{opt}{D} };

959
    my $module = $state->{args}[0];
960
    $state->{module} = $module;
961 962 963 964 965 966 967 968 969 970 971 972 973 974 975
    my $checkout_path = $module;

    # use the user specified directory if we're given it
    $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );

    $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );

    $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");

    $ENV{GIT_DIR} = $state->{CVSROOT} . "/";

    # Grab a handle to the SQLite db and do any necessary updates
    my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
    $updater->update();

976 977 978 979 980 981 982 983 984 985 986
    my $headHash;
    if( defined($stickyInfo) && defined($stickyInfo->{tag}) )
    {
        $headHash = $updater->lookupCommitRef($stickyInfo->{tag});
        if( !defined($headHash) )
        {
            print "error 1 no such tag `$stickyInfo->{tag}'\n";
            cleanupWorkTree();
            exit;
        }
    }
987

988
    $checkout_path =~ s|/$||; # get rid of trailing slashes
989 990

    my %seendirs = ();
991
    my $lastdir ='';
992

993 994 995 996 997 998 999 1000 1001
    prepDirForOutput(
            ".",
            $state->{CVSROOT} . "/$module",
            $checkout_path,
            \%seendirs,
            'checkout',
            $state->{dirArgs} );

    foreach my $git ( @{$updater->getAnyHead($headHash)} )
1002 1003 1004 1005
    {
        # Don't want to check out deleted files
        next if ( $git->{filehash} eq "deleted" );

1006
        my $fullName = $git->{name};
1007 1008
        ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});

1009 1010 1011 1012 1013 1014 1015
        unless (exists($seendirs{$git->{dir}})) {
            prepDirForOutput($git->{dir}, $state->{CVSROOT} . "/$module/",
                             $checkout_path, \%seendirs, 'checkout',
                             $state->{dirArgs} );
            $lastdir = $git->{dir};
            $seendirs{$git->{dir}} = 1;
        }
1016

1017 1018 1019 1020 1021 1022
        # modification time of this file
        print "Mod-time $git->{modified}\n";

        # print some information to the client
        if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
        {
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 1029
       # instruct client we're sending a file to put in this path
       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 1036
        print "/$git->{name}/$git->{revision}//$kopts/" .
                        getStickyTagOrDate($stickyInfo) . "\n";
1037 1038 1039 1040 1041 1042 1043 1044 1045 1046 1047 1048
        # permissions
        print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";

        # transmit file
        transmitfile($git->{filehash});
    }

    print "ok\n";

    statecleanup();
}

1049 1050 1051 1052 1053 1054 1055 1056 1057 1058 1059 1060 1061 1062 1063 1064 1065 1066 1067 1068 1069 1070 1071 1072 1073 1074 1075 1076 1077 1078 1079 1080 1081 1082 1083 1084 1085 1086 1087 1088 1089 1090 1091 1092 1093 1094 1095 1096 1097 1098 1099 1100 1101 1102 1103 1104 1105 1106 1107 1108 1109 1110 1111 1112 1113 1114 1115 1116 1117 1118 1119 1120 1121 1122 1123 1124 1125 1126 1127 1128 1129 1130 1131 1132 1133 1134 1135 1136 1137 1138 1139 1140 1141 1142 1143 1144 1145 1146 1147 1148 1149 1150 1151 1152 1153 1154 1155 1156 1157 1158
# used by req_co and req_update to set up directories for files
# recursively handles parents
sub prepDirForOutput
{
    my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;

    my $parent = dirname($dir);
    $dir       =~ s|/+$||;
    $repodir   =~ s|/+$||;
    $remotedir =~ s|/+$||;
    $parent    =~ s|/+$||;

    if ($parent eq '.' || $parent eq './')
    {
        $parent = '';
    }
    # recurse to announce unseen parents first
    if( length($parent) &&
        !exists($seendirs->{$parent}) &&
        ( $request eq "checkout" ||
          exists($dirArgs->{$parent}) ) )
    {
        prepDirForOutput($parent, $repodir, $remotedir,
                         $seendirs, $request, $dirArgs);
    }
    # Announce that we are going to modify at the parent level
    if ($dir eq '.' || $dir eq './')
    {
        $dir = '';
    }
    if(exists($seendirs->{$dir}))
    {
        return;
    }
    $log->debug("announcedir $dir, $repodir, $remotedir" );
    my($thisRemoteDir,$thisRepoDir);
    if ($dir ne "")
    {
        $thisRepoDir="$repodir/$dir";
        if($remotedir eq ".")
        {
            $thisRemoteDir=$dir;
        }
        else
        {
            $thisRemoteDir="$remotedir/$dir";
        }
    }
    else
    {
        $thisRepoDir=$repodir;
        $thisRemoteDir=$remotedir;
    }
    unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
    {
        print "E cvs $request: Updating $thisRemoteDir\n";
    }

    my ($opt_r)=$state->{opt}{r};
    my $stickyInfo;
    if(exists($state->{opt}{A}))
    {
        # $stickyInfo=undef;
    }
    elsif( defined($opt_r) && $opt_r ne "" )
           # || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO
    {
        $stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };

        # TODO: Convert -D value into the form 2011.04.10.04.46.57,
        #   similar to an entry line's sticky date, without the D prefix.
        #   It sometimes (always?) arrives as something more like
        #   '10 Apr 2011 04:46:57 -0000'...
        # $stickyInfo={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
    }
    else
    {
        $stickyInfo=getDirStickyInfo($state->{prependdir} . $dir);
    }

    my $stickyResponse;
    if(defined($stickyInfo))
    {
        $stickyResponse = "Set-sticky $thisRemoteDir/\n" .
                          "$thisRepoDir/\n" .
                          getStickyTagOrDate($stickyInfo) . "\n";
    }
    else
    {
        $stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
                          "$thisRepoDir/\n";
    }

    unless ( $state->{globaloptions}{-n} )
    {
        print $stickyResponse;

        print "Clear-static-directory $thisRemoteDir/\n";
        print "$thisRepoDir/\n";
        print $stickyResponse; # yes, twice
        print "Template $thisRemoteDir/\n";
        print "$thisRepoDir/\n";
        print "0\n";
    }

    $seendirs->{$dir} = 1;

    # FUTURE: This would more accurately emulate CVS by sending
    #   another copy of sticky after processing the files in that
    #   directory.  Or intermediate: perhaps send all sticky's for
1159
    #   $seendirs after processing all files.
1160 1161
}

1162 1163 1164 1165 1166 1167 1168 1169 1170 1171 1172 1173 1174 1175 1176
# update \n
#     Response expected: yes. Actually do a cvs update command. This uses any
#     previous Argument, Directory, Entry, or Modified requests, if they have
#     been sent. The last Directory sent specifies the working directory at the
#     time of the operation. The -I option is not used--files which the client
#     can decide whether to ignore are not mentioned and the client sends the
#     Questionable request for others.
sub req_update
{
    my ( $cmd, $data ) = @_;

    $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));

    argsplit("update");

1177
    #
1178
    # It may just be a client exploring the available heads/modules
1179 1180 1181 1182 1183
    # in that case, list them as top level directories and leave it
    # at that. Eclipse uses this technique to offer you a list of
    # projects (heads in this case) to checkout.
    #
    if ($state->{module} eq '') {
1184
        my $showref = safe_pipe_capture(qw(git show-ref --heads));
1185
        print "E cvs update: Updating .\n";
1186 1187 1188 1189 1190 1191 1192
        for my $line (split '\n', $showref) {
            if ( $line =~ m% refs/heads/(.*)$% ) {
                print "E cvs update: New directory `$1'\n";
            }
        }
        print "ok\n";
        return 1;
1193 1194 1195
    }


1196 1197 1198 1199 1200
    # Grab a handle to the SQLite db and do any necessary updates
    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);

    $updater->update();

1201
    argsfromdir($updater);
1202 1203 1204

    #$log->debug("update state : " . Dumper($state));

1205 1206 1207 1208
    my($repoDir);
    $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";

    my %seendirs = ();
1209

Pavel Roskin's avatar
Pavel Roskin committed
1210
    # foreach file specified on the command line ...
1211
    foreach my $argsFilename ( @{$state->{args}} )
1212
    {
1213 1214
        my $filename;
        $filename = filecleanup($argsFilename);
1215

1216 1217
        $log->debug("Processing file $filename");

1218 1219 1220 1221 1222 1223 1224 1225
        # if we have a -C we should pretend we never saw modified stuff
        if ( exists ( $state->{opt}{C} ) )
        {
            delete $state->{entries}{$filename}{modified_hash};
            delete $state->{entries}{$filename}{modified_filename};
            $state->{entries}{$filename}{unchanged} = 1;
        }

1226 1227 1228 1229 1230
        my $stickyInfo = resolveStickyInfo($filename,
                                           $state->{opt}{r},
                                           $state->{opt}{D},
                                           exists($state->{opt}{A}));
        my $meta = $updater->getmeta($filename, $stickyInfo);
1231

1232 1233 1234 1235 1236 1237 1238 1239 1240 1241 1242
        # If -p was given, "print" the contents of the requested revision.
        if ( exists ( $state->{opt}{p} ) ) {
            if ( defined ( $meta->{revision} ) ) {
                $log->info("Printing '$filename' revision " . $meta->{revision});

                transmitfile($meta->{filehash}, { print => 1 });
            }

            next;
        }

1243 1244 1245 1246 1247 1248 1249 1250 1251 1252 1253
        # Directories:
        prepDirForOutput(
                dirname($argsFilename),
                $repoDir,
                ".",
                \%seendirs,
                "update",
                $state->{dirArgs} );

        my $wrev = revparse($filename);

1254 1255 1256 1257
	if ( ! defined $meta )
	{
	    $meta = {
	        name => $filename,
1258
	        revision => '0',
1259 1260
	        filehash => 'added'
	    };
1261 1262 1263 1264
	    if($wrev ne "0")
	    {
	        $meta->{filehash}='deleted';
	    }
1265
	}
1266 1267 1268 1269

        my $oldmeta = $meta;

        # If the working copy is an old revision, lets get that version too for comparison.
1270 1271
        my $oldWrev=$wrev;
        if(defined($oldWrev))
1272
        {
1273 1274 1275 1276 1277
            $oldWrev=~s/^-//;
            if($oldWrev ne $meta->{revision})
            {
                $oldmeta = $updater->getmeta($filename, $oldWrev);
            }
1278 1279 1280 1281
        }

        #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");

1282 1283 1284 1285
        # Files are up to date if the working copy and repo copy have the same revision,
        # and the working copy is unmodified _and_ the user hasn't specified -C
        next if ( defined ( $wrev )
                  and defined($meta->{revision})
1286
                  and $wrev eq $meta->{revision}
1287 1288 1289 1290 1291 1292 1293
                  and $state->{entries}{$filename}{unchanged}
                  and not exists ( $state->{opt}{C} ) );

        # If the working copy and repo copy have the same revision,
        # but the working copy is modified, tell the client it's modified
        if ( defined ( $wrev )
             and defined($meta->{revision})
1294
             and $wrev eq $meta->{revision}
1295
             and $wrev ne "0"
1296
             and defined($state->{entries}{$filename}{modified_hash})
1297 1298 1299
             and not exists ( $state->{opt}{C} ) )
        {
            $log->info("Tell the client the file is modified");
1300
            print "MT text M \n";
1301 1302 1303 1304
            print "MT fname $filename\n";
            print "MT newline\n";
            next;
        }
1305

1306
        if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
1307
        {
1308 1309 1310 1311
            # TODO: If it has been modified in the sandbox, error out
            #   with the appropriate message, rather than deleting a modified
            #   file.

1312
            my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1313 1314 1315 1316

            $log->info("Removing '$filename' from working copy (no longer in the repo)");

            print "E cvs update: `$filename' is no longer in the repository\n";
1317 1318 1319 1320 1321
            # Don't want to actually _DO_ the update if -n specified
            unless ( $state->{globaloptions}{-n} ) {
		print "Removed $dirpart\n";
		print "$filepart\n";
	    }
1322
        }
1323
        elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
1324 1325
		or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
		or $meta->{filehash} eq 'added' )
1326
        {
1327 1328
            # normal update, just send the new revision (either U=Update,
            # or A=Add, or R=Remove)
1329
	    if ( defined($wrev) && ($wrev=~/^-/) )
1330 1331 1332 1333 1334 1335 1336
	    {
	        $log->info("Tell the client the file is scheduled for removal");
		print "MT text R \n";
                print "MT fname $filename\n";
                print "MT newline\n";
		next;
	    }
1337 1338
	    elsif ( (!defined($wrev) || $wrev eq '0') &&
                    (!defined($meta->{revision}) || $meta->{revision} eq '0') )
1339
	    {
1340
	        $log->info("Tell the client the file is scheduled for addition");
1341 1342 1343 1344 1345 1346 1347
		print "MT text A \n";
                print "MT fname $filename\n";
                print "MT newline\n";
		next;

	    }
	    else {
1348
                $log->info("UpdatingX3 '$filename' to ".$meta->{revision});
1349 1350 1351 1352 1353 1354
                print "MT +updated\n";
                print "MT text U \n";
                print "MT fname $filename\n";
                print "MT newline\n";
		print "MT -updated\n";
	    }
1355

1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374
            my ( $filepart, $dirpart ) = filenamesplit($filename,1);

	    # Don't want to actually _DO_ the update if -n specified
	    unless ( $state->{globaloptions}{-n} )
	    {
		if ( defined ( $wrev ) )
		{
		    # instruct client we're sending a file to put in this path as a replacement
		    print "Update-existing $dirpart\n";
		    $log->debug("Updating existing file 'Update-existing $dirpart'");
		} else {
		    # instruct client we're sending a file to put in this path as a new file

		    $log->debug("Creating new file 'Created $dirpart'");
		    print "Created $dirpart\n";
		}
		print $state->{CVSROOT} . "/$state->{module}/$filename\n";

		# this is an "entries" line
1375
		my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
1376 1377 1378 1379
                my $entriesLine = "/$filepart/$meta->{revision}//$kopts/";
                $entriesLine .= getStickyTagOrDate($stickyInfo);
		$log->debug($entriesLine);
		print "$entriesLine\n";
1380 1381 1382 1383 1384 1385 1386 1387

		# permissions
		$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
		print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";

		# transmit file
		transmitfile($meta->{filehash});
	    }
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 1396
            system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
            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 1402

            # we need to merge with the local changes ( M=successful merge, C=conflict merge )
            $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 1409
            $return >>= 8;

1410 1411
            cleanupTmpDir();

1412 1413 1414 1415
            if ( $return == 0 )
            {
                $log->info("Merged successfully");
                print "M M $filename\n";
1416
                $log->debug("Merged $dirpart");
1417 1418 1419 1420

                # Don't want to actually _DO_ the update if -n specified
                unless ( $state->{globaloptions}{-n} )
                {
1421
                    print "Merged $dirpart\n";
1422 1423
                    $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
                    print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1424 1425
                    my $kopts = kopts_from_path("$dirpart/$filepart",
                                                "file",$mergedFile);
1426
                    $log->debug("/$filepart/$meta->{revision}//$kopts/");
1427 1428 1429
                    my $entriesLine="/$filepart/$meta->{revision}//$kopts/";
                    $entriesLine .= getStickyTagOrDate($stickyInfo);
                    print "$entriesLine\n";
1430
                }
1431 1432 1433 1434
            }
            elsif ( $return == 1 )
            {
                $log->info("Merged with conflicts");
1435
                print "E cvs update: conflicts found in $filename\n";
1436
                print "M C $filename\n";
1437 1438 1439 1440

                # Don't want to actually _DO_ the update if -n specified
                unless ( $state->{globaloptions}{-n} )
                {
1441
                    print "Merged $dirpart\n";
1442
                    print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1443 1444
                    my $kopts = kopts_from_path("$dirpart/$filepart",
                                                "file",$mergedFile);
1445 1446 1447
                    my $entriesLine = "/$filepart/$meta->{revision}/+/$kopts/";
                    $entriesLine .= getStickyTagOrDate($stickyInfo);
                    print "$entriesLine\n";
1448
                }
1449 1450 1451 1452 1453 1454 1455
            }
            else
            {
                $log->warn("Merge failed");
                next;
            }

1456 1457 1458 1459 1460 1461 1462 1463 1464 1465
            # Don't want to actually _DO_ the update if -n specified
            unless ( $state->{globaloptions}{-n} )
            {
                # permissions
                $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
                print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";

                # transmit file, format is single integer on a line by itself (file
                # size) followed by the file contents
                # TODO : we should copy files in blocks
1466
                my $data = safe_pipe_capture('cat', $mergedFile);
1467 1468 1469 1470
                $log->debug("File size : " . length($data));
                print length($data) . "\n";
                print $data;
            }
1471 1472 1473 1474
        }

    }

1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499 1500 1501 1502 1503 1504 1505 1506 1507 1508 1509 1510 1511
    # prepDirForOutput() any other existing directories unless they already
    # have the right sticky tag:
    unless ( $state->{globaloptions}{n} )
    {
        my $dir;
        foreach $dir (keys(%{$state->{dirMap}}))
        {
            if( ! $seendirs{$dir} &&
                exists($state->{dirArgs}{$dir}) )
            {
                my($oldTag);
                $oldTag=$state->{dirMap}{$dir}{tagspec};

                unless( ( exists($state->{opt}{A}) &&
                          defined($oldTag) ) ||
                          ( defined($state->{opt}{r}) &&
                            ( !defined($oldTag) ||
                              $state->{opt}{r} ne $oldTag ) ) )
                        # TODO?: OR sticky dir is different...
                {
                    next;
                }

                prepDirForOutput(
                        $dir,
                        $repoDir,
                        ".",
                        \%seendirs,
                        'update',
                        $state->{dirArgs} );
            }

            # TODO?: Consider sending a final duplicate Sticky response
            #   to more closely mimic real CVS.
        }
    }

1512 1513 1514 1515 1516 1517 1518 1519 1520 1521 1522 1523 1524
    print "ok\n";
}

sub req_ci
{
    my ( $cmd, $data ) = @_;

    argsplit("ci");

    #$log->debug("State : " . Dumper($state));

    $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));

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 1530 1531
        exit;
    }

1532 1533
    if ( -e $state->{CVSROOT} . "/index" )
    {
1534
        $log->warn("file 'index' already exists in the git repository");
1535
        print "error 1 Index already exists in git repo\n";
1536
        cleanupWorkTree();
1537 1538 1539 1540 1541 1542 1543 1544
        exit;
    }

    # Grab a handle to the SQLite db and do any necessary updates
    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
    $updater->update();

    my @committedfiles = ();
1545
    my %oldmeta;
1546 1547 1548
    my $stickyInfo;
    my $branchRef;
    my $parenthash;
1549

Pavel Roskin's avatar
Pavel Roskin committed
1550
    # foreach file specified on the command line ...
1551 1552
    foreach my $filename ( @{$state->{args}} )
    {
1553
        my $committedfile = $filename;
1554 1555 1556 1557
        $filename = filecleanup($filename);

        next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );

1558 1559 1560 1561 1562 1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 1573 1574 1575 1576 1577 1578 1579 1580 1581
        #####
        # Figure out which branch and parenthash we are committing
        # to, and setup worktree:

        # should always come from entries:
        my $fileStickyInfo = resolveStickyInfo($filename);
        if( !defined($branchRef) )
        {
            $stickyInfo = $fileStickyInfo;
            if( defined($stickyInfo) &&
                ( defined($stickyInfo->{date}) ||
                  !defined($stickyInfo->{tag}) ) )
            {
                print "error 1 cannot commit with sticky date for file `$filename'\n";
                cleanupWorkTree();
                exit;
            }

            $branchRef = "refs/heads/$state->{module}";
            if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
            {
                $branchRef = "refs/heads/$stickyInfo->{tag}";
            }

1582
            $parenthash = safe_pipe_capture('git', 'show-ref', '-s', $branchRef);
1583 1584 1585 1586 1587 1588 1589 1590 1591 1592 1593 1594 1595 1596 1597 1598 1599 1600 1601 1602 1603 1604 1605 1606 1607 1608 1609 1610 1611 1612 1613 1614 1615 1616 1617 1618
            chomp $parenthash;
            if ($parenthash !~ /^[0-9a-f]{40}$/)
            {
                if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
                {
                    print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
                }
                else
                {
                    print "error 1 pserver cannot find the current HEAD of module";
                }
                cleanupWorkTree();
                exit;
            }

            setupWorkTree($parenthash);

            $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");

            $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
        }
        elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )
        {
            #TODO: We could split the cvs commit into multiple
            #  git commits by distinct stickyTag values, but that
            #  is lowish priority.
            print "error 1 Committing different files to different"
                  . " branches is not currently supported\n";
            cleanupWorkTree();
            exit;
        }

        #####
        # Process this file:

        my $meta = $updater->getmeta($filename,$stickyInfo);
1619
	$oldmeta{$filename} = $meta;
1620 1621 1622 1623 1624

        my $wrev = revparse($filename);

        my ( $filepart, $dirpart ) = filenamesplit($filename);

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 1629 1630 1631 1632 1633 1634
            unless ($? == 0) {
                die "Error running git-checkout-index -f -u $filename : $!";
            }
        }

        my $addflag = 0;
        my $rmflag = 0;
1635
        $rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
1636 1637 1638
        $addflag = 1 unless ( -e $filename );

        # Do up to date checking
1639 1640
        unless ( $addflag or $wrev eq $meta->{revision} or
                 ( $rmflag and $wrev eq "-$meta->{revision}" ) )
1641 1642 1643
        {
            # fail everything if an up to date check fails
            print "error 1 Up to date check failed for $filename\n";
1644
            cleanupWorkTree();
1645 1646 1647
            exit;
        }

1648
        push @committedfiles, $committedfile;
1649 1650 1651 1652 1653 1654 1655 1656 1657 1658 1659 1660 1661 1662 1663 1664 1665 1666 1667 1668 1669
        $log->info("Committing $filename");

        system("mkdir","-p",$dirpart) unless ( -d $dirpart );

        unless ( $rmflag )
        {
            $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
            rename $state->{entries}{$filename}{modified_filename},$filename;

            # Calculate modes to remove
            my $invmode = "";
            foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }

            $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
            system("chmod","u+" .  $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
        }

        if ( $rmflag )
        {
            $log->info("Removing file '$filename'");
            unlink($filename);
1670
            system("git", "update-index", "--remove", $filename);
1671 1672 1673 1674
        }
        elsif ( $addflag )
        {
            $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 1683 1684 1685
        }
    }

    unless ( scalar(@committedfiles) > 0 )
    {
        print "E No files to commit\n";
        print "ok\n";
1686
        cleanupWorkTree();
1687 1688 1689
        return;
    }

1690
    my $treehash = safe_pipe_capture(qw(git write-tree));
1691 1692 1693 1694 1695 1696 1697
    chomp $treehash;

    $log->debug("Treehash : $treehash, Parenthash : $parenthash");

    # write our commit message out if we have one ...
    my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
    print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1698 1699 1700 1701 1702 1703 1704
    if ( defined ( $cfg->{gitcvs}{commitmsgannotation} ) ) {
        if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/ ) {
            print $msg_fh "\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"
        }
    } else {
        print $msg_fh "\n\nvia git-CVS emulator\n";
    }
1705 1706
    close $msg_fh;

1707
    my $commithash = safe_pipe_capture('git', 'commit-tree', $treehash, '-p', $parenthash, '-F', $msg_filename);
1708
    chomp($commithash);
1709 1710 1711 1712 1713 1714
    $log->info("Commit hash : $commithash");

    unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
    {
        $log->warn("Commit failed (Invalid commit hash)");
        print "error 1 Commit failed (unknown reason)\n";
1715
        cleanupWorkTree();
1716 1717 1718
        exit;
    }

1719
	### Emulate git-receive-pack by running hooks/update
1720
	my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
1721
			$parenthash, $commithash );
1722 1723
	if( -x $hook[0] ) {
		unless( system( @hook ) == 0 )
1724 1725 1726
		{
			$log->warn("Commit failed (update hook declined to update ref)");
			print "error 1 Commit failed (update hook declined)\n";
1727
			cleanupWorkTree();
1728 1729 1730 1731
			exit;
		}
	}

1732
	### Update the ref
1733
	if (system(qw(git update-ref -m), "cvsserver ci",
1734
			$branchRef, $commithash, $parenthash)) {
1735 1736
		$log->warn("update-ref for $state->{module} failed.");
		print "error 1 Cannot commit -- update first\n";
1737
		cleanupWorkTree();