]> git.ipfire.org Git - thirdparty/git.git/blame - git-cvsserver.perl
Merge branch 'bc/sha-256-cvs-svn-updates'
[thirdparty/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 =
d2bb624c 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
46203ac2 359 my @gitvars = safe_pipe_capture(qw(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 {
05ea93d6 368 next unless ( $line =~ /^(gitcvs|extensions)\.(?:(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 394
05ea93d6 395 $state->{rawsz} = ($cfg->{'extensions'}{'objectformat'} || 'sha1') eq 'sha256' ? 32 : 20;
396 $state->{hexsz} = $state->{rawsz} * 2;
397
91a6bf46 398 return 1;
3fda8c4c
ML
399}
400
401# Global_option option \n
402# Response expected: no. Transmit one of the global options `-q', `-Q',
403# `-l', `-t', `-r', or `-n'. option must be one of those strings, no
404# variations (such as combining of options) are allowed. For graceful
405# handling of valid-requests, it is probably better to make new global
406# options separate requests, rather than trying to add them to this
407# request.
408sub req_Globaloption
409{
410 my ( $cmd, $data ) = @_;
411 $log->debug("req_Globaloption : $data");
7d90095a 412 $state->{globaloptions}{$data} = 1;
3fda8c4c
ML
413}
414
415# Valid-responses request-list \n
416# Response expected: no. Tell the server what responses the client will
417# accept. request-list is a space separated list of tokens.
418sub req_Validresponses
419{
420 my ( $cmd, $data ) = @_;
5348b6e7 421 $log->debug("req_Validresponses : $data");
3fda8c4c
ML
422
423 # TODO : re-enable this, currently it's not particularly useful
424 #$state->{validresponses} = [ split /\s+/, $data ];
425}
426
427# valid-requests \n
428# Response expected: yes. Ask the server to send back a Valid-requests
429# response.
430sub req_validrequests
431{
432 my ( $cmd, $data ) = @_;
433
434 $log->debug("req_validrequests");
435
9462953a 436 $log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
3fda8c4c
ML
437 $log->debug("SEND : ok");
438
9462953a 439 print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
3fda8c4c
ML
440 print "ok\n";
441}
442
443# Directory local-directory \n
444# Additional data: repository \n. Response expected: no. Tell the server
445# what directory to use. The repository should be a directory name from a
446# previous server response. Note that this both gives a default for Entry
447# and Modified and also for ci and the other commands; normal usage is to
448# send Directory for each directory in which there will be an Entry or
449# Modified, and then a final Directory for the original directory, then the
450# command. The local-directory is relative to the top level at which the
451# command is occurring (i.e. the last Directory which is sent before the
452# command); to indicate that top level, `.' should be sent for
453# local-directory.
454sub req_Directory
455{
456 my ( $cmd, $data ) = @_;
457
458 my $repository = <STDIN>;
459 chomp $repository;
460
461
462 $state->{localdir} = $data;
463 $state->{repository} = $repository;
7d90095a 464 $state->{path} = $repository;
f9acaeae 465 $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
7d90095a
MS
466 $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
467 $state->{path} .= "/" if ( $state->{path} =~ /\S/ );
468
469 $state->{directory} = $state->{localdir};
470 $state->{directory} = "" if ( $state->{directory} eq "." );
3fda8c4c
ML
471 $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
472
d988b822 473 if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
7d90095a
MS
474 {
475 $log->info("Setting prepend to '$state->{path}'");
476 $state->{prependdir} = $state->{path};
eb5dcb2c 477 my %entries;
7d90095a
MS
478 foreach my $entry ( keys %{$state->{entries}} )
479 {
eb5dcb2c 480 $entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
7d90095a 481 }
eb5dcb2c
MO
482 $state->{entries}=\%entries;
483
484 my %dirMap;
485 foreach my $dir ( keys %{$state->{dirMap}} )
486 {
487 $dirMap{$state->{prependdir} . $dir} = $state->{dirMap}{$dir};
488 }
489 $state->{dirMap}=\%dirMap;
7d90095a
MS
490 }
491
492 if ( defined ( $state->{prependdir} ) )
493 {
494 $log->debug("Prepending '$state->{prependdir}' to state|directory");
495 $state->{directory} = $state->{prependdir} . $state->{directory}
496 }
eb5dcb2c
MO
497
498 if ( ! defined($state->{dirMap}{$state->{directory}}) )
499 {
500 $state->{dirMap}{$state->{directory}} =
501 {
502 'names' => {}
503 #'tagspec' => undef
504 };
505 }
506
82000d74 507 $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
3fda8c4c
ML
508}
509
eb5dcb2c
MO
510# Sticky tagspec \n
511# Response expected: no. Tell the server that the directory most
512# recently specified with Directory has a sticky tag or date
513# tagspec. The first character of tagspec is T for a tag, D for
514# a date, or some other character supplied by a Set-sticky
515# response from a previous request to the server. The remainder
516# of tagspec contains the actual tag or date, again as supplied
517# by Set-sticky.
518# The server should remember Static-directory and Sticky requests
519# for a particular directory; the client need not resend them each
520# time it sends a Directory request for a given directory. However,
521# the server is not obliged to remember them beyond the context
522# of a single command.
523sub req_Sticky
524{
525 my ( $cmd, $tagspec ) = @_;
526
527 my ( $stickyInfo );
528 if($tagspec eq "")
529 {
530 # nothing
531 }
532 elsif($tagspec=~/^T([^ ]+)\s*$/)
533 {
534 $stickyInfo = { 'tag' => $1 };
535 }
536 elsif($tagspec=~/^D([0-9.]+)\s*$/)
537 {
538 $stickyInfo= { 'date' => $1 };
539 }
540 else
541 {
542 die "Unknown tag_or_date format\n";
543 }
544 $state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;
545
546 $log->debug("req_Sticky : tagspec=$tagspec repository=$state->{repository}"
547 . " path=$state->{path} directory=$state->{directory}"
548 . " module=$state->{module}");
549}
550
3fda8c4c
ML
551# Entry entry-line \n
552# Response expected: no. Tell the server what version of a file is on the
553# local machine. The name in entry-line is a name relative to the directory
554# most recently specified with Directory. If the user is operating on only
555# some files in a directory, Entry requests for only those files need be
556# included. If an Entry request is sent without Modified, Is-modified, or
557# Unchanged, it means the file is lost (does not exist in the working
558# directory). If both Entry and one of Modified, Is-modified, or Unchanged
559# are sent for the same file, Entry must be sent first. For a given file,
560# one can send Modified, Is-modified, or Unchanged, but not more than one
561# of these three.
562sub req_Entry
563{
564 my ( $cmd, $data ) = @_;
565
7d90095a 566 #$log->debug("req_Entry : $data");
3fda8c4c 567
abd66f22 568 my @data = split(/\//, $data, -1);
3fda8c4c
ML
569
570 $state->{entries}{$state->{directory}.$data[1]} = {
571 revision => $data[2],
572 conflict => $data[3],
573 options => $data[4],
574 tag_or_date => $data[5],
575 };
7d90095a 576
eb5dcb2c
MO
577 $state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';
578
7d90095a
MS
579 $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
580}
581
582# Questionable filename \n
583# Response expected: no. Additional data: no. Tell the server to check
584# whether filename should be ignored, and if not, next time the server
585# sends responses, send (in a M response) `?' followed by the directory and
586# filename. filename must not contain `/'; it needs to be a file in the
587# directory named by the most recent Directory request.
588sub req_Questionable
589{
590 my ( $cmd, $data ) = @_;
591
592 $log->debug("req_Questionable : $data");
593 $state->{entries}{$state->{directory}.$data}{questionable} = 1;
3fda8c4c
ML
594}
595
596# add \n
597# Response expected: yes. Add a file or directory. This uses any previous
598# Argument, Directory, Entry, or Modified requests, if they have been sent.
599# The last Directory sent specifies the working directory at the time of
600# the operation. To add a directory, send the directory to be added using
601# Directory and Argument requests.
602sub req_add
603{
604 my ( $cmd, $data ) = @_;
605
606 argsplit("add");
607
4db0c8de
FL
608 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
609 $updater->update();
610
3fda8c4c
ML
611 my $addcount = 0;
612
613 foreach my $filename ( @{$state->{args}} )
614 {
615 $filename = filecleanup($filename);
616
61717661
MO
617 # no -r, -A, or -D with add
618 my $stickyInfo = resolveStickyInfo($filename);
619
620 my $meta = $updater->getmeta($filename,$stickyInfo);
4db0c8de
FL
621 my $wrev = revparse($filename);
622
ab07681f 623 if ($wrev && $meta && ($wrev=~/^-/))
4db0c8de
FL
624 {
625 # previously removed file, add back
ab07681f 626 $log->info("added file $filename was previously removed, send $meta->{revision}");
4db0c8de
FL
627
628 print "MT +updated\n";
629 print "MT text U \n";
630 print "MT fname $filename\n";
631 print "MT newline\n";
632 print "MT -updated\n";
633
634 unless ( $state->{globaloptions}{-n} )
635 {
636 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
637
638 print "Created $dirpart\n";
639 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
640
641 # this is an "entries" line
90948a42 642 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
61717661
MO
643 my $entryLine = "/$filepart/$meta->{revision}//$kopts/";
644 $entryLine .= getStickyTagOrDate($stickyInfo);
645 $log->debug($entryLine);
646 print "$entryLine\n";
4db0c8de
FL
647 # permissions
648 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
649 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
650 # transmit file
651 transmitfile($meta->{filehash});
652 }
653
654 next;
655 }
656
3fda8c4c
ML
657 unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
658 {
659 print "E cvs add: nothing known about `$filename'\n";
660 next;
661 }
662 # TODO : check we're not squashing an already existing file
663 if ( defined ( $state->{entries}{$filename}{revision} ) )
664 {
665 print "E cvs add: `$filename' has already been entered\n";
666 next;
667 }
668
7d90095a 669 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
3fda8c4c
ML
670
671 print "E cvs add: scheduling file `$filename' for addition\n";
672
673 print "Checked-in $dirpart\n";
674 print "$filename\n";
90948a42
MO
675 my $kopts = kopts_from_path($filename,"file",
676 $state->{entries}{$filename}{modified_filename});
61717661
MO
677 print "/$filepart/0//$kopts/" .
678 getStickyTagOrDate($stickyInfo) . "\n";
3fda8c4c 679
8a06a632
MO
680 my $requestedKopts = $state->{opt}{k};
681 if(defined($requestedKopts))
682 {
683 $requestedKopts = "-k$requestedKopts";
684 }
685 else
686 {
687 $requestedKopts = "";
688 }
689 if( $kopts ne $requestedKopts )
690 {
691 $log->warn("Ignoring requested -k='$requestedKopts'"
692 . " for '$filename'; detected -k='$kopts' instead");
693 #TODO: Also have option to send warning to user?
694 }
695
3fda8c4c
ML
696 $addcount++;
697 }
698
699 if ( $addcount == 1 )
700 {
701 print "E cvs add: use `cvs commit' to add this file permanently\n";
702 }
703 elsif ( $addcount > 1 )
704 {
705 print "E cvs add: use `cvs commit' to add these files permanently\n";
706 }
707
708 print "ok\n";
709}
710
711# remove \n
712# Response expected: yes. Remove a file. This uses any previous Argument,
713# Directory, Entry, or Modified requests, if they have been sent. The last
714# Directory sent specifies the working directory at the time of the
715# operation. Note that this request does not actually do anything to the
716# repository; the only effect of a successful remove request is to supply
717# the client with a new entries line containing `-' to indicate a removed
718# file. In fact, the client probably could perform this operation without
719# contacting the server, although using remove may cause the server to
720# perform a few more checks. The client sends a subsequent ci request to
721# actually record the removal in the repository.
722sub req_remove
723{
724 my ( $cmd, $data ) = @_;
725
726 argsplit("remove");
727
728 # Grab a handle to the SQLite db and do any necessary updates
729 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
730 $updater->update();
731
732 #$log->debug("add state : " . Dumper($state));
733
734 my $rmcount = 0;
735
736 foreach my $filename ( @{$state->{args}} )
737 {
738 $filename = filecleanup($filename);
739
740 if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
741 {
742 print "E cvs remove: file `$filename' still in working directory\n";
743 next;
744 }
745
61717661
MO
746 # only from entries
747 my $stickyInfo = resolveStickyInfo($filename);
748
749 my $meta = $updater->getmeta($filename,$stickyInfo);
3fda8c4c
ML
750 my $wrev = revparse($filename);
751
752 unless ( defined ( $wrev ) )
753 {
754 print "E cvs remove: nothing known about `$filename'\n";
755 next;
756 }
757
ab07681f 758 if ( defined($wrev) and ($wrev=~/^-/) )
3fda8c4c
ML
759 {
760 print "E cvs remove: file `$filename' already scheduled for removal\n";
761 next;
762 }
763
ab07681f 764 unless ( $wrev eq $meta->{revision} )
3fda8c4c
ML
765 {
766 # TODO : not sure if the format of this message is quite correct.
767 print "E cvs remove: Up to date check failed for `$filename'\n";
768 next;
769 }
770
771
7d90095a 772 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
3fda8c4c
ML
773
774 print "E cvs remove: scheduling `$filename' for removal\n";
775
776 print "Checked-in $dirpart\n";
777 print "$filename\n";
90948a42 778 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
61717661 779 print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
3fda8c4c
ML
780
781 $rmcount++;
782 }
783
784 if ( $rmcount == 1 )
785 {
786 print "E cvs remove: use `cvs commit' to remove this file permanently\n";
787 }
788 elsif ( $rmcount > 1 )
789 {
790 print "E cvs remove: use `cvs commit' to remove these files permanently\n";
791 }
792
793 print "ok\n";
794}
795
796# Modified filename \n
797# Response expected: no. Additional data: mode, \n, file transmission. Send
798# the server a copy of one locally modified file. filename is a file within
799# the most recent directory sent with Directory; it must not contain `/'.
800# If the user is operating on only some files in a directory, only those
801# files need to be included. This can also be sent without Entry, if there
802# is no entry for the file.
803sub req_Modified
804{
805 my ( $cmd, $data ) = @_;
806
807 my $mode = <STDIN>;
a5e40798
JM
808 defined $mode
809 or (print "E end of file reading mode for $data\n"), return;
3fda8c4c
ML
810 chomp $mode;
811 my $size = <STDIN>;
a5e40798
JM
812 defined $size
813 or (print "E end of file reading size of $data\n"), return;
3fda8c4c
ML
814 chomp $size;
815
816 # Grab config information
817 my $blocksize = 8192;
818 my $bytesleft = $size;
819 my $tmp;
820
821 # Get a filehandle/name to write it to
822 my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
823
824 # Loop over file data writing out to temporary file.
825 while ( $bytesleft )
826 {
827 $blocksize = $bytesleft if ( $bytesleft < $blocksize );
828 read STDIN, $tmp, $blocksize;
829 print $fh $tmp;
830 $bytesleft -= $blocksize;
831 }
832
a5e40798
JM
833 close $fh
834 or (print "E failed to write temporary, $filename: $!\n"), return;
3fda8c4c
ML
835
836 # Ensure we have something sensible for the file mode
837 if ( $mode =~ /u=(\w+)/ )
838 {
839 $mode = $1;
840 } else {
841 $mode = "rw";
842 }
843
844 # Save the file data in $state
845 $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
846 $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
27dd7387 847 $state->{entries}{$state->{directory}.$data}{modified_hash} = safe_pipe_capture('git','hash-object',$filename);
3fda8c4c
ML
848 $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
849
850 #$log->debug("req_Modified : file=$data mode=$mode size=$size");
851}
852
853# Unchanged filename \n
854# Response expected: no. Tell the server that filename has not been
855# modified in the checked out directory. The filename is a file within the
856# most recent directory sent with Directory; it must not contain `/'.
857sub req_Unchanged
858{
859 my ( $cmd, $data ) = @_;
860
861 $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
862
863 #$log->debug("req_Unchanged : $data");
864}
865
866# Argument text \n
867# Response expected: no. Save argument for use in a subsequent command.
868# Arguments accumulate until an argument-using command is given, at which
869# point they are forgotten.
870# Argumentx text \n
871# Response expected: no. Append \n followed by text to the current argument
872# being saved.
873sub req_Argument
874{
875 my ( $cmd, $data ) = @_;
876
2c3cff49 877 # Argumentx means: append to last Argument (with a newline in front)
3fda8c4c
ML
878
879 $log->debug("$cmd : $data");
880
2c3cff49
JS
881 if ( $cmd eq 'Argumentx') {
882 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
883 } else {
884 push @{$state->{arguments}}, $data;
885 }
3fda8c4c
ML
886}
887
888# expand-modules \n
889# Response expected: yes. Expand the modules which are specified in the
890# arguments. Returns the data in Module-expansion responses. Note that the
891# server can assume that this is checkout or export, not rtag or rdiff; the
892# latter do not access the working directory and thus have no need to
893# expand modules on the client side. Expand may not be the best word for
894# what this request does. It does not necessarily tell you all the files
895# contained in a module, for example. Basically it is a way of telling you
896# which working directories the server needs to know about in order to
897# handle a checkout of the specified modules. For example, suppose that the
898# server has a module defined by
899# aliasmodule -a 1dir
900# That is, one can check out aliasmodule and it will take 1dir in the
901# repository and check it out to 1dir in the working directory. Now suppose
902# the client already has this module checked out and is planning on using
903# the co request to update it. Without using expand-modules, the client
904# would have two bad choices: it could either send information about all
905# working directories under the current directory, which could be
906# unnecessarily slow, or it could be ignorant of the fact that aliasmodule
907# stands for 1dir, and neglect to send information for 1dir, which would
908# lead to incorrect operation. With expand-modules, the client would first
909# ask for the module to be expanded:
910sub req_expandmodules
911{
912 my ( $cmd, $data ) = @_;
913
914 argsplit();
915
916 $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
917
918 unless ( ref $state->{arguments} eq "ARRAY" )
919 {
920 print "ok\n";
921 return;
922 }
923
924 foreach my $module ( @{$state->{arguments}} )
925 {
926 $log->debug("SEND : Module-expansion $module");
927 print "Module-expansion $module\n";
928 }
929
930 print "ok\n";
931 statecleanup();
932}
933
934# co \n
935# Response expected: yes. Get files from the repository. This uses any
936# previous Argument, Directory, Entry, or Modified requests, if they have
937# been sent. Arguments to this command are module names; the client cannot
938# know what directories they correspond to except by (1) just sending the
939# co request, and then seeing what directory names the server sends back in
940# its responses, and (2) the expand-modules request.
941sub req_co
942{
943 my ( $cmd, $data ) = @_;
944
945 argsplit("co");
946
89a9167f
LN
947 # Provide list of modules, if -c was used.
948 if (exists $state->{opt}{c}) {
46203ac2 949 my $showref = safe_pipe_capture(qw(git show-ref --heads));
89a9167f
LN
950 for my $line (split '\n', $showref) {
951 if ( $line =~ m% refs/heads/(.*)$% ) {
952 print "M $1\t$1\n";
953 }
954 }
955 print "ok\n";
956 return 1;
957 }
958
61717661
MO
959 my $stickyInfo = { 'tag' => $state->{opt}{r},
960 'date' => $state->{opt}{D} };
961
3fda8c4c 962 my $module = $state->{args}[0];
8a06a632 963 $state->{module} = $module;
3fda8c4c
ML
964 my $checkout_path = $module;
965
966 # use the user specified directory if we're given it
967 $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
968
969 $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
970
971 $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
972
973 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
974
975 # Grab a handle to the SQLite db and do any necessary updates
976 my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
977 $updater->update();
978
61717661
MO
979 my $headHash;
980 if( defined($stickyInfo) && defined($stickyInfo->{tag}) )
981 {
982 $headHash = $updater->lookupCommitRef($stickyInfo->{tag});
983 if( !defined($headHash) )
984 {
985 print "error 1 no such tag `$stickyInfo->{tag}'\n";
986 cleanupWorkTree();
987 exit;
988 }
989 }
c8c4f220 990
61717661 991 $checkout_path =~ s|/$||; # get rid of trailing slashes
c8c4f220
ML
992
993 my %seendirs = ();
501c7372 994 my $lastdir ='';
3fda8c4c 995
61717661
MO
996 prepDirForOutput(
997 ".",
998 $state->{CVSROOT} . "/$module",
999 $checkout_path,
1000 \%seendirs,
1001 'checkout',
1002 $state->{dirArgs} );
1003
1004 foreach my $git ( @{$updater->getAnyHead($headHash)} )
3fda8c4c
ML
1005 {
1006 # Don't want to check out deleted files
1007 next if ( $git->{filehash} eq "deleted" );
1008
8a06a632 1009 my $fullName = $git->{name};
3fda8c4c
ML
1010 ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
1011
61717661
MO
1012 unless (exists($seendirs{$git->{dir}})) {
1013 prepDirForOutput($git->{dir}, $state->{CVSROOT} . "/$module/",
1014 $checkout_path, \%seendirs, 'checkout',
1015 $state->{dirArgs} );
1016 $lastdir = $git->{dir};
1017 $seendirs{$git->{dir}} = 1;
1018 }
6be32d47 1019
3fda8c4c
ML
1020 # modification time of this file
1021 print "Mod-time $git->{modified}\n";
1022
1023 # print some information to the client
3fda8c4c
ML
1024 if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
1025 {
c8c4f220 1026 print "M U $checkout_path/$git->{dir}$git->{name}\n";
3fda8c4c 1027 } else {
c8c4f220 1028 print "M U $checkout_path/$git->{name}\n";
3fda8c4c 1029 }
c8c4f220 1030
6be32d47
ML
1031 # instruct client we're sending a file to put in this path
1032 print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
3fda8c4c 1033
6be32d47 1034 print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
3fda8c4c
ML
1035
1036 # this is an "entries" line
90948a42 1037 my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
61717661
MO
1038 print "/$git->{name}/$git->{revision}//$kopts/" .
1039 getStickyTagOrDate($stickyInfo) . "\n";
3fda8c4c
ML
1040 # permissions
1041 print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
1042
1043 # transmit file
1044 transmitfile($git->{filehash});
1045 }
1046
1047 print "ok\n";
1048
1049 statecleanup();
1050}
1051
61717661
MO
1052# used by req_co and req_update to set up directories for files
1053# recursively handles parents
1054sub prepDirForOutput
1055{
1056 my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;
1057
1058 my $parent = dirname($dir);
1059 $dir =~ s|/+$||;
1060 $repodir =~ s|/+$||;
1061 $remotedir =~ s|/+$||;
1062 $parent =~ s|/+$||;
1063
1064 if ($parent eq '.' || $parent eq './')
1065 {
1066 $parent = '';
1067 }
1068 # recurse to announce unseen parents first
1069 if( length($parent) &&
1070 !exists($seendirs->{$parent}) &&
1071 ( $request eq "checkout" ||
1072 exists($dirArgs->{$parent}) ) )
1073 {
1074 prepDirForOutput($parent, $repodir, $remotedir,
1075 $seendirs, $request, $dirArgs);
1076 }
1077 # Announce that we are going to modify at the parent level
1078 if ($dir eq '.' || $dir eq './')
1079 {
1080 $dir = '';
1081 }
1082 if(exists($seendirs->{$dir}))
1083 {
1084 return;
1085 }
1086 $log->debug("announcedir $dir, $repodir, $remotedir" );
1087 my($thisRemoteDir,$thisRepoDir);
1088 if ($dir ne "")
1089 {
1090 $thisRepoDir="$repodir/$dir";
1091 if($remotedir eq ".")
1092 {
1093 $thisRemoteDir=$dir;
1094 }
1095 else
1096 {
1097 $thisRemoteDir="$remotedir/$dir";
1098 }
1099 }
1100 else
1101 {
1102 $thisRepoDir=$repodir;
1103 $thisRemoteDir=$remotedir;
1104 }
1105 unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
1106 {
1107 print "E cvs $request: Updating $thisRemoteDir\n";
1108 }
1109
1110 my ($opt_r)=$state->{opt}{r};
1111 my $stickyInfo;
1112 if(exists($state->{opt}{A}))
1113 {
1114 # $stickyInfo=undef;
1115 }
1116 elsif( defined($opt_r) && $opt_r ne "" )
1117 # || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO
1118 {
1119 $stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };
1120
1121 # TODO: Convert -D value into the form 2011.04.10.04.46.57,
1122 # similar to an entry line's sticky date, without the D prefix.
1123 # It sometimes (always?) arrives as something more like
1124 # '10 Apr 2011 04:46:57 -0000'...
1125 # $stickyInfo={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
1126 }
1127 else
1128 {
1129 $stickyInfo=getDirStickyInfo($state->{prependdir} . $dir);
1130 }
1131
1132 my $stickyResponse;
1133 if(defined($stickyInfo))
1134 {
1135 $stickyResponse = "Set-sticky $thisRemoteDir/\n" .
1136 "$thisRepoDir/\n" .
1137 getStickyTagOrDate($stickyInfo) . "\n";
1138 }
1139 else
1140 {
1141 $stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
1142 "$thisRepoDir/\n";
1143 }
1144
1145 unless ( $state->{globaloptions}{-n} )
1146 {
1147 print $stickyResponse;
1148
1149 print "Clear-static-directory $thisRemoteDir/\n";
1150 print "$thisRepoDir/\n";
1151 print $stickyResponse; # yes, twice
1152 print "Template $thisRemoteDir/\n";
1153 print "$thisRepoDir/\n";
1154 print "0\n";
1155 }
1156
1157 $seendirs->{$dir} = 1;
1158
1159 # FUTURE: This would more accurately emulate CVS by sending
1160 # another copy of sticky after processing the files in that
1161 # directory. Or intermediate: perhaps send all sticky's for
832c0e5e 1162 # $seendirs after processing all files.
61717661
MO
1163}
1164
3fda8c4c
ML
1165# update \n
1166# Response expected: yes. Actually do a cvs update command. This uses any
1167# previous Argument, Directory, Entry, or Modified requests, if they have
1168# been sent. The last Directory sent specifies the working directory at the
1169# time of the operation. The -I option is not used--files which the client
1170# can decide whether to ignore are not mentioned and the client sends the
1171# Questionable request for others.
1172sub req_update
1173{
1174 my ( $cmd, $data ) = @_;
1175
1176 $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
1177
1178 argsplit("update");
1179
858cbfba 1180 #
5348b6e7 1181 # It may just be a client exploring the available heads/modules
858cbfba
ML
1182 # in that case, list them as top level directories and leave it
1183 # at that. Eclipse uses this technique to offer you a list of
1184 # projects (heads in this case) to checkout.
1185 #
1186 if ($state->{module} eq '') {
46203ac2 1187 my $showref = safe_pipe_capture(qw(git show-ref --heads));
858cbfba 1188 print "E cvs update: Updating .\n";
b20171eb
LN
1189 for my $line (split '\n', $showref) {
1190 if ( $line =~ m% refs/heads/(.*)$% ) {
1191 print "E cvs update: New directory `$1'\n";
1192 }
1193 }
1194 print "ok\n";
1195 return 1;
858cbfba
ML
1196 }
1197
1198
3fda8c4c
ML
1199 # Grab a handle to the SQLite db and do any necessary updates
1200 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1201
1202 $updater->update();
1203
7d90095a 1204 argsfromdir($updater);
3fda8c4c
ML
1205
1206 #$log->debug("update state : " . Dumper($state));
1207
61717661
MO
1208 my($repoDir);
1209 $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
1210
1211 my %seendirs = ();
8e4c4e7d 1212
addf88e4 1213 # foreach file specified on the command line ...
61717661 1214 foreach my $argsFilename ( @{$state->{args}} )
3fda8c4c 1215 {
61717661
MO
1216 my $filename;
1217 $filename = filecleanup($argsFilename);
3fda8c4c 1218
7d90095a
MS
1219 $log->debug("Processing file $filename");
1220
3fda8c4c
ML
1221 # if we have a -C we should pretend we never saw modified stuff
1222 if ( exists ( $state->{opt}{C} ) )
1223 {
1224 delete $state->{entries}{$filename}{modified_hash};
1225 delete $state->{entries}{$filename}{modified_filename};
1226 $state->{entries}{$filename}{unchanged} = 1;
1227 }
1228
61717661
MO
1229 my $stickyInfo = resolveStickyInfo($filename,
1230 $state->{opt}{r},
1231 $state->{opt}{D},
1232 exists($state->{opt}{A}));
1233 my $meta = $updater->getmeta($filename, $stickyInfo);
3fda8c4c 1234
e78f69a3
DD
1235 # If -p was given, "print" the contents of the requested revision.
1236 if ( exists ( $state->{opt}{p} ) ) {
1237 if ( defined ( $meta->{revision} ) ) {
1238 $log->info("Printing '$filename' revision " . $meta->{revision});
1239
1240 transmitfile($meta->{filehash}, { print => 1 });
1241 }
1242
1243 next;
1244 }
1245
61717661
MO
1246 # Directories:
1247 prepDirForOutput(
1248 dirname($argsFilename),
1249 $repoDir,
1250 ".",
1251 \%seendirs,
1252 "update",
1253 $state->{dirArgs} );
1254
1255 my $wrev = revparse($filename);
1256
0a7a9a12
JS
1257 if ( ! defined $meta )
1258 {
1259 $meta = {
1260 name => $filename,
ab07681f 1261 revision => '0',
0a7a9a12
JS
1262 filehash => 'added'
1263 };
61717661
MO
1264 if($wrev ne "0")
1265 {
1266 $meta->{filehash}='deleted';
1267 }
0a7a9a12 1268 }
3fda8c4c
ML
1269
1270 my $oldmeta = $meta;
1271
3fda8c4c 1272 # If the working copy is an old revision, lets get that version too for comparison.
61717661
MO
1273 my $oldWrev=$wrev;
1274 if(defined($oldWrev))
3fda8c4c 1275 {
61717661
MO
1276 $oldWrev=~s/^-//;
1277 if($oldWrev ne $meta->{revision})
1278 {
1279 $oldmeta = $updater->getmeta($filename, $oldWrev);
1280 }
3fda8c4c
ML
1281 }
1282
1283 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
1284
ec58db15
ML
1285 # Files are up to date if the working copy and repo copy have the same revision,
1286 # and the working copy is unmodified _and_ the user hasn't specified -C
1287 next if ( defined ( $wrev )
1288 and defined($meta->{revision})
ab07681f 1289 and $wrev eq $meta->{revision}
ec58db15
ML
1290 and $state->{entries}{$filename}{unchanged}
1291 and not exists ( $state->{opt}{C} ) );
1292
1293 # If the working copy and repo copy have the same revision,
1294 # but the working copy is modified, tell the client it's modified
1295 if ( defined ( $wrev )
1296 and defined($meta->{revision})
ab07681f 1297 and $wrev eq $meta->{revision}
61717661 1298 and $wrev ne "0"
cb52d9a1 1299 and defined($state->{entries}{$filename}{modified_hash})
ec58db15
ML
1300 and not exists ( $state->{opt}{C} ) )
1301 {
1302 $log->info("Tell the client the file is modified");
0a7a9a12 1303 print "MT text M \n";
ec58db15
ML
1304 print "MT fname $filename\n";
1305 print "MT newline\n";
1306 next;
1307 }
3fda8c4c 1308
61717661 1309 if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
3fda8c4c 1310 {
d8574ff2
MO
1311 # TODO: If it has been modified in the sandbox, error out
1312 # with the appropriate message, rather than deleting a modified
1313 # file.
1314
7d90095a 1315 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
3fda8c4c
ML
1316
1317 $log->info("Removing '$filename' from working copy (no longer in the repo)");
1318
1319 print "E cvs update: `$filename' is no longer in the repository\n";
7d90095a
MS
1320 # Don't want to actually _DO_ the update if -n specified
1321 unless ( $state->{globaloptions}{-n} ) {
1322 print "Removed $dirpart\n";
1323 print "$filepart\n";
1324 }
3fda8c4c 1325 }
ec58db15 1326 elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
0a7a9a12
JS
1327 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
1328 or $meta->{filehash} eq 'added' )
3fda8c4c 1329 {
0a7a9a12
JS
1330 # normal update, just send the new revision (either U=Update,
1331 # or A=Add, or R=Remove)
ab07681f 1332 if ( defined($wrev) && ($wrev=~/^-/) )
0a7a9a12
JS
1333 {
1334 $log->info("Tell the client the file is scheduled for removal");
1335 print "MT text R \n";
1336 print "MT fname $filename\n";
1337 print "MT newline\n";
1338 next;
1339 }
ab07681f
MO
1340 elsif ( (!defined($wrev) || $wrev eq '0') &&
1341 (!defined($meta->{revision}) || $meta->{revision} eq '0') )
0a7a9a12 1342 {
535514f1 1343 $log->info("Tell the client the file is scheduled for addition");
0a7a9a12
JS
1344 print "MT text A \n";
1345 print "MT fname $filename\n";
1346 print "MT newline\n";
1347 next;
1348
1349 }
1350 else {
ab07681f 1351 $log->info("UpdatingX3 '$filename' to ".$meta->{revision});
0a7a9a12
JS
1352 print "MT +updated\n";
1353 print "MT text U \n";
1354 print "MT fname $filename\n";
1355 print "MT newline\n";
1356 print "MT -updated\n";
1357 }
3fda8c4c 1358
7d90095a
MS
1359 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1360
1361 # Don't want to actually _DO_ the update if -n specified
1362 unless ( $state->{globaloptions}{-n} )
1363 {
1364 if ( defined ( $wrev ) )
1365 {
1366 # instruct client we're sending a file to put in this path as a replacement
1367 print "Update-existing $dirpart\n";
1368 $log->debug("Updating existing file 'Update-existing $dirpart'");
1369 } else {
1370 # instruct client we're sending a file to put in this path as a new file
7d90095a
MS
1371
1372 $log->debug("Creating new file 'Created $dirpart'");
1373 print "Created $dirpart\n";
1374 }
1375 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1376
1377 # this is an "entries" line
90948a42 1378 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
61717661
MO
1379 my $entriesLine = "/$filepart/$meta->{revision}//$kopts/";
1380 $entriesLine .= getStickyTagOrDate($stickyInfo);
1381 $log->debug($entriesLine);
1382 print "$entriesLine\n";
7d90095a
MS
1383
1384 # permissions
1385 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1386 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1387
1388 # transmit file
1389 transmitfile($meta->{filehash});
1390 }
3fda8c4c 1391 } else {
7d90095a 1392 my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
3fda8c4c 1393
044182ef 1394 my $mergeDir = setupTmpDir();
3fda8c4c 1395
3fda8c4c 1396 my $file_local = $filepart . ".mine";
044182ef 1397 my $mergedFile = "$mergeDir/$file_local";
3fda8c4c
ML
1398 system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
1399 my $file_old = $filepart . "." . $oldmeta->{revision};
e78f69a3 1400 transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
3fda8c4c 1401 my $file_new = $filepart . "." . $meta->{revision};
e78f69a3 1402 transmitfile($meta->{filehash}, { targetfile => $file_new });
3fda8c4c
ML
1403
1404 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
1405 $log->info("Merging $file_local, $file_old, $file_new");
ab07681f 1406 print "M Merging differences between $oldmeta->{revision} and $meta->{revision} into $filename\n";
3fda8c4c 1407
044182ef 1408 $log->debug("Temporary directory for merge is $mergeDir");
3fda8c4c 1409
c6b4fa96 1410 my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
3fda8c4c
ML
1411 $return >>= 8;
1412
044182ef
MO
1413 cleanupTmpDir();
1414
3fda8c4c
ML
1415 if ( $return == 0 )
1416 {
1417 $log->info("Merged successfully");
1418 print "M M $filename\n";
53877846 1419 $log->debug("Merged $dirpart");
7d90095a
MS
1420
1421 # Don't want to actually _DO_ the update if -n specified
1422 unless ( $state->{globaloptions}{-n} )
1423 {
53877846 1424 print "Merged $dirpart\n";
7d90095a
MS
1425 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
1426 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
90948a42
MO
1427 my $kopts = kopts_from_path("$dirpart/$filepart",
1428 "file",$mergedFile);
ab07681f 1429 $log->debug("/$filepart/$meta->{revision}//$kopts/");
61717661
MO
1430 my $entriesLine="/$filepart/$meta->{revision}//$kopts/";
1431 $entriesLine .= getStickyTagOrDate($stickyInfo);
1432 print "$entriesLine\n";
7d90095a 1433 }
3fda8c4c
ML
1434 }
1435 elsif ( $return == 1 )
1436 {
1437 $log->info("Merged with conflicts");
459bad77 1438 print "E cvs update: conflicts found in $filename\n";
3fda8c4c 1439 print "M C $filename\n";
7d90095a
MS
1440
1441 # Don't want to actually _DO_ the update if -n specified
1442 unless ( $state->{globaloptions}{-n} )
1443 {
53877846 1444 print "Merged $dirpart\n";
7d90095a 1445 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
90948a42
MO
1446 my $kopts = kopts_from_path("$dirpart/$filepart",
1447 "file",$mergedFile);
61717661
MO
1448 my $entriesLine = "/$filepart/$meta->{revision}/+/$kopts/";
1449 $entriesLine .= getStickyTagOrDate($stickyInfo);
1450 print "$entriesLine\n";
7d90095a 1451 }
3fda8c4c
ML
1452 }
1453 else
1454 {
1455 $log->warn("Merge failed");
1456 next;
1457 }
1458
7d90095a
MS
1459 # Don't want to actually _DO_ the update if -n specified
1460 unless ( $state->{globaloptions}{-n} )
1461 {
1462 # permissions
1463 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1464 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1465
1466 # transmit file, format is single integer on a line by itself (file
1467 # size) followed by the file contents
1468 # TODO : we should copy files in blocks
27dd7387 1469 my $data = safe_pipe_capture('cat', $mergedFile);
7d90095a
MS
1470 $log->debug("File size : " . length($data));
1471 print length($data) . "\n";
1472 print $data;
1473 }
3fda8c4c
ML
1474 }
1475
1476 }
1477
61717661
MO
1478 # prepDirForOutput() any other existing directories unless they already
1479 # have the right sticky tag:
1480 unless ( $state->{globaloptions}{n} )
1481 {
1482 my $dir;
1483 foreach $dir (keys(%{$state->{dirMap}}))
1484 {
1485 if( ! $seendirs{$dir} &&
1486 exists($state->{dirArgs}{$dir}) )
1487 {
1488 my($oldTag);
1489 $oldTag=$state->{dirMap}{$dir}{tagspec};
1490
1491 unless( ( exists($state->{opt}{A}) &&
1492 defined($oldTag) ) ||
1493 ( defined($state->{opt}{r}) &&
1494 ( !defined($oldTag) ||
1495 $state->{opt}{r} ne $oldTag ) ) )
1496 # TODO?: OR sticky dir is different...
1497 {
1498 next;
1499 }
1500
1501 prepDirForOutput(
1502 $dir,
1503 $repoDir,
1504 ".",
1505 \%seendirs,
1506 'update',
1507 $state->{dirArgs} );
1508 }
1509
1510 # TODO?: Consider sending a final duplicate Sticky response
1511 # to more closely mimic real CVS.
1512 }
1513 }
1514
3fda8c4c
ML
1515 print "ok\n";
1516}
1517
1518sub req_ci
1519{
1520 my ( $cmd, $data ) = @_;
1521
1522 argsplit("ci");
1523
1524 #$log->debug("State : " . Dumper($state));
1525
1526 $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1527
031a027a 1528 if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
91a6bf46 1529 {
031a027a 1530 print "error 1 anonymous user cannot commit via pserver\n";
044182ef 1531 cleanupWorkTree();
91a6bf46
ML
1532 exit;
1533 }
1534
3fda8c4c
ML
1535 if ( -e $state->{CVSROOT} . "/index" )
1536 {
568907f5 1537 $log->warn("file 'index' already exists in the git repository");
3fda8c4c 1538 print "error 1 Index already exists in git repo\n";
044182ef 1539 cleanupWorkTree();
3fda8c4c
ML
1540 exit;
1541 }
1542
3fda8c4c
ML
1543 # Grab a handle to the SQLite db and do any necessary updates
1544 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1545 $updater->update();
1546
3fda8c4c 1547 my @committedfiles = ();
392e2817 1548 my %oldmeta;
61717661
MO
1549 my $stickyInfo;
1550 my $branchRef;
1551 my $parenthash;
3fda8c4c 1552
addf88e4 1553 # foreach file specified on the command line ...
3fda8c4c
ML
1554 foreach my $filename ( @{$state->{args}} )
1555 {
7d90095a 1556 my $committedfile = $filename;
3fda8c4c
ML
1557 $filename = filecleanup($filename);
1558
1559 next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1560
61717661
MO
1561 #####
1562 # Figure out which branch and parenthash we are committing
1563 # to, and setup worktree:
1564
1565 # should always come from entries:
1566 my $fileStickyInfo = resolveStickyInfo($filename);
1567 if( !defined($branchRef) )
1568 {
1569 $stickyInfo = $fileStickyInfo;
1570 if( defined($stickyInfo) &&
1571 ( defined($stickyInfo->{date}) ||
1572 !defined($stickyInfo->{tag}) ) )
1573 {
1574 print "error 1 cannot commit with sticky date for file `$filename'\n";
1575 cleanupWorkTree();
1576 exit;
1577 }
1578
1579 $branchRef = "refs/heads/$state->{module}";
1580 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1581 {
1582 $branchRef = "refs/heads/$stickyInfo->{tag}";
1583 }
1584
27dd7387 1585 $parenthash = safe_pipe_capture('git', 'show-ref', '-s', $branchRef);
61717661 1586 chomp $parenthash;
05ea93d6 1587 if ($parenthash !~ /^[0-9a-f]{$state->{hexsz}}$/)
61717661
MO
1588 {
1589 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1590 {
1591 print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
1592 }
1593 else
1594 {
1595 print "error 1 pserver cannot find the current HEAD of module";
1596 }
1597 cleanupWorkTree();
1598 exit;
1599 }
1600
1601 setupWorkTree($parenthash);
1602
1603 $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
1604
1605 $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
1606 }
1607 elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )
1608 {
1609 #TODO: We could split the cvs commit into multiple
1610 # git commits by distinct stickyTag values, but that
1611 # is lowish priority.
1612 print "error 1 Committing different files to different"
1613 . " branches is not currently supported\n";
1614 cleanupWorkTree();
1615 exit;
1616 }
1617
1618 #####
1619 # Process this file:
1620
1621 my $meta = $updater->getmeta($filename,$stickyInfo);
392e2817 1622 $oldmeta{$filename} = $meta;
3fda8c4c
ML
1623
1624 my $wrev = revparse($filename);
1625
1626 my ( $filepart, $dirpart ) = filenamesplit($filename);
1627
cdf63284 1628 # do a checkout of the file if it is part of this tree
3fda8c4c 1629 if ($wrev) {
d2feb01a 1630 system('git', 'checkout-index', '-f', '-u', $filename);
3fda8c4c
ML
1631 unless ($? == 0) {
1632 die "Error running git-checkout-index -f -u $filename : $!";
1633 }
1634 }
1635
1636 my $addflag = 0;
1637 my $rmflag = 0;
ab07681f 1638 $rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
3fda8c4c
ML
1639 $addflag = 1 unless ( -e $filename );
1640
1641 # Do up to date checking
ab07681f
MO
1642 unless ( $addflag or $wrev eq $meta->{revision} or
1643 ( $rmflag and $wrev eq "-$meta->{revision}" ) )
3fda8c4c
ML
1644 {
1645 # fail everything if an up to date check fails
1646 print "error 1 Up to date check failed for $filename\n";
044182ef 1647 cleanupWorkTree();
3fda8c4c
ML
1648 exit;
1649 }
1650
7d90095a 1651 push @committedfiles, $committedfile;
3fda8c4c
ML
1652 $log->info("Committing $filename");
1653
1654 system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1655
1656 unless ( $rmflag )
1657 {
1658 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1659 rename $state->{entries}{$filename}{modified_filename},$filename;
1660
1661 # Calculate modes to remove
1662 my $invmode = "";
1663 foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1664
1665 $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1666 system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1667 }
1668
1669 if ( $rmflag )
1670 {
1671 $log->info("Removing file '$filename'");
1672 unlink($filename);
d2feb01a 1673 system("git", "update-index", "--remove", $filename);
3fda8c4c
ML
1674 }
1675 elsif ( $addflag )
1676 {
1677 $log->info("Adding file '$filename'");
d2feb01a 1678 system("git", "update-index", "--add", $filename);
3fda8c4c 1679 } else {
ab07681f 1680 $log->info("UpdatingX2 file '$filename'");
d2feb01a 1681 system("git", "update-index", $filename);
3fda8c4c
ML
1682 }
1683 }
1684
1685 unless ( scalar(@committedfiles) > 0 )
1686 {
1687 print "E No files to commit\n";
1688 print "ok\n";
044182ef 1689 cleanupWorkTree();
3fda8c4c
ML
1690 return;
1691 }
1692
46203ac2 1693 my $treehash = safe_pipe_capture(qw(git write-tree));
3fda8c4c 1694 chomp $treehash;
3fda8c4c
ML
1695
1696 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1697
1698 # write our commit message out if we have one ...
1699 my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1700 print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
280514e1
FE
1701 if ( defined ( $cfg->{gitcvs}{commitmsgannotation} ) ) {
1702 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/ ) {
1703 print $msg_fh "\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"
1704 }
1705 } else {
1706 print $msg_fh "\n\nvia git-CVS emulator\n";
1707 }
3fda8c4c
ML
1708 close $msg_fh;
1709
27dd7387 1710 my $commithash = safe_pipe_capture('git', 'commit-tree', $treehash, '-p', $parenthash, '-F', $msg_filename);
1872adab 1711 chomp($commithash);
3fda8c4c
ML
1712 $log->info("Commit hash : $commithash");
1713
05ea93d6 1714 unless ( $commithash =~ /[a-zA-Z0-9]{$state->{hexsz}}/ )
3fda8c4c
ML
1715 {
1716 $log->warn("Commit failed (Invalid commit hash)");
1717 print "error 1 Commit failed (unknown reason)\n";
044182ef 1718 cleanupWorkTree();
3fda8c4c
ML
1719 exit;
1720 }
1721
cdf63284 1722 ### Emulate git-receive-pack by running hooks/update
61717661 1723 my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
b2741f63 1724 $parenthash, $commithash );
cdf63284
MW
1725 if( -x $hook[0] ) {
1726 unless( system( @hook ) == 0 )
b2741f63
AP
1727 {
1728 $log->warn("Commit failed (update hook declined to update ref)");
1729 print "error 1 Commit failed (update hook declined)\n";
044182ef 1730 cleanupWorkTree();
b2741f63
AP
1731 exit;
1732 }
1733 }
1734
cdf63284 1735 ### Update the ref
ada5ef3b 1736 if (system(qw(git update-ref -m), "cvsserver ci",
61717661 1737 $branchRef, $commithash, $parenthash)) {
ada5ef3b
JH
1738 $log->warn("update-ref for $state->{module} failed.");
1739 print "error 1 Cannot commit -- update first\n";
044182ef 1740 cleanupWorkTree();
ada5ef3b
JH
1741 exit;
1742 }
3fda8c4c 1743
cdf63284
MW
1744 ### Emulate git-receive-pack by running hooks/post-receive
1745 my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
1746 if( -x $hook ) {
1747 open(my $pipe, "| $hook") || die "can't fork $!";
1748
1749 local $SIG{PIPE} = sub { die 'pipe broke' };
1750
61717661 1751 print $pipe "$parenthash $commithash $branchRef\n";
cdf63284
MW
1752
1753 close $pipe || die "bad pipe: $! $?";
1754 }
1755
ad8c3477
SK
1756 $updater->update();
1757
394d66d4
JH
1758 ### Then hooks/post-update
1759 $hook = $ENV{GIT_DIR}.'hooks/post-update';
1760 if (-x $hook) {
61717661 1761 system($hook, $branchRef);
394d66d4
JH
1762 }
1763
addf88e4 1764 # foreach file specified on the command line ...
3fda8c4c
ML
1765 foreach my $filename ( @committedfiles )
1766 {
1767 $filename = filecleanup($filename);
1768
61717661 1769 my $meta = $updater->getmeta($filename,$stickyInfo);
3486595b 1770 unless (defined $meta->{revision}) {
ab07681f 1771 $meta->{revision} = "1.1";
3486595b 1772 }
3fda8c4c 1773
7d90095a 1774 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
3fda8c4c
ML
1775
1776 $log->debug("Checked-in $dirpart : $filename");
1777
392e2817 1778 print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
3486595b 1779 if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
3fda8c4c 1780 {
ab07681f 1781 print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
3fda8c4c
ML
1782 print "Remove-entry $dirpart\n";
1783 print "$filename\n";
1784 } else {
ab07681f 1785 if ($meta->{revision} eq "1.1") {
459bad77
FL
1786 print "M initial revision: 1.1\n";
1787 } else {
ab07681f 1788 print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
459bad77 1789 }
3fda8c4c
ML
1790 print "Checked-in $dirpart\n";
1791 print "$filename\n";
90948a42 1792 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
61717661
MO
1793 print "/$filepart/$meta->{revision}//$kopts/" .
1794 getStickyTagOrDate($stickyInfo) . "\n";
3fda8c4c
ML
1795 }
1796 }
1797
044182ef 1798 cleanupWorkTree();
3fda8c4c
ML
1799 print "ok\n";
1800}
1801
1802sub req_status
1803{
1804 my ( $cmd, $data ) = @_;
1805
1806 argsplit("status");
1807
1808 $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1809 #$log->debug("status state : " . Dumper($state));
1810
1811 # Grab a handle to the SQLite db and do any necessary updates
4d804c0e
MO
1812 my $updater;
1813 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
3fda8c4c
ML
1814 $updater->update();
1815
4d804c0e
MO
1816 # if no files were specified, we need to work out what files we should
1817 # be providing status on ...
7d90095a 1818 argsfromdir($updater);
3fda8c4c 1819
addf88e4 1820 # foreach file specified on the command line ...
3fda8c4c
ML
1821 foreach my $filename ( @{$state->{args}} )
1822 {
1823 $filename = filecleanup($filename);
1824
4d804c0e
MO
1825 if ( exists($state->{opt}{l}) &&
1826 index($filename, '/', length($state->{prependdir})) >= 0 )
1827 {
1828 next;
1829 }
852b921c 1830
3fda8c4c
ML
1831 my $wrev = revparse($filename);
1832
61717661
MO
1833 my $stickyInfo = resolveStickyInfo($filename);
1834 my $meta = $updater->getmeta($filename,$stickyInfo);
1835 my $oldmeta = $meta;
1836
4d804c0e
MO
1837 # If the working copy is an old revision, lets get that
1838 # version too for comparison.
ab07681f 1839 if ( defined($wrev) and $wrev ne $meta->{revision} )
3fda8c4c 1840 {
61717661
MO
1841 my($rmRev)=$wrev;
1842 $rmRev=~s/^-//;
1843 $oldmeta = $updater->getmeta($filename, $rmRev);
3fda8c4c
ML
1844 }
1845
1846 # TODO : All possible statuses aren't yet implemented
1847 my $status;
4d804c0e
MO
1848 # Files are up to date if the working copy and repo copy have
1849 # the same revision, and the working copy is unmodified
1850 if ( defined ( $wrev ) and defined($meta->{revision}) and
ab07681f 1851 $wrev eq $meta->{revision} and
4d804c0e
MO
1852 ( ( $state->{entries}{$filename}{unchanged} and
1853 ( not defined ( $state->{entries}{$filename}{conflict} ) or
1854 $state->{entries}{$filename}{conflict} !~ /^\+=/ ) ) or
1855 ( defined($state->{entries}{$filename}{modified_hash}) and
1856 $state->{entries}{$filename}{modified_hash} eq
ab07681f 1857 $meta->{filehash} ) ) )
4d804c0e 1858 {
ab07681f 1859 $status = "Up-to-date"
4d804c0e
MO
1860 }
1861
ab07681f
MO
1862 # Need checkout if the working copy has a different (usually
1863 # older) revision than the repo copy, and the working copy is
1864 # unmodified
4d804c0e 1865 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
ab07681f 1866 $meta->{revision} ne $wrev and
4d804c0e
MO
1867 ( $state->{entries}{$filename}{unchanged} or
1868 ( defined($state->{entries}{$filename}{modified_hash}) and
1869 $state->{entries}{$filename}{modified_hash} eq
1870 $oldmeta->{filehash} ) ) )
1871 {
1872 $status ||= "Needs Checkout";
1873 }
1874
1875 # Need checkout if it exists in the repo but doesn't have a working
1876 # copy
1877 if ( not defined ( $wrev ) and defined ( $meta->{revision} ) )
1878 {
1879 $status ||= "Needs Checkout";
1880 }
1881
1882 # Locally modified if working copy and repo copy have the
1883 # same revision but there are local changes
1884 if ( defined ( $wrev ) and defined($meta->{revision}) and
ab07681f 1885 $wrev eq $meta->{revision} and
61717661 1886 $wrev ne "0" and
4d804c0e
MO
1887 $state->{entries}{$filename}{modified_filename} )
1888 {
1889 $status ||= "Locally Modified";
1890 }
1891
ab07681f
MO
1892 # Needs Merge if working copy revision is different
1893 # (usually older) than repo copy and there are local changes
4d804c0e 1894 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
ab07681f 1895 $meta->{revision} ne $wrev and
4d804c0e
MO
1896 $state->{entries}{$filename}{modified_filename} )
1897 {
1898 $status ||= "Needs Merge";
1899 }
1900
1901 if ( defined ( $state->{entries}{$filename}{revision} ) and
61717661
MO
1902 ( !defined($meta->{revision}) ||
1903 $meta->{revision} eq "0" ) )
4d804c0e
MO
1904 {
1905 $status ||= "Locally Added";
1906 }
1907 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
ab07681f 1908 $wrev eq "-$meta->{revision}" )
4d804c0e
MO
1909 {
1910 $status ||= "Locally Removed";
1911 }
1912 if ( defined ( $state->{entries}{$filename}{conflict} ) and
1913 $state->{entries}{$filename}{conflict} =~ /^\+=/ )
1914 {
1915 $status ||= "Unresolved Conflict";
1916 }
1917 if ( 0 )
1918 {
1919 $status ||= "File had conflicts on merge";
1920 }
3fda8c4c
ML
1921
1922 $status ||= "Unknown";
1923
23b7180f
DD
1924 my ($filepart) = filenamesplit($filename);
1925
4d804c0e 1926 print "M =======" . ( "=" x 60 ) . "\n";
23b7180f 1927 print "M File: $filepart\tStatus: $status\n";
3fda8c4c
ML
1928 if ( defined($state->{entries}{$filename}{revision}) )
1929 {
4d804c0e
MO
1930 print "M Working revision:\t" .
1931 $state->{entries}{$filename}{revision} . "\n";
3fda8c4c
ML
1932 } else {
1933 print "M Working revision:\tNo entry for $filename\n";
1934 }
1935 if ( defined($meta->{revision}) )
1936 {
ab07681f 1937 print "M Repository revision:\t" .
4d804c0e
MO
1938 $meta->{revision} .
1939 "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
abd66f22
MO
1940 my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
1941 my($tag)=($tagOrDate=~m/^T(.+)$/);
1942 if( !defined($tag) )
1943 {
1944 $tag="(none)";
1945 }
1946 print "M Sticky Tag:\t\t$tag\n";
1947 my($date)=($tagOrDate=~m/^D(.+)$/);
1948 if( !defined($date) )
1949 {
1950 $date="(none)";
1951 }
1952 print "M Sticky Date:\t\t$date\n";
1953 my($options)=$state->{entries}{$filename}{options};
1954 if( $options eq "" )
1955 {
1956 $options="(none)";
1957 }
1958 print "M Sticky Options:\t\t$options\n";
3fda8c4c
ML
1959 } else {
1960 print "M Repository revision:\tNo revision control file\n";
1961 }
1962 print "M\n";
1963 }
1964
1965 print "ok\n";
1966}
1967
1968sub req_diff
1969{
1970 my ( $cmd, $data ) = @_;
1971
1972 argsplit("diff");
1973
1974 $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1975 #$log->debug("status state : " . Dumper($state));
1976
1977 my ($revision1, $revision2);
1978 if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1979 {
1980 $revision1 = $state->{opt}{r}[0];
1981 $revision2 = $state->{opt}{r}[1];
1982 } else {
1983 $revision1 = $state->{opt}{r};
1984 }
1985
4d804c0e
MO
1986 $log->debug("Diffing revisions " .
1987 ( defined($revision1) ? $revision1 : "[NULL]" ) .
1988 " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
3fda8c4c
ML
1989
1990 # Grab a handle to the SQLite db and do any necessary updates
4d804c0e
MO
1991 my $updater;
1992 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
3fda8c4c
ML
1993 $updater->update();
1994
4d804c0e
MO
1995 # if no files were specified, we need to work out what files we should
1996 # be providing status on ...
7d90095a 1997 argsfromdir($updater);
3fda8c4c 1998
61717661
MO
1999 my($foundDiff);
2000
addf88e4 2001 # foreach file specified on the command line ...
61717661 2002 foreach my $argFilename ( @{$state->{args}} )
3fda8c4c 2003 {
61717661 2004 my($filename) = filecleanup($argFilename);
3fda8c4c
ML
2005
2006 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
2007
2008 my $wrev = revparse($filename);
2009
61717661
MO
2010 # Priority for revision1:
2011 # 1. First -r (missing file: check -N)
2012 # 2. wrev from client's Entry line
2013 # - missing line/file: check -N
2014 # - "0": added file not committed (empty contents for rev1)
2015 # - Prefixed with dash (to be removed): check -N
3fda8c4c 2016
3fda8c4c
ML
2017 if ( defined ( $revision1 ) )
2018 {
3fda8c4c 2019 $meta1 = $updater->getmeta($filename, $revision1);
61717661
MO
2020 }
2021 elsif( defined($wrev) && $wrev ne "0" )
2022 {
2023 my($rmRev)=$wrev;
2024 $rmRev=~s/^-//;
2025 $meta1 = $updater->getmeta($filename, $rmRev);
2026 }
2027 if ( !defined($meta1) ||
2028 $meta1->{filehash} eq "deleted" )
2029 {
2030 if( !exists($state->{opt}{N}) )
3fda8c4c 2031 {
61717661
MO
2032 if(!defined($revision1))
2033 {
2034 print "E File $filename at revision $revision1 doesn't exist\n";
2035 }
3fda8c4c
ML
2036 next;
2037 }
61717661
MO
2038 elsif( !defined($meta1) )
2039 {
2040 $meta1 = {
2041 name => $filename,
2042 revision => '0',
2043 filehash => 'deleted'
2044 };
2045 }
3fda8c4c
ML
2046 }
2047
61717661
MO
2048 # Priority for revision2:
2049 # 1. Second -r (missing file: check -N)
2050 # 2. Modified file contents from client
2051 # 3. wrev from client's Entry line
2052 # - missing line/file: check -N
2053 # - Prefixed with dash (to be removed): check -N
2054
3fda8c4c
ML
2055 # if we have a second -r switch, use it too
2056 if ( defined ( $revision2 ) )
2057 {
3fda8c4c 2058 $meta2 = $updater->getmeta($filename, $revision2);
3fda8c4c 2059 }
61717661 2060 elsif(defined($state->{entries}{$filename}{modified_filename}))
3fda8c4c
ML
2061 {
2062 $file2 = $state->{entries}{$filename}{modified_filename};
61717661
MO
2063 $meta2 = {
2064 name => $filename,
2065 revision => '0',
2066 filehash => 'modified'
2067 };
3fda8c4c 2068 }
61717661 2069 elsif( defined($wrev) && ($wrev!~/^-/) )
3fda8c4c 2070 {
61717661
MO
2071 if(!defined($revision1)) # no revision and no modifications:
2072 {
2073 next;
2074 }
3fda8c4c 2075 $meta2 = $updater->getmeta($filename, $wrev);
61717661
MO
2076 }
2077 if(!defined($file2))
2078 {
2079 if ( !defined($meta2) ||
2080 $meta2->{filehash} eq "deleted" )
2081 {
2082 if( !exists($state->{opt}{N}) )
2083 {
2084 if(!defined($revision2))
2085 {
2086 print "E File $filename at revision $revision2 doesn't exist\n";
2087 }
2088 next;
2089 }
2090 elsif( !defined($meta2) )
2091 {
2092 $meta2 = {
2093 name => $filename,
2094 revision => '0',
2095 filehash => 'deleted'
2096 };
2097 }
2098 }
3fda8c4c
ML
2099 }
2100
61717661 2101 if( $meta1->{filehash} eq $meta2->{filehash} )
4d804c0e 2102 {
61717661 2103 $log->info("unchanged $filename");
4d804c0e
MO
2104 next;
2105 }
3fda8c4c 2106
61717661
MO
2107 # Retrieve revision contents:
2108 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2109 transmitfile($meta1->{filehash}, { targetfile => $file1 });
2110
2111 if(!defined($file2))
4d804c0e 2112 {
61717661
MO
2113 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2114 transmitfile($meta2->{filehash}, { targetfile => $file2 });
4d804c0e 2115 }
3fda8c4c 2116
61717661
MO
2117 # Generate the actual diff:
2118 print "M Index: $argFilename\n";
4d804c0e 2119 print "M =======" . ( "=" x 60 ) . "\n";
3fda8c4c 2120 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
61717661 2121 if ( defined ( $meta1 ) && $meta1->{revision} ne "0" )
4d804c0e 2122 {
ab07681f 2123 print "M retrieving revision $meta1->{revision}\n"
4d804c0e 2124 }
61717661 2125 if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
4d804c0e 2126 {
ab07681f 2127 print "M retrieving revision $meta2->{revision}\n"
4d804c0e 2128 }
3fda8c4c 2129 print "M diff ";
9462953a 2130 foreach my $opt ( sort keys %{$state->{opt}} )
3fda8c4c
ML
2131 {
2132 if ( ref $state->{opt}{$opt} eq "ARRAY" )
2133 {
2134 foreach my $value ( @{$state->{opt}{$opt}} )
2135 {
2136 print "-$opt $value ";
2137 }
2138 } else {
2139 print "-$opt ";
4d804c0e
MO
2140 if ( defined ( $state->{opt}{$opt} ) )
2141 {
2142 print "$state->{opt}{$opt} "
2143 }
3fda8c4c
ML
2144 }
2145 }
61717661 2146 print "$argFilename\n";
3fda8c4c 2147
4d804c0e
MO
2148 $log->info("Diffing $filename -r $meta1->{revision} -r " .
2149 ( $meta2->{revision} or "workingcopy" ));
3fda8c4c 2150
61717661
MO
2151 # TODO: Use --label instead of -L because -L is no longer
2152 # documented and may go away someday. Not sure if there there are
2153 # versions that only support -L, which would make this change risky?
2154 # http://osdir.com/ml/bug-gnu-utils-gnu/2010-12/msg00060.html
2155 # ("man diff" should actually document the best migration strategy,
2156 # [current behavior, future changes, old compatibility issues
2157 # or lack thereof, etc], not just stop mentioning the option...)
2158 # TODO: Real CVS seems to include a date in the label, before
2159 # the revision part, without the keyword "revision". The following
2160 # has minimal changes compared to original versions of
2161 # git-cvsserver.perl. (Mostly tab vs space after filename.)
3fda8c4c 2162
61717661
MO
2163 my (@diffCmd) = ( 'diff' );
2164 if ( exists($state->{opt}{N}) )
3fda8c4c 2165 {
61717661 2166 push @diffCmd,"-N";
3fda8c4c 2167 }
61717661
MO
2168 if ( exists $state->{opt}{u} )
2169 {
2170 push @diffCmd,("-u","-L");
2171 if( $meta1->{filehash} eq "deleted" )
2172 {
2173 push @diffCmd,"/dev/null";
2174 } else {
2175 push @diffCmd,("$argFilename\trevision $meta1->{revision}");
2176 }
3fda8c4c 2177
61717661
MO
2178 if( defined($meta2->{filehash}) )
2179 {
2180 if( $meta2->{filehash} eq "deleted" )
2181 {
2182 push @diffCmd,("-L","/dev/null");
2183 } else {
2184 push @diffCmd,("-L",
2185 "$argFilename\trevision $meta2->{revision}");
2186 }
2187 } else {
2188 push @diffCmd,("-L","$argFilename\tworking copy");
2189 }
2190 }
2191 push @diffCmd,($file1,$file2);
2192 if(!open(DIFF,"-|",@diffCmd))
3fda8c4c 2193 {
61717661 2194 $log->warn("Unable to run diff: $!");
3fda8c4c 2195 }
61717661
MO
2196 my($diffLine);
2197 while(defined($diffLine=<DIFF>))
2198 {
2199 print "M $diffLine";
2200 $foundDiff=1;
2201 }
2202 close(DIFF);
3fda8c4c
ML
2203 }
2204
61717661
MO
2205 if($foundDiff)
2206 {
2207 print "error \n";
2208 }
2209 else
2210 {
2211 print "ok\n";
2212 }
3fda8c4c
ML
2213}
2214
2215sub req_log
2216{
2217 my ( $cmd, $data ) = @_;
2218
2219 argsplit("log");
2220
2221 $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
2222 #$log->debug("log state : " . Dumper($state));
2223
ab07681f
MO
2224 my ( $revFilter );
2225 if ( defined ( $state->{opt}{r} ) )
2226 {
2227 $revFilter = $state->{opt}{r};
3fda8c4c
ML
2228 }
2229
2230 # Grab a handle to the SQLite db and do any necessary updates
4d804c0e
MO
2231 my $updater;
2232 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
3fda8c4c
ML
2233 $updater->update();
2234
4d804c0e
MO
2235 # if no files were specified, we need to work out what files we
2236 # should be providing status on ...
7d90095a 2237 argsfromdir($updater);
3fda8c4c 2238
addf88e4 2239 # foreach file specified on the command line ...
3fda8c4c
ML
2240 foreach my $filename ( @{$state->{args}} )
2241 {
2242 $filename = filecleanup($filename);
2243
2244 my $headmeta = $updater->getmeta($filename);
2245
ab07681f
MO
2246 my ($revisions,$totalrevisions) = $updater->getlog($filename,
2247 $revFilter);
3fda8c4c
ML
2248
2249 next unless ( scalar(@$revisions) );
2250
2251 print "M \n";
2252 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
2253 print "M Working file: $filename\n";
ab07681f 2254 print "M head: $headmeta->{revision}\n";
3fda8c4c
ML
2255 print "M branch:\n";
2256 print "M locks: strict\n";
2257 print "M access list:\n";
2258 print "M symbolic names:\n";
2259 print "M keyword substitution: kv\n";
4d804c0e
MO
2260 print "M total revisions: $totalrevisions;\tselected revisions: " .
2261 scalar(@$revisions) . "\n";
3fda8c4c
ML
2262 print "M description:\n";
2263
2264 foreach my $revision ( @$revisions )
2265 {
2266 print "M ----------------------------\n";
ab07681f 2267 print "M revision $revision->{revision}\n";
3fda8c4c 2268 # reformat the date for log output
4d804c0e
MO
2269 if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and
2270 defined($DATE_LIST->{$2}) )
2271 {
2272 $revision->{modified} = sprintf('%04d/%02d/%02d %s',
2273 $3, $DATE_LIST->{$2}, $1, $4 );
2274 }
c1bc3061 2275 $revision->{author} = cvs_author($revision->{author});
4d804c0e
MO
2276 print "M date: $revision->{modified};" .
2277 " author: $revision->{author}; state: " .
2278 ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) .
2279 "; lines: +2 -3\n";
2280 my $commitmessage;
2281 $commitmessage = $updater->commitmessage($revision->{commithash});
3fda8c4c
ML
2282 $commitmessage =~ s/^/M /mg;
2283 print $commitmessage . "\n";
2284 }
4d804c0e 2285 print "M =======" . ( "=" x 70 ) . "\n";
3fda8c4c
ML
2286 }
2287
2288 print "ok\n";
2289}
2290
2291sub req_annotate
2292{
2293 my ( $cmd, $data ) = @_;
2294
2295 argsplit("annotate");
2296
2297 $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
2298 #$log->debug("status state : " . Dumper($state));
2299
2300 # Grab a handle to the SQLite db and do any necessary updates
2301 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
2302 $updater->update();
2303
2304 # if no files were specified, we need to work out what files we should be providing annotate on ...
7d90095a 2305 argsfromdir($updater);
3fda8c4c
ML
2306
2307 # we'll need a temporary checkout dir
044182ef 2308 setupWorkTree();
3fda8c4c 2309
044182ef 2310 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
3fda8c4c 2311
addf88e4 2312 # foreach file specified on the command line ...
3fda8c4c
ML
2313 foreach my $filename ( @{$state->{args}} )
2314 {
2315 $filename = filecleanup($filename);
2316
2317 my $meta = $updater->getmeta($filename);
2318
2319 next unless ( $meta->{revision} );
2320
2321 # get all the commits that this file was in
2322 # in dense format -- aka skip dead revisions
2323 my $revisions = $updater->gethistorydense($filename);
2324 my $lastseenin = $revisions->[0][2];
2325
2326 # populate the temporary index based on the latest commit were we saw
2327 # the file -- but do it cheaply without checking out any files
2328 # TODO: if we got a revision from the client, use that instead
2329 # to look up the commithash in sqlite (still good to default to
2330 # the current head as we do now)
d2feb01a 2331 system("git", "read-tree", $lastseenin);
3fda8c4c
ML
2332 unless ($? == 0)
2333 {
044182ef 2334 print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
a5e40798 2335 return;
3fda8c4c 2336 }
044182ef 2337 $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
3fda8c4c
ML
2338
2339 # do a checkout of the file
d2feb01a 2340 system('git', 'checkout-index', '-f', '-u', $filename);
3fda8c4c 2341 unless ($? == 0) {
a5e40798
JM
2342 print "E error running git-checkout-index -f -u $filename : $!\n";
2343 return;
3fda8c4c
ML
2344 }
2345
2346 $log->info("Annotate $filename");
2347
2348 # Prepare a file with the commits from the linearized
2349 # history that annotate should know about. This prevents
2350 # git-jsannotate telling us about commits we are hiding
2351 # from the client.
2352
044182ef 2353 my $a_hints = "$work->{workDir}/.annotate_hints";
a5e40798
JM
2354 if (!open(ANNOTATEHINTS, '>', $a_hints)) {
2355 print "E failed to open '$a_hints' for writing: $!\n";
2356 return;
2357 }
3fda8c4c
ML
2358 for (my $i=0; $i < @$revisions; $i++)
2359 {
2360 print ANNOTATEHINTS $revisions->[$i][2];
2361 if ($i+1 < @$revisions) { # have we got a parent?
2362 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
2363 }
2364 print ANNOTATEHINTS "\n";
2365 }
2366
2367 print ANNOTATEHINTS "\n";
a5e40798
JM
2368 close ANNOTATEHINTS
2369 or (print "E failed to write $a_hints: $!\n"), return;
3fda8c4c 2370
d2feb01a 2371 my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
a5e40798
JM
2372 if (!open(ANNOTATE, "-|", @cmd)) {
2373 print "E error invoking ". join(' ',@cmd) .": $!\n";
2374 return;
2375 }
3fda8c4c
ML
2376 my $metadata = {};
2377 print "E Annotations for $filename\n";
2378 print "E ***************\n";
2379 while ( <ANNOTATE> )
2380 {
05ea93d6 2381 if (m/^([a-zA-Z0-9]{$state->{hexsz}})\t\([^\)]*\)(.*)$/i)
3fda8c4c
ML
2382 {
2383 my $commithash = $1;
2384 my $data = $2;
2385 unless ( defined ( $metadata->{$commithash} ) )
2386 {
2387 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
c1bc3061 2388 $metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
3fda8c4c
ML
2389 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
2390 }
ab07681f 2391 printf("M %-7s (%-8s %10s): %s\n",
3fda8c4c
ML
2392 $metadata->{$commithash}{revision},
2393 $metadata->{$commithash}{author},
2394 $metadata->{$commithash}{modified},
2395 $data
2396 );
2397 } else {
2398 $log->warn("Error in annotate output! LINE: $_");
2399 print "E Annotate error \n";
2400 next;
2401 }
2402 }
2403 close ANNOTATE;
2404 }
2405
2406 # done; get out of the tempdir
df4b3abc 2407 cleanupWorkTree();
3fda8c4c
ML
2408
2409 print "ok\n";
2410
2411}
2412
2413# This method takes the state->{arguments} array and produces two new arrays.
2414# The first is $state->{args} which is everything before the '--' argument, and
2415# the second is $state->{files} which is everything after it.
2416sub argsplit
2417{
3fda8c4c
ML
2418 $state->{args} = [];
2419 $state->{files} = [];
2420 $state->{opt} = {};
2421
1e76b702
FL
2422 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
2423
2424 my $type = shift;
2425
3fda8c4c
ML
2426 if ( defined($type) )
2427 {
2428 my $opt = {};
2429 $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" );
2430 $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
2431 $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" );
61717661 2432 $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2, N => 0 } if ( $type eq "diff" );
3fda8c4c
ML
2433 $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
2434 $opt = { k => 1, m => 1 } if ( $type eq "add" );
2435 $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
2436 $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" );
2437
2438
2439 while ( scalar ( @{$state->{arguments}} ) > 0 )
2440 {
2441 my $arg = shift @{$state->{arguments}};
2442
2443 next if ( $arg eq "--" );
2444 next unless ( $arg =~ /\S/ );
2445
2446 # if the argument looks like a switch
2447 if ( $arg =~ /^-(\w)(.*)/ )
2448 {
2449 # if it's a switch that takes an argument
2450 if ( $opt->{$1} )
2451 {
2452 # If this switch has already been provided
2453 if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
2454 {
2455 $state->{opt}{$1} = [ $state->{opt}{$1} ];
2456 if ( length($2) > 0 )
2457 {
2458 push @{$state->{opt}{$1}},$2;
2459 } else {
2460 push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
2461 }
2462 } else {
2463 # if there's extra data in the arg, use that as the argument for the switch
2464 if ( length($2) > 0 )
2465 {
2466 $state->{opt}{$1} = $2;
2467 } else {
2468 $state->{opt}{$1} = shift @{$state->{arguments}};
2469 }
2470 }
2471 } else {
2472 $state->{opt}{$1} = undef;
2473 }
2474 }
2475 else
2476 {
2477 push @{$state->{args}}, $arg;
2478 }
2479 }
2480 }
2481 else
2482 {
2483 my $mode = 0;
2484
2485 foreach my $value ( @{$state->{arguments}} )
2486 {
2487 if ( $value eq "--" )
2488 {
2489 $mode++;
2490 next;
2491 }
2492 push @{$state->{args}}, $value if ( $mode == 0 );
2493 push @{$state->{files}}, $value if ( $mode == 1 );
2494 }
2495 }
2496}
2497
d66e8f8c
MO
2498# Used by argsfromdir
2499sub expandArg
3fda8c4c 2500{
d66e8f8c 2501 my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
3fda8c4c 2502
d66e8f8c 2503 my $fullPath = filecleanup($path);
7d90095a 2504
d66e8f8c
MO
2505 # Is it a directory?
2506 if( defined($state->{dirMap}{$fullPath}) ||
2507 defined($state->{dirMap}{"$fullPath/"}) )
2508 {
2509 # It is a directory in the user's sandbox.
2510 $isDir=1;
7d90095a 2511
d66e8f8c
MO
2512 if(defined($state->{entries}{$fullPath}))
2513 {
2514 $log->fatal("Inconsistent file/dir type");
2515 die "Inconsistent file/dir type";
2516 }
2517 }
2518 elsif(defined($state->{entries}{$fullPath}))
2519 {
2520 # It is a file in the user's sandbox.
2521 $isDir=0;
2522 }
2523 my($revDirMap,$otherRevDirMap);
2524 if(!defined($isDir) || $isDir)
2525 {
2526 # Resolve version tree for sticky tag:
2527 # (for now we only want list of files for the version, not
2528 # particular versions of those files: assume it is a directory
2529 # for the moment; ignore Entry's stick tag)
2530
2531 # Order of precedence of sticky tags:
2532 # -A [head]
2533 # -r /tag/
2534 # [file entry sticky tag, but that is only relevant to files]
2535 # [the tag specified in dir req_Sticky]
2536 # [the tag specified in a parent dir req_Sticky]
2537 # [head]
2538 # Also, -r may appear twice (for diff).
2539 #
2540 # FUTURE: When/if -j (merges) are supported, we also
2541 # need to add relevant files from one or two
2542 # versions specified with -j.
2543
2544 if(exists($state->{opt}{A}))
2545 {
2546 $revDirMap=$updater->getRevisionDirMap();
2547 }
2548 elsif( defined($state->{opt}{r}) and
2549 ref $state->{opt}{r} eq "ARRAY" )
2550 {
2551 $revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
2552 $otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
2553 }
2554 elsif(defined($state->{opt}{r}))
2555 {
2556 $revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
2557 }
2558 else
2559 {
2560 my($sticky)=getDirStickyInfo($fullPath);
2561 $revDirMap=$updater->getRevisionDirMap($sticky->{tag});
2562 }
0a7a9a12 2563
d66e8f8c
MO
2564 # Is it a directory?
2565 if( defined($revDirMap->{$fullPath}) ||
2566 defined($otherRevDirMap->{$fullPath}) )
2567 {
2568 $isDir=1;
2569 }
0a7a9a12
JS
2570 }
2571
d66e8f8c
MO
2572 # What to do with it?
2573 if(!$isDir)
82000d74 2574 {
d66e8f8c
MO
2575 $outNameMap->{$fullPath}=1;
2576 }
2577 else
2578 {
2579 $outDirMap->{$fullPath}=1;
3fda8c4c 2580
d66e8f8c
MO
2581 if(defined($revDirMap->{$fullPath}))
2582 {
2583 addDirMapFiles($updater,$outNameMap,$outDirMap,
2584 $revDirMap->{$fullPath});
2585 }
2586 if( defined($otherRevDirMap) &&
2587 defined($otherRevDirMap->{$fullPath}) )
82000d74 2588 {
d66e8f8c
MO
2589 addDirMapFiles($updater,$outNameMap,$outDirMap,
2590 $otherRevDirMap->{$fullPath});
82000d74 2591 }
d66e8f8c
MO
2592 }
2593}
82000d74 2594
d66e8f8c
MO
2595# Used by argsfromdir
2596# Add entries from dirMap to outNameMap. Also recurse into entries
2597# that are subdirectories.
2598sub addDirMapFiles
2599{
2600 my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
82000d74 2601
d66e8f8c
MO
2602 my($fullName);
2603 foreach $fullName (keys(%$dirMap))
2604 {
2605 my $cleanName=$fullName;
2606 if(defined($state->{prependdir}))
2607 {
2608 if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
2609 {
2610 $log->fatal("internal error stripping prependdir");
2611 die "internal error stripping prependdir";
2612 }
2613 }
82000d74 2614
d66e8f8c
MO
2615 if($dirMap->{$fullName} eq "F")
2616 {
2617 $outNameMap->{$cleanName}=1;
2618 }
2619 elsif($dirMap->{$fullName} eq "D")
2620 {
2621 if(!$state->{opt}{l})
2622 {
2623 expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
2624 }
2625 }
2626 else
82000d74 2627 {
d66e8f8c
MO
2628 $log->fatal("internal error in addDirMapFiles");
2629 die "internal error in addDirMapFiles";
82000d74 2630 }
3fda8c4c
ML
2631 }
2632}
2633
d66e8f8c
MO
2634# This method replaces $state->{args} with a directory-expanded
2635# list of all relevant filenames (recursively unless -d), based
2636# on $state->{entries}, and the "current" list of files in
2637# each directory. "Current" files as determined by
2638# either the requested (-r/-A) or "req_Sticky" version of
2639# that directory.
2640# Both the input args and the new output args are relative
2641# to the cvs-client's CWD, although some of the internal
2642# computations are relative to the top of the project.
2643sub argsfromdir
2644{
2645 my $updater = shift;
2646
2647 # Notes about requirements for specific callers:
2648 # update # "standard" case (entries; a single -r/-A/default; -l)
2649 # # Special case: -d for create missing directories.
2650 # diff # 0 or 1 -r's: "standard" case.
2651 # # 2 -r's: We could ignore entries (just use the two -r's),
2652 # # but it doesn't really matter.
2653 # annotate # "standard" case
2654 # log # Punting: log -r has a more complex non-"standard"
2655 # # meaning, and we don't currently try to support log'ing
2656 # # branches at all (need a lot of work to
2657 # # support CVS-consistent branch relative version
2658 # # numbering).
2659#HERE: But we still want to expand directories. Maybe we should
2660# essentially force "-A".
2661 # status # "standard", except that -r/-A/default are not possible.
2662 # # Mostly only used to expand entries only)
2663 #
2664 # Don't use argsfromdir at all:
2665 # add # Explicit arguments required. Directory args imply add
2666 # # the directory itself, not the files in it.
2667 # co # Obtain list directly.
2668 # remove # HERE: TEST: MAYBE client does the recursion for us,
2669 # # since it only makes sense to remove stuff already in
527d4a63 2670 # # the sandbox?
d66e8f8c
MO
2671 # ci # HERE: Similar to remove...
2672 # # Don't try to implement the confusing/weird
2673 # # ci -r bug er.."feature".
2674
2675 if(scalar(@{$state->{args}})==0)
2676 {
2677 $state->{args} = [ "." ];
2678 }
2679 my %allArgs;
2680 my %allDirs;
2681 for my $file (@{$state->{args}})
2682 {
2683 expandArg($updater,\%allArgs,\%allDirs,$file);
2684 }
2685
2686 # Include any entries from sandbox. Generally client won't
2687 # send entries that shouldn't be used.
2688 foreach my $file (keys %{$state->{entries}})
2689 {
2690 $allArgs{remove_prependdir($file)} = 1;
2691 }
2692
2693 $state->{dirArgs} = \%allDirs;
2694 $state->{args} = [
2695 sort {
2696 # Sort priority: by directory depth, then actual file name:
2697 my @piecesA=split('/',$a);
2698 my @piecesB=split('/',$b);
2699
2700 my $count=scalar(@piecesA);
2701 my $tmp=scalar(@piecesB);
2702 return $count<=>$tmp if($count!=$tmp);
2703
2704 for($tmp=0;$tmp<$count;$tmp++)
2705 {
2706 if($piecesA[$tmp] ne $piecesB[$tmp])
2707 {
2708 return $piecesA[$tmp] cmp $piecesB[$tmp]
2709 }
2710 }
2711 return 0;
2712 } keys(%allArgs) ];
2713}
eb5dcb2c
MO
2714
2715## look up directory sticky tag, of either fullPath or a parent:
2716sub getDirStickyInfo
2717{
2718 my($fullPath)=@_;
2719
2720 $fullPath=~s%/+$%%;
2721 while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
2722 {
2723 $fullPath=~s%/?[^/]*$%%;
2724 }
2725
2726 if( !defined($state->{dirMap}{"$fullPath/"}) &&
2727 ( $fullPath eq "" ||
2728 $fullPath eq "." ) )
2729 {
2730 return $state->{dirMap}{""}{stickyInfo};
2731 }
2732 else
2733 {
2734 return $state->{dirMap}{"$fullPath/"}{stickyInfo};
2735 }
2736}
2737
2738# Resolve precedence of various ways of specifying which version of
2739# a file you want. Returns undef (for default head), or a ref to a hash
2740# that contains "tag" and/or "date" keys.
2741sub resolveStickyInfo
2742{
2743 my($filename,$stickyTag,$stickyDate,$reset) = @_;
2744
2745 # Order of precedence of sticky tags:
2746 # -A [head]
2747 # -r /tag/
2748 # [file entry sticky tag]
2749 # [the tag specified in dir req_Sticky]
2750 # [the tag specified in a parent dir req_Sticky]
2751 # [head]
2752
2753 my $result;
2754 if($reset)
2755 {
2756 # $result=undef;
2757 }
2758 elsif( defined($stickyTag) && $stickyTag ne "" )
2759 # || ( defined($stickyDate) && $stickyDate ne "" ) # TODO
2760 {
2761 $result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
2762
2763 # TODO: Convert -D value into the form 2011.04.10.04.46.57,
2764 # similar to an entry line's sticky date, without the D prefix.
2765 # It sometimes (always?) arrives as something more like
2766 # '10 Apr 2011 04:46:57 -0000'...
2767 # $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
2768 }
2769 elsif( defined($state->{entries}{$filename}) &&
2770 defined($state->{entries}{$filename}{tag_or_date}) &&
2771 $state->{entries}{$filename}{tag_or_date} ne "" )
2772 {
2773 my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
2774 if($tagOrDate=~/^T([^ ]+)\s*$/)
2775 {
2776 $result = { 'tag' => $1 };
2777 }
2778 elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
2779 {
2780 $result= { 'date' => $1 };
2781 }
2782 else
2783 {
2784 die "Unknown tag_or_date format\n";
2785 }
2786 }
2787 else
2788 {
2789 $result=getDirStickyInfo($filename);
2790 }
2791
2792 return $result;
2793}
2794
2795# Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into
2796# a form appropriate for the sticky tag field of an Entries
2797# line (field index 5, 0-based).
2798sub getStickyTagOrDate
2799{
2800 my($stickyInfo)=@_;
2801
2802 my $result;
2803 if(defined($stickyInfo) && defined($stickyInfo->{tag}))
2804 {
2805 $result="T$stickyInfo->{tag}";
2806 }
2807 # TODO: When/if we actually pick versions by {date} properly,
2808 # also handle it here:
2809 # "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").
2810 else
2811 {
2812 $result="";
2813 }
2814
2815 return $result;
2816}
2817
3fda8c4c
ML
2818# This method cleans up the $state variable after a command that uses arguments has run
2819sub statecleanup
2820{
2821 $state->{files} = [];
d66e8f8c 2822 $state->{dirArgs} = {};
3fda8c4c
ML
2823 $state->{args} = [];
2824 $state->{arguments} = [];
2825 $state->{entries} = {};
eb5dcb2c 2826 $state->{dirMap} = {};
3fda8c4c
ML
2827}
2828
ab07681f 2829# Return working directory CVS revision "1.X" out
832c0e5e 2830# of the working directory "entries" state, for the given filename.
ab07681f 2831# This is prefixed with a dash if the file is scheduled for removal
196e48f4 2832# when it is committed.
3fda8c4c
ML
2833sub revparse
2834{
2835 my $filename = shift;
2836
ab07681f 2837 return $state->{entries}{$filename}{revision};
3fda8c4c
ML
2838}
2839
e78f69a3
DD
2840# This method takes a file hash and does a CVS "file transfer". Its
2841# exact behaviour depends on a second, optional hash table argument:
2842# - If $options->{targetfile}, dump the contents to that file;
2843# - If $options->{print}, use M/MT to transmit the contents one line
2844# at a time;
2845# - Otherwise, transmit the size of the file, followed by the file
2846# contents.
3fda8c4c
ML
2847sub transmitfile
2848{
2849 my $filehash = shift;
e78f69a3 2850 my $options = shift;
3fda8c4c
ML
2851
2852 if ( defined ( $filehash ) and $filehash eq "deleted" )
2853 {
2854 $log->warn("filehash is 'deleted'");
2855 return;
2856 }
2857
05ea93d6 2858 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ );
3fda8c4c 2859
27dd7387 2860 my $type = safe_pipe_capture('git', 'cat-file', '-t', $filehash);
3fda8c4c
ML
2861 chomp $type;
2862
2863 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2864
27dd7387 2865 my $size = safe_pipe_capture('git', 'cat-file', '-s', $filehash);
3fda8c4c
ML
2866 chomp $size;
2867
2868 $log->debug("transmitfile($filehash) size=$size, type=$type");
2869
d2feb01a 2870 if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
3fda8c4c 2871 {
e78f69a3 2872 if ( defined ( $options->{targetfile} ) )
3fda8c4c 2873 {
e78f69a3 2874 my $targetfile = $options->{targetfile};
3fda8c4c
ML
2875 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2876 print NEWFILE $_ while ( <$fh> );
a5e40798 2877 close NEWFILE or die("Failed to write '$targetfile': $!");
e78f69a3
DD
2878 } elsif ( defined ( $options->{print} ) && $options->{print} ) {
2879 while ( <$fh> ) {
2880 if( /\n\z/ ) {
2881 print 'M ', $_;
2882 } else {
2883 print 'MT text ', $_, "\n";
2884 }
2885 }
3fda8c4c
ML
2886 } else {
2887 print "$size\n";
2888 print while ( <$fh> );
2889 }
a5e40798 2890 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
3fda8c4c
ML
2891 } else {
2892 die("Couldn't execute git-cat-file");
2893 }
2894}
2895
2896# This method takes a file name, and returns ( $dirpart, $filepart ) which
5348b6e7 2897# refers to the directory portion and the file portion of the filename
3fda8c4c
ML
2898# respectively
2899sub filenamesplit
2900{
2901 my $filename = shift;
7d90095a 2902 my $fixforlocaldir = shift;
3fda8c4c
ML
2903
2904 my ( $filepart, $dirpart ) = ( $filename, "." );
2905 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2906 $dirpart .= "/";
2907
7d90095a
MS
2908 if ( $fixforlocaldir )
2909 {
2910 $dirpart =~ s/^$state->{prependdir}//;
2911 }
2912
3fda8c4c
ML
2913 return ( $filepart, $dirpart );
2914}
2915
1899cbc5 2916# Cleanup various junk in filename (try to canonicalize it), and
41ccfdd9 2917# add prependdir to accommodate running CVS client from a
1899cbc5 2918# subdirectory (so the output is relative to top directory of the project).
3fda8c4c
ML
2919sub filecleanup
2920{
2921 my $filename = shift;
2922
2923 return undef unless(defined($filename));
2924 if ( $filename =~ /^\// )
2925 {
2926 print "E absolute filenames '$filename' not supported by server\n";
2927 return undef;
2928 }
2929
1899cbc5
MO
2930 if($filename eq ".")
2931 {
2932 $filename="";
2933 }
3fda8c4c 2934 $filename =~ s/^\.\///g;
1899cbc5 2935 $filename =~ s%/+%/%g;
82000d74 2936 $filename = $state->{prependdir} . $filename;
1899cbc5 2937 $filename =~ s%/$%%;
3fda8c4c
ML
2938 return $filename;
2939}
2940
832c0e5e 2941# Remove prependdir from the path, so that it is relative to the directory
1899cbc5
MO
2942# the CVS client was started from, rather than the top of the project.
2943# Essentially the inverse of filecleanup().
2944sub remove_prependdir
2945{
2946 my($path) = @_;
2947 if(defined($state->{prependdir}) && $state->{prependdir} ne "")
2948 {
2949 my($pre)=$state->{prependdir};
2950 $pre=~s%/$%%;
2951 if(!($path=~s%^\Q$pre\E/?%%))
2952 {
2953 $log->fatal("internal error missing prependdir");
2954 die("internal error missing prependdir");
2955 }
2956 }
2957 return $path;
2958}
2959
044182ef
MO
2960sub validateGitDir
2961{
2962 if( !defined($state->{CVSROOT}) )
2963 {
2964 print "error 1 CVSROOT not specified\n";
2965 cleanupWorkTree();
2966 exit;
2967 }
2968 if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
2969 {
2970 print "error 1 Internally inconsistent CVSROOT\n";
2971 cleanupWorkTree();
2972 exit;
2973 }
2974}
2975
2976# Setup working directory in a work tree with the requested version
2977# loaded in the index.
2978sub setupWorkTree
2979{
2980 my ($ver) = @_;
2981
2982 validateGitDir();
2983
2984 if( ( defined($work->{state}) && $work->{state} != 1 ) ||
2985 defined($work->{tmpDir}) )
2986 {
2987 $log->warn("Bad work tree state management");
2988 print "error 1 Internal setup multiple work trees without cleanup\n";
2989 cleanupWorkTree();
2990 exit;
2991 }
2992
2993 $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
2994
2995 if( !defined($work->{index}) )
2996 {
2997 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2998 }
2999
3000 chdir $work->{workDir} or
3001 die "Unable to chdir to $work->{workDir}\n";
3002
3003 $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
3004
3005 $ENV{GIT_WORK_TREE} = ".";
3006 $ENV{GIT_INDEX_FILE} = $work->{index};
3007 $work->{state} = 2;
3008
3009 if($ver)
3010 {
3011 system("git","read-tree",$ver);
3012 unless ($? == 0)
3013 {
3014 $log->warn("Error running git-read-tree");
3015 die "Error running git-read-tree $ver in $work->{workDir} $!\n";
3016 }
3017 }
3018 # else # req_annotate reads tree for each file
3019}
3020
3021# Ensure current directory is in some kind of working directory,
3022# with a recent version loaded in the index.
3023sub ensureWorkTree
3024{
3025 if( defined($work->{tmpDir}) )
3026 {
3027 $log->warn("Bad work tree state management [ensureWorkTree()]");
3028 print "error 1 Internal setup multiple dirs without cleanup\n";
3029 cleanupWorkTree();
3030 exit;
3031 }
3032 if( $work->{state} )
3033 {
3034 return;
3035 }
3036
3037 validateGitDir();
3038
3039 if( !defined($work->{emptyDir}) )
3040 {
3041 $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
3042 }
3043 chdir $work->{emptyDir} or
3044 die "Unable to chdir to $work->{emptyDir}\n";
3045
27dd7387 3046 my $ver = safe_pipe_capture('git', 'show-ref', '-s', "refs/heads/$state->{module}");
044182ef 3047 chomp $ver;
05ea93d6 3048 if ($ver !~ /^[0-9a-f]{$state->{hexsz}}$/)
044182ef
MO
3049 {
3050 $log->warn("Error from git show-ref -s refs/head$state->{module}");
3051 print "error 1 cannot find the current HEAD of module";
3052 cleanupWorkTree();
3053 exit;
3054 }
3055
3056 if( !defined($work->{index}) )
3057 {
3058 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
3059 }
3060
3061 $ENV{GIT_WORK_TREE} = ".";
3062 $ENV{GIT_INDEX_FILE} = $work->{index};
3063 $work->{state} = 1;
3064
3065 system("git","read-tree",$ver);
3066 unless ($? == 0)
3067 {
3068 die "Error running git-read-tree $ver $!\n";
3069 }
3070}
3071
3072# Cleanup working directory that is not needed any longer.
3073sub cleanupWorkTree
3074{
3075 if( ! $work->{state} )
3076 {
3077 return;
3078 }
3079
3080 chdir "/" or die "Unable to chdir '/'\n";
3081
3082 if( defined($work->{workDir}) )
3083 {
3084 rmtree( $work->{workDir} );
3085 undef $work->{workDir};
3086 }
3087 undef $work->{state};
3088}
3089
3090# Setup a temporary directory (not a working tree), typically for
3091# merging dirty state as in req_update.
3092sub setupTmpDir
3093{
3094 $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
3095 chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
3096
3097 return $work->{tmpDir};
3098}
3099
3100# Clean up a previously setupTmpDir. Restore previous work tree if
3101# appropriate.
3102sub cleanupTmpDir
3103{
3104 if ( !defined($work->{tmpDir}) )
3105 {
3106 $log->warn("cleanup tmpdir that has not been setup");
3107 die "Cleanup tmpDir that has not been setup\n";
3108 }
3109 if( defined($work->{state}) )
3110 {
3111 if( $work->{state} == 1 )
3112 {
3113 chdir $work->{emptyDir} or
3114 die "Unable to chdir to $work->{emptyDir}\n";
3115 }
3116 elsif( $work->{state} == 2 )
3117 {
3118 chdir $work->{workDir} or
3119 die "Unable to chdir to $work->{emptyDir}\n";
3120 }
3121 else
3122 {
3123 $log->warn("Inconsistent work dir state");
3124 die "Inconsistent work dir state\n";
3125 }
3126 }
3127 else
3128 {
3129 chdir "/" or die "Unable to chdir '/'\n";
3130 }
3131}
3132
8538e876
AP
3133# Given a path, this function returns a string containing the kopts
3134# that should go into that path's Entries line. For example, a binary
3135# file should get -kb.
3136sub kopts_from_path
3137{
90948a42 3138 my ($path, $srcType, $name) = @_;
8538e876 3139
8a06a632
MO
3140 if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
3141 $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
3142 {
5ec3e670
EB
3143 my ($val) = check_attr( "text", $path );
3144 if ( $val eq "unspecified" )
8a06a632 3145 {
5ec3e670 3146 $val = check_attr( "crlf", $path );
8a06a632 3147 }
5ec3e670 3148 if ( $val eq "unset" )
8a06a632
MO
3149 {
3150 return "-kb"
3151 }
5ec3e670
EB
3152 elsif ( check_attr( "eol", $path ) ne "unspecified" ||
3153 $val eq "set" || $val eq "input" )
3154 {
3155 return "";
3156 }
8a06a632
MO
3157 else
3158 {
3159 $log->info("Unrecognized check_attr crlf $path : $val");
3160 }
3161 }
8538e876 3162
90948a42 3163 if ( defined ( $cfg->{gitcvs}{allbinary} ) )
8538e876 3164 {
90948a42
MO
3165 if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
3166 {
3167 return "-kb";
3168 }
3169 elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
3170 {
39b6a4bd 3171 if( is_binary($srcType,$name) )
90948a42 3172 {
39b6a4bd
MO
3173 $log->debug("... as binary");
3174 return "-kb";
90948a42
MO
3175 }
3176 else
3177 {
39b6a4bd 3178 $log->debug("... as text");
90948a42
MO
3179 }
3180 }
8538e876 3181 }
90948a42
MO
3182 # Return "" to give no special treatment to any path
3183 return "";
8538e876
AP
3184}
3185
8a06a632
MO
3186sub check_attr
3187{
3188 my ($attr,$path) = @_;
3189 ensureWorkTree();
3190 if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
3191 {
3192 my $val = <$fh>;
3193 close $fh;
3194 $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
3195 return $val;
3196 }
3197 else
3198 {
3199 return undef;
3200 }
3201}
3202
90948a42
MO
3203# This should have the same heuristics as convert.c:is_binary() and related.
3204# Note that the bare CR test is done by callers in convert.c.
3205sub is_binary
3206{
3207 my ($srcType,$name) = @_;
3208 $log->debug("is_binary($srcType,$name)");
3209
3210 # Minimize amount of interpreted code run in the inner per-character
3211 # loop for large files, by totalling each character value and
3212 # then analyzing the totals.
3213 my @counts;
3214 my $i;
3215 for($i=0;$i<256;$i++)
3216 {
3217 $counts[$i]=0;
3218 }
3219
3220 my $fh = open_blob_or_die($srcType,$name);
3221 my $line;
3222 while( defined($line=<$fh>) )
3223 {
3224 # Any '\0' and bare CR are considered binary.
3225 if( $line =~ /\0|(\r[^\n])/ )
3226 {
3227 close($fh);
3228 return 1;
3229 }
3230
3231 # Count up each character in the line:
3232 my $len=length($line);
3233 for($i=0;$i<$len;$i++)
3234 {
3235 $counts[ord(substr($line,$i,1))]++;
3236 }
3237 }
3238 close $fh;
3239
3240 # Don't count CR and LF as either printable/nonprintable
3241 $counts[ord("\n")]=0;
3242 $counts[ord("\r")]=0;
3243
3244 # Categorize individual character count into printable and nonprintable:
3245 my $printable=0;
3246 my $nonprintable=0;
3247 for($i=0;$i<256;$i++)
3248 {
3249 if( $i < 32 &&
3250 $i != ord("\b") &&
3251 $i != ord("\t") &&
3252 $i != 033 && # ESC
3253 $i != 014 ) # FF
3254 {
3255 $nonprintable+=$counts[$i];
3256 }
3257 elsif( $i==127 ) # DEL
3258 {
3259 $nonprintable+=$counts[$i];
3260 }
3261 else
3262 {
3263 $printable+=$counts[$i];
3264 }
3265 }
3266
3267 return ($printable >> 7) < $nonprintable;
3268}
3269
3270# Returns open file handle. Possible invocations:
3271# - open_blob_or_die("file",$filename);
3272# - open_blob_or_die("sha1",$filehash);
3273sub open_blob_or_die
3274{
3275 my ($srcType,$name) = @_;
3276 my ($fh);
3277 if( $srcType eq "file" )
3278 {
3279 if( !open $fh,"<",$name )
3280 {
3281 $log->warn("Unable to open file $name: $!");
3282 die "Unable to open file $name: $!\n";
3283 }
3284 }
39b6a4bd 3285 elsif( $srcType eq "sha1" )
90948a42 3286 {
05ea93d6 3287 unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ )
90948a42
MO
3288 {
3289 $log->warn("Need filehash");
3290 die "Need filehash\n";
3291 }
3292
27dd7387 3293 my $type = safe_pipe_capture('git', 'cat-file', '-t', $name);
90948a42
MO
3294 chomp $type;
3295
3296 unless ( defined ( $type ) and $type eq "blob" )
3297 {
3298 $log->warn("Invalid type '$type' for '$name'");
3299 die ( "Invalid type '$type' (expected 'blob')" )
3300 }
3301
27dd7387 3302 my $size = safe_pipe_capture('git', 'cat-file', '-s', $name);
90948a42
MO
3303 chomp $size;
3304
3305 $log->debug("open_blob_or_die($name) size=$size, type=$type");
3306
3307 unless( open $fh, '-|', "git", "cat-file", "blob", $name )
3308 {
3309 $log->warn("Unable to open sha1 $name");
3310 die "Unable to open sha1 $name\n";
3311 }
3312 }
3313 else
3314 {
3315 $log->warn("Unknown type of blob source: $srcType");
3316 die "Unknown type of blob source: $srcType\n";
3317 }
3318 return $fh;
3319}
3320
d500a1ee
FE
3321# Generate a CVS author name from Git author information, by taking the local
3322# part of the email address and replacing characters not in the Portable
3323# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS
3324# Login names are Unix login names, which should be restricted to this
3325# character set.
c1bc3061
DD
3326sub cvs_author
3327{
3328 my $author_line = shift;
d500a1ee
FE
3329 (my $author) = $author_line =~ /<([^@>]*)/;
3330
3331 $author =~ s/[^-a-zA-Z0-9_.]/_/g;
3332 $author =~ s/^-/_/;
c1bc3061
DD
3333
3334 $author;
3335}
3336
031a027a
ÆAB
3337
3338sub descramble
3339{
3340 # This table is from src/scramble.c in the CVS source
3341 my @SHIFTS = (
3342 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
3343 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
3344 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
3345 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
3346 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
3347 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
3348 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
3349 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
3350 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
3351 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
3352 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
3353 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
3354 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
3355 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
3356 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
3357 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
3358 );
3359 my ($str) = @_;
3360
fce338a5 3361 # This should never happen, the same password format (A) has been
031a027a 3362 # used by CVS since the beginning of time
1f0eb513
ÆAB
3363 {
3364 my $fmt = substr($str, 0, 1);
3365 die "invalid password format `$fmt'" unless $fmt eq 'A';
3366 }
031a027a
ÆAB
3367
3368 my @str = unpack "C*", substr($str, 1);
3369 my $ret = join '', map { chr $SHIFTS[$_] } @str;
3370 return $ret;
3371}
3372
61717661
MO
3373# Test if the (deep) values of two references to a hash are the same.
3374sub refHashEqual
3375{
3376 my($v1,$v2) = @_;
3377
3378 my $out;
3379 if(!defined($v1))
3380 {
3381 if(!defined($v2))
3382 {
3383 $out=1;
3384 }
3385 }
3386 elsif( !defined($v2) ||
3387 scalar(keys(%{$v1})) != scalar(keys(%{$v2})) )
3388 {
3389 # $out=undef;
3390 }
3391 else
3392 {
3393 $out=1;
3394
3395 my $key;
3396 foreach $key (keys(%{$v1}))
3397 {
3398 if( !exists($v2->{$key}) ||
3399 defined($v1->{$key}) ne defined($v2->{$key}) ||
3400 ( defined($v1->{$key}) &&
3401 $v1->{$key} ne $v2->{$key} ) )
3402 {
3403 $out=undef;
3404 last;
3405 }
3406 }
3407 }
3408
3409 return $out;
3410}
3411
fce13af5
JH
3412# an alternative to `command` that allows input to be passed as an array
3413# to work around shell problems with weird characters in arguments
3414
3415sub safe_pipe_capture {
3416
3417 my @output;
3418
3419 if (my $pid = open my $child, '-|') {
3420 @output = (<$child>);
3421 close $child or die join(' ',@_).": $! $?";
3422 } else {
3423 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
3424 }
3425 return wantarray ? @output : join('',@output);
3426}
3427
031a027a 3428
3fda8c4c
ML
3429package GITCVS::log;
3430
3431####
3432#### Copyright The Open University UK - 2006.
3433####
3434#### Authors: Martyn Smith <martyn@catalyst.net.nz>
adc3192e 3435#### Martin Langhoff <martin@laptop.org>
3fda8c4c
ML
3436####
3437####
3438
3439use strict;
3440use warnings;
3441
3442=head1 NAME
3443
3444GITCVS::log
3445
3446=head1 DESCRIPTION
3447
3448This module provides very crude logging with a similar interface to
3449Log::Log4perl
3450
3451=head1 METHODS
3452
3453=cut
3454
3455=head2 new
3456
3457Creates a new log object, optionally you can specify a filename here to
5348b6e7 3458indicate the file to log to. If no log file is specified, you can specify one
3fda8c4c
ML
3459later with method setfile, or indicate you no longer want logging with method
3460nofile.
3461
3462Until one of these methods is called, all log calls will buffer messages ready
3463to write out.
3464
3465=cut
3466sub new
3467{
3468 my $class = shift;
3469 my $filename = shift;
3470
3471 my $self = {};
3472
3473 bless $self, $class;
3474
3475 if ( defined ( $filename ) )
3476 {
3477 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3478 }
3479
3480 return $self;
3481}
3482
3483=head2 setfile
3484
3485This methods takes a filename, and attempts to open that file as the log file.
3486If successful, all buffered data is written out to the file, and any further
3487logging is written directly to the file.
3488
3489=cut
3490sub setfile
3491{
3492 my $self = shift;
3493 my $filename = shift;
3494
3495 if ( defined ( $filename ) )
3496 {
3497 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3498 }
3499
3500 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3501
3502 while ( my $line = shift @{$self->{buffer}} )
3503 {
3504 print {$self->{fh}} $line;
3505 }
3506}
3507
3508=head2 nofile
3509
3510This method indicates no logging is going to be used. It flushes any entries in
3511the internal buffer, and sets a flag to ensure no further data is put there.
3512
3513=cut
3514sub nofile
3515{
3516 my $self = shift;
3517
3518 $self->{nolog} = 1;
3519
3520 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3521
3522 $self->{buffer} = [];
3523}
3524
3525=head2 _logopen
3526
3527Internal method. Returns true if the log file is open, false otherwise.
3528
3529=cut
3530sub _logopen
3531{
3532 my $self = shift;
3533
3534 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
3535 return 0;
3536}
3537
3538=head2 debug info warn fatal
3539
3540These four methods are wrappers to _log. They provide the actual interface for
3541logging data.
3542
3543=cut
3544sub debug { my $self = shift; $self->_log("debug", @_); }
3545sub info { my $self = shift; $self->_log("info" , @_); }
3546sub warn { my $self = shift; $self->_log("warn" , @_); }
3547sub fatal { my $self = shift; $self->_log("fatal", @_); }
3548
3549=head2 _log
3550
3551This is an internal method called by the logging functions. It generates a
3552timestamp and pushes the logged line either to file, or internal buffer.
3553
3554=cut
3555sub _log
3556{
3557 my $self = shift;
3558 my $level = shift;
3559
3560 return if ( $self->{nolog} );
3561
3562 my @time = localtime;
3563 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
3564 $time[5] + 1900,
3565 $time[4] + 1,
3566 $time[3],
3567 $time[2],
3568 $time[1],
3569 $time[0],
3570 uc $level,
3571 );
3572
3573 if ( $self->_logopen )
3574 {
3575 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
3576 } else {
3577 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
3578 }
3579}
3580
3581=head2 DESTROY
3582
3583This method simply closes the file handle if one is open
3584
3585=cut
3586sub DESTROY
3587{
3588 my $self = shift;
3589
3590 if ( $self->_logopen )
3591 {
3592 close $self->{fh};
3593 }
3594}
3595
3596package GITCVS::updater;
3597
3598####
3599#### Copyright The Open University UK - 2006.
3600####
3601#### Authors: Martyn Smith <martyn@catalyst.net.nz>
adc3192e 3602#### Martin Langhoff <martin@laptop.org>
3fda8c4c
ML
3603####
3604####
3605
3606use strict;
3607use warnings;
3608use DBI;
3609
3610=head1 METHODS
3611
3612=cut
3613
3614=head2 new
3615
3616=cut
3617sub new
3618{
3619 my $class = shift;
3620 my $config = shift;
3621 my $module = shift;
3622 my $log = shift;
3623
3624 die "Need to specify a git repository" unless ( defined($config) and -d $config );
3625 die "Need to specify a module" unless ( defined($module) );
3626
3627 $class = ref($class) || $class;
3628
3629 my $self = {};
3630
3631 bless $self, $class;
3632
6aeeffd1
JE
3633 $self->{valid_tables} = {'revision' => 1,
3634 'revision_ix1' => 1,
3635 'revision_ix2' => 1,
3636 'head' => 1,
3637 'head_ix1' => 1,
3638 'properties' => 1,
3639 'commitmsgs' => 1};
3640
3fda8c4c 3641 $self->{module} = $module;
3fda8c4c
ML
3642 $self->{git_path} = $config . "/";
3643
3644 $self->{log} = $log;
3645
3646 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
3647
658b57ad
MO
3648 # Stores full sha1's for various branch/tag names, abbreviations, etc:
3649 $self->{commitRefCache} = {};
3650
eb1780d4 3651 $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
473937ed 3652 $cfg->{gitcvs}{dbdriver} || "SQLite";
eb1780d4
FL
3653 $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
3654 $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
3655 $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
3656 $cfg->{gitcvs}{dbuser} || "";
3657 $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
3658 $cfg->{gitcvs}{dbpass} || "";
6aeeffd1
JE
3659 $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
3660 $cfg->{gitcvs}{dbtablenameprefix} || "";
eb1780d4
FL
3661 my %mapping = ( m => $module,
3662 a => $state->{method},
3663 u => getlogin || getpwuid($<) || $<,
3664 G => $self->{git_path},
3665 g => mangle_dirname($self->{git_path}),
3666 );
3667 $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
3668 $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
6aeeffd1
JE
3669 $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
3670 $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
eb1780d4 3671
473937ed
FL
3672 die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
3673 die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
3674 $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
eb1780d4
FL
3675 $self->{dbuser},
3676 $self->{dbpass});
920a449a 3677 die "Error connecting to database\n" unless defined $self->{dbh};
3fda8c4c
ML
3678
3679 $self->{tables} = {};
0cf611a3 3680 foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
3fda8c4c 3681 {
3fda8c4c
ML
3682 $self->{tables}{$table} = 1;
3683 }
3684
3685 # Construct the revision table if required
196e48f4
MO
3686 # The revision table stores an entry for each file, each time that file
3687 # changes.
3688 # numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
3689 # This is not sufficient to support "-r {commithash}" for any
3690 # files except files that were modified by that commit (also,
3691 # some places in the code ignore/effectively strip out -r in
3692 # some cases, before it gets passed to getmeta()).
3693 # The "filehash" field typically has a git blob hash, but can also
3694 # be set to "dead" to indicate that the given version of the file
3695 # should not exist in the sandbox.
6aeeffd1 3696 unless ( $self->{tables}{$self->tablename("revision")} )
3fda8c4c 3697 {
6aeeffd1
JE
3698 my $tablename = $self->tablename("revision");
3699 my $ix1name = $self->tablename("revision_ix1");
3700 my $ix2name = $self->tablename("revision_ix2");
3fda8c4c 3701 $self->{dbh}->do("
6aeeffd1 3702 CREATE TABLE $tablename (
3fda8c4c
ML
3703 name TEXT NOT NULL,
3704 revision INTEGER NOT NULL,
3705 filehash TEXT NOT NULL,
3706 commithash TEXT NOT NULL,
3707 author TEXT NOT NULL,
3708 modified TEXT NOT NULL,
3709 mode TEXT NOT NULL
3710 )
3711 ");
178e015c 3712 $self->{dbh}->do("
6aeeffd1
JE
3713 CREATE INDEX $ix1name
3714 ON $tablename (name,revision)
178e015c
SP
3715 ");
3716 $self->{dbh}->do("
6aeeffd1
JE
3717 CREATE INDEX $ix2name
3718 ON $tablename (name,commithash)
178e015c 3719 ");
3fda8c4c
ML
3720 }
3721
178e015c 3722 # Construct the head table if required
196e48f4
MO
3723 # The head table (along with the "last_commit" entry in the property
3724 # table) is the persisted working state of the "sub update" subroutine.
3725 # All of it's data is read entirely first, and completely recreated
3726 # last, every time "sub update" runs.
3727 # This is also used by "sub getmeta" when it is asked for the latest
3728 # version of a file (as opposed to some specific version).
3729 # Another way of thinking about it is as a single slice out of
3730 # "revisions", giving just the most recent revision information for
3731 # each file.
6aeeffd1 3732 unless ( $self->{tables}{$self->tablename("head")} )
3fda8c4c 3733 {
6aeeffd1
JE
3734 my $tablename = $self->tablename("head");
3735 my $ix1name = $self->tablename("head_ix1");
3fda8c4c 3736 $self->{dbh}->do("
6aeeffd1 3737 CREATE TABLE $tablename (
3fda8c4c
ML
3738 name TEXT NOT NULL,
3739 revision INTEGER NOT NULL,
3740 filehash TEXT NOT NULL,
3741 commithash TEXT NOT NULL,
3742 author TEXT NOT NULL,
3743 modified TEXT NOT NULL,
3744 mode TEXT NOT NULL
3745 )
3746 ");
178e015c 3747 $self->{dbh}->do("
6aeeffd1
JE
3748 CREATE INDEX $ix1name
3749 ON $tablename (name)
178e015c 3750 ");
3fda8c4c
ML
3751 }
3752
3753 # Construct the properties table if required
196e48f4 3754 # - "last_commit" - Used by "sub update".
6aeeffd1 3755 unless ( $self->{tables}{$self->tablename("properties")} )
3fda8c4c 3756 {
6aeeffd1 3757 my $tablename = $self->tablename("properties");
3fda8c4c 3758 $self->{dbh}->do("
6aeeffd1 3759 CREATE TABLE $tablename (
3fda8c4c
ML
3760 key TEXT NOT NULL PRIMARY KEY,
3761 value TEXT
3762 )
3763 ");
3764 }
3765
3766 # Construct the commitmsgs table if required
196e48f4
MO
3767 # The commitmsgs table is only used for merge commits, since
3768 # "sub update" will only keep one branch of parents. Shortlogs
3769 # for ignored commits (i.e. not on the chosen branch) will be used
3770 # to construct a replacement "collapsed" merge commit message,
3771 # which will be stored in this table. See also "sub commitmessage".
6aeeffd1 3772 unless ( $self->{tables}{$self->tablename("commitmsgs")} )
3fda8c4c 3773 {
6aeeffd1 3774 my $tablename = $self->tablename("commitmsgs");
3fda8c4c 3775 $self->{dbh}->do("
6aeeffd1 3776 CREATE TABLE $tablename (
3fda8c4c
ML
3777 key TEXT NOT NULL PRIMARY KEY,
3778 value TEXT
3779 )
3780 ");
3781 }
3782
3783 return $self;
3784}
3785
6aeeffd1
JE
3786=head2 tablename
3787
3788=cut
3789sub tablename
3790{
3791 my $self = shift;
3792 my $name = shift;
3793
3794 if (exists $self->{valid_tables}{$name}) {
3795 return $self->{dbtablenameprefix} . $name;
3796 } else {
3797 return undef;
3798 }
3799}
3800
3fda8c4c
ML
3801=head2 update
3802
196e48f4
MO
3803Bring the database up to date with the latest changes from
3804the git repository.
3805
3806Internal working state is read out of the "head" table and the
3807"last_commit" property, then it updates "revisions" based on that, and
3808finally it writes the new internal state back to the "head" table
3809so it can be used as a starting point the next time update is called.
3810
3fda8c4c
ML
3811=cut
3812sub update
3813{
3814 my $self = shift;
3815
3816 # first lets get the commit list
3817 $ENV{GIT_DIR} = $self->{git_path};
3818
27dd7387 3819 my $commitsha1 = ::safe_pipe_capture('git', 'rev-parse', $self->{module});
49fb940e
ML
3820 chomp $commitsha1;
3821
27dd7387 3822 my $commitinfo = ::safe_pipe_capture('git', 'cat-file', 'commit', $self->{module});
05ea93d6 3823 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{$state->{hexsz}}/ )
3fda8c4c
ML
3824 {
3825 die("Invalid module '$self->{module}'");
3826 }
3827
3828
3829 my $git_log;
3830 my $lastcommit = $self->_get_prop("last_commit");
3831
49fb940e 3832 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
61717661
MO
3833 # invalidate the gethead cache
3834 $self->clearCommitRefCaches();
49fb940e
ML
3835 return 1;
3836 }
3837
3fda8c4c
ML
3838 # Start exclusive lock here...
3839 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
3840
3841 # TODO: log processing is memory bound
3842 # if we can parse into a 2nd file that is in reverse order
3843 # we can probably do something really efficient
a248c961 3844 my @git_log_params = ('--pretty', '--parents', '--topo-order');
3fda8c4c
ML
3845
3846 if (defined $lastcommit) {
3847 push @git_log_params, "$lastcommit..$self->{module}";
3848 } else {
3849 push @git_log_params, $self->{module};
3850 }
a248c961 3851 # git-rev-list is the backend / plumbing version of git-log
2c3af7e7
MO
3852 open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
3853 or die "Cannot call git-rev-list: $!";
3854 my @commits=readCommits($gitLogPipe);
3855 close $gitLogPipe;
3fda8c4c
ML
3856
3857 # Now all the commits are in the @commits bucket
3858 # ordered by time DESC. for each commit that needs processing,
3859 # determine whether it's following the last head we've seen or if
3860 # it's on its own branch, grab a file list, and add whatever's changed
3861 # NOTE: $lastcommit refers to the last commit from previous run
3862 # $lastpicked is the last commit we picked in this run
3863 my $lastpicked;
3864 my $head = {};
3865 if (defined $lastcommit) {
3866 $lastpicked = $lastcommit;
3867 }
3868
3869 my $committotal = scalar(@commits);
3870 my $commitcount = 0;
3871
3872 # Load the head table into $head (for cached lookups during the update process)
ab07681f 3873 foreach my $file ( @{$self->gethead(1)} )
3fda8c4c
ML
3874 {
3875 $head->{$file->{name}} = $file;
3876 }
3877
3878 foreach my $commit ( @commits )
3879 {
3880 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
3881 if (defined $lastpicked)
3882 {
3883 if (!in_array($lastpicked, @{$commit->{parents}}))
3884 {
3885 # skip, we'll see this delta
3886 # as part of a merge later
3887 # warn "skipping off-track $commit->{hash}\n";
3888 next;
3889 } elsif (@{$commit->{parents}} > 1) {
3890 # it is a merge commit, for each parent that is
196e48f4
MO
3891 # not $lastpicked (not given a CVS revision number),
3892 # see if we can get a log
3fda8c4c
ML
3893 # from the merge-base to that parent to put it
3894 # in the message as a merge summary.
3895 my @parents = @{$commit->{parents}};
3896 foreach my $parent (@parents) {
3fda8c4c
ML
3897 if ($parent eq $lastpicked) {
3898 next;
3899 }
196e48f4
MO
3900 # git-merge-base can potentially (but rarely) throw
3901 # several candidate merge bases. let's assume
3902 # that the first one is the best one.
e509db99 3903 my $base = eval {
fce13af5 3904 ::safe_pipe_capture('git', 'merge-base',
a5e40798 3905 $lastpicked, $parent);
e509db99
SP
3906 };
3907 # The two branches may not be related at all,
3908 # in which case merge base simply fails to find
3909 # any, but that's Ok.
3910 next if ($@);
3911
3fda8c4c
ML
3912 chomp $base;
3913 if ($base) {
3914 my @merged;
3915 # print "want to log between $base $parent \n";
d2feb01a 3916 open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
a5e40798 3917 or die "Cannot call git-log: $!";
3fda8c4c
ML
3918 my $mergedhash;
3919 while (<GITLOG>) {
3920 chomp;
3921 if (!defined $mergedhash) {
3922 if (m/^commit\s+(.+)$/) {
3923 $mergedhash = $1;
3924 } else {
3925 next;
3926 }
3927 } else {
3928 # grab the first line that looks non-rfc822
3929 # aka has content after leading space
3930 if (m/^\s+(\S.*)$/) {
3931 my $title = $1;
3932 $title = substr($title,0,100); # truncate
3933 unshift @merged, "$mergedhash $title";
3934 undef $mergedhash;
3935 }
3936 }
3937 }
3938 close GITLOG;
3939 if (@merged) {
3940 $commit->{mergemsg} = $commit->{message};
3941 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
3942 foreach my $summary (@merged) {
3943 $commit->{mergemsg} .= "\t$summary\n";
3944 }
3945 $commit->{mergemsg} .= "\n\n";
3946 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
3947 }
3948 }
3949 }
3950 }
3951 }
3952
3953 # convert the date to CVS-happy format
2c3af7e7 3954 my $cvsDate = convertToCvsDate($commit->{date});
3fda8c4c
ML
3955
3956 if ( defined ( $lastpicked ) )
3957 {
d2feb01a 3958 my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
e02cd638 3959 local ($/) = "\0";
3fda8c4c
ML
3960 while ( <FILELIST> )
3961 {
e02cd638 3962 chomp;
05ea93d6 3963 unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{$state->{hexsz}}\s+([a-f0-9]{$state->{hexsz}})\s+(\w)$/o )
3fda8c4c
ML
3964 {
3965 die("Couldn't process git-diff-tree line : $_");
3966 }
e02cd638
JH
3967 my ($mode, $hash, $change) = ($1, $2, $3);
3968 my $name = <FILELIST>;
3969 chomp($name);
3fda8c4c 3970
e02cd638 3971 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
3fda8c4c 3972
2c3af7e7 3973 my $dbMode = convertToDbMode($mode);
3fda8c4c 3974
e02cd638 3975 if ( $change eq "D" )
3fda8c4c 3976 {
e02cd638
JH
3977 #$log->debug("DELETE $name");
3978 $head->{$name} = {
3979 name => $name,
3980 revision => $head->{$name}{revision} + 1,
3fda8c4c
ML
3981 filehash => "deleted",
3982 commithash => $commit->{hash},
2c3af7e7 3983 modified => $cvsDate,
3fda8c4c 3984 author => $commit->{author},
2c3af7e7 3985 mode => $dbMode,
3fda8c4c 3986 };
2c3af7e7 3987 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
3fda8c4c 3988 }
9027efed 3989 elsif ( $change eq "M" || $change eq "T" )
3fda8c4c 3990 {
e02cd638
JH
3991 #$log->debug("MODIFIED $name");
3992 $head->{$name} = {
3993 name => $name,
3994 revision => $head->{$name}{revision} + 1,
3995 filehash => $hash,
3fda8c4c 3996 commithash => $commit->{hash},
2c3af7e7 3997 modified => $cvsDate,
3fda8c4c 3998 author => $commit->{author},
2c3af7e7 3999 mode => $dbMode,
3fda8c4c 4000 };
2c3af7e7 4001 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
3fda8c4c 4002 }
e02cd638 4003 elsif ( $change eq "A" )
3fda8c4c 4004 {
e02cd638
JH
4005 #$log->debug("ADDED $name");
4006 $head->{$name} = {
4007 name => $name,
a7da9adb 4008 revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
e02cd638 4009 filehash => $hash,
3fda8c4c 4010 commithash => $commit->{hash},
2c3af7e7 4011 modified => $cvsDate,
3fda8c4c 4012 author => $commit->{author},
2c3af7e7 4013 mode => $dbMode,
3fda8c4c 4014 };
2c3af7e7 4015 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
3fda8c4c
ML
4016 }
4017 else
4018 {
e02cd638 4019 $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
3fda8c4c
ML
4020 die;
4021 }
4022 }
4023 close FILELIST;
4024 } else {
4025 # this is used to detect files removed from the repo
4026 my $seen_files = {};
4027
d2feb01a 4028 my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
e02cd638 4029 local $/ = "\0";
3fda8c4c
ML
4030 while ( <FILELIST> )
4031 {
e02cd638
JH
4032 chomp;
4033 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
3fda8c4c
ML
4034 {
4035 die("Couldn't process git-ls-tree line : $_");
4036 }
4037
2c3af7e7 4038 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
3fda8c4c
ML
4039
4040 $seen_files->{$git_filename} = 1;
4041
4042 my ( $oldhash, $oldrevision, $oldmode ) = (
4043 $head->{$git_filename}{filehash},
4044 $head->{$git_filename}{revision},
4045 $head->{$git_filename}{mode}
4046 );
4047
2c3af7e7 4048 my $dbMode = convertToDbMode($mode);
3fda8c4c
ML
4049
4050 # unless the file exists with the same hash, we need to update it ...
2c3af7e7 4051 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
3fda8c4c
ML
4052 {
4053 my $newrevision = ( $oldrevision or 0 ) + 1;
4054
4055 $head->{$git_filename} = {
4056 name => $git_filename,
4057 revision => $newrevision,
4058 filehash => $git_hash,
4059 commithash => $commit->{hash},
2c3af7e7 4060 modified => $cvsDate,
3fda8c4c 4061 author => $commit->{author},
2c3af7e7 4062 mode => $dbMode,
3fda8c4c
ML
4063 };
4064
4065
2c3af7e7 4066 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
3fda8c4c
ML
4067 }
4068 }
4069 close FILELIST;
4070
4071 # Detect deleted files
9462953a 4072 foreach my $file ( sort keys %$head )
3fda8c4c
ML
4073 {
4074 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
4075 {
4076 $head->{$file}{revision}++;
4077 $head->{$file}{filehash} = "deleted";
4078 $head->{$file}{commithash} = $commit->{hash};
2c3af7e7 4079 $head->{$file}{modified} = $cvsDate;
3fda8c4c
ML
4080 $head->{$file}{author} = $commit->{author};
4081
2c3af7e7 4082 $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $cvsDate, $commit->{author}, $head->{$file}{mode});
3fda8c4c
ML
4083 }
4084 }
4085 # END : "Detect deleted files"
4086 }
4087
4088
4089 if (exists $commit->{mergemsg})
4090 {
96256bba 4091 $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
3fda8c4c
ML
4092 }
4093
4094 $lastpicked = $commit->{hash};
4095
4096 $self->_set_prop("last_commit", $commit->{hash});
4097 }
4098
96256bba 4099 $self->delete_head();
9462953a 4100 foreach my $file ( sort keys %$head )
3fda8c4c 4101 {
96256bba 4102 $self->insert_head(
3fda8c4c
ML
4103 $file,
4104 $head->{$file}{revision},
4105 $head->{$file}{filehash},
4106 $head->{$file}{commithash},
4107 $head->{$file}{modified},
4108 $head->{$file}{author},
4109 $head->{$file}{mode},
4110 );
4111 }
4112 # invalidate the gethead cache
658b57ad 4113 $self->clearCommitRefCaches();
3fda8c4c
ML
4114
4115
4116 # Ending exclusive lock here
4117 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
4118}
4119
2c3af7e7
MO
4120sub readCommits
4121{
4122 my $pipeHandle = shift;
4123 my @commits;
4124
4125 my %commit = ();
4126
4127 while ( <$pipeHandle> )
4128 {
4129 chomp;
4130 if (m/^commit\s+(.*)$/) {
4131 # on ^commit lines put the just seen commit in the stack
4132 # and prime things for the next one
4133 if (keys %commit) {
4134 my %copy = %commit;
4135 unshift @commits, \%copy;
4136 %commit = ();
4137 }
4138 my @parents = split(m/\s+/, $1);
4139 $commit{hash} = shift @parents;
4140 $commit{parents} = \@parents;
4141 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
4142 # on rfc822-like lines seen before we see any message,
4143 # lowercase the entry and put it in the hash as key-value
4144 $commit{lc($1)} = $2;
4145 } else {
4146 # message lines - skip initial empty line
4147 # and trim whitespace
4148 if (!exists($commit{message}) && m/^\s*$/) {
4149 # define it to mark the end of headers
4150 $commit{message} = '';
4151 next;
4152 }
4153 s/^\s+//; s/\s+$//; # trim ws
4154 $commit{message} .= $_ . "\n";
4155 }
4156 }
4157
4158 unshift @commits, \%commit if ( keys %commit );
4159
4160 return @commits;
4161}
4162
4163sub convertToCvsDate
4164{
4165 my $date = shift;
4166 # Convert from: "git rev-list --pretty" formatted date
4167 # Convert to: "the format specified by RFC822 as modified by RFC1123."
4168 # Example: 26 May 1997 13:01:40 -0400
4169 if( $date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ )
4170 {
4171 $date = "$2 $1 $4 $3 $5";
4172 }
4173
4174 return $date;
4175}
4176
4177sub convertToDbMode
4178{
4179 my $mode = shift;
4180
4181 # NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",
4182 # but the database "mode" column historically (and currently)
4183 # only stores the "rw" (for user) part of the string.
4184 # FUTURE: It might make more sense to persist the raw
4185 # octal mode (or perhaps the final full CVS form) instead of
4186 # this half-converted form, but it isn't currently worth the
4187 # backwards compatibility headaches.
4188
1b48d56c 4189 $mode=~/^\d{3}(\d)\d\d$/;
2c3af7e7
MO
4190 my $userBits=$1;
4191
4192 my $dbMode = "";
4193 $dbMode .= "r" if ( $userBits & 4 );
4194 $dbMode .= "w" if ( $userBits & 2 );
4195 $dbMode .= "x" if ( $userBits & 1 );
4196 $dbMode = "rw" if ( $dbMode eq "" );
4197
4198 return $dbMode;
4199}
4200
96256bba
JS
4201sub insert_rev
4202{
4203 my $self = shift;
4204 my $name = shift;
4205 my $revision = shift;
4206 my $filehash = shift;
4207 my $commithash = shift;
4208 my $modified = shift;
4209 my $author = shift;
4210 my $mode = shift;
6aeeffd1 4211 my $tablename = $self->tablename("revision");
96256bba 4212
6aeeffd1 4213 my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
96256bba
JS
4214 $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4215}
4216
4217sub insert_mergelog
4218{
4219 my $self = shift;
4220 my $key = shift;
4221 my $value = shift;
6aeeffd1 4222 my $tablename = $self->tablename("commitmsgs");
96256bba 4223
6aeeffd1 4224 my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
96256bba
JS
4225 $insert_mergelog->execute($key, $value);
4226}
4227
4228sub delete_head
4229{
4230 my $self = shift;
6aeeffd1 4231 my $tablename = $self->tablename("head");
96256bba 4232
6aeeffd1 4233 my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
96256bba
JS
4234 $delete_head->execute();
4235}
4236
4237sub insert_head
4238{
4239 my $self = shift;
4240 my $name = shift;
4241 my $revision = shift;
4242 my $filehash = shift;
4243 my $commithash = shift;
4244 my $modified = shift;
4245 my $author = shift;
4246 my $mode = shift;
6aeeffd1 4247 my $tablename = $self->tablename("head");
96256bba 4248
6aeeffd1 4249 my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
96256bba
JS
4250 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4251}
4252
3fda8c4c
ML
4253sub _get_prop
4254{
4255 my $self = shift;
4256 my $key = shift;
6aeeffd1 4257 my $tablename = $self->tablename("properties");
3fda8c4c 4258
6aeeffd1 4259 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
3fda8c4c
ML
4260 $db_query->execute($key);
4261 my ( $value ) = $db_query->fetchrow_array;
4262
4263 return $value;
4264}
4265
4266sub _set_prop
4267{
4268 my $self = shift;
4269 my $key = shift;
4270 my $value = shift;
6aeeffd1 4271 my $tablename = $self->tablename("properties");
3fda8c4c 4272
6aeeffd1 4273 my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
3fda8c4c
ML
4274 $db_query->execute($value, $key);
4275
4276 unless ( $db_query->rows )
4277 {
6aeeffd1 4278 $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
3fda8c4c
ML
4279 $db_query->execute($key, $value);
4280 }
4281
4282 return $value;
4283}
4284
4285=head2 gethead
4286
4287=cut
4288
4289sub gethead
4290{
4291 my $self = shift;
ab07681f 4292 my $intRev = shift;
6aeeffd1 4293 my $tablename = $self->tablename("head");
3fda8c4c
ML
4294
4295 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
4296
6aeeffd1 4297 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
3fda8c4c
ML
4298 $db_query->execute();
4299
4300 my $tree = [];
4301 while ( my $file = $db_query->fetchrow_hashref )
4302 {
ab07681f
MO
4303 if(!$intRev)
4304 {
4305 $file->{revision} = "1.$file->{revision}"
4306 }
3fda8c4c
ML
4307 push @$tree, $file;
4308 }
4309
4310 $self->{gethead_cache} = $tree;
4311
4312 return $tree;
4313}
4314
658b57ad
MO
4315=head2 getAnyHead
4316
4317Returns a reference to an array of getmeta structures, one
4318per file in the specified tree hash.
4319
4320=cut
4321
4322sub getAnyHead
4323{
4324 my ($self,$hash) = @_;
4325
4326 if(!defined($hash))
4327 {
4328 return $self->gethead();
4329 }
4330
4331 my @files;
4332 {
4333 open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4334 or die("Cannot call git-ls-tree : $!");
4335 local $/ = "\0";
4336 @files=<$filePipe>;
4337 close $filePipe;
4338 }
4339
4340 my $tree=[];
4341 my($line);
4342 foreach $line (@files)
4343 {
4344 $line=~s/\0$//;
4345 unless ( $line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4346 {
4347 die("Couldn't process git-ls-tree line : $_");
4348 }
4349
4350 my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4351 push @$tree, $self->getMetaFromCommithash($git_filename,$hash);
4352 }
4353
4354 return $tree;
4355}
4356
4357=head2 getRevisionDirMap
4358
4359A "revision dir map" contains all the plain-file filenames associated
bb8040f9 4360with a particular revision (tree-ish), organized by directory:
658b57ad
MO
4361
4362 $type = $out->{$dir}{$fullName}
4363
4364The type of each is "F" (for ordinary file) or "D" (for directory,
4365for which the map $out->{$fullName} will also exist).
4366
4367=cut
4368
4369sub getRevisionDirMap
4370{
4371 my ($self,$ver)=@_;
4372
4373 if(!defined($self->{revisionDirMapCache}))
4374 {
4375 $self->{revisionDirMapCache}={};
4376 }
4377
4378 # Get file list (previously cached results are dependent on HEAD,
4379 # but are early in each case):
4380 my $cacheKey;
4381 my (@fileList);
4382 if( !defined($ver) || $ver eq "" )
4383 {
4384 $cacheKey="";
4385 if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4386 {
4387 return $self->{revisionDirMapCache}{$cacheKey};
4388 }
4389
4390 my @head = @{$self->gethead()};
4391 foreach my $file ( @head )
4392 {
4393 next if ( $file->{filehash} eq "deleted" );
4394
4395 push @fileList,$file->{name};
4396 }
4397 }
4398 else
4399 {
4400 my ($hash)=$self->lookupCommitRef($ver);
4401 if( !defined($hash) )
4402 {
4403 return undef;
4404 }
4405
4406 $cacheKey=$hash;
4407 if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4408 {
4409 return $self->{revisionDirMapCache}{$cacheKey};
4410 }
4411
4412 open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4413 or die("Cannot call git-ls-tree : $!");
4414 local $/ = "\0";
4415 while ( <$filePipe> )
4416 {
4417 chomp;
4418 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4419 {
4420 die("Couldn't process git-ls-tree line : $_");
4421 }
4422
4423 my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4424
4425 push @fileList, $git_filename;
4426 }
4427 close $filePipe;
4428 }
4429
4430 # Convert to normalized form:
4431 my %revMap;
4432 my $file;
4433 foreach $file (@fileList)
4434 {
4435 my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);
4436 $dir='' if(!defined($dir));
4437
4438 # parent directories:
4439 # ... create empty dir maps for parent dirs:
4440 my($td)=$dir;
4441 while(!defined($revMap{$td}))
4442 {
4443 $revMap{$td}={};
4444
4445 my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4446 $tp='' if(!defined($tp));
4447 $td=$tp;
4448 }
4449 # ... add children to parent maps (now that they exist):
4450 $td=$dir;
4451 while($td ne "")
4452 {
4453 my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4454 $tp='' if(!defined($tp));
4455
4456 if(defined($revMap{$tp}{$td}))
4457 {
4458 if($revMap{$tp}{$td} ne 'D')
4459 {
4460 die "Weird file/directory inconsistency in $cacheKey";
4461 }
4462 last; # loop exit
4463 }
4464 $revMap{$tp}{$td}='D';
4465
4466 $td=$tp;
4467 }
4468
4469 # file
4470 $revMap{$dir}{$file}='F';
4471 }
4472
4473 # Save in cache:
4474 $self->{revisionDirMapCache}{$cacheKey}=\%revMap;
4475 return $self->{revisionDirMapCache}{$cacheKey};
4476}
4477
3fda8c4c
ML
4478=head2 getlog
4479
a86c0983
MO
4480See also gethistorydense().
4481
3fda8c4c
ML
4482=cut
4483
4484sub getlog
4485{
4486 my $self = shift;
4487 my $filename = shift;
ab07681f
MO
4488 my $revFilter = shift;
4489
6aeeffd1 4490 my $tablename = $self->tablename("revision");
3fda8c4c 4491
ab07681f
MO
4492 # Filters:
4493 # TODO: date, state, or by specific logins filters?
4494 # TODO: Handle comma-separated list of revFilter items, each item
4495 # can be a range [only case currently handled] or individual
4496 # rev or branch or "branch.".
4497 # TODO: Adjust $db_query WHERE clause based on revFilter, instead of
4498 # manually filtering the results of the query?
4499 my ( $minrev, $maxrev );
4500 if( defined($revFilter) and
4501 $state->{opt}{r} =~ /^(1.(\d+))?(::?)(1.(\d.+))?$/ )
4502 {
4503 my $control = $3;
4504 $minrev = $2;
4505 $maxrev = $5;
4506 $minrev++ if ( defined($minrev) and $control eq "::" );
4507 }
4508
6aeeffd1 4509 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
3fda8c4c
ML
4510 $db_query->execute($filename);
4511
ab07681f 4512 my $totalRevs=0;
3fda8c4c
ML
4513 my $tree = [];
4514 while ( my $file = $db_query->fetchrow_hashref )
4515 {
ab07681f
MO
4516 $totalRevs++;
4517 if( defined($minrev) and $file->{revision} < $minrev )
4518 {
4519 next;
4520 }
4521 if( defined($maxrev) and $file->{revision} > $maxrev )
4522 {
4523 next;
4524 }
4525
4526 $file->{revision} = "1." . $file->{revision};
3fda8c4c
ML
4527 push @$tree, $file;
4528 }
4529
ab07681f 4530 return ($tree,$totalRevs);
3fda8c4c
ML
4531}
4532
4533=head2 getmeta
4534
4535This function takes a filename (with path) argument and returns a hashref of
4536metadata for that file.
4537
bfdafa09
MO
4538There are several ways $revision can be specified:
4539
4540 - A reference to hash that contains a "tag" that is the
4541 actual revision (one of the below). TODO: Also allow it to
4542 specify a "date" in the hash.
4543 - undef, to refer to the latest version on the main branch.
4544 - Full CVS client revision number (mapped to integer in DB, without the
4545 "1." prefix),
4546 - Complex CVS-compatible "special" revision number for
4547 non-linear history (see comment below)
4548 - git commit sha1 hash
4549 - branch or tag name
4550
3fda8c4c
ML
4551=cut
4552
4553sub getmeta
4554{
4555 my $self = shift;
4556 my $filename = shift;
4557 my $revision = shift;
6aeeffd1
JE
4558 my $tablename_rev = $self->tablename("revision");
4559 my $tablename_head = $self->tablename("head");
3fda8c4c 4560
bfdafa09 4561 if ( ref($revision) eq "HASH" )
3fda8c4c 4562 {
bfdafa09 4563 $revision = $revision->{tag};
3fda8c4c 4564 }
bfdafa09
MO
4565
4566 # Overview of CVS revision numbers:
4567 #
4568 # General CVS numbering scheme:
4569 # - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.
4570 # - Result of "cvs checkin -r" (possible, but not really
4571 # recommended): "2.1", "2.2", etc
4572 # - Branch tag: "1.2.0.n", where "1.2" is revision it was branched
4573 # from, "0" is a magic placeholder that identifies it as a
4574 # branch tag instead of a version tag, and n is 2 times the
4575 # branch number off of "1.2", starting with "2".
4576 # - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"
4577 # is branch number off of "1.2" (like n above), and "x" is
4578 # the version number on the branch.
4579 # - Branches can branch off of branches: "1.3.2.7.4.1" (even number
4580 # of components).
4581 # - Odd "n"s are used by "vendor branches" that result
4582 # from "cvs import". Vendor branches have additional
4583 # strangeness in the sense that the main rcs "head" of the main
4584 # branch will (temporarily until first normal commit) point
4585 # to the version on the vendor branch, rather than the actual
4586 # main branch. (FUTURE: This may provide an opportunity
4587 # to use "strange" revision numbers for fast-forward-merged
4588 # branch tip when CVS client is asking for the main branch.)
4589 #
4590 # git-cvsserver CVS-compatible special numbering schemes:
4591 # - Currently git-cvsserver only tries to be identical to CVS for
4592 # simple "1.x" numbers on the "main" branch (as identified
4593 # by the module name that was originally cvs checkout'ed).
4594 # - The database only stores the "x" part, for historical reasons.
4595 # But most of the rest of the cvsserver preserves
4596 # and thinks using the full revision number.
4597 # - To handle non-linear history, it uses a version of the form
4598 # "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely
4599 # identify this as a special revision number, and there are
4600 # 20 b's that together encode the sha1 git commit from which
4601 # this version of this file originated. Each b is
4602 # the numerical value of the corresponding byte plus
4603 # 100.
4604 # - "plus 100" avoids "0"s, and also reduces the
41ccfdd9 4605 # likelihood of a collision in the case that someone someday
bfdafa09
MO
4606 # writes an import tool that tries to preserve original
4607 # CVS revision numbers, and the original CVS data had done
4608 # lots of branches off of branches and other strangeness to
4609 # end up with a real version number that just happens to look
4610 # like this special revision number form. Also, if needed
4611 # there are several ways to extend/identify alternative encodings
4612 # within the "2.1.1.2000" part if necessary.
4613 # - Unlike real CVS revisions, you can't really reconstruct what
4614 # relation a revision of this form has to other revisions.
4615 # - FUTURE: TODO: Rework database somehow to make up and remember
4616 # fully-CVS-compatible branches and branch version numbers.
4617
4618 my $meta;
4619 if ( defined($revision) )
3fda8c4c 4620 {
bfdafa09
MO
4621 if ( $revision =~ /^1\.(\d+)$/ )
4622 {
4623 my ($intRev) = $1;
4624 my $db_query;
4625 $db_query = $self->{dbh}->prepare_cached(
4626 "SELECT * FROM $tablename_rev WHERE name=? AND revision=?",
4627 {},1);
4628 $db_query->execute($filename, $intRev);
4629 $meta = $db_query->fetchrow_hashref;
4630 }
05ea93d6 4631 elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){$state->{rawsz}}$/ )
bfdafa09
MO
4632 {
4633 my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
4634 $commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
05ea93d6 4635 if($commitHash=~/^[0-9a-f]{$state->{hexsz}}$/)
bfdafa09
MO
4636 {
4637 return $self->getMetaFromCommithash($filename,$commitHash);
4638 }
4639
4640 # error recovery: fall back on head version below
4641 print "E Failed to find $filename version=$revision or commit=$commitHash\n";
4642 $log->warning("failed get $revision with commithash=$commitHash");
4643 undef $revision;
4644 }
05ea93d6 4645 elsif ( $revision =~ /^[0-9a-f]{$state->{hexsz}}$/ )
bfdafa09
MO
4646 {
4647 # Try DB first. This is mostly only useful for req_annotate(),
4648 # which only calls this for stuff that should already be in
4649 # the DB. It is fairly likely to be a waste of time
4650 # in most other cases [unless the file happened to be
4651 # modified in $revision specifically], but
4652 # it is probably in the noise compared to how long
4653 # getMetaFromCommithash() will take.
4654 my $db_query;
4655 $db_query = $self->{dbh}->prepare_cached(
4656 "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4657 {},1);
4658 $db_query->execute($filename, $revision);
4659 $meta = $db_query->fetchrow_hashref;
4660
4661 if(! $meta)
4662 {
4663 my($revCommit)=$self->lookupCommitRef($revision);
05ea93d6 4664 if($revCommit=~/^[0-9a-f]{$state->{hexsz}}$/)
bfdafa09
MO
4665 {
4666 return $self->getMetaFromCommithash($filename,$revCommit);
4667 }
4668
4669 # error recovery: nothing found:
4670 print "E Failed to find $filename version=$revision\n";
4671 $log->warning("failed get $revision");
4672 return $meta;
4673 }
4674 }
4675 else
4676 {
4677 my($revCommit)=$self->lookupCommitRef($revision);
05ea93d6 4678 if($revCommit=~/^[0-9a-f]{$state->{hexsz}}$/)
bfdafa09
MO
4679 {
4680 return $self->getMetaFromCommithash($filename,$revCommit);
4681 }
4682
4683 # error recovery: fall back on head version below
4684 print "E Failed to find $filename version=$revision\n";
4685 $log->warning("failed get $revision");
4686 undef $revision; # Allow fallback
4687 }
4688 }
4689
4690 if(!defined($revision))
4691 {
4692 my $db_query;
4693 $db_query = $self->{dbh}->prepare_cached(
4694 "SELECT * FROM $tablename_head WHERE name=?",{},1);
3fda8c4c 4695 $db_query->execute($filename);
bfdafa09 4696 $meta = $db_query->fetchrow_hashref;
3fda8c4c
ML
4697 }
4698
ab07681f
MO
4699 if($meta)
4700 {
4701 $meta->{revision} = "1.$meta->{revision}";
4702 }
4703 return $meta;
3fda8c4c
ML
4704}
4705
658b57ad
MO
4706sub getMetaFromCommithash
4707{
4708 my $self = shift;
4709 my $filename = shift;
4710 my $revCommit = shift;
4711
4712 # NOTE: This function doesn't scale well (lots of forks), especially
4713 # if you have many files that have not been modified for many commits
4714 # (each git-rev-parse redoes a lot of work for each file
4715 # that theoretically could be done in parallel by smarter
4716 # graph traversal).
4717 #
4718 # TODO: Possible optimization strategies:
4719 # - Solve the issue of assigning and remembering "real" CVS
4720 # revision numbers for branches, and ensure the
4721 # data structure can do this efficiently. Perhaps something
4722 # similar to "git notes", and carefully structured to take
4723 # advantage same-sha1-is-same-contents, to roll the same
4724 # unmodified subdirectory data onto multiple commits?
4725 # - Write and use a C tool that is like git-blame, but
4726 # operates on multiple files with file granularity, instead
4727 # of one file with line granularity. Cache
4728 # most-recently-modified in $self->{commitRefCache}{$revCommit}.
4729 # Try to be intelligent about how many files we do with
4730 # one fork (perhaps one directory at a time, without recursion,
4731 # and/or include directory as one line item, recurse from here
4732 # instead of in C tool?).
4733 # - Perhaps we could ask the DB for (filename,fileHash),
4734 # and just guess that it is correct (that the file hadn't
4735 # changed between $revCommit and the found commit, then
4736 # changed back, confusing anything trying to interpret
4737 # history). Probably need to add another index to revisions
4738 # DB table for this.
4739 # - NOTE: Trying to store all (commit,file) keys in DB [to
4740 # find "lastModfiedCommit] (instead of
4741 # just files that changed in each commit as we do now) is
4742 # probably not practical from a disk space perspective.
4743
4744 # Does the file exist in $revCommit?
4745 # TODO: Include file hash in dirmap cache.
4746 my($dirMap)=$self->getRevisionDirMap($revCommit);
4747 my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);
4748 if(!defined($dir))
4749 {
4750 $dir="";
4751 }
4752 if( !defined($dirMap->{$dir}) ||
4753 !defined($dirMap->{$dir}{$filename}) )
4754 {
4755 my($fileHash)="deleted";
4756
4757 my($retVal)={};
4758 $retVal->{name}=$filename;
4759 $retVal->{filehash}=$fileHash;
4760
4761 # not needed and difficult to compute:
4762 $retVal->{revision}="0"; # $revision;
4763 $retVal->{commithash}=$revCommit;
4764 #$retVal->{author}=$commit->{author};
4765 #$retVal->{modified}=convertToCvsDate($commit->{date});
4766 #$retVal->{mode}=convertToDbMode($mode);
4767
4768 return $retVal;
4769 }
4770
fce13af5 4771 my($fileHash) = ::safe_pipe_capture("git","rev-parse","$revCommit:$filename");
658b57ad 4772 chomp $fileHash;
05ea93d6 4773 if(!($fileHash=~/^[0-9a-f]{$state->{hexsz}}$/))
658b57ad
MO
4774 {
4775 die "Invalid fileHash '$fileHash' looking up"
4776 ." '$revCommit:$filename'\n";
4777 }
4778
4779 # information about most recent commit to modify $filename:
4780 open(my $gitLogPipe, '-|', 'git', 'rev-list',
4781 '--max-count=1', '--pretty', '--parents',
4782 $revCommit, '--', $filename)
4783 or die "Cannot call git-rev-list: $!";
4784 my @commits=readCommits($gitLogPipe);
4785 close $gitLogPipe;
4786 if(scalar(@commits)!=1)
4787 {
4788 die "Can't find most recent commit changing $filename\n";
4789 }
4790 my($commit)=$commits[0];
4791 if( !defined($commit) || !defined($commit->{hash}) )
4792 {
4793 return undef;
4794 }
4795
4796 # does this (commit,file) have a real assigned CVS revision number?
4797 my $tablename_rev = $self->tablename("revision");
4798 my $db_query;
4799 $db_query = $self->{dbh}->prepare_cached(
4800 "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4801 {},1);
4802 $db_query->execute($filename, $commit->{hash});
4803 my($meta)=$db_query->fetchrow_hashref;
4804 if($meta)
4805 {
4806 $meta->{revision} = "1.$meta->{revision}";
4807 return $meta;
4808 }
4809
4810 # fall back on special revision number
4811 my($revision)=$commit->{hash};
4812 $revision=~s/(..)/'.' . (hex($1)+100)/eg;
4813 $revision="2.1.1.2000$revision";
4814
4815 # meta data about $filename:
4816 open(my $filePipe, '-|', 'git', 'ls-tree', '-z',
4817 $commit->{hash}, '--', $filename)
4818 or die("Cannot call git-ls-tree : $!");
4819 local $/ = "\0";
4820 my $line;
4821 $line=<$filePipe>;
4822 if(defined(<$filePipe>))
4823 {
4824 die "Expected only a single file for git-ls-tree $filename\n";
4825 }
4826 close $filePipe;
4827
4828 chomp $line;
4829 unless ( $line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4830 {
4831 die("Couldn't process git-ls-tree line : $line\n");
4832 }
4833 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
4834
4835 # save result:
4836 my($retVal)={};
4837 $retVal->{name}=$filename;
4838 $retVal->{revision}=$revision;
4839 $retVal->{filehash}=$fileHash;
4840 $retVal->{commithash}=$revCommit;
4841 $retVal->{author}=$commit->{author};
4842 $retVal->{modified}=convertToCvsDate($commit->{date});
4843 $retVal->{mode}=convertToDbMode($mode);
4844
4845 return $retVal;
4846}
4847
4848=head2 lookupCommitRef
4849
4850Convert tag/branch/abbreviation/etc into a commit sha1 hash. Caches
4851the result so looking it up again is fast.
4852
4853=cut
4854
4855sub lookupCommitRef
4856{
4857 my $self = shift;
4858 my $ref = shift;
4859
4860 my $commitHash = $self->{commitRefCache}{$ref};
4861 if(defined($commitHash))
4862 {
4863 return $commitHash;
4864 }
4865
fce13af5
JH
4866 $commitHash = ::safe_pipe_capture("git","rev-parse","--verify","--quiet",
4867 $self->unescapeRefName($ref));
658b57ad 4868 $commitHash=~s/\s*$//;
05ea93d6 4869 if(!($commitHash=~/^[0-9a-f]{$state->{hexsz}}$/))
658b57ad
MO
4870 {
4871 $commitHash=undef;
4872 }
4873
4874 if( defined($commitHash) )
4875 {
fce13af5 4876 my $type = ::safe_pipe_capture("git","cat-file","-t",$commitHash);
658b57ad
MO
4877 if( ! ($type=~/^commit\s*$/ ) )
4878 {
4879 $commitHash=undef;
4880 }
4881 }
4882 if(defined($commitHash))
4883 {
4884 $self->{commitRefCache}{$ref}=$commitHash;
4885 }
4886 return $commitHash;
4887}
4888
4889=head2 clearCommitRefCaches
4890
4891Clears cached commit cache (sha1's for various tags/abbeviations/etc),
4892and related caches.
4893
4894=cut
4895
4896sub clearCommitRefCaches
4897{
4898 my $self = shift;
4899 $self->{commitRefCache} = {};
4900 $self->{revisionDirMapCache} = undef;
4901 $self->{gethead_cache} = undef;
4902}
4903
3fda8c4c
ML
4904=head2 commitmessage
4905
4906this function takes a commithash and returns the commit message for that commit
4907
4908=cut
4909sub commitmessage
4910{
4911 my $self = shift;
4912 my $commithash = shift;
6aeeffd1 4913 my $tablename = $self->tablename("commitmsgs");
3fda8c4c 4914
05ea93d6 4915 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ );
3fda8c4c
ML
4916
4917 my $db_query;
6aeeffd1 4918 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
3fda8c4c
ML
4919 $db_query->execute($commithash);
4920
4921 my ( $message ) = $db_query->fetchrow_array;
4922
4923 if ( defined ( $message ) )
4924 {
4925 $message .= " " if ( $message =~ /\n$/ );
4926 return $message;
4927 }
4928
fce13af5 4929 my @lines = ::safe_pipe_capture("git", "cat-file", "commit", $commithash);
3fda8c4c
ML
4930 shift @lines while ( $lines[0] =~ /\S/ );
4931 $message = join("",@lines);
4932 $message .= " " if ( $message =~ /\n$/ );
4933 return $message;
4934}
4935
3fda8c4c
ML
4936=head2 gethistorydense
4937
4938This function takes a filename (with path) argument and returns an arrayofarrays
4939containing revision,filehash,commithash ordered by revision descending.
4940
4941This version of gethistory skips deleted entries -- so it is useful for annotate.
4942The 'dense' part is a reference to a '--dense' option available for git-rev-list
4943and other git tools that depend on it.
4944
a86c0983
MO
4945See also getlog().
4946
3fda8c4c
ML
4947=cut
4948sub gethistorydense
4949{
4950 my $self = shift;
4951 my $filename = shift;
6aeeffd1 4952 my $tablename = $self->tablename("revision");
3fda8c4c
ML
4953
4954 my $db_query;
6aeeffd1 4955 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
3fda8c4c
ML
4956 $db_query->execute($filename);
4957
ab07681f
MO
4958 my $result = $db_query->fetchall_arrayref;
4959
4960 my $i;
4961 for($i=0 ; $i<scalar(@$result) ; $i++)
4962 {
4963 $result->[$i][0]="1." . $result->[$i][0];
4964 }
4965
4966 return $result;
3fda8c4c
ML
4967}
4968
51a7e6db
MO
4969=head2 escapeRefName
4970
4971Apply an escape mechanism to compensate for characters that
4972git ref names can have that CVS tags can not.
4973
4974=cut
4975sub escapeRefName
4976{
4977 my($self,$refName)=@_;
4978
4979 # CVS officially only allows [-_A-Za-z0-9] in tag names (or in
4980 # many contexts it can also be a CVS revision number).
4981 #
4982 # Git tags commonly use '/' and '.' as well, but also handle
4983 # anything else just in case:
4984 #
4985 # = "_-s-" For '/'.
4986 # = "_-p-" For '.'.
4987 # = "_-u-" For underscore, in case someone wants a literal "_-" in
4988 # a tag name.
4989 # = "_-xx-" Where "xx" is the hexadecimal representation of the
4990 # desired ASCII character byte. (for anything else)
4991
4992 if(! $refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)
4993 {
4994 $refName=~s/_-/_-u--/g;
4995 $refName=~s/\./_-p-/g;
4996 $refName=~s%/%_-s-%g;
4997 $refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;
4998 }
4999}
5000
5001=head2 unescapeRefName
5002
5003Undo an escape mechanism to compensate for characters that
5004git ref names can have that CVS tags can not.
5005
5006=cut
5007sub unescapeRefName
5008{
5009 my($self,$refName)=@_;
5010
5011 # see escapeRefName() for description of escape mechanism.
5012
5013 $refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;
5014
5015 # allowed tag names
5016 # TODO: Perhaps use git check-ref-format, with an in-process cache of
5017 # validated names?
5018 if( !( $refName=~m%^[^-][-a-zA-Z0-9_/.]*$% ) ||
5019 ( $refName=~m%[/.]$% ) ||
5020 ( $refName=~/\.lock$/ ) ||
5021 ( $refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) ) # matching }
5022 {
5023 # Error:
5024 $log->warn("illegal refName: $refName");
5025 $refName=undef;
5026 }
5027 return $refName;
5028}
5029
5030sub unescapeRefNameChar
5031{
5032 my($char)=@_;
5033
5034 if($char eq "s")
5035 {
5036 $char="/";
5037 }
5038 elsif($char eq "p")
5039 {
5040 $char=".";
5041 }
5042 elsif($char eq "u")
5043 {
5044 $char="_";
5045 }
5046 elsif($char=~/^[0-9a-f][0-9a-f]$/)
5047 {
5048 $char=chr(hex($char));
5049 }
5050 else
5051 {
5052 # Error case: Maybe it has come straight from user, and
5053 # wasn't supposed to be escaped? Restore it the way we got it:
5054 $char="_-$char-";
5055 }
5056
5057 return $char;
5058}
5059
3fda8c4c
ML
5060=head2 in_array()
5061
5062from Array::PAT - mimics the in_array() function
5063found in PHP. Yuck but works for small arrays.
5064
5065=cut
5066sub in_array
5067{
5068 my ($check, @array) = @_;
5069 my $retval = 0;
5070 foreach my $test (@array){
5071 if($check eq $test){
5072 $retval = 1;
5073 }
5074 }
5075 return $retval;
5076}
5077
eb1780d4
FL
5078=head2 mangle_dirname
5079
5080create a string from a directory name that is suitable to use as
5081part of a filename, mainly by converting all chars except \w.- to _
5082
5083=cut
5084sub mangle_dirname {
5085 my $dirname = shift;
5086 return unless defined $dirname;
5087
5088 $dirname =~ s/[^\w.-]/_/g;
5089
5090 return $dirname;
5091}
3fda8c4c 5092
6aeeffd1
JE
5093=head2 mangle_tablename
5094
5095create a string from a that is suitable to use as part of an SQL table
5096name, mainly by converting all chars except \w to _
5097
5098=cut
5099sub mangle_tablename {
5100 my $tablename = shift;
5101 return unless defined $tablename;
5102
5103 $tablename =~ s/[^\w_]/_/g;
5104
5105 return $tablename;
5106}
5107
3fda8c4c 51081;