git

git-cvsserver.perl
5128 строк · 159.9 Кб
Перенос по словам
1
#!/usr/bin/perl
2

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

18
use 5.008001;
19
use strict;
20
use warnings;
21
use bytes;
22

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

29
my $VERSION = '@@GIT_VERSION@@';
30

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

34
my $DATE_LIST = {
35
    Jan => "01",
36
    Feb => "02",
37
    Mar => "03",
38
    Apr => "04",
39
    May => "05",
40
    Jun => "06",
41
    Jul => "07",
42
    Aug => "08",
43
    Sep => "09",
44
    Oct => "10",
45
    Nov => "11",
46
    Dec => "12",
47
};
48

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

52
#### Definition and mappings of functions ####
53

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

90
##############################################
91

92

93
# $state holds all the bits of information the clients sends us that could
94
# potentially be useful when it comes to actually _doing_ something.
95
my $state = { prependdir => '' };
96

97
# Work is for managing temporary working directory
98
my $work =
99
    {
100
        state => undef,  # undef, 1 (empty), 2 (with stuff)
101
        workDir => undef,
102
        index => undef,
103
        emptyDir => undef,
104
        tmpDir => undef
105
    };
106

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

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

123
my @opts = ( 'h|H', 'version|V',
124
	     'base-path=s', 'strict-paths', 'export-all' );
125
GetOptions( $state, @opts )
126
    or die $usage;
127

128
if ($state->{version}) {
129
    print "git-cvsserver version $VERSION\n";
130
    exit;
131
}
132
if ($state->{help}) {
133
    print $usage;
134
    exit;
135
}
136

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

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

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

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

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

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

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

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

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

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

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

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

238
        # Fall through to LOVE
239
    }
240

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

244
    $line = <STDIN>; chomp $line;
245
    unless ($line eq "END $request REQUEST") {
246
       die "E Do not understand $line -- expecting END $request REQUEST\n";
247
    }
248
    print "I LOVE YOU\n";
249
    exit if $request eq 'VERIFICATION'; # cvs login
250
    # and now back to our regular programme...
251
}
252

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

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

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

277
chdir '/';
278
exit 0;
279

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

290
# This method invariably succeeds with an empty response.
291
sub req_EMPTY
292
{
293
    print "ok\n";
294
}
295

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

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

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

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

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

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

329
    if (@{$state->{allowed_roots}}) {
330
	my $allowed = 0;
331
	foreach my $dir (@{$state->{allowed_roots}}) {
332
	    next unless $dir =~ m#^/#;
333
	    $dir =~ s#/+$##;
334
	    if ($state->{'strict-paths'}) {
335
		if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
336
		    $allowed = 1;
337
		    last;
338
		}
339
	    } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
340
		$allowed = 1;
341
		last;
342
	    }
343
	}
344

345
	unless ($allowed) {
346
	    print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
347
	    print "E \n";
348
	    print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
349
	    return 0;
350
	}
351
    }
352

353
    unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
354
       print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
355
       print "E \n";
356
       print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
357
       return 0;
358
    }
359

360
    my @gitvars = safe_pipe_capture(qw(git config -l));
361
    if ($?) {
362
       print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
363
        print "E \n";
364
        print "error 1 - problem executing git-config\n";
365
       return 0;
366
    }
367
    foreach my $line ( @gitvars )
368
    {
369
        next unless ( $line =~ /^(gitcvs|extensions)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
370
        unless ($2) {
371
            $cfg->{$1}{$3} = $4;
372
        } else {
373
            $cfg->{$1}{$2}{$3} = $4;
374
        }
375
    }
376

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

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

396
    $state->{rawsz} = ($cfg->{'extensions'}{'objectformat'} || 'sha1') eq 'sha256' ? 32 : 20;
397
    $state->{hexsz} = $state->{rawsz} * 2;
398

399
    return 1;
400
}
401

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

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

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

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

435
    $log->debug("req_validrequests");
436

437
    $log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
438
    $log->debug("SEND : ok");
439

440
    print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
441
    print "ok\n";
442
}
443

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

459
    my $repository = <STDIN>;
460
    chomp $repository;
461

462

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

470
    $state->{directory} = $state->{localdir};
471
    $state->{directory} = "" if ( $state->{directory} eq "." );
472
    $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
473

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

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

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

499
    if ( ! defined($state->{dirMap}{$state->{directory}}) )
500
    {
501
        $state->{dirMap}{$state->{directory}} =
502
            {
503
                'names' => {}
504
                #'tagspec' => undef
505
            };
506
    }
507

508
    $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
509
}
510

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

528
    my ( $stickyInfo );
529
    if($tagspec eq "")
530
    {
531
        # nothing
532
    }
533
    elsif($tagspec=~/^T([^ ]+)\s*$/)
534
    {
535
        $stickyInfo = { 'tag' => $1 };
536
    }
537
    elsif($tagspec=~/^D([0-9.]+)\s*$/)
538
    {
539
        $stickyInfo= { 'date' => $1 };
540
    }
541
    else
542
    {
543
        die "Unknown tag_or_date format\n";
544
    }
545
    $state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;
546

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

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

567
    #$log->debug("req_Entry : $data");
568

569
    my @data = split(/\//, $data, -1);
570

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

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

580
    $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
581
}
582

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

593
    $log->debug("req_Questionable : $data");
594
    $state->{entries}{$state->{directory}.$data}{questionable} = 1;
595
}
596

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

607
    argsplit("add");
608

609
    my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
610
    $updater->update();
611

612
    my $addcount = 0;
613

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

618
        # no -r, -A, or -D with add
619
        my $stickyInfo = resolveStickyInfo($filename);
620

621
        my $meta = $updater->getmeta($filename,$stickyInfo);
622
        my $wrev = revparse($filename);
623

624
        if ($wrev && $meta && ($wrev=~/^-/))
625
        {
626
            # previously removed file, add back
627
            $log->info("added file $filename was previously removed, send $meta->{revision}");
628

629
            print "MT +updated\n";
630
            print "MT text U \n";
631
            print "MT fname $filename\n";
632
            print "MT newline\n";
633
            print "MT -updated\n";
634

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

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

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

655
            next;
656
        }
657

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

670
        my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
671

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

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

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

697
        $addcount++;
698
    }
699

700
    if ( $addcount == 1 )
701
    {
702
        print "E cvs add: use `cvs commit' to add this file permanently\n";
703
    }
704
    elsif ( $addcount > 1 )
705
    {
706
        print "E cvs add: use `cvs commit' to add these files permanently\n";
707
    }
708

709
    print "ok\n";
710
}
711

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

727
    argsplit("remove");
728

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

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

735
    my $rmcount = 0;
736

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

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

747
        # only from entries
748
        my $stickyInfo = resolveStickyInfo($filename);
749

750
        my $meta = $updater->getmeta($filename,$stickyInfo);
751
        my $wrev = revparse($filename);
752

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

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

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

772

773
        my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
774

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

777
        print "Checked-in $dirpart\n";
778
        print "$filename\n";
779
        my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
780
        print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
781

782
        $rmcount++;
783
    }
784

785
    if ( $rmcount == 1 )
786
    {
787
        print "E cvs remove: use `cvs commit' to remove this file permanently\n";
788
    }
789
    elsif ( $rmcount > 1 )
790
    {
791
        print "E cvs remove: use `cvs commit' to remove these files permanently\n";
792
    }
793

794
    print "ok\n";
795
}
796

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

808
    my $mode = <STDIN>;
809
    defined $mode
810
        or (print "E end of file reading mode for $data\n"), return;
811
    chomp $mode;
812
    my $size = <STDIN>;
813
    defined $size
814
        or (print "E end of file reading size of $data\n"), return;
815
    chomp $size;
816

817
    # Grab config information
818
    my $blocksize = 8192;
819
    my $bytesleft = $size;
820
    my $tmp;
821

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

825
    # Loop over file data writing out to temporary file.
826
    while ( $bytesleft )
827
    {
828
        $blocksize = $bytesleft if ( $bytesleft < $blocksize );
829
        read STDIN, $tmp, $blocksize;
830
        print $fh $tmp;
831
        $bytesleft -= $blocksize;
832
    }
833

834
    close $fh
835
        or (print "E failed to write temporary, $filename: $!\n"), return;
836

837
    # Ensure we have something sensible for the file mode
838
    if ( $mode =~ /u=(\w+)/ )
839
    {
840
        $mode = $1;
841
    } else {
842
        $mode = "rw";
843
    }
844

845
    # Save the file data in $state
846
    $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
847
    $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
848
    $state->{entries}{$state->{directory}.$data}{modified_hash} = safe_pipe_capture('git','hash-object',$filename);
849
    $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
850

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

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

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

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

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

878
    # Argumentx means: append to last Argument (with a newline in front)
879

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

882
    if ( $cmd eq 'Argumentx') {
883
        ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
884
    } else {
885
        push @{$state->{arguments}}, $data;
886
    }
887
}
888

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

915
    argsplit();
916

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

919
    unless ( ref $state->{arguments} eq "ARRAY" )
920
    {
921
        print "ok\n";
922
        return;
923
    }
924

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

931
    print "ok\n";
932
    statecleanup();
933
}
934

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

946
    argsplit("co");
947

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

960
    my $stickyInfo = { 'tag' => $state->{opt}{r},
961
                       'date' => $state->{opt}{D} };
962

963
    my $module = $state->{args}[0];
964
    $state->{module} = $module;
965
    my $checkout_path = $module;
966

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

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

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

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

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

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

992
    $checkout_path =~ s|/$||; # get rid of trailing slashes
993

994
    my %seendirs = ();
995
    my $lastdir ='';
996

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

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

1010
        my $fullName = $git->{name};
1011
        ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
1012

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

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

1024
        # print some information to the client
1025
        if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
1026
        {
1027
            print "M U $checkout_path/$git->{dir}$git->{name}\n";
1028
        } else {
1029
            print "M U $checkout_path/$git->{name}\n";
1030
        }
1031

1032
       # instruct client we're sending a file to put in this path
1033
       print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
1034

1035
       print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
1036

1037
        # this is an "entries" line
1038
        my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
1039
        print "/$git->{name}/$git->{revision}//$kopts/" .
1040
                        getStickyTagOrDate($stickyInfo) . "\n";
1041
        # permissions
1042
        print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
1043

1044
        # transmit file
1045
        transmitfile($git->{filehash});
1046
    }
1047

1048
    print "ok\n";
1049

1050
    statecleanup();
1051
}
1052

1053
# used by req_co and req_update to set up directories for files
1054
# recursively handles parents
1055
sub prepDirForOutput
1056
{
1057
    my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;
1058

1059
    my $parent = dirname($dir);
1060
    $dir       =~ s|/+$||;
1061
    $repodir   =~ s|/+$||;
1062
    $remotedir =~ s|/+$||;
1063
    $parent    =~ s|/+$||;
1064

1065
    if ($parent eq '.' || $parent eq './')
1066
    {
1067
        $parent = '';
1068
    }
1069
    # recurse to announce unseen parents first
1070
    if( length($parent) &&
1071
        !exists($seendirs->{$parent}) &&
1072
        ( $request eq "checkout" ||
1073
          exists($dirArgs->{$parent}) ) )
1074
    {
1075
        prepDirForOutput($parent, $repodir, $remotedir,
1076
                         $seendirs, $request, $dirArgs);
1077
    }
1078
    # Announce that we are going to modify at the parent level
1079
    if ($dir eq '.' || $dir eq './')
1080
    {
1081
        $dir = '';
1082
    }
1083
    if(exists($seendirs->{$dir}))
1084
    {
1085
        return;
1086
    }
1087
    $log->debug("announcedir $dir, $repodir, $remotedir" );
1088
    my($thisRemoteDir,$thisRepoDir);
1089
    if ($dir ne "")
1090
    {
1091
        $thisRepoDir="$repodir/$dir";
1092
        if($remotedir eq ".")
1093
        {
1094
            $thisRemoteDir=$dir;
1095
        }
1096
        else
1097
        {
1098
            $thisRemoteDir="$remotedir/$dir";
1099
        }
1100
    }
1101
    else
1102
    {
1103
        $thisRepoDir=$repodir;
1104
        $thisRemoteDir=$remotedir;
1105
    }
1106
    unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
1107
    {
1108
        print "E cvs $request: Updating $thisRemoteDir\n";
1109
    }
1110

1111
    my ($opt_r)=$state->{opt}{r};
1112
    my $stickyInfo;
1113
    if(exists($state->{opt}{A}))
1114
    {
1115
        # $stickyInfo=undef;
1116
    }
1117
    elsif( defined($opt_r) && $opt_r ne "" )
1118
           # || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO
1119
    {
1120
        $stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };
1121

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

1133
    my $stickyResponse;
1134
    if(defined($stickyInfo))
1135
    {
1136
        $stickyResponse = "Set-sticky $thisRemoteDir/\n" .
1137
                          "$thisRepoDir/\n" .
1138
                          getStickyTagOrDate($stickyInfo) . "\n";
1139
    }
1140
    else
1141
    {
1142
        $stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
1143
                          "$thisRepoDir/\n";
1144
    }
1145

1146
    unless ( $state->{globaloptions}{-n} )
1147
    {
1148
        print $stickyResponse;
1149

1150
        print "Clear-static-directory $thisRemoteDir/\n";
1151
        print "$thisRepoDir/\n";
1152
        print $stickyResponse; # yes, twice
1153
        print "Template $thisRemoteDir/\n";
1154
        print "$thisRepoDir/\n";
1155
        print "0\n";
1156
    }
1157

1158
    $seendirs->{$dir} = 1;
1159

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

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

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

1179
    argsplit("update");
1180

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

1199

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

1203
    $updater->update();
1204

1205
    argsfromdir($updater);
1206

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

1209
    my($repoDir);
1210
    $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
1211

1212
    my %seendirs = ();
1213

1214
    # foreach file specified on the command line ...
1215
    foreach my $argsFilename ( @{$state->{args}} )
1216
    {
1217
        my $filename;
1218
        $filename = filecleanup($argsFilename);
1219

1220
        $log->debug("Processing file $filename");
1221

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

1230
        my $stickyInfo = resolveStickyInfo($filename,
1231
                                           $state->{opt}{r},
1232
                                           $state->{opt}{D},
1233
                                           exists($state->{opt}{A}));
1234
        my $meta = $updater->getmeta($filename, $stickyInfo);
1235

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

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

1244
            next;
1245
        }
1246

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

1256
        my $wrev = revparse($filename);
1257

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

1271
        my $oldmeta = $meta;
1272

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

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

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

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

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

1316
            my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1317

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

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

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

1360
            my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1361

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

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

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

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

1389
		# transmit file
1390
		transmitfile($meta->{filehash});
1391
	    }
1392
        } else {
1393
            my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
1394

1395
            my $mergeDir = setupTmpDir();
1396

1397
            my $file_local = $filepart . ".mine";
1398
            my $mergedFile = "$mergeDir/$file_local";
1399
            system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
1400
            my $file_old = $filepart . "." . $oldmeta->{revision};
1401
            transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
1402
            my $file_new = $filepart . "." . $meta->{revision};
1403
            transmitfile($meta->{filehash}, { targetfile => $file_new });
1404

1405
            # we need to merge with the local changes ( M=successful merge, C=conflict merge )
1406
            $log->info("Merging $file_local, $file_old, $file_new");
1407
            print "M Merging differences between $oldmeta->{revision} and $meta->{revision} into $filename\n";
1408

1409
            $log->debug("Temporary directory for merge is $mergeDir");
1410

1411
            my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
1412
            $return >>= 8;
1413

1414
            cleanupTmpDir();
1415

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

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

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

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

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

1477
    }
1478

1479
    # prepDirForOutput() any other existing directories unless they already
1480
    # have the right sticky tag:
1481
    unless ( $state->{globaloptions}{n} )
1482
    {
1483
        my $dir;
1484
        foreach $dir (keys(%{$state->{dirMap}}))
1485
        {
1486
            if( ! $seendirs{$dir} &&
1487
                exists($state->{dirArgs}{$dir}) )
1488
            {
1489
                my($oldTag);
1490
                $oldTag=$state->{dirMap}{$dir}{tagspec};
1491

1492
                unless( ( exists($state->{opt}{A}) &&
1493
                          defined($oldTag) ) ||
1494
                          ( defined($state->{opt}{r}) &&
1495
                            ( !defined($oldTag) ||
1496
                              $state->{opt}{r} ne $oldTag ) ) )
1497
                        # TODO?: OR sticky dir is different...
1498
                {
1499
                    next;
1500
                }
1501

1502
                prepDirForOutput(
1503
                        $dir,
1504
                        $repoDir,
1505
                        ".",
1506
                        \%seendirs,
1507
                        'update',
1508
                        $state->{dirArgs} );
1509
            }
1510

1511
            # TODO?: Consider sending a final duplicate Sticky response
1512
            #   to more closely mimic real CVS.
1513
        }
1514
    }
1515

1516
    print "ok\n";
1517
}
1518

1519
sub req_ci
1520
{
1521
    my ( $cmd, $data ) = @_;
1522

1523
    argsplit("ci");
1524

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

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

1529
    if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
1530
    {
1531
        print "error 1 anonymous user cannot commit via pserver\n";
1532
        cleanupWorkTree();
1533
        exit;
1534
    }
1535

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

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

1548
    my @committedfiles = ();
1549
    my %oldmeta;
1550
    my $stickyInfo;
1551
    my $branchRef;
1552
    my $parenthash;
1553

1554
    # foreach file specified on the command line ...
1555
    foreach my $filename ( @{$state->{args}} )
1556
    {
1557
        my $committedfile = $filename;
1558
        $filename = filecleanup($filename);
1559

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

1562
        #####
1563
        # Figure out which branch and parenthash we are committing
1564
        # to, and setup worktree:
1565

1566
        # should always come from entries:
1567
        my $fileStickyInfo = resolveStickyInfo($filename);
1568
        if( !defined($branchRef) )
1569
        {
1570
            $stickyInfo = $fileStickyInfo;
1571
            if( defined($stickyInfo) &&
1572
                ( defined($stickyInfo->{date}) ||
1573
                  !defined($stickyInfo->{tag}) ) )
1574
            {
1575
                print "error 1 cannot commit with sticky date for file `$filename'\n";
1576
                cleanupWorkTree();
1577
                exit;
1578
            }
1579

1580
            $branchRef = "refs/heads/$state->{module}";
1581
            if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1582
            {
1583
                $branchRef = "refs/heads/$stickyInfo->{tag}";
1584
            }
1585

1586
            $parenthash = safe_pipe_capture('git', 'show-ref', '-s', $branchRef);
1587
            chomp $parenthash;
1588
            if ($parenthash !~ /^[0-9a-f]{$state->{hexsz}}$/)
1589
            {
1590
                if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1591
                {
1592
                    print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
1593
                }
1594
                else
1595
                {
1596
                    print "error 1 pserver cannot find the current HEAD of module";
1597
                }
1598
                cleanupWorkTree();
1599
                exit;
1600
            }
1601

1602
            setupWorkTree($parenthash);
1603

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

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

1619
        #####
1620
        # Process this file:
1621

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

1625
        my $wrev = revparse($filename);
1626

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

1629
	# do a checkout of the file if it is part of this tree
1630
        if ($wrev) {
1631
            system('git', 'checkout-index', '-f', '-u', $filename);
1632
            unless ($? == 0) {
1633
                die "Error running git-checkout-index -f -u $filename : $!";
1634
            }
1635
        }
1636

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

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

1652
        push @committedfiles, $committedfile;
1653
        $log->info("Committing $filename");
1654

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

1657
        unless ( $rmflag )
1658
        {
1659
            $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1660
            rename $state->{entries}{$filename}{modified_filename},$filename;
1661

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

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

1670
        if ( $rmflag )
1671
        {
1672
            $log->info("Removing file '$filename'");
1673
            unlink($filename);
1674
            system("git", "update-index", "--remove", $filename);
1675
        }
1676
        elsif ( $addflag )
1677
        {
1678
            $log->info("Adding file '$filename'");
1679
            system("git", "update-index", "--add", $filename);
1680
        } else {
1681
            $log->info("UpdatingX2 file '$filename'");
1682
            system("git", "update-index", $filename);
1683
        }
1684
    }
1685

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

1694
    my $treehash = safe_pipe_capture(qw(git write-tree));
1695
    chomp $treehash;
1696

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

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

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

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

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

1736
	### Update the ref
1737
	if (system(qw(git update-ref -m), "cvsserver ci",
1738
			$branchRef, $commithash, $parenthash)) {
1739
		$log->warn("update-ref for $state->{module} failed.");
1740
		print "error 1 Cannot commit -- update first\n";
1741
		cleanupWorkTree();
1742
		exit;
1743
	}
1744

1745
	### Emulate git-receive-pack by running hooks/post-receive
1746
	my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
1747
	if( -x $hook ) {
1748
		open(my $pipe, "| $hook") || die "can't fork $!";
1749

1750
		local $SIG{PIPE} = sub { die 'pipe broke' };
1751

1752
		print $pipe "$parenthash $commithash $branchRef\n";
1753

1754
		close $pipe || die "bad pipe: $! $?";
1755
	}
1756

1757
    $updater->update();
1758

1759
	### Then hooks/post-update
1760
	$hook = $ENV{GIT_DIR}.'hooks/post-update';
1761
	if (-x $hook) {
1762
		system($hook, $branchRef);
1763
	}
1764

1765
    # foreach file specified on the command line ...
1766
    foreach my $filename ( @committedfiles )
1767
    {
1768
        $filename = filecleanup($filename);
1769

1770
        my $meta = $updater->getmeta($filename,$stickyInfo);
1771
	unless (defined $meta->{revision}) {
1772
	  $meta->{revision} = "1.1";
1773
	}
1774

1775
        my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
1776

1777
        $log->debug("Checked-in $dirpart : $filename");
1778

1779
	print "M $state->{CVSROOT}/$state->{module}/$filename,v  <--  $dirpart$filepart\n";
1780
        if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
1781
        {
1782
            print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
1783
            print "Remove-entry $dirpart\n";
1784
            print "$filename\n";
1785
        } else {
1786
            if ($meta->{revision} eq "1.1") {
1787
	        print "M initial revision: 1.1\n";
1788
            } else {
1789
	        print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
1790
            }
1791
            print "Checked-in $dirpart\n";
1792
            print "$filename\n";
1793
            my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
1794
            print "/$filepart/$meta->{revision}//$kopts/" .
1795
                  getStickyTagOrDate($stickyInfo) . "\n";
1796
        }
1797
    }
1798

1799
    cleanupWorkTree();
1800
    print "ok\n";
1801
}
1802

1803
sub req_status
1804
{
1805
    my ( $cmd, $data ) = @_;
1806

1807
    argsplit("status");
1808

1809
    $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1810
    #$log->debug("status state : " . Dumper($state));
1811

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

1817
    # if no files were specified, we need to work out what files we should
1818
    # be providing status on ...
1819
    argsfromdir($updater);
1820

1821
    # foreach file specified on the command line ...
1822
    foreach my $filename ( @{$state->{args}} )
1823
    {
1824
        $filename = filecleanup($filename);
1825

1826
        if ( exists($state->{opt}{l}) &&
1827
             index($filename, '/', length($state->{prependdir})) >= 0 )
1828
        {
1829
           next;
1830
        }
1831

1832
        my $wrev = revparse($filename);
1833

1834
        my $stickyInfo = resolveStickyInfo($filename);
1835
        my $meta = $updater->getmeta($filename,$stickyInfo);
1836
        my $oldmeta = $meta;
1837

1838
        # If the working copy is an old revision, lets get that
1839
        # version too for comparison.
1840
        if ( defined($wrev) and $wrev ne $meta->{revision} )
1841
        {
1842
            my($rmRev)=$wrev;
1843
            $rmRev=~s/^-//;
1844
            $oldmeta = $updater->getmeta($filename, $rmRev);
1845
        }
1846

1847
        # TODO : All possible statuses aren't yet implemented
1848
        my $status;
1849
        # Files are up to date if the working copy and repo copy have
1850
        # the same revision, and the working copy is unmodified
1851
        if ( defined ( $wrev ) and defined($meta->{revision}) and
1852
             $wrev eq $meta->{revision} and
1853
             ( ( $state->{entries}{$filename}{unchanged} and
1854
                 ( not defined ( $state->{entries}{$filename}{conflict} ) or
1855
                   $state->{entries}{$filename}{conflict} !~ /^\+=/ ) ) or
1856
               ( defined($state->{entries}{$filename}{modified_hash}) and
1857
                 $state->{entries}{$filename}{modified_hash} eq
1858
                        $meta->{filehash} ) ) )
1859
        {
1860
            $status = "Up-to-date"
1861
        }
1862

1863
        # Need checkout if the working copy has a different (usually
1864
        # older) revision than the repo copy, and the working copy is
1865
        # unmodified
1866
        if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
1867
             $meta->{revision} ne $wrev and
1868
             ( $state->{entries}{$filename}{unchanged} or
1869
               ( defined($state->{entries}{$filename}{modified_hash}) and
1870
                 $state->{entries}{$filename}{modified_hash} eq
1871
                                $oldmeta->{filehash} ) ) )
1872
        {
1873
            $status ||= "Needs Checkout";
1874
        }
1875

1876
        # Need checkout if it exists in the repo but doesn't have a working
1877
        # copy
1878
        if ( not defined ( $wrev ) and defined ( $meta->{revision} ) )
1879
        {
1880
            $status ||= "Needs Checkout";
1881
        }
1882

1883
        # Locally modified if working copy and repo copy have the
1884
        # same revision but there are local changes
1885
        if ( defined ( $wrev ) and defined($meta->{revision}) and
1886
             $wrev eq $meta->{revision} and
1887
             $wrev ne "0" and
1888
             $state->{entries}{$filename}{modified_filename} )
1889
        {
1890
            $status ||= "Locally Modified";
1891
        }
1892

1893
        # Needs Merge if working copy revision is different
1894
        # (usually older) than repo copy and there are local changes
1895
        if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
1896
             $meta->{revision} ne $wrev and
1897
             $state->{entries}{$filename}{modified_filename} )
1898
        {
1899
            $status ||= "Needs Merge";
1900
        }
1901

1902
        if ( defined ( $state->{entries}{$filename}{revision} ) and
1903
             ( !defined($meta->{revision}) ||
1904
               $meta->{revision} eq "0" ) )
1905
        {
1906
            $status ||= "Locally Added";
1907
        }
1908
        if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
1909
             $wrev eq "-$meta->{revision}" )
1910
        {
1911
            $status ||= "Locally Removed";
1912
        }
1913
        if ( defined ( $state->{entries}{$filename}{conflict} ) and
1914
             $state->{entries}{$filename}{conflict} =~ /^\+=/ )
1915
        {
1916
            $status ||= "Unresolved Conflict";
1917
        }
1918
        if ( 0 )
1919
        {
1920
            $status ||= "File had conflicts on merge";
1921
        }
1922

1923
        $status ||= "Unknown";
1924

1925
        my ($filepart) = filenamesplit($filename);
1926

1927
        print "M =======" . ( "=" x 60 ) . "\n";
1928
        print "M File: $filepart\tStatus: $status\n";
1929
        if ( defined($state->{entries}{$filename}{revision}) )
1930
        {
1931
            print "M Working revision:\t" .
1932
                  $state->{entries}{$filename}{revision} . "\n";
1933
        } else {
1934
            print "M Working revision:\tNo entry for $filename\n";
1935
        }
1936
        if ( defined($meta->{revision}) )
1937
        {
1938
            print "M Repository revision:\t" .
1939
                   $meta->{revision} .
1940
                   "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
1941
            my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
1942
            my($tag)=($tagOrDate=~m/^T(.+)$/);
1943
            if( !defined($tag) )
1944
            {
1945
                $tag="(none)";
1946
            }
1947
            print "M Sticky Tag:\t\t$tag\n";
1948
            my($date)=($tagOrDate=~m/^D(.+)$/);
1949
            if( !defined($date) )
1950
            {
1951
                $date="(none)";
1952
            }
1953
            print "M Sticky Date:\t\t$date\n";
1954
            my($options)=$state->{entries}{$filename}{options};
1955
            if( $options eq "" )
1956
            {
1957
                $options="(none)";
1958
            }
1959
            print "M Sticky Options:\t\t$options\n";
1960
        } else {
1961
            print "M Repository revision:\tNo revision control file\n";
1962
        }
1963
        print "M\n";
1964
    }
1965

1966
    print "ok\n";
1967
}
1968

1969
sub req_diff
1970
{
1971
    my ( $cmd, $data ) = @_;
1972

1973
    argsplit("diff");
1974

1975
    $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1976
    #$log->debug("status state : " . Dumper($state));
1977

1978
    my ($revision1, $revision2);
1979
    if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1980
    {
1981
        $revision1 = $state->{opt}{r}[0];
1982
        $revision2 = $state->{opt}{r}[1];
1983
    } else {
1984
        $revision1 = $state->{opt}{r};
1985
    }
1986

1987
    $log->debug("Diffing revisions " .
1988
                ( defined($revision1) ? $revision1 : "[NULL]" ) .
1989
                " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1990

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

1996
    # if no files were specified, we need to work out what files we should
1997
    # be providing status on ...
1998
    argsfromdir($updater);
1999

2000
    my($foundDiff);
2001

2002
    # foreach file specified on the command line ...
2003
    foreach my $argFilename ( @{$state->{args}} )
2004
    {
2005
        my($filename) = filecleanup($argFilename);
2006

2007
        my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
2008

2009
        my $wrev = revparse($filename);
2010

2011
        # Priority for revision1:
2012
        #  1. First -r (missing file: check -N)
2013
        #  2. wrev from client's Entry line
2014
        #      - missing line/file: check -N
2015
        #      - "0": added file not committed (empty contents for rev1)
2016
        #      - Prefixed with dash (to be removed): check -N
2017

2018
        if ( defined ( $revision1 ) )
2019
        {
2020
            $meta1 = $updater->getmeta($filename, $revision1);
2021
        }
2022
        elsif( defined($wrev) && $wrev ne "0" )
2023
        {
2024
            my($rmRev)=$wrev;
2025
            $rmRev=~s/^-//;
2026
            $meta1 = $updater->getmeta($filename, $rmRev);
2027
        }
2028
        if ( !defined($meta1) ||
2029
             $meta1->{filehash} eq "deleted" )
2030
        {
2031
            if( !exists($state->{opt}{N}) )
2032
            {
2033
                if(!defined($revision1))
2034
                {
2035
                    print "E File $filename at revision $revision1 doesn't exist\n";
2036
                }
2037
                next;
2038
            }
2039
            elsif( !defined($meta1) )
2040
            {
2041
                $meta1 = {
2042
                    name => $filename,
2043
                    revision => '0',
2044
                    filehash => 'deleted'
2045
                };
2046
            }
2047
        }
2048

2049
        # Priority for revision2:
2050
        #  1. Second -r (missing file: check -N)
2051
        #  2. Modified file contents from client
2052
        #  3. wrev from client's Entry line
2053
        #      - missing line/file: check -N
2054
        #      - Prefixed with dash (to be removed): check -N
2055

2056
        # if we have a second -r switch, use it too
2057
        if ( defined ( $revision2 ) )
2058
        {
2059
            $meta2 = $updater->getmeta($filename, $revision2);
2060
        }
2061
        elsif(defined($state->{entries}{$filename}{modified_filename}))
2062
        {
2063
            $file2 = $state->{entries}{$filename}{modified_filename};
2064
	    $meta2 = {
2065
                name => $filename,
2066
	        revision => '0',
2067
	        filehash => 'modified'
2068
            };
2069
        }
2070
        elsif( defined($wrev) && ($wrev!~/^-/) )
2071
        {
2072
            if(!defined($revision1))  # no revision and no modifications:
2073
            {
2074
                next;
2075
            }
2076
            $meta2 = $updater->getmeta($filename, $wrev);
2077
        }
2078
        if(!defined($file2))
2079
        {
2080
            if ( !defined($meta2) ||
2081
                 $meta2->{filehash} eq "deleted" )
2082
            {
2083
                if( !exists($state->{opt}{N}) )
2084
                {
2085
                    if(!defined($revision2))
2086
                    {
2087
                        print "E File $filename at revision $revision2 doesn't exist\n";
2088
                    }
2089
                    next;
2090
                }
2091
                elsif( !defined($meta2) )
2092
                {
2093
	            $meta2 = {
2094
                        name => $filename,
2095
	                revision => '0',
2096
	                filehash => 'deleted'
2097
                    };
2098
                }
2099
            }
2100
        }
2101

2102
        if( $meta1->{filehash} eq $meta2->{filehash} )
2103
        {
2104
            $log->info("unchanged $filename");
2105
            next;
2106
        }
2107

2108
        # Retrieve revision contents:
2109
        ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2110
        transmitfile($meta1->{filehash}, { targetfile => $file1 });
2111

2112
        if(!defined($file2))
2113
        {
2114
            ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2115
            transmitfile($meta2->{filehash}, { targetfile => $file2 });
2116
        }
2117

2118
        # Generate the actual diff:
2119
        print "M Index: $argFilename\n";
2120
        print "M =======" . ( "=" x 60 ) . "\n";
2121
        print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
2122
        if ( defined ( $meta1 ) && $meta1->{revision} ne "0" )
2123
        {
2124
            print "M retrieving revision $meta1->{revision}\n"
2125
        }
2126
        if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
2127
        {
2128
            print "M retrieving revision $meta2->{revision}\n"
2129
        }
2130
        print "M diff ";
2131
        foreach my $opt ( sort keys %{$state->{opt}} )
2132
        {
2133
            if ( ref $state->{opt}{$opt} eq "ARRAY" )
2134
            {
2135
                foreach my $value ( @{$state->{opt}{$opt}} )
2136
                {
2137
                    print "-$opt $value ";
2138
                }
2139
            } else {
2140
                print "-$opt ";
2141
                if ( defined ( $state->{opt}{$opt} ) )
2142
                {
2143
                    print "$state->{opt}{$opt} "
2144
                }
2145
            }
2146
        }
2147
        print "$argFilename\n";
2148

2149
        $log->info("Diffing $filename -r $meta1->{revision} -r " .
2150
                   ( $meta2->{revision} or "workingcopy" ));
2151

2152
        # TODO: Use --label instead of -L because -L is no longer
2153
        #  documented and may go away someday.  Not sure if there are
2154
        #  versions that only support -L, which would make this change risky?
2155
        #  http://osdir.com/ml/bug-gnu-utils-gnu/2010-12/msg00060.html
2156
        #    ("man diff" should actually document the best migration strategy,
2157
        #  [current behavior, future changes, old compatibility issues
2158
        #  or lack thereof, etc], not just stop mentioning the option...)
2159
        # TODO: Real CVS seems to include a date in the label, before
2160
        #  the revision part, without the keyword "revision".  The following
2161
        #  has minimal changes compared to original versions of
2162
        #  git-cvsserver.perl.  (Mostly tab vs space after filename.)
2163

2164
        my (@diffCmd) = ( 'diff' );
2165
        if ( exists($state->{opt}{N}) )
2166
        {
2167
            push @diffCmd,"-N";
2168
        }
2169
        if ( exists $state->{opt}{u} )
2170
        {
2171
            push @diffCmd,("-u","-L");
2172
            if( $meta1->{filehash} eq "deleted" )
2173
            {
2174
                push @diffCmd,"/dev/null";
2175
            } else {
2176
                push @diffCmd,("$argFilename\trevision $meta1->{revision}");
2177
            }
2178

2179
            if( defined($meta2->{filehash}) )
2180
            {
2181
                if( $meta2->{filehash} eq "deleted" )
2182
                {
2183
                    push @diffCmd,("-L","/dev/null");
2184
                } else {
2185
                    push @diffCmd,("-L",
2186
                                   "$argFilename\trevision $meta2->{revision}");
2187
                }
2188
            } else {
2189
                push @diffCmd,("-L","$argFilename\tworking copy");
2190
            }
2191
        }
2192
        push @diffCmd,($file1,$file2);
2193
        if(!open(DIFF,"-|",@diffCmd))
2194
        {
2195
            $log->warn("Unable to run diff: $!");
2196
        }
2197
        my($diffLine);
2198
        while(defined($diffLine=<DIFF>))
2199
        {
2200
            print "M $diffLine";
2201
            $foundDiff=1;
2202
        }
2203
        close(DIFF);
2204
    }
2205

2206
    if($foundDiff)
2207
    {
2208
        print "error  \n";
2209
    }
2210
    else
2211
    {
2212
        print "ok\n";
2213
    }
2214
}
2215

2216
sub req_log
2217
{
2218
    my ( $cmd, $data ) = @_;
2219

2220
    argsplit("log");
2221

2222
    $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
2223
    #$log->debug("log state : " . Dumper($state));
2224

2225
    my ( $revFilter );
2226
    if ( defined ( $state->{opt}{r} ) )
2227
    {
2228
        $revFilter = $state->{opt}{r};
2229
    }
2230

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

2236
    # if no files were specified, we need to work out what files we
2237
    # should be providing status on ...
2238
    argsfromdir($updater);
2239

2240
    # foreach file specified on the command line ...
2241
    foreach my $filename ( @{$state->{args}} )
2242
    {
2243
        $filename = filecleanup($filename);
2244

2245
        my $headmeta = $updater->getmeta($filename);
2246

2247
        my ($revisions,$totalrevisions) = $updater->getlog($filename,
2248
                                                           $revFilter);
2249

2250
        next unless ( scalar(@$revisions) );
2251

2252
        print "M \n";
2253
        print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
2254
        print "M Working file: $filename\n";
2255
        print "M head: $headmeta->{revision}\n";
2256
        print "M branch:\n";
2257
        print "M locks: strict\n";
2258
        print "M access list:\n";
2259
        print "M symbolic names:\n";
2260
        print "M keyword substitution: kv\n";
2261
        print "M total revisions: $totalrevisions;\tselected revisions: " .
2262
              scalar(@$revisions) . "\n";
2263
        print "M description:\n";
2264

2265
        foreach my $revision ( @$revisions )
2266
        {
2267
            print "M ----------------------------\n";
2268
            print "M revision $revision->{revision}\n";
2269
            # reformat the date for log output
2270
            if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and
2271
                 defined($DATE_LIST->{$2}) )
2272
            {
2273
                $revision->{modified} = sprintf('%04d/%02d/%02d %s',
2274
                                            $3, $DATE_LIST->{$2}, $1, $4 );
2275
            }
2276
            $revision->{author} = cvs_author($revision->{author});
2277
            print "M date: $revision->{modified};" .
2278
                  "  author: $revision->{author};  state: " .
2279
                  ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) .
2280
                  ";  lines: +2 -3\n";
2281
            my $commitmessage;
2282
            $commitmessage = $updater->commitmessage($revision->{commithash});
2283
            $commitmessage =~ s/^/M /mg;
2284
            print $commitmessage . "\n";
2285
        }
2286
        print "M =======" . ( "=" x 70 ) . "\n";
2287
    }
2288

2289
    print "ok\n";
2290
}
2291

2292
sub req_annotate
2293
{
2294
    my ( $cmd, $data ) = @_;
2295

2296
    argsplit("annotate");
2297

2298
    $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
2299
    #$log->debug("status state : " . Dumper($state));
2300

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

2305
    # if no files were specified, we need to work out what files we should be providing annotate on ...
2306
    argsfromdir($updater);
2307

2308
    # we'll need a temporary checkout dir
2309
    setupWorkTree();
2310

2311
    $log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
2312

2313
    # foreach file specified on the command line ...
2314
    foreach my $filename ( @{$state->{args}} )
2315
    {
2316
        $filename = filecleanup($filename);
2317

2318
        my $meta = $updater->getmeta($filename);
2319

2320
        next unless ( $meta->{revision} );
2321

2322
	# get all the commits that this file was in
2323
	# in dense format -- aka skip dead revisions
2324
        my $revisions   = $updater->gethistorydense($filename);
2325
	my $lastseenin  = $revisions->[0][2];
2326

2327
	# populate the temporary index based on the latest commit were we saw
2328
	# the file -- but do it cheaply without checking out any files
2329
	# TODO: if we got a revision from the client, use that instead
2330
	# to look up the commithash in sqlite (still good to default to
2331
	# the current head as we do now)
2332
	system("git", "read-tree", $lastseenin);
2333
	unless ($? == 0)
2334
	{
2335
	    print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
2336
	    return;
2337
	}
2338
	$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
2339

2340
        # do a checkout of the file
2341
        system('git', 'checkout-index', '-f', '-u', $filename);
2342
        unless ($? == 0) {
2343
            print "E error running git-checkout-index -f -u $filename : $!\n";
2344
            return;
2345
        }
2346

2347
        $log->info("Annotate $filename");
2348

2349
        # Prepare a file with the commits from the linearized
2350
        # history that annotate should know about. This prevents
2351
        # git-jsannotate telling us about commits we are hiding
2352
        # from the client.
2353

2354
        my $a_hints = "$work->{workDir}/.annotate_hints";
2355
        if (!open(ANNOTATEHINTS, '>', $a_hints)) {
2356
            print "E failed to open '$a_hints' for writing: $!\n";
2357
            return;
2358
        }
2359
        for (my $i=0; $i < @$revisions; $i++)
2360
        {
2361
            print ANNOTATEHINTS $revisions->[$i][2];
2362
            if ($i+1 < @$revisions) { # have we got a parent?
2363
                print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
2364
            }
2365
            print ANNOTATEHINTS "\n";
2366
        }
2367

2368
        print ANNOTATEHINTS "\n";
2369
        close ANNOTATEHINTS
2370
            or (print "E failed to write $a_hints: $!\n"), return;
2371

2372
        my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
2373
        if (!open(ANNOTATE, "-|", @cmd)) {
2374
            print "E error invoking ". join(' ',@cmd) .": $!\n";
2375
            return;
2376
        }
2377
        my $metadata = {};
2378
        print "E Annotations for $filename\n";
2379
        print "E ***************\n";
2380
        while ( <ANNOTATE> )
2381
        {
2382
            if (m/^([a-zA-Z0-9]{$state->{hexsz}})\t\([^\)]*\)(.*)$/i)
2383
            {
2384
                my $commithash = $1;
2385
                my $data = $2;
2386
                unless ( defined ( $metadata->{$commithash} ) )
2387
                {
2388
                    $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
2389
                    $metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
2390
                    $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
2391
                }
2392
                printf("M %-7s      (%-8s %10s): %s\n",
2393
                    $metadata->{$commithash}{revision},
2394
                    $metadata->{$commithash}{author},
2395
                    $metadata->{$commithash}{modified},
2396
                    $data
2397
                );
2398
            } else {
2399
                $log->warn("Error in annotate output! LINE: $_");
2400
                print "E Annotate error \n";
2401
                next;
2402
            }
2403
        }
2404
        close ANNOTATE;
2405
    }
2406

2407
    # done; get out of the tempdir
2408
    cleanupWorkTree();
2409

2410
    print "ok\n";
2411

2412
}
2413

2414
# This method takes the state->{arguments} array and produces two new arrays.
2415
# The first is $state->{args} which is everything before the '--' argument, and
2416
# the second is $state->{files} which is everything after it.
2417
sub argsplit
2418
{
2419
    $state->{args} = [];
2420
    $state->{files} = [];
2421
    $state->{opt} = {};
2422

2423
    return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
2424

2425
    my $type = shift;
2426

2427
    if ( defined($type) )
2428
    {
2429
        my $opt = {};
2430
        $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" );
2431
        $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
2432
        $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" );
2433
        $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2, N => 0 } if ( $type eq "diff" );
2434
        $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
2435
        $opt = { k => 1, m => 1 } if ( $type eq "add" );
2436
        $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
2437
        $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" );
2438

2439

2440
        while ( scalar ( @{$state->{arguments}} ) > 0 )
2441
        {
2442
            my $arg = shift @{$state->{arguments}};
2443

2444
            next if ( $arg eq "--" );
2445
            next unless ( $arg =~ /\S/ );
2446

2447
            # if the argument looks like a switch
2448
            if ( $arg =~ /^-(\w)(.*)/ )
2449
            {
2450
                # if it's a switch that takes an argument
2451
                if ( $opt->{$1} )
2452
                {
2453
                    # If this switch has already been provided
2454
                    if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
2455
                    {
2456
                        $state->{opt}{$1} = [ $state->{opt}{$1} ];
2457
                        if ( length($2) > 0 )
2458
                        {
2459
                            push @{$state->{opt}{$1}},$2;
2460
                        } else {
2461
                            push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
2462
                        }
2463
                    } else {
2464
                        # if there's extra data in the arg, use that as the argument for the switch
2465
                        if ( length($2) > 0 )
2466
                        {
2467
                            $state->{opt}{$1} = $2;
2468
                        } else {
2469
                            $state->{opt}{$1} = shift @{$state->{arguments}};
2470
                        }
2471
                    }
2472
                } else {
2473
                    $state->{opt}{$1} = undef;
2474
                }
2475
            }
2476
            else
2477
            {
2478
                push @{$state->{args}}, $arg;
2479
            }
2480
        }
2481
    }
2482
    else
2483
    {
2484
        my $mode = 0;
2485

2486
        foreach my $value ( @{$state->{arguments}} )
2487
        {
2488
            if ( $value eq "--" )
2489
            {
2490
                $mode++;
2491
                next;
2492
            }
2493
            push @{$state->{args}}, $value if ( $mode == 0 );
2494
            push @{$state->{files}}, $value if ( $mode == 1 );
2495
        }
2496
    }
2497
}
2498

2499
# Used by argsfromdir
2500
sub expandArg
2501
{
2502
    my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
2503

2504
    my $fullPath = filecleanup($path);
2505

2506
      # Is it a directory?
2507
    if( defined($state->{dirMap}{$fullPath}) ||
2508
        defined($state->{dirMap}{"$fullPath/"}) )
2509
    {
2510
          # It is a directory in the user's sandbox.
2511
        $isDir=1;
2512

2513
        if(defined($state->{entries}{$fullPath}))
2514
        {
2515
            $log->fatal("Inconsistent file/dir type");
2516
            die "Inconsistent file/dir type";
2517
        }
2518
    }
2519
    elsif(defined($state->{entries}{$fullPath}))
2520
    {
2521
          # It is a file in the user's sandbox.
2522
        $isDir=0;
2523
    }
2524
    my($revDirMap,$otherRevDirMap);
2525
    if(!defined($isDir) || $isDir)
2526
    {
2527
          # Resolve version tree for sticky tag:
2528
          # (for now we only want list of files for the version, not
2529
          # particular versions of those files: assume it is a directory
2530
          # for the moment; ignore Entry's stick tag)
2531

2532
          # Order of precedence of sticky tags:
2533
          #    -A       [head]
2534
          #    -r /tag/
2535
          #    [file entry sticky tag, but that is only relevant to files]
2536
          #    [the tag specified in dir req_Sticky]
2537
          #    [the tag specified in a parent dir req_Sticky]
2538
          #    [head]
2539
          # Also, -r may appear twice (for diff).
2540
          #
2541
          # FUTURE: When/if -j (merges) are supported, we also
2542
          #  need to add relevant files from one or two
2543
          #  versions specified with -j.
2544

2545
        if(exists($state->{opt}{A}))
2546
        {
2547
            $revDirMap=$updater->getRevisionDirMap();
2548
        }
2549
        elsif( defined($state->{opt}{r}) and
2550
               ref $state->{opt}{r} eq "ARRAY" )
2551
        {
2552
            $revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
2553
            $otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
2554
        }
2555
        elsif(defined($state->{opt}{r}))
2556
        {
2557
            $revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
2558
        }
2559
        else
2560
        {
2561
            my($sticky)=getDirStickyInfo($fullPath);
2562
            $revDirMap=$updater->getRevisionDirMap($sticky->{tag});
2563
        }
2564

2565
          # Is it a directory?
2566
        if( defined($revDirMap->{$fullPath}) ||
2567
            defined($otherRevDirMap->{$fullPath}) )
2568
        {
2569
            $isDir=1;
2570
        }
2571
    }
2572

2573
      # What to do with it?
2574
    if(!$isDir)
2575
    {
2576
        $outNameMap->{$fullPath}=1;
2577
    }
2578
    else
2579
    {
2580
        $outDirMap->{$fullPath}=1;
2581

2582
        if(defined($revDirMap->{$fullPath}))
2583
        {
2584
            addDirMapFiles($updater,$outNameMap,$outDirMap,
2585
                           $revDirMap->{$fullPath});
2586
        }
2587
        if( defined($otherRevDirMap) &&
2588
            defined($otherRevDirMap->{$fullPath}) )
2589
        {
2590
            addDirMapFiles($updater,$outNameMap,$outDirMap,
2591
                           $otherRevDirMap->{$fullPath});
2592
        }
2593
    }
2594
}
2595

2596
# Used by argsfromdir
2597
# Add entries from dirMap to outNameMap.  Also recurse into entries
2598
# that are subdirectories.
2599
sub addDirMapFiles
2600
{
2601
    my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
2602

2603
    my($fullName);
2604
    foreach $fullName (keys(%$dirMap))
2605
    {
2606
        my $cleanName=$fullName;
2607
        if(defined($state->{prependdir}))
2608
        {
2609
            if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
2610
            {
2611
                $log->fatal("internal error stripping prependdir");
2612
                die "internal error stripping prependdir";
2613
            }
2614
        }
2615

2616
        if($dirMap->{$fullName} eq "F")
2617
        {
2618
            $outNameMap->{$cleanName}=1;
2619
        }
2620
        elsif($dirMap->{$fullName} eq "D")
2621
        {
2622
            if(!$state->{opt}{l})
2623
            {
2624
                expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
2625
            }
2626
        }
2627
        else
2628
        {
2629
            $log->fatal("internal error in addDirMapFiles");
2630
            die "internal error in addDirMapFiles";
2631
        }
2632
    }
2633
}
2634

2635
# This method replaces $state->{args} with a directory-expanded
2636
# list of all relevant filenames (recursively unless -d), based
2637
# on $state->{entries}, and the "current" list of files in
2638
# each directory.  "Current" files as determined by
2639
# either the requested (-r/-A) or "req_Sticky" version of
2640
# that directory.
2641
#    Both the input args and the new output args are relative
2642
# to the cvs-client's CWD, although some of the internal
2643
# computations are relative to the top of the project.
2644
sub argsfromdir
2645
{
2646
    my $updater = shift;
2647

2648
    # Notes about requirements for specific callers:
2649
    #   update # "standard" case (entries; a single -r/-A/default; -l)
2650
    #          # Special case: -d for create missing directories.
2651
    #   diff # 0 or 1 -r's: "standard" case.
2652
    #        # 2 -r's: We could ignore entries (just use the two -r's),
2653
    #        # but it doesn't really matter.
2654
    #   annotate # "standard" case
2655
    #   log # Punting: log -r has a more complex non-"standard"
2656
    #       # meaning, and we don't currently try to support log'ing
2657
    #       # branches at all (need a lot of work to
2658
    #       # support CVS-consistent branch relative version
2659
    #       # numbering).
2660
#HERE: But we still want to expand directories.  Maybe we should
2661
#  essentially force "-A".
2662
    #   status # "standard", except that -r/-A/default are not possible.
2663
    #          # Mostly only used to expand entries only)
2664
    #
2665
    # Don't use argsfromdir at all:
2666
    #   add # Explicit arguments required.  Directory args imply add
2667
    #       # the directory itself, not the files in it.
2668
    #   co  # Obtain list directly.
2669
    #   remove # HERE: TEST: MAYBE client does the recursion for us,
2670
    #          # since it only makes sense to remove stuff already in
2671
    #          # the sandbox?
2672
    #   ci # HERE: Similar to remove...
2673
    #      # Don't try to implement the confusing/weird
2674
    #      # ci -r bug er.."feature".
2675

2676
    if(scalar(@{$state->{args}})==0)
2677
    {
2678
        $state->{args} = [ "." ];
2679
    }
2680
    my %allArgs;
2681
    my %allDirs;
2682
    for my $file (@{$state->{args}})
2683
    {
2684
        expandArg($updater,\%allArgs,\%allDirs,$file);
2685
    }
2686

2687
    # Include any entries from sandbox.  Generally client won't
2688
    # send entries that shouldn't be used.
2689
    foreach my $file (keys %{$state->{entries}})
2690
    {
2691
        $allArgs{remove_prependdir($file)} = 1;
2692
    }
2693

2694
    $state->{dirArgs} = \%allDirs;
2695
    $state->{args} = [
2696
        sort {
2697
                # Sort priority: by directory depth, then actual file name:
2698
            my @piecesA=split('/',$a);
2699
            my @piecesB=split('/',$b);
2700

2701
            my $count=scalar(@piecesA);
2702
            my $tmp=scalar(@piecesB);
2703
            return $count<=>$tmp if($count!=$tmp);
2704

2705
            for($tmp=0;$tmp<$count;$tmp++)
2706
            {
2707
                if($piecesA[$tmp] ne $piecesB[$tmp])
2708
                {
2709
                    return $piecesA[$tmp] cmp $piecesB[$tmp]
2710
                }
2711
            }
2712
            return 0;
2713
        } keys(%allArgs) ];
2714
}
2715

2716
## look up directory sticky tag, of either fullPath or a parent:
2717
sub getDirStickyInfo
2718
{
2719
    my($fullPath)=@_;
2720

2721
    $fullPath=~s%/+$%%;
2722
    while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
2723
    {
2724
        $fullPath=~s%/?[^/]*$%%;
2725
    }
2726

2727
    if( !defined($state->{dirMap}{"$fullPath/"}) &&
2728
        ( $fullPath eq "" ||
2729
          $fullPath eq "." ) )
2730
    {
2731
        return $state->{dirMap}{""}{stickyInfo};
2732
    }
2733
    else
2734
    {
2735
        return $state->{dirMap}{"$fullPath/"}{stickyInfo};
2736
    }
2737
}
2738

2739
# Resolve precedence of various ways of specifying which version of
2740
# a file you want.  Returns undef (for default head), or a ref to a hash
2741
# that contains "tag" and/or "date" keys.
2742
sub resolveStickyInfo
2743
{
2744
    my($filename,$stickyTag,$stickyDate,$reset) = @_;
2745

2746
    # Order of precedence of sticky tags:
2747
    #    -A       [head]
2748
    #    -r /tag/
2749
    #    [file entry sticky tag]
2750
    #    [the tag specified in dir req_Sticky]
2751
    #    [the tag specified in a parent dir req_Sticky]
2752
    #    [head]
2753

2754
    my $result;
2755
    if($reset)
2756
    {
2757
        # $result=undef;
2758
    }
2759
    elsif( defined($stickyTag) && $stickyTag ne "" )
2760
           # || ( defined($stickyDate) && $stickyDate ne "" )   # TODO
2761
    {
2762
        $result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
2763

2764
        # TODO: Convert -D value into the form 2011.04.10.04.46.57,
2765
        #   similar to an entry line's sticky date, without the D prefix.
2766
        #   It sometimes (always?) arrives as something more like
2767
        #   '10 Apr 2011 04:46:57 -0000'...
2768
        # $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
2769
    }
2770
    elsif( defined($state->{entries}{$filename}) &&
2771
           defined($state->{entries}{$filename}{tag_or_date}) &&
2772
           $state->{entries}{$filename}{tag_or_date} ne "" )
2773
    {
2774
        my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
2775
        if($tagOrDate=~/^T([^ ]+)\s*$/)
2776
        {
2777
            $result = { 'tag' => $1 };
2778
        }
2779
        elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
2780
        {
2781
            $result= { 'date' => $1 };
2782
        }
2783
        else
2784
        {
2785
            die "Unknown tag_or_date format\n";
2786
        }
2787
    }
2788
    else
2789
    {
2790
        $result=getDirStickyInfo($filename);
2791
    }
2792

2793
    return $result;
2794
}
2795

2796
# Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into
2797
# a form appropriate for the sticky tag field of an Entries
2798
# line (field index 5, 0-based).
2799
sub getStickyTagOrDate
2800
{
2801
    my($stickyInfo)=@_;
2802

2803
    my $result;
2804
    if(defined($stickyInfo) && defined($stickyInfo->{tag}))
2805
    {
2806
        $result="T$stickyInfo->{tag}";
2807
    }
2808
    # TODO: When/if we actually pick versions by {date} properly,
2809
    #   also handle it here:
2810
    #   "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").
2811
    else
2812
    {
2813
        $result="";
2814
    }
2815

2816
    return $result;
2817
}
2818

2819
# This method cleans up the $state variable after a command that uses arguments has run
2820
sub statecleanup
2821
{
2822
    $state->{files} = [];
2823
    $state->{dirArgs} = {};
2824
    $state->{args} = [];
2825
    $state->{arguments} = [];
2826
    $state->{entries} = {};
2827
    $state->{dirMap} = {};
2828
}
2829

2830
# Return working directory CVS revision "1.X" out
2831
# of the working directory "entries" state, for the given filename.
2832
# This is prefixed with a dash if the file is scheduled for removal
2833
# when it is committed.
2834
sub revparse
2835
{
2836
    my $filename = shift;
2837

2838
    return $state->{entries}{$filename}{revision};
2839
}
2840

2841
# This method takes a file hash and does a CVS "file transfer".  Its
2842
# exact behaviour depends on a second, optional hash table argument:
2843
# - If $options->{targetfile}, dump the contents to that file;
2844
# - If $options->{print}, use M/MT to transmit the contents one line
2845
#   at a time;
2846
# - Otherwise, transmit the size of the file, followed by the file
2847
#   contents.
2848
sub transmitfile
2849
{
2850
    my $filehash = shift;
2851
    my $options = shift;
2852

2853
    if ( defined ( $filehash ) and $filehash eq "deleted" )
2854
    {
2855
        $log->warn("filehash is 'deleted'");
2856
        return;
2857
    }
2858

2859
    die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ );
2860

2861
    my $type = safe_pipe_capture('git', 'cat-file', '-t', $filehash);
2862
    chomp $type;
2863

2864
    die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2865

2866
    my $size = safe_pipe_capture('git', 'cat-file', '-s', $filehash);
2867
    chomp $size;
2868

2869
    $log->debug("transmitfile($filehash) size=$size, type=$type");
2870

2871
    if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
2872
    {
2873
        if ( defined ( $options->{targetfile} ) )
2874
        {
2875
            my $targetfile = $options->{targetfile};
2876
            open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2877
            print NEWFILE $_ while ( <$fh> );
2878
            close NEWFILE or die("Failed to write '$targetfile': $!");
2879
        } elsif ( defined ( $options->{print} ) && $options->{print} ) {
2880
            while ( <$fh> ) {
2881
                if( /\n\z/ ) {
2882
                    print 'M ', $_;
2883
                } else {
2884
                    print 'MT text ', $_, "\n";
2885
                }
2886
            }
2887
        } else {
2888
            print "$size\n";
2889
            print while ( <$fh> );
2890
        }
2891
        close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
2892
    } else {
2893
        die("Couldn't execute git-cat-file");
2894
    }
2895
}
2896

2897
# This method takes a file name, and returns ( $dirpart, $filepart ) which
2898
# refers to the directory portion and the file portion of the filename
2899
# respectively
2900
sub filenamesplit
2901
{
2902
    my $filename = shift;
2903
    my $fixforlocaldir = shift;
2904

2905
    my ( $filepart, $dirpart ) = ( $filename, "." );
2906
    ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2907
    $dirpart .= "/";
2908

2909
    if ( $fixforlocaldir )
2910
    {
2911
        $dirpart =~ s/^$state->{prependdir}//;
2912
    }
2913

2914
    return ( $filepart, $dirpart );
2915
}
2916

2917
# Cleanup various junk in filename (try to canonicalize it), and
2918
# add prependdir to accommodate running CVS client from a
2919
# subdirectory (so the output is relative to top directory of the project).
2920
sub filecleanup
2921
{
2922
    my $filename = shift;
2923

2924
    return undef unless(defined($filename));
2925
    if ( $filename =~ /^\// )
2926
    {
2927
        print "E absolute filenames '$filename' not supported by server\n";
2928
        return undef;
2929
    }
2930

2931
    if($filename eq ".")
2932
    {
2933
        $filename="";
2934
    }
2935
    $filename =~ s/^\.\///g;
2936
    $filename =~ s%/+%/%g;
2937
    $filename = $state->{prependdir} . $filename;
2938
    $filename =~ s%/$%%;
2939
    return $filename;
2940
}
2941

2942
# Remove prependdir from the path, so that it is relative to the directory
2943
# the CVS client was started from, rather than the top of the project.
2944
# Essentially the inverse of filecleanup().
2945
sub remove_prependdir
2946
{
2947
    my($path) = @_;
2948
    if(defined($state->{prependdir}) && $state->{prependdir} ne "")
2949
    {
2950
        my($pre)=$state->{prependdir};
2951
        $pre=~s%/$%%;
2952
        if(!($path=~s%^\Q$pre\E/?%%))
2953
        {
2954
            $log->fatal("internal error missing prependdir");
2955
            die("internal error missing prependdir");
2956
        }
2957
    }
2958
    return $path;
2959
}
2960

2961
sub validateGitDir
2962
{
2963
    if( !defined($state->{CVSROOT}) )
2964
    {
2965
        print "error 1 CVSROOT not specified\n";
2966
        cleanupWorkTree();
2967
        exit;
2968
    }
2969
    if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
2970
    {
2971
        print "error 1 Internally inconsistent CVSROOT\n";
2972
        cleanupWorkTree();
2973
        exit;
2974
    }
2975
}
2976

2977
# Setup working directory in a work tree with the requested version
2978
# loaded in the index.
2979
sub setupWorkTree
2980
{
2981
    my ($ver) = @_;
2982

2983
    validateGitDir();
2984

2985
    if( ( defined($work->{state}) && $work->{state} != 1 ) ||
2986
        defined($work->{tmpDir}) )
2987
    {
2988
        $log->warn("Bad work tree state management");
2989
        print "error 1 Internal setup multiple work trees without cleanup\n";
2990
        cleanupWorkTree();
2991
        exit;
2992
    }
2993

2994
    $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
2995

2996
    if( !defined($work->{index}) )
2997
    {
2998
        (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2999
    }
3000

3001
    chdir $work->{workDir} or
3002
        die "Unable to chdir to $work->{workDir}\n";
3003

3004
    $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
3005

3006
    $ENV{GIT_WORK_TREE} = ".";
3007
    $ENV{GIT_INDEX_FILE} = $work->{index};
3008
    $work->{state} = 2;
3009

3010
    if($ver)
3011
    {
3012
        system("git","read-tree",$ver);
3013
        unless ($? == 0)
3014
        {
3015
            $log->warn("Error running git-read-tree");
3016
            die "Error running git-read-tree $ver in $work->{workDir} $!\n";
3017
        }
3018
    }
3019
    # else # req_annotate reads tree for each file
3020
}
3021

3022
# Ensure current directory is in some kind of working directory,
3023
# with a recent version loaded in the index.
3024
sub ensureWorkTree
3025
{
3026
    if( defined($work->{tmpDir}) )
3027
    {
3028
        $log->warn("Bad work tree state management [ensureWorkTree()]");
3029
        print "error 1 Internal setup multiple dirs without cleanup\n";
3030
        cleanupWorkTree();
3031
        exit;
3032
    }
3033
    if( $work->{state} )
3034
    {
3035
        return;
3036
    }
3037

3038
    validateGitDir();
3039

3040
    if( !defined($work->{emptyDir}) )
3041
    {
3042
        $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
3043
    }
3044
    chdir $work->{emptyDir} or
3045
        die "Unable to chdir to $work->{emptyDir}\n";
3046

3047
    my $ver = safe_pipe_capture('git', 'show-ref', '-s', "refs/heads/$state->{module}");
3048
    chomp $ver;
3049
    if ($ver !~ /^[0-9a-f]{$state->{hexsz}}$/)
3050
    {
3051
        $log->warn("Error from git show-ref -s refs/head$state->{module}");
3052
        print "error 1 cannot find the current HEAD of module";
3053
        cleanupWorkTree();
3054
        exit;
3055
    }
3056

3057
    if( !defined($work->{index}) )
3058
    {
3059
        (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
3060
    }
3061

3062
    $ENV{GIT_WORK_TREE} = ".";
3063
    $ENV{GIT_INDEX_FILE} = $work->{index};
3064
    $work->{state} = 1;
3065

3066
    system("git","read-tree",$ver);
3067
    unless ($? == 0)
3068
    {
3069
        die "Error running git-read-tree $ver $!\n";
3070
    }
3071
}
3072

3073
# Cleanup working directory that is not needed any longer.
3074
sub cleanupWorkTree
3075
{
3076
    if( ! $work->{state} )
3077
    {
3078
        return;
3079
    }
3080

3081
    chdir "/" or die "Unable to chdir '/'\n";
3082

3083
    if( defined($work->{workDir}) )
3084
    {
3085
        rmtree( $work->{workDir} );
3086
        undef $work->{workDir};
3087
    }
3088
    undef $work->{state};
3089
}
3090

3091
# Setup a temporary directory (not a working tree), typically for
3092
# merging dirty state as in req_update.
3093
sub setupTmpDir
3094
{
3095
    $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
3096
    chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
3097

3098
    return $work->{tmpDir};
3099
}
3100

3101
# Clean up a previously setupTmpDir.  Restore previous work tree if
3102
# appropriate.
3103
sub cleanupTmpDir
3104
{
3105
    if ( !defined($work->{tmpDir}) )
3106
    {
3107
        $log->warn("cleanup tmpdir that has not been setup");
3108
        die "Cleanup tmpDir that has not been setup\n";
3109
    }
3110
    if( defined($work->{state}) )
3111
    {
3112
        if( $work->{state} == 1 )
3113
        {
3114
            chdir $work->{emptyDir} or
3115
                die "Unable to chdir to $work->{emptyDir}\n";
3116
        }
3117
        elsif( $work->{state} == 2 )
3118
        {
3119
            chdir $work->{workDir} or
3120
                die "Unable to chdir to $work->{emptyDir}\n";
3121
        }
3122
        else
3123
        {
3124
            $log->warn("Inconsistent work dir state");
3125
            die "Inconsistent work dir state\n";
3126
        }
3127
    }
3128
    else
3129
    {
3130
        chdir "/" or die "Unable to chdir '/'\n";
3131
    }
3132
}
3133

3134
# Given a path, this function returns a string containing the kopts
3135
# that should go into that path's Entries line.  For example, a binary
3136
# file should get -kb.
3137
sub kopts_from_path
3138
{
3139
    my ($path, $srcType, $name) = @_;
3140

3141
    if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
3142
         $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
3143
    {
3144
        my ($val) = check_attr( "text", $path );
3145
        if ( $val eq "unspecified" )
3146
        {
3147
            $val = check_attr( "crlf", $path );
3148
        }
3149
        if ( $val eq "unset" )
3150
        {
3151
            return "-kb"
3152
        }
3153
        elsif ( check_attr( "eol", $path ) ne "unspecified" ||
3154
                $val eq "set" || $val eq "input" )
3155
        {
3156
            return "";
3157
        }
3158
        else
3159
        {
3160
            $log->info("Unrecognized check_attr crlf $path : $val");
3161
        }
3162
    }
3163

3164
    if ( defined ( $cfg->{gitcvs}{allbinary} ) )
3165
    {
3166
        if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
3167
        {
3168
            return "-kb";
3169
        }
3170
        elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
3171
        {
3172
            if( is_binary($srcType,$name) )
3173
            {
3174
                $log->debug("... as binary");
3175
                return "-kb";
3176
            }
3177
            else
3178
            {
3179
                $log->debug("... as text");
3180
            }
3181
        }
3182
    }
3183
    # Return "" to give no special treatment to any path
3184
    return "";
3185
}
3186

3187
sub check_attr
3188
{
3189
    my ($attr,$path) = @_;
3190
    ensureWorkTree();
3191
    if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
3192
    {
3193
        my $val = <$fh>;
3194
        close $fh;
3195
        $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
3196
        return $val;
3197
    }
3198
    else
3199
    {
3200
        return undef;
3201
    }
3202
}
3203

3204
# This should have the same heuristics as convert.c:is_binary() and related.
3205
# Note that the bare CR test is done by callers in convert.c.
3206
sub is_binary
3207
{
3208
    my ($srcType,$name) = @_;
3209
    $log->debug("is_binary($srcType,$name)");
3210

3211
    # Minimize amount of interpreted code run in the inner per-character
3212
    # loop for large files, by totalling each character value and
3213
    # then analyzing the totals.
3214
    my @counts;
3215
    my $i;
3216
    for($i=0;$i<256;$i++)
3217
    {
3218
        $counts[$i]=0;
3219
    }
3220

3221
    my $fh = open_blob_or_die($srcType,$name);
3222
    my $line;
3223
    while( defined($line=<$fh>) )
3224
    {
3225
        # Any '\0' and bare CR are considered binary.
3226
        if( $line =~ /\0|(\r[^\n])/ )
3227
        {
3228
            close($fh);
3229
            return 1;
3230
        }
3231

3232
        # Count up each character in the line:
3233
        my $len=length($line);
3234
        for($i=0;$i<$len;$i++)
3235
        {
3236
            $counts[ord(substr($line,$i,1))]++;
3237
        }
3238
    }
3239
    close $fh;
3240

3241
    # Don't count CR and LF as either printable/nonprintable
3242
    $counts[ord("\n")]=0;
3243
    $counts[ord("\r")]=0;
3244

3245
    # Categorize individual character count into printable and nonprintable:
3246
    my $printable=0;
3247
    my $nonprintable=0;
3248
    for($i=0;$i<256;$i++)
3249
    {
3250
        if( $i < 32 &&
3251
            $i != ord("\b") &&
3252
            $i != ord("\t") &&
3253
            $i != 033 &&       # ESC
3254
            $i != 014 )        # FF
3255
        {
3256
            $nonprintable+=$counts[$i];
3257
        }
3258
        elsif( $i==127 )  # DEL
3259
        {
3260
            $nonprintable+=$counts[$i];
3261
        }
3262
        else
3263
        {
3264
            $printable+=$counts[$i];
3265
        }
3266
    }
3267

3268
    return ($printable >> 7) < $nonprintable;
3269
}
3270

3271
# Returns open file handle.  Possible invocations:
3272
#  - open_blob_or_die("file",$filename);
3273
#  - open_blob_or_die("sha1",$filehash);
3274
sub open_blob_or_die
3275
{
3276
    my ($srcType,$name) = @_;
3277
    my ($fh);
3278
    if( $srcType eq "file" )
3279
    {
3280
        if( !open $fh,"<",$name )
3281
        {
3282
            $log->warn("Unable to open file $name: $!");
3283
            die "Unable to open file $name: $!\n";
3284
        }
3285
    }
3286
    elsif( $srcType eq "sha1" )
3287
    {
3288
        unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ )
3289
        {
3290
            $log->warn("Need filehash");
3291
            die "Need filehash\n";
3292
        }
3293

3294
        my $type = safe_pipe_capture('git', 'cat-file', '-t', $name);
3295
        chomp $type;
3296

3297
        unless ( defined ( $type ) and $type eq "blob" )
3298
        {
3299
            $log->warn("Invalid type '$type' for '$name'");
3300
            die ( "Invalid type '$type' (expected 'blob')" )
3301
        }
3302

3303
        my $size = safe_pipe_capture('git', 'cat-file', '-s', $name);
3304
        chomp $size;
3305

3306
        $log->debug("open_blob_or_die($name) size=$size, type=$type");
3307

3308
        unless( open $fh, '-|', "git", "cat-file", "blob", $name )
3309
        {
3310
            $log->warn("Unable to open sha1 $name");
3311
            die "Unable to open sha1 $name\n";
3312
        }
3313
    }
3314
    else
3315
    {
3316
        $log->warn("Unknown type of blob source: $srcType");
3317
        die "Unknown type of blob source: $srcType\n";
3318
    }
3319
    return $fh;
3320
}
3321

3322
# Generate a CVS author name from Git author information, by taking the local
3323
# part of the email address and replacing characters not in the Portable
3324
# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS
3325
# Login names are Unix login names, which should be restricted to this
3326
# character set.
3327
sub cvs_author
3328
{
3329
    my $author_line = shift;
3330
    (my $author) = $author_line =~ /<([^@>]*)/;
3331

3332
    $author =~ s/[^-a-zA-Z0-9_.]/_/g;
3333
    $author =~ s/^-/_/;
3334

3335
    $author;
3336
}
3337

3338

3339
sub descramble
3340
{
3341
    # This table is from src/scramble.c in the CVS source
3342
    my @SHIFTS = (
3343
        0,  1,  2,  3,  4,  5,  6,  7,  8,  9, 10, 11, 12, 13, 14, 15,
3344
        16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
3345
        114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
3346
        111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
3347
        41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
3348
        125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
3349
        36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
3350
        58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
3351
        225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
3352
        199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
3353
        174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
3354
        207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
3355
        192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
3356
        227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
3357
        182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
3358
        243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
3359
    );
3360
    my ($str) = @_;
3361

3362
    # This should never happen, the same password format (A) has been
3363
    # used by CVS since the beginning of time
3364
    {
3365
        my $fmt = substr($str, 0, 1);
3366
        die "invalid password format `$fmt'" unless $fmt eq 'A';
3367
    }
3368

3369
    my @str = unpack "C*", substr($str, 1);
3370
    my $ret = join '', map { chr $SHIFTS[$_] } @str;
3371
    return $ret;
3372
}
3373

3374
# Test if the (deep) values of two references to a hash are the same.
3375
sub refHashEqual
3376
{
3377
    my($v1,$v2) = @_;
3378

3379
    my $out;
3380
    if(!defined($v1))
3381
    {
3382
        if(!defined($v2))
3383
        {
3384
            $out=1;
3385
        }
3386
    }
3387
    elsif( !defined($v2) ||
3388
           scalar(keys(%{$v1})) != scalar(keys(%{$v2})) )
3389
    {
3390
        # $out=undef;
3391
    }
3392
    else
3393
    {
3394
        $out=1;
3395

3396
        my $key;
3397
        foreach $key (keys(%{$v1}))
3398
        {
3399
            if( !exists($v2->{$key}) ||
3400
                defined($v1->{$key}) ne defined($v2->{$key}) ||
3401
                ( defined($v1->{$key}) &&
3402
                  $v1->{$key} ne $v2->{$key} ) )
3403
            {
3404
               $out=undef;
3405
               last;
3406
            }
3407
        }
3408
    }
3409

3410
    return $out;
3411
}
3412

3413
# an alternative to `command` that allows input to be passed as an array
3414
# to work around shell problems with weird characters in arguments
3415

3416
sub safe_pipe_capture {
3417

3418
    my @output;
3419

3420
    if (my $pid = open my $child, '-|') {
3421
        @output = (<$child>);
3422
        close $child or die join(' ',@_).": $! $?";
3423
    } else {
3424
        exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
3425
    }
3426
    return wantarray ? @output : join('',@output);
3427
}
3428

3429

3430
package GITCVS::log;
3431

3432
####
3433
#### Copyright The Open University UK - 2006.
3434
####
3435
#### Authors: Martyn Smith    <martyn@catalyst.net.nz>
3436
####          Martin Langhoff <martin@laptop.org>
3437
####
3438
####
3439

3440
use strict;
3441
use warnings;
3442

3443
=head1 NAME
3444

3445
GITCVS::log
3446

3447
=head1 DESCRIPTION
3448

3449
This module provides very crude logging with a similar interface to
3450
Log::Log4perl
3451

3452
=head1 METHODS
3453

3454
=cut
3455

3456
=head2 new
3457

3458
Creates a new log object, optionally you can specify a filename here to
3459
indicate the file to log to. If no log file is specified, you can specify one
3460
later with method setfile, or indicate you no longer want logging with method
3461
nofile.
3462

3463
Until one of these methods is called, all log calls will buffer messages ready
3464
to write out.
3465

3466
=cut
3467
sub new
3468
{
3469
    my $class = shift;
3470
    my $filename = shift;
3471

3472
    my $self = {};
3473

3474
    bless $self, $class;
3475

3476
    if ( defined ( $filename ) )
3477
    {
3478
        open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3479
    }
3480

3481
    return $self;
3482
}
3483

3484
=head2 setfile
3485

3486
This methods takes a filename, and attempts to open that file as the log file.
3487
If successful, all buffered data is written out to the file, and any further
3488
logging is written directly to the file.
3489

3490
=cut
3491
sub setfile
3492
{
3493
    my $self = shift;
3494
    my $filename = shift;
3495

3496
    if ( defined ( $filename ) )
3497
    {
3498
        open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3499
    }
3500

3501
    return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3502

3503
    while ( my $line = shift @{$self->{buffer}} )
3504
    {
3505
        print {$self->{fh}} $line;
3506
    }
3507
}
3508

3509
=head2 nofile
3510

3511
This method indicates no logging is going to be used. It flushes any entries in
3512
the internal buffer, and sets a flag to ensure no further data is put there.
3513

3514
=cut
3515
sub nofile
3516
{
3517
    my $self = shift;
3518

3519
    $self->{nolog} = 1;
3520

3521
    return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3522

3523
    $self->{buffer} = [];
3524
}
3525

3526
=head2 _logopen
3527

3528
Internal method. Returns true if the log file is open, false otherwise.
3529

3530
=cut
3531
sub _logopen
3532
{
3533
    my $self = shift;
3534

3535
    return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
3536
    return 0;
3537
}
3538

3539
=head2 debug info warn fatal
3540

3541
These four methods are wrappers to _log. They provide the actual interface for
3542
logging data.
3543

3544
=cut
3545
sub debug { my $self = shift; $self->_log("debug", @_); }
3546
sub info  { my $self = shift; $self->_log("info" , @_); }
3547
sub warn  { my $self = shift; $self->_log("warn" , @_); }
3548
sub fatal { my $self = shift; $self->_log("fatal", @_); }
3549

3550
=head2 _log
3551

3552
This is an internal method called by the logging functions. It generates a
3553
timestamp and pushes the logged line either to file, or internal buffer.
3554

3555
=cut
3556
sub _log
3557
{
3558
    my $self = shift;
3559
    my $level = shift;
3560

3561
    return if ( $self->{nolog} );
3562

3563
    my @time = localtime;
3564
    my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
3565
        $time[5] + 1900,
3566
        $time[4] + 1,
3567
        $time[3],
3568
        $time[2],
3569
        $time[1],
3570
        $time[0],
3571
        uc $level,
3572
    );
3573

3574
    if ( $self->_logopen )
3575
    {
3576
        print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
3577
    } else {
3578
        push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
3579
    }
3580
}
3581

3582
=head2 DESTROY
3583

3584
This method simply closes the file handle if one is open
3585

3586
=cut
3587
sub DESTROY
3588
{
3589
    my $self = shift;
3590

3591
    if ( $self->_logopen )
3592
    {
3593
        close $self->{fh};
3594
    }
3595
}
3596

3597
package GITCVS::updater;
3598

3599
####
3600
#### Copyright The Open University UK - 2006.
3601
####
3602
#### Authors: Martyn Smith    <martyn@catalyst.net.nz>
3603
####          Martin Langhoff <martin@laptop.org>
3604
####
3605
####
3606

3607
use strict;
3608
use warnings;
3609
use DBI;
3610
our $_use_fsync;
3611

3612
# n.b. consider using Git.pm
3613
sub use_fsync {
3614
    if (!defined($_use_fsync)) {
3615
        my $x = $ENV{GIT_TEST_FSYNC};
3616
        if (defined $x) {
3617
            local $ENV{GIT_CONFIG};
3618
            delete $ENV{GIT_CONFIG};
3619
            my $v = ::safe_pipe_capture('git', '-c', "test.fsync=$x",
3620
                                        qw(config --type=bool test.fsync));
3621
            $_use_fsync = defined($v) ? ($v eq "true\n") : 1;
3622
        }
3623
    }
3624
    $_use_fsync;
3625
}
3626

3627
=head1 METHODS
3628

3629
=cut
3630

3631
=head2 new
3632

3633
=cut
3634
sub new
3635
{
3636
    my $class = shift;
3637
    my $config = shift;
3638
    my $module = shift;
3639
    my $log = shift;
3640

3641
    die "Need to specify a git repository" unless ( defined($config) and -d $config );
3642
    die "Need to specify a module" unless ( defined($module) );
3643

3644
    $class = ref($class) || $class;
3645

3646
    my $self = {};
3647

3648
    bless $self, $class;
3649

3650
    $self->{valid_tables} = {'revision' => 1,
3651
                             'revision_ix1' => 1,
3652
                             'revision_ix2' => 1,
3653
                             'head' => 1,
3654
                             'head_ix1' => 1,
3655
                             'properties' => 1,
3656
                             'commitmsgs' => 1};
3657

3658
    $self->{module} = $module;
3659
    $self->{git_path} = $config . "/";
3660

3661
    $self->{log} = $log;
3662

3663
    die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
3664

3665
    # Stores full sha1's for various branch/tag names, abbreviations, etc:
3666
    $self->{commitRefCache} = {};
3667

3668
    $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
3669
        $cfg->{gitcvs}{dbdriver} || "SQLite";
3670
    $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
3671
        $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
3672
    $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
3673
        $cfg->{gitcvs}{dbuser} || "";
3674
    $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
3675
        $cfg->{gitcvs}{dbpass} || "";
3676
    $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
3677
        $cfg->{gitcvs}{dbtablenameprefix} || "";
3678
    my %mapping = ( m => $module,
3679
                    a => $state->{method},
3680
                    u => getlogin || getpwuid($<) || $<,
3681
                    G => $self->{git_path},
3682
                    g => mangle_dirname($self->{git_path}),
3683
                    );
3684
    $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
3685
    $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
3686
    $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
3687
    $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
3688

3689
    die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
3690
    die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
3691
    $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
3692
                                $self->{dbuser},
3693
                                $self->{dbpass});
3694
    die "Error connecting to database\n" unless defined $self->{dbh};
3695
    if ($self->{dbdriver} eq 'SQLite' && !use_fsync()) {
3696
        $self->{dbh}->do('PRAGMA synchronous = OFF');
3697
    }
3698

3699
    $self->{tables} = {};
3700
    foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
3701
    {
3702
        $self->{tables}{$table} = 1;
3703
    }
3704

3705
    # Construct the revision table if required
3706
    # The revision table stores an entry for each file, each time that file
3707
    # changes.
3708
    #   numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
3709
    # This is not sufficient to support "-r {commithash}" for any
3710
    # files except files that were modified by that commit (also,
3711
    # some places in the code ignore/effectively strip out -r in
3712
    # some cases, before it gets passed to getmeta()).
3713
    # The "filehash" field typically has a git blob hash, but can also
3714
    # be set to "dead" to indicate that the given version of the file
3715
    # should not exist in the sandbox.
3716
    unless ( $self->{tables}{$self->tablename("revision")} )
3717
    {
3718
        my $tablename = $self->tablename("revision");
3719
        my $ix1name = $self->tablename("revision_ix1");
3720
        my $ix2name = $self->tablename("revision_ix2");
3721
        $self->{dbh}->do("
3722
            CREATE TABLE $tablename (
3723
                name       TEXT NOT NULL,
3724
                revision   INTEGER NOT NULL,
3725
                filehash   TEXT NOT NULL,
3726
                commithash TEXT NOT NULL,
3727
                author     TEXT NOT NULL,
3728
                modified   TEXT NOT NULL,
3729
                mode       TEXT NOT NULL
3730
            )
3731
        ");
3732
        $self->{dbh}->do("
3733
            CREATE INDEX $ix1name
3734
            ON $tablename (name,revision)
3735
        ");
3736
        $self->{dbh}->do("
3737
            CREATE INDEX $ix2name
3738
            ON $tablename (name,commithash)
3739
        ");
3740
    }
3741

3742
    # Construct the head table if required
3743
    # The head table (along with the "last_commit" entry in the property
3744
    # table) is the persisted working state of the "sub update" subroutine.
3745
    # All of it's data is read entirely first, and completely recreated
3746
    # last, every time "sub update" runs.
3747
    # This is also used by "sub getmeta" when it is asked for the latest
3748
    # version of a file (as opposed to some specific version).
3749
    # Another way of thinking about it is as a single slice out of
3750
    # "revisions", giving just the most recent revision information for
3751
    # each file.
3752
    unless ( $self->{tables}{$self->tablename("head")} )
3753
    {
3754
        my $tablename = $self->tablename("head");
3755
        my $ix1name = $self->tablename("head_ix1");
3756
        $self->{dbh}->do("
3757
            CREATE TABLE $tablename (
3758
                name       TEXT NOT NULL,
3759
                revision   INTEGER NOT NULL,
3760
                filehash   TEXT NOT NULL,
3761
                commithash TEXT NOT NULL,
3762
                author     TEXT NOT NULL,
3763
                modified   TEXT NOT NULL,
3764
                mode       TEXT NOT NULL
3765
            )
3766
        ");
3767
        $self->{dbh}->do("
3768
            CREATE INDEX $ix1name
3769
            ON $tablename (name)
3770
        ");
3771
    }
3772

3773
    # Construct the properties table if required
3774
    #  - "last_commit" - Used by "sub update".
3775
    unless ( $self->{tables}{$self->tablename("properties")} )
3776
    {
3777
        my $tablename = $self->tablename("properties");
3778
        $self->{dbh}->do("
3779
            CREATE TABLE $tablename (
3780
                key        TEXT NOT NULL PRIMARY KEY,
3781
                value      TEXT
3782
            )
3783
        ");
3784
    }
3785

3786
    # Construct the commitmsgs table if required
3787
    # The commitmsgs table is only used for merge commits, since
3788
    # "sub update" will only keep one branch of parents.  Shortlogs
3789
    # for ignored commits (i.e. not on the chosen branch) will be used
3790
    # to construct a replacement "collapsed" merge commit message,
3791
    # which will be stored in this table.  See also "sub commitmessage".
3792
    unless ( $self->{tables}{$self->tablename("commitmsgs")} )
3793
    {
3794
        my $tablename = $self->tablename("commitmsgs");
3795
        $self->{dbh}->do("
3796
            CREATE TABLE $tablename (
3797
                key        TEXT NOT NULL PRIMARY KEY,
3798
                value      TEXT
3799
            )
3800
        ");
3801
    }
3802

3803
    return $self;
3804
}
3805

3806
=head2 tablename
3807

3808
=cut
3809
sub tablename
3810
{
3811
    my $self = shift;
3812
    my $name = shift;
3813

3814
    if (exists $self->{valid_tables}{$name}) {
3815
        return $self->{dbtablenameprefix} . $name;
3816
    } else {
3817
        return undef;
3818
    }
3819
}
3820

3821
=head2 update
3822

3823
Bring the database up to date with the latest changes from
3824
the git repository.
3825

3826
Internal working state is read out of the "head" table and the
3827
"last_commit" property, then it updates "revisions" based on that, and
3828
finally it writes the new internal state back to the "head" table
3829
so it can be used as a starting point the next time update is called.
3830

3831
=cut
3832
sub update
3833
{
3834
    my $self = shift;
3835

3836
    # first lets get the commit list
3837
    $ENV{GIT_DIR} = $self->{git_path};
3838

3839
    my $commitsha1 = ::safe_pipe_capture('git', 'rev-parse', $self->{module});
3840
    chomp $commitsha1;
3841

3842
    my $commitinfo = ::safe_pipe_capture('git', 'cat-file', 'commit', $self->{module});
3843
    unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{$state->{hexsz}}/ )
3844
    {
3845
        die("Invalid module '$self->{module}'");
3846
    }
3847

3848

3849
    my $git_log;
3850
    my $lastcommit = $self->_get_prop("last_commit");
3851

3852
    if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
3853
         # invalidate the gethead cache
3854
         $self->clearCommitRefCaches();
3855
         return 1;
3856
    }
3857

3858
    # Start exclusive lock here...
3859
    $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
3860

3861
    # TODO: log processing is memory bound
3862
    # if we can parse into a 2nd file that is in reverse order
3863
    # we can probably do something really efficient
3864
    my @git_log_params = ('--pretty', '--parents', '--topo-order');
3865

3866
    if (defined $lastcommit) {
3867
        push @git_log_params, "$lastcommit..$self->{module}";
3868
    } else {
3869
        push @git_log_params, $self->{module};
3870
    }
3871
    # git-rev-list is the backend / plumbing version of git-log
3872
    open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
3873
                or die "Cannot call git-rev-list: $!";
3874
    my @commits=readCommits($gitLogPipe);
3875
    close $gitLogPipe;
3876

3877
    # Now all the commits are in the @commits bucket
3878
    # ordered by time DESC. for each commit that needs processing,
3879
    # determine whether it's following the last head we've seen or if
3880
    # it's on its own branch, grab a file list, and add whatever's changed
3881
    # NOTE: $lastcommit refers to the last commit from previous run
3882
    #       $lastpicked is the last commit we picked in this run
3883
    my $lastpicked;
3884
    my $head = {};
3885
    if (defined $lastcommit) {
3886
        $lastpicked = $lastcommit;
3887
    }
3888

3889
    my $committotal = scalar(@commits);
3890
    my $commitcount = 0;
3891

3892
    # Load the head table into $head (for cached lookups during the update process)
3893
    foreach my $file ( @{$self->gethead(1)} )
3894
    {
3895
        $head->{$file->{name}} = $file;
3896
    }
3897

3898
    foreach my $commit ( @commits )
3899
    {
3900
        $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
3901
        if (defined $lastpicked)
3902
        {
3903
            if (!in_array($lastpicked, @{$commit->{parents}}))
3904
            {
3905
                # skip, we'll see this delta
3906
                # as part of a merge later
3907
                # warn "skipping off-track  $commit->{hash}\n";
3908
                next;
3909
            } elsif (@{$commit->{parents}} > 1) {
3910
                # it is a merge commit, for each parent that is
3911
                # not $lastpicked (not given a CVS revision number),
3912
                # see if we can get a log
3913
                # from the merge-base to that parent to put it
3914
                # in the message as a merge summary.
3915
                my @parents = @{$commit->{parents}};
3916
                foreach my $parent (@parents) {
3917
                    if ($parent eq $lastpicked) {
3918
                        next;
3919
                    }
3920
                    # git-merge-base can potentially (but rarely) throw
3921
                    # several candidate merge bases. let's assume
3922
                    # that the first one is the best one.
3923
		    my $base = eval {
3924
			    ::safe_pipe_capture('git', 'merge-base',
3925
						 $lastpicked, $parent);
3926
		    };
3927
		    # The two branches may not be related at all,
3928
		    # in which case merge base simply fails to find
3929
		    # any, but that's Ok.
3930
		    next if ($@);
3931

3932
                    chomp $base;
3933
                    if ($base) {
3934
                        my @merged;
3935
                        # print "want to log between  $base $parent \n";
3936
                        open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
3937
			  or die "Cannot call git-log: $!";
3938
                        my $mergedhash;
3939
                        while (<GITLOG>) {
3940
                            chomp;
3941
                            if (!defined $mergedhash) {
3942
                                if (m/^commit\s+(.+)$/) {
3943
                                    $mergedhash = $1;
3944
                                } else {
3945
                                    next;
3946
                                }
3947
                            } else {
3948
                                # grab the first line that looks non-rfc822
3949
                                # aka has content after leading space
3950
                                if (m/^\s+(\S.*)$/) {
3951
                                    my $title = $1;
3952
                                    $title = substr($title,0,100); # truncate
3953
                                    unshift @merged, "$mergedhash $title";
3954
                                    undef $mergedhash;
3955
                                }
3956
                            }
3957
                        }
3958
                        close GITLOG;
3959
                        if (@merged) {
3960
                            $commit->{mergemsg} = $commit->{message};
3961
                            $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
3962
                            foreach my $summary (@merged) {
3963
                                $commit->{mergemsg} .= "\t$summary\n";
3964
                            }
3965
                            $commit->{mergemsg} .= "\n\n";
3966
                            # print "Message for $commit->{hash} \n$commit->{mergemsg}";
3967
                        }
3968
                    }
3969
                }
3970
            }
3971
        }
3972

3973
        # convert the date to CVS-happy format
3974
        my $cvsDate = convertToCvsDate($commit->{date});
3975

3976
        if ( defined ( $lastpicked ) )
3977
        {
3978
            my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
3979
	    local ($/) = "\0";
3980
            while ( <FILELIST> )
3981
            {
3982
		chomp;
3983
                unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{$state->{hexsz}}\s+([a-f0-9]{$state->{hexsz}})\s+(\w)$/o )
3984
                {
3985
                    die("Couldn't process git-diff-tree line : $_");
3986
                }
3987
		my ($mode, $hash, $change) = ($1, $2, $3);
3988
		my $name = <FILELIST>;
3989
		chomp($name);
3990

3991
                # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
3992

3993
                my $dbMode = convertToDbMode($mode);
3994

3995
                if ( $change eq "D" )
3996
                {
3997
                    #$log->debug("DELETE   $name");
3998
                    $head->{$name} = {
3999
                        name => $name,
4000
                        revision => $head->{$name}{revision} + 1,
4001
                        filehash => "deleted",
4002
                        commithash => $commit->{hash},
4003
                        modified => $cvsDate,
4004
                        author => $commit->{author},
4005
                        mode => $dbMode,
4006
                    };
4007
                    $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
4008
                }
4009
                elsif ( $change eq "M" || $change eq "T" )
4010
                {
4011
                    #$log->debug("MODIFIED $name");
4012
                    $head->{$name} = {
4013
                        name => $name,
4014
                        revision => $head->{$name}{revision} + 1,
4015
                        filehash => $hash,
4016
                        commithash => $commit->{hash},
4017
                        modified => $cvsDate,
4018
                        author => $commit->{author},
4019
                        mode => $dbMode,
4020
                    };
4021
                    $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
4022
                }
4023
                elsif ( $change eq "A" )
4024
                {
4025
                    #$log->debug("ADDED    $name");
4026
                    $head->{$name} = {
4027
                        name => $name,
4028
                        revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
4029
                        filehash => $hash,
4030
                        commithash => $commit->{hash},
4031
                        modified => $cvsDate,
4032
                        author => $commit->{author},
4033
                        mode => $dbMode,
4034
                    };
4035
                    $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
4036
                }
4037
                else
4038
                {
4039
                    $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
4040
                    die;
4041
                }
4042
            }
4043
            close FILELIST;
4044
        } else {
4045
            # this is used to detect files removed from the repo
4046
            my $seen_files = {};
4047

4048
            my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
4049
	    local $/ = "\0";
4050
            while ( <FILELIST> )
4051
            {
4052
		chomp;
4053
                unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4054
                {
4055
                    die("Couldn't process git-ls-tree line : $_");
4056
                }
4057

4058
                my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
4059

4060
                $seen_files->{$git_filename} = 1;
4061

4062
                my ( $oldhash, $oldrevision, $oldmode ) = (
4063
                    $head->{$git_filename}{filehash},
4064
                    $head->{$git_filename}{revision},
4065
                    $head->{$git_filename}{mode}
4066
                );
4067

4068
                my $dbMode = convertToDbMode($mode);
4069

4070
                # unless the file exists with the same hash, we need to update it ...
4071
                unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
4072
                {
4073
                    my $newrevision = ( $oldrevision or 0 ) + 1;
4074

4075
                    $head->{$git_filename} = {
4076
                        name => $git_filename,
4077
                        revision => $newrevision,
4078
                        filehash => $git_hash,
4079
                        commithash => $commit->{hash},
4080
                        modified => $cvsDate,
4081
                        author => $commit->{author},
4082
                        mode => $dbMode,
4083
                    };
4084

4085

4086
                    $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
4087
                }
4088
            }
4089
            close FILELIST;
4090

4091
            # Detect deleted files
4092
            foreach my $file ( sort keys %$head )
4093
            {
4094
                unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
4095
                {
4096
                    $head->{$file}{revision}++;
4097
                    $head->{$file}{filehash} = "deleted";
4098
                    $head->{$file}{commithash} = $commit->{hash};
4099
                    $head->{$file}{modified} = $cvsDate;
4100
                    $head->{$file}{author} = $commit->{author};
4101

4102
                    $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $cvsDate, $commit->{author}, $head->{$file}{mode});
4103
                }
4104
            }
4105
            # END : "Detect deleted files"
4106
        }
4107

4108

4109
        if (exists $commit->{mergemsg})
4110
        {
4111
            $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
4112
        }
4113

4114
        $lastpicked = $commit->{hash};
4115

4116
        $self->_set_prop("last_commit", $commit->{hash});
4117
    }
4118

4119
    $self->delete_head();
4120
    foreach my $file ( sort keys %$head )
4121
    {
4122
        $self->insert_head(
4123
            $file,
4124
            $head->{$file}{revision},
4125
            $head->{$file}{filehash},
4126
            $head->{$file}{commithash},
4127
            $head->{$file}{modified},
4128
            $head->{$file}{author},
4129
            $head->{$file}{mode},
4130
        );
4131
    }
4132
    # invalidate the gethead cache
4133
    $self->clearCommitRefCaches();
4134

4135

4136
    # Ending exclusive lock here
4137
    $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
4138
}
4139

4140
sub readCommits
4141
{
4142
    my $pipeHandle = shift;
4143
    my @commits;
4144

4145
    my %commit = ();
4146

4147
    while ( <$pipeHandle> )
4148
    {
4149
        chomp;
4150
        if (m/^commit\s+(.*)$/) {
4151
            # on ^commit lines put the just seen commit in the stack
4152
            # and prime things for the next one
4153
            if (keys %commit) {
4154
                my %copy = %commit;
4155
                unshift @commits, \%copy;
4156
                %commit = ();
4157
            }
4158
            my @parents = split(m/\s+/, $1);
4159
            $commit{hash} = shift @parents;
4160
            $commit{parents} = \@parents;
4161
        } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
4162
            # on rfc822-like lines seen before we see any message,
4163
            # lowercase the entry and put it in the hash as key-value
4164
            $commit{lc($1)} = $2;
4165
        } else {
4166
            # message lines - skip initial empty line
4167
            # and trim whitespace
4168
            if (!exists($commit{message}) && m/^\s*$/) {
4169
                # define it to mark the end of headers
4170
                $commit{message} = '';
4171
                next;
4172
            }
4173
            s/^\s+//; s/\s+$//; # trim ws
4174
            $commit{message} .= $_ . "\n";
4175
        }
4176
    }
4177

4178
    unshift @commits, \%commit if ( keys %commit );
4179

4180
    return @commits;
4181
}
4182

4183
sub convertToCvsDate
4184
{
4185
    my $date = shift;
4186
    # Convert from: "git rev-list --pretty" formatted date
4187
    # Convert to: "the format specified by RFC822 as modified by RFC1123."
4188
    # Example: 26 May 1997 13:01:40 -0400
4189
    if( $date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ )
4190
    {
4191
        $date = "$2 $1 $4 $3 $5";
4192
    }
4193

4194
    return $date;
4195
}
4196

4197
sub convertToDbMode
4198
{
4199
    my $mode = shift;
4200

4201
    # NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",
4202
    #  but the database "mode" column historically (and currently)
4203
    #  only stores the "rw" (for user) part of the string.
4204
    #    FUTURE: It might make more sense to persist the raw
4205
    #  octal mode (or perhaps the final full CVS form) instead of
4206
    #  this half-converted form, but it isn't currently worth the
4207
    #  backwards compatibility headaches.
4208

4209
    $mode=~/^\d{3}(\d)\d\d$/;
4210
    my $userBits=$1;
4211

4212
    my $dbMode = "";
4213
    $dbMode .= "r" if ( $userBits & 4 );
4214
    $dbMode .= "w" if ( $userBits & 2 );
4215
    $dbMode .= "x" if ( $userBits & 1 );
4216
    $dbMode = "rw" if ( $dbMode eq "" );
4217

4218
    return $dbMode;
4219
}
4220

4221
sub insert_rev
4222
{
4223
    my $self = shift;
4224
    my $name = shift;
4225
    my $revision = shift;
4226
    my $filehash = shift;
4227
    my $commithash = shift;
4228
    my $modified = shift;
4229
    my $author = shift;
4230
    my $mode = shift;
4231
    my $tablename = $self->tablename("revision");
4232

4233
    my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
4234
    $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4235
}
4236

4237
sub insert_mergelog
4238
{
4239
    my $self = shift;
4240
    my $key = shift;
4241
    my $value = shift;
4242
    my $tablename = $self->tablename("commitmsgs");
4243

4244
    my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
4245
    $insert_mergelog->execute($key, $value);
4246
}
4247

4248
sub delete_head
4249
{
4250
    my $self = shift;
4251
    my $tablename = $self->tablename("head");
4252

4253
    my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
4254
    $delete_head->execute();
4255
}
4256

4257
sub insert_head
4258
{
4259
    my $self = shift;
4260
    my $name = shift;
4261
    my $revision = shift;
4262
    my $filehash = shift;
4263
    my $commithash = shift;
4264
    my $modified = shift;
4265
    my $author = shift;
4266
    my $mode = shift;
4267
    my $tablename = $self->tablename("head");
4268

4269
    my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
4270
    $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4271
}
4272

4273
sub _get_prop
4274
{
4275
    my $self = shift;
4276
    my $key = shift;
4277
    my $tablename = $self->tablename("properties");
4278

4279
    my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
4280
    $db_query->execute($key);
4281
    my ( $value ) = $db_query->fetchrow_array;
4282

4283
    return $value;
4284
}
4285

4286
sub _set_prop
4287
{
4288
    my $self = shift;
4289
    my $key = shift;
4290
    my $value = shift;
4291
    my $tablename = $self->tablename("properties");
4292

4293
    my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
4294
    $db_query->execute($value, $key);
4295

4296
    unless ( $db_query->rows )
4297
    {
4298
        $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
4299
        $db_query->execute($key, $value);
4300
    }
4301

4302
    return $value;
4303
}
4304

4305
=head2 gethead
4306

4307
=cut
4308

4309
sub gethead
4310
{
4311
    my $self = shift;
4312
    my $intRev = shift;
4313
    my $tablename = $self->tablename("head");
4314

4315
    return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
4316

4317
    my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
4318
    $db_query->execute();
4319

4320
    my $tree = [];
4321
    while ( my $file = $db_query->fetchrow_hashref )
4322
    {
4323
        if(!$intRev)
4324
        {
4325
            $file->{revision} = "1.$file->{revision}"
4326
        }
4327
        push @$tree, $file;
4328
    }
4329

4330
    $self->{gethead_cache} = $tree;
4331

4332
    return $tree;
4333
}
4334

4335
=head2 getAnyHead
4336

4337
Returns a reference to an array of getmeta structures, one
4338
per file in the specified tree hash.
4339

4340
=cut
4341

4342
sub getAnyHead
4343
{
4344
    my ($self,$hash) = @_;
4345

4346
    if(!defined($hash))
4347
    {
4348
        return $self->gethead();
4349
    }
4350

4351
    my @files;
4352
    {
4353
        open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4354
                or die("Cannot call git-ls-tree : $!");
4355
        local $/ = "\0";
4356
        @files=<$filePipe>;
4357
        close $filePipe;
4358
    }
4359

4360
    my $tree=[];
4361
    my($line);
4362
    foreach $line (@files)
4363
    {
4364
        $line=~s/\0$//;
4365
        unless ( $line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4366
        {
4367
            die("Couldn't process git-ls-tree line : $_");
4368
        }
4369

4370
        my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4371
        push @$tree, $self->getMetaFromCommithash($git_filename,$hash);
4372
    }
4373

4374
    return $tree;
4375
}
4376

4377
=head2 getRevisionDirMap
4378

4379
A "revision dir map" contains all the plain-file filenames associated
4380
with a particular revision (tree-ish), organized by directory:
4381

4382
  $type = $out->{$dir}{$fullName}
4383

4384
The type of each is "F" (for ordinary file) or "D" (for directory,
4385
for which the map $out->{$fullName} will also exist).
4386

4387
=cut
4388

4389
sub getRevisionDirMap
4390
{
4391
    my ($self,$ver)=@_;
4392

4393
    if(!defined($self->{revisionDirMapCache}))
4394
    {
4395
        $self->{revisionDirMapCache}={};
4396
    }
4397

4398
        # Get file list (previously cached results are dependent on HEAD,
4399
        # but are early in each case):
4400
    my $cacheKey;
4401
    my (@fileList);
4402
    if( !defined($ver) || $ver eq "" )
4403
    {
4404
        $cacheKey="";
4405
        if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4406
        {
4407
            return $self->{revisionDirMapCache}{$cacheKey};
4408
        }
4409

4410
        my @head = @{$self->gethead()};
4411
        foreach my $file ( @head )
4412
        {
4413
            next if ( $file->{filehash} eq "deleted" );
4414

4415
            push @fileList,$file->{name};
4416
        }
4417
    }
4418
    else
4419
    {
4420
        my ($hash)=$self->lookupCommitRef($ver);
4421
        if( !defined($hash) )
4422
        {
4423
            return undef;
4424
        }
4425

4426
        $cacheKey=$hash;
4427
        if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4428
        {
4429
            return $self->{revisionDirMapCache}{$cacheKey};
4430
        }
4431

4432
        open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4433
                or die("Cannot call git-ls-tree : $!");
4434
        local $/ = "\0";
4435
        while ( <$filePipe> )
4436
        {
4437
            chomp;
4438
            unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4439
            {
4440
                die("Couldn't process git-ls-tree line : $_");
4441
            }
4442

4443
            my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4444

4445
            push @fileList, $git_filename;
4446
        }
4447
        close $filePipe;
4448
    }
4449

4450
        # Convert to normalized form:
4451
    my %revMap;
4452
    my $file;
4453
    foreach $file (@fileList)
4454
    {
4455
        my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);
4456
        $dir='' if(!defined($dir));
4457

4458
            # parent directories:
4459
            # ... create empty dir maps for parent dirs:
4460
        my($td)=$dir;
4461
        while(!defined($revMap{$td}))
4462
        {
4463
            $revMap{$td}={};
4464

4465
            my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4466
            $tp='' if(!defined($tp));
4467
            $td=$tp;
4468
        }
4469
            # ... add children to parent maps (now that they exist):
4470
        $td=$dir;
4471
        while($td ne "")
4472
        {
4473
            my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4474
            $tp='' if(!defined($tp));
4475

4476
            if(defined($revMap{$tp}{$td}))
4477
            {
4478
                if($revMap{$tp}{$td} ne 'D')
4479
                {
4480
                    die "Weird file/directory inconsistency in $cacheKey";
4481
                }
4482
                last;   # loop exit
4483
            }
4484
            $revMap{$tp}{$td}='D';
4485

4486
            $td=$tp;
4487
        }
4488

4489
            # file
4490
        $revMap{$dir}{$file}='F';
4491
    }
4492

4493
        # Save in cache:
4494
    $self->{revisionDirMapCache}{$cacheKey}=\%revMap;
4495
    return $self->{revisionDirMapCache}{$cacheKey};
4496
}
4497

4498
=head2 getlog
4499

4500
See also gethistorydense().
4501

4502
=cut
4503

4504
sub getlog
4505
{
4506
    my $self = shift;
4507
    my $filename = shift;
4508
    my $revFilter = shift;
4509

4510
    my $tablename = $self->tablename("revision");
4511

4512
    # Filters:
4513
    # TODO: date, state, or by specific logins filters?
4514
    # TODO: Handle comma-separated list of revFilter items, each item
4515
    #   can be a range [only case currently handled] or individual
4516
    #   rev or branch or "branch.".
4517
    # TODO: Adjust $db_query WHERE clause based on revFilter, instead of
4518
    #   manually filtering the results of the query?
4519
    my ( $minrev, $maxrev );
4520
    if( defined($revFilter) and
4521
        $state->{opt}{r} =~ /^(1.(\d+))?(::?)(1.(\d.+))?$/ )
4522
    {
4523
        my $control = $3;
4524
        $minrev = $2;
4525
        $maxrev = $5;
4526
        $minrev++ if ( defined($minrev) and $control eq "::" );
4527
    }
4528

4529
    my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
4530
    $db_query->execute($filename);
4531

4532
    my $totalRevs=0;
4533
    my $tree = [];
4534
    while ( my $file = $db_query->fetchrow_hashref )
4535
    {
4536
        $totalRevs++;
4537
        if( defined($minrev) and $file->{revision} < $minrev )
4538
        {
4539
            next;
4540
        }
4541
        if( defined($maxrev) and $file->{revision} > $maxrev )
4542
        {
4543
            next;
4544
        }
4545

4546
        $file->{revision} = "1." . $file->{revision};
4547
        push @$tree, $file;
4548
    }
4549

4550
    return ($tree,$totalRevs);
4551
}
4552

4553
=head2 getmeta
4554

4555
This function takes a filename (with path) argument and returns a hashref of
4556
metadata for that file.
4557

4558
There are several ways $revision can be specified:
4559

4560
   - A reference to hash that contains a "tag" that is the
4561
     actual revision (one of the below).  TODO: Also allow it to
4562
     specify a "date" in the hash.
4563
   - undef, to refer to the latest version on the main branch.
4564
   - Full CVS client revision number (mapped to integer in DB, without the
4565
     "1." prefix),
4566
   - Complex CVS-compatible "special" revision number for
4567
     non-linear history (see comment below)
4568
   - git commit sha1 hash
4569
   - branch or tag name
4570

4571
=cut
4572

4573
sub getmeta
4574
{
4575
    my $self = shift;
4576
    my $filename = shift;
4577
    my $revision = shift;
4578
    my $tablename_rev = $self->tablename("revision");
4579
    my $tablename_head = $self->tablename("head");
4580

4581
    if ( ref($revision) eq "HASH" )
4582
    {
4583
        $revision = $revision->{tag};
4584
    }
4585

4586
    # Overview of CVS revision numbers:
4587
    #
4588
    # General CVS numbering scheme:
4589
    #   - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.
4590
    #   - Result of "cvs checkin -r" (possible, but not really
4591
    #     recommended): "2.1", "2.2", etc
4592
    #   - Branch tag: "1.2.0.n", where "1.2" is revision it was branched
4593
    #     from, "0" is a magic placeholder that identifies it as a
4594
    #     branch tag instead of a version tag, and n is 2 times the
4595
    #     branch number off of "1.2", starting with "2".
4596
    #   - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"
4597
    #     is branch number off of "1.2" (like n above), and "x" is
4598
    #     the version number on the branch.
4599
    #   - Branches can branch off of branches: "1.3.2.7.4.1" (even number
4600
    #     of components).
4601
    #   - Odd "n"s are used by "vendor branches" that result
4602
    #     from "cvs import".  Vendor branches have additional
4603
    #     strangeness in the sense that the main rcs "head" of the main
4604
    #     branch will (temporarily until first normal commit) point
4605
    #     to the version on the vendor branch, rather than the actual
4606
    #     main branch.  (FUTURE: This may provide an opportunity
4607
    #     to use "strange" revision numbers for fast-forward-merged
4608
    #     branch tip when CVS client is asking for the main branch.)
4609
    #
4610
    # git-cvsserver CVS-compatible special numbering schemes:
4611
    #   - Currently git-cvsserver only tries to be identical to CVS for
4612
    #     simple "1.x" numbers on the "main" branch (as identified
4613
    #     by the module name that was originally cvs checkout'ed).
4614
    #   - The database only stores the "x" part, for historical reasons.
4615
    #     But most of the rest of the cvsserver preserves
4616
    #     and thinks using the full revision number.
4617
    #   - To handle non-linear history, it uses a version of the form
4618
    #     "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely
4619
    #     identify this as a special revision number, and there are
4620
    #     20 b's that together encode the sha1 git commit from which
4621
    #     this version of this file originated.  Each b is
4622
    #     the numerical value of the corresponding byte plus
4623
    #     100.
4624
    #      - "plus 100" avoids "0"s, and also reduces the
4625
    #        likelihood of a collision in the case that someone someday
4626
    #        writes an import tool that tries to preserve original
4627
    #        CVS revision numbers, and the original CVS data had done
4628
    #        lots of branches off of branches and other strangeness to
4629
    #        end up with a real version number that just happens to look
4630
    #        like this special revision number form.  Also, if needed
4631
    #        there are several ways to extend/identify alternative encodings
4632
    #        within the "2.1.1.2000" part if necessary.
4633
    #      - Unlike real CVS revisions, you can't really reconstruct what
4634
    #        relation a revision of this form has to other revisions.
4635
    #   - FUTURE: TODO: Rework database somehow to make up and remember
4636
    #     fully-CVS-compatible branches and branch version numbers.
4637

4638
    my $meta;
4639
    if ( defined($revision) )
4640
    {
4641
        if ( $revision =~ /^1\.(\d+)$/ )
4642
        {
4643
            my ($intRev) = $1;
4644
            my $db_query;
4645
            $db_query = $self->{dbh}->prepare_cached(
4646
                "SELECT * FROM $tablename_rev WHERE name=? AND revision=?",
4647
                {},1);
4648
            $db_query->execute($filename, $intRev);
4649
            $meta = $db_query->fetchrow_hashref;
4650
        }
4651
        elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){$state->{rawsz}}$/ )
4652
        {
4653
            my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
4654
            $commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
4655
            if($commitHash=~/^[0-9a-f]{$state->{hexsz}}$/)
4656
            {
4657
                return $self->getMetaFromCommithash($filename,$commitHash);
4658
            }
4659

4660
            # error recovery: fall back on head version below
4661
            print "E Failed to find $filename version=$revision or commit=$commitHash\n";
4662
            $log->warning("failed get $revision with commithash=$commitHash");
4663
            undef $revision;
4664
        }
4665
        elsif ( $revision =~ /^[0-9a-f]{$state->{hexsz}}$/ )
4666
        {
4667
            # Try DB first.  This is mostly only useful for req_annotate(),
4668
            # which only calls this for stuff that should already be in
4669
            # the DB.  It is fairly likely to be a waste of time
4670
            # in most other cases [unless the file happened to be
4671
            # modified in $revision specifically], but
4672
            # it is probably in the noise compared to how long
4673
            # getMetaFromCommithash() will take.
4674
            my $db_query;
4675
            $db_query = $self->{dbh}->prepare_cached(
4676
                "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4677
                {},1);
4678
            $db_query->execute($filename, $revision);
4679
            $meta = $db_query->fetchrow_hashref;
4680

4681
            if(! $meta)
4682
            {
4683
                my($revCommit)=$self->lookupCommitRef($revision);
4684
                if($revCommit=~/^[0-9a-f]{$state->{hexsz}}$/)
4685
                {
4686
                    return $self->getMetaFromCommithash($filename,$revCommit);
4687
                }
4688

4689
                # error recovery: nothing found:
4690
                print "E Failed to find $filename version=$revision\n";
4691
                $log->warning("failed get $revision");
4692
                return $meta;
4693
            }
4694
        }
4695
        else
4696
        {
4697
            my($revCommit)=$self->lookupCommitRef($revision);
4698
            if($revCommit=~/^[0-9a-f]{$state->{hexsz}}$/)
4699
            {
4700
                return $self->getMetaFromCommithash($filename,$revCommit);
4701
            }
4702

4703
            # error recovery: fall back on head version below
4704
            print "E Failed to find $filename version=$revision\n";
4705
            $log->warning("failed get $revision");
4706
            undef $revision;  # Allow fallback
4707
        }
4708
    }
4709

4710
    if(!defined($revision))
4711
    {
4712
        my $db_query;
4713
        $db_query = $self->{dbh}->prepare_cached(
4714
                "SELECT * FROM $tablename_head WHERE name=?",{},1);
4715
        $db_query->execute($filename);
4716
        $meta = $db_query->fetchrow_hashref;
4717
    }
4718

4719
    if($meta)
4720
    {
4721
        $meta->{revision} = "1.$meta->{revision}";
4722
    }
4723
    return $meta;
4724
}
4725

4726
sub getMetaFromCommithash
4727
{
4728
    my $self = shift;
4729
    my $filename = shift;
4730
    my $revCommit = shift;
4731

4732
    # NOTE: This function doesn't scale well (lots of forks), especially
4733
    #   if you have many files that have not been modified for many commits
4734
    #   (each git-rev-parse redoes a lot of work for each file
4735
    #   that theoretically could be done in parallel by smarter
4736
    #   graph traversal).
4737
    #
4738
    # TODO: Possible optimization strategies:
4739
    #   - Solve the issue of assigning and remembering "real" CVS
4740
    #     revision numbers for branches, and ensure the
4741
    #     data structure can do this efficiently.  Perhaps something
4742
    #     similar to "git notes", and carefully structured to take
4743
    #     advantage same-sha1-is-same-contents, to roll the same
4744
    #     unmodified subdirectory data onto multiple commits?
4745
    #   - Write and use a C tool that is like git-blame, but
4746
    #     operates on multiple files with file granularity, instead
4747
    #     of one file with line granularity.  Cache
4748
    #     most-recently-modified in $self->{commitRefCache}{$revCommit}.
4749
    #     Try to be intelligent about how many files we do with
4750
    #     one fork (perhaps one directory at a time, without recursion,
4751
    #     and/or include directory as one line item, recurse from here
4752
    #     instead of in C tool?).
4753
    #   - Perhaps we could ask the DB for (filename,fileHash),
4754
    #     and just guess that it is correct (that the file hadn't
4755
    #     changed between $revCommit and the found commit, then
4756
    #     changed back, confusing anything trying to interpret
4757
    #     history).  Probably need to add another index to revisions
4758
    #     DB table for this.
4759
    #   - NOTE: Trying to store all (commit,file) keys in DB [to
4760
    #     find "lastModfiedCommit] (instead of
4761
    #     just files that changed in each commit as we do now) is
4762
    #     probably not practical from a disk space perspective.
4763

4764
        # Does the file exist in $revCommit?
4765
    # TODO: Include file hash in dirmap cache.
4766
    my($dirMap)=$self->getRevisionDirMap($revCommit);
4767
    my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);
4768
    if(!defined($dir))
4769
    {
4770
        $dir="";
4771
    }
4772
    if( !defined($dirMap->{$dir}) ||
4773
        !defined($dirMap->{$dir}{$filename}) )
4774
    {
4775
        my($fileHash)="deleted";
4776

4777
        my($retVal)={};
4778
        $retVal->{name}=$filename;
4779
        $retVal->{filehash}=$fileHash;
4780

4781
            # not needed and difficult to compute:
4782
        $retVal->{revision}="0";  # $revision;
4783
        $retVal->{commithash}=$revCommit;
4784
        #$retVal->{author}=$commit->{author};
4785
        #$retVal->{modified}=convertToCvsDate($commit->{date});
4786
        #$retVal->{mode}=convertToDbMode($mode);
4787

4788
        return $retVal;
4789
    }
4790

4791
    my($fileHash) = ::safe_pipe_capture("git","rev-parse","$revCommit:$filename");
4792
    chomp $fileHash;
4793
    if(!($fileHash=~/^[0-9a-f]{$state->{hexsz}}$/))
4794
    {
4795
        die "Invalid fileHash '$fileHash' looking up"
4796
                    ." '$revCommit:$filename'\n";
4797
    }
4798

4799
    # information about most recent commit to modify $filename:
4800
    open(my $gitLogPipe, '-|', 'git', 'rev-list',
4801
         '--max-count=1', '--pretty', '--parents',
4802
         $revCommit, '--', $filename)
4803
                or die "Cannot call git-rev-list: $!";
4804
    my @commits=readCommits($gitLogPipe);
4805
    close $gitLogPipe;
4806
    if(scalar(@commits)!=1)
4807
    {
4808
        die "Can't find most recent commit changing $filename\n";
4809
    }
4810
    my($commit)=$commits[0];
4811
    if( !defined($commit) || !defined($commit->{hash}) )
4812
    {
4813
        return undef;
4814
    }
4815

4816
    # does this (commit,file) have a real assigned CVS revision number?
4817
    my $tablename_rev = $self->tablename("revision");
4818
    my $db_query;
4819
    $db_query = $self->{dbh}->prepare_cached(
4820
        "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4821
        {},1);
4822
    $db_query->execute($filename, $commit->{hash});
4823
    my($meta)=$db_query->fetchrow_hashref;
4824
    if($meta)
4825
    {
4826
        $meta->{revision} = "1.$meta->{revision}";
4827
        return $meta;
4828
    }
4829

4830
    # fall back on special revision number
4831
    my($revision)=$commit->{hash};
4832
    $revision=~s/(..)/'.' . (hex($1)+100)/eg;
4833
    $revision="2.1.1.2000$revision";
4834

4835
    # meta data about $filename:
4836
    open(my $filePipe, '-|', 'git', 'ls-tree', '-z',
4837
                $commit->{hash}, '--', $filename)
4838
            or die("Cannot call git-ls-tree : $!");
4839
    local $/ = "\0";
4840
    my $line;
4841
    $line=<$filePipe>;
4842
    if(defined(<$filePipe>))
4843
    {
4844
        die "Expected only a single file for git-ls-tree $filename\n";
4845
    }
4846
    close $filePipe;
4847

4848
    chomp $line;
4849
    unless ( $line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4850
    {
4851
        die("Couldn't process git-ls-tree line : $line\n");
4852
    }
4853
    my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
4854

4855
    # save result:
4856
    my($retVal)={};
4857
    $retVal->{name}=$filename;
4858
    $retVal->{revision}=$revision;
4859
    $retVal->{filehash}=$fileHash;
4860
    $retVal->{commithash}=$revCommit;
4861
    $retVal->{author}=$commit->{author};
4862
    $retVal->{modified}=convertToCvsDate($commit->{date});
4863
    $retVal->{mode}=convertToDbMode($mode);
4864

4865
    return $retVal;
4866
}
4867

4868
=head2 lookupCommitRef
4869

4870
Convert tag/branch/abbreviation/etc into a commit sha1 hash.  Caches
4871
the result so looking it up again is fast.
4872

4873
=cut
4874

4875
sub lookupCommitRef
4876
{
4877
    my $self = shift;
4878
    my $ref = shift;
4879

4880
    my $commitHash = $self->{commitRefCache}{$ref};
4881
    if(defined($commitHash))
4882
    {
4883
        return $commitHash;
4884
    }
4885

4886
    $commitHash = ::safe_pipe_capture("git","rev-parse","--verify","--quiet",
4887
				      $self->unescapeRefName($ref));
4888
    $commitHash=~s/\s*$//;
4889
    if(!($commitHash=~/^[0-9a-f]{$state->{hexsz}}$/))
4890
    {
4891
        $commitHash=undef;
4892
    }
4893

4894
    if( defined($commitHash) )
4895
    {
4896
        my $type = ::safe_pipe_capture("git","cat-file","-t",$commitHash);
4897
        if( ! ($type=~/^commit\s*$/ ) )
4898
        {
4899
            $commitHash=undef;
4900
        }
4901
    }
4902
    if(defined($commitHash))
4903
    {
4904
        $self->{commitRefCache}{$ref}=$commitHash;
4905
    }
4906
    return $commitHash;
4907
}
4908

4909
=head2 clearCommitRefCaches
4910

4911
Clears cached commit cache (sha1's for various tags/abbeviations/etc),
4912
and related caches.
4913

4914
=cut
4915

4916
sub clearCommitRefCaches
4917
{
4918
    my $self = shift;
4919
    $self->{commitRefCache} = {};
4920
    $self->{revisionDirMapCache} = undef;
4921
    $self->{gethead_cache} = undef;
4922
}
4923

4924
=head2 commitmessage
4925

4926
this function takes a commithash and returns the commit message for that commit
4927

4928
=cut
4929
sub commitmessage
4930
{
4931
    my $self = shift;
4932
    my $commithash = shift;
4933
    my $tablename = $self->tablename("commitmsgs");
4934

4935
    die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ );
4936

4937
    my $db_query;
4938
    $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
4939
    $db_query->execute($commithash);
4940

4941
    my ( $message ) = $db_query->fetchrow_array;
4942

4943
    if ( defined ( $message ) )
4944
    {
4945
        $message .= " " if ( $message =~ /\n$/ );
4946
        return $message;
4947
    }
4948

4949
    my @lines = ::safe_pipe_capture("git", "cat-file", "commit", $commithash);
4950
    shift @lines while ( $lines[0] =~ /\S/ );
4951
    $message = join("",@lines);
4952
    $message .= " " if ( $message =~ /\n$/ );
4953
    return $message;
4954
}
4955

4956
=head2 gethistorydense
4957

4958
This function takes a filename (with path) argument and returns an arrayofarrays
4959
containing revision,filehash,commithash ordered by revision descending.
4960

4961
This version of gethistory skips deleted entries -- so it is useful for annotate.
4962
The 'dense' part is a reference to a '--dense' option available for git-rev-list
4963
and other git tools that depend on it.
4964

4965
See also getlog().
4966

4967
=cut
4968
sub gethistorydense
4969
{
4970
    my $self = shift;
4971
    my $filename = shift;
4972
    my $tablename = $self->tablename("revision");
4973

4974
    my $db_query;
4975
    $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
4976
    $db_query->execute($filename);
4977

4978
    my $result = $db_query->fetchall_arrayref;
4979

4980
    my $i;
4981
    for($i=0 ; $i<scalar(@$result) ; $i++)
4982
    {
4983
        $result->[$i][0]="1." . $result->[$i][0];
4984
    }
4985

4986
    return $result;
4987
}
4988

4989
=head2 escapeRefName
4990

4991
Apply an escape mechanism to compensate for characters that
4992
git ref names can have that CVS tags can not.
4993

4994
=cut
4995
sub escapeRefName
4996
{
4997
    my($self,$refName)=@_;
4998

4999
    # CVS officially only allows [-_A-Za-z0-9] in tag names (or in
5000
    # many contexts it can also be a CVS revision number).
5001
    #
5002
    # Git tags commonly use '/' and '.' as well, but also handle
5003
    # anything else just in case:
5004
    #
5005
    #   = "_-s-"  For '/'.
5006
    #   = "_-p-"  For '.'.
5007
    #   = "_-u-"  For underscore, in case someone wants a literal "_-" in
5008
    #     a tag name.
5009
    #   = "_-xx-" Where "xx" is the hexadecimal representation of the
5010
    #     desired ASCII character byte. (for anything else)
5011

5012
    if(! $refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)
5013
    {
5014
        $refName=~s/_-/_-u--/g;
5015
        $refName=~s/\./_-p-/g;
5016
        $refName=~s%/%_-s-%g;
5017
        $refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;
5018
    }
5019
}
5020

5021
=head2 unescapeRefName
5022

5023
Undo an escape mechanism to compensate for characters that
5024
git ref names can have that CVS tags can not.
5025

5026
=cut
5027
sub unescapeRefName
5028
{
5029
    my($self,$refName)=@_;
5030

5031
    # see escapeRefName() for description of escape mechanism.
5032

5033
    $refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;
5034

5035
    # allowed tag names
5036
    # TODO: Perhaps use git check-ref-format, with an in-process cache of
5037
    #  validated names?
5038
    if( !( $refName=~m%^[^-][-a-zA-Z0-9_/.]*$% ) ||
5039
        ( $refName=~m%[/.]$% ) ||
5040
        ( $refName=~/\.lock$/ ) ||
5041
        ( $refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) )  # matching }
5042
    {
5043
        # Error:
5044
        $log->warn("illegal refName: $refName");
5045
        $refName=undef;
5046
    }
5047
    return $refName;
5048
}
5049

5050
sub unescapeRefNameChar
5051
{
5052
    my($char)=@_;
5053

5054
    if($char eq "s")
5055
    {
5056
        $char="/";
5057
    }
5058
    elsif($char eq "p")
5059
    {
5060
        $char=".";
5061
    }
5062
    elsif($char eq "u")
5063
    {
5064
        $char="_";
5065
    }
5066
    elsif($char=~/^[0-9a-f][0-9a-f]$/)
5067
    {
5068
        $char=chr(hex($char));
5069
    }
5070
    else
5071
    {
5072
        # Error case: Maybe it has come straight from user, and
5073
        # wasn't supposed to be escaped?  Restore it the way we got it:
5074
        $char="_-$char-";
5075
    }
5076

5077
    return $char;
5078
}
5079

5080
=head2 in_array()
5081

5082
from Array::PAT - mimics the in_array() function
5083
found in PHP. Yuck but works for small arrays.
5084

5085
=cut
5086
sub in_array
5087
{
5088
    my ($check, @array) = @_;
5089
    my $retval = 0;
5090
    foreach my $test (@array){
5091
        if($check eq $test){
5092
            $retval =  1;
5093
        }
5094
    }
5095
    return $retval;
5096
}
5097

5098
=head2 mangle_dirname
5099

5100
create a string from a directory name that is suitable to use as
5101
part of a filename, mainly by converting all chars except \w.- to _
5102

5103
=cut
5104
sub mangle_dirname {
5105
    my $dirname = shift;
5106
    return unless defined $dirname;
5107

5108
    $dirname =~ s/[^\w.-]/_/g;
5109

5110
    return $dirname;
5111
}
5112

5113
=head2 mangle_tablename
5114

5115
create a string from a that is suitable to use as part of an SQL table
5116
name, mainly by converting all chars except \w to _
5117

5118
=cut
5119
sub mangle_tablename {
5120
    my $tablename = shift;
5121
    return unless defined $tablename;
5122

5123
    $tablename =~ s/[^\w_]/_/g;
5124

5125
    return $tablename;
5126
}
5127

5128
1;
5129
git

Использование cookies
