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