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