blob: f6f3fc192c8713555fa0752c29b0c45146d6ed6c [file] [log] [blame]
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001#!/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>
Junio C Hamanoadc31922010-10-05 12:44:08 -070011#### Martin Langhoff <martin@laptop.org>
Martin Langhoff3fda8c42006-02-22 22:50:15 +130012####
13####
14#### Released under the GNU Public License, version 2.
15####
16####
17
Ævar Arnfjörð Bjarmasond48b2842010-09-24 20:00:52 +000018use 5.008;
Martin Langhoff3fda8c42006-02-22 22:50:15 +130019use strict;
20use warnings;
Martin Langhoff4f88d3e2006-12-07 16:38:50 +130021use bytes;
Martin Langhoff3fda8c42006-02-22 22:50:15 +130022
23use Fcntl;
24use File::Temp qw/tempdir tempfile/;
Matthew Ogilvie044182e2008-05-14 22:35:46 -060025use File::Path qw/rmtree/;
Martin Langhoff3fda8c42006-02-22 22:50:15 +130026use File::Basename;
Frank Lichtenheld693b6322007-06-07 16:57:01 +020027use Getopt::Long qw(:config require_order no_ignore_case);
28
29my $VERSION = '@@GIT_VERSION@@';
Martin Langhoff3fda8c42006-02-22 22:50:15 +130030
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
Matthew Ogilvie566c69e2012-10-13 23:42:19 -060054# 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?
Martin Langhoff3fda8c42006-02-22 22:50:15 +130058my $methods = {
59 'Root' => \&req_Root,
60 'Valid-responses' => \&req_Validresponses,
61 'valid-requests' => \&req_validrequests,
62 'Directory' => \&req_Directory,
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -060063 'Sticky' => \&req_Sticky,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130064 'Entry' => \&req_Entry,
65 'Modified' => \&req_Modified,
66 'Unchanged' => \&req_Unchanged,
Martin Langhoff7172aab2006-03-01 19:30:35 +130067 'Questionable' => \&req_Questionable,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130068 '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,
Martin Langhoff7172aab2006-03-01 19:30:35 +130078 'rlog' => \&req_log,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130079 'tag' => \&req_CATCHALL,
80 'status' => \&req_status,
81 'admin' => \&req_CATCHALL,
82 'history' => \&req_CATCHALL,
Damien Diederen38bcd312008-03-27 23:17:26 +010083 'watchers' => \&req_EMPTY,
84 'editors' => \&req_EMPTY,
Stefan Karpinski499cc562009-01-29 17:12:27 -080085 'noop' => \&req_EMPTY,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130086 'annotate' => \&req_annotate,
87 'Global_option' => \&req_Globaloption,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130088};
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.
Johannes Schindelin42217f12006-07-25 12:48:52 +020095my $state = { prependdir => '' };
Matthew Ogilvie044182e2008-05-14 22:35:46 -060096
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
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300107$log->info("--------------- STARTING -----------------");
108
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200109my $usage =
David Aguilard2bb6242013-02-23 16:50:16 -0800110 "usage: git cvsserver [options] [pserver|server] [<directory> ...]\n".
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200111 " --base-path <path> : Prepend to requested CVSROOT\n".
Phil Miller03bd0d62009-12-30 13:35:31 -0600112 " Can be read from GIT_CVSSERVER_BASE_PATH\n".
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200113 " --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".
Clemens Buchacher87182b12011-10-03 20:21:36 +0200116 " -h, -H : Print usage information and exit\n".
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200117 "\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".
Phil Miller03bd0d62009-12-30 13:35:31 -0600120 "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";
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200122
Clemens Buchacher87182b12011-10-03 20:21:36 +0200123my @opts = ( 'h|H', 'version|V',
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200124 '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
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300137my $TEMP_DIR = tempdir( CLEANUP => 1 );
138$log->debug("Temporary directory is '$TEMP_DIR'");
139
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200140$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
Frank Lichtenheld226bccb2007-06-15 03:01:53 +0200153# 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
Phil Miller03bd0d62009-12-30 13:35:31 -0600158# 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
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300176# if we are called with a pserver argument,
Junio C Hamano5348b6e2006-04-25 23:59:28 -0700177# deal with the authentication cat before entering the
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300178# main loop
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200179if ($state->{method} eq 'pserver') {
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300180 my $line = <STDIN>; chomp $line;
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200181 unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300182 die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
183 }
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200184 my $request = $1;
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300185 $line = <STDIN>; chomp $line;
Brian Gernhardt2a4b5d52007-10-17 10:05:47 -0400186 unless (req_Root('root', $line)) { # reuse Root
187 print "E Invalid root $line \n";
188 exit 1;
189 }
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300190 $line = <STDIN>; chomp $line;
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000191 my $user = $line;
192 $line = <STDIN>; chomp $line;
193 my $password = $line;
194
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000195 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 {
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000206 # Trying to authenticate a user
Sam Vilainc057bad2010-05-15 15:07:54 +0000207 if (not exists $cfg->{gitcvs}->{authdb}) {
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000208 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";
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000217 print "I HATE YOU\n";
218 exit 1;
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000219 }
Ævar Arnfjörð Bjarmason30525252010-05-15 02:46:01 +0000220
221 my $auth_ok;
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000222 open my $passwd, "<", $authdb or die $!;
Ævar Arnfjörð Bjarmason30525252010-05-15 02:46:01 +0000223 while (<$passwd>) {
224 if (m{^\Q$user\E:(.*)}) {
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000225 if (crypt($user, descramble($password)) eq $1) {
Ævar Arnfjörð Bjarmason30525252010-05-15 02:46:01 +0000226 $auth_ok = 1;
227 }
228 };
229 }
230 close $passwd;
231
232 unless ($auth_ok) {
Sam Vilainc057bad2010-05-15 15:07:54 +0000233 print "I HATE YOU\n";
234 exit 1;
235 }
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000236
237 # Fall through to LOVE
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300238 }
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000239
240 # For checking whether the user is anonymous on commit
241 $state->{user} = $user;
242
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300243 $line = <STDIN>; chomp $line;
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200244 unless ($line eq "END $request REQUEST") {
245 die "E Do not understand $line -- expecting END $request REQUEST\n";
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300246 }
247 print "I LOVE YOU\n";
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200248 exit if $request eq 'VERIFICATION'; # cvs login
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300249 # and now back to our regular programme...
250}
251
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300252# Keep going until the client closes the connection
253while (<STDIN>)
254{
255 chomp;
256
Junio C Hamano5348b6e2006-04-25 23:59:28 -0700257 # Check to see if we've seen this method, and call appropriate function.
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300258 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
Matthew Ogilvie044182e2008-05-14 22:35:46 -0600276chdir '/';
277exit 0;
278
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300279# 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
Damien Diederen38bcd312008-03-27 23:17:26 +0100289# This method invariably succeeds with an empty response.
290sub req_EMPTY
291{
292 print "ok\n";
293}
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300294
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
Frank Lichtenheld48908882007-06-07 16:57:00 +0200309 unless ($data =~ m#^/#) {
310 print "error 1 Root must be an absolute pathname\n";
311 return 0;
312 }
313
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200314 my $cvsroot = $state->{'base-path'} || '';
315 $cvsroot =~ s#/+$##;
316 $cvsroot .= $data;
317
Frank Lichtenheld48908882007-06-07 16:57:00 +0200318 if ($state->{CVSROOT}
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200319 && ($state->{CVSROOT} ne $cvsroot)) {
Frank Lichtenheld48908882007-06-07 16:57:00 +0200320 print "error 1 Conflicting roots specified\n";
321 return 0;
322 }
323
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200324 $state->{CVSROOT} = $cvsroot;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300325
326 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200327
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
Martin Langhoffcdb67602006-03-04 17:47:22 +1300352 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";
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200354 print "E \n";
355 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
Martin Langhoffcdb67602006-03-04 17:47:22 +1300356 return 0;
357 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300358
Junio C Hamano46203ac2017-09-11 14:45:54 +0900359 my @gitvars = safe_pipe_capture(qw(git config -l));
Martin Langhoffcdb67602006-03-04 17:47:22 +1300360 if ($?) {
Tom Princee0d10e12007-01-28 16:16:53 -0800361 print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
Martin Langhoffcdb67602006-03-04 17:47:22 +1300362 print "E \n";
Tom Princee0d10e12007-01-28 16:16:53 -0800363 print "error 1 - problem executing git-config\n";
Martin Langhoffcdb67602006-03-04 17:47:22 +1300364 return 0;
365 }
366 foreach my $line ( @gitvars )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300367 {
brian m. carlson05ea93d2020-06-22 18:04:16 +0000368 next unless ( $line =~ /^(gitcvs|extensions)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
Frank Lichtenheldf987afa2007-05-13 02:16:24 +0200369 unless ($2) {
370 $cfg->{$1}{$3} = $4;
Frank Lichtenheld92a39a12007-03-19 16:55:58 +0100371 } else {
372 $cfg->{$1}{$2}{$3} = $4;
373 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300374 }
375
Junio C Hamano523d12e2007-05-20 17:57:27 -0700376 my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
377 || $cfg->{gitcvs}{enabled});
Frank Lichtenheld226bccb2007-06-15 03:01:53 +0200378 unless ($state->{'export-all'} ||
379 ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300380 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";
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300384 return 0;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300385 }
386
Frank Lichtenheldd55820c2007-03-19 16:55:59 +0100387 my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
388 if ( $logfile )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300389 {
Frank Lichtenheldd55820c2007-03-19 16:55:59 +0100390 $log->setfile($logfile);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300391 } else {
392 $log->nofile();
393 }
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300394
brian m. carlson05ea93d2020-06-22 18:04:16 +0000395 $state->{rawsz} = ($cfg->{'extensions'}{'objectformat'} || 'sha1') eq 'sha256' ? 32 : 20;
396 $state->{hexsz} = $state->{rawsz} * 2;
397
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300398 return 1;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300399}
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");
Martyn Smith7d900952006-03-27 15:51:42 +1200412 $state->{globaloptions}{$data} = 1;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300413}
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 ) = @_;
Junio C Hamano5348b6e2006-04-25 23:59:28 -0700421 $log->debug("req_Validresponses : $data");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300422
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
Anders Kaseorg94629532013-10-30 04:44:43 -0400436 $log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300437 $log->debug("SEND : ok");
438
Anders Kaseorg94629532013-10-30 04:44:43 -0400439 print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300440 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;
Martyn Smith7d900952006-03-27 15:51:42 +1200464 $state->{path} = $repository;
Gerrit Papef9acaea2010-01-26 14:47:16 +0000465 $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
Martyn Smith7d900952006-03-27 15:51:42 +1200466 $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 "." );
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300471 $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
472
Johannes Schindelind988b822006-10-11 00:33:28 +0200473 if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
Martyn Smith7d900952006-03-27 15:51:42 +1200474 {
475 $log->info("Setting prepend to '$state->{path}'");
476 $state->{prependdir} = $state->{path};
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600477 my %entries;
Martyn Smith7d900952006-03-27 15:51:42 +1200478 foreach my $entry ( keys %{$state->{entries}} )
479 {
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600480 $entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
Martyn Smith7d900952006-03-27 15:51:42 +1200481 }
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600482 $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;
Martyn Smith7d900952006-03-27 15:51:42 +1200490 }
491
492 if ( defined ( $state->{prependdir} ) )
493 {
494 $log->debug("Prepending '$state->{prependdir}' to state|directory");
495 $state->{directory} = $state->{prependdir} . $state->{directory}
496 }
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600497
498 if ( ! defined($state->{dirMap}{$state->{directory}}) )
499 {
500 $state->{dirMap}{$state->{directory}} =
501 {
502 'names' => {}
503 #'tagspec' => undef
504 };
505 }
506
Martyn Smith82000d72006-03-28 13:24:27 +1200507 $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300508}
509
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600510# 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300551# 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
Martyn Smith7d900952006-03-27 15:51:42 +1200566 #$log->debug("req_Entry : $data");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300567
Matthew Ogilvieabd66f22012-10-13 23:42:23 -0600568 my @data = split(/\//, $data, -1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300569
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 };
Martyn Smith7d900952006-03-27 15:51:42 +1200576
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600577 $state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';
578
Martyn Smith7d900952006-03-27 15:51:42 +1200579 $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;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300594}
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
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200608 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
609 $updater->update();
610
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300611 my $addcount = 0;
612
613 foreach my $filename ( @{$state->{args}} )
614 {
615 $filename = filecleanup($filename);
616
Matthew Ogilvie61717662012-10-13 23:42:31 -0600617 # no -r, -A, or -D with add
618 my $stickyInfo = resolveStickyInfo($filename);
619
620 my $meta = $updater->getmeta($filename,$stickyInfo);
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200621 my $wrev = revparse($filename);
622
Matthew Ogilvieab076812012-10-13 23:42:21 -0600623 if ($wrev && $meta && ($wrev=~/^-/))
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200624 {
625 # previously removed file, add back
Matthew Ogilvieab076812012-10-13 23:42:21 -0600626 $log->info("added file $filename was previously removed, send $meta->{revision}");
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200627
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
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600642 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600643 my $entryLine = "/$filepart/$meta->{revision}//$kopts/";
644 $entryLine .= getStickyTagOrDate($stickyInfo);
645 $log->debug($entryLine);
646 print "$entryLine\n";
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200647 # 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300657 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
Martyn Smith7d900952006-03-27 15:51:42 +1200669 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300670
671 print "E cvs add: scheduling file `$filename' for addition\n";
672
673 print "Checked-in $dirpart\n";
674 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600675 my $kopts = kopts_from_path($filename,"file",
676 $state->{entries}{$filename}{modified_filename});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600677 print "/$filepart/0//$kopts/" .
678 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300679
Matthew Ogilvie8a06a632008-05-14 22:35:47 -0600680 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300696 $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
Matthew Ogilvie61717662012-10-13 23:42:31 -0600746 # only from entries
747 my $stickyInfo = resolveStickyInfo($filename);
748
749 my $meta = $updater->getmeta($filename,$stickyInfo);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300750 my $wrev = revparse($filename);
751
752 unless ( defined ( $wrev ) )
753 {
754 print "E cvs remove: nothing known about `$filename'\n";
755 next;
756 }
757
Matthew Ogilvieab076812012-10-13 23:42:21 -0600758 if ( defined($wrev) and ($wrev=~/^-/) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300759 {
760 print "E cvs remove: file `$filename' already scheduled for removal\n";
761 next;
762 }
763
Matthew Ogilvieab076812012-10-13 23:42:21 -0600764 unless ( $wrev eq $meta->{revision} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300765 {
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
Martyn Smith7d900952006-03-27 15:51:42 +1200772 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300773
774 print "E cvs remove: scheduling `$filename' for removal\n";
775
776 print "Checked-in $dirpart\n";
777 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600778 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600779 print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300780
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>;
Jim Meyeringa5e40792007-07-14 20:48:42 +0200808 defined $mode
809 or (print "E end of file reading mode for $data\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300810 chomp $mode;
811 my $size = <STDIN>;
Jim Meyeringa5e40792007-07-14 20:48:42 +0200812 defined $size
813 or (print "E end of file reading size of $data\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300814 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
Jim Meyeringa5e40792007-07-14 20:48:42 +0200833 close $fh
834 or (print "E failed to write temporary, $filename: $!\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300835
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;
joernchen27dd7382017-09-11 14:45:09 +0900847 $state->{entries}{$state->{directory}.$data}{modified_hash} = safe_pipe_capture('git','hash-object',$filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300848 $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
Johannes Schindelin2c3cff42006-07-26 21:59:08 +0200877 # Argumentx means: append to last Argument (with a newline in front)
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300878
879 $log->debug("$cmd : $data");
880
Johannes Schindelin2c3cff42006-07-26 21:59:08 +0200881 if ( $cmd eq 'Argumentx') {
882 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
883 } else {
884 push @{$state->{arguments}}, $data;
885 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300886}
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
Lars Noschinski89a91672008-07-17 19:00:29 +0200947 # Provide list of modules, if -c was used.
948 if (exists $state->{opt}{c}) {
Junio C Hamano46203ac2017-09-11 14:45:54 +0900949 my $showref = safe_pipe_capture(qw(git show-ref --heads));
Lars Noschinski89a91672008-07-17 19:00:29 +0200950 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
Matthew Ogilvie61717662012-10-13 23:42:31 -0600959 my $stickyInfo = { 'tag' => $state->{opt}{r},
960 'date' => $state->{opt}{D} };
961
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300962 my $module = $state->{args}[0];
Matthew Ogilvie8a06a632008-05-14 22:35:47 -0600963 $state->{module} = $module;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300964 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
Matthew Ogilvie61717662012-10-13 23:42:31 -0600979 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 }
990
Martin Langhoffc8c4f222006-03-02 13:58:57 +1300991 $checkout_path =~ s|/$||; # get rid of trailing slashes
992
Martin Langhoffc8c4f222006-03-02 13:58:57 +1300993 my %seendirs = ();
Martin Langhoff501c7372006-03-03 16:38:03 +1300994 my $lastdir ='';
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300995
Matthew Ogilvie61717662012-10-13 23:42:31 -0600996 prepDirForOutput(
997 ".",
998 $state->{CVSROOT} . "/$module",
999 $checkout_path,
1000 \%seendirs,
1001 'checkout',
1002 $state->{dirArgs} );
Martin Langhoff6be32d42006-03-04 17:47:29 +13001003
Matthew Ogilvie61717662012-10-13 23:42:31 -06001004 foreach my $git ( @{$updater->getAnyHead($headHash)} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001005 {
1006 # Don't want to check out deleted files
1007 next if ( $git->{filehash} eq "deleted" );
1008
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06001009 my $fullName = $git->{name};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001010 ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
1011
Matthew Ogilvie61717662012-10-13 23:42:31 -06001012 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 }
Martin Langhoff6be32d42006-03-04 17:47:29 +13001019
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001020 # modification time of this file
1021 print "Mod-time $git->{modified}\n";
1022
1023 # print some information to the client
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001024 if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
1025 {
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001026 print "M U $checkout_path/$git->{dir}$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001027 } else {
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001028 print "M U $checkout_path/$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001029 }
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001030
Martin Langhoff6be32d42006-03-04 17:47:29 +13001031 # 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";
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001033
Martin Langhoff6be32d42006-03-04 17:47:29 +13001034 print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001035
1036 # this is an "entries" line
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001037 my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001038 print "/$git->{name}/$git->{revision}//$kopts/" .
1039 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001040 # 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
Matthew Ogilvie61717662012-10-13 23:42:31 -06001052# 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
Li Peng832c0e52016-05-06 20:36:46 +08001162 # $seendirs after processing all files.
Matthew Ogilvie61717662012-10-13 23:42:31 -06001163}
1164
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001165# 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
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001180 #
Junio C Hamano5348b6e2006-04-25 23:59:28 -07001181 # It may just be a client exploring the available heads/modules
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001182 # 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 '') {
Junio C Hamano46203ac2017-09-11 14:45:54 +09001187 my $showref = safe_pipe_capture(qw(git show-ref --heads));
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001188 print "E cvs update: Updating .\n";
Lars Noschinskib20171e2008-07-17 19:00:27 +02001189 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;
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001196 }
1197
1198
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001199 # 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
Martyn Smith7d900952006-03-27 15:51:42 +12001204 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001205
1206 #$log->debug("update state : " . Dumper($state));
1207
Matthew Ogilvie61717662012-10-13 23:42:31 -06001208 my($repoDir);
1209 $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
1210
1211 my %seendirs = ();
Sergei Organov8e4c4e72009-12-07 14:11:44 +03001212
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001213 # foreach file specified on the command line ...
Matthew Ogilvie61717662012-10-13 23:42:31 -06001214 foreach my $argsFilename ( @{$state->{args}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001215 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001216 my $filename;
1217 $filename = filecleanup($argsFilename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001218
Martyn Smith7d900952006-03-27 15:51:42 +12001219 $log->debug("Processing file $filename");
1220
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001221 # 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
Matthew Ogilvie61717662012-10-13 23:42:31 -06001229 my $stickyInfo = resolveStickyInfo($filename,
1230 $state->{opt}{r},
1231 $state->{opt}{D},
1232 exists($state->{opt}{A}));
1233 my $meta = $updater->getmeta($filename, $stickyInfo);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001234
Damien Diederene78f69a2008-03-27 23:18:12 +01001235 # 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
Matthew Ogilvie61717662012-10-13 23:42:31 -06001246 # Directories:
1247 prepDirForOutput(
1248 dirname($argsFilename),
1249 $repoDir,
1250 ".",
1251 \%seendirs,
1252 "update",
1253 $state->{dirArgs} );
1254
1255 my $wrev = revparse($filename);
1256
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001257 if ( ! defined $meta )
1258 {
1259 $meta = {
1260 name => $filename,
Matthew Ogilvieab076812012-10-13 23:42:21 -06001261 revision => '0',
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001262 filehash => 'added'
1263 };
Matthew Ogilvie61717662012-10-13 23:42:31 -06001264 if($wrev ne "0")
1265 {
1266 $meta->{filehash}='deleted';
1267 }
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001268 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001269
1270 my $oldmeta = $meta;
1271
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001272 # If the working copy is an old revision, lets get that version too for comparison.
Matthew Ogilvie61717662012-10-13 23:42:31 -06001273 my $oldWrev=$wrev;
1274 if(defined($oldWrev))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001275 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001276 $oldWrev=~s/^-//;
1277 if($oldWrev ne $meta->{revision})
1278 {
1279 $oldmeta = $updater->getmeta($filename, $oldWrev);
1280 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001281 }
1282
1283 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
1284
Martin Langhoffec58db12006-03-02 18:42:01 +13001285 # 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})
Matthew Ogilvieab076812012-10-13 23:42:21 -06001289 and $wrev eq $meta->{revision}
Martin Langhoffec58db12006-03-02 18:42:01 +13001290 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})
Matthew Ogilvieab076812012-10-13 23:42:21 -06001297 and $wrev eq $meta->{revision}
Matthew Ogilvie61717662012-10-13 23:42:31 -06001298 and $wrev ne "0"
Frank Lichtenheldcb52d9a2007-04-11 22:38:19 +02001299 and defined($state->{entries}{$filename}{modified_hash})
Martin Langhoffec58db12006-03-02 18:42:01 +13001300 and not exists ( $state->{opt}{C} ) )
1301 {
1302 $log->info("Tell the client the file is modified");
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001303 print "MT text M \n";
Martin Langhoffec58db12006-03-02 18:42:01 +13001304 print "MT fname $filename\n";
1305 print "MT newline\n";
1306 next;
1307 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001308
Matthew Ogilvie61717662012-10-13 23:42:31 -06001309 if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001310 {
Matthew Ogilvied8574ff2012-10-13 23:42:17 -06001311 # TODO: If it has been modified in the sandbox, error out
1312 # with the appropriate message, rather than deleting a modified
1313 # file.
1314
Martyn Smith7d900952006-03-27 15:51:42 +12001315 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001316
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";
Martyn Smith7d900952006-03-27 15:51:42 +12001320 # 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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001325 }
Martin Langhoffec58db12006-03-02 18:42:01 +13001326 elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001327 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
1328 or $meta->{filehash} eq 'added' )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001329 {
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001330 # normal update, just send the new revision (either U=Update,
1331 # or A=Add, or R=Remove)
Matthew Ogilvieab076812012-10-13 23:42:21 -06001332 if ( defined($wrev) && ($wrev=~/^-/) )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001333 {
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 }
Matthew Ogilvieab076812012-10-13 23:42:21 -06001340 elsif ( (!defined($wrev) || $wrev eq '0') &&
1341 (!defined($meta->{revision}) || $meta->{revision} eq '0') )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001342 {
Andy Parkins535514f2007-01-22 10:56:27 +00001343 $log->info("Tell the client the file is scheduled for addition");
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001344 print "MT text A \n";
1345 print "MT fname $filename\n";
1346 print "MT newline\n";
1347 next;
1348
1349 }
1350 else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001351 $log->info("UpdatingX3 '$filename' to ".$meta->{revision});
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001352 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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001358
Martyn Smith7d900952006-03-27 15:51:42 +12001359 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001360
Martyn Smith7d900952006-03-27 15:51:42 +12001361 # 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001371
Martyn Smith7d900952006-03-27 15:51:42 +12001372 $log->debug("Creating new file 'Created $dirpart'");
1373 print "Created $dirpart\n";
1374 }
1375 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001376
Martyn Smith7d900952006-03-27 15:51:42 +12001377 # this is an "entries" line
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001378 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001379 my $entriesLine = "/$filepart/$meta->{revision}//$kopts/";
1380 $entriesLine .= getStickyTagOrDate($stickyInfo);
1381 $log->debug($entriesLine);
1382 print "$entriesLine\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001383
Martyn Smith7d900952006-03-27 15:51:42 +12001384 # 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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001391 } else {
Martyn Smith7d900952006-03-27 15:51:42 +12001392 my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001393
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001394 my $mergeDir = setupTmpDir();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001395
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001396 my $file_local = $filepart . ".mine";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001397 my $mergedFile = "$mergeDir/$file_local";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001398 system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
1399 my $file_old = $filepart . "." . $oldmeta->{revision};
Damien Diederene78f69a2008-03-27 23:18:12 +01001400 transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001401 my $file_new = $filepart . "." . $meta->{revision};
Damien Diederene78f69a2008-03-27 23:18:12 +01001402 transmitfile($meta->{filehash}, { targetfile => $file_new });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001403
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");
Matthew Ogilvieab076812012-10-13 23:42:21 -06001406 print "M Merging differences between $oldmeta->{revision} and $meta->{revision} into $filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001407
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001408 $log->debug("Temporary directory for merge is $mergeDir");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001409
Eric Wongc6b4fa92006-12-19 14:58:20 -08001410 my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001411 $return >>= 8;
1412
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001413 cleanupTmpDir();
1414
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001415 if ( $return == 0 )
1416 {
1417 $log->info("Merged successfully");
1418 print "M M $filename\n";
Frank Lichtenheld53877842007-03-06 10:42:24 +01001419 $log->debug("Merged $dirpart");
Martyn Smith7d900952006-03-27 15:51:42 +12001420
1421 # Don't want to actually _DO_ the update if -n specified
1422 unless ( $state->{globaloptions}{-n} )
1423 {
Frank Lichtenheld53877842007-03-06 10:42:24 +01001424 print "Merged $dirpart\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001425 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
1426 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001427 my $kopts = kopts_from_path("$dirpart/$filepart",
1428 "file",$mergedFile);
Matthew Ogilvieab076812012-10-13 23:42:21 -06001429 $log->debug("/$filepart/$meta->{revision}//$kopts/");
Matthew Ogilvie61717662012-10-13 23:42:31 -06001430 my $entriesLine="/$filepart/$meta->{revision}//$kopts/";
1431 $entriesLine .= getStickyTagOrDate($stickyInfo);
1432 print "$entriesLine\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001433 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001434 }
1435 elsif ( $return == 1 )
1436 {
1437 $log->info("Merged with conflicts");
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001438 print "E cvs update: conflicts found in $filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001439 print "M C $filename\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001440
1441 # Don't want to actually _DO_ the update if -n specified
1442 unless ( $state->{globaloptions}{-n} )
1443 {
Frank Lichtenheld53877842007-03-06 10:42:24 +01001444 print "Merged $dirpart\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001445 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001446 my $kopts = kopts_from_path("$dirpart/$filepart",
1447 "file",$mergedFile);
Matthew Ogilvie61717662012-10-13 23:42:31 -06001448 my $entriesLine = "/$filepart/$meta->{revision}/+/$kopts/";
1449 $entriesLine .= getStickyTagOrDate($stickyInfo);
1450 print "$entriesLine\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001451 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001452 }
1453 else
1454 {
1455 $log->warn("Merge failed");
1456 next;
1457 }
1458
Martyn Smith7d900952006-03-27 15:51:42 +12001459 # 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";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001465
Martyn Smith7d900952006-03-27 15:51:42 +12001466 # 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
joernchen27dd7382017-09-11 14:45:09 +09001469 my $data = safe_pipe_capture('cat', $mergedFile);
Martyn Smith7d900952006-03-27 15:51:42 +12001470 $log->debug("File size : " . length($data));
1471 print length($data) . "\n";
1472 print $data;
1473 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001474 }
1475
1476 }
1477
Matthew Ogilvie61717662012-10-13 23:42:31 -06001478 # 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001515 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
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00001528 if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
Martin Langhoff91a6bf42006-03-04 20:30:04 +13001529 {
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00001530 print "error 1 anonymous user cannot commit via pserver\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001531 cleanupWorkTree();
Martin Langhoff91a6bf42006-03-04 20:30:04 +13001532 exit;
1533 }
1534
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001535 if ( -e $state->{CVSROOT} . "/index" )
1536 {
Martyn Smith568907f2006-03-17 13:33:19 +13001537 $log->warn("file 'index' already exists in the git repository");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001538 print "error 1 Index already exists in git repo\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001539 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001540 exit;
1541 }
1542
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001543 # 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001547 my @committedfiles = ();
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001548 my %oldmeta;
Matthew Ogilvie61717662012-10-13 23:42:31 -06001549 my $stickyInfo;
1550 my $branchRef;
1551 my $parenthash;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001552
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001553 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001554 foreach my $filename ( @{$state->{args}} )
1555 {
Martyn Smith7d900952006-03-27 15:51:42 +12001556 my $committedfile = $filename;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001557 $filename = filecleanup($filename);
1558
1559 next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1560
Matthew Ogilvie61717662012-10-13 23:42:31 -06001561 #####
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
joernchen27dd7382017-09-11 14:45:09 +09001585 $parenthash = safe_pipe_capture('git', 'show-ref', '-s', $branchRef);
Matthew Ogilvie61717662012-10-13 23:42:31 -06001586 chomp $parenthash;
brian m. carlson05ea93d2020-06-22 18:04:16 +00001587 if ($parenthash !~ /^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilvie61717662012-10-13 23:42:31 -06001588 {
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);
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001622 $oldmeta{$filename} = $meta;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001623
1624 my $wrev = revparse($filename);
1625
1626 my ( $filepart, $dirpart ) = filenamesplit($filename);
1627
Michael Wittencdf63282007-11-23 04:12:54 -05001628 # do a checkout of the file if it is part of this tree
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001629 if ($wrev) {
Gerrit Paped2feb012009-09-02 09:23:10 +00001630 system('git', 'checkout-index', '-f', '-u', $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001631 unless ($? == 0) {
1632 die "Error running git-checkout-index -f -u $filename : $!";
1633 }
1634 }
1635
1636 my $addflag = 0;
1637 my $rmflag = 0;
Matthew Ogilvieab076812012-10-13 23:42:21 -06001638 $rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001639 $addflag = 1 unless ( -e $filename );
1640
1641 # Do up to date checking
Matthew Ogilvieab076812012-10-13 23:42:21 -06001642 unless ( $addflag or $wrev eq $meta->{revision} or
1643 ( $rmflag and $wrev eq "-$meta->{revision}" ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001644 {
1645 # fail everything if an up to date check fails
1646 print "error 1 Up to date check failed for $filename\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001647 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001648 exit;
1649 }
1650
Martyn Smith7d900952006-03-27 15:51:42 +12001651 push @committedfiles, $committedfile;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001652 $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);
Gerrit Paped2feb012009-09-02 09:23:10 +00001673 system("git", "update-index", "--remove", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001674 }
1675 elsif ( $addflag )
1676 {
1677 $log->info("Adding file '$filename'");
Gerrit Paped2feb012009-09-02 09:23:10 +00001678 system("git", "update-index", "--add", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001679 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001680 $log->info("UpdatingX2 file '$filename'");
Gerrit Paped2feb012009-09-02 09:23:10 +00001681 system("git", "update-index", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001682 }
1683 }
1684
1685 unless ( scalar(@committedfiles) > 0 )
1686 {
1687 print "E No files to commit\n";
1688 print "ok\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001689 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001690 return;
1691 }
1692
Junio C Hamano46203ac2017-09-11 14:45:54 +09001693 my $treehash = safe_pipe_capture(qw(git write-tree));
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001694 chomp $treehash;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001695
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} ) );
Fabian Emmes280514e2009-01-02 16:40:13 +01001701 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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001708 close $msg_fh;
1709
joernchen27dd7382017-09-11 14:45:09 +09001710 my $commithash = safe_pipe_capture('git', 'commit-tree', $treehash, '-p', $parenthash, '-F', $msg_filename);
Andy Parkins1872ada2007-02-27 12:49:09 +00001711 chomp($commithash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001712 $log->info("Commit hash : $commithash");
1713
brian m. carlson05ea93d2020-06-22 18:04:16 +00001714 unless ( $commithash =~ /[a-zA-Z0-9]{$state->{hexsz}}/ )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001715 {
1716 $log->warn("Commit failed (Invalid commit hash)");
1717 print "error 1 Commit failed (unknown reason)\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001718 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001719 exit;
1720 }
1721
Michael Wittencdf63282007-11-23 04:12:54 -05001722 ### Emulate git-receive-pack by running hooks/update
Matthew Ogilvie61717662012-10-13 23:42:31 -06001723 my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
Andy Parkinsb2741f62007-02-13 15:12:45 +00001724 $parenthash, $commithash );
Michael Wittencdf63282007-11-23 04:12:54 -05001725 if( -x $hook[0] ) {
1726 unless( system( @hook ) == 0 )
Andy Parkinsb2741f62007-02-13 15:12:45 +00001727 {
1728 $log->warn("Commit failed (update hook declined to update ref)");
1729 print "error 1 Commit failed (update hook declined)\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001730 cleanupWorkTree();
Andy Parkinsb2741f62007-02-13 15:12:45 +00001731 exit;
1732 }
1733 }
1734
Michael Wittencdf63282007-11-23 04:12:54 -05001735 ### Update the ref
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001736 if (system(qw(git update-ref -m), "cvsserver ci",
Matthew Ogilvie61717662012-10-13 23:42:31 -06001737 $branchRef, $commithash, $parenthash)) {
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001738 $log->warn("update-ref for $state->{module} failed.");
1739 print "error 1 Cannot commit -- update first\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001740 cleanupWorkTree();
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001741 exit;
1742 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001743
Michael Wittencdf63282007-11-23 04:12:54 -05001744 ### 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
Matthew Ogilvie61717662012-10-13 23:42:31 -06001751 print $pipe "$parenthash $commithash $branchRef\n";
Michael Wittencdf63282007-11-23 04:12:54 -05001752
1753 close $pipe || die "bad pipe: $! $?";
1754 }
1755
Stefan Karpinskiad8c3472009-01-29 13:58:02 -08001756 $updater->update();
1757
Junio C Hamano394d66d2007-12-05 01:15:01 -08001758 ### Then hooks/post-update
1759 $hook = $ENV{GIT_DIR}.'hooks/post-update';
1760 if (-x $hook) {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001761 system($hook, $branchRef);
Junio C Hamano394d66d2007-12-05 01:15:01 -08001762 }
1763
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001764 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001765 foreach my $filename ( @committedfiles )
1766 {
1767 $filename = filecleanup($filename);
1768
Matthew Ogilvie61717662012-10-13 23:42:31 -06001769 my $meta = $updater->getmeta($filename,$stickyInfo);
Martin Langhoff34865952007-01-09 15:10:41 +13001770 unless (defined $meta->{revision}) {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001771 $meta->{revision} = "1.1";
Martin Langhoff34865952007-01-09 15:10:41 +13001772 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001773
Martyn Smith7d900952006-03-27 15:51:42 +12001774 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001775
1776 $log->debug("Checked-in $dirpart : $filename");
1777
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001778 print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
Martin Langhoff34865952007-01-09 15:10:41 +13001779 if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001780 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001781 print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001782 print "Remove-entry $dirpart\n";
1783 print "$filename\n";
1784 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001785 if ($meta->{revision} eq "1.1") {
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001786 print "M initial revision: 1.1\n";
1787 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001788 print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001789 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001790 print "Checked-in $dirpart\n";
1791 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001792 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001793 print "/$filepart/$meta->{revision}//$kopts/" .
1794 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001795 }
1796 }
1797
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001798 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001799 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
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001812 my $updater;
1813 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001814 $updater->update();
1815
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001816 # if no files were specified, we need to work out what files we should
1817 # be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12001818 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001819
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001820 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001821 foreach my $filename ( @{$state->{args}} )
1822 {
1823 $filename = filecleanup($filename);
1824
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001825 if ( exists($state->{opt}{l}) &&
1826 index($filename, '/', length($state->{prependdir})) >= 0 )
1827 {
1828 next;
1829 }
Damien Diederen852b9212008-03-27 23:17:53 +01001830
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001831 my $wrev = revparse($filename);
1832
Matthew Ogilvie61717662012-10-13 23:42:31 -06001833 my $stickyInfo = resolveStickyInfo($filename);
1834 my $meta = $updater->getmeta($filename,$stickyInfo);
1835 my $oldmeta = $meta;
1836
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001837 # If the working copy is an old revision, lets get that
1838 # version too for comparison.
Matthew Ogilvieab076812012-10-13 23:42:21 -06001839 if ( defined($wrev) and $wrev ne $meta->{revision} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001840 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001841 my($rmRev)=$wrev;
1842 $rmRev=~s/^-//;
1843 $oldmeta = $updater->getmeta($filename, $rmRev);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001844 }
1845
1846 # TODO : All possible statuses aren't yet implemented
1847 my $status;
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001848 # 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
Matthew Ogilvieab076812012-10-13 23:42:21 -06001851 $wrev eq $meta->{revision} and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001852 ( ( $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
Matthew Ogilvieab076812012-10-13 23:42:21 -06001857 $meta->{filehash} ) ) )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001858 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001859 $status = "Up-to-date"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001860 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001861
Matthew Ogilvieab076812012-10-13 23:42:21 -06001862 # Need checkout if the working copy has a different (usually
1863 # older) revision than the repo copy, and the working copy is
1864 # unmodified
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001865 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001866 $meta->{revision} ne $wrev and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001867 ( $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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001874
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001875 # 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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001881
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001882 # 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
Matthew Ogilvieab076812012-10-13 23:42:21 -06001885 $wrev eq $meta->{revision} and
Matthew Ogilvie61717662012-10-13 23:42:31 -06001886 $wrev ne "0" and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001887 $state->{entries}{$filename}{modified_filename} )
1888 {
1889 $status ||= "Locally Modified";
1890 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001891
Matthew Ogilvieab076812012-10-13 23:42:21 -06001892 # Needs Merge if working copy revision is different
1893 # (usually older) than repo copy and there are local changes
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001894 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001895 $meta->{revision} ne $wrev and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001896 $state->{entries}{$filename}{modified_filename} )
1897 {
1898 $status ||= "Needs Merge";
1899 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001900
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001901 if ( defined ( $state->{entries}{$filename}{revision} ) and
Matthew Ogilvie61717662012-10-13 23:42:31 -06001902 ( !defined($meta->{revision}) ||
1903 $meta->{revision} eq "0" ) )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001904 {
1905 $status ||= "Locally Added";
1906 }
1907 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001908 $wrev eq "-$meta->{revision}" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001909 {
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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001921
1922 $status ||= "Unknown";
1923
Damien Diederen23b71802008-03-27 23:17:42 +01001924 my ($filepart) = filenamesplit($filename);
1925
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001926 print "M =======" . ( "=" x 60 ) . "\n";
Damien Diederen23b71802008-03-27 23:17:42 +01001927 print "M File: $filepart\tStatus: $status\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001928 if ( defined($state->{entries}{$filename}{revision}) )
1929 {
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001930 print "M Working revision:\t" .
1931 $state->{entries}{$filename}{revision} . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001932 } else {
1933 print "M Working revision:\tNo entry for $filename\n";
1934 }
1935 if ( defined($meta->{revision}) )
1936 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001937 print "M Repository revision:\t" .
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001938 $meta->{revision} .
1939 "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
Matthew Ogilvieabd66f22012-10-13 23:42:23 -06001940 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";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001959 } 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
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001986 $log->debug("Diffing revisions " .
1987 ( defined($revision1) ? $revision1 : "[NULL]" ) .
1988 " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001989
1990 # Grab a handle to the SQLite db and do any necessary updates
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001991 my $updater;
1992 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001993 $updater->update();
1994
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001995 # if no files were specified, we need to work out what files we should
1996 # be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12001997 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001998
Matthew Ogilvie61717662012-10-13 23:42:31 -06001999 my($foundDiff);
2000
Pavel Roskinaddf88e2006-07-09 03:44:30 -04002001 # foreach file specified on the command line ...
Matthew Ogilvie61717662012-10-13 23:42:31 -06002002 foreach my $argFilename ( @{$state->{args}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002003 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002004 my($filename) = filecleanup($argFilename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002005
2006 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
2007
2008 my $wrev = revparse($filename);
2009
Matthew Ogilvie61717662012-10-13 23:42:31 -06002010 # 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002016
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002017 if ( defined ( $revision1 ) )
2018 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002019 $meta1 = $updater->getmeta($filename, $revision1);
Matthew Ogilvie61717662012-10-13 23:42:31 -06002020 }
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}) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002031 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002032 if(!defined($revision1))
2033 {
2034 print "E File $filename at revision $revision1 doesn't exist\n";
2035 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002036 next;
2037 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002038 elsif( !defined($meta1) )
2039 {
2040 $meta1 = {
2041 name => $filename,
2042 revision => '0',
2043 filehash => 'deleted'
2044 };
2045 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002046 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002047
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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002054
2055 # if we have a second -r switch, use it too
2056 if ( defined ( $revision2 ) )
2057 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002058 $meta2 = $updater->getmeta($filename, $revision2);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002059 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002060 elsif(defined($state->{entries}{$filename}{modified_filename}))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002061 {
2062 $file2 = $state->{entries}{$filename}{modified_filename};
Matthew Ogilvie61717662012-10-13 23:42:31 -06002063 $meta2 = {
2064 name => $filename,
2065 revision => '0',
2066 filehash => 'modified'
2067 };
2068 }
2069 elsif( defined($wrev) && ($wrev!~/^-/) )
2070 {
2071 if(!defined($revision1)) # no revision and no modifications:
2072 {
2073 next;
2074 }
2075 $meta2 = $updater->getmeta($filename, $wrev);
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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002099 }
2100
Matthew Ogilvie61717662012-10-13 23:42:31 -06002101 if( $meta1->{filehash} eq $meta2->{filehash} )
2102 {
2103 $log->info("unchanged $filename");
2104 next;
2105 }
2106
2107 # Retrieve revision contents:
2108 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2109 transmitfile($meta1->{filehash}, { targetfile => $file1 });
2110
2111 if(!defined($file2))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002112 {
2113 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
Damien Diederene78f69a2008-03-27 23:18:12 +01002114 transmitfile($meta2->{filehash}, { targetfile => $file2 });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002115 }
2116
Matthew Ogilvie61717662012-10-13 23:42:31 -06002117 # Generate the actual diff:
2118 print "M Index: $argFilename\n";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002119 print "M =======" . ( "=" x 60 ) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002120 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
Matthew Ogilvie61717662012-10-13 23:42:31 -06002121 if ( defined ( $meta1 ) && $meta1->{revision} ne "0" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002122 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002123 print "M retrieving revision $meta1->{revision}\n"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002124 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002125 if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002126 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002127 print "M retrieving revision $meta2->{revision}\n"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002128 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002129 print "M diff ";
Anders Kaseorg94629532013-10-30 04:44:43 -04002130 foreach my $opt ( sort keys %{$state->{opt}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002131 {
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 ";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002140 if ( defined ( $state->{opt}{$opt} ) )
2141 {
2142 print "$state->{opt}{$opt} "
2143 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002144 }
2145 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002146 print "$argFilename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002147
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002148 $log->info("Diffing $filename -r $meta1->{revision} -r " .
2149 ( $meta2->{revision} or "workingcopy" ));
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002150
Matthew Ogilvie61717662012-10-13 23:42:31 -06002151 # 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.)
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002162
Matthew Ogilvie61717662012-10-13 23:42:31 -06002163 my (@diffCmd) = ( 'diff' );
2164 if ( exists($state->{opt}{N}) )
2165 {
2166 push @diffCmd,"-N";
2167 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002168 if ( exists $state->{opt}{u} )
2169 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002170 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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002177
Matthew Ogilvie61717662012-10-13 23:42:31 -06002178 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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002190 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002191 push @diffCmd,($file1,$file2);
2192 if(!open(DIFF,"-|",@diffCmd))
2193 {
2194 $log->warn("Unable to run diff: $!");
2195 }
2196 my($diffLine);
2197 while(defined($diffLine=<DIFF>))
2198 {
2199 print "M $diffLine";
2200 $foundDiff=1;
2201 }
2202 close(DIFF);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002203 }
2204
Matthew Ogilvie61717662012-10-13 23:42:31 -06002205 if($foundDiff)
2206 {
2207 print "error \n";
2208 }
2209 else
2210 {
2211 print "ok\n";
2212 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002213}
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
Matthew Ogilvieab076812012-10-13 23:42:21 -06002224 my ( $revFilter );
2225 if ( defined ( $state->{opt}{r} ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002226 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002227 $revFilter = $state->{opt}{r};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002228 }
2229
2230 # Grab a handle to the SQLite db and do any necessary updates
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002231 my $updater;
2232 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002233 $updater->update();
2234
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002235 # if no files were specified, we need to work out what files we
2236 # should be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12002237 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002238
Pavel Roskinaddf88e2006-07-09 03:44:30 -04002239 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002240 foreach my $filename ( @{$state->{args}} )
2241 {
2242 $filename = filecleanup($filename);
2243
2244 my $headmeta = $updater->getmeta($filename);
2245
Matthew Ogilvieab076812012-10-13 23:42:21 -06002246 my ($revisions,$totalrevisions) = $updater->getlog($filename,
2247 $revFilter);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002248
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";
Matthew Ogilvieab076812012-10-13 23:42:21 -06002254 print "M head: $headmeta->{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002255 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";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002260 print "M total revisions: $totalrevisions;\tselected revisions: " .
2261 scalar(@$revisions) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002262 print "M description:\n";
2263
2264 foreach my $revision ( @$revisions )
2265 {
2266 print "M ----------------------------\n";
Matthew Ogilvieab076812012-10-13 23:42:21 -06002267 print "M revision $revision->{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002268 # reformat the date for log output
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002269 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 }
Damien Diederenc1bc3062008-03-27 23:18:35 +01002275 $revision->{author} = cvs_author($revision->{author});
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002276 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});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002282 $commitmessage =~ s/^/M /mg;
2283 print $commitmessage . "\n";
2284 }
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002285 print "M =======" . ( "=" x 70 ) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002286 }
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 ...
Martyn Smith7d900952006-03-27 15:51:42 +12002305 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002306
2307 # we'll need a temporary checkout dir
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002308 setupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002309
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002310 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002311
Pavel Roskinaddf88e2006-07-09 03:44:30 -04002312 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002313 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)
Gerrit Paped2feb012009-09-02 09:23:10 +00002331 system("git", "read-tree", $lastseenin);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002332 unless ($? == 0)
2333 {
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002334 print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002335 return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002336 }
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002337 $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002338
2339 # do a checkout of the file
Gerrit Paped2feb012009-09-02 09:23:10 +00002340 system('git', 'checkout-index', '-f', '-u', $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002341 unless ($? == 0) {
Jim Meyeringa5e40792007-07-14 20:48:42 +02002342 print "E error running git-checkout-index -f -u $filename : $!\n";
2343 return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002344 }
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
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002353 my $a_hints = "$work->{workDir}/.annotate_hints";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002354 if (!open(ANNOTATEHINTS, '>', $a_hints)) {
2355 print "E failed to open '$a_hints' for writing: $!\n";
2356 return;
2357 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002358 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";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002368 close ANNOTATEHINTS
2369 or (print "E failed to write $a_hints: $!\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002370
Gerrit Paped2feb012009-09-02 09:23:10 +00002371 my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
Jim Meyeringa5e40792007-07-14 20:48:42 +02002372 if (!open(ANNOTATE, "-|", @cmd)) {
2373 print "E error invoking ". join(' ',@cmd) .": $!\n";
2374 return;
2375 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002376 my $metadata = {};
2377 print "E Annotations for $filename\n";
2378 print "E ***************\n";
2379 while ( <ANNOTATE> )
2380 {
brian m. carlson05ea93d2020-06-22 18:04:16 +00002381 if (m/^([a-zA-Z0-9]{$state->{hexsz}})\t\([^\)]*\)(.*)$/i)
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002382 {
2383 my $commithash = $1;
2384 my $data = $2;
2385 unless ( defined ( $metadata->{$commithash} ) )
2386 {
2387 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
Damien Diederenc1bc3062008-03-27 23:18:35 +01002388 $metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002389 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
2390 }
Matthew Ogilvieab076812012-10-13 23:42:21 -06002391 printf("M %-7s (%-8s %10s): %s\n",
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002392 $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
Lars Noschinskidf4b3ab2008-07-16 13:35:46 +02002407 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002408
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{
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002418 $state->{args} = [];
2419 $state->{files} = [];
2420 $state->{opt} = {};
2421
Frank Lichtenheld1e76b702007-06-17 10:31:02 +02002422 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
2423
2424 my $type = shift;
2425
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002426 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" );
Matthew Ogilvie61717662012-10-13 23:42:31 -06002432 $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2, N => 0 } if ( $type eq "diff" );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002433 $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
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002498# Used by argsfromdir
2499sub expandArg
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002500{
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002501 my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002502
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002503 my $fullPath = filecleanup($path);
Martyn Smith7d900952006-03-27 15:51:42 +12002504
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002505 # Is it a directory?
2506 if( defined($state->{dirMap}{$fullPath}) ||
2507 defined($state->{dirMap}{"$fullPath/"}) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002508 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002509 # It is a directory in the user's sandbox.
2510 $isDir=1;
Martyn Smith82000d72006-03-28 13:24:27 +12002511
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002512 if(defined($state->{entries}{$fullPath}))
Martyn Smith82000d72006-03-28 13:24:27 +12002513 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002514 $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});
Martyn Smith82000d72006-03-28 13:24:27 +12002562 }
2563
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002564 # Is it a directory?
2565 if( defined($revDirMap->{$fullPath}) ||
2566 defined($otherRevDirMap->{$fullPath}) )
Martyn Smith82000d72006-03-28 13:24:27 +12002567 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002568 $isDir=1;
2569 }
2570 }
2571
2572 # What to do with it?
2573 if(!$isDir)
2574 {
2575 $outNameMap->{$fullPath}=1;
2576 }
2577 else
2578 {
2579 $outDirMap->{$fullPath}=1;
2580
2581 if(defined($revDirMap->{$fullPath}))
2582 {
2583 addDirMapFiles($updater,$outNameMap,$outDirMap,
2584 $revDirMap->{$fullPath});
2585 }
2586 if( defined($otherRevDirMap) &&
2587 defined($otherRevDirMap->{$fullPath}) )
2588 {
2589 addDirMapFiles($updater,$outNameMap,$outDirMap,
2590 $otherRevDirMap->{$fullPath});
Martyn Smith82000d72006-03-28 13:24:27 +12002591 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002592 }
2593}
2594
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002595# 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)=@_;
2601
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 }
2614
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
2627 {
2628 $log->fatal("internal error in addDirMapFiles");
2629 die "internal error in addDirMapFiles";
2630 }
2631 }
2632}
2633
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
GyuYong Jung527d4a62016-02-17 11:14:58 +09002670 # # the sandbox?
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002671 # 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}
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -06002714
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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002818# This method cleans up the $state variable after a command that uses arguments has run
2819sub statecleanup
2820{
2821 $state->{files} = [];
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002822 $state->{dirArgs} = {};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002823 $state->{args} = [];
2824 $state->{arguments} = [];
2825 $state->{entries} = {};
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -06002826 $state->{dirMap} = {};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002827}
2828
Matthew Ogilvieab076812012-10-13 23:42:21 -06002829# Return working directory CVS revision "1.X" out
Li Peng832c0e52016-05-06 20:36:46 +08002830# of the working directory "entries" state, for the given filename.
Matthew Ogilvieab076812012-10-13 23:42:21 -06002831# This is prefixed with a dash if the file is scheduled for removal
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06002832# when it is committed.
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002833sub revparse
2834{
2835 my $filename = shift;
2836
Matthew Ogilvieab076812012-10-13 23:42:21 -06002837 return $state->{entries}{$filename}{revision};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002838}
2839
Damien Diederene78f69a2008-03-27 23:18:12 +01002840# 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.
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002847sub transmitfile
2848{
2849 my $filehash = shift;
Damien Diederene78f69a2008-03-27 23:18:12 +01002850 my $options = shift;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002851
2852 if ( defined ( $filehash ) and $filehash eq "deleted" )
2853 {
2854 $log->warn("filehash is 'deleted'");
2855 return;
2856 }
2857
brian m. carlson05ea93d2020-06-22 18:04:16 +00002858 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002859
joernchen27dd7382017-09-11 14:45:09 +09002860 my $type = safe_pipe_capture('git', 'cat-file', '-t', $filehash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002861 chomp $type;
2862
2863 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2864
joernchen27dd7382017-09-11 14:45:09 +09002865 my $size = safe_pipe_capture('git', 'cat-file', '-s', $filehash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002866 chomp $size;
2867
2868 $log->debug("transmitfile($filehash) size=$size, type=$type");
2869
Gerrit Paped2feb012009-09-02 09:23:10 +00002870 if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002871 {
Damien Diederene78f69a2008-03-27 23:18:12 +01002872 if ( defined ( $options->{targetfile} ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002873 {
Damien Diederene78f69a2008-03-27 23:18:12 +01002874 my $targetfile = $options->{targetfile};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002875 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2876 print NEWFILE $_ while ( <$fh> );
Jim Meyeringa5e40792007-07-14 20:48:42 +02002877 close NEWFILE or die("Failed to write '$targetfile': $!");
Damien Diederene78f69a2008-03-27 23:18:12 +01002878 } 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 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002886 } else {
2887 print "$size\n";
2888 print while ( <$fh> );
2889 }
Jim Meyeringa5e40792007-07-14 20:48:42 +02002890 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002891 } else {
2892 die("Couldn't execute git-cat-file");
2893 }
2894}
2895
2896# This method takes a file name, and returns ( $dirpart, $filepart ) which
Junio C Hamano5348b6e2006-04-25 23:59:28 -07002897# refers to the directory portion and the file portion of the filename
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002898# respectively
2899sub filenamesplit
2900{
2901 my $filename = shift;
Martyn Smith7d900952006-03-27 15:51:42 +12002902 my $fixforlocaldir = shift;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002903
2904 my ( $filepart, $dirpart ) = ( $filename, "." );
2905 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2906 $dirpart .= "/";
2907
Martyn Smith7d900952006-03-27 15:51:42 +12002908 if ( $fixforlocaldir )
2909 {
2910 $dirpart =~ s/^$state->{prependdir}//;
2911 }
2912
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002913 return ( $filepart, $dirpart );
2914}
2915
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002916# Cleanup various junk in filename (try to canonicalize it), and
Stefano Lattarini41ccfdd2013-04-12 00:36:10 +02002917# add prependdir to accommodate running CVS client from a
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002918# subdirectory (so the output is relative to top directory of the project).
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002919sub 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
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002930 if($filename eq ".")
2931 {
2932 $filename="";
2933 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002934 $filename =~ s/^\.\///g;
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002935 $filename =~ s%/+%/%g;
Martyn Smith82000d72006-03-28 13:24:27 +12002936 $filename = $state->{prependdir} . $filename;
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002937 $filename =~ s%/$%%;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002938 return $filename;
2939}
2940
Li Peng832c0e52016-05-06 20:36:46 +08002941# Remove prependdir from the path, so that it is relative to the directory
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002942# 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
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002960sub 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
joernchen27dd7382017-09-11 14:45:09 +09003046 my $ver = safe_pipe_capture('git', 'show-ref', '-s', "refs/heads/$state->{module}");
Matthew Ogilvie044182e2008-05-14 22:35:46 -06003047 chomp $ver;
brian m. carlson05ea93d2020-06-22 18:04:16 +00003048 if ($ver !~ /^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilvie044182e2008-05-14 22:35:46 -06003049 {
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
Andy Parkins8538e872007-02-27 13:46:55 +00003133# 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{
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003138 my ($path, $srcType, $name) = @_;
Andy Parkins8538e872007-02-27 13:46:55 +00003139
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003140 if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
3141 $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
3142 {
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003143 my ($val) = check_attr( "text", $path );
3144 if ( $val eq "unspecified" )
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003145 {
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003146 $val = check_attr( "crlf", $path );
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003147 }
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003148 if ( $val eq "unset" )
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003149 {
3150 return "-kb"
3151 }
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003152 elsif ( check_attr( "eol", $path ) ne "unspecified" ||
3153 $val eq "set" || $val eq "input" )
3154 {
3155 return "";
3156 }
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003157 else
3158 {
3159 $log->info("Unrecognized check_attr crlf $path : $val");
3160 }
3161 }
Andy Parkins8538e872007-02-27 13:46:55 +00003162
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003163 if ( defined ( $cfg->{gitcvs}{allbinary} ) )
Andy Parkins8538e872007-02-27 13:46:55 +00003164 {
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003165 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 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003171 if( is_binary($srcType,$name) )
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003172 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003173 $log->debug("... as binary");
3174 return "-kb";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003175 }
3176 else
3177 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003178 $log->debug("... as text");
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003179 }
3180 }
Andy Parkins8538e872007-02-27 13:46:55 +00003181 }
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003182 # Return "" to give no special treatment to any path
3183 return "";
Andy Parkins8538e872007-02-27 13:46:55 +00003184}
3185
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003186sub 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
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003203# 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 }
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003285 elsif( $srcType eq "sha1" )
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003286 {
brian m. carlson05ea93d2020-06-22 18:04:16 +00003287 unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ )
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003288 {
3289 $log->warn("Need filehash");
3290 die "Need filehash\n";
3291 }
3292
joernchen27dd7382017-09-11 14:45:09 +09003293 my $type = safe_pipe_capture('git', 'cat-file', '-t', $name);
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003294 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
joernchen27dd7382017-09-11 14:45:09 +09003302 my $size = safe_pipe_capture('git', 'cat-file', '-s', $name);
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003303 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
Fabian Emmesd500a1e2009-01-02 16:40:14 +01003321# 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.
Damien Diederenc1bc3062008-03-27 23:18:35 +01003326sub cvs_author
3327{
3328 my $author_line = shift;
Fabian Emmesd500a1e2009-01-02 16:40:14 +01003329 (my $author) = $author_line =~ /<([^@>]*)/;
3330
3331 $author =~ s/[^-a-zA-Z0-9_.]/_/g;
3332 $author =~ s/^-/_/;
Damien Diederenc1bc3062008-03-27 23:18:35 +01003333
3334 $author;
3335}
3336
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003337
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
Ævar Arnfjörð Bjarmasonfce338a2010-06-19 16:06:57 +00003361 # This should never happen, the same password format (A) has been
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003362 # used by CVS since the beginning of time
Ævar Arnfjörð Bjarmason1f0eb512010-06-19 16:06:58 +00003363 {
3364 my $fmt = substr($str, 0, 1);
3365 die "invalid password format `$fmt'" unless $fmt eq 'A';
3366 }
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003367
3368 my @str = unpack "C*", substr($str, 1);
3369 my $ret = join '', map { chr $SHIFTS[$_] } @str;
3370 return $ret;
3371}
3372
Matthew Ogilvie61717662012-10-13 23:42:31 -06003373# 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
Junio C Hamanofce13af2017-09-11 14:44:24 +09003412# 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
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003428
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003429package GITCVS::log;
3430
3431####
3432#### Copyright The Open University UK - 2006.
3433####
3434#### Authors: Martyn Smith <martyn@catalyst.net.nz>
Junio C Hamanoadc31922010-10-05 12:44:08 -07003435#### Martin Langhoff <martin@laptop.org>
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003436####
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
Junio C Hamano5348b6e2006-04-25 23:59:28 -07003458indicate the file to log to. If no log file is specified, you can specify one
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003459later 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>
Junio C Hamanoadc31922010-10-05 12:44:08 -07003602#### Martin Langhoff <martin@laptop.org>
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003603####
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
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003633 $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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003641 $self->{module} = $module;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003642 $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
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06003648 # Stores full sha1's for various branch/tag names, abbreviations, etc:
3649 $self->{commitRefCache} = {};
3650
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003651 $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
Frank Lichtenheld473937e2007-04-07 16:58:09 +02003652 $cfg->{gitcvs}{dbdriver} || "SQLite";
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003653 $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} || "";
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003659 $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
3660 $cfg->{gitcvs}{dbtablenameprefix} || "";
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003661 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;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003669 $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
3670 $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003671
Frank Lichtenheld473937e2007-04-07 16:58:09 +02003672 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}",
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003675 $self->{dbuser},
3676 $self->{dbpass});
Frank Lichtenheld920a4492007-03-19 16:56:01 +01003677 die "Error connecting to database\n" unless defined $self->{dbh};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003678
3679 $self->{tables} = {};
Frank Lichtenheld0cf611a2007-03-31 15:57:47 +02003680 foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003681 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003682 $self->{tables}{$table} = 1;
3683 }
3684
3685 # Construct the revision table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003686 # 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.
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003696 unless ( $self->{tables}{$self->tablename("revision")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003697 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003698 my $tablename = $self->tablename("revision");
3699 my $ix1name = $self->tablename("revision_ix1");
3700 my $ix2name = $self->tablename("revision_ix2");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003701 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003702 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003703 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 ");
Shawn Pearce178e0152006-10-23 01:09:35 -04003712 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003713 CREATE INDEX $ix1name
3714 ON $tablename (name,revision)
Shawn Pearce178e0152006-10-23 01:09:35 -04003715 ");
3716 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003717 CREATE INDEX $ix2name
3718 ON $tablename (name,commithash)
Shawn Pearce178e0152006-10-23 01:09:35 -04003719 ");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003720 }
3721
Shawn Pearce178e0152006-10-23 01:09:35 -04003722 # Construct the head table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003723 # 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.
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003732 unless ( $self->{tables}{$self->tablename("head")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003733 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003734 my $tablename = $self->tablename("head");
3735 my $ix1name = $self->tablename("head_ix1");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003736 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003737 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003738 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 ");
Shawn Pearce178e0152006-10-23 01:09:35 -04003747 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003748 CREATE INDEX $ix1name
3749 ON $tablename (name)
Shawn Pearce178e0152006-10-23 01:09:35 -04003750 ");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003751 }
3752
3753 # Construct the properties table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003754 # - "last_commit" - Used by "sub update".
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003755 unless ( $self->{tables}{$self->tablename("properties")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003756 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003757 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003758 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003759 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003760 key TEXT NOT NULL PRIMARY KEY,
3761 value TEXT
3762 )
3763 ");
3764 }
3765
3766 # Construct the commitmsgs table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003767 # 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".
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003772 unless ( $self->{tables}{$self->tablename("commitmsgs")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003773 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003774 my $tablename = $self->tablename("commitmsgs");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003775 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003776 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003777 key TEXT NOT NULL PRIMARY KEY,
3778 value TEXT
3779 )
3780 ");
3781 }
3782
3783 return $self;
3784}
3785
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003786=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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003801=head2 update
3802
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003803Bring 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003811=cut
3812sub update
3813{
3814 my $self = shift;
3815
3816 # first lets get the commit list
3817 $ENV{GIT_DIR} = $self->{git_path};
3818
joernchen27dd7382017-09-11 14:45:09 +09003819 my $commitsha1 = ::safe_pipe_capture('git', 'rev-parse', $self->{module});
Martin Langhoff49fb9402007-01-09 15:10:32 +13003820 chomp $commitsha1;
3821
joernchen27dd7382017-09-11 14:45:09 +09003822 my $commitinfo = ::safe_pipe_capture('git', 'cat-file', 'commit', $self->{module});
brian m. carlson05ea93d2020-06-22 18:04:16 +00003823 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{$state->{hexsz}}/ )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003824 {
3825 die("Invalid module '$self->{module}'");
3826 }
3827
3828
3829 my $git_log;
3830 my $lastcommit = $self->_get_prop("last_commit");
3831
Martin Langhoff49fb9402007-01-09 15:10:32 +13003832 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
Matthew Ogilvie61717662012-10-13 23:42:31 -06003833 # invalidate the gethead cache
3834 $self->clearCommitRefCaches();
Martin Langhoff49fb9402007-01-09 15:10:32 +13003835 return 1;
3836 }
3837
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003838 # 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
Martin Langhoffa248c962006-05-04 10:51:46 +12003844 my @git_log_params = ('--pretty', '--parents', '--topo-order');
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003845
3846 if (defined $lastcommit) {
3847 push @git_log_params, "$lastcommit..$self->{module}";
3848 } else {
3849 push @git_log_params, $self->{module};
3850 }
Martin Langhoffa248c962006-05-04 10:51:46 +12003851 # git-rev-list is the backend / plumbing version of git-log
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003852 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;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003856
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)
Matthew Ogilvieab076812012-10-13 23:42:21 -06003873 foreach my $file ( @{$self->gethead(1)} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003874 {
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
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003891 # not $lastpicked (not given a CVS revision number),
3892 # see if we can get a log
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003893 # 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) {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003897 if ($parent eq $lastpicked) {
3898 next;
3899 }
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003900 # 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.
Steffen Prohaskae509db92008-01-26 10:54:06 +01003903 my $base = eval {
Junio C Hamanofce13af2017-09-11 14:44:24 +09003904 ::safe_pipe_capture('git', 'merge-base',
Jim Meyeringa5e40792007-07-14 20:48:42 +02003905 $lastpicked, $parent);
Steffen Prohaskae509db92008-01-26 10:54:06 +01003906 };
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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003912 chomp $base;
3913 if ($base) {
3914 my @merged;
3915 # print "want to log between $base $parent \n";
Gerrit Paped2feb012009-09-02 09:23:10 +00003916 open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
Jim Meyeringa5e40792007-07-14 20:48:42 +02003917 or die "Cannot call git-log: $!";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003918 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
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003954 my $cvsDate = convertToCvsDate($commit->{date});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003955
3956 if ( defined ( $lastpicked ) )
3957 {
Gerrit Paped2feb012009-09-02 09:23:10 +00003958 my $filepipe = open(FILELIST, '-|', 'git', 'diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003959 local ($/) = "\0";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003960 while ( <FILELIST> )
3961 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003962 chomp;
brian m. carlson05ea93d2020-06-22 18:04:16 +00003963 unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{$state->{hexsz}}\s+([a-f0-9]{$state->{hexsz}})\s+(\w)$/o )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003964 {
3965 die("Couldn't process git-diff-tree line : $_");
3966 }
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003967 my ($mode, $hash, $change) = ($1, $2, $3);
3968 my $name = <FILELIST>;
3969 chomp($name);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003970
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003971 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003972
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003973 my $dbMode = convertToDbMode($mode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003974
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003975 if ( $change eq "D" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003976 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003977 #$log->debug("DELETE $name");
3978 $head->{$name} = {
3979 name => $name,
3980 revision => $head->{$name}{revision} + 1,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003981 filehash => "deleted",
3982 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003983 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003984 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003985 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003986 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003987 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003988 }
Paolo Bonzini9027efe2008-03-16 20:00:21 +01003989 elsif ( $change eq "M" || $change eq "T" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003990 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003991 #$log->debug("MODIFIED $name");
3992 $head->{$name} = {
3993 name => $name,
3994 revision => $head->{$name}{revision} + 1,
3995 filehash => $hash,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003996 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003997 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003998 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003999 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004000 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004001 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004002 }
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004003 elsif ( $change eq "A" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004004 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004005 #$log->debug("ADDED $name");
4006 $head->{$name} = {
4007 name => $name,
Frank Lichtenhelda7da9ad2007-05-02 02:43:14 +02004008 revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004009 filehash => $hash,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004010 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004011 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004012 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004013 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004014 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004015 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004016 }
4017 else
4018 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004019 $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004020 die;
4021 }
4022 }
4023 close FILELIST;
4024 } else {
4025 # this is used to detect files removed from the repo
4026 my $seen_files = {};
4027
Gerrit Paped2feb012009-09-02 09:23:10 +00004028 my $filepipe = open(FILELIST, '-|', 'git', 'ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004029 local $/ = "\0";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004030 while ( <FILELIST> )
4031 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004032 chomp;
4033 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004034 {
4035 die("Couldn't process git-ls-tree line : $_");
4036 }
4037
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004038 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004039
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
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004048 my $dbMode = convertToDbMode($mode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004049
4050 # unless the file exists with the same hash, we need to update it ...
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004051 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004052 {
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},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004060 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004061 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004062 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004063 };
4064
4065
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004066 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004067 }
4068 }
4069 close FILELIST;
4070
4071 # Detect deleted files
Anders Kaseorg94629532013-10-30 04:44:43 -04004072 foreach my $file ( sort keys %$head )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004073 {
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};
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004079 $head->{$file}{modified} = $cvsDate;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004080 $head->{$file}{author} = $commit->{author};
4081
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004082 $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $cvsDate, $commit->{author}, $head->{$file}{mode});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004083 }
4084 }
4085 # END : "Detect deleted files"
4086 }
4087
4088
4089 if (exists $commit->{mergemsg})
4090 {
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004091 $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004092 }
4093
4094 $lastpicked = $commit->{hash};
4095
4096 $self->_set_prop("last_commit", $commit->{hash});
4097 }
4098
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004099 $self->delete_head();
Anders Kaseorg94629532013-10-30 04:44:43 -04004100 foreach my $file ( sort keys %$head )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004101 {
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004102 $self->insert_head(
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004103 $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
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004113 $self->clearCommitRefCaches();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004114
4115
4116 # Ending exclusive lock here
4117 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
4118}
4119
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004120sub 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
Junio C Hamano1b48d562013-09-10 15:33:06 -07004189 $mode=~/^\d{3}(\d)\d\d$/;
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004190 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
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004201sub 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;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004211 my $tablename = $self->tablename("revision");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004212
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004213 my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004214 $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;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004222 my $tablename = $self->tablename("commitmsgs");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004223
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004224 my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004225 $insert_mergelog->execute($key, $value);
4226}
4227
4228sub delete_head
4229{
4230 my $self = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004231 my $tablename = $self->tablename("head");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004232
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004233 my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004234 $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;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004247 my $tablename = $self->tablename("head");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004248
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004249 my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO $tablename (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004250 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4251}
4252
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004253sub _get_prop
4254{
4255 my $self = shift;
4256 my $key = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004257 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004258
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004259 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004260 $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;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004271 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004272
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004273 my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004274 $db_query->execute($value, $key);
4275
4276 unless ( $db_query->rows )
4277 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004278 $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004279 $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;
Matthew Ogilvieab076812012-10-13 23:42:21 -06004292 my $intRev = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004293 my $tablename = $self->tablename("head");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004294
4295 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
4296
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004297 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM $tablename ORDER BY name ASC",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004298 $db_query->execute();
4299
4300 my $tree = [];
4301 while ( my $file = $db_query->fetchrow_hashref )
4302 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06004303 if(!$intRev)
4304 {
4305 $file->{revision} = "1.$file->{revision}"
4306 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004307 push @$tree, $file;
4308 }
4309
4310 $self->{gethead_cache} = $tree;
4311
4312 return $tree;
4313}
4314
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004315=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
Richard Hansenbb8040f2013-09-04 15:04:30 -04004360with a particular revision (tree-ish), organized by directory:
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004361
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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004478=head2 getlog
4479
Matthew Ogilviea86c0982012-10-13 23:42:18 -06004480See also gethistorydense().
4481
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004482=cut
4483
4484sub getlog
4485{
4486 my $self = shift;
4487 my $filename = shift;
Matthew Ogilvieab076812012-10-13 23:42:21 -06004488 my $revFilter = shift;
4489
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004490 my $tablename = $self->tablename("revision");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004491
Matthew Ogilvieab076812012-10-13 23:42:21 -06004492 # 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
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004509 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM $tablename WHERE name=? ORDER BY revision DESC",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004510 $db_query->execute($filename);
4511
Matthew Ogilvieab076812012-10-13 23:42:21 -06004512 my $totalRevs=0;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004513 my $tree = [];
4514 while ( my $file = $db_query->fetchrow_hashref )
4515 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06004516 $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};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004527 push @$tree, $file;
4528 }
4529
Matthew Ogilvieab076812012-10-13 23:42:21 -06004530 return ($tree,$totalRevs);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004531}
4532
4533=head2 getmeta
4534
4535This function takes a filename (with path) argument and returns a hashref of
4536metadata for that file.
4537
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004538There 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004551=cut
4552
4553sub getmeta
4554{
4555 my $self = shift;
4556 my $filename = shift;
4557 my $revision = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004558 my $tablename_rev = $self->tablename("revision");
4559 my $tablename_head = $self->tablename("head");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004560
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004561 if ( ref($revision) eq "HASH" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004562 {
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004563 $revision = $revision->{tag};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004564 }
4565
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004566 # 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
Stefano Lattarini41ccfdd2013-04-12 00:36:10 +02004605 # likelihood of a collision in the case that someone someday
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004606 # 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) )
4620 {
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 }
brian m. carlson05ea93d2020-06-22 18:04:16 +00004631 elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){$state->{rawsz}}$/ )
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004632 {
4633 my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
4634 $commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
brian m. carlson05ea93d2020-06-22 18:04:16 +00004635 if($commitHash=~/^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004636 {
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 }
brian m. carlson05ea93d2020-06-22 18:04:16 +00004645 elsif ( $revision =~ /^[0-9a-f]{$state->{hexsz}}$/ )
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004646 {
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);
brian m. carlson05ea93d2020-06-22 18:04:16 +00004664 if($revCommit=~/^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004665 {
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);
brian m. carlson05ea93d2020-06-22 18:04:16 +00004678 if($revCommit=~/^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004679 {
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);
4695 $db_query->execute($filename);
4696 $meta = $db_query->fetchrow_hashref;
4697 }
4698
Matthew Ogilvieab076812012-10-13 23:42:21 -06004699 if($meta)
4700 {
4701 $meta->{revision} = "1.$meta->{revision}";
4702 }
4703 return $meta;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004704}
4705
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004706sub 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
Junio C Hamanofce13af2017-09-11 14:44:24 +09004771 my($fileHash) = ::safe_pipe_capture("git","rev-parse","$revCommit:$filename");
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004772 chomp $fileHash;
brian m. carlson05ea93d2020-06-22 18:04:16 +00004773 if(!($fileHash=~/^[0-9a-f]{$state->{hexsz}}$/))
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004774 {
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
Junio C Hamanofce13af2017-09-11 14:44:24 +09004866 $commitHash = ::safe_pipe_capture("git","rev-parse","--verify","--quiet",
4867 $self->unescapeRefName($ref));
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004868 $commitHash=~s/\s*$//;
brian m. carlson05ea93d2020-06-22 18:04:16 +00004869 if(!($commitHash=~/^[0-9a-f]{$state->{hexsz}}$/))
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004870 {
4871 $commitHash=undef;
4872 }
4873
4874 if( defined($commitHash) )
4875 {
Junio C Hamanofce13af2017-09-11 14:44:24 +09004876 my $type = ::safe_pipe_capture("git","cat-file","-t",$commitHash);
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004877 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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004904=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;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004913 my $tablename = $self->tablename("commitmsgs");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004914
brian m. carlson05ea93d2020-06-22 18:04:16 +00004915 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004916
4917 my $db_query;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004918 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004919 $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
Junio C Hamanofce13af2017-09-11 14:44:24 +09004929 my @lines = ::safe_pipe_capture("git", "cat-file", "commit", $commithash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004930 shift @lines while ( $lines[0] =~ /\S/ );
4931 $message = join("",@lines);
4932 $message .= " " if ( $message =~ /\n$/ );
4933 return $message;
4934}
4935
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004936=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
Matthew Ogilviea86c0982012-10-13 23:42:18 -06004945See also getlog().
4946
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004947=cut
4948sub gethistorydense
4949{
4950 my $self = shift;
4951 my $filename = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004952 my $tablename = $self->tablename("revision");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004953
4954 my $db_query;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004955 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM $tablename WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004956 $db_query->execute($filename);
4957
Matthew Ogilvieab076812012-10-13 23:42:21 -06004958 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;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004967}
4968
Matthew Ogilvie51a7e6d2012-10-13 23:42:26 -06004969=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
Martin Langhoff3fda8c42006-02-22 22:50:15 +13005060=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
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01005078=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}
Martin Langhoff3fda8c42006-02-22 22:50:15 +13005092
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07005093=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
Martin Langhoff3fda8c42006-02-22 22:50:15 +130051081;