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