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