t9400-git-cvsserver-server: Wrap setup into test case
[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
394d66d4
JH
1360 ### Then hooks/post-update
1361 $hook = $ENV{GIT_DIR}.'hooks/post-update';
1362 if (-x $hook) {
1363 system($hook, "refs/heads/$state->{module}");
1364 }
1365
3fda8c4c
ML
1366 $updater->update();
1367
addf88e4 1368 # foreach file specified on the command line ...
3fda8c4c
ML
1369 foreach my $filename ( @committedfiles )
1370 {
1371 $filename = filecleanup($filename);
1372
1373 my $meta = $updater->getmeta($filename);
3486595b
ML
1374 unless (defined $meta->{revision}) {
1375 $meta->{revision} = 1;
1376 }
3fda8c4c 1377
7d90095a 1378 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
3fda8c4c
ML
1379
1380 $log->debug("Checked-in $dirpart : $filename");
1381
392e2817 1382 print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
3486595b 1383 if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
3fda8c4c 1384 {
392e2817 1385 print "M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";
3fda8c4c
ML
1386 print "Remove-entry $dirpart\n";
1387 print "$filename\n";
1388 } else {
459bad77
FL
1389 if ($meta->{revision} == 1) {
1390 print "M initial revision: 1.1\n";
1391 } else {
392e2817 1392 print "M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";
459bad77 1393 }
3fda8c4c
ML
1394 print "Checked-in $dirpart\n";
1395 print "$filename\n";
8538e876
AP
1396 my $kopts = kopts_from_path($filepart);
1397 print "/$filepart/1.$meta->{revision}//$kopts/\n";
3fda8c4c
ML
1398 }
1399 }
1400
3fda8c4c 1401 chdir "/";
3fda8c4c
ML
1402 print "ok\n";
1403}
1404
1405sub req_status
1406{
1407 my ( $cmd, $data ) = @_;
1408
1409 argsplit("status");
1410
1411 $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1412 #$log->debug("status state : " . Dumper($state));
1413
1414 # Grab a handle to the SQLite db and do any necessary updates
1415 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1416 $updater->update();
1417
1418 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1419 argsfromdir($updater);
3fda8c4c 1420
addf88e4 1421 # foreach file specified on the command line ...
3fda8c4c
ML
1422 foreach my $filename ( @{$state->{args}} )
1423 {
1424 $filename = filecleanup($filename);
1425
1426 my $meta = $updater->getmeta($filename);
1427 my $oldmeta = $meta;
1428
1429 my $wrev = revparse($filename);
1430
1431 # If the working copy is an old revision, lets get that version too for comparison.
1432 if ( defined($wrev) and $wrev != $meta->{revision} )
1433 {
1434 $oldmeta = $updater->getmeta($filename, $wrev);
1435 }
1436
1437 # TODO : All possible statuses aren't yet implemented
1438 my $status;
1439 # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1440 $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1441 and
1442 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1443 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1444 );
1445
1446 # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1447 $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1448 and
1449 ( $state->{entries}{$filename}{unchanged}
1450 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1451 );
1452
1453 # Need checkout if it exists in the repo but doesn't have a working copy
1454 $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1455
1456 # Locally modified if working copy and repo copy have the same revision but there are local changes
1457 $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1458
1459 # Needs Merge if working copy revision is less than repo copy and there are local changes
1460 $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1461
1462 $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1463 $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1464 $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1465 $status ||= "File had conflicts on merge" if ( 0 );
1466
1467 $status ||= "Unknown";
1468
1469 print "M ===================================================================\n";
1470 print "M File: $filename\tStatus: $status\n";
1471 if ( defined($state->{entries}{$filename}{revision}) )
1472 {
1473 print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1474 } else {
1475 print "M Working revision:\tNo entry for $filename\n";
1476 }
1477 if ( defined($meta->{revision}) )
1478 {
392e2817 1479 print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
3fda8c4c
ML
1480 print "M Sticky Tag:\t\t(none)\n";
1481 print "M Sticky Date:\t\t(none)\n";
1482 print "M Sticky Options:\t\t(none)\n";
1483 } else {
1484 print "M Repository revision:\tNo revision control file\n";
1485 }
1486 print "M\n";
1487 }
1488
1489 print "ok\n";
1490}
1491
1492sub req_diff
1493{
1494 my ( $cmd, $data ) = @_;
1495
1496 argsplit("diff");
1497
1498 $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1499 #$log->debug("status state : " . Dumper($state));
1500
1501 my ($revision1, $revision2);
1502 if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1503 {
1504 $revision1 = $state->{opt}{r}[0];
1505 $revision2 = $state->{opt}{r}[1];
1506 } else {
1507 $revision1 = $state->{opt}{r};
1508 }
1509
1510 $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1511 $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1512
1513 $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1514
1515 # Grab a handle to the SQLite db and do any necessary updates
1516 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1517 $updater->update();
1518
1519 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1520 argsfromdir($updater);
3fda8c4c 1521
addf88e4 1522 # foreach file specified on the command line ...
3fda8c4c
ML
1523 foreach my $filename ( @{$state->{args}} )
1524 {
1525 $filename = filecleanup($filename);
1526
1527 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1528
1529 my $wrev = revparse($filename);
1530
1531 # We need _something_ to diff against
1532 next unless ( defined ( $wrev ) );
1533
1534 # if we have a -r switch, use it
1535 if ( defined ( $revision1 ) )
1536 {
1537 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1538 $meta1 = $updater->getmeta($filename, $revision1);
1539 unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1540 {
1541 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1542 next;
1543 }
1544 transmitfile($meta1->{filehash}, $file1);
1545 }
1546 # otherwise we just use the working copy revision
1547 else
1548 {
1549 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1550 $meta1 = $updater->getmeta($filename, $wrev);
1551 transmitfile($meta1->{filehash}, $file1);
1552 }
1553
1554 # if we have a second -r switch, use it too
1555 if ( defined ( $revision2 ) )
1556 {
1557 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1558 $meta2 = $updater->getmeta($filename, $revision2);
1559
1560 unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1561 {
1562 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1563 next;
1564 }
1565
1566 transmitfile($meta2->{filehash}, $file2);
1567 }
1568 # otherwise we just use the working copy
1569 else
1570 {
1571 $file2 = $state->{entries}{$filename}{modified_filename};
1572 }
1573
1574 # if we have been given -r, and we don't have a $file2 yet, lets get one
1575 if ( defined ( $revision1 ) and not defined ( $file2 ) )
1576 {
1577 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1578 $meta2 = $updater->getmeta($filename, $wrev);
1579 transmitfile($meta2->{filehash}, $file2);
1580 }
1581
1582 # We need to have retrieved something useful
1583 next unless ( defined ( $meta1 ) );
1584
1585 # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1586 next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1587 and
1588 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1589 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1590 );
1591
1592 # Apparently we only show diffs for locally modified files
1593 next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1594
1595 print "M Index: $filename\n";
1596 print "M ===================================================================\n";
1597 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1598 print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1599 print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1600 print "M diff ";
1601 foreach my $opt ( keys %{$state->{opt}} )
1602 {
1603 if ( ref $state->{opt}{$opt} eq "ARRAY" )
1604 {
1605 foreach my $value ( @{$state->{opt}{$opt}} )
1606 {
1607 print "-$opt $value ";
1608 }
1609 } else {
1610 print "-$opt ";
1611 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1612 }
1613 }
1614 print "$filename\n";
1615
1616 $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1617
1618 ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1619
1620 if ( exists $state->{opt}{u} )
1621 {
1622 system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1623 } else {
1624 system("diff $file1 $file2 > $filediff");
1625 }
1626
1627 while ( <$fh> )
1628 {
1629 print "M $_";
1630 }
1631 close $fh;
1632 }
1633
1634 print "ok\n";
1635}
1636
1637sub req_log
1638{
1639 my ( $cmd, $data ) = @_;
1640
1641 argsplit("log");
1642
1643 $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1644 #$log->debug("log state : " . Dumper($state));
1645
1646 my ( $minrev, $maxrev );
1647 if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1648 {
1649 my $control = $2;
1650 $minrev = $1;
1651 $maxrev = $3;
1652 $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1653 $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1654 $minrev++ if ( defined($minrev) and $control eq "::" );
1655 }
1656
1657 # Grab a handle to the SQLite db and do any necessary updates
1658 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1659 $updater->update();
1660
1661 # if no files were specified, we need to work out what files we should be providing status on ...
7d90095a 1662 argsfromdir($updater);
3fda8c4c 1663
addf88e4 1664 # foreach file specified on the command line ...
3fda8c4c
ML
1665 foreach my $filename ( @{$state->{args}} )
1666 {
1667 $filename = filecleanup($filename);
1668
1669 my $headmeta = $updater->getmeta($filename);
1670
1671 my $revisions = $updater->getlog($filename);
1672 my $totalrevisions = scalar(@$revisions);
1673
1674 if ( defined ( $minrev ) )
1675 {
1676 $log->debug("Removing revisions less than $minrev");
1677 while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1678 {
1679 pop @$revisions;
1680 }
1681 }
1682 if ( defined ( $maxrev ) )
1683 {
1684 $log->debug("Removing revisions greater than $maxrev");
1685 while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1686 {
1687 shift @$revisions;
1688 }
1689 }
1690
1691 next unless ( scalar(@$revisions) );
1692
1693 print "M \n";
1694 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1695 print "M Working file: $filename\n";
1696 print "M head: 1.$headmeta->{revision}\n";
1697 print "M branch:\n";
1698 print "M locks: strict\n";
1699 print "M access list:\n";
1700 print "M symbolic names:\n";
1701 print "M keyword substitution: kv\n";
1702 print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1703 print "M description:\n";
1704
1705 foreach my $revision ( @$revisions )
1706 {
1707 print "M ----------------------------\n";
1708 print "M revision 1.$revision->{revision}\n";
1709 # reformat the date for log output
1710 $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}) );
1711 $revision->{author} =~ s/\s+.*//;
1712 $revision->{author} =~ s/^(.{8}).*/$1/;
1713 print "M date: $revision->{modified}; author: $revision->{author}; state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . "; lines: +2 -3\n";
1714 my $commitmessage = $updater->commitmessage($revision->{commithash});
1715 $commitmessage =~ s/^/M /mg;
1716 print $commitmessage . "\n";
1717 }
1718 print "M =============================================================================\n";
1719 }
1720
1721 print "ok\n";
1722}
1723
1724sub req_annotate
1725{
1726 my ( $cmd, $data ) = @_;
1727
1728 argsplit("annotate");
1729
1730 $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1731 #$log->debug("status state : " . Dumper($state));
1732
1733 # Grab a handle to the SQLite db and do any necessary updates
1734 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1735 $updater->update();
1736
1737 # if no files were specified, we need to work out what files we should be providing annotate on ...
7d90095a 1738 argsfromdir($updater);
3fda8c4c
ML
1739
1740 # we'll need a temporary checkout dir
1741 my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1742 my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1743 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1744
1745 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
b50be1d8 1746 $ENV{GIT_WORK_TREE} = ".";
3fda8c4c
ML
1747 $ENV{GIT_INDEX_FILE} = $file_index;
1748
1749 chdir $tmpdir;
1750
addf88e4 1751 # foreach file specified on the command line ...
3fda8c4c
ML
1752 foreach my $filename ( @{$state->{args}} )
1753 {
1754 $filename = filecleanup($filename);
1755
1756 my $meta = $updater->getmeta($filename);
1757
1758 next unless ( $meta->{revision} );
1759
1760 # get all the commits that this file was in
1761 # in dense format -- aka skip dead revisions
1762 my $revisions = $updater->gethistorydense($filename);
1763 my $lastseenin = $revisions->[0][2];
1764
1765 # populate the temporary index based on the latest commit were we saw
1766 # the file -- but do it cheaply without checking out any files
1767 # TODO: if we got a revision from the client, use that instead
1768 # to look up the commithash in sqlite (still good to default to
1769 # the current head as we do now)
1770 system("git-read-tree", $lastseenin);
1771 unless ($? == 0)
1772 {
a5e40798
JM
1773 print "E error running git-read-tree $lastseenin $file_index $!\n";
1774 return;
3fda8c4c
ML
1775 }
1776 $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1777
1778 # do a checkout of the file
1779 system('git-checkout-index', '-f', '-u', $filename);
1780 unless ($? == 0) {
a5e40798
JM
1781 print "E error running git-checkout-index -f -u $filename : $!\n";
1782 return;
3fda8c4c
ML
1783 }
1784
1785 $log->info("Annotate $filename");
1786
1787 # Prepare a file with the commits from the linearized
1788 # history that annotate should know about. This prevents
1789 # git-jsannotate telling us about commits we are hiding
1790 # from the client.
1791
a5e40798
JM
1792 my $a_hints = "$tmpdir/.annotate_hints";
1793 if (!open(ANNOTATEHINTS, '>', $a_hints)) {
1794 print "E failed to open '$a_hints' for writing: $!\n";
1795 return;
1796 }
3fda8c4c
ML
1797 for (my $i=0; $i < @$revisions; $i++)
1798 {
1799 print ANNOTATEHINTS $revisions->[$i][2];
1800 if ($i+1 < @$revisions) { # have we got a parent?
1801 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1802 }
1803 print ANNOTATEHINTS "\n";
1804 }
1805
1806 print ANNOTATEHINTS "\n";
a5e40798
JM
1807 close ANNOTATEHINTS
1808 or (print "E failed to write $a_hints: $!\n"), return;
3fda8c4c 1809
a5e40798
JM
1810 my @cmd = (qw(git-annotate -l -S), $a_hints, $filename);
1811 if (!open(ANNOTATE, "-|", @cmd)) {
1812 print "E error invoking ". join(' ',@cmd) .": $!\n";
1813 return;
1814 }
3fda8c4c
ML
1815 my $metadata = {};
1816 print "E Annotations for $filename\n";
1817 print "E ***************\n";
1818 while ( <ANNOTATE> )
1819 {
1820 if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1821 {
1822 my $commithash = $1;
1823 my $data = $2;
1824 unless ( defined ( $metadata->{$commithash} ) )
1825 {
1826 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1827 $metadata->{$commithash}{author} =~ s/\s+.*//;
1828 $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1829 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1830 }
1831 printf("M 1.%-5d (%-8s %10s): %s\n",
1832 $metadata->{$commithash}{revision},
1833 $metadata->{$commithash}{author},
1834 $metadata->{$commithash}{modified},
1835 $data
1836 );
1837 } else {
1838 $log->warn("Error in annotate output! LINE: $_");
1839 print "E Annotate error \n";
1840 next;
1841 }
1842 }
1843 close ANNOTATE;
1844 }
1845
1846 # done; get out of the tempdir
1847 chdir "/";
1848
1849 print "ok\n";
1850
1851}
1852
1853# This method takes the state->{arguments} array and produces two new arrays.
1854# The first is $state->{args} which is everything before the '--' argument, and
1855# the second is $state->{files} which is everything after it.
1856sub argsplit
1857{
3fda8c4c
ML
1858 $state->{args} = [];
1859 $state->{files} = [];
1860 $state->{opt} = {};
1861
1e76b702
FL
1862 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1863
1864 my $type = shift;
1865
3fda8c4c
ML
1866 if ( defined($type) )
1867 {
1868 my $opt = {};
1869 $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" );
1870 $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1871 $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" );
1872 $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1873 $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1874 $opt = { k => 1, m => 1 } if ( $type eq "add" );
1875 $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1876 $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" );
1877
1878
1879 while ( scalar ( @{$state->{arguments}} ) > 0 )
1880 {
1881 my $arg = shift @{$state->{arguments}};
1882
1883 next if ( $arg eq "--" );
1884 next unless ( $arg =~ /\S/ );
1885
1886 # if the argument looks like a switch
1887 if ( $arg =~ /^-(\w)(.*)/ )
1888 {
1889 # if it's a switch that takes an argument
1890 if ( $opt->{$1} )
1891 {
1892 # If this switch has already been provided
1893 if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1894 {
1895 $state->{opt}{$1} = [ $state->{opt}{$1} ];
1896 if ( length($2) > 0 )
1897 {
1898 push @{$state->{opt}{$1}},$2;
1899 } else {
1900 push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1901 }
1902 } else {
1903 # if there's extra data in the arg, use that as the argument for the switch
1904 if ( length($2) > 0 )
1905 {
1906 $state->{opt}{$1} = $2;
1907 } else {
1908 $state->{opt}{$1} = shift @{$state->{arguments}};
1909 }
1910 }
1911 } else {
1912 $state->{opt}{$1} = undef;
1913 }
1914 }
1915 else
1916 {
1917 push @{$state->{args}}, $arg;
1918 }
1919 }
1920 }
1921 else
1922 {
1923 my $mode = 0;
1924
1925 foreach my $value ( @{$state->{arguments}} )
1926 {
1927 if ( $value eq "--" )
1928 {
1929 $mode++;
1930 next;
1931 }
1932 push @{$state->{args}}, $value if ( $mode == 0 );
1933 push @{$state->{files}}, $value if ( $mode == 1 );
1934 }
1935 }
1936}
1937
1938# This method uses $state->{directory} to populate $state->{args} with a list of filenames
1939sub argsfromdir
1940{
1941 my $updater = shift;
1942
7d90095a
MS
1943 $state->{args} = [] if ( scalar(@{$state->{args}}) == 1 and $state->{args}[0] eq "." );
1944
82000d74 1945 return if ( scalar ( @{$state->{args}} ) > 1 );
7d90095a 1946
0a7a9a12
JS
1947 my @gethead = @{$updater->gethead};
1948
1949 # push added files
1950 foreach my $file (keys %{$state->{entries}}) {
1951 if ( exists $state->{entries}{$file}{revision} &&
1952 $state->{entries}{$file}{revision} == 0 )
1953 {
1954 push @gethead, { name => $file, filehash => 'added' };
1955 }
1956 }
1957
82000d74
MS
1958 if ( scalar(@{$state->{args}}) == 1 )
1959 {
1960 my $arg = $state->{args}[0];
1961 $arg .= $state->{prependdir} if ( defined ( $state->{prependdir} ) );
7d90095a 1962
82000d74 1963 $log->info("Only one arg specified, checking for directory expansion on '$arg'");
3fda8c4c 1964
0a7a9a12 1965 foreach my $file ( @gethead )
82000d74
MS
1966 {
1967 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1968 next unless ( $file->{name} =~ /^$arg\// or $file->{name} eq $arg );
1969 push @{$state->{args}}, $file->{name};
1970 }
1971
1972 shift @{$state->{args}} if ( scalar(@{$state->{args}}) > 1 );
1973 } else {
1974 $log->info("Only one arg specified, populating file list automatically");
1975
1976 $state->{args} = [];
1977
0a7a9a12 1978 foreach my $file ( @gethead )
82000d74
MS
1979 {
1980 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1981 next unless ( $file->{name} =~ s/^$state->{prependdir}// );
1982 push @{$state->{args}}, $file->{name};
1983 }
3fda8c4c
ML
1984 }
1985}
1986
1987# This method cleans up the $state variable after a command that uses arguments has run
1988sub statecleanup
1989{
1990 $state->{files} = [];
1991 $state->{args} = [];
1992 $state->{arguments} = [];
1993 $state->{entries} = {};
1994}
1995
1996sub revparse
1997{
1998 my $filename = shift;
1999
2000 return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
2001
2002 return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
2003 return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
2004
2005 return undef;
2006}
2007
2008# This method takes a file hash and does a CVS "file transfer" which transmits the
2009# size of the file, and then the file contents.
2010# If a second argument $targetfile is given, the file is instead written out to
2011# a file by the name of $targetfile
2012sub transmitfile
2013{
2014 my $filehash = shift;
2015 my $targetfile = shift;
2016
2017 if ( defined ( $filehash ) and $filehash eq "deleted" )
2018 {
2019 $log->warn("filehash is 'deleted'");
2020 return;
2021 }
2022
2023 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
2024
2025 my $type = `git-cat-file -t $filehash`;
2026 chomp $type;
2027
2028 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2029
2030 my $size = `git-cat-file -s $filehash`;
2031 chomp $size;
2032
2033 $log->debug("transmitfile($filehash) size=$size, type=$type");
2034
2035 if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
2036 {
2037 if ( defined ( $targetfile ) )
2038 {
2039 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2040 print NEWFILE $_ while ( <$fh> );
a5e40798 2041 close NEWFILE or die("Failed to write '$targetfile': $!");
3fda8c4c
ML
2042 } else {
2043 print "$size\n";
2044 print while ( <$fh> );
2045 }
a5e40798 2046 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
3fda8c4c
ML
2047 } else {
2048 die("Couldn't execute git-cat-file");
2049 }
2050}
2051
2052# This method takes a file name, and returns ( $dirpart, $filepart ) which
5348b6e7 2053# refers to the directory portion and the file portion of the filename
3fda8c4c
ML
2054# respectively
2055sub filenamesplit
2056{
2057 my $filename = shift;
7d90095a 2058 my $fixforlocaldir = shift;
3fda8c4c
ML
2059
2060 my ( $filepart, $dirpart ) = ( $filename, "." );
2061 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2062 $dirpart .= "/";
2063
7d90095a
MS
2064 if ( $fixforlocaldir )
2065 {
2066 $dirpart =~ s/^$state->{prependdir}//;
2067 }
2068
3fda8c4c
ML
2069 return ( $filepart, $dirpart );
2070}
2071
2072sub filecleanup
2073{
2074 my $filename = shift;
2075
2076 return undef unless(defined($filename));
2077 if ( $filename =~ /^\// )
2078 {
2079 print "E absolute filenames '$filename' not supported by server\n";
2080 return undef;
2081 }
2082
2083 $filename =~ s/^\.\///g;
82000d74 2084 $filename = $state->{prependdir} . $filename;
3fda8c4c
ML
2085 return $filename;
2086}
2087
8538e876
AP
2088# Given a path, this function returns a string containing the kopts
2089# that should go into that path's Entries line. For example, a binary
2090# file should get -kb.
2091sub kopts_from_path
2092{
2093 my ($path) = @_;
2094
2095 # Once it exists, the git attributes system should be used to look up
2096 # what attributes apply to this path.
2097
2098 # Until then, take the setting from the config file
2099 unless ( defined ( $cfg->{gitcvs}{allbinary} ) and $cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i )
2100 {
2101 # Return "" to give no special treatment to any path
2102 return "";
2103 } else {
2104 # Alternatively, to have all files treated as if they are binary (which
2105 # is more like git itself), always return the "-kb" option
2106 return "-kb";
2107 }
2108}
2109
3fda8c4c
ML
2110package GITCVS::log;
2111
2112####
2113#### Copyright The Open University UK - 2006.
2114####
2115#### Authors: Martyn Smith <martyn@catalyst.net.nz>
2116#### Martin Langhoff <martin@catalyst.net.nz>
2117####
2118####
2119
2120use strict;
2121use warnings;
2122
2123=head1 NAME
2124
2125GITCVS::log
2126
2127=head1 DESCRIPTION
2128
2129This module provides very crude logging with a similar interface to
2130Log::Log4perl
2131
2132=head1 METHODS
2133
2134=cut
2135
2136=head2 new
2137
2138Creates a new log object, optionally you can specify a filename here to
5348b6e7 2139indicate the file to log to. If no log file is specified, you can specify one
3fda8c4c
ML
2140later with method setfile, or indicate you no longer want logging with method
2141nofile.
2142
2143Until one of these methods is called, all log calls will buffer messages ready
2144to write out.
2145
2146=cut
2147sub new
2148{
2149 my $class = shift;
2150 my $filename = shift;
2151
2152 my $self = {};
2153
2154 bless $self, $class;
2155
2156 if ( defined ( $filename ) )
2157 {
2158 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
2159 }
2160
2161 return $self;
2162}
2163
2164=head2 setfile
2165
2166This methods takes a filename, and attempts to open that file as the log file.
2167If successful, all buffered data is written out to the file, and any further
2168logging is written directly to the file.
2169
2170=cut
2171sub setfile
2172{
2173 my $self = shift;
2174 my $filename = shift;
2175
2176 if ( defined ( $filename ) )
2177 {
2178 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
2179 }
2180
2181 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
2182
2183 while ( my $line = shift @{$self->{buffer}} )
2184 {
2185 print {$self->{fh}} $line;
2186 }
2187}
2188
2189=head2 nofile
2190
2191This method indicates no logging is going to be used. It flushes any entries in
2192the internal buffer, and sets a flag to ensure no further data is put there.
2193
2194=cut
2195sub nofile
2196{
2197 my $self = shift;
2198
2199 $self->{nolog} = 1;
2200
2201 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
2202
2203 $self->{buffer} = [];
2204}
2205
2206=head2 _logopen
2207
2208Internal method. Returns true if the log file is open, false otherwise.
2209
2210=cut
2211sub _logopen
2212{
2213 my $self = shift;
2214
2215 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
2216 return 0;
2217}
2218
2219=head2 debug info warn fatal
2220
2221These four methods are wrappers to _log. They provide the actual interface for
2222logging data.
2223
2224=cut
2225sub debug { my $self = shift; $self->_log("debug", @_); }
2226sub info { my $self = shift; $self->_log("info" , @_); }
2227sub warn { my $self = shift; $self->_log("warn" , @_); }
2228sub fatal { my $self = shift; $self->_log("fatal", @_); }
2229
2230=head2 _log
2231
2232This is an internal method called by the logging functions. It generates a
2233timestamp and pushes the logged line either to file, or internal buffer.
2234
2235=cut
2236sub _log
2237{
2238 my $self = shift;
2239 my $level = shift;
2240
2241 return if ( $self->{nolog} );
2242
2243 my @time = localtime;
2244 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
2245 $time[5] + 1900,
2246 $time[4] + 1,
2247 $time[3],
2248 $time[2],
2249 $time[1],
2250 $time[0],
2251 uc $level,
2252 );
2253
2254 if ( $self->_logopen )
2255 {
2256 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
2257 } else {
2258 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
2259 }
2260}
2261
2262=head2 DESTROY
2263
2264This method simply closes the file handle if one is open
2265
2266=cut
2267sub DESTROY
2268{
2269 my $self = shift;
2270
2271 if ( $self->_logopen )
2272 {
2273 close $self->{fh};
2274 }
2275}
2276
2277package GITCVS::updater;
2278
2279####
2280#### Copyright The Open University UK - 2006.
2281####
2282#### Authors: Martyn Smith <martyn@catalyst.net.nz>
2283#### Martin Langhoff <martin@catalyst.net.nz>
2284####
2285####
2286
2287use strict;
2288use warnings;
2289use DBI;
2290
2291=head1 METHODS
2292
2293=cut
2294
2295=head2 new
2296
2297=cut
2298sub new
2299{
2300 my $class = shift;
2301 my $config = shift;
2302 my $module = shift;
2303 my $log = shift;
2304
2305 die "Need to specify a git repository" unless ( defined($config) and -d $config );
2306 die "Need to specify a module" unless ( defined($module) );
2307
2308 $class = ref($class) || $class;
2309
2310 my $self = {};
2311
2312 bless $self, $class;
2313
3fda8c4c 2314 $self->{module} = $module;
3fda8c4c
ML
2315 $self->{git_path} = $config . "/";
2316
2317 $self->{log} = $log;
2318
2319 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
2320
eb1780d4 2321 $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
473937ed 2322 $cfg->{gitcvs}{dbdriver} || "SQLite";
eb1780d4
FL
2323 $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
2324 $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
2325 $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
2326 $cfg->{gitcvs}{dbuser} || "";
2327 $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
2328 $cfg->{gitcvs}{dbpass} || "";
2329 my %mapping = ( m => $module,
2330 a => $state->{method},
2331 u => getlogin || getpwuid($<) || $<,
2332 G => $self->{git_path},
2333 g => mangle_dirname($self->{git_path}),
2334 );
2335 $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
2336 $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
2337
473937ed
FL
2338 die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
2339 die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
2340 $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
eb1780d4
FL
2341 $self->{dbuser},
2342 $self->{dbpass});
920a449a 2343 die "Error connecting to database\n" unless defined $self->{dbh};
3fda8c4c
ML
2344
2345 $self->{tables} = {};
0cf611a3 2346 foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
3fda8c4c 2347 {
3fda8c4c
ML
2348 $self->{tables}{$table} = 1;
2349 }
2350
2351 # Construct the revision table if required
2352 unless ( $self->{tables}{revision} )
2353 {
2354 $self->{dbh}->do("
2355 CREATE TABLE revision (
2356 name TEXT NOT NULL,
2357 revision INTEGER NOT NULL,
2358 filehash TEXT NOT NULL,
2359 commithash TEXT NOT NULL,
2360 author TEXT NOT NULL,
2361 modified TEXT NOT NULL,
2362 mode TEXT NOT NULL
2363 )
2364 ");
178e015c
SP
2365 $self->{dbh}->do("
2366 CREATE INDEX revision_ix1
2367 ON revision (name,revision)
2368 ");
2369 $self->{dbh}->do("
2370 CREATE INDEX revision_ix2
2371 ON revision (name,commithash)
2372 ");
3fda8c4c
ML
2373 }
2374
178e015c 2375 # Construct the head table if required
3fda8c4c
ML
2376 unless ( $self->{tables}{head} )
2377 {
2378 $self->{dbh}->do("
2379 CREATE TABLE head (
2380 name TEXT NOT NULL,
2381 revision INTEGER NOT NULL,
2382 filehash TEXT NOT NULL,
2383 commithash TEXT NOT NULL,
2384 author TEXT NOT NULL,
2385 modified TEXT NOT NULL,
2386 mode TEXT NOT NULL
2387 )
2388 ");
178e015c
SP
2389 $self->{dbh}->do("
2390 CREATE INDEX head_ix1
2391 ON head (name)
2392 ");
3fda8c4c
ML
2393 }
2394
2395 # Construct the properties table if required
2396 unless ( $self->{tables}{properties} )
2397 {
2398 $self->{dbh}->do("
2399 CREATE TABLE properties (
2400 key TEXT NOT NULL PRIMARY KEY,
2401 value TEXT
2402 )
2403 ");
2404 }
2405
2406 # Construct the commitmsgs table if required
2407 unless ( $self->{tables}{commitmsgs} )
2408 {
2409 $self->{dbh}->do("
2410 CREATE TABLE commitmsgs (
2411 key TEXT NOT NULL PRIMARY KEY,
2412 value TEXT
2413 )
2414 ");
2415 }
2416
2417 return $self;
2418}
2419
2420=head2 update
2421
2422=cut
2423sub update
2424{
2425 my $self = shift;
2426
2427 # first lets get the commit list
2428 $ENV{GIT_DIR} = $self->{git_path};
2429
49fb940e
ML
2430 my $commitsha1 = `git rev-parse $self->{module}`;
2431 chomp $commitsha1;
2432
2433 my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
3fda8c4c
ML
2434 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2435 {
2436 die("Invalid module '$self->{module}'");
2437 }
2438
2439
2440 my $git_log;
2441 my $lastcommit = $self->_get_prop("last_commit");
2442
49fb940e
ML
2443 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
2444 return 1;
2445 }
2446
3fda8c4c
ML
2447 # Start exclusive lock here...
2448 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2449
2450 # TODO: log processing is memory bound
2451 # if we can parse into a 2nd file that is in reverse order
2452 # we can probably do something really efficient
a248c961 2453 my @git_log_params = ('--pretty', '--parents', '--topo-order');
3fda8c4c
ML
2454
2455 if (defined $lastcommit) {
2456 push @git_log_params, "$lastcommit..$self->{module}";
2457 } else {
2458 push @git_log_params, $self->{module};
2459 }
a248c961
ML
2460 # git-rev-list is the backend / plumbing version of git-log
2461 open(GITLOG, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
3fda8c4c
ML
2462
2463 my @commits;
2464
2465 my %commit = ();
2466
2467 while ( <GITLOG> )
2468 {
2469 chomp;
2470 if (m/^commit\s+(.*)$/) {
2471 # on ^commit lines put the just seen commit in the stack
2472 # and prime things for the next one
2473 if (keys %commit) {
2474 my %copy = %commit;
2475 unshift @commits, \%copy;
2476 %commit = ();
2477 }
2478 my @parents = split(m/\s+/, $1);
2479 $commit{hash} = shift @parents;
2480 $commit{parents} = \@parents;
2481 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2482 # on rfc822-like lines seen before we see any message,
2483 # lowercase the entry and put it in the hash as key-value
2484 $commit{lc($1)} = $2;
2485 } else {
2486 # message lines - skip initial empty line
2487 # and trim whitespace
2488 if (!exists($commit{message}) && m/^\s*$/) {
2489 # define it to mark the end of headers
2490 $commit{message} = '';
2491 next;
2492 }
2493 s/^\s+//; s/\s+$//; # trim ws
2494 $commit{message} .= $_ . "\n";
2495 }
2496 }
2497 close GITLOG;
2498
2499 unshift @commits, \%commit if ( keys %commit );
2500
2501 # Now all the commits are in the @commits bucket
2502 # ordered by time DESC. for each commit that needs processing,
2503 # determine whether it's following the last head we've seen or if
2504 # it's on its own branch, grab a file list, and add whatever's changed
2505 # NOTE: $lastcommit refers to the last commit from previous run
2506 # $lastpicked is the last commit we picked in this run
2507 my $lastpicked;
2508 my $head = {};
2509 if (defined $lastcommit) {
2510 $lastpicked = $lastcommit;
2511 }
2512
2513 my $committotal = scalar(@commits);
2514 my $commitcount = 0;
2515
2516 # Load the head table into $head (for cached lookups during the update process)
2517 foreach my $file ( @{$self->gethead()} )
2518 {
2519 $head->{$file->{name}} = $file;
2520 }
2521
2522 foreach my $commit ( @commits )
2523 {
2524 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2525 if (defined $lastpicked)
2526 {
2527 if (!in_array($lastpicked, @{$commit->{parents}}))
2528 {
2529 # skip, we'll see this delta
2530 # as part of a merge later
2531 # warn "skipping off-track $commit->{hash}\n";
2532 next;
2533 } elsif (@{$commit->{parents}} > 1) {
2534 # it is a merge commit, for each parent that is
2535 # not $lastpicked, see if we can get a log
2536 # from the merge-base to that parent to put it
2537 # in the message as a merge summary.
2538 my @parents = @{$commit->{parents}};
2539 foreach my $parent (@parents) {
2540 # git-merge-base can potentially (but rarely) throw
2541 # several candidate merge bases. let's assume
2542 # that the first one is the best one.
2543 if ($parent eq $lastpicked) {
2544 next;
2545 }
a5e40798
JM
2546 my $base = safe_pipe_capture('git-merge-base',
2547 $lastpicked, $parent);
3fda8c4c
ML
2548 chomp $base;
2549 if ($base) {
2550 my @merged;
2551 # print "want to log between $base $parent \n";
2552 open(GITLOG, '-|', 'git-log', "$base..$parent")
a5e40798 2553 or die "Cannot call git-log: $!";
3fda8c4c
ML
2554 my $mergedhash;
2555 while (<GITLOG>) {
2556 chomp;
2557 if (!defined $mergedhash) {
2558 if (m/^commit\s+(.+)$/) {
2559 $mergedhash = $1;
2560 } else {
2561 next;
2562 }
2563 } else {
2564 # grab the first line that looks non-rfc822
2565 # aka has content after leading space
2566 if (m/^\s+(\S.*)$/) {
2567 my $title = $1;
2568 $title = substr($title,0,100); # truncate
2569 unshift @merged, "$mergedhash $title";
2570 undef $mergedhash;
2571 }
2572 }
2573 }
2574 close GITLOG;
2575 if (@merged) {
2576 $commit->{mergemsg} = $commit->{message};
2577 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2578 foreach my $summary (@merged) {
2579 $commit->{mergemsg} .= "\t$summary\n";
2580 }
2581 $commit->{mergemsg} .= "\n\n";
2582 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2583 }
2584 }
2585 }
2586 }
2587 }
2588
2589 # convert the date to CVS-happy format
2590 $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2591
2592 if ( defined ( $lastpicked ) )
2593 {
e02cd638
JH
2594 my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2595 local ($/) = "\0";
3fda8c4c
ML
2596 while ( <FILELIST> )
2597 {
e02cd638
JH
2598 chomp;
2599 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
2600 {
2601 die("Couldn't process git-diff-tree line : $_");
2602 }
e02cd638
JH
2603 my ($mode, $hash, $change) = ($1, $2, $3);
2604 my $name = <FILELIST>;
2605 chomp($name);
3fda8c4c 2606
e02cd638 2607 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
3fda8c4c
ML
2608
2609 my $git_perms = "";
e02cd638
JH
2610 $git_perms .= "r" if ( $mode & 4 );
2611 $git_perms .= "w" if ( $mode & 2 );
2612 $git_perms .= "x" if ( $mode & 1 );
3fda8c4c
ML
2613 $git_perms = "rw" if ( $git_perms eq "" );
2614
e02cd638 2615 if ( $change eq "D" )
3fda8c4c 2616 {
e02cd638
JH
2617 #$log->debug("DELETE $name");
2618 $head->{$name} = {
2619 name => $name,
2620 revision => $head->{$name}{revision} + 1,
3fda8c4c
ML
2621 filehash => "deleted",
2622 commithash => $commit->{hash},
2623 modified => $commit->{date},
2624 author => $commit->{author},
2625 mode => $git_perms,
2626 };
e02cd638 2627 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c 2628 }
e02cd638 2629 elsif ( $change eq "M" )
3fda8c4c 2630 {
e02cd638
JH
2631 #$log->debug("MODIFIED $name");
2632 $head->{$name} = {
2633 name => $name,
2634 revision => $head->{$name}{revision} + 1,
2635 filehash => $hash,
3fda8c4c
ML
2636 commithash => $commit->{hash},
2637 modified => $commit->{date},
2638 author => $commit->{author},
2639 mode => $git_perms,
2640 };
e02cd638 2641 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c 2642 }
e02cd638 2643 elsif ( $change eq "A" )
3fda8c4c 2644 {
e02cd638
JH
2645 #$log->debug("ADDED $name");
2646 $head->{$name} = {
2647 name => $name,
a7da9adb 2648 revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
e02cd638 2649 filehash => $hash,
3fda8c4c
ML
2650 commithash => $commit->{hash},
2651 modified => $commit->{date},
2652 author => $commit->{author},
2653 mode => $git_perms,
2654 };
e02cd638 2655 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c
ML
2656 }
2657 else
2658 {
e02cd638 2659 $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
3fda8c4c
ML
2660 die;
2661 }
2662 }
2663 close FILELIST;
2664 } else {
2665 # this is used to detect files removed from the repo
2666 my $seen_files = {};
2667
e02cd638
JH
2668 my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2669 local $/ = "\0";
3fda8c4c
ML
2670 while ( <FILELIST> )
2671 {
e02cd638
JH
2672 chomp;
2673 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
3fda8c4c
ML
2674 {
2675 die("Couldn't process git-ls-tree line : $_");
2676 }
2677
2678 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2679
2680 $seen_files->{$git_filename} = 1;
2681
2682 my ( $oldhash, $oldrevision, $oldmode ) = (
2683 $head->{$git_filename}{filehash},
2684 $head->{$git_filename}{revision},
2685 $head->{$git_filename}{mode}
2686 );
2687
2688 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2689 {
2690 $git_perms = "";
2691 $git_perms .= "r" if ( $1 & 4 );
2692 $git_perms .= "w" if ( $1 & 2 );
2693 $git_perms .= "x" if ( $1 & 1 );
2694 } else {
2695 $git_perms = "rw";
2696 }
2697
2698 # unless the file exists with the same hash, we need to update it ...
2699 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2700 {
2701 my $newrevision = ( $oldrevision or 0 ) + 1;
2702
2703 $head->{$git_filename} = {
2704 name => $git_filename,
2705 revision => $newrevision,
2706 filehash => $git_hash,
2707 commithash => $commit->{hash},
2708 modified => $commit->{date},
2709 author => $commit->{author},
2710 mode => $git_perms,
2711 };
2712
2713
96256bba 2714 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
3fda8c4c
ML
2715 }
2716 }
2717 close FILELIST;
2718
2719 # Detect deleted files
2720 foreach my $file ( keys %$head )
2721 {
2722 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2723 {
2724 $head->{$file}{revision}++;
2725 $head->{$file}{filehash} = "deleted";
2726 $head->{$file}{commithash} = $commit->{hash};
2727 $head->{$file}{modified} = $commit->{date};
2728 $head->{$file}{author} = $commit->{author};
2729
96256bba 2730 $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
3fda8c4c
ML
2731 }
2732 }
2733 # END : "Detect deleted files"
2734 }
2735
2736
2737 if (exists $commit->{mergemsg})
2738 {
96256bba 2739 $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
3fda8c4c
ML
2740 }
2741
2742 $lastpicked = $commit->{hash};
2743
2744 $self->_set_prop("last_commit", $commit->{hash});
2745 }
2746
96256bba 2747 $self->delete_head();
3fda8c4c
ML
2748 foreach my $file ( keys %$head )
2749 {
96256bba 2750 $self->insert_head(
3fda8c4c
ML
2751 $file,
2752 $head->{$file}{revision},
2753 $head->{$file}{filehash},
2754 $head->{$file}{commithash},
2755 $head->{$file}{modified},
2756 $head->{$file}{author},
2757 $head->{$file}{mode},
2758 );
2759 }
2760 # invalidate the gethead cache
2761 $self->{gethead_cache} = undef;
2762
2763
2764 # Ending exclusive lock here
2765 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2766}
2767
96256bba
JS
2768sub insert_rev
2769{
2770 my $self = shift;
2771 my $name = shift;
2772 my $revision = shift;
2773 my $filehash = shift;
2774 my $commithash = shift;
2775 my $modified = shift;
2776 my $author = shift;
2777 my $mode = shift;
2778
2779 my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2780 $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2781}
2782
2783sub insert_mergelog
2784{
2785 my $self = shift;
2786 my $key = shift;
2787 my $value = shift;
2788
2789 my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2790 $insert_mergelog->execute($key, $value);
2791}
2792
2793sub delete_head
2794{
2795 my $self = shift;
2796
2797 my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2798 $delete_head->execute();
2799}
2800
2801sub insert_head
2802{
2803 my $self = shift;
2804 my $name = shift;
2805 my $revision = shift;
2806 my $filehash = shift;
2807 my $commithash = shift;
2808 my $modified = shift;
2809 my $author = shift;
2810 my $mode = shift;
2811
2812 my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2813 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2814}
2815
3fda8c4c
ML
2816sub _headrev
2817{
2818 my $self = shift;
2819 my $filename = shift;
2820
2821 my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2822 $db_query->execute($filename);
2823 my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2824
2825 return ( $hash, $revision, $mode );
2826}
2827
2828sub _get_prop
2829{
2830 my $self = shift;
2831 my $key = shift;
2832
2833 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2834 $db_query->execute($key);
2835 my ( $value ) = $db_query->fetchrow_array;
2836
2837 return $value;
2838}
2839
2840sub _set_prop
2841{
2842 my $self = shift;
2843 my $key = shift;
2844 my $value = shift;
2845
2846 my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2847 $db_query->execute($value, $key);
2848
2849 unless ( $db_query->rows )
2850 {
2851 $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2852 $db_query->execute($key, $value);
2853 }
2854
2855 return $value;
2856}
2857
2858=head2 gethead
2859
2860=cut
2861
2862sub gethead
2863{
2864 my $self = shift;
2865
2866 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2867
501c7372 2868 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
3fda8c4c
ML
2869 $db_query->execute();
2870
2871 my $tree = [];
2872 while ( my $file = $db_query->fetchrow_hashref )
2873 {
2874 push @$tree, $file;
2875 }
2876
2877 $self->{gethead_cache} = $tree;
2878
2879 return $tree;
2880}
2881
2882=head2 getlog
2883
2884=cut
2885
2886sub getlog
2887{
2888 my $self = shift;
2889 my $filename = shift;
2890
2891 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2892 $db_query->execute($filename);
2893
2894 my $tree = [];
2895 while ( my $file = $db_query->fetchrow_hashref )
2896 {
2897 push @$tree, $file;
2898 }
2899
2900 return $tree;
2901}
2902
2903=head2 getmeta
2904
2905This function takes a filename (with path) argument and returns a hashref of
2906metadata for that file.
2907
2908=cut
2909
2910sub getmeta
2911{
2912 my $self = shift;
2913 my $filename = shift;
2914 my $revision = shift;
2915
2916 my $db_query;
2917 if ( defined($revision) and $revision =~ /^\d+$/ )
2918 {
2919 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2920 $db_query->execute($filename, $revision);
2921 }
2922 elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2923 {
2924 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2925 $db_query->execute($filename, $revision);
2926 } else {
2927 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2928 $db_query->execute($filename);
2929 }
2930
2931 return $db_query->fetchrow_hashref;
2932}
2933
2934=head2 commitmessage
2935
2936this function takes a commithash and returns the commit message for that commit
2937
2938=cut
2939sub commitmessage
2940{
2941 my $self = shift;
2942 my $commithash = shift;
2943
2944 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2945
2946 my $db_query;
2947 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2948 $db_query->execute($commithash);
2949
2950 my ( $message ) = $db_query->fetchrow_array;
2951
2952 if ( defined ( $message ) )
2953 {
2954 $message .= " " if ( $message =~ /\n$/ );
2955 return $message;
2956 }
2957
2958 my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2959 shift @lines while ( $lines[0] =~ /\S/ );
2960 $message = join("",@lines);
2961 $message .= " " if ( $message =~ /\n$/ );
2962 return $message;
2963}
2964
2965=head2 gethistory
2966
2967This function takes a filename (with path) argument and returns an arrayofarrays
2968containing revision,filehash,commithash ordered by revision descending
2969
2970=cut
2971sub gethistory
2972{
2973 my $self = shift;
2974 my $filename = shift;
2975
2976 my $db_query;
2977 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2978 $db_query->execute($filename);
2979
2980 return $db_query->fetchall_arrayref;
2981}
2982
2983=head2 gethistorydense
2984
2985This function takes a filename (with path) argument and returns an arrayofarrays
2986containing revision,filehash,commithash ordered by revision descending.
2987
2988This version of gethistory skips deleted entries -- so it is useful for annotate.
2989The 'dense' part is a reference to a '--dense' option available for git-rev-list
2990and other git tools that depend on it.
2991
2992=cut
2993sub gethistorydense
2994{
2995 my $self = shift;
2996 my $filename = shift;
2997
2998 my $db_query;
2999 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
3000 $db_query->execute($filename);
3001
3002 return $db_query->fetchall_arrayref;
3003}
3004
3005=head2 in_array()
3006
3007from Array::PAT - mimics the in_array() function
3008found in PHP. Yuck but works for small arrays.
3009
3010=cut
3011sub in_array
3012{
3013 my ($check, @array) = @_;
3014 my $retval = 0;
3015 foreach my $test (@array){
3016 if($check eq $test){
3017 $retval = 1;
3018 }
3019 }
3020 return $retval;
3021}
3022
3023=head2 safe_pipe_capture
3024
5348b6e7 3025an alternative to `command` that allows input to be passed as an array
3fda8c4c
ML
3026to work around shell problems with weird characters in arguments
3027
3028=cut
3029sub safe_pipe_capture {
3030
3031 my @output;
3032
3033 if (my $pid = open my $child, '-|') {
3034 @output = (<$child>);
3035 close $child or die join(' ',@_).": $! $?";
3036 } else {
3037 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
3038 }
3039 return wantarray ? @output : join('',@output);
3040}
3041
eb1780d4
FL
3042=head2 mangle_dirname
3043
3044create a string from a directory name that is suitable to use as
3045part of a filename, mainly by converting all chars except \w.- to _
3046
3047=cut
3048sub mangle_dirname {
3049 my $dirname = shift;
3050 return unless defined $dirname;
3051
3052 $dirname =~ s/[^\w.-]/_/g;
3053
3054 return $dirname;
3055}
3fda8c4c
ML
3056
30571;