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