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