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