cvsserver: clean up client request handler map comments
[git/git.git] / git-cvsserver.perl
CommitLineData
3fda8c4c
ML
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>
adc3192e 11#### Martin Langhoff <martin@laptop.org>
3fda8c4c
ML
12####
13####
14#### Released under the GNU Public License, version 2.
15####
16####
17
d48b2841 18use 5.008;
3fda8c4c
ML
19use strict;
20use warnings;
4f88d3e0 21use bytes;
3fda8c4c
ML
22
23use Fcntl;
24use File::Temp qw/tempdir tempfile/;
044182ef 25use File::Path qw/rmtree/;
3fda8c4c 26use File::Basename;
693b6327
FL
27use Getopt::Long qw(:config require_order no_ignore_case);
28
29my $VERSION = '@@GIT_VERSION@@';
3fda8c4c
ML
30
31my $log = GITCVS::log->new();
32my $cfg;
33
34my $DATE_LIST = {
35 Jan => "01",
36 Feb => "02",
37 Mar => "03",
38 Apr => "04",
39 May => "05",
40 Jun => "06",
41 Jul => "07",
42 Aug => "08",
43 Sep => "09",
44 Oct => "10",
45 Nov => "11",
46 Dec => "12",
47};
48
49# Enable autoflush for STDOUT (otherwise the whole thing falls apart)
50$| = 1;
51
52#### Definition and mappings of functions ####
53
566c69e7
MO
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?
3fda8c4c
ML
58my $methods = {
59 'Root' => \&req_Root,
60 'Valid-responses' => \&req_Validresponses,
61 'valid-requests' => \&req_validrequests,
62 'Directory' => \&req_Directory,
63 'Entry' => \&req_Entry,
64 'Modified' => \&req_Modified,
65 'Unchanged' => \&req_Unchanged,
7172aabb 66 'Questionable' => \&req_Questionable,
3fda8c4c
ML
67 'Argument' => \&req_Argument,
68 'Argumentx' => \&req_Argument,
69 'expand-modules' => \&req_expandmodules,
70 'add' => \&req_add,
71 'remove' => \&req_remove,
72 'co' => \&req_co,
73 'update' => \&req_update,
74 'ci' => \&req_ci,
75 'diff' => \&req_diff,
76 'log' => \&req_log,
7172aabb 77 'rlog' => \&req_log,
3fda8c4c
ML
78 'tag' => \&req_CATCHALL,
79 'status' => \&req_status,
80 'admin' => \&req_CATCHALL,
81 'history' => \&req_CATCHALL,
38bcd31a
DD
82 'watchers' => \&req_EMPTY,
83 'editors' => \&req_EMPTY,
499cc56a 84 'noop' => \&req_EMPTY,
3fda8c4c
ML
85 'annotate' => \&req_annotate,
86 'Global_option' => \&req_Globaloption,
3fda8c4c
ML
87};
88
89##############################################
90
91
92# $state holds all the bits of information the clients sends us that could
93# potentially be useful when it comes to actually _doing_ something.
42217f13 94my $state = { prependdir => '' };
044182ef
MO
95
96# Work is for managing temporary working directory
97my $work =
98 {
99 state => undef, # undef, 1 (empty), 2 (with stuff)
100 workDir => undef,
101 index => undef,
102 emptyDir => undef,
103 tmpDir => undef
104 };
105
3fda8c4c
ML
106$log->info("--------------- STARTING -----------------");
107
693b6327 108my $usage =
1b1dd23f 109 "Usage: git cvsserver [options] [pserver|server] [<directory> ...]\n".
693b6327 110 " --base-path <path> : Prepend to requested CVSROOT\n".
03bd0d60 111 " Can be read from GIT_CVSSERVER_BASE_PATH\n".
693b6327
FL
112 " --strict-paths : Don't allow recursing into subdirectories\n".
113 " --export-all : Don't check for gitcvs.enabled in config\n".
114 " --version, -V : Print version information and exit\n".
87182b17 115 " -h, -H : Print usage information and exit\n".
693b6327
FL
116 "\n".
117 "<directory> ... is a list of allowed directories. If no directories\n".
118 "are given, all are allowed. This is an additional restriction, gitcvs\n".
03bd0d60
PM
119 "access still needs to be enabled by the gitcvs.enabled config option.\n".
120 "Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n";
693b6327 121
87182b17 122my @opts = ( 'h|H', 'version|V',
693b6327
FL
123 'base-path=s', 'strict-paths', 'export-all' );
124GetOptions( $state, @opts )
125 or die $usage;
126
127if ($state->{version}) {
128 print "git-cvsserver version $VERSION\n";
129 exit;
130}
131if ($state->{help}) {
132 print $usage;
133 exit;
134}
135
3fda8c4c
ML
136my $TEMP_DIR = tempdir( CLEANUP => 1 );
137$log->debug("Temporary directory is '$TEMP_DIR'");
138
693b6327
FL
139$state->{method} = 'ext';
140if (@ARGV) {
141 if ($ARGV[0] eq 'pserver') {
142 $state->{method} = 'pserver';
143 shift @ARGV;
144 } elsif ($ARGV[0] eq 'server') {
145 shift @ARGV;
146 }
147}
148
149# everything else is a directory
150$state->{allowed_roots} = [ @ARGV ];
151
226bccb9
FL
152# don't export the whole system unless the users requests it
153if ($state->{'export-all'} && !@{$state->{allowed_roots}}) {
154 die "--export-all can only be used together with an explicit whitelist\n";
155}
156
03bd0d60
PM
157# Environment handling for running under git-shell
158if (exists $ENV{GIT_CVSSERVER_BASE_PATH}) {
159 if ($state->{'base-path'}) {
160 die "Cannot specify base path both ways.\n";
161 }
162 my $base_path = $ENV{GIT_CVSSERVER_BASE_PATH};
163 $state->{'base-path'} = $base_path;
164 $log->debug("Picked up base path '$base_path' from environment.\n");
165}
166if (exists $ENV{GIT_CVSSERVER_ROOT}) {
167 if (@{$state->{allowed_roots}}) {
168 die "Cannot specify roots both ways: @ARGV\n";
169 }
170 my $allowed_root = $ENV{GIT_CVSSERVER_ROOT};
171 $state->{allowed_roots} = [ $allowed_root ];
172 $log->debug("Picked up allowed root '$allowed_root' from environment.\n");
173}
174
91a6bf46 175# if we are called with a pserver argument,
5348b6e7 176# deal with the authentication cat before entering the
91a6bf46 177# main loop
693b6327 178if ($state->{method} eq 'pserver') {
91a6bf46 179 my $line = <STDIN>; chomp $line;
24a97d84 180 unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
91a6bf46
ML
181 die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
182 }
24a97d84 183 my $request = $1;
91a6bf46 184 $line = <STDIN>; chomp $line;
2a4b5d5a
BG
185 unless (req_Root('root', $line)) { # reuse Root
186 print "E Invalid root $line \n";
187 exit 1;
188 }
91a6bf46 189 $line = <STDIN>; chomp $line;
031a027a
ÆAB
190 my $user = $line;
191 $line = <STDIN>; chomp $line;
192 my $password = $line;
193
475357a3
ÆAB
194 if ($user eq 'anonymous') {
195 # "A" will be 1 byte, use length instead in case the
196 # encryption method ever changes (yeah, right!)
197 if (length($password) > 1 ) {
198 print "E Don't supply a password for the `anonymous' user\n";
199 print "I HATE YOU\n";
200 exit 1;
201 }
202
203 # Fall through to LOVE
204 } else {
031a027a 205 # Trying to authenticate a user
c057bad3 206 if (not exists $cfg->{gitcvs}->{authdb}) {
475357a3
ÆAB
207 print "E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n";
208 print "I HATE YOU\n";
209 exit 1;
210 }
211
212 my $authdb = $cfg->{gitcvs}->{authdb};
213
214 unless (-e $authdb) {
215 print "E The authentication database specified in [gitcvs.authdb] does not exist\n";
031a027a
ÆAB
216 print "I HATE YOU\n";
217 exit 1;
c057bad3 218 }
3052525e
ÆAB
219
220 my $auth_ok;
475357a3 221 open my $passwd, "<", $authdb or die $!;
3052525e
ÆAB
222 while (<$passwd>) {
223 if (m{^\Q$user\E:(.*)}) {
475357a3 224 if (crypt($user, descramble($password)) eq $1) {
3052525e
ÆAB
225 $auth_ok = 1;
226 }
227 };
228 }
229 close $passwd;
230
231 unless ($auth_ok) {
031a027a
ÆAB
232 print "I HATE YOU\n";
233 exit 1;
031a027a 234 }
475357a3
ÆAB
235
236 # Fall through to LOVE
91a6bf46 237 }
031a027a
ÆAB
238
239 # For checking whether the user is anonymous on commit
240 $state->{user} = $user;
241
91a6bf46 242 $line = <STDIN>; chomp $line;
24a97d84
FL
243 unless ($line eq "END $request REQUEST") {
244 die "E Do not understand $line -- expecting END $request REQUEST\n";
91a6bf46
ML
245 }
246 print "I LOVE YOU\n";
24a97d84 247 exit if $request eq 'VERIFICATION'; # cvs login
91a6bf46
ML
248 # and now back to our regular programme...
249}
250
3fda8c4c
ML
251# Keep going until the client closes the connection
252while (<STDIN>)
253{
254 chomp;
255
5348b6e7 256 # Check to see if we've seen this method, and call appropriate function.
3fda8c4c
ML
257 if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
258 {
259 # use the $methods hash to call the appropriate sub for this command
260 #$log->info("Method : $1");
261 &{$methods->{$1}}($1,$2);
262 } else {
263 # log fatal because we don't understand this function. If this happens
264 # we're fairly screwed because we don't know if the client is expecting
265 # a response. If it is, the client will hang, we'll hang, and the whole
266 # thing will be custard.
267 $log->fatal("Don't understand command $_\n");
268 die("Unknown command $_");
269 }
270}
271
272$log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
273$log->info("--------------- FINISH -----------------");
274
044182ef
MO
275chdir '/';
276exit 0;
277
3fda8c4c
ML
278# Magic catchall method.
279# This is the method that will handle all commands we haven't yet
280# implemented. It simply sends a warning to the log file indicating a
281# command that hasn't been implemented has been invoked.
282sub req_CATCHALL
283{
284 my ( $cmd, $data ) = @_;
285 $log->warn("Unhandled command : req_$cmd : $data");
286}
287
38bcd31a
DD
288# This method invariably succeeds with an empty response.
289sub req_EMPTY
290{
291 print "ok\n";
292}
3fda8c4c
ML
293
294# Root pathname \n
295# Response expected: no. Tell the server which CVSROOT to use. Note that
296# pathname is a local directory and not a fully qualified CVSROOT variable.
297# pathname must already exist; if creating a new root, use the init
298# request, not Root. pathname does not include the hostname of the server,
299# how to access the server, etc.; by the time the CVS protocol is in use,
300# connection, authentication, etc., are already taken care of. The Root
301# request must be sent only once, and it must be sent before any requests
302# other than Valid-responses, valid-requests, UseUnchanged, Set or init.
303sub req_Root
304{
305 my ( $cmd, $data ) = @_;
306 $log->debug("req_Root : $data");
307
4890888d
FL
308 unless ($data =~ m#^/#) {
309 print "error 1 Root must be an absolute pathname\n";
310 return 0;
311 }
312
fd1cd91e
FL
313 my $cvsroot = $state->{'base-path'} || '';
314 $cvsroot =~ s#/+$##;
315 $cvsroot .= $data;
316
4890888d 317 if ($state->{CVSROOT}
fd1cd91e 318 && ($state->{CVSROOT} ne $cvsroot)) {
4890888d
FL
319 print "error 1 Conflicting roots specified\n";
320 return 0;
321 }
322
fd1cd91e 323 $state->{CVSROOT} = $cvsroot;
3fda8c4c
ML
324
325 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
693b6327
FL
326
327 if (@{$state->{allowed_roots}}) {
328 my $allowed = 0;
329 foreach my $dir (@{$state->{allowed_roots}}) {
330 next unless $dir =~ m#^/#;
331 $dir =~ s#/+$##;
332 if ($state->{'strict-paths'}) {
333 if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
334 $allowed = 1;
335 last;
336 }
337 } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
338 $allowed = 1;
339 last;
340 }
341 }
342
343 unless ($allowed) {
344 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
345 print "E \n";
346 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
347 return 0;
348 }
349 }
350
cdb6760e
ML
351 unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
352 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
693b6327
FL
353 print "E \n";
354 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
cdb6760e
ML
355 return 0;
356 }
3fda8c4c 357
d2feb01a 358 my @gitvars = `git config -l`;
cdb6760e 359 if ($?) {
e0d10e1c 360 print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
cdb6760e 361 print "E \n";
e0d10e1c 362 print "error 1 - problem executing git-config\n";
cdb6760e
ML
363 return 0;
364 }
365 foreach my $line ( @gitvars )
3fda8c4c 366 {
c057bad3 367 next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
f987afa8
FL
368 unless ($2) {
369 $cfg->{$1}{$3} = $4;
92a39a14
FL
370 } else {
371 $cfg->{$1}{$2}{$3} = $4;
372 }
3fda8c4c
ML
373 }
374
523d12e5
JH
375 my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
376 || $cfg->{gitcvs}{enabled});
226bccb9
FL
377 unless ($state->{'export-all'} ||
378 ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
3fda8c4c
ML
379 print "E GITCVS emulation needs to be enabled on this repo\n";
380 print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
381 print "E \n";
382 print "error 1 GITCVS emulation disabled\n";
91a6bf46 383 return 0;
3fda8c4c
ML
384 }
385
d55820ce
FL
386 my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
387 if ( $logfile )
3fda8c4c 388 {
d55820ce 389 $log->setfile($logfile);
3fda8c4c
ML
390 } else {
391 $log->nofile();
392 }
91a6bf46
ML
393
394 return 1;
3fda8c4c
ML
395}
396
397# Global_option option \n
398# Response expected: no. Transmit one of the global options `-q', `-Q',
399# `-l', `-t', `-r', or `-n'. option must be one of those strings, no
400# variations (such as combining of options) are allowed. For graceful
401# handling of valid-requests, it is probably better to make new global
402# options separate requests, rather than trying to add them to this
403# request.
404sub req_Globaloption
405{
406 my ( $cmd, $data ) = @_;
407 $log->debug("req_Globaloption : $data");
7d90095a 408 $state->{globaloptions}{$data} = 1;
3fda8c4c
ML
409}
410
411# Valid-responses request-list \n
412# Response expected: no. Tell the server what responses the client will
413# accept. request-list is a space separated list of tokens.
414sub req_Validresponses
415{
416 my ( $cmd, $data ) = @_;
5348b6e7 417 $log->debug("req_Validresponses : $data");
3fda8c4c
ML
418
419 # TODO : re-enable this, currently it's not particularly useful
420 #$state->{validresponses} = [ split /\s+/, $data ];
421}
422
423# valid-requests \n
424# Response expected: yes. Ask the server to send back a Valid-requests
425# response.
426sub req_validrequests
427{
428 my ( $cmd, $data ) = @_;
429
430 $log->debug("req_validrequests");
431
432 $log->debug("SEND : Valid-requests " . join(" ",keys %$methods));
433 $log->debug("SEND : ok");
434
435 print "Valid-requests " . join(" ",keys %$methods) . "\n";
436 print "ok\n";
437}
438
439# Directory local-directory \n
440# Additional data: repository \n. Response expected: no. Tell the server
441# what directory to use. The repository should be a directory name from a
442# previous server response. Note that this both gives a default for Entry
443# and Modified and also for ci and the other commands; normal usage is to
444# send Directory for each directory in which there will be an Entry or
445# Modified, and then a final Directory for the original directory, then the
446# command. The local-directory is relative to the top level at which the
447# command is occurring (i.e. the last Directory which is sent before the
448# command); to indicate that top level, `.' should be sent for
449# local-directory.
450sub req_Directory
451{
452 my ( $cmd, $data ) = @_;
453
454 my $repository = <STDIN>;
455 chomp $repository;
456
457
458 $state->{localdir} = $data;
459 $state->{repository} = $repository;
7d90095a 460 $state->{path} = $repository;
f9acaeae 461 $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
7d90095a
MS
462 $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
463 $state->{path} .= "/" if ( $state->{path} =~ /\S/ );
464
465 $state->{directory} = $state->{localdir};
466 $state->{directory} = "" if ( $state->{directory} eq "." );
3fda8c4c
ML
467 $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
468
d988b822 469 if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
7d90095a
MS
470 {
471 $log->info("Setting prepend to '$state->{path}'");
472 $state->{prependdir} = $state->{path};
473 foreach my $entry ( keys %{$state->{entries}} )
474 {
475 $state->{entries}{$state->{prependdir} . $entry} = $state->{entries}{$entry};
476 delete $state->{entries}{$entry};
477 }
478 }
479
480 if ( defined ( $state->{prependdir} ) )
481 {
482 $log->debug("Prepending '$state->{prependdir}' to state|directory");
483 $state->{directory} = $state->{prependdir} . $state->{directory}
484 }
82000d74 485 $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
3fda8c4c
ML
486}
487
488# Entry entry-line \n
489# Response expected: no. Tell the server what version of a file is on the
490# local machine. The name in entry-line is a name relative to the directory
491# most recently specified with Directory. If the user is operating on only
492# some files in a directory, Entry requests for only those files need be
493# included. If an Entry request is sent without Modified, Is-modified, or
494# Unchanged, it means the file is lost (does not exist in the working
495# directory). If both Entry and one of Modified, Is-modified, or Unchanged
496# are sent for the same file, Entry must be sent first. For a given file,
497# one can send Modified, Is-modified, or Unchanged, but not more than one
498# of these three.
499sub req_Entry
500{
501 my ( $cmd, $data ) = @_;
502
7d90095a 503 #$log->debug("req_Entry : $data");
3fda8c4c
ML
504
505 my @data = split(/\//, $data);
506
507 $state->{entries}{$state->{directory}.$data[1]} = {
508 revision => $data[2],
509 conflict => $data[3],
510 options => $data[4],
511 tag_or_date => $data[5],
512 };
7d90095a
MS
513
514 $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
515}
516
517# Questionable filename \n
518# Response expected: no. Additional data: no. Tell the server to check
519# whether filename should be ignored, and if not, next time the server
520# sends responses, send (in a M response) `?' followed by the directory and
521# filename. filename must not contain `/'; it needs to be a file in the
522# directory named by the most recent Directory request.
523sub req_Questionable
524{
525 my ( $cmd, $data ) = @_;
526
527 $log->debug("req_Questionable : $data");
528 $state->{entries}{$state->{directory}.$data}{questionable} = 1;
3fda8c4c
ML
529}
530
531# add \n
532# Response expected: yes. Add a file or directory. This uses any previous
533# Argument, Directory, Entry, or Modified requests, if they have been sent.
534# The last Directory sent specifies the working directory at the time of
535# the operation. To add a directory, send the directory to be added using
536# Directory and Argument requests.
537sub req_add
538{
539 my ( $cmd, $data ) = @_;
540
541 argsplit("add");
542
4db0c8de
FL
543 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
544 $updater->update();
545
546 argsfromdir($updater);
547
3fda8c4c
ML
548 my $addcount = 0;
549
550 foreach my $filename ( @{$state->{args}} )
551 {
552 $filename = filecleanup($filename);
553
4db0c8de
FL
554 my $meta = $updater->getmeta($filename);
555 my $wrev = revparse($filename);
556
557 if ($wrev && $meta && ($wrev < 0))
558 {
559 # previously removed file, add back
560 $log->info("added file $filename was previously removed, send 1.$meta->{revision}");
561
562 print "MT +updated\n";
563 print "MT text U \n";
564 print "MT fname $filename\n";
565 print "MT newline\n";
566 print "MT -updated\n";
567
568 unless ( $state->{globaloptions}{-n} )
569 {
570 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
571
572 print "Created $dirpart\n";
573 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
574
575 # this is an "entries" line
90948a42 576 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
4db0c8de
FL
577 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
578 print "/$filepart/1.$meta->{revision}//$kopts/\n";
579 # permissions
580 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
581 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
582 # transmit file
583 transmitfile($meta->{filehash});
584 }
585
586 next;
587 }
588
3fda8c4c
ML
589 unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
590 {
591 print "E cvs add: nothing known about `$filename'\n";
592 next;
593 }
594 # TODO : check we're not squashing an already existing file
595 if ( defined ( $state->{entries}{$filename}{revision} ) )
596 {
597 print "E cvs add: `$filename' has already been entered\n";
598 next;
599 }
600
7d90095a 601 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
3fda8c4c
ML
602
603 print "E cvs add: scheduling file `$filename' for addition\n";
604
605 print "Checked-in $dirpart\n";
606 print "$filename\n";
90948a42
MO
607 my $kopts = kopts_from_path($filename,"file",
608 $state->{entries}{$filename}{modified_filename});
8538e876 609 print "/$filepart/0//$kopts/\n";
3fda8c4c 610
8a06a632
MO
611 my $requestedKopts = $state->{opt}{k};
612 if(defined($requestedKopts))
613 {
614 $requestedKopts = "-k$requestedKopts";
615 }
616 else
617 {
618 $requestedKopts = "";
619 }
620 if( $kopts ne $requestedKopts )
621 {
622 $log->warn("Ignoring requested -k='$requestedKopts'"
623 . " for '$filename'; detected -k='$kopts' instead");
624 #TODO: Also have option to send warning to user?
625 }
626
3fda8c4c
ML
627 $addcount++;
628 }
629
630 if ( $addcount == 1 )
631 {
632 print "E cvs add: use `cvs commit' to add this file permanently\n";
633 }
634 elsif ( $addcount > 1 )
635 {
636 print "E cvs add: use `cvs commit' to add these files permanently\n";
637 }
638
639 print "ok\n";
640}
641
642# remove \n
643# Response expected: yes. Remove a file. This uses any previous Argument,
644# Directory, Entry, or Modified requests, if they have been sent. The last
645# Directory sent specifies the working directory at the time of the
646# operation. Note that this request does not actually do anything to the
647# repository; the only effect of a successful remove request is to supply
648# the client with a new entries line containing `-' to indicate a removed
649# file. In fact, the client probably could perform this operation without
650# contacting the server, although using remove may cause the server to
651# perform a few more checks. The client sends a subsequent ci request to
652# actually record the removal in the repository.
653sub req_remove
654{
655 my ( $cmd, $data ) = @_;
656
657 argsplit("remove");
658
659 # Grab a handle to the SQLite db and do any necessary updates
660 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
661 $updater->update();
662
663 #$log->debug("add state : " . Dumper($state));
664
665 my $rmcount = 0;
666
667 foreach my $filename ( @{$state->{args}} )
668 {
669 $filename = filecleanup($filename);
670
671 if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
672 {
673 print "E cvs remove: file `$filename' still in working directory\n";
674 next;
675 }
676
677 my $meta = $updater->getmeta($filename);
678 my $wrev = revparse($filename);
679
680 unless ( defined ( $wrev ) )
681 {
682 print "E cvs remove: nothing known about `$filename'\n";
683 next;
684 }
685
686 if ( defined($wrev) and $wrev < 0 )
687 {
688 print "E cvs remove: file `$filename' already scheduled for removal\n";
689 next;
690 }
691
692 unless ( $wrev == $meta->{revision} )
693 {
694 # TODO : not sure if the format of this message is quite correct.
695 print "E cvs remove: Up to date check failed for `$filename'\n";
696 next;
697 }
698
699
7d90095a 700 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
3fda8c4c
ML
701
702 print "E cvs remove: scheduling `$filename' for removal\n";
703
704 print "Checked-in $dirpart\n";
705 print "$filename\n";
90948a42 706 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
8538e876 707 print "/$filepart/-1.$wrev//$kopts/\n";
3fda8c4c
ML
708
709 $rmcount++;
710 }
711
712 if ( $rmcount == 1 )
713 {
714 print "E cvs remove: use `cvs commit' to remove this file permanently\n";
715 }
716 elsif ( $rmcount > 1 )
717 {
718 print "E cvs remove: use `cvs commit' to remove these files permanently\n";
719 }
720
721 print "ok\n";
722}
723
724# Modified filename \n
725# Response expected: no. Additional data: mode, \n, file transmission. Send
726# the server a copy of one locally modified file. filename is a file within
727# the most recent directory sent with Directory; it must not contain `/'.
728# If the user is operating on only some files in a directory, only those
729# files need to be included. This can also be sent without Entry, if there
730# is no entry for the file.
731sub req_Modified
732{
733 my ( $cmd, $data ) = @_;
734
735 my $mode = <STDIN>;
a5e40798
JM
736 defined $mode
737 or (print "E end of file reading mode for $data\n"), return;
3fda8c4c
ML
738 chomp $mode;
739 my $size = <STDIN>;
a5e40798
JM
740 defined $size
741 or (print "E end of file reading size of $data\n"), return;
3fda8c4c
ML
742 chomp $size;
743
744 # Grab config information
745 my $blocksize = 8192;
746 my $bytesleft = $size;
747 my $tmp;
748
749 # Get a filehandle/name to write it to
750 my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
751
752 # Loop over file data writing out to temporary file.
753 while ( $bytesleft )
754 {
755 $blocksize = $bytesleft if ( $bytesleft < $blocksize );
756 read STDIN, $tmp, $blocksize;
757 print $fh $tmp;
758 $bytesleft -= $blocksize;
759 }
760
a5e40798
JM
761 close $fh
762 or (print "E failed to write temporary, $filename: $!\n"), return;
3fda8c4c
ML
763
764 # Ensure we have something sensible for the file mode
765 if ( $mode =~ /u=(\w+)/ )
766 {
767 $mode = $1;
768 } else {
769 $mode = "rw";
770 }
771
772 # Save the file data in $state
773 $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
774 $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
d2feb01a 775 $state->{entries}{$state->{directory}.$data}{modified_hash} = `git hash-object $filename`;
3fda8c4c
ML
776 $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
777
778 #$log->debug("req_Modified : file=$data mode=$mode size=$size");
779}
780
781# Unchanged filename \n
782# Response expected: no. Tell the server that filename has not been
783# modified in the checked out directory. The filename is a file within the
784# most recent directory sent with Directory; it must not contain `/'.
785sub req_Unchanged
786{
787 my ( $cmd, $data ) = @_;
788
789 $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
790
791 #$log->debug("req_Unchanged : $data");
792}
793
794# Argument text \n
795# Response expected: no. Save argument for use in a subsequent command.
796# Arguments accumulate until an argument-using command is given, at which
797# point they are forgotten.
798# Argumentx text \n
799# Response expected: no. Append \n followed by text to the current argument
800# being saved.
801sub req_Argument
802{
803 my ( $cmd, $data ) = @_;
804
2c3cff49 805 # Argumentx means: append to last Argument (with a newline in front)
3fda8c4c
ML
806
807 $log->debug("$cmd : $data");
808
2c3cff49
JS
809 if ( $cmd eq 'Argumentx') {
810 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
811 } else {
812 push @{$state->{arguments}}, $data;
813 }
3fda8c4c
ML
814}
815
816# expand-modules \n
817# Response expected: yes. Expand the modules which are specified in the
818# arguments. Returns the data in Module-expansion responses. Note that the
819# server can assume that this is checkout or export, not rtag or rdiff; the
820# latter do not access the working directory and thus have no need to
821# expand modules on the client side. Expand may not be the best word for
822# what this request does. It does not necessarily tell you all the files
823# contained in a module, for example. Basically it is a way of telling you
824# which working directories the server needs to know about in order to
825# handle a checkout of the specified modules. For example, suppose that the
826# server has a module defined by
827# aliasmodule -a 1dir
828# That is, one can check out aliasmodule and it will take 1dir in the
829# repository and check it out to 1dir in the working directory. Now suppose
830# the client already has this module checked out and is planning on using
831# the co request to update it. Without using expand-modules, the client
832# would have two bad choices: it could either send information about all
833# working directories under the current directory, which could be
834# unnecessarily slow, or it could be ignorant of the fact that aliasmodule
835# stands for 1dir, and neglect to send information for 1dir, which would
836# lead to incorrect operation. With expand-modules, the client would first
837# ask for the module to be expanded:
838sub req_expandmodules
839{
840 my ( $cmd, $data ) = @_;
841
842 argsplit();
843
844 $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
845
846 unless ( ref $state->{arguments} eq "ARRAY" )
847 {
848 print "ok\n";
849 return;
850 }
851
852 foreach my $module ( @{$state->{arguments}} )
853 {
854 $log->debug("SEND : Module-expansion $module");
855 print "Module-expansion $module\n";
856 }
857
858 print "ok\n";
859 statecleanup();
860}
861
862# co \n
863# Response expected: yes. Get files from the repository. This uses any
864# previous Argument, Directory, Entry, or Modified requests, if they have
865# been sent. Arguments to this command are module names; the client cannot
866# know what directories they correspond to except by (1) just sending the
867# co request, and then seeing what directory names the server sends back in
868# its responses, and (2) the expand-modules request.
869sub req_co
870{
871 my ( $cmd, $data ) = @_;
872
873 argsplit("co");
874
89a9167f
LN
875 # Provide list of modules, if -c was used.
876 if (exists $state->{opt}{c}) {
877 my $showref = `git show-ref --heads`;
878 for my $line (split '\n', $showref) {
879 if ( $line =~ m% refs/heads/(.*)$% ) {
880 print "M $1\t$1\n";
881 }
882 }
883 print "ok\n";
884 return 1;
885 }
886
3fda8c4c 887 my $module = $state->{args}[0];
8a06a632 888 $state->{module} = $module;
3fda8c4c
ML
889 my $checkout_path = $module;
890
891 # use the user specified directory if we're given it
892 $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
893
894 $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
895
896 $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
897
898 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
899
900 # Grab a handle to the SQLite db and do any necessary updates
901 my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
902 $updater->update();
903
c8c4f220
ML
904 $checkout_path =~ s|/$||; # get rid of trailing slashes
905
906 # Eclipse seems to need the Clear-sticky command
907 # to prepare the 'Entries' file for the new directory.
908 print "Clear-sticky $checkout_path/\n";
e74ee784 909 print $state->{CVSROOT} . "/$module/\n";
c8c4f220 910 print "Clear-static-directory $checkout_path/\n";
e74ee784 911 print $state->{CVSROOT} . "/$module/\n";
6be32d47
ML
912 print "Clear-sticky $checkout_path/\n"; # yes, twice
913 print $state->{CVSROOT} . "/$module/\n";
914 print "Template $checkout_path/\n";
915 print $state->{CVSROOT} . "/$module/\n";
916 print "0\n";
c8c4f220 917
3fda8c4c 918 # instruct the client that we're checking out to $checkout_path
c8c4f220
ML
919 print "E cvs checkout: Updating $checkout_path\n";
920
921 my %seendirs = ();
501c7372 922 my $lastdir ='';
3fda8c4c 923
6be32d47
ML
924 # recursive
925 sub prepdir {
926 my ($dir, $repodir, $remotedir, $seendirs) = @_;
927 my $parent = dirname($dir);
928 $dir =~ s|/+$||;
929 $repodir =~ s|/+$||;
930 $remotedir =~ s|/+$||;
931 $parent =~ s|/+$||;
932 $log->debug("announcedir $dir, $repodir, $remotedir" );
933
934 if ($parent eq '.' || $parent eq './') {
935 $parent = '';
936 }
937 # recurse to announce unseen parents first
938 if (length($parent) && !exists($seendirs->{$parent})) {
939 prepdir($parent, $repodir, $remotedir, $seendirs);
940 }
941 # Announce that we are going to modify at the parent level
942 if ($parent) {
943 print "E cvs checkout: Updating $remotedir/$parent\n";
944 } else {
945 print "E cvs checkout: Updating $remotedir\n";
946 }
947 print "Clear-sticky $remotedir/$parent/\n";
948 print "$repodir/$parent/\n";
949
950 print "Clear-static-directory $remotedir/$dir/\n";
951 print "$repodir/$dir/\n";
952 print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
953 print "$repodir/$parent/\n";
954 print "Template $remotedir/$dir/\n";
955 print "$repodir/$dir/\n";
956 print "0\n";
957
958 $seendirs->{$dir} = 1;
959 }
960
3fda8c4c
ML
961 foreach my $git ( @{$updater->gethead} )
962 {
963 # Don't want to check out deleted files
964 next if ( $git->{filehash} eq "deleted" );
965
8a06a632 966 my $fullName = $git->{name};
3fda8c4c
ML
967 ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
968
6be32d47
ML
969 if (length($git->{dir}) && $git->{dir} ne './'
970 && $git->{dir} ne $lastdir ) {
971 unless (exists($seendirs{$git->{dir}})) {
972 prepdir($git->{dir}, $state->{CVSROOT} . "/$module/",
973 $checkout_path, \%seendirs);
974 $lastdir = $git->{dir};
975 $seendirs{$git->{dir}} = 1;
976 }
977 print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
978 }
979
3fda8c4c
ML
980 # modification time of this file
981 print "Mod-time $git->{modified}\n";
982
983 # print some information to the client
3fda8c4c
ML
984 if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
985 {
c8c4f220 986 print "M U $checkout_path/$git->{dir}$git->{name}\n";
3fda8c4c 987 } else {
c8c4f220 988 print "M U $checkout_path/$git->{name}\n";
3fda8c4c 989 }
c8c4f220 990
6be32d47
ML
991 # instruct client we're sending a file to put in this path
992 print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
3fda8c4c 993
6be32d47 994 print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
3fda8c4c
ML
995
996 # this is an "entries" line
90948a42 997 my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
8538e876 998 print "/$git->{name}/1.$git->{revision}//$kopts/\n";
3fda8c4c
ML
999 # permissions
1000 print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
1001
1002 # transmit file
1003 transmitfile($git->{filehash});
1004 }
1005
1006 print "ok\n";
1007
1008 statecleanup();
1009}
1010
1011# update \n
1012# Response expected: yes. Actually do a cvs update command. This uses any
1013# previous Argument, Directory, Entry, or Modified requests, if they have
1014# been sent. The last Directory sent specifies the working directory at the
1015# time of the operation. The -I option is not used--files which the client
1016# can decide whether to ignore are not mentioned and the client sends the
1017# Questionable request for others.
1018sub req_update
1019{
1020 my ( $cmd, $data ) = @_;
1021
1022 $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
1023
1024 argsplit("update");
1025
858cbfba 1026 #
5348b6e7 1027 # It may just be a client exploring the available heads/modules
858cbfba
ML
1028 # in that case, list them as top level directories and leave it
1029 # at that. Eclipse uses this technique to offer you a list of
1030 # projects (heads in this case) to checkout.
1031 #
1032 if ($state->{module} eq '') {
b20171eb 1033 my $showref = `git show-ref --heads`;
858cbfba 1034 print "E cvs update: Updating .\n";
b20171eb
LN
1035 for my $line (split '\n', $showref) {
1036 if ( $line =~ m% refs/heads/(.*)$% ) {
1037 print "E cvs update: New directory `$1'\n";
1038 }
1039 }
1040 print "ok\n";
1041 return 1;
858cbfba
ML
1042 }
1043
1044
3fda8c4c
ML
1045 # Grab a handle to the SQLite db and do any necessary updates
1046 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1047
1048 $updater->update();
1049
7d90095a 1050 argsfromdir($updater);
3fda8c4c
ML
1051
1052 #$log->debug("update state : " . Dumper($state));
1053
8e4c4e7d
SO
1054 my $last_dirname = "///";
1055
addf88e4 1056 # foreach file specified on the command line ...
3fda8c4c
ML
1057 foreach my $filename ( @{$state->{args}} )
1058 {
1059 $filename = filecleanup($filename);
1060
7d90095a
MS
1061 $log->debug("Processing file $filename");
1062
8e4c4e7d
SO
1063 unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
1064 {
1065 my $cur_dirname = dirname($filename);
1066 if ( $cur_dirname ne $last_dirname )
1067 {
1068 $last_dirname = $cur_dirname;
1069 if ( $cur_dirname eq "" )
1070 {
1071 $cur_dirname = ".";
1072 }
1073 print "E cvs update: Updating $cur_dirname\n";
1074 }
1075 }
1076
3fda8c4c
ML
1077 # if we have a -C we should pretend we never saw modified stuff
1078 if ( exists ( $state->{opt}{C} ) )
1079 {
1080 delete $state->{entries}{$filename}{modified_hash};
1081 delete $state->{entries}{$filename}{modified_filename};
1082 $state->{entries}{$filename}{unchanged} = 1;
1083 }
1084
1085 my $meta;
1086 if ( defined($state->{opt}{r}) and $state->{opt}{r} =~ /^1\.(\d+)/ )
1087 {
1088 $meta = $updater->getmeta($filename, $1);
1089 } else {
1090 $meta = $updater->getmeta($filename);
1091 }
1092
e78f69a3
DD
1093 # If -p was given, "print" the contents of the requested revision.
1094 if ( exists ( $state->{opt}{p} ) ) {
1095 if ( defined ( $meta->{revision} ) ) {
1096 $log->info("Printing '$filename' revision " . $meta->{revision});
1097
1098 transmitfile($meta->{filehash}, { print => 1 });
1099 }
1100
1101 next;
1102 }
1103
0a7a9a12
JS
1104 if ( ! defined $meta )
1105 {
1106 $meta = {
1107 name => $filename,
1108 revision => 0,
1109 filehash => 'added'
1110 };
1111 }
3fda8c4c
ML
1112
1113 my $oldmeta = $meta;
1114
1115 my $wrev = revparse($filename);
1116
1117 # If the working copy is an old revision, lets get that version too for comparison.
1118 if ( defined($wrev) and $wrev != $meta->{revision} )
1119 {
1120 $oldmeta = $updater->getmeta($filename, $wrev);
1121 }
1122
1123 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
1124
ec58db15
ML
1125 # Files are up to date if the working copy and repo copy have the same revision,
1126 # and the working copy is unmodified _and_ the user hasn't specified -C
1127 next if ( defined ( $wrev )
1128 and defined($meta->{revision})
1129 and $wrev == $meta->{revision}
1130 and $state->{entries}{$filename}{unchanged}
1131 and not exists ( $state->{opt}{C} ) );
1132
1133 # If the working copy and repo copy have the same revision,
1134 # but the working copy is modified, tell the client it's modified
1135 if ( defined ( $wrev )
1136 and defined($meta->{revision})
1137 and $wrev == $meta->{revision}
cb52d9a1 1138 and defined($state->{entries}{$filename}{modified_hash})
ec58db15
ML
1139 and not exists ( $state->{opt}{C} ) )
1140 {
1141 $log->info("Tell the client the file is modified");
0a7a9a12 1142 print "MT text M \n";
ec58db15
ML
1143 print "MT fname $filename\n";
1144 print "MT newline\n";
1145 next;
1146 }
3fda8c4c
ML
1147
1148 if ( $meta->{filehash} eq "deleted" )
1149 {
d8574ff2
MO
1150 # TODO: If it has been modified in the sandbox, error out
1151 # with the appropriate message, rather than deleting a modified
1152 # file.
1153
7d90095a 1154 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
3fda8c4c
ML
1155
1156 $log->info("Removing '$filename' from working copy (no longer in the repo)");
1157
1158 print "E cvs update: `$filename' is no longer in the repository\n";
7d90095a
MS
1159 # Don't want to actually _DO_ the update if -n specified
1160 unless ( $state->{globaloptions}{-n} ) {
1161 print "Removed $dirpart\n";
1162 print "$filepart\n";
1163 }
3fda8c4c 1164 }
ec58db15 1165 elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
0a7a9a12
JS
1166 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
1167 or $meta->{filehash} eq 'added' )
3fda8c4c 1168 {
0a7a9a12
JS
1169 # normal update, just send the new revision (either U=Update,
1170 # or A=Add, or R=Remove)
1171 if ( defined($wrev) && $wrev < 0 )
1172 {
1173 $log->info("Tell the client the file is scheduled for removal");
1174 print "MT text R \n";
1175 print "MT fname $filename\n";
1176 print "MT newline\n";
1177 next;
1178 }
535514f1 1179 elsif ( (!defined($wrev) || $wrev == 0) && (!defined($meta->{revision}) || $meta->{revision} == 0) )
0a7a9a12 1180 {
535514f1 1181 $log->info("Tell the client the file is scheduled for addition");
0a7a9a12
JS
1182 print "MT text A \n";
1183 print "MT fname $filename\n";
1184 print "MT newline\n";
1185 next;
1186
1187 }
1188 else {
535514f1 1189 $log->info("Updating '$filename' to ".$meta->{revision});
0a7a9a12
JS
1190 print "MT +updated\n";
1191 print "MT text U \n";
1192 print "MT fname $filename\n";
1193 print "MT newline\n";
1194 print "MT -updated\n";
1195 }
3fda8c4c 1196
7d90095a
MS
1197 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1198
1199 # Don't want to actually _DO_ the update if -n specified
1200 unless ( $state->{globaloptions}{-n} )
1201 {
1202 if ( defined ( $wrev ) )
1203 {
1204 # instruct client we're sending a file to put in this path as a replacement
1205 print "Update-existing $dirpart\n";
1206 $log->debug("Updating existing file 'Update-existing $dirpart'");
1207 } else {
1208 # instruct client we're sending a file to put in this path as a new file
1209 print "Clear-static-directory $dirpart\n";
1210 print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
1211 print "Clear-sticky $dirpart\n";
1212 print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
1213
1214 $log->debug("Creating new file 'Created $dirpart'");
1215 print "Created $dirpart\n";
1216 }
1217 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1218
1219 # this is an "entries" line
90948a42 1220 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
8538e876
AP
1221 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
1222 print "/$filepart/1.$meta->{revision}//$kopts/\n";
7d90095a
MS
1223
1224 # permissions
1225 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1226 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1227
1228 # transmit file
1229 transmitfile($meta->{filehash});
1230 }
3fda8c4c 1231 } else {
ec58db15 1232 $log->info("Updating '$filename'");
7d90095a 1233 my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
3fda8c4c 1234
044182ef 1235 my $mergeDir = setupTmpDir();
3fda8c4c 1236
3fda8c4c 1237 my $file_local = $filepart . ".mine";
044182ef 1238 my $mergedFile = "$mergeDir/$file_local";
3fda8c4c
ML
1239 system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
1240 my $file_old = $filepart . "." . $oldmeta->{revision};
e78f69a3 1241 transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
3fda8c4c 1242 my $file_new = $filepart . "." . $meta->{revision};
e78f69a3 1243 transmitfile($meta->{filehash}, { targetfile => $file_new });
3fda8c4c
ML
1244
1245 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
1246 $log->info("Merging $file_local, $file_old, $file_new");
459bad77 1247 print "M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into $filename\n";
3fda8c4c 1248
044182ef 1249 $log->debug("Temporary directory for merge is $mergeDir");
3fda8c4c 1250
c6b4fa96 1251 my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
3fda8c4c
ML
1252 $return >>= 8;
1253
044182ef
MO
1254 cleanupTmpDir();
1255
3fda8c4c
ML
1256 if ( $return == 0 )
1257 {
1258 $log->info("Merged successfully");
1259 print "M M $filename\n";
53877846 1260 $log->debug("Merged $dirpart");
7d90095a
MS
1261
1262 # Don't want to actually _DO_ the update if -n specified
1263 unless ( $state->{globaloptions}{-n} )
1264 {
53877846 1265 print "Merged $dirpart\n";
7d90095a
MS
1266 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
1267 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
90948a42
MO
1268 my $kopts = kopts_from_path("$dirpart/$filepart",
1269 "file",$mergedFile);
8538e876
AP
1270 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
1271 print "/$filepart/1.$meta->{revision}//$kopts/\n";
7d90095a 1272 }
3fda8c4c
ML
1273 }
1274 elsif ( $return == 1 )
1275 {
1276 $log->info("Merged with conflicts");
459bad77 1277 print "E cvs update: conflicts found in $filename\n";
3fda8c4c 1278 print "M C $filename\n";
7d90095a
MS
1279
1280 # Don't want to actually _DO_ the update if -n specified
1281 unless ( $state->{globaloptions}{-n} )
1282 {
53877846 1283 print "Merged $dirpart\n";
7d90095a 1284 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
90948a42
MO
1285 my $kopts = kopts_from_path("$dirpart/$filepart",
1286 "file",$mergedFile);
8538e876 1287 print "/$filepart/1.$meta->{revision}/+/$kopts/\n";
7d90095a 1288 }
3fda8c4c
ML
1289 }
1290 else
1291 {
1292 $log->warn("Merge failed");
1293 next;
1294 }
1295
7d90095a
MS
1296 # Don't want to actually _DO_ the update if -n specified
1297 unless ( $state->{globaloptions}{-n} )
1298 {
1299 # permissions
1300 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1301 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1302
1303 # transmit file, format is single integer on a line by itself (file
1304 # size) followed by the file contents
1305 # TODO : we should copy files in blocks
044182ef 1306 my $data = `cat $mergedFile`;
7d90095a
MS
1307 $log->debug("File size : " . length($data));
1308 print length($data) . "\n";
1309 print $data;
1310 }
3fda8c4c
ML
1311 }
1312
1313 }
1314
1315 print "ok\n";
1316}
1317
1318sub req_ci
1319{
1320 my ( $cmd, $data ) = @_;
1321
1322 argsplit("ci");
1323
1324 #$log->debug("State : " . Dumper($state));
1325
1326 $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1327
031a027a 1328 if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
91a6bf46 1329 {
031a027a 1330 print "error 1 anonymous user cannot commit via pserver\n";
044182ef 1331 cleanupWorkTree();
91a6bf46
ML
1332 exit;
1333 }
1334
3fda8c4c
ML
1335 if ( -e $state->{CVSROOT} . "/index" )
1336 {
568907f5 1337 $log->warn("file 'index' already exists in the git repository");
3fda8c4c 1338 print "error 1 Index already exists in git repo\n";
044182ef 1339 cleanupWorkTree();
3fda8c4c
ML
1340 exit;
1341 }
1342
3fda8c4c
ML
1343 # Grab a handle to the SQLite db and do any necessary updates
1344 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1345 $updater->update();
1346
ada5ef3b
JH
1347 # Remember where the head was at the beginning.
1348 my $parenthash = `git show-ref -s refs/heads/$state->{module}`;
1349 chomp $parenthash;
1350 if ($parenthash !~ /^[0-9a-f]{40}$/) {
1351 print "error 1 pserver cannot find the current HEAD of module";
044182ef 1352 cleanupWorkTree();
ada5ef3b
JH
1353 exit;
1354 }
1355
044182ef 1356 setupWorkTree($parenthash);
3fda8c4c 1357
044182ef
MO
1358 $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
1359
1360 $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
3fda8c4c 1361
3fda8c4c 1362 my @committedfiles = ();
392e2817 1363 my %oldmeta;
3fda8c4c 1364
addf88e4 1365 # foreach file specified on the command line ...
3fda8c4c
ML
1366 foreach my $filename ( @{$state->{args}} )
1367 {
7d90095a 1368 my $committedfile = $filename;
3fda8c4c
ML
1369 $filename = filecleanup($filename);
1370
1371 next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1372
1373 my $meta = $updater->getmeta($filename);
392e2817 1374 $oldmeta{$filename} = $meta;
3fda8c4c
ML
1375
1376 my $wrev = revparse($filename);
1377
1378 my ( $filepart, $dirpart ) = filenamesplit($filename);
1379
cdf63284 1380 # do a checkout of the file if it is part of this tree
3fda8c4c 1381 if ($wrev) {
d2feb01a 1382 system('git', 'checkout-index', '-f', '-u', $filename);
3fda8c4c
ML
1383 unless ($? == 0) {
1384 die "Error running git-checkout-index -f -u $filename : $!";
1385 }
1386 }
1387
1388 my $addflag = 0;
1389 my $rmflag = 0;
1390 $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1391 $addflag = 1 unless ( -e $filename );
1392
1393 # Do up to date checking
1394 unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
1395 {
1396 # fail everything if an up to date check fails
1397 print "error 1 Up to date check failed for $filename\n";
044182ef 1398 cleanupWorkTree();
3fda8c4c
ML
1399 exit;
1400 }
1401
7d90095a 1402 push @committedfiles, $committedfile;
3fda8c4c
ML
1403 $log->info("Committing $filename");
1404
1405 system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1406
1407 unless ( $rmflag )
1408 {
1409 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1410 rename $state->{entries}{$filename}{modified_filename},$filename;
1411
1412 # Calculate modes to remove
1413 my $invmode = "";
1414 foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1415
1416 $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1417 system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1418 }
1419
1420 if ( $rmflag )
1421 {
1422 $log->info("Removing file '$filename'");
1423 unlink($filename);
d2feb01a 1424 system("git", "update-index", "--remove", $filename);
3fda8c4c
ML
1425 }
1426 elsif ( $addflag )
1427 {
1428 $log->info("Adding file '$filename'");
d2feb01a 1429 system("git", "update-index", "--add", $filename);
3fda8c4c
ML
1430 } else {
1431 $log->info("Updating file '$filename'");
d2feb01a 1432 system("git", "update-index", $filename);
3fda8c4c
ML
1433 }
1434 }
1435
1436 unless ( scalar(@committedfiles) > 0 )
1437 {
1438 print "E No files to commit\n";
1439 print "ok\n";
044182ef 1440 cleanupWorkTree();
3fda8c4c
ML
1441 return;
1442 }
1443
d2feb01a 1444 my $treehash = `git write-tree`;
3fda8c4c 1445 chomp $treehash;
3fda8c4c
ML
1446
1447 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1448
1449 # write our commit message out if we have one ...
1450 my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1451 print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
280514e1
FE
1452 if ( defined ( $cfg->{gitcvs}{commitmsgannotation} ) ) {
1453 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/ ) {
1454 print $msg_fh "\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"
1455 }
1456 } else {
1457 print $msg_fh "\n\nvia git-CVS emulator\n";
1458 }
3fda8c4c
ML
1459 close $msg_fh;
1460
d2feb01a 1461 my $commithash = `git commit-tree $treehash -p $parenthash < $msg_filename`;
1872adab 1462 chomp($commithash);
3fda8c4c
ML
1463 $log->info("Commit hash : $commithash");
1464
1465 unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1466 {
1467 $log->warn("Commit failed (Invalid commit hash)");
1468 print "error 1 Commit failed (unknown reason)\n";
044182ef 1469 cleanupWorkTree();
3fda8c4c
ML
1470 exit;
1471 }
1472
cdf63284
MW
1473 ### Emulate git-receive-pack by running hooks/update
1474 my @hook = ( $ENV{GIT_DIR}.'hooks/update', "refs/heads/$state->{module}",
b2741f63 1475 $parenthash, $commithash );
cdf63284
MW
1476 if( -x $hook[0] ) {
1477 unless( system( @hook ) == 0 )
b2741f63
AP
1478 {
1479 $log->warn("Commit failed (update hook declined to update ref)");
1480 print "error 1 Commit failed (update hook declined)\n";
044182ef 1481 cleanupWorkTree();
b2741f63
AP
1482 exit;
1483 }
1484 }
1485
cdf63284 1486 ### Update the ref
ada5ef3b
JH
1487 if (system(qw(git update-ref -m), "cvsserver ci",
1488 "refs/heads/$state->{module}", $commithash, $parenthash)) {
1489 $log->warn("update-ref for $state->{module} failed.");
1490 print "error 1 Cannot commit -- update first\n";
044182ef 1491 cleanupWorkTree();
ada5ef3b
JH
1492 exit;
1493 }
3fda8c4c 1494
cdf63284
MW
1495 ### Emulate git-receive-pack by running hooks/post-receive
1496 my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
1497 if( -x $hook ) {
1498 open(my $pipe, "| $hook") || die "can't fork $!";
1499
1500 local $SIG{PIPE} = sub { die 'pipe broke' };
1501
1502 print $pipe "$parenthash $commithash refs/heads/$state->{module}\n";
1503
1504 close $pipe || die "bad pipe: $! $?";
1505 }
1506
ad8c3477
SK
1507 $updater->update();
1508
394d66d4
JH
1509 ### Then hooks/post-update
1510 $hook = $ENV{GIT_DIR}.'hooks/post-update';
1511 if (-x $hook) {
1512 system($hook, "refs/heads/$state->{module}");
1513 }
1514
addf88e4 1515 # foreach file specified on the command line ...
3fda8c4c
ML
1516 foreach my $filename ( @committedfiles )
1517 {
1518 $filename = filecleanup($filename);
1519
1520 my $meta = $updater->getmeta($filename);
3486595b
ML
1521 unless (defined $meta->{revision}) {
1522 $meta->{revision} = 1;
1523 }
3fda8c4c 1524
7d90095a 1525 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
3fda8c4c
ML
1526
1527 $log->debug("Checked-in $dirpart : $filename");
1528
392e2817 1529 print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
3486595b 1530 if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
3fda8c4c 1531 {
392e2817 1532 print "M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";
3fda8c4c
ML
1533 print "Remove-entry $dirpart\n";
1534 print "$filename\n";
1535 } else {
459bad77
FL
1536 if ($meta->{revision} == 1) {
1537 print "M initial revision: 1.1\n";
1538 } else {
392e2817 1539 print "M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";
459bad77 1540 }
3fda8c4c
ML
1541 print "Checked-in $dirpart\n";
1542 print "$filename\n";
90948a42 1543 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
8538e876 1544 print "/$filepart/1.$meta->{revision}//$kopts/\n";
3fda8c4c
ML
1545 }
1546 }
1547
044182ef 1548 cleanupWorkTree();
3fda8c4c
ML
1549 print "ok\n";
1550}
1551
1552sub req_status
1553{
1554 my ( $cmd, $data ) = @_;
1555
1556 argsplit("status");
1557
1558 $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1559 #$log->debug("status state : " . Dumper($state));
1560
1561 # Grab a handle to the SQLite db and do any necessary updates
1562 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1563 $updater->update();
1564
1565 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1566 argsfromdir($updater);
3fda8c4c 1567
addf88e4 1568 # foreach file specified on the command line ...
3fda8c4c
ML
1569 foreach my $filename ( @{$state->{args}} )
1570 {
1571 $filename = filecleanup($filename);
1572
852b921c
DD
1573 next if exists($state->{opt}{l}) && index($filename, '/', length($state->{prependdir})) >= 0;
1574
3fda8c4c
ML
1575 my $meta = $updater->getmeta($filename);
1576 my $oldmeta = $meta;
1577
1578 my $wrev = revparse($filename);
1579
1580 # If the working copy is an old revision, lets get that version too for comparison.
1581 if ( defined($wrev) and $wrev != $meta->{revision} )
1582 {
1583 $oldmeta = $updater->getmeta($filename, $wrev);
1584 }
1585
1586 # TODO : All possible statuses aren't yet implemented
1587 my $status;
1588 # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1589 $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1590 and
1591 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1592 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1593 );
1594
1595 # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1596 $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1597 and
1598 ( $state->{entries}{$filename}{unchanged}
1599 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1600 );
1601
1602 # Need checkout if it exists in the repo but doesn't have a working copy
1603 $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1604
1605 # Locally modified if working copy and repo copy have the same revision but there are local changes
1606 $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1607
1608 # Needs Merge if working copy revision is less than repo copy and there are local changes
1609 $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1610
1611 $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1612 $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1613 $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1614 $status ||= "File had conflicts on merge" if ( 0 );
1615
1616 $status ||= "Unknown";
1617
23b7180f
DD
1618 my ($filepart) = filenamesplit($filename);
1619
3fda8c4c 1620 print "M ===================================================================\n";
23b7180f 1621 print "M File: $filepart\tStatus: $status\n";
3fda8c4c
ML
1622 if ( defined($state->{entries}{$filename}{revision}) )
1623 {
1624 print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1625 } else {
1626 print "M Working revision:\tNo entry for $filename\n";
1627 }
1628 if ( defined($meta->{revision}) )
1629 {
392e2817 1630 print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
3fda8c4c
ML
1631 print "M Sticky Tag:\t\t(none)\n";
1632 print "M Sticky Date:\t\t(none)\n";
1633 print "M Sticky Options:\t\t(none)\n";
1634 } else {
1635 print "M Repository revision:\tNo revision control file\n";
1636 }
1637 print "M\n";
1638 }
1639
1640 print "ok\n";
1641}
1642
1643sub req_diff
1644{
1645 my ( $cmd, $data ) = @_;
1646
1647 argsplit("diff");
1648
1649 $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1650 #$log->debug("status state : " . Dumper($state));
1651
1652 my ($revision1, $revision2);
1653 if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1654 {
1655 $revision1 = $state->{opt}{r}[0];
1656 $revision2 = $state->{opt}{r}[1];
1657 } else {
1658 $revision1 = $state->{opt}{r};
1659 }
1660
1661 $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1662 $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1663
1664 $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1665
1666 # Grab a handle to the SQLite db and do any necessary updates
1667 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1668 $updater->update();
1669
1670 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1671 argsfromdir($updater);
3fda8c4c 1672
addf88e4 1673 # foreach file specified on the command line ...
3fda8c4c
ML
1674 foreach my $filename ( @{$state->{args}} )
1675 {
1676 $filename = filecleanup($filename);
1677
1678 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1679
1680 my $wrev = revparse($filename);
1681
1682 # We need _something_ to diff against
1683 next unless ( defined ( $wrev ) );
1684
1685 # if we have a -r switch, use it
1686 if ( defined ( $revision1 ) )
1687 {
1688 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1689 $meta1 = $updater->getmeta($filename, $revision1);
1690 unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1691 {
1692 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1693 next;
1694 }
e78f69a3 1695 transmitfile($meta1->{filehash}, { targetfile => $file1 });
3fda8c4c
ML
1696 }
1697 # otherwise we just use the working copy revision
1698 else
1699 {
1700 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1701 $meta1 = $updater->getmeta($filename, $wrev);
e78f69a3 1702 transmitfile($meta1->{filehash}, { targetfile => $file1 });
3fda8c4c
ML
1703 }
1704
1705 # if we have a second -r switch, use it too
1706 if ( defined ( $revision2 ) )
1707 {
1708 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1709 $meta2 = $updater->getmeta($filename, $revision2);
1710
1711 unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1712 {
1713 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1714 next;
1715 }
1716
e78f69a3 1717 transmitfile($meta2->{filehash}, { targetfile => $file2 });
3fda8c4c
ML
1718 }
1719 # otherwise we just use the working copy
1720 else
1721 {
1722 $file2 = $state->{entries}{$filename}{modified_filename};
1723 }
1724
1725 # if we have been given -r, and we don't have a $file2 yet, lets get one
1726 if ( defined ( $revision1 ) and not defined ( $file2 ) )
1727 {
1728 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1729 $meta2 = $updater->getmeta($filename, $wrev);
e78f69a3 1730 transmitfile($meta2->{filehash}, { targetfile => $file2 });
3fda8c4c
ML
1731 }
1732
1733 # We need to have retrieved something useful
1734 next unless ( defined ( $meta1 ) );
1735
1736 # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1737 next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1738 and
1739 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1740 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1741 );
1742
1743 # Apparently we only show diffs for locally modified files
1744 next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1745
1746 print "M Index: $filename\n";
1747 print "M ===================================================================\n";
1748 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1749 print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1750 print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1751 print "M diff ";
1752 foreach my $opt ( keys %{$state->{opt}} )
1753 {
1754 if ( ref $state->{opt}{$opt} eq "ARRAY" )
1755 {
1756 foreach my $value ( @{$state->{opt}{$opt}} )
1757 {
1758 print "-$opt $value ";
1759 }
1760 } else {
1761 print "-$opt ";
1762 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1763 }
1764 }
1765 print "$filename\n";
1766
1767 $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1768
1769 ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1770
1771 if ( exists $state->{opt}{u} )
1772 {
1773 system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1774 } else {
1775 system("diff $file1 $file2 > $filediff");
1776 }
1777
1778 while ( <$fh> )
1779 {
1780 print "M $_";
1781 }
1782 close $fh;
1783 }
1784
1785 print "ok\n";
1786}
1787
1788sub req_log
1789{
1790 my ( $cmd, $data ) = @_;
1791
1792 argsplit("log");
1793
1794 $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1795 #$log->debug("log state : " . Dumper($state));
1796
1797 my ( $minrev, $maxrev );
1798 if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1799 {
1800 my $control = $2;
1801 $minrev = $1;
1802 $maxrev = $3;
1803 $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1804 $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1805 $minrev++ if ( defined($minrev) and $control eq "::" );
1806 }
1807
1808 # Grab a handle to the SQLite db and do any necessary updates
1809 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1810 $updater->update();
1811
1812 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1813 argsfromdir($updater);
3fda8c4c 1814
addf88e4 1815 # foreach file specified on the command line ...
3fda8c4c
ML
1816 foreach my $filename ( @{$state->{args}} )
1817 {
1818 $filename = filecleanup($filename);
1819
1820 my $headmeta = $updater->getmeta($filename);
1821
1822 my $revisions = $updater->getlog($filename);
1823 my $totalrevisions = scalar(@$revisions);
1824
1825 if ( defined ( $minrev ) )
1826 {
1827 $log->debug("Removing revisions less than $minrev");
1828 while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1829 {
1830 pop @$revisions;
1831 }
1832 }
1833 if ( defined ( $maxrev ) )
1834 {
1835 $log->debug("Removing revisions greater than $maxrev");
1836 while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1837 {
1838 shift @$revisions;
1839 }
1840 }
1841
1842 next unless ( scalar(@$revisions) );
1843
1844 print "M \n";
1845 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1846 print "M Working file: $filename\n";
1847 print "M head: 1.$headmeta->{revision}\n";
1848 print "M branch:\n";
1849 print "M locks: strict\n";
1850 print "M access list:\n";
1851 print "M symbolic names:\n";
1852 print "M keyword substitution: kv\n";
1853 print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1854 print "M description:\n";
1855
1856 foreach my $revision ( @$revisions )
1857 {
1858 print "M ----------------------------\n";
1859 print "M revision 1.$revision->{revision}\n";
1860 # reformat the date for log output
1861 $revision->{modified} = sprintf('%04d/%02d/%02d %s', $3, $DATE_LIST->{$2}, $1, $4 ) if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and defined($DATE_LIST->{$2}) );
c1bc3061 1862 $revision->{author} = cvs_author($revision->{author});
3fda8c4c
ML
1863 print "M date: $revision->{modified}; author: $revision->{author}; state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . "; lines: +2 -3\n";
1864 my $commitmessage = $updater->commitmessage($revision->{commithash});
1865 $commitmessage =~ s/^/M /mg;
1866 print $commitmessage . "\n";
1867 }
1868 print "M =============================================================================\n";
1869 }
1870
1871 print "ok\n";
1872}
1873
1874sub req_annotate
1875{
1876 my ( $cmd, $data ) = @_;
1877
1878 argsplit("annotate");
1879
1880 $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1881 #$log->debug("status state : " . Dumper($state));
1882
1883 # Grab a handle to the SQLite db and do any necessary updates
1884 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1885 $updater->update();
1886
1887 # if no files were specified, we need to work out what files we should be providing annotate on ...
7d90095a 1888 argsfromdir($updater);
3fda8c4c
ML
1889
1890 # we'll need a temporary checkout dir
044182ef 1891 setupWorkTree();
3fda8c4c 1892
044182ef 1893 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
3fda8c4c 1894
addf88e4 1895 # foreach file specified on the command line ...
3fda8c4c
ML
1896 foreach my $filename ( @{$state->{args}} )
1897 {
1898 $filename = filecleanup($filename);
1899
1900 my $meta = $updater->getmeta($filename);
1901
1902 next unless ( $meta->{revision} );
1903
1904 # get all the commits that this file was in
1905 # in dense format -- aka skip dead revisions
1906 my $revisions = $updater->gethistorydense($filename);
1907 my $lastseenin = $revisions->[0][2];
1908
1909 # populate the temporary index based on the latest commit were we saw
1910 # the file -- but do it cheaply without checking out any files
1911 # TODO: if we got a revision from the client, use that instead
1912 # to look up the commithash in sqlite (still good to default to
1913 # the current head as we do now)
d2feb01a 1914 system("git", "read-tree", $lastseenin);
3fda8c4c
ML
1915 unless ($? == 0)
1916 {
044182ef 1917 print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
a5e40798 1918 return;
3fda8c4c 1919 }
044182ef 1920 $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
3fda8c4c
ML
1921
1922 # do a checkout of the file
d2feb01a 1923 system('git', 'checkout-index', '-f', '-u', $filename);
3fda8c4c 1924 unless ($? == 0) {
a5e40798
JM
1925 print "E error running git-checkout-index -f -u $filename : $!\n";
1926 return;
3fda8c4c
ML
1927 }
1928
1929 $log->info("Annotate $filename");
1930
1931 # Prepare a file with the commits from the linearized
1932 # history that annotate should know about. This prevents
1933 # git-jsannotate telling us about commits we are hiding
1934 # from the client.
1935
044182ef 1936 my $a_hints = "$work->{workDir}/.annotate_hints";
a5e40798
JM
1937 if (!open(ANNOTATEHINTS, '>', $a_hints)) {
1938 print "E failed to open '$a_hints' for writing: $!\n";
1939 return;
1940 }
3fda8c4c
ML
1941 for (my $i=0; $i < @$revisions; $i++)
1942 {
1943 print ANNOTATEHINTS $revisions->[$i][2];
1944 if ($i+1 < @$revisions) { # have we got a parent?
1945 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1946 }
1947 print ANNOTATEHINTS "\n";
1948 }
1949
1950 print ANNOTATEHINTS "\n";
a5e40798
JM
1951 close ANNOTATEHINTS
1952 or (print "E failed to write $a_hints: $!\n"), return;
3fda8c4c 1953
d2feb01a 1954 my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
a5e40798
JM
1955 if (!open(ANNOTATE, "-|", @cmd)) {
1956 print "E error invoking ". join(' ',@cmd) .": $!\n";
1957 return;
1958 }
3fda8c4c
ML
1959 my $metadata = {};
1960 print "E Annotations for $filename\n";
1961 print "E ***************\n";
1962 while ( <ANNOTATE> )
1963 {
1964 if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1965 {
1966 my $commithash = $1;
1967 my $data = $2;
1968 unless ( defined ( $metadata->{$commithash} ) )
1969 {
1970 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
c1bc3061 1971 $metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
3fda8c4c
ML
1972 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1973 }
1974 printf("M 1.%-5d (%-8s %10s): %s\n",
1975 $metadata->{$commithash}{revision},
1976 $metadata->{$commithash}{author},
1977 $metadata->{$commithash}{modified},
1978 $data
1979 );
1980 } else {
1981 $log->warn("Error in annotate output! LINE: $_");
1982 print "E Annotate error \n";
1983 next;
1984 }
1985 }
1986 close ANNOTATE;
1987 }
1988
1989 # done; get out of the tempdir
df4b3abc 1990 cleanupWorkTree();
3fda8c4c
ML
1991
1992 print "ok\n";
1993
1994}
1995
1996# This method takes the state->{arguments} array and produces two new arrays.
1997# The first is $state->{args} which is everything before the '--' argument, and
1998# the second is $state->{files} which is everything after it.
1999sub argsplit
2000{
3fda8c4c
ML
2001 $state->{args} = [];
2002 $state->{files} = [];
2003 $state->{opt} = {};
2004
1e76b702
FL
2005 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
2006
2007 my $type = shift;
2008
3fda8c4c
ML
2009 if ( defined($type) )
2010 {
2011 my $opt = {};
2012 $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" );
2013 $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
2014 $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" );
2015 $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
2016 $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
2017 $opt = { k => 1, m => 1 } if ( $type eq "add" );
2018 $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
2019 $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" );
2020
2021
2022 while ( scalar ( @{$state->{arguments}} ) > 0 )
2023 {
2024 my $arg = shift @{$state->{arguments}};
2025
2026 next if ( $arg eq "--" );
2027 next unless ( $arg =~ /\S/ );
2028
2029 # if the argument looks like a switch
2030 if ( $arg =~ /^-(\w)(.*)/ )
2031 {
2032 # if it's a switch that takes an argument
2033 if ( $opt->{$1} )
2034 {
2035 # If this switch has already been provided
2036 if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
2037 {
2038 $state->{opt}{$1} = [ $state->{opt}{$1} ];
2039 if ( length($2) > 0 )
2040 {
2041 push @{$state->{opt}{$1}},$2;
2042 } else {
2043 push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
2044 }
2045 } else {
2046 # if there's extra data in the arg, use that as the argument for the switch
2047 if ( length($2) > 0 )
2048 {
2049 $state->{opt}{$1} = $2;
2050 } else {
2051 $state->{opt}{$1} = shift @{$state->{arguments}};
2052 }
2053 }
2054 } else {
2055 $state->{opt}{$1} = undef;
2056 }
2057 }
2058 else
2059 {
2060 push @{$state->{args}}, $arg;
2061 }
2062 }
2063 }
2064 else
2065 {
2066 my $mode = 0;
2067
2068 foreach my $value ( @{$state->{arguments}} )
2069 {
2070 if ( $value eq "--" )
2071 {
2072 $mode++;
2073 next;
2074 }
2075 push @{$state->{args}}, $value if ( $mode == 0 );
2076 push @{$state->{files}}, $value if ( $mode == 1 );
2077 }
2078 }
2079}
2080
2081# This method uses $state->{directory} to populate $state->{args} with a list of filenames
2082sub argsfromdir
2083{
2084 my $updater = shift;
2085
7d90095a
MS
2086 $state->{args} = [] if ( scalar(@{$state->{args}}) == 1 and $state->{args}[0] eq "." );
2087
82000d74 2088 return if ( scalar ( @{$state->{args}} ) > 1 );
7d90095a 2089
0a7a9a12
JS
2090 my @gethead = @{$updater->gethead};
2091
2092 # push added files
2093 foreach my $file (keys %{$state->{entries}}) {
2094 if ( exists $state->{entries}{$file}{revision} &&
2095 $state->{entries}{$file}{revision} == 0 )
2096 {
2097 push @gethead, { name => $file, filehash => 'added' };
2098 }
2099 }
2100
82000d74
MS
2101 if ( scalar(@{$state->{args}}) == 1 )
2102 {
2103 my $arg = $state->{args}[0];
2104 $arg .= $state->{prependdir} if ( defined ( $state->{prependdir} ) );
7d90095a 2105
82000d74 2106 $log->info("Only one arg specified, checking for directory expansion on '$arg'");
3fda8c4c 2107
0a7a9a12 2108 foreach my $file ( @gethead )
82000d74
MS
2109 {
2110 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
2111 next unless ( $file->{name} =~ /^$arg\// or $file->{name} eq $arg );
2112 push @{$state->{args}}, $file->{name};
2113 }
2114
2115 shift @{$state->{args}} if ( scalar(@{$state->{args}}) > 1 );
2116 } else {
2117 $log->info("Only one arg specified, populating file list automatically");
2118
2119 $state->{args} = [];
2120
0a7a9a12 2121 foreach my $file ( @gethead )
82000d74
MS
2122 {
2123 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
2124 next unless ( $file->{name} =~ s/^$state->{prependdir}// );
2125 push @{$state->{args}}, $file->{name};
2126 }
3fda8c4c
ML
2127 }
2128}
2129
2130# This method cleans up the $state variable after a command that uses arguments has run
2131sub statecleanup
2132{
2133 $state->{files} = [];
2134 $state->{args} = [];
2135 $state->{arguments} = [];
2136 $state->{entries} = {};
2137}
2138
196e48f4
MO
2139# Return working directory revision int "X" from CVS revision "1.X" out
2140# of the the working directory "entries" state, for the given filename.
2141# Return negative "X" to represent the file is scheduled for removal
2142# when it is committed.
3fda8c4c
ML
2143sub revparse
2144{
2145 my $filename = shift;
2146
2147 return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
2148
2149 return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
2150 return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
2151
2152 return undef;
2153}
2154
e78f69a3
DD
2155# This method takes a file hash and does a CVS "file transfer". Its
2156# exact behaviour depends on a second, optional hash table argument:
2157# - If $options->{targetfile}, dump the contents to that file;
2158# - If $options->{print}, use M/MT to transmit the contents one line
2159# at a time;
2160# - Otherwise, transmit the size of the file, followed by the file
2161# contents.
3fda8c4c
ML
2162sub transmitfile
2163{
2164 my $filehash = shift;
e78f69a3 2165 my $options = shift;
3fda8c4c
ML
2166
2167 if ( defined ( $filehash ) and $filehash eq "deleted" )
2168 {
2169 $log->warn("filehash is 'deleted'");
2170 return;
2171 }
2172
2173 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
2174
d2feb01a 2175 my $type = `git cat-file -t $filehash`;
3fda8c4c
ML
2176 chomp $type;
2177
2178 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2179
d2feb01a 2180 my $size = `git cat-file -s $filehash`;
3fda8c4c
ML
2181 chomp $size;
2182
2183 $log->debug("transmitfile($filehash) size=$size, type=$type");
2184
d2feb01a 2185 if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
3fda8c4c 2186 {
e78f69a3 2187 if ( defined ( $options->{targetfile} ) )
3fda8c4c 2188 {
e78f69a3 2189 my $targetfile = $options->{targetfile};
3fda8c4c
ML
2190 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2191 print NEWFILE $_ while ( <$fh> );
a5e40798 2192 close NEWFILE or die("Failed to write '$targetfile': $!");
e78f69a3
DD
2193 } elsif ( defined ( $options->{print} ) && $options->{print} ) {
2194 while ( <$fh> ) {
2195 if( /\n\z/ ) {
2196 print 'M ', $_;
2197 } else {
2198 print 'MT text ', $_, "\n";
2199 }
2200 }
3fda8c4c
ML
2201 } else {
2202 print "$size\n";
2203 print while ( <$fh> );
2204 }
a5e40798 2205 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
3fda8c4c
ML
2206 } else {
2207 die("Couldn't execute git-cat-file");
2208 }
2209}
2210
2211# This method takes a file name, and returns ( $dirpart, $filepart ) which
5348b6e7 2212# refers to the directory portion and the file portion of the filename
3fda8c4c
ML
2213# respectively
2214sub filenamesplit
2215{
2216 my $filename = shift;
7d90095a 2217 my $fixforlocaldir = shift;
3fda8c4c
ML
2218
2219 my ( $filepart, $dirpart ) = ( $filename, "." );
2220 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2221 $dirpart .= "/";
2222
7d90095a
MS
2223 if ( $fixforlocaldir )
2224 {
2225 $dirpart =~ s/^$state->{prependdir}//;
2226 }
2227
3fda8c4c
ML
2228 return ( $filepart, $dirpart );
2229}
2230
2231sub filecleanup
2232{
2233 my $filename = shift;
2234
2235 return undef unless(defined($filename));
2236 if ( $filename =~ /^\// )
2237 {
2238 print "E absolute filenames '$filename' not supported by server\n";
2239 return undef;
2240 }
2241
2242 $filename =~ s/^\.\///g;
82000d74 2243 $filename = $state->{prependdir} . $filename;
3fda8c4c
ML
2244 return $filename;
2245}
2246
044182ef
MO
2247sub validateGitDir
2248{
2249 if( !defined($state->{CVSROOT}) )
2250 {
2251 print "error 1 CVSROOT not specified\n";
2252 cleanupWorkTree();
2253 exit;
2254 }
2255 if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
2256 {
2257 print "error 1 Internally inconsistent CVSROOT\n";
2258 cleanupWorkTree();
2259 exit;
2260 }
2261}
2262
2263# Setup working directory in a work tree with the requested version
2264# loaded in the index.
2265sub setupWorkTree
2266{
2267 my ($ver) = @_;
2268
2269 validateGitDir();
2270
2271 if( ( defined($work->{state}) && $work->{state} != 1 ) ||
2272 defined($work->{tmpDir}) )
2273 {
2274 $log->warn("Bad work tree state management");
2275 print "error 1 Internal setup multiple work trees without cleanup\n";
2276 cleanupWorkTree();
2277 exit;
2278 }
2279
2280 $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
2281
2282 if( !defined($work->{index}) )
2283 {
2284 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2285 }
2286
2287 chdir $work->{workDir} or
2288 die "Unable to chdir to $work->{workDir}\n";
2289
2290 $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
2291
2292 $ENV{GIT_WORK_TREE} = ".";
2293 $ENV{GIT_INDEX_FILE} = $work->{index};
2294 $work->{state} = 2;
2295
2296 if($ver)
2297 {
2298 system("git","read-tree",$ver);
2299 unless ($? == 0)
2300 {
2301 $log->warn("Error running git-read-tree");
2302 die "Error running git-read-tree $ver in $work->{workDir} $!\n";
2303 }
2304 }
2305 # else # req_annotate reads tree for each file
2306}
2307
2308# Ensure current directory is in some kind of working directory,
2309# with a recent version loaded in the index.
2310sub ensureWorkTree
2311{
2312 if( defined($work->{tmpDir}) )
2313 {
2314 $log->warn("Bad work tree state management [ensureWorkTree()]");
2315 print "error 1 Internal setup multiple dirs without cleanup\n";
2316 cleanupWorkTree();
2317 exit;
2318 }
2319 if( $work->{state} )
2320 {
2321 return;
2322 }
2323
2324 validateGitDir();
2325
2326 if( !defined($work->{emptyDir}) )
2327 {
2328 $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
2329 }
2330 chdir $work->{emptyDir} or
2331 die "Unable to chdir to $work->{emptyDir}\n";
2332
2333 my $ver = `git show-ref -s refs/heads/$state->{module}`;
2334 chomp $ver;
2335 if ($ver !~ /^[0-9a-f]{40}$/)
2336 {
2337 $log->warn("Error from git show-ref -s refs/head$state->{module}");
2338 print "error 1 cannot find the current HEAD of module";
2339 cleanupWorkTree();
2340 exit;
2341 }
2342
2343 if( !defined($work->{index}) )
2344 {
2345 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2346 }
2347
2348 $ENV{GIT_WORK_TREE} = ".";
2349 $ENV{GIT_INDEX_FILE} = $work->{index};
2350 $work->{state} = 1;
2351
2352 system("git","read-tree",$ver);
2353 unless ($? == 0)
2354 {
2355 die "Error running git-read-tree $ver $!\n";
2356 }
2357}
2358
2359# Cleanup working directory that is not needed any longer.
2360sub cleanupWorkTree
2361{
2362 if( ! $work->{state} )
2363 {
2364 return;
2365 }
2366
2367 chdir "/" or die "Unable to chdir '/'\n";
2368
2369 if( defined($work->{workDir}) )
2370 {
2371 rmtree( $work->{workDir} );
2372 undef $work->{workDir};
2373 }
2374 undef $work->{state};
2375}
2376
2377# Setup a temporary directory (not a working tree), typically for
2378# merging dirty state as in req_update.
2379sub setupTmpDir
2380{
2381 $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
2382 chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
2383
2384 return $work->{tmpDir};
2385}
2386
2387# Clean up a previously setupTmpDir. Restore previous work tree if
2388# appropriate.
2389sub cleanupTmpDir
2390{
2391 if ( !defined($work->{tmpDir}) )
2392 {
2393 $log->warn("cleanup tmpdir that has not been setup");
2394 die "Cleanup tmpDir that has not been setup\n";
2395 }
2396 if( defined($work->{state}) )
2397 {
2398 if( $work->{state} == 1 )
2399 {
2400 chdir $work->{emptyDir} or
2401 die "Unable to chdir to $work->{emptyDir}\n";
2402 }
2403 elsif( $work->{state} == 2 )
2404 {
2405 chdir $work->{workDir} or
2406 die "Unable to chdir to $work->{emptyDir}\n";
2407 }
2408 else
2409 {
2410 $log->warn("Inconsistent work dir state");
2411 die "Inconsistent work dir state\n";
2412 }
2413 }
2414 else
2415 {
2416 chdir "/" or die "Unable to chdir '/'\n";
2417 }
2418}
2419
8538e876
AP
2420# Given a path, this function returns a string containing the kopts
2421# that should go into that path's Entries line. For example, a binary
2422# file should get -kb.
2423sub kopts_from_path
2424{
90948a42 2425 my ($path, $srcType, $name) = @_;
8538e876 2426
8a06a632
MO
2427 if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
2428 $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
2429 {
5ec3e670
EB
2430 my ($val) = check_attr( "text", $path );
2431 if ( $val eq "unspecified" )
8a06a632 2432 {
5ec3e670 2433 $val = check_attr( "crlf", $path );
8a06a632 2434 }
5ec3e670 2435 if ( $val eq "unset" )
8a06a632
MO
2436 {
2437 return "-kb"
2438 }
5ec3e670
EB
2439 elsif ( check_attr( "eol", $path ) ne "unspecified" ||
2440 $val eq "set" || $val eq "input" )
2441 {
2442 return "";
2443 }
8a06a632
MO
2444 else
2445 {
2446 $log->info("Unrecognized check_attr crlf $path : $val");
2447 }
2448 }
8538e876 2449
90948a42 2450 if ( defined ( $cfg->{gitcvs}{allbinary} ) )
8538e876 2451 {
90948a42
MO
2452 if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
2453 {
2454 return "-kb";
2455 }
2456 elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
2457 {
39b6a4bd 2458 if( is_binary($srcType,$name) )
90948a42 2459 {
39b6a4bd
MO
2460 $log->debug("... as binary");
2461 return "-kb";
90948a42
MO
2462 }
2463 else
2464 {
39b6a4bd 2465 $log->debug("... as text");
90948a42
MO
2466 }
2467 }
8538e876 2468 }
90948a42
MO
2469 # Return "" to give no special treatment to any path
2470 return "";
8538e876
AP
2471}
2472
8a06a632
MO
2473sub check_attr
2474{
2475 my ($attr,$path) = @_;
2476 ensureWorkTree();
2477 if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
2478 {
2479 my $val = <$fh>;
2480 close $fh;
2481 $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
2482 return $val;
2483 }
2484 else
2485 {
2486 return undef;
2487 }
2488}
2489
90948a42
MO
2490# This should have the same heuristics as convert.c:is_binary() and related.
2491# Note that the bare CR test is done by callers in convert.c.
2492sub is_binary
2493{
2494 my ($srcType,$name) = @_;
2495 $log->debug("is_binary($srcType,$name)");
2496
2497 # Minimize amount of interpreted code run in the inner per-character
2498 # loop for large files, by totalling each character value and
2499 # then analyzing the totals.
2500 my @counts;
2501 my $i;
2502 for($i=0;$i<256;$i++)
2503 {
2504 $counts[$i]=0;
2505 }
2506
2507 my $fh = open_blob_or_die($srcType,$name);
2508 my $line;
2509 while( defined($line=<$fh>) )
2510 {
2511 # Any '\0' and bare CR are considered binary.
2512 if( $line =~ /\0|(\r[^\n])/ )
2513 {
2514 close($fh);
2515 return 1;
2516 }
2517
2518 # Count up each character in the line:
2519 my $len=length($line);
2520 for($i=0;$i<$len;$i++)
2521 {
2522 $counts[ord(substr($line,$i,1))]++;
2523 }
2524 }
2525 close $fh;
2526
2527 # Don't count CR and LF as either printable/nonprintable
2528 $counts[ord("\n")]=0;
2529 $counts[ord("\r")]=0;
2530
2531 # Categorize individual character count into printable and nonprintable:
2532 my $printable=0;
2533 my $nonprintable=0;
2534 for($i=0;$i<256;$i++)
2535 {
2536 if( $i < 32 &&
2537 $i != ord("\b") &&
2538 $i != ord("\t") &&
2539 $i != 033 && # ESC
2540 $i != 014 ) # FF
2541 {
2542 $nonprintable+=$counts[$i];
2543 }
2544 elsif( $i==127 ) # DEL
2545 {
2546 $nonprintable+=$counts[$i];
2547 }
2548 else
2549 {
2550 $printable+=$counts[$i];
2551 }
2552 }
2553
2554 return ($printable >> 7) < $nonprintable;
2555}
2556
2557# Returns open file handle. Possible invocations:
2558# - open_blob_or_die("file",$filename);
2559# - open_blob_or_die("sha1",$filehash);
2560sub open_blob_or_die
2561{
2562 my ($srcType,$name) = @_;
2563 my ($fh);
2564 if( $srcType eq "file" )
2565 {
2566 if( !open $fh,"<",$name )
2567 {
2568 $log->warn("Unable to open file $name: $!");
2569 die "Unable to open file $name: $!\n";
2570 }
2571 }
39b6a4bd 2572 elsif( $srcType eq "sha1" )
90948a42
MO
2573 {
2574 unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{40}$/ )
2575 {
2576 $log->warn("Need filehash");
2577 die "Need filehash\n";
2578 }
2579
2580 my $type = `git cat-file -t $name`;
2581 chomp $type;
2582
2583 unless ( defined ( $type ) and $type eq "blob" )
2584 {
2585 $log->warn("Invalid type '$type' for '$name'");
2586 die ( "Invalid type '$type' (expected 'blob')" )
2587 }
2588
2589 my $size = `git cat-file -s $name`;
2590 chomp $size;
2591
2592 $log->debug("open_blob_or_die($name) size=$size, type=$type");
2593
2594 unless( open $fh, '-|', "git", "cat-file", "blob", $name )
2595 {
2596 $log->warn("Unable to open sha1 $name");
2597 die "Unable to open sha1 $name\n";
2598 }
2599 }
2600 else
2601 {
2602 $log->warn("Unknown type of blob source: $srcType");
2603 die "Unknown type of blob source: $srcType\n";
2604 }
2605 return $fh;
2606}
2607
d500a1ee
FE
2608# Generate a CVS author name from Git author information, by taking the local
2609# part of the email address and replacing characters not in the Portable
2610# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS
2611# Login names are Unix login names, which should be restricted to this
2612# character set.
c1bc3061
DD
2613sub cvs_author
2614{
2615 my $author_line = shift;
d500a1ee
FE
2616 (my $author) = $author_line =~ /<([^@>]*)/;
2617
2618 $author =~ s/[^-a-zA-Z0-9_.]/_/g;
2619 $author =~ s/^-/_/;
c1bc3061
DD
2620
2621 $author;
2622}
2623
031a027a
ÆAB
2624
2625sub descramble
2626{
2627 # This table is from src/scramble.c in the CVS source
2628 my @SHIFTS = (
2629 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
2630 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
2631 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
2632 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
2633 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
2634 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
2635 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
2636 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
2637 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
2638 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
2639 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
2640 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
2641 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
2642 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
2643 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
2644 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
2645 );
2646 my ($str) = @_;
2647
fce338a5 2648 # This should never happen, the same password format (A) has been
031a027a 2649 # used by CVS since the beginning of time
1f0eb513
ÆAB
2650 {
2651 my $fmt = substr($str, 0, 1);
2652 die "invalid password format `$fmt'" unless $fmt eq 'A';
2653 }
031a027a
ÆAB
2654
2655 my @str = unpack "C*", substr($str, 1);
2656 my $ret = join '', map { chr $SHIFTS[$_] } @str;
2657 return $ret;
2658}
2659
2660
3fda8c4c
ML
2661package GITCVS::log;
2662
2663####
2664#### Copyright The Open University UK - 2006.
2665####
2666#### Authors: Martyn Smith <martyn@catalyst.net.nz>
adc3192e 2667#### Martin Langhoff <martin@laptop.org>
3fda8c4c
ML
2668####
2669####
2670
2671use strict;
2672use warnings;
2673
2674=head1 NAME
2675
2676GITCVS::log
2677
2678=head1 DESCRIPTION
2679
2680This module provides very crude logging with a similar interface to
2681Log::Log4perl
2682
2683=head1 METHODS
2684
2685=cut
2686
2687=head2 new
2688
2689Creates a new log object, optionally you can specify a filename here to
5348b6e7 2690indicate the file to log to. If no log file is specified, you can specify one
3fda8c4c
ML
2691later with method setfile, or indicate you no longer want logging with method
2692nofile.
2693
2694Until one of these methods is called, all log calls will buffer messages ready
2695to write out.
2696
2697=cut
2698sub new
2699{
2700 my $class = shift;
2701 my $filename = shift;
2702
2703 my $self = {};
2704
2705 bless $self, $class;
2706
2707 if ( defined ( $filename ) )
2708 {
2709 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
2710 }
2711
2712 return $self;
2713}
2714
2715=head2 setfile
2716
2717This methods takes a filename, and attempts to open that file as the log file.
2718If successful, all buffered data is written out to the file, and any further
2719logging is written directly to the file.
2720
2721=cut
2722sub setfile
2723{
2724 my $self = shift;
2725 my $filename = shift;
2726
2727 if ( defined ( $filename ) )
2728 {
2729 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
2730 }
2731
2732 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
2733
2734 while ( my $line = shift @{$self->{buffer}} )
2735 {
2736 print {$self->{fh}} $line;
2737 }
2738}
2739
2740=head2 nofile
2741
2742This method indicates no logging is going to be used. It flushes any entries in
2743the internal buffer, and sets a flag to ensure no further data is put there.
2744
2745=cut
2746sub nofile
2747{
2748 my $self = shift;
2749
2750 $self->{nolog} = 1;
2751
2752 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
2753
2754 $self->{buffer} = [];
2755}
2756
2757=head2 _logopen
2758
2759Internal method. Returns true if the log file is open, false otherwise.
2760
2761=cut
2762sub _logopen
2763{
2764 my $self = shift;
2765
2766 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
2767 return 0;
2768}
2769
2770=head2 debug info warn fatal
2771
2772These four methods are wrappers to _log. They provide the actual interface for
2773logging data.
2774
2775=cut
2776sub debug { my $self = shift; $self->_log("debug", @_); }
2777sub info { my $self = shift; $self->_log("info" , @_); }
2778sub warn { my $self = shift; $self->_log("warn" , @_); }
2779sub fatal { my $self = shift; $self->_log("fatal", @_); }
2780
2781=head2 _log
2782
2783This is an internal method called by the logging functions. It generates a
2784timestamp and pushes the logged line either to file, or internal buffer.
2785
2786=cut
2787sub _log
2788{
2789 my $self = shift;
2790 my $level = shift;
2791
2792 return if ( $self->{nolog} );
2793
2794 my @time = localtime;
2795 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
2796 $time[5] + 1900,
2797 $time[4] + 1,
2798 $time[3],
2799 $time[2],
2800 $time[1],
2801 $time[0],
2802 uc $level,
2803 );
2804
2805 if ( $self->_logopen )
2806 {
2807 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
2808 } else {
2809 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
2810 }
2811}
2812
2813=head2 DESTROY
2814
2815This method simply closes the file handle if one is open
2816
2817=cut
2818sub DESTROY
2819{
2820 my $self = shift;
2821
2822 if ( $self->_logopen )
2823 {
2824 close $self->{fh};
2825 }
2826}
2827
2828package GITCVS::updater;
2829
2830####
2831#### Copyright The Open University UK - 2006.
2832####
2833#### Authors: Martyn Smith <martyn@catalyst.net.nz>
adc3192e 2834#### Martin Langhoff <martin@laptop.org>
3fda8c4c
ML
2835####
2836####
2837
2838use strict;
2839use warnings;
2840use DBI;
2841
2842=head1 METHODS
2843
2844=cut
2845
2846=head2 new
2847
2848=cut
2849sub new
2850{
2851 my $class = shift;
2852 my $config = shift;
2853 my $module = shift;
2854 my $log = shift;
2855
2856 die "Need to specify a git repository" unless ( defined($config) and -d $config );
2857 die "Need to specify a module" unless ( defined($module) );
2858
2859 $class = ref($class) || $class;
2860
2861 my $self = {};
2862
2863 bless $self, $class;
2864
6aeeffd1
JE
2865 $self->{valid_tables} = {'revision' => 1,
2866 'revision_ix1' => 1,
2867 'revision_ix2' => 1,
2868 'head' => 1,
2869 'head_ix1' => 1,
2870 'properties' => 1,
2871 'commitmsgs' => 1};
2872
3fda8c4c 2873 $self->{module} = $module;
3fda8c4c
ML
2874 $self->{git_path} = $config . "/";
2875
2876 $self->{log} = $log;
2877
2878 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
2879
eb1780d4 2880 $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
473937ed 2881 $cfg->{gitcvs}{dbdriver} || "SQLite";
eb1780d4
FL
2882 $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
2883 $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
2884 $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
2885 $cfg->{gitcvs}{dbuser} || "";
2886 $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
2887 $cfg->{gitcvs}{dbpass} || "";
6aeeffd1
JE
2888 $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
2889 $cfg->{gitcvs}{dbtablenameprefix} || "";
eb1780d4
FL
2890 my %mapping = ( m => $module,
2891 a => $state->{method},
2892 u => getlogin || getpwuid($<) || $<,
2893 G => $self->{git_path},
2894 g => mangle_dirname($self->{git_path}),
2895 );
2896 $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
2897 $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
6aeeffd1
JE
2898 $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
2899 $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
eb1780d4 2900
473937ed
FL
2901 die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
2902 die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
2903 $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
eb1780d4
FL
2904 $self->{dbuser},
2905 $self->{dbpass});
920a449a 2906 die "Error connecting to database\n" unless defined $self->{dbh};
3fda8c4c
ML
2907
2908 $self->{tables} = {};
0cf611a3 2909 foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
3fda8c4c 2910 {
3fda8c4c
ML
2911 $self->{tables}{$table} = 1;
2912 }
2913
2914 # Construct the revision table if required
196e48f4
MO
2915 # The revision table stores an entry for each file, each time that file
2916 # changes.
2917 # numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
2918 # This is not sufficient to support "-r {commithash}" for any
2919 # files except files that were modified by that commit (also,
2920 # some places in the code ignore/effectively strip out -r in
2921 # some cases, before it gets passed to getmeta()).
2922 # The "filehash" field typically has a git blob hash, but can also
2923 # be set to "dead" to indicate that the given version of the file
2924 # should not exist in the sandbox.
6aeeffd1 2925 unless ( $self->{tables}{$self->tablename("revision")} )
3fda8c4c 2926 {
6aeeffd1
JE
2927 my $tablename = $self->tablename("revision");
2928 my $ix1name = $self->tablename("revision_ix1");
2929 my $ix2name = $self->tablename("revision_ix2");
3fda8c4c 2930 $self->{dbh}->do("
6aeeffd1 2931 CREATE TABLE $tablename (
3fda8c4c
ML
2932 name TEXT NOT NULL,
2933 revision INTEGER NOT NULL,
2934 filehash TEXT NOT NULL,
2935 commithash TEXT NOT NULL,
2936 author TEXT NOT NULL,
2937 modified TEXT NOT NULL,
2938 mode TEXT NOT NULL
2939 )
2940 ");
178e015c 2941 $self->{dbh}->do("
6aeeffd1
JE
2942 CREATE INDEX $ix1name
2943 ON $tablename (name,revision)
178e015c
SP
2944 ");
2945 $self->{dbh}->do("
6aeeffd1
JE
2946 CREATE INDEX $ix2name
2947 ON $tablename (name,commithash)
178e015c 2948 ");
3fda8c4c
ML
2949 }
2950
178e015c 2951 # Construct the head table if required
196e48f4
MO
2952 # The head table (along with the "last_commit" entry in the property
2953 # table) is the persisted working state of the "sub update" subroutine.
2954 # All of it's data is read entirely first, and completely recreated
2955 # last, every time "sub update" runs.
2956 # This is also used by "sub getmeta" when it is asked for the latest
2957 # version of a file (as opposed to some specific version).
2958 # Another way of thinking about it is as a single slice out of
2959 # "revisions", giving just the most recent revision information for
2960 # each file.
6aeeffd1 2961 unless ( $self->{tables}{$self->tablename("head")} )
3fda8c4c 2962 {
6aeeffd1
JE
2963 my $tablename = $self->tablename("head");
2964 my $ix1name = $self->tablename("head_ix1");
3fda8c4c 2965 $self->{dbh}->do("
6aeeffd1 2966 CREATE TABLE $tablename (
3fda8c4c
ML
2967 name TEXT NOT NULL,
2968 revision INTEGER NOT NULL,
2969 filehash TEXT NOT NULL,
2970 commithash TEXT NOT NULL,
2971 author TEXT NOT NULL,
2972 modified TEXT NOT NULL,
2973 mode TEXT NOT NULL
2974 )
2975 ");
178e015c 2976 $self->{dbh}->do("
6aeeffd1
JE
2977 CREATE INDEX $ix1name
2978 ON $tablename (name)
178e015c 2979 ");
3fda8c4c
ML
2980 }
2981
2982 # Construct the properties table if required
196e48f4 2983 # - "last_commit" - Used by "sub update".
6aeeffd1 2984 unless ( $self->{tables}{$self->tablename("properties")} )
3fda8c4c 2985 {
6aeeffd1 2986 my $tablename = $self->tablename("properties");
3fda8c4c 2987 $self->{dbh}->do("
6aeeffd1 2988 CREATE TABLE $tablename (
3fda8c4c
ML
2989 key TEXT NOT NULL PRIMARY KEY,
2990 value TEXT
2991 )
2992 ");
2993 }
2994
2995 # Construct the commitmsgs table if required
196e48f4
MO
2996 # The commitmsgs table is only used for merge commits, since
2997 # "sub update" will only keep one branch of parents. Shortlogs
2998 # for ignored commits (i.e. not on the chosen branch) will be used
2999 # to construct a replacement "collapsed" merge commit message,
3000 # which will be stored in this table. See also "sub commitmessage".
6aeeffd1 3001 unless ( $self->{tables}{$self->tablename("commitmsgs")} )
3fda8c4c 3002 {
6aeeffd1 3003 my $tablename = $self->tablename("commitmsgs");
3fda8c4c 3004 $self->{dbh}->do("
6aeeffd1 3005 CREATE TABLE $tablename (
3fda8c4c
ML
3006 key TEXT NOT NULL PRIMARY KEY,
3007 value TEXT
3008 )
3009 ");
3010 }
3011
3012 return $self;
3013}
3014
6aeeffd1
JE
3015=head2 tablename
3016
3017=cut
3018sub tablename
3019{
3020 my $self = shift;
3021 my $name = shift;
3022
3023 if (exists $self->{valid_tables}{$name}) {
3024 return $self->{dbtablenameprefix} . $name;
3025 } else {
3026 return undef;
3027 }
3028}
3029
3fda8c4c
ML
3030=head2 update
3031
196e48f4
MO
3032Bring the database up to date with the latest changes from
3033the git repository.
3034
3035Internal working state is read out of the "head" table and the
3036"last_commit" property, then it updates "revisions" based on that, and
3037finally it writes the new internal state back to the "head" table
3038so it can be used as a starting point the next time update is called.
3039
3fda8c4c
ML
3040=cut
3041sub update
3042{
3043 my $self = shift;
3044
3045 # first lets get the commit list
3046 $ENV{GIT_DIR} = $self->{git_path};
3047
49fb940e
ML
3048 my $commitsha1 = `git rev-parse $self->{module}`;
3049 chomp $commitsha1;
3050
3051 my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
3fda8c4c
ML
3052 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
3053 {
3054 die("Invalid module '$self->{module}'");
3055 }
3056
3057
3058 my $git_log;
3059 my $lastcommit = $self->_get_prop("last_commit");
3060
49fb940e
ML
3061 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
3062 return 1;
3063 }
3064
3fda8c4c
ML
3065 # Start exclusive lock here...
3066 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
3067
3068 # TODO: log processing is memory bound
3069 # if we can parse into a 2nd file that is in reverse order
3070 # we can probably do something really efficient
a248c961 3071 my @git_log_params = ('--pretty', '--parents', '--topo-order');
3fda8c4c
ML
3072
3073 if (defined $lastcommit) {
3074 push @git_log_params, "$lastcommit..$self->{module}";
3075 } else {
3076 push @git_log_params, $self->{module};
3077 }
a248c961 3078 # git-rev-list is the backend / plumbing version of git-log
d2feb01a 3079 open(GITLOG, '-|', 'git', 'rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
3fda8c4c
ML
3080
3081 my @commits;
3082
3083 my %commit = ();
3084
3085 while ( <GITLOG> )
3086 {
3087 chomp;
3088 if (m/^commit\s+(.*)$/) {
3089 # on ^commit lines put the just seen commit in the stack
3090 # and prime things for the next one
3091 if (keys %commit) {
3092 my %copy = %commit;
3093 unshift @commits, \%copy;
3094 %commit = ();
3095 }
3096 my @parents = split(m/\s+/, $1);
3097 $commit{hash} = shift @parents;
3098 $commit{parents} = \@parents;
3099 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
3100 # on rfc822-like lines seen before we see any message,
3101 # lowercase the entry and put it in the hash as key-value
3102 $commit{lc($1)} = $2;
3103 } else {
3104 # message lines - skip initial empty line
3105 # and trim whitespace
3106 if (!exists($commit{message}) && m/^\s*$/) {
3107 # define it to mark the end of headers
3108 $commit{message} = '';
3109 next;
3110 }
3111 s/^\s+//; s/\s+$//; # trim ws
3112 $commit{message} .= $_ . "\n";
3113 }
3114 }
3115 close GITLOG;
3116
3117 unshift @commits, \%commit if ( keys %commit );
3118
3119 # Now all the commits are in the @commits bucket
3120 # ordered by time DESC. for each commit that needs processing,
3121 # determine whether it's following the last head we've seen or if
3122 # it's on its own branch, grab a file list, and add whatever's changed
3123 # NOTE: $lastcommit refers to the last commit from previous run
3124 # $lastpicked is the last commit we picked in this run
3125 my $lastpicked;
3126 my $head = {};
3127 if (defined $lastcommit) {
3128 $lastpicked = $lastcommit;
3129 }
3130
3131 my $committotal = scalar(@commits);
3132 my $commitcount = 0;
3133
3134 # Load the head table into $head (for cached lookups during the update process)
3135 foreach my $file ( @{$self->gethead()} )
3136 {
3137 $head->{$file->{name}} = $file;
3138 }
3139
3140 foreach my $commit ( @commits )
3141 {
3142 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
3143 if (defined $lastpicked)
3144 {
3145 if (!in_array($lastpicked, @{$commit->{parents}}))
3146 {
3147 # skip, we'll see this delta
3148 # as part of a merge later
3149 # warn "skipping off-track $commit->{hash}\n";
3150 next;
3151 } elsif (@{$commit->{parents}} > 1) {
3152 # it is a merge commit, for each parent that is
196e48f4
MO
3153 # not $lastpicked (not given a CVS revision number),
3154 # see if we can get a log
3fda8c4c
ML
3155 # from the merge-base to that parent to put it
3156 # in the message as a merge summary.
3157 my @parents = @{$commit->{parents}};
3158 foreach my $parent (@parents) {
3fda8c4c
ML
3159 if ($parent eq $lastpicked) {
3160 next;
3161 }
196e48f4
MO
3162 # git-merge-base can potentially (but rarely) throw
3163 # several candidate merge bases. let's assume
3164 # that the first one is the best one.
e509db99 3165 my $base = eval {
d2feb01a 3166 safe_pipe_capture('git', 'merge-base',
a5e40798 3167 $lastpicked, $parent);
e509db99
SP
3168 };
3169 # The two branches may not be related at all,
3170 # in which case merge base simply fails to find
3171 # any, but that's Ok.
3172 next if ($@);
3173
3fda8c4c
ML
3174 chomp $base;
3175 if ($base) {
3176 my @merged;
3177 # print "want to log between $base $parent \n";
d2feb01a 3178 open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
a5e40798 3179 or die "Cannot call git-log: $!";
3fda8c4c
ML
3180 my $mergedhash;
3181 while (<GITLOG>) {
3182 chomp;
3183 if (!defined $mergedhash) {
3184 if (m/^commit\s+(.+)$/) {
3185 $mergedhash = $1;
3186 } else {
3187 next;
3188 }
3189 } else {
3190 # grab the first line that looks non-rfc822
3191 # aka has content after leading space
3192 if (m/^\s+(\S.*)$/) {
3193 my $title = $1;
3194 $title = substr($title,0,100); # truncate
3195 unshift @merged, "$mergedhash $title";
3196 undef $mergedhash;
3197 }
3198 }
3199 }
3200 close GITLOG;
3201 if (@merged) {
3202 $commit->{mergemsg} = $commit->{message};
3203 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
3204 foreach my $summary (@merged) {
3205 $commit->{mergemsg} .= "\t$summary\n";
3206 }
3207 $commit->{mergemsg} .= "\n\n";
3208 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
3209 }
3210 }
3211 }
3212 }
3213 }
3214
3215 # convert the date to CVS-happy format
3216 $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
3217
3218 if ( defined ( $lastpicked ) )
3219 {
d2feb01a 3220 my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
e02cd638 3221 local ($/) = "\0";
3fda8c4c
ML
3222 while ( <FILELIST> )
3223 {
e02cd638
JH
3224 chomp;
3225 unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o )
3fda8c4c
ML
3226 {
3227 die("Couldn't process git-diff-tree line : $_");
3228 }
e02cd638
JH
3229 my ($mode, $hash, $change) = ($1, $2, $3);
3230 my $name = <FILELIST>;
3231 chomp($name);
3fda8c4c 3232
e02cd638 3233 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
3fda8c4c
ML
3234
3235 my $git_perms = "";
e02cd638
JH
3236 $git_perms .= "r" if ( $mode & 4 );
3237 $git_perms .= "w" if ( $mode & 2 );
3238 $git_perms .= "x" if ( $mode & 1 );
3fda8c4c
ML
3239 $git_perms = "rw" if ( $git_perms eq "" );
3240
e02cd638 3241 if ( $change eq "D" )
3fda8c4c 3242 {
e02cd638
JH
3243 #$log->debug("DELETE $name");
3244 $head->{$name} = {
3245 name => $name,
3246 revision => $head->{$name}{revision} + 1,
3fda8c4c
ML
3247 filehash => "deleted",
3248 commithash => $commit->{hash},
3249 modified => $commit->{date},
3250 author => $commit->{author},
3251 mode => $git_perms,
3252 };
e02cd638 3253 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c 3254 }
9027efed 3255 elsif ( $change eq "M" || $change eq "T" )
3fda8c4c 3256 {
e02cd638
JH
3257 #$log->debug("MODIFIED $name");
3258 $head->{$name} = {
3259 name => $name,
3260 revision => $head->{$name}{revision} + 1,
3261 filehash => $hash,
3fda8c4c
ML
3262 commithash => $commit->{hash},
3263 modified => $commit->{date},
3264 author => $commit->{author},
3265 mode => $git_perms,
3266 };
e02cd638 3267 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c 3268 }
e02cd638 3269 elsif ( $change eq "A" )
3fda8c4c 3270 {
e02cd638
JH
3271 #$log->debug("ADDED $name");
3272 $head->{$name} = {
3273 name => $name,
a7da9adb 3274 revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
e02cd638 3275 filehash => $hash,
3fda8c4c
ML
3276 commithash => $commit->{hash},
3277 modified => $commit->{date},
3278 author => $commit->{author},
3279 mode => $git_perms,
3280 };
e02cd638 3281 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c
ML
3282 }
3283 else
3284 {
e02cd638 3285 $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
3fda8c4c
ML
3286 die;
3287 }
3288 }
3289 close FILELIST;
3290 } else {
3291 # this is used to detect files removed from the repo
3292 my $seen_files = {};
3293
d2feb01a 3294 my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
e02cd638 3295 local $/ = "\0";
3fda8c4c
ML
3296 while ( <FILELIST> )
3297 {
e02cd638
JH
3298 chomp;
3299 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
3fda8c4c
ML
3300 {
3301 die("Couldn't process git-ls-tree line : $_");
3302 }
3303
3304 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
3305
3306 $seen_files->{$git_filename} = 1;
3307
3308 my ( $oldhash, $oldrevision, $oldmode ) = (
3309 $head->{$git_filename}{filehash},
3310 $head->{$git_filename}{revision},
3311 $head->{$git_filename}{mode}
3312 );
3313
3314 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
3315 {
3316 $git_perms = "";
3317 $git_perms .= "r" if ( $1 & 4 );
3318 $git_perms .= "w" if ( $1 & 2 );
3319 $git_perms .= "x" if ( $1 & 1 );
3320 } else {
3321 $git_perms = "rw";
3322 }
3323
3324 # unless the file exists with the same hash, we need to update it ...
3325 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
3326 {
3327 my $newrevision = ( $oldrevision or 0 ) + 1;
3328
3329 $head->{$git_filename} = {
3330 name => $git_filename,
3331 revision => $newrevision,
3332 filehash => $git_hash,
3333 commithash => $commit->{hash},
3334 modified => $commit->{date},
3335 author => $commit->{author},
3336 mode => $git_perms,
3337 };
3338
3339
96256bba 3340 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c
ML
3341 }
3342 }
3343 close FILELIST;
3344
3345 # Detect deleted files
3346 foreach my $file ( keys %$head )
3347 {
3348 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
3349 {
3350 $head->{$file}{revision}++;
3351 $head->{$file}{filehash} = "deleted";
3352 $head->{$file}{commithash} = $commit->{hash};
3353 $head->{$file}{modified} = $commit->{date};
3354 $head->{$file}{author} = $commit->{author};
3355
96256bba 3356 $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
3fda8c4c
ML
3357 }
3358 }
3359 # END : "Detect deleted files"
3360 }
3361
3362
3363 if (exists $commit->{mergemsg})
3364 {
96256bba 3365 $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
3fda8c4c
ML
3366 }
3367
3368 $lastpicked = $commit->{hash};
3369
3370 $self->_set_prop("last_commit", $commit->{hash});
3371 }
3372
96256bba 3373 $self->delete_head();
3fda8c4c
ML
3374 foreach my $file ( keys %$head )
3375 {
96256bba 3376 $self->insert_head(
3fda8c4c
ML
3377 $file,
3378 $head->{$file}{revision},
3379 $head->{$file}{filehash},
3380 $head->{$file}{commithash},
3381 $head->{$file}{modified},
3382 $head->{$file}{author},
3383 $head->{$file}{mode},
3384 );
3385 }
3386 # invalidate the gethead cache
3387 $self->{gethead_cache} = undef;
3388
3389
3390 # Ending exclusive lock here
3391 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
3392}
3393
96256bba
JS
3394sub insert_rev
3395{
3396 my $self = shift;
3397 my $name = shift;
3398 my $revision = shift;
3399 my $filehash = shift;
3400 my $commithash = shift;
3401 my $modified = shift;
3402 my $author = shift;
3403 my $mode = shift;
6aeeffd1 3404 my $tablename = $self->tablename("revision");
96256bba 3405
6aeeffd1 3406 my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
96256bba
JS
3407 $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
3408}
3409
3410sub insert_mergelog
3411{
3412 my $self = shift;
3413 my $key = shift;
3414 my $value = shift;
6aeeffd1 3415 my $tablename = $self->tablename("commitmsgs");
96256bba 3416
6aeeffd1 3417 my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
96256bba
JS
3418 $insert_mergelog->execute($key, $value);
3419}
3420
3421sub delete_head
3422{
3423 my $self = shift;
6aeeffd1 3424 my $tablename = $self->tablename("head");
96256bba 3425
6aeeffd1 3426 my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
96256bba
JS
3427 $delete_head->execute();
3428}
3429
3430sub insert_head
3431{
3432 my $self = shift;
3433 my $name = shift;
3434 my $revision = shift;
3435 my $filehash = shift;
3436 my $commithash = shift;
3437 my $modified = shift;
3438 my $author = shift;
3439 my $mode = shift;
6aeeffd1 3440 my $tablename = $self->tablename("head");
96256bba 3441
6aeeffd1 3442 my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
96256bba
JS
3443 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
3444}
3445
3fda8c4c
ML
3446sub _get_prop
3447{
3448 my $self = shift;
3449 my $key = shift;
6aeeffd1 3450 my $tablename = $self->tablename("properties");
3fda8c4c 3451
6aeeffd1 3452 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
3fda8c4c
ML
3453 $db_query->execute($key);
3454 my ( $value ) = $db_query->fetchrow_array;
3455
3456 return $value;
3457}
3458
3459sub _set_prop
3460{
3461 my $self = shift;
3462 my $key = shift;
3463 my $value = shift;
6aeeffd1 3464 my $tablename = $self->tablename("properties");
3fda8c4c 3465
6aeeffd1 3466 my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
3fda8c4c
ML
3467 $db_query->execute($value, $key);
3468
3469 unless ( $db_query->rows )
3470 {
6aeeffd1 3471 $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
3fda8c4c
ML
3472 $db_query->execute($key, $value);
3473 }
3474
3475 return $value;
3476}
3477
3478=head2 gethead
3479
3480=cut
3481
3482sub gethead
3483{
3484 my $self = shift;
6aeeffd1 3485 my $tablename = $self->tablename("head");
3fda8c4c
ML
3486
3487 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
3488
6aeeffd1 3489 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
3fda8c4c
ML
3490 $db_query->execute();
3491
3492 my $tree = [];
3493 while ( my $file = $db_query->fetchrow_hashref )
3494 {
3495 push @$tree, $file;
3496 }
3497
3498 $self->{gethead_cache} = $tree;
3499
3500 return $tree;
3501}
3502
3503=head2 getlog
3504
a86c0983
MO
3505See also gethistorydense().
3506
3fda8c4c
ML
3507=cut
3508
3509sub getlog
3510{
3511 my $self = shift;
3512 my $filename = shift;
6aeeffd1 3513 my $tablename = $self->tablename("revision");
3fda8c4c 3514
6aeeffd1 3515 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
3fda8c4c
ML
3516 $db_query->execute($filename);
3517
3518 my $tree = [];
3519 while ( my $file = $db_query->fetchrow_hashref )
3520 {
3521 push @$tree, $file;
3522 }
3523
3524 return $tree;
3525}
3526
3527=head2 getmeta
3528
3529This function takes a filename (with path) argument and returns a hashref of
3530metadata for that file.
3531
3532=cut
3533
3534sub getmeta
3535{
3536 my $self = shift;
3537 my $filename = shift;
3538 my $revision = shift;
6aeeffd1
JE
3539 my $tablename_rev = $self->tablename("revision");
3540 my $tablename_head = $self->tablename("head");
3fda8c4c
ML
3541
3542 my $db_query;
3543 if ( defined($revision) and $revision =~ /^\d+$/ )
3544 {
6aeeffd1 3545 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM $tablename_rev WHERE name=? AND revision=?",{},1);
3fda8c4c
ML
3546 $db_query->execute($filename, $revision);
3547 }
3548 elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
3549 {
6aeeffd1 3550 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",{},1);
3fda8c4c
ML
3551 $db_query->execute($filename, $revision);
3552 } else {
6aeeffd1 3553 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM $tablename_head WHERE name=?",{},1);
3fda8c4c
ML
3554 $db_query->execute($filename);
3555 }
3556
3557 return $db_query->fetchrow_hashref;
3558}
3559
3560=head2 commitmessage
3561
3562this function takes a commithash and returns the commit message for that commit
3563
3564=cut
3565sub commitmessage
3566{
3567 my $self = shift;
3568 my $commithash = shift;
6aeeffd1 3569 my $tablename = $self->tablename("commitmsgs");
3fda8c4c
ML
3570
3571 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
3572
3573 my $db_query;
6aeeffd1 3574 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
3fda8c4c
ML
3575 $db_query->execute($commithash);
3576
3577 my ( $message ) = $db_query->fetchrow_array;
3578
3579 if ( defined ( $message ) )
3580 {
3581 $message .= " " if ( $message =~ /\n$/ );
3582 return $message;
3583 }
3584
d2feb01a 3585 my @lines = safe_pipe_capture("git", "cat-file", "commit", $commithash);
3fda8c4c
ML
3586 shift @lines while ( $lines[0] =~ /\S/ );
3587 $message = join("",@lines);
3588 $message .= " " if ( $message =~ /\n$/ );
3589 return $message;
3590}
3591
3fda8c4c
ML
3592=head2 gethistorydense
3593
3594This function takes a filename (with path) argument and returns an arrayofarrays
3595containing revision,filehash,commithash ordered by revision descending.
3596
3597This version of gethistory skips deleted entries -- so it is useful for annotate.
3598The 'dense' part is a reference to a '--dense' option available for git-rev-list
3599and other git tools that depend on it.
3600
a86c0983
MO
3601See also getlog().
3602
3fda8c4c
ML
3603=cut
3604sub gethistorydense
3605{
3606 my $self = shift;
3607 my $filename = shift;
6aeeffd1 3608 my $tablename = $self->tablename("revision");
3fda8c4c
ML
3609
3610 my $db_query;
6aeeffd1 3611 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
3fda8c4c
ML
3612 $db_query->execute($filename);
3613
3614 return $db_query->fetchall_arrayref;
3615}
3616
3617=head2 in_array()
3618
3619from Array::PAT - mimics the in_array() function
3620found in PHP. Yuck but works for small arrays.
3621
3622=cut
3623sub in_array
3624{
3625 my ($check, @array) = @_;
3626 my $retval = 0;
3627 foreach my $test (@array){
3628 if($check eq $test){
3629 $retval = 1;
3630 }
3631 }
3632 return $retval;
3633}
3634
3635=head2 safe_pipe_capture
3636
5348b6e7 3637an alternative to `command` that allows input to be passed as an array
3fda8c4c
ML
3638to work around shell problems with weird characters in arguments
3639
3640=cut
3641sub safe_pipe_capture {
3642
3643 my @output;
3644
3645 if (my $pid = open my $child, '-|') {
3646 @output = (<$child>);
3647 close $child or die join(' ',@_).": $! $?";
3648 } else {
3649 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
3650 }
3651 return wantarray ? @output : join('',@output);
3652}
<