cvsserver: Add version awareness to argsfromdir
[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
d66e8f8c
MO
2229# Used by argsfromdir
2230sub expandArg
3fda8c4c 2231{
d66e8f8c 2232 my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
3fda8c4c 2233
d66e8f8c 2234 my $fullPath = filecleanup($path);
7d90095a 2235
d66e8f8c
MO
2236 # Is it a directory?
2237 if( defined($state->{dirMap}{$fullPath}) ||
2238 defined($state->{dirMap}{"$fullPath/"}) )
2239 {
2240 # It is a directory in the user's sandbox.
2241 $isDir=1;
7d90095a 2242
d66e8f8c
MO
2243 if(defined($state->{entries}{$fullPath}))
2244 {
2245 $log->fatal("Inconsistent file/dir type");
2246 die "Inconsistent file/dir type";
2247 }
2248 }
2249 elsif(defined($state->{entries}{$fullPath}))
2250 {
2251 # It is a file in the user's sandbox.
2252 $isDir=0;
2253 }
2254 my($revDirMap,$otherRevDirMap);
2255 if(!defined($isDir) || $isDir)
2256 {
2257 # Resolve version tree for sticky tag:
2258 # (for now we only want list of files for the version, not
2259 # particular versions of those files: assume it is a directory
2260 # for the moment; ignore Entry's stick tag)
2261
2262 # Order of precedence of sticky tags:
2263 # -A [head]
2264 # -r /tag/
2265 # [file entry sticky tag, but that is only relevant to files]
2266 # [the tag specified in dir req_Sticky]
2267 # [the tag specified in a parent dir req_Sticky]
2268 # [head]
2269 # Also, -r may appear twice (for diff).
2270 #
2271 # FUTURE: When/if -j (merges) are supported, we also
2272 # need to add relevant files from one or two
2273 # versions specified with -j.
2274
2275 if(exists($state->{opt}{A}))
2276 {
2277 $revDirMap=$updater->getRevisionDirMap();
2278 }
2279 elsif( defined($state->{opt}{r}) and
2280 ref $state->{opt}{r} eq "ARRAY" )
2281 {
2282 $revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
2283 $otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
2284 }
2285 elsif(defined($state->{opt}{r}))
2286 {
2287 $revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
2288 }
2289 else
2290 {
2291 my($sticky)=getDirStickyInfo($fullPath);
2292 $revDirMap=$updater->getRevisionDirMap($sticky->{tag});
2293 }
0a7a9a12 2294
d66e8f8c
MO
2295 # Is it a directory?
2296 if( defined($revDirMap->{$fullPath}) ||
2297 defined($otherRevDirMap->{$fullPath}) )
2298 {
2299 $isDir=1;
2300 }
0a7a9a12
JS
2301 }
2302
d66e8f8c
MO
2303 # What to do with it?
2304 if(!$isDir)
82000d74 2305 {
d66e8f8c
MO
2306 $outNameMap->{$fullPath}=1;
2307 }
2308 else
2309 {
2310 $outDirMap->{$fullPath}=1;
3fda8c4c 2311
d66e8f8c
MO
2312 if(defined($revDirMap->{$fullPath}))
2313 {
2314 addDirMapFiles($updater,$outNameMap,$outDirMap,
2315 $revDirMap->{$fullPath});
2316 }
2317 if( defined($otherRevDirMap) &&
2318 defined($otherRevDirMap->{$fullPath}) )
82000d74 2319 {
d66e8f8c
MO
2320 addDirMapFiles($updater,$outNameMap,$outDirMap,
2321 $otherRevDirMap->{$fullPath});
82000d74 2322 }
d66e8f8c
MO
2323 }
2324}
82000d74 2325
d66e8f8c
MO
2326# Used by argsfromdir
2327# Add entries from dirMap to outNameMap. Also recurse into entries
2328# that are subdirectories.
2329sub addDirMapFiles
2330{
2331 my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
82000d74 2332
d66e8f8c
MO
2333 my($fullName);
2334 foreach $fullName (keys(%$dirMap))
2335 {
2336 my $cleanName=$fullName;
2337 if(defined($state->{prependdir}))
2338 {
2339 if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
2340 {
2341 $log->fatal("internal error stripping prependdir");
2342 die "internal error stripping prependdir";
2343 }
2344 }
82000d74 2345
d66e8f8c
MO
2346 if($dirMap->{$fullName} eq "F")
2347 {
2348 $outNameMap->{$cleanName}=1;
2349 }
2350 elsif($dirMap->{$fullName} eq "D")
2351 {
2352 if(!$state->{opt}{l})
2353 {
2354 expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
2355 }
2356 }
2357 else
82000d74 2358 {
d66e8f8c
MO
2359 $log->fatal("internal error in addDirMapFiles");
2360 die "internal error in addDirMapFiles";
82000d74 2361 }
3fda8c4c
ML
2362 }
2363}
2364
d66e8f8c
MO
2365# This method replaces $state->{args} with a directory-expanded
2366# list of all relevant filenames (recursively unless -d), based
2367# on $state->{entries}, and the "current" list of files in
2368# each directory. "Current" files as determined by
2369# either the requested (-r/-A) or "req_Sticky" version of
2370# that directory.
2371# Both the input args and the new output args are relative
2372# to the cvs-client's CWD, although some of the internal
2373# computations are relative to the top of the project.
2374sub argsfromdir
2375{
2376 my $updater = shift;
2377
2378 # Notes about requirements for specific callers:
2379 # update # "standard" case (entries; a single -r/-A/default; -l)
2380 # # Special case: -d for create missing directories.
2381 # diff # 0 or 1 -r's: "standard" case.
2382 # # 2 -r's: We could ignore entries (just use the two -r's),
2383 # # but it doesn't really matter.
2384 # annotate # "standard" case
2385 # log # Punting: log -r has a more complex non-"standard"
2386 # # meaning, and we don't currently try to support log'ing
2387 # # branches at all (need a lot of work to
2388 # # support CVS-consistent branch relative version
2389 # # numbering).
2390#HERE: But we still want to expand directories. Maybe we should
2391# essentially force "-A".
2392 # status # "standard", except that -r/-A/default are not possible.
2393 # # Mostly only used to expand entries only)
2394 #
2395 # Don't use argsfromdir at all:
2396 # add # Explicit arguments required. Directory args imply add
2397 # # the directory itself, not the files in it.
2398 # co # Obtain list directly.
2399 # remove # HERE: TEST: MAYBE client does the recursion for us,
2400 # # since it only makes sense to remove stuff already in
2401 # # the sandobx?
2402 # ci # HERE: Similar to remove...
2403 # # Don't try to implement the confusing/weird
2404 # # ci -r bug er.."feature".
2405
2406 if(scalar(@{$state->{args}})==0)
2407 {
2408 $state->{args} = [ "." ];
2409 }
2410 my %allArgs;
2411 my %allDirs;
2412 for my $file (@{$state->{args}})
2413 {
2414 expandArg($updater,\%allArgs,\%allDirs,$file);
2415 }
2416
2417 # Include any entries from sandbox. Generally client won't
2418 # send entries that shouldn't be used.
2419 foreach my $file (keys %{$state->{entries}})
2420 {
2421 $allArgs{remove_prependdir($file)} = 1;
2422 }
2423
2424 $state->{dirArgs} = \%allDirs;
2425 $state->{args} = [
2426 sort {
2427 # Sort priority: by directory depth, then actual file name:
2428 my @piecesA=split('/',$a);
2429 my @piecesB=split('/',$b);
2430
2431 my $count=scalar(@piecesA);
2432 my $tmp=scalar(@piecesB);
2433 return $count<=>$tmp if($count!=$tmp);
2434
2435 for($tmp=0;$tmp<$count;$tmp++)
2436 {
2437 if($piecesA[$tmp] ne $piecesB[$tmp])
2438 {
2439 return $piecesA[$tmp] cmp $piecesB[$tmp]
2440 }
2441 }
2442 return 0;
2443 } keys(%allArgs) ];
2444}
eb5dcb2c
MO
2445
2446## look up directory sticky tag, of either fullPath or a parent:
2447sub getDirStickyInfo
2448{
2449 my($fullPath)=@_;
2450
2451 $fullPath=~s%/+$%%;
2452 while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
2453 {
2454 $fullPath=~s%/?[^/]*$%%;
2455 }
2456
2457 if( !defined($state->{dirMap}{"$fullPath/"}) &&
2458 ( $fullPath eq "" ||
2459 $fullPath eq "." ) )
2460 {
2461 return $state->{dirMap}{""}{stickyInfo};
2462 }
2463 else
2464 {
2465 return $state->{dirMap}{"$fullPath/"}{stickyInfo};
2466 }
2467}
2468
2469# Resolve precedence of various ways of specifying which version of
2470# a file you want. Returns undef (for default head), or a ref to a hash
2471# that contains "tag" and/or "date" keys.
2472sub resolveStickyInfo
2473{
2474 my($filename,$stickyTag,$stickyDate,$reset) = @_;
2475
2476 # Order of precedence of sticky tags:
2477 # -A [head]
2478 # -r /tag/
2479 # [file entry sticky tag]
2480 # [the tag specified in dir req_Sticky]
2481 # [the tag specified in a parent dir req_Sticky]
2482 # [head]
2483
2484 my $result;
2485 if($reset)
2486 {
2487 # $result=undef;
2488 }
2489 elsif( defined($stickyTag) && $stickyTag ne "" )
2490 # || ( defined($stickyDate) && $stickyDate ne "" ) # TODO
2491 {
2492 $result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
2493
2494 # TODO: Convert -D value into the form 2011.04.10.04.46.57,
2495 # similar to an entry line's sticky date, without the D prefix.
2496 # It sometimes (always?) arrives as something more like
2497 # '10 Apr 2011 04:46:57 -0000'...
2498 # $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
2499 }
2500 elsif( defined($state->{entries}{$filename}) &&
2501 defined($state->{entries}{$filename}{tag_or_date}) &&
2502 $state->{entries}{$filename}{tag_or_date} ne "" )
2503 {
2504 my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
2505 if($tagOrDate=~/^T([^ ]+)\s*$/)
2506 {
2507 $result = { 'tag' => $1 };
2508 }
2509 elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
2510 {
2511 $result= { 'date' => $1 };
2512 }
2513 else
2514 {
2515 die "Unknown tag_or_date format\n";
2516 }
2517 }
2518 else
2519 {
2520 $result=getDirStickyInfo($filename);
2521 }
2522
2523 return $result;
2524}
2525
2526# Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into
2527# a form appropriate for the sticky tag field of an Entries
2528# line (field index 5, 0-based).
2529sub getStickyTagOrDate
2530{
2531 my($stickyInfo)=@_;
2532
2533 my $result;
2534 if(defined($stickyInfo) && defined($stickyInfo->{tag}))
2535 {
2536 $result="T$stickyInfo->{tag}";
2537 }
2538 # TODO: When/if we actually pick versions by {date} properly,
2539 # also handle it here:
2540 # "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").
2541 else
2542 {
2543 $result="";
2544 }
2545
2546 return $result;
2547}
2548
3fda8c4c
ML
2549# This method cleans up the $state variable after a command that uses arguments has run
2550sub statecleanup
2551{
2552 $state->{files} = [];
d66e8f8c 2553 $state->{dirArgs} = {};
3fda8c4c
ML
2554 $state->{args} = [];
2555 $state->{arguments} = [];
2556 $state->{entries} = {};
eb5dcb2c 2557 $state->{dirMap} = {};
3fda8c4c
ML
2558}
2559
ab07681f 2560# Return working directory CVS revision "1.X" out
196e48f4 2561# of the the working directory "entries" state, for the given filename.
ab07681f 2562# This is prefixed with a dash if the file is scheduled for removal
196e48f4 2563# when it is committed.
3fda8c4c
ML
2564sub revparse
2565{
2566 my $filename = shift;
2567
ab07681f 2568 return $state->{entries}{$filename}{revision};
3fda8c4c
ML
2569}
2570
e78f69a3
DD
2571# This method takes a file hash and does a CVS "file transfer". Its
2572# exact behaviour depends on a second, optional hash table argument:
2573# - If $options->{targetfile}, dump the contents to that file;
2574# - If $options->{print}, use M/MT to transmit the contents one line
2575# at a time;
2576# - Otherwise, transmit the size of the file, followed by the file
2577# contents.
3fda8c4c
ML
2578sub transmitfile
2579{
2580 my $filehash = shift;
e78f69a3 2581 my $options = shift;
3fda8c4c
ML
2582
2583 if ( defined ( $filehash ) and $filehash eq "deleted" )
2584 {
2585 $log->warn("filehash is 'deleted'");
2586 return;
2587 }
2588
2589 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
2590
d2feb01a 2591 my $type = `git cat-file -t $filehash`;
3fda8c4c
ML
2592 chomp $type;
2593
2594 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2595
d2feb01a 2596 my $size = `git cat-file -s $filehash`;
3fda8c4c
ML
2597 chomp $size;
2598
2599 $log->debug("transmitfile($filehash) size=$size, type=$type");
2600
d2feb01a 2601 if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
3fda8c4c 2602 {
e78f69a3 2603 if ( defined ( $options->{targetfile} ) )
3fda8c4c 2604 {
e78f69a3 2605 my $targetfile = $options->{targetfile};
3fda8c4c
ML
2606 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2607 print NEWFILE $_ while ( <$fh> );
a5e40798 2608 close NEWFILE or die("Failed to write '$targetfile': $!");
e78f69a3
DD
2609 } elsif ( defined ( $options->{print} ) && $options->{print} ) {
2610 while ( <$fh> ) {
2611 if( /\n\z/ ) {
2612 print 'M ', $_;
2613 } else {
2614 print 'MT text ', $_, "\n";
2615 }
2616 }
3fda8c4c
ML
2617 } else {
2618 print "$size\n";
2619 print while ( <$fh> );
2620 }
a5e40798 2621 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
3fda8c4c
ML
2622 } else {
2623 die("Couldn't execute git-cat-file");
2624 }
2625}
2626
2627# This method takes a file name, and returns ( $dirpart, $filepart ) which
5348b6e7 2628# refers to the directory portion and the file portion of the filename
3fda8c4c
ML
2629# respectively
2630sub filenamesplit
2631{
2632 my $filename = shift;
7d90095a 2633 my $fixforlocaldir = shift;
3fda8c4c
ML
2634
2635 my ( $filepart, $dirpart ) = ( $filename, "." );
2636 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2637 $dirpart .= "/";
2638
7d90095a
MS
2639 if ( $fixforlocaldir )
2640 {
2641 $dirpart =~ s/^$state->{prependdir}//;
2642 }
2643
3fda8c4c
ML
2644 return ( $filepart, $dirpart );
2645}
2646
1899cbc5
MO
2647# Cleanup various junk in filename (try to canonicalize it), and
2648# add prependdir to accomodate running CVS client from a
2649# subdirectory (so the output is relative to top directory of the project).
3fda8c4c
ML
2650sub filecleanup
2651{
2652 my $filename = shift;
2653
2654 return undef unless(defined($filename));
2655 if ( $filename =~ /^\// )
2656 {
2657 print "E absolute filenames '$filename' not supported by server\n";
2658 return undef;
2659 }
2660
1899cbc5
MO
2661 if($filename eq ".")
2662 {
2663 $filename="";
2664 }
3fda8c4c 2665 $filename =~ s/^\.\///g;
1899cbc5 2666 $filename =~ s%/+%/%g;
82000d74 2667 $filename = $state->{prependdir} . $filename;
1899cbc5 2668 $filename =~ s%/$%%;
3fda8c4c
ML
2669 return $filename;
2670}
2671
1899cbc5
MO
2672# Remove prependdir from the path, so that is is relative to the directory
2673# the CVS client was started from, rather than the top of the project.
2674# Essentially the inverse of filecleanup().
2675sub remove_prependdir
2676{
2677 my($path) = @_;
2678 if(defined($state->{prependdir}) && $state->{prependdir} ne "")
2679 {
2680 my($pre)=$state->{prependdir};
2681 $pre=~s%/$%%;
2682 if(!($path=~s%^\Q$pre\E/?%%))
2683 {
2684 $log->fatal("internal error missing prependdir");
2685 die("internal error missing prependdir");
2686 }
2687 }
2688 return $path;
2689}
2690
044182ef
MO
2691sub validateGitDir
2692{
2693 if( !defined($state->{CVSROOT}) )
2694 {
2695 print "error 1 CVSROOT not specified\n";
2696 cleanupWorkTree();
2697 exit;
2698 }
2699 if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
2700 {
2701 print "error 1 Internally inconsistent CVSROOT\n";
2702 cleanupWorkTree();
2703 exit;
2704 }
2705}
2706
2707# Setup working directory in a work tree with the requested version
2708# loaded in the index.
2709sub setupWorkTree
2710{
2711 my ($ver) = @_;
2712
2713 validateGitDir();
2714
2715 if( ( defined($work->{state}) && $work->{state} != 1 ) ||
2716 defined($work->{tmpDir}) )
2717 {
2718 $log->warn("Bad work tree state management");
2719 print "error 1 Internal setup multiple work trees without cleanup\n";
2720 cleanupWorkTree();
2721 exit;
2722 }
2723
2724 $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
2725
2726 if( !defined($work->{index}) )
2727 {
2728 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2729 }
2730
2731 chdir $work->{workDir} or
2732 die "Unable to chdir to $work->{workDir}\n";
2733
2734 $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
2735
2736 $ENV{GIT_WORK_TREE} = ".";
2737 $ENV{GIT_INDEX_FILE} = $work->{index};
2738 $work->{state} = 2;
2739
2740 if($ver)
2741 {
2742 system("git","read-tree",$ver);
2743 unless ($? == 0)
2744 {
2745 $log->warn("Error running git-read-tree");
2746 die "Error running git-read-tree $ver in $work->{workDir} $!\n";
2747 }
2748 }
2749 # else # req_annotate reads tree for each file
2750}
2751
2752# Ensure current directory is in some kind of working directory,
2753# with a recent version loaded in the index.
2754sub ensureWorkTree
2755{
2756 if( defined($work->{tmpDir}) )
2757 {
2758 $log->warn("Bad work tree state management [ensureWorkTree()]");
2759 print "error 1 Internal setup multiple dirs without cleanup\n";
2760 cleanupWorkTree();
2761 exit;
2762 }
2763 if( $work->{state} )
2764 {
2765 return;
2766 }
2767
2768 validateGitDir();
2769
2770 if( !defined($work->{emptyDir}) )
2771 {
2772 $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
2773 }
2774 chdir $work->{emptyDir} or
2775 die "Unable to chdir to $work->{emptyDir}\n";
2776
2777 my $ver = `git show-ref -s refs/heads/$state->{module}`;
2778 chomp $ver;
2779 if ($ver !~ /^[0-9a-f]{40}$/)
2780 {
2781 $log->warn("Error from git show-ref -s refs/head$state->{module}");
2782 print "error 1 cannot find the current HEAD of module";
2783 cleanupWorkTree();
2784 exit;
2785 }
2786
2787 if( !defined($work->{index}) )
2788 {
2789 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2790 }
2791
2792 $ENV{GIT_WORK_TREE} = ".";
2793 $ENV{GIT_INDEX_FILE} = $work->{index};
2794 $work->{state} = 1;
2795
2796 system("git","read-tree",$ver);
2797 unless ($? == 0)
2798 {
2799 die "Error running git-read-tree $ver $!\n";
2800 }
2801}
2802
2803# Cleanup working directory that is not needed any longer.
2804sub cleanupWorkTree
2805{
2806 if( ! $work->{state} )
2807 {
2808 return;
2809 }
2810
2811 chdir "/" or die "Unable to chdir '/'\n";
2812
2813 if( defined($work->{workDir}) )
2814 {
2815 rmtree( $work->{workDir} );
2816 undef $work->{workDir};
2817 }
2818 undef $work->{state};
2819}
2820
2821# Setup a temporary directory (not a working tree), typically for
2822# merging dirty state as in req_update.
2823sub setupTmpDir
2824{
2825 $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
2826 chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
2827
2828 return $work->{tmpDir};
2829}
2830
2831# Clean up a previously setupTmpDir. Restore previous work tree if
2832# appropriate.
2833sub cleanupTmpDir
2834{
2835 if ( !defined($work->{tmpDir}) )
2836 {
2837 $log->warn("cleanup tmpdir that has not been setup");
2838 die "Cleanup tmpDir that has not been setup\n";
2839 }
2840 if( defined($work->{state}) )
2841 {
2842 if( $work->{state} == 1 )
2843 {
2844 chdir $work->{emptyDir} or
2845 die "Unable to chdir to $work->{emptyDir}\n";
2846 }
2847 elsif( $work->{state} == 2 )
2848 {
2849 chdir $work->{workDir} or
2850 die "Unable to chdir to $work->{emptyDir}\n";
2851 }
2852 else
2853 {
2854 $log->warn("Inconsistent work dir state");
2855 die "Inconsistent work dir state\n";
2856 }
2857 }
2858 else
2859 {
2860 chdir "/" or die "Unable to chdir '/'\n";
2861 }
2862}
2863
8538e876
AP
2864# Given a path, this function returns a string containing the kopts
2865# that should go into that path's Entries line. For example, a binary
2866# file should get -kb.
2867sub kopts_from_path
2868{
90948a42 2869 my ($path, $srcType, $name) = @_;
8538e876 2870
8a06a632
MO
2871 if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
2872 $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
2873 {
5ec3e670
EB
2874 my ($val) = check_attr( "text", $path );
2875 if ( $val eq "unspecified" )
8a06a632 2876 {
5ec3e670 2877 $val = check_attr( "crlf", $path );
8a06a632 2878 }
5ec3e670 2879 if ( $val eq "unset" )
8a06a632
MO
2880 {
2881 return "-kb"
2882 }
5ec3e670
EB
2883 elsif ( check_attr( "eol", $path ) ne "unspecified" ||
2884 $val eq "set" || $val eq "input" )
2885 {
2886 return "";
2887 }
8a06a632
MO
2888 else
2889 {
2890 $log->info("Unrecognized check_attr crlf $path : $val");
2891 }
2892 }
8538e876 2893
90948a42 2894 if ( defined ( $cfg->{gitcvs}{allbinary} ) )
8538e876 2895 {
90948a42
MO
2896 if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
2897 {
2898 return "-kb";
2899 }
2900 elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
2901 {
39b6a4bd 2902 if( is_binary($srcType,$name) )
90948a42 2903 {
39b6a4bd
MO
2904 $log->debug("... as binary");
2905 return "-kb";
90948a42
MO
2906 }
2907 else
2908 {
39b6a4bd 2909 $log->debug("... as text");
90948a42
MO
2910 }
2911 }
8538e876 2912 }
90948a42
MO
2913 # Return "" to give no special treatment to any path
2914 return "";
8538e876
AP
2915}
2916
8a06a632
MO
2917sub check_attr
2918{
2919 my ($attr,$path) = @_;
2920 ensureWorkTree();
2921 if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
2922 {
2923 my $val = <$fh>;
2924 close $fh;
2925 $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
2926 return $val;
2927 }
2928 else
2929 {
2930 return undef;
2931 }
2932}
2933
90948a42
MO
2934# This should have the same heuristics as convert.c:is_binary() and related.
2935# Note that the bare CR test is done by callers in convert.c.
2936sub is_binary
2937{
2938 my ($srcType,$name) = @_;
2939 $log->debug("is_binary($srcType,$name)");
2940
2941 # Minimize amount of interpreted code run in the inner per-character
2942 # loop for large files, by totalling each character value and
2943 # then analyzing the totals.
2944 my @counts;
2945 my $i;
2946 for($i=0;$i<256;$i++)
2947 {
2948 $counts[$i]=0;
2949 }
2950
2951 my $fh = open_blob_or_die($srcType,$name);
2952 my $line;
2953 while( defined($line=<$fh>) )
2954 {
2955 # Any '\0' and bare CR are considered binary.
2956 if( $line =~ /\0|(\r[^\n])/ )
2957 {
2958 close($fh);
2959 return 1;
2960 }
2961
2962 # Count up each character in the line:
2963 my $len=length($line);
2964 for($i=0;$i<$len;$i++)
2965 {
2966 $counts[ord(substr($line,$i,1))]++;
2967 }
2968 }
2969 close $fh;
2970
2971 # Don't count CR and LF as either printable/nonprintable
2972 $counts[ord("\n")]=0;
2973 $counts[ord("\r")]=0;
2974
2975 # Categorize individual character count into printable and nonprintable:
2976 my $printable=0;
2977 my $nonprintable=0;
2978 for($i=0;$i<256;$i++)
2979 {
2980 if( $i < 32 &&
2981 $i != ord("\b") &&
2982 $i != ord("\t") &&
2983 $i != 033 && # ESC
2984 $i != 014 ) # FF
2985 {
2986 $nonprintable+=$counts[$i];
2987 }
2988 elsif( $i==127 ) # DEL
2989 {
2990 $nonprintable+=$counts[$i];
2991 }
2992 else
2993 {
2994 $printable+=$counts[$i];
2995 }
2996 }
2997
2998 return ($printable >> 7) < $nonprintable;
2999}
3000
3001# Returns open file handle. Possible invocations:
3002# - open_blob_or_die("file",$filename);
3003# - open_blob_or_die("sha1",$filehash);
3004sub open_blob_or_die
3005{
3006 my ($srcType,$name) = @_;
3007 my ($fh);
3008 if( $srcType eq "file" )
3009 {
3010 if( !open $fh,"<",$name )
3011 {
3012 $log->warn("Unable to open file $name: $!");
3013 die "Unable to open file $name: $!\n";
3014 }
3015 }
39b6a4bd 3016 elsif( $srcType eq "sha1" )
90948a42
MO
3017 {
3018 unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{40}$/ )
3019 {
3020 $log->warn("Need filehash");
3021 die "Need filehash\n";
3022 }
3023
3024 my $type = `git cat-file -t $name`;
3025 chomp $type;
3026
3027 unless ( defined ( $type ) and $type eq "blob" )
3028 {
3029 $log->warn("Invalid type '$type' for '$name'");
3030 die ( "Invalid type '$type' (expected 'blob')" )
3031 }
3032
3033 my $size = `git cat-file -s $name`;
3034 chomp $size;
3035
3036 $log->debug("open_blob_or_die($name) size=$size, type=$type");
3037
3038 unless( open $fh, '-|', "git", "cat-file", "blob", $name )
3039 {
3040 $log->warn("Unable to open sha1 $name");
3041 die "Unable to open sha1 $name\n";
3042 }
3043 }
3044 else
3045 {
3046 $log->warn("Unknown type of blob source: $srcType");
3047 die "Unknown type of blob source: $srcType\n";
3048 }
3049 return $fh;
3050}
3051
d500a1ee
FE
3052# Generate a CVS author name from Git author information, by taking the local
3053# part of the email address and replacing characters not in the Portable
3054# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS
3055# Login names are Unix login names, which should be restricted to this
3056# character set.
c1bc3061
DD
3057sub cvs_author
3058{
3059 my $author_line = shift;
d500a1ee
FE
3060 (my $author) = $author_line =~ /<([^@>]*)/;
3061
3062 $author =~ s/[^-a-zA-Z0-9_.]/_/g;
3063 $author =~ s/^-/_/;
c1bc3061
DD
3064
3065 $author;
3066}
3067
031a027a
ÆAB
3068
3069sub descramble
3070{
3071 # This table is from src/scramble.c in the CVS source
3072 my @SHIFTS = (
3073 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
3074 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
3075 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
3076 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
3077 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
3078 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
3079 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
3080 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
3081 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
3082 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
3083 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
3084 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
3085 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
3086 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
3087 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
3088 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
3089 );
3090 my ($str) = @_;
3091
fce338a5 3092 # This should never happen, the same password format (A) has been
031a027a 3093 # used by CVS since the beginning of time
1f0eb513
ÆAB
3094 {
3095 my $fmt = substr($str, 0, 1);
3096 die "invalid password format `$fmt'" unless $fmt eq 'A';
3097 }
031a027a
ÆAB
3098
3099 my @str = unpack "C*", substr($str, 1);
3100 my $ret = join '', map { chr $SHIFTS[$_] } @str;
3101 return $ret;
3102}
3103
3104
3fda8c4c
ML
3105package GITCVS::log;
3106
3107####
3108#### Copyright The Open University UK - 2006.
3109####
3110#### Authors: Martyn Smith <martyn@catalyst.net.nz>
adc3192e 3111#### Martin Langhoff <martin@laptop.org>
3fda8c4c
ML
3112####
3113####
3114
3115use strict;
3116use warnings;
3117
3118=head1 NAME
3119
3120GITCVS::log
3121
3122=head1 DESCRIPTION
3123
3124This module provides very crude logging with a similar interface to
3125Log::Log4perl
3126
3127=head1 METHODS
3128
3129=cut
3130
3131=head2 new
3132
3133Creates a new log object, optionally you can specify a filename here to
5348b6e7 3134indicate the file to log to. If no log file is specified, you can specify one
3fda8c4c
ML
3135later with method setfile, or indicate you no longer want logging with method
3136nofile.
3137
3138Until one of these methods is called, all log calls will buffer messages ready
3139to write out.
3140
3141=cut
3142sub new
3143{
3144 my $class = shift;
3145 my $filename = shift;
3146
3147 my $self = {};
3148
3149 bless $self, $class;
3150
3151 if ( defined ( $filename ) )
3152 {
3153 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3154 }
3155
3156 return $self;
3157}
3158
3159=head2 setfile
3160
3161This methods takes a filename, and attempts to open that file as the log file.
3162If successful, all buffered data is written out to the file, and any further
3163logging is written directly to the file.
3164
3165=cut
3166sub setfile
3167{
3168 my $self = shift;
3169 my $filename = shift;
3170
3171 if ( defined ( $filename ) )
3172 {
3173 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3174 }
3175
3176 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3177
3178 while ( my $line = shift @{$self->{buffer}} )
3179 {
3180 print {$self->{fh}} $line;
3181 }
3182}
3183
3184=head2 nofile
3185
3186This method indicates no logging is going to be used. It flushes any entries in
3187the internal buffer, and sets a flag to ensure no further data is put there.
3188
3189=cut
3190sub nofile
3191{
3192 my $self = shift;
3193
3194 $self->{nolog} = 1;
3195
3196 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3197
3198 $self->{buffer} = [];
3199}
3200
3201=head2 _logopen
3202
3203Internal method. Returns true if the log file is open, false otherwise.
3204
3205=cut
3206sub _logopen
3207{
3208 my $self = shift;
3209
3210 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
3211 return 0;
3212}
3213
3214=head2 debug info warn fatal
3215
3216These four methods are wrappers to _log. They provide the actual interface for
3217logging data.
3218
3219=cut
3220sub debug { my $self = shift; $self->_log("debug", @_); }
3221sub info { my $self = shift; $self->_log("info" , @_); }
3222sub warn { my $self = shift; $self->_log("warn" , @_); }
3223sub fatal { my $self = shift; $self->_log("fatal", @_); }
3224
3225=head2 _log
3226
3227This is an internal method called by the logging functions. It generates a
3228timestamp and pushes the logged line either to file, or internal buffer.
3229
3230=cut
3231sub _log
3232{
3233 my $self = shift;
3234 my $level = shift;
3235
3236 return if ( $self->{nolog} );
3237
3238 my @time = localtime;
3239 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
3240 $time[5] + 1900,
3241 $time[4] + 1,
3242 $time[3],
3243 $time[2],
3244 $time[1],
3245 $time[0],
3246 uc $level,
3247 );
3248
3249 if ( $self->_logopen )
3250 {
3251 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
3252 } else {
3253 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
3254 }
3255}
3256
3257=head2 DESTROY
3258
3259This method simply closes the file handle if one is open
3260
3261=cut
3262sub DESTROY
3263{
3264 my $self = shift;
3265
3266 if ( $self->_logopen )
3267 {
3268 close $self->{fh};
3269 }
3270}
3271
3272package GITCVS::updater;
3273
3274####
3275#### Copyright The Open University UK - 2006.
3276####
3277#### Authors: Martyn Smith <martyn@catalyst.net.nz>
adc3192e 3278#### Martin Langhoff <martin@laptop.org>
3fda8c4c
ML
3279####
3280####
3281
3282use strict;
3283use warnings;
3284use DBI;
3285
3286=head1 METHODS
3287
3288=cut
3289
3290=head2 new
3291
3292=cut
3293sub new
3294{
3295 my $class = shift;
3296 my $config = shift;
3297 my $module = shift;
3298 my $log = shift;
3299
3300 die "Need to specify a git repository" unless ( defined($config) and -d $config );
3301 die "Need to specify a module" unless ( defined($module) );
3302
3303 $class = ref($class) || $class;
3304
3305 my $self = {};
3306
3307 bless $self, $class;
3308
6aeeffd1
JE
3309 $self->{valid_tables} = {'revision' => 1,
3310 'revision_ix1' => 1,
3311 'revision_ix2' => 1,
3312 'head' => 1,
3313 'head_ix1' => 1,
3314 'properties' => 1,
3315 'commitmsgs' => 1};
3316
3fda8c4c 3317 $self->{module} = $module;
3fda8c4c
ML
3318 $self->{git_path} = $config . "/";
3319
3320 $self->{log} = $log;
3321
3322 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
3323
658b57ad
MO
3324 # Stores full sha1's for various branch/tag names, abbreviations, etc:
3325 $self->{commitRefCache} = {};
3326
eb1780d4 3327 $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
473937ed 3328 $cfg->{gitcvs}{dbdriver} || "SQLite";
eb1780d4
FL
3329 $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
3330 $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
3331 $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
3332 $cfg->{gitcvs}{dbuser} || "";
3333 $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
3334 $cfg->{gitcvs}{dbpass} || "";
6aeeffd1
JE
3335 $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
3336 $cfg->{gitcvs}{dbtablenameprefix} || "";
eb1780d4
FL
3337 my %mapping = ( m => $module,
3338 a => $state->{method},
3339 u => getlogin || getpwuid($<) || $<,
3340 G => $self->{git_path},
3341 g => mangle_dirname($self->{git_path}),
3342 );
3343 $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
3344 $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
6aeeffd1
JE
3345 $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
3346 $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
eb1780d4 3347
473937ed
FL
3348 die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
3349 die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
3350 $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
eb1780d4
FL
3351 $self->{dbuser},
3352 $self->{dbpass});
920a449a 3353 die "Error connecting to database\n" unless defined $self->{dbh};
3fda8c4c
ML
3354
3355 $self->{tables} = {};
0cf611a3 3356 foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
3fda8c4c 3357 {
3fda8c4c
ML
3358 $self->{tables}{$table} = 1;
3359 }
3360
3361 # Construct the revision table if required
196e48f4
MO
3362 # The revision table stores an entry for each file, each time that file
3363 # changes.
3364 # numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
3365 # This is not sufficient to support "-r {commithash}" for any
3366 # files except files that were modified by that commit (also,
3367 # some places in the code ignore/effectively strip out -r in
3368 # some cases, before it gets passed to getmeta()).
3369 # The "filehash" field typically has a git blob hash, but can also
3370 # be set to "dead" to indicate that the given version of the file
3371 # should not exist in the sandbox.
6aeeffd1 3372 unless ( $self->{tables}{$self->tablename("revision")} )
3fda8c4c 3373 {
6aeeffd1
JE
3374 my $tablename = $self->tablename("revision");
3375 my $ix1name = $self->tablename("revision_ix1");
3376 my $ix2name = $self->tablename("revision_ix2");
3fda8c4c 3377 $self->{dbh}->do("
6aeeffd1 3378 CREATE TABLE $tablename (
3fda8c4c
ML
3379 name TEXT NOT NULL,
3380 revision INTEGER NOT NULL,
3381 filehash TEXT NOT NULL,
3382 commithash TEXT NOT NULL,
3383 author TEXT NOT NULL,
3384 modified TEXT NOT NULL,
3385 mode TEXT NOT NULL
3386 )
3387 ");
178e015c 3388 $self->{dbh}->do("
6aeeffd1
JE
3389 CREATE INDEX $ix1name
3390 ON $tablename (name,revision)
178e015c
SP
3391 ");
3392 $self->{dbh}->do("
6aeeffd1
JE
3393 CREATE INDEX $ix2name
3394 ON $tablename (name,commithash)
178e015c 3395 ");
3fda8c4c
ML
3396 }
3397
178e015c 3398 # Construct the head table if required
196e48f4
MO
3399 # The head table (along with the "last_commit" entry in the property
3400 # table) is the persisted working state of the "sub update" subroutine.
3401 # All of it's data is read entirely first, and completely recreated
3402 # last, every time "sub update" runs.
3403 # This is also used by "sub getmeta" when it is asked for the latest
3404 # version of a file (as opposed to some specific version).
3405 # Another way of thinking about it is as a single slice out of
3406 # "revisions", giving just the most recent revision information for
3407 # each file.
6aeeffd1 3408 unless ( $self->{tables}{$self->tablename("head")} )
3fda8c4c 3409 {
6aeeffd1
JE
3410 my $tablename = $self->tablename("head");
3411 my $ix1name = $self->tablename("head_ix1");
3fda8c4c 3412 $self->{dbh}->do("
6aeeffd1 3413 CREATE TABLE $tablename (
3fda8c4c
ML
3414 name TEXT NOT NULL,
3415 revision INTEGER NOT NULL,
3416 filehash TEXT NOT NULL,
3417 commithash TEXT NOT NULL,
3418 author TEXT NOT NULL,
3419 modified TEXT NOT NULL,
3420 mode TEXT NOT NULL
3421 )
3422 ");
178e015c 3423 $self->{dbh}->do("
6aeeffd1
JE
3424 CREATE INDEX $ix1name
3425 ON $tablename (name)
178e015c 3426 ");
3fda8c4c
ML
3427 }
3428
3429 # Construct the properties table if required
196e48f4 3430 # - "last_commit" - Used by "sub update".
6aeeffd1 3431 unless ( $self->{tables}{$self->tablename("properties")} )
3fda8c4c 3432 {
6aeeffd1 3433 my $tablename = $self->tablename("properties");
3fda8c4c 3434 $self->{dbh}->do("
6aeeffd1 3435 CREATE TABLE $tablename (
3fda8c4c
ML
3436 key TEXT NOT NULL PRIMARY KEY,
3437 value TEXT
3438 )
3439 ");
3440 }
3441
3442 # Construct the commitmsgs table if required
196e48f4
MO
3443 # The commitmsgs table is only used for merge commits, since
3444 # "sub update" will only keep one branch of parents. Shortlogs
3445 # for ignored commits (i.e. not on the chosen branch) will be used
3446 # to construct a replacement "collapsed" merge commit message,
3447 # which will be stored in this table. See also "sub commitmessage".
6aeeffd1 3448 unless ( $self->{tables}{$self->tablename("commitmsgs")} )
3fda8c4c 3449 {
6aeeffd1 3450 my $tablename = $self->tablename("commitmsgs");
3fda8c4c 3451 $self->{dbh}->do("
6aeeffd1 3452 CREATE TABLE $tablename (
3fda8c4c
ML
3453 key TEXT NOT NULL PRIMARY KEY,
3454 value TEXT
3455 )
3456 ");
3457 }
3458
3459 return $self;
3460}
3461
6aeeffd1
JE
3462=head2 tablename
3463
3464=cut
3465sub tablename
3466{
3467 my $self = shift;
3468 my $name = shift;
3469
3470 if (exists $self->{valid_tables}{$name}) {
3471 return $self->{dbtablenameprefix} . $name;
3472 } else {
3473 return undef;
3474 }
3475}
3476
3fda8c4c
ML
3477=head2 update
3478
196e48f4
MO
3479Bring the database up to date with the latest changes from
3480the git repository.
3481
3482Internal working state is read out of the "head" table and the
3483"last_commit" property, then it updates "revisions" based on that, and
3484finally it writes the new internal state back to the "head" table
3485so it can be used as a starting point the next time update is called.
3486
3fda8c4c
ML
3487=cut
3488sub update
3489{
3490 my $self = shift;
3491
3492 # first lets get the commit list
3493 $ENV{GIT_DIR} = $self->{git_path};
3494
49fb940e
ML
3495 my $commitsha1 = `git rev-parse $self->{module}`;
3496 chomp $commitsha1;
3497
3498 my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
3fda8c4c
ML
3499 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
3500 {
3501 die("Invalid module '$self->{module}'");
3502 }
3503
3504
3505 my $git_log;
3506 my $lastcommit = $self->_get_prop("last_commit");
3507
49fb940e
ML
3508 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
3509 return 1;
3510 }
3511
3fda8c4c
ML
3512 # Start exclusive lock here...
3513 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
3514
3515 # TODO: log processing is memory bound
3516 # if we can parse into a 2nd file that is in reverse order
3517 # we can probably do something really efficient
a248c961 3518 my @git_log_params = ('--pretty', '--parents', '--topo-order');
3fda8c4c
ML
3519
3520 if (defined $lastcommit) {
3521 push @git_log_params, "$lastcommit..$self->{module}";
3522 } else {
3523 push @git_log_params, $self->{module};
3524 }
a248c961 3525 # git-rev-list is the backend / plumbing version of git-log
2c3af7e7
MO
3526 open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
3527 or die "Cannot call git-rev-list: $!";
3528 my @commits=readCommits($gitLogPipe);
3529 close $gitLogPipe;
3fda8c4c
ML
3530
3531 # Now all the commits are in the @commits bucket
3532 # ordered by time DESC. for each commit that needs processing,
3533 # determine whether it's following the last head we've seen or if
3534 # it's on its own branch, grab a file list, and add whatever's changed
3535 # NOTE: $lastcommit refers to the last commit from previous run
3536 # $lastpicked is the last commit we picked in this run
3537 my $lastpicked;
3538 my $head = {};
3539 if (defined $lastcommit) {
3540 $lastpicked = $lastcommit;
3541 }
3542
3543 my $committotal = scalar(@commits);
3544 my $commitcount = 0;
3545
3546 # Load the head table into $head (for cached lookups during the update process)
ab07681f 3547 foreach my $file ( @{$self->gethead(1)} )
3fda8c4c
ML
3548 {
3549 $head->{$file->{name}} = $file;
3550 }
3551
3552 foreach my $commit ( @commits )
3553 {
3554 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
3555 if (defined $lastpicked)
3556 {
3557 if (!in_array($lastpicked, @{$commit->{parents}}))
3558 {
3559 # skip, we'll see this delta
3560 # as part of a merge later
3561 # warn "skipping off-track $commit->{hash}\n";
3562 next;
3563 } elsif (@{$commit->{parents}} > 1) {
3564 # it is a merge commit, for each parent that is
196e48f4
MO
3565 # not $lastpicked (not given a CVS revision number),
3566 # see if we can get a log
3fda8c4c
ML
3567 # from the merge-base to that parent to put it
3568 # in the message as a merge summary.
3569 my @parents = @{$commit->{parents}};
3570 foreach my $parent (@parents) {
3fda8c4c
ML
3571 if ($parent eq $lastpicked) {
3572 next;
3573 }
196e48f4
MO
3574 # git-merge-base can potentially (but rarely) throw
3575 # several candidate merge bases. let's assume
3576 # that the first one is the best one.
e509db99 3577 my $base = eval {
d2feb01a 3578 safe_pipe_capture('git', 'merge-base',
a5e40798 3579 $lastpicked, $parent);
e509db99
SP
3580 };
3581 # The two branches may not be related at all,
3582 # in which case merge base simply fails to find
3583 # any, but that's Ok.
3584 next if ($@);
3585
3fda8c4c
ML
3586 chomp $base;
3587 if ($base) {
3588 my @merged;
3589 # print "want to log between $base $parent \n";
d2feb01a 3590 open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
a5e40798 3591 or die "Cannot call git-log: $!";
3fda8c4c
ML
3592 my $mergedhash;
3593 while (<GITLOG>) {
3594 chomp;
3595 if (!defined $mergedhash) {
3596 if (m/^commit\s+(.+)$/) {
3597 $mergedhash = $1;
3598 } else {
3599 next;
3600 }
3601 } else {
3602 # grab the first line that looks non-rfc822
3603 # aka has content after leading space
3604 if (m/^\s+(\S.*)$/) {
3605 my $title = $1;
3606 $title = substr($title,0,100); # truncate
3607 unshift @merged, "$mergedhash $title";
3608 undef $mergedhash;
3609 }
3610 }
3611 }
3612 close GITLOG;
3613 if (@merged) {
3614 $commit->{mergemsg} = $commit->{message};
3615 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
3616 foreach my $summary (@merged) {
3617 $commit->{mergemsg} .= "\t$summary\n";
3618 }
3619 $commit->{mergemsg} .= "\n\n";
3620 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
3621 }
3622 }
3623 }
3624 }
3625 }
3626
3627 # convert the date to CVS-happy format
2c3af7e7 3628 my $cvsDate = convertToCvsDate($commit->{date});
3fda8c4c
ML
3629
3630 if ( defined ( $lastpicked ) )
3631 {
d2feb01a 3632 my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
e02cd638 3633 local ($/) = "\0";
3fda8c4c
ML
3634 while ( <FILELIST> )
3635 {
e02cd638 3636 chomp;
2c3af7e7 3637 unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/