blob: 4c8118010a81f4da9cd2e52029cb9d6c7992975d [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:(.*)}) {
Carlo Marcelo Arenas Belónbffcb4d2021-09-15 01:09:47 -0700225 my $hash = crypt(descramble($password), $1);
226 if (defined $hash and $hash eq $1) {
Ævar Arnfjörð Bjarmason30525252010-05-15 02:46:01 +0000227 $auth_ok = 1;
228 }
Carlo Marcelo Arenas Belónbffcb4d2021-09-15 01:09:47 -0700229 }
Ævar Arnfjörð Bjarmason30525252010-05-15 02:46:01 +0000230 }
231 close $passwd;
232
233 unless ($auth_ok) {
Sam Vilainc057bad2010-05-15 15:07:54 +0000234 print "I HATE YOU\n";
235 exit 1;
236 }
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000237
238 # Fall through to LOVE
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300239 }
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000240
241 # For checking whether the user is anonymous on commit
242 $state->{user} = $user;
243
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300244 $line = <STDIN>; chomp $line;
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200245 unless ($line eq "END $request REQUEST") {
246 die "E Do not understand $line -- expecting END $request REQUEST\n";
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300247 }
248 print "I LOVE YOU\n";
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200249 exit if $request eq 'VERIFICATION'; # cvs login
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300250 # and now back to our regular programme...
251}
252
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300253# Keep going until the client closes the connection
254while (<STDIN>)
255{
256 chomp;
257
Junio C Hamano5348b6e2006-04-25 23:59:28 -0700258 # Check to see if we've seen this method, and call appropriate function.
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300259 if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
260 {
261 # use the $methods hash to call the appropriate sub for this command
262 #$log->info("Method : $1");
263 &{$methods->{$1}}($1,$2);
264 } else {
265 # log fatal because we don't understand this function. If this happens
266 # we're fairly screwed because we don't know if the client is expecting
267 # a response. If it is, the client will hang, we'll hang, and the whole
268 # thing will be custard.
269 $log->fatal("Don't understand command $_\n");
270 die("Unknown command $_");
271 }
272}
273
274$log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
275$log->info("--------------- FINISH -----------------");
276
Matthew Ogilvie044182e2008-05-14 22:35:46 -0600277chdir '/';
278exit 0;
279
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300280# Magic catchall method.
281# This is the method that will handle all commands we haven't yet
282# implemented. It simply sends a warning to the log file indicating a
283# command that hasn't been implemented has been invoked.
284sub req_CATCHALL
285{
286 my ( $cmd, $data ) = @_;
287 $log->warn("Unhandled command : req_$cmd : $data");
288}
289
Damien Diederen38bcd312008-03-27 23:17:26 +0100290# This method invariably succeeds with an empty response.
291sub req_EMPTY
292{
293 print "ok\n";
294}
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300295
296# Root pathname \n
297# Response expected: no. Tell the server which CVSROOT to use. Note that
298# pathname is a local directory and not a fully qualified CVSROOT variable.
299# pathname must already exist; if creating a new root, use the init
300# request, not Root. pathname does not include the hostname of the server,
301# how to access the server, etc.; by the time the CVS protocol is in use,
302# connection, authentication, etc., are already taken care of. The Root
303# request must be sent only once, and it must be sent before any requests
304# other than Valid-responses, valid-requests, UseUnchanged, Set or init.
305sub req_Root
306{
307 my ( $cmd, $data ) = @_;
308 $log->debug("req_Root : $data");
309
Frank Lichtenheld48908882007-06-07 16:57:00 +0200310 unless ($data =~ m#^/#) {
311 print "error 1 Root must be an absolute pathname\n";
312 return 0;
313 }
314
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200315 my $cvsroot = $state->{'base-path'} || '';
316 $cvsroot =~ s#/+$##;
317 $cvsroot .= $data;
318
Frank Lichtenheld48908882007-06-07 16:57:00 +0200319 if ($state->{CVSROOT}
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200320 && ($state->{CVSROOT} ne $cvsroot)) {
Frank Lichtenheld48908882007-06-07 16:57:00 +0200321 print "error 1 Conflicting roots specified\n";
322 return 0;
323 }
324
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200325 $state->{CVSROOT} = $cvsroot;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300326
327 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200328
329 if (@{$state->{allowed_roots}}) {
330 my $allowed = 0;
331 foreach my $dir (@{$state->{allowed_roots}}) {
332 next unless $dir =~ m#^/#;
333 $dir =~ s#/+$##;
334 if ($state->{'strict-paths'}) {
335 if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
336 $allowed = 1;
337 last;
338 }
339 } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
340 $allowed = 1;
341 last;
342 }
343 }
344
345 unless ($allowed) {
346 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
347 print "E \n";
348 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
349 return 0;
350 }
351 }
352
Martin Langhoffcdb67602006-03-04 17:47:22 +1300353 unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
354 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200355 print "E \n";
356 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
Martin Langhoffcdb67602006-03-04 17:47:22 +1300357 return 0;
358 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300359
Junio C Hamano46203ac2017-09-11 14:45:54 +0900360 my @gitvars = safe_pipe_capture(qw(git config -l));
Martin Langhoffcdb67602006-03-04 17:47:22 +1300361 if ($?) {
Tom Princee0d10e12007-01-28 16:16:53 -0800362 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 +1300363 print "E \n";
Tom Princee0d10e12007-01-28 16:16:53 -0800364 print "error 1 - problem executing git-config\n";
Martin Langhoffcdb67602006-03-04 17:47:22 +1300365 return 0;
366 }
367 foreach my $line ( @gitvars )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300368 {
brian m. carlson05ea93d2020-06-22 18:04:16 +0000369 next unless ( $line =~ /^(gitcvs|extensions)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
Frank Lichtenheldf987afa2007-05-13 02:16:24 +0200370 unless ($2) {
371 $cfg->{$1}{$3} = $4;
Frank Lichtenheld92a39a12007-03-19 16:55:58 +0100372 } else {
373 $cfg->{$1}{$2}{$3} = $4;
374 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300375 }
376
Junio C Hamano523d12e2007-05-20 17:57:27 -0700377 my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
378 || $cfg->{gitcvs}{enabled});
Frank Lichtenheld226bccb2007-06-15 03:01:53 +0200379 unless ($state->{'export-all'} ||
380 ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300381 print "E GITCVS emulation needs to be enabled on this repo\n";
382 print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
383 print "E \n";
384 print "error 1 GITCVS emulation disabled\n";
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300385 return 0;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300386 }
387
Frank Lichtenheldd55820c2007-03-19 16:55:59 +0100388 my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
389 if ( $logfile )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300390 {
Frank Lichtenheldd55820c2007-03-19 16:55:59 +0100391 $log->setfile($logfile);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300392 } else {
393 $log->nofile();
394 }
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300395
brian m. carlson05ea93d2020-06-22 18:04:16 +0000396 $state->{rawsz} = ($cfg->{'extensions'}{'objectformat'} || 'sha1') eq 'sha256' ? 32 : 20;
397 $state->{hexsz} = $state->{rawsz} * 2;
398
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300399 return 1;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300400}
401
402# Global_option option \n
403# Response expected: no. Transmit one of the global options `-q', `-Q',
404# `-l', `-t', `-r', or `-n'. option must be one of those strings, no
405# variations (such as combining of options) are allowed. For graceful
406# handling of valid-requests, it is probably better to make new global
407# options separate requests, rather than trying to add them to this
408# request.
409sub req_Globaloption
410{
411 my ( $cmd, $data ) = @_;
412 $log->debug("req_Globaloption : $data");
Martyn Smith7d900952006-03-27 15:51:42 +1200413 $state->{globaloptions}{$data} = 1;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300414}
415
416# Valid-responses request-list \n
417# Response expected: no. Tell the server what responses the client will
418# accept. request-list is a space separated list of tokens.
419sub req_Validresponses
420{
421 my ( $cmd, $data ) = @_;
Junio C Hamano5348b6e2006-04-25 23:59:28 -0700422 $log->debug("req_Validresponses : $data");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300423
424 # TODO : re-enable this, currently it's not particularly useful
425 #$state->{validresponses} = [ split /\s+/, $data ];
426}
427
428# valid-requests \n
429# Response expected: yes. Ask the server to send back a Valid-requests
430# response.
431sub req_validrequests
432{
433 my ( $cmd, $data ) = @_;
434
435 $log->debug("req_validrequests");
436
Anders Kaseorg94629532013-10-30 04:44:43 -0400437 $log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300438 $log->debug("SEND : ok");
439
Anders Kaseorg94629532013-10-30 04:44:43 -0400440 print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300441 print "ok\n";
442}
443
444# Directory local-directory \n
445# Additional data: repository \n. Response expected: no. Tell the server
446# what directory to use. The repository should be a directory name from a
447# previous server response. Note that this both gives a default for Entry
448# and Modified and also for ci and the other commands; normal usage is to
449# send Directory for each directory in which there will be an Entry or
450# Modified, and then a final Directory for the original directory, then the
451# command. The local-directory is relative to the top level at which the
452# command is occurring (i.e. the last Directory which is sent before the
453# command); to indicate that top level, `.' should be sent for
454# local-directory.
455sub req_Directory
456{
457 my ( $cmd, $data ) = @_;
458
459 my $repository = <STDIN>;
460 chomp $repository;
461
462
463 $state->{localdir} = $data;
464 $state->{repository} = $repository;
Martyn Smith7d900952006-03-27 15:51:42 +1200465 $state->{path} = $repository;
Gerrit Papef9acaea2010-01-26 14:47:16 +0000466 $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
Martyn Smith7d900952006-03-27 15:51:42 +1200467 $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
468 $state->{path} .= "/" if ( $state->{path} =~ /\S/ );
469
470 $state->{directory} = $state->{localdir};
471 $state->{directory} = "" if ( $state->{directory} eq "." );
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300472 $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
473
Johannes Schindelind988b822006-10-11 00:33:28 +0200474 if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
Martyn Smith7d900952006-03-27 15:51:42 +1200475 {
476 $log->info("Setting prepend to '$state->{path}'");
477 $state->{prependdir} = $state->{path};
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600478 my %entries;
Martyn Smith7d900952006-03-27 15:51:42 +1200479 foreach my $entry ( keys %{$state->{entries}} )
480 {
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600481 $entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
Martyn Smith7d900952006-03-27 15:51:42 +1200482 }
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600483 $state->{entries}=\%entries;
484
485 my %dirMap;
486 foreach my $dir ( keys %{$state->{dirMap}} )
487 {
488 $dirMap{$state->{prependdir} . $dir} = $state->{dirMap}{$dir};
489 }
490 $state->{dirMap}=\%dirMap;
Martyn Smith7d900952006-03-27 15:51:42 +1200491 }
492
493 if ( defined ( $state->{prependdir} ) )
494 {
495 $log->debug("Prepending '$state->{prependdir}' to state|directory");
496 $state->{directory} = $state->{prependdir} . $state->{directory}
497 }
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600498
499 if ( ! defined($state->{dirMap}{$state->{directory}}) )
500 {
501 $state->{dirMap}{$state->{directory}} =
502 {
503 'names' => {}
504 #'tagspec' => undef
505 };
506 }
507
Martyn Smith82000d72006-03-28 13:24:27 +1200508 $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300509}
510
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600511# Sticky tagspec \n
512# Response expected: no. Tell the server that the directory most
513# recently specified with Directory has a sticky tag or date
514# tagspec. The first character of tagspec is T for a tag, D for
515# a date, or some other character supplied by a Set-sticky
516# response from a previous request to the server. The remainder
517# of tagspec contains the actual tag or date, again as supplied
518# by Set-sticky.
519# The server should remember Static-directory and Sticky requests
520# for a particular directory; the client need not resend them each
521# time it sends a Directory request for a given directory. However,
522# the server is not obliged to remember them beyond the context
523# of a single command.
524sub req_Sticky
525{
526 my ( $cmd, $tagspec ) = @_;
527
528 my ( $stickyInfo );
529 if($tagspec eq "")
530 {
531 # nothing
532 }
533 elsif($tagspec=~/^T([^ ]+)\s*$/)
534 {
535 $stickyInfo = { 'tag' => $1 };
536 }
537 elsif($tagspec=~/^D([0-9.]+)\s*$/)
538 {
539 $stickyInfo= { 'date' => $1 };
540 }
541 else
542 {
543 die "Unknown tag_or_date format\n";
544 }
545 $state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;
546
547 $log->debug("req_Sticky : tagspec=$tagspec repository=$state->{repository}"
548 . " path=$state->{path} directory=$state->{directory}"
549 . " module=$state->{module}");
550}
551
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300552# Entry entry-line \n
553# Response expected: no. Tell the server what version of a file is on the
554# local machine. The name in entry-line is a name relative to the directory
555# most recently specified with Directory. If the user is operating on only
556# some files in a directory, Entry requests for only those files need be
557# included. If an Entry request is sent without Modified, Is-modified, or
558# Unchanged, it means the file is lost (does not exist in the working
559# directory). If both Entry and one of Modified, Is-modified, or Unchanged
560# are sent for the same file, Entry must be sent first. For a given file,
561# one can send Modified, Is-modified, or Unchanged, but not more than one
562# of these three.
563sub req_Entry
564{
565 my ( $cmd, $data ) = @_;
566
Martyn Smith7d900952006-03-27 15:51:42 +1200567 #$log->debug("req_Entry : $data");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300568
Matthew Ogilvieabd66f22012-10-13 23:42:23 -0600569 my @data = split(/\//, $data, -1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300570
571 $state->{entries}{$state->{directory}.$data[1]} = {
572 revision => $data[2],
573 conflict => $data[3],
574 options => $data[4],
575 tag_or_date => $data[5],
576 };
Martyn Smith7d900952006-03-27 15:51:42 +1200577
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600578 $state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';
579
Martyn Smith7d900952006-03-27 15:51:42 +1200580 $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
581}
582
583# Questionable filename \n
584# Response expected: no. Additional data: no. Tell the server to check
585# whether filename should be ignored, and if not, next time the server
586# sends responses, send (in a M response) `?' followed by the directory and
587# filename. filename must not contain `/'; it needs to be a file in the
588# directory named by the most recent Directory request.
589sub req_Questionable
590{
591 my ( $cmd, $data ) = @_;
592
593 $log->debug("req_Questionable : $data");
594 $state->{entries}{$state->{directory}.$data}{questionable} = 1;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300595}
596
597# add \n
598# Response expected: yes. Add a file or directory. This uses any previous
599# Argument, Directory, Entry, or Modified requests, if they have been sent.
600# The last Directory sent specifies the working directory at the time of
601# the operation. To add a directory, send the directory to be added using
602# Directory and Argument requests.
603sub req_add
604{
605 my ( $cmd, $data ) = @_;
606
607 argsplit("add");
608
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200609 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
610 $updater->update();
611
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300612 my $addcount = 0;
613
614 foreach my $filename ( @{$state->{args}} )
615 {
616 $filename = filecleanup($filename);
617
Matthew Ogilvie61717662012-10-13 23:42:31 -0600618 # no -r, -A, or -D with add
619 my $stickyInfo = resolveStickyInfo($filename);
620
621 my $meta = $updater->getmeta($filename,$stickyInfo);
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200622 my $wrev = revparse($filename);
623
Matthew Ogilvieab076812012-10-13 23:42:21 -0600624 if ($wrev && $meta && ($wrev=~/^-/))
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200625 {
626 # previously removed file, add back
Matthew Ogilvieab076812012-10-13 23:42:21 -0600627 $log->info("added file $filename was previously removed, send $meta->{revision}");
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200628
629 print "MT +updated\n";
630 print "MT text U \n";
631 print "MT fname $filename\n";
632 print "MT newline\n";
633 print "MT -updated\n";
634
635 unless ( $state->{globaloptions}{-n} )
636 {
637 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
638
639 print "Created $dirpart\n";
640 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
641
642 # this is an "entries" line
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600643 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600644 my $entryLine = "/$filepart/$meta->{revision}//$kopts/";
645 $entryLine .= getStickyTagOrDate($stickyInfo);
646 $log->debug($entryLine);
647 print "$entryLine\n";
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200648 # permissions
649 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
650 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
651 # transmit file
652 transmitfile($meta->{filehash});
653 }
654
655 next;
656 }
657
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300658 unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
659 {
660 print "E cvs add: nothing known about `$filename'\n";
661 next;
662 }
663 # TODO : check we're not squashing an already existing file
664 if ( defined ( $state->{entries}{$filename}{revision} ) )
665 {
666 print "E cvs add: `$filename' has already been entered\n";
667 next;
668 }
669
Martyn Smith7d900952006-03-27 15:51:42 +1200670 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300671
672 print "E cvs add: scheduling file `$filename' for addition\n";
673
674 print "Checked-in $dirpart\n";
675 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600676 my $kopts = kopts_from_path($filename,"file",
677 $state->{entries}{$filename}{modified_filename});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600678 print "/$filepart/0//$kopts/" .
679 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300680
Matthew Ogilvie8a06a632008-05-14 22:35:47 -0600681 my $requestedKopts = $state->{opt}{k};
682 if(defined($requestedKopts))
683 {
684 $requestedKopts = "-k$requestedKopts";
685 }
686 else
687 {
688 $requestedKopts = "";
689 }
690 if( $kopts ne $requestedKopts )
691 {
692 $log->warn("Ignoring requested -k='$requestedKopts'"
693 . " for '$filename'; detected -k='$kopts' instead");
694 #TODO: Also have option to send warning to user?
695 }
696
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300697 $addcount++;
698 }
699
700 if ( $addcount == 1 )
701 {
702 print "E cvs add: use `cvs commit' to add this file permanently\n";
703 }
704 elsif ( $addcount > 1 )
705 {
706 print "E cvs add: use `cvs commit' to add these files permanently\n";
707 }
708
709 print "ok\n";
710}
711
712# remove \n
713# Response expected: yes. Remove a file. This uses any previous Argument,
714# Directory, Entry, or Modified requests, if they have been sent. The last
715# Directory sent specifies the working directory at the time of the
716# operation. Note that this request does not actually do anything to the
717# repository; the only effect of a successful remove request is to supply
718# the client with a new entries line containing `-' to indicate a removed
719# file. In fact, the client probably could perform this operation without
720# contacting the server, although using remove may cause the server to
721# perform a few more checks. The client sends a subsequent ci request to
722# actually record the removal in the repository.
723sub req_remove
724{
725 my ( $cmd, $data ) = @_;
726
727 argsplit("remove");
728
729 # Grab a handle to the SQLite db and do any necessary updates
730 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
731 $updater->update();
732
733 #$log->debug("add state : " . Dumper($state));
734
735 my $rmcount = 0;
736
737 foreach my $filename ( @{$state->{args}} )
738 {
739 $filename = filecleanup($filename);
740
741 if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
742 {
743 print "E cvs remove: file `$filename' still in working directory\n";
744 next;
745 }
746
Matthew Ogilvie61717662012-10-13 23:42:31 -0600747 # only from entries
748 my $stickyInfo = resolveStickyInfo($filename);
749
750 my $meta = $updater->getmeta($filename,$stickyInfo);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300751 my $wrev = revparse($filename);
752
753 unless ( defined ( $wrev ) )
754 {
755 print "E cvs remove: nothing known about `$filename'\n";
756 next;
757 }
758
Matthew Ogilvieab076812012-10-13 23:42:21 -0600759 if ( defined($wrev) and ($wrev=~/^-/) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300760 {
761 print "E cvs remove: file `$filename' already scheduled for removal\n";
762 next;
763 }
764
Matthew Ogilvieab076812012-10-13 23:42:21 -0600765 unless ( $wrev eq $meta->{revision} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300766 {
767 # TODO : not sure if the format of this message is quite correct.
768 print "E cvs remove: Up to date check failed for `$filename'\n";
769 next;
770 }
771
772
Martyn Smith7d900952006-03-27 15:51:42 +1200773 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300774
775 print "E cvs remove: scheduling `$filename' for removal\n";
776
777 print "Checked-in $dirpart\n";
778 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600779 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600780 print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300781
782 $rmcount++;
783 }
784
785 if ( $rmcount == 1 )
786 {
787 print "E cvs remove: use `cvs commit' to remove this file permanently\n";
788 }
789 elsif ( $rmcount > 1 )
790 {
791 print "E cvs remove: use `cvs commit' to remove these files permanently\n";
792 }
793
794 print "ok\n";
795}
796
797# Modified filename \n
798# Response expected: no. Additional data: mode, \n, file transmission. Send
799# the server a copy of one locally modified file. filename is a file within
800# the most recent directory sent with Directory; it must not contain `/'.
801# If the user is operating on only some files in a directory, only those
802# files need to be included. This can also be sent without Entry, if there
803# is no entry for the file.
804sub req_Modified
805{
806 my ( $cmd, $data ) = @_;
807
808 my $mode = <STDIN>;
Jim Meyeringa5e40792007-07-14 20:48:42 +0200809 defined $mode
810 or (print "E end of file reading mode for $data\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300811 chomp $mode;
812 my $size = <STDIN>;
Jim Meyeringa5e40792007-07-14 20:48:42 +0200813 defined $size
814 or (print "E end of file reading size of $data\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300815 chomp $size;
816
817 # Grab config information
818 my $blocksize = 8192;
819 my $bytesleft = $size;
820 my $tmp;
821
822 # Get a filehandle/name to write it to
823 my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
824
825 # Loop over file data writing out to temporary file.
826 while ( $bytesleft )
827 {
828 $blocksize = $bytesleft if ( $bytesleft < $blocksize );
829 read STDIN, $tmp, $blocksize;
830 print $fh $tmp;
831 $bytesleft -= $blocksize;
832 }
833
Jim Meyeringa5e40792007-07-14 20:48:42 +0200834 close $fh
835 or (print "E failed to write temporary, $filename: $!\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300836
837 # Ensure we have something sensible for the file mode
838 if ( $mode =~ /u=(\w+)/ )
839 {
840 $mode = $1;
841 } else {
842 $mode = "rw";
843 }
844
845 # Save the file data in $state
846 $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
847 $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
joernchen27dd7382017-09-11 14:45:09 +0900848 $state->{entries}{$state->{directory}.$data}{modified_hash} = safe_pipe_capture('git','hash-object',$filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300849 $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
850
851 #$log->debug("req_Modified : file=$data mode=$mode size=$size");
852}
853
854# Unchanged filename \n
855# Response expected: no. Tell the server that filename has not been
856# modified in the checked out directory. The filename is a file within the
857# most recent directory sent with Directory; it must not contain `/'.
858sub req_Unchanged
859{
860 my ( $cmd, $data ) = @_;
861
862 $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
863
864 #$log->debug("req_Unchanged : $data");
865}
866
867# Argument text \n
868# Response expected: no. Save argument for use in a subsequent command.
869# Arguments accumulate until an argument-using command is given, at which
870# point they are forgotten.
871# Argumentx text \n
872# Response expected: no. Append \n followed by text to the current argument
873# being saved.
874sub req_Argument
875{
876 my ( $cmd, $data ) = @_;
877
Johannes Schindelin2c3cff42006-07-26 21:59:08 +0200878 # Argumentx means: append to last Argument (with a newline in front)
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300879
880 $log->debug("$cmd : $data");
881
Johannes Schindelin2c3cff42006-07-26 21:59:08 +0200882 if ( $cmd eq 'Argumentx') {
883 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
884 } else {
885 push @{$state->{arguments}}, $data;
886 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300887}
888
889# expand-modules \n
890# Response expected: yes. Expand the modules which are specified in the
891# arguments. Returns the data in Module-expansion responses. Note that the
892# server can assume that this is checkout or export, not rtag or rdiff; the
893# latter do not access the working directory and thus have no need to
894# expand modules on the client side. Expand may not be the best word for
895# what this request does. It does not necessarily tell you all the files
896# contained in a module, for example. Basically it is a way of telling you
897# which working directories the server needs to know about in order to
898# handle a checkout of the specified modules. For example, suppose that the
899# server has a module defined by
900# aliasmodule -a 1dir
901# That is, one can check out aliasmodule and it will take 1dir in the
902# repository and check it out to 1dir in the working directory. Now suppose
903# the client already has this module checked out and is planning on using
904# the co request to update it. Without using expand-modules, the client
905# would have two bad choices: it could either send information about all
906# working directories under the current directory, which could be
907# unnecessarily slow, or it could be ignorant of the fact that aliasmodule
908# stands for 1dir, and neglect to send information for 1dir, which would
909# lead to incorrect operation. With expand-modules, the client would first
910# ask for the module to be expanded:
911sub req_expandmodules
912{
913 my ( $cmd, $data ) = @_;
914
915 argsplit();
916
917 $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
918
919 unless ( ref $state->{arguments} eq "ARRAY" )
920 {
921 print "ok\n";
922 return;
923 }
924
925 foreach my $module ( @{$state->{arguments}} )
926 {
927 $log->debug("SEND : Module-expansion $module");
928 print "Module-expansion $module\n";
929 }
930
931 print "ok\n";
932 statecleanup();
933}
934
935# co \n
936# Response expected: yes. Get files from the repository. This uses any
937# previous Argument, Directory, Entry, or Modified requests, if they have
938# been sent. Arguments to this command are module names; the client cannot
939# know what directories they correspond to except by (1) just sending the
940# co request, and then seeing what directory names the server sends back in
941# its responses, and (2) the expand-modules request.
942sub req_co
943{
944 my ( $cmd, $data ) = @_;
945
946 argsplit("co");
947
Lars Noschinski89a91672008-07-17 19:00:29 +0200948 # Provide list of modules, if -c was used.
949 if (exists $state->{opt}{c}) {
Junio C Hamano46203ac2017-09-11 14:45:54 +0900950 my $showref = safe_pipe_capture(qw(git show-ref --heads));
Lars Noschinski89a91672008-07-17 19:00:29 +0200951 for my $line (split '\n', $showref) {
952 if ( $line =~ m% refs/heads/(.*)$% ) {
953 print "M $1\t$1\n";
954 }
955 }
956 print "ok\n";
957 return 1;
958 }
959
Matthew Ogilvie61717662012-10-13 23:42:31 -0600960 my $stickyInfo = { 'tag' => $state->{opt}{r},
961 'date' => $state->{opt}{D} };
962
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300963 my $module = $state->{args}[0];
Matthew Ogilvie8a06a632008-05-14 22:35:47 -0600964 $state->{module} = $module;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300965 my $checkout_path = $module;
966
967 # use the user specified directory if we're given it
968 $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
969
970 $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
971
972 $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
973
974 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
975
976 # Grab a handle to the SQLite db and do any necessary updates
977 my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
978 $updater->update();
979
Matthew Ogilvie61717662012-10-13 23:42:31 -0600980 my $headHash;
981 if( defined($stickyInfo) && defined($stickyInfo->{tag}) )
982 {
983 $headHash = $updater->lookupCommitRef($stickyInfo->{tag});
984 if( !defined($headHash) )
985 {
986 print "error 1 no such tag `$stickyInfo->{tag}'\n";
987 cleanupWorkTree();
988 exit;
989 }
990 }
991
Martin Langhoffc8c4f222006-03-02 13:58:57 +1300992 $checkout_path =~ s|/$||; # get rid of trailing slashes
993
Martin Langhoffc8c4f222006-03-02 13:58:57 +1300994 my %seendirs = ();
Martin Langhoff501c7372006-03-03 16:38:03 +1300995 my $lastdir ='';
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300996
Matthew Ogilvie61717662012-10-13 23:42:31 -0600997 prepDirForOutput(
998 ".",
999 $state->{CVSROOT} . "/$module",
1000 $checkout_path,
1001 \%seendirs,
1002 'checkout',
1003 $state->{dirArgs} );
Martin Langhoff6be32d42006-03-04 17:47:29 +13001004
Matthew Ogilvie61717662012-10-13 23:42:31 -06001005 foreach my $git ( @{$updater->getAnyHead($headHash)} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001006 {
1007 # Don't want to check out deleted files
1008 next if ( $git->{filehash} eq "deleted" );
1009
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06001010 my $fullName = $git->{name};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001011 ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
1012
Matthew Ogilvie61717662012-10-13 23:42:31 -06001013 unless (exists($seendirs{$git->{dir}})) {
1014 prepDirForOutput($git->{dir}, $state->{CVSROOT} . "/$module/",
1015 $checkout_path, \%seendirs, 'checkout',
1016 $state->{dirArgs} );
1017 $lastdir = $git->{dir};
1018 $seendirs{$git->{dir}} = 1;
1019 }
Martin Langhoff6be32d42006-03-04 17:47:29 +13001020
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001021 # modification time of this file
1022 print "Mod-time $git->{modified}\n";
1023
1024 # print some information to the client
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001025 if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
1026 {
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001027 print "M U $checkout_path/$git->{dir}$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001028 } else {
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001029 print "M U $checkout_path/$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001030 }
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001031
Martin Langhoff6be32d42006-03-04 17:47:29 +13001032 # instruct client we're sending a file to put in this path
1033 print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001034
Martin Langhoff6be32d42006-03-04 17:47:29 +13001035 print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001036
1037 # this is an "entries" line
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001038 my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001039 print "/$git->{name}/$git->{revision}//$kopts/" .
1040 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001041 # permissions
1042 print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
1043
1044 # transmit file
1045 transmitfile($git->{filehash});
1046 }
1047
1048 print "ok\n";
1049
1050 statecleanup();
1051}
1052
Matthew Ogilvie61717662012-10-13 23:42:31 -06001053# used by req_co and req_update to set up directories for files
1054# recursively handles parents
1055sub prepDirForOutput
1056{
1057 my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;
1058
1059 my $parent = dirname($dir);
1060 $dir =~ s|/+$||;
1061 $repodir =~ s|/+$||;
1062 $remotedir =~ s|/+$||;
1063 $parent =~ s|/+$||;
1064
1065 if ($parent eq '.' || $parent eq './')
1066 {
1067 $parent = '';
1068 }
1069 # recurse to announce unseen parents first
1070 if( length($parent) &&
1071 !exists($seendirs->{$parent}) &&
1072 ( $request eq "checkout" ||
1073 exists($dirArgs->{$parent}) ) )
1074 {
1075 prepDirForOutput($parent, $repodir, $remotedir,
1076 $seendirs, $request, $dirArgs);
1077 }
1078 # Announce that we are going to modify at the parent level
1079 if ($dir eq '.' || $dir eq './')
1080 {
1081 $dir = '';
1082 }
1083 if(exists($seendirs->{$dir}))
1084 {
1085 return;
1086 }
1087 $log->debug("announcedir $dir, $repodir, $remotedir" );
1088 my($thisRemoteDir,$thisRepoDir);
1089 if ($dir ne "")
1090 {
1091 $thisRepoDir="$repodir/$dir";
1092 if($remotedir eq ".")
1093 {
1094 $thisRemoteDir=$dir;
1095 }
1096 else
1097 {
1098 $thisRemoteDir="$remotedir/$dir";
1099 }
1100 }
1101 else
1102 {
1103 $thisRepoDir=$repodir;
1104 $thisRemoteDir=$remotedir;
1105 }
1106 unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
1107 {
1108 print "E cvs $request: Updating $thisRemoteDir\n";
1109 }
1110
1111 my ($opt_r)=$state->{opt}{r};
1112 my $stickyInfo;
1113 if(exists($state->{opt}{A}))
1114 {
1115 # $stickyInfo=undef;
1116 }
1117 elsif( defined($opt_r) && $opt_r ne "" )
1118 # || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO
1119 {
1120 $stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };
1121
1122 # TODO: Convert -D value into the form 2011.04.10.04.46.57,
1123 # similar to an entry line's sticky date, without the D prefix.
1124 # It sometimes (always?) arrives as something more like
1125 # '10 Apr 2011 04:46:57 -0000'...
1126 # $stickyInfo={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
1127 }
1128 else
1129 {
1130 $stickyInfo=getDirStickyInfo($state->{prependdir} . $dir);
1131 }
1132
1133 my $stickyResponse;
1134 if(defined($stickyInfo))
1135 {
1136 $stickyResponse = "Set-sticky $thisRemoteDir/\n" .
1137 "$thisRepoDir/\n" .
1138 getStickyTagOrDate($stickyInfo) . "\n";
1139 }
1140 else
1141 {
1142 $stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
1143 "$thisRepoDir/\n";
1144 }
1145
1146 unless ( $state->{globaloptions}{-n} )
1147 {
1148 print $stickyResponse;
1149
1150 print "Clear-static-directory $thisRemoteDir/\n";
1151 print "$thisRepoDir/\n";
1152 print $stickyResponse; # yes, twice
1153 print "Template $thisRemoteDir/\n";
1154 print "$thisRepoDir/\n";
1155 print "0\n";
1156 }
1157
1158 $seendirs->{$dir} = 1;
1159
1160 # FUTURE: This would more accurately emulate CVS by sending
1161 # another copy of sticky after processing the files in that
1162 # directory. Or intermediate: perhaps send all sticky's for
Li Peng832c0e52016-05-06 20:36:46 +08001163 # $seendirs after processing all files.
Matthew Ogilvie61717662012-10-13 23:42:31 -06001164}
1165
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001166# update \n
1167# Response expected: yes. Actually do a cvs update command. This uses any
1168# previous Argument, Directory, Entry, or Modified requests, if they have
1169# been sent. The last Directory sent specifies the working directory at the
1170# time of the operation. The -I option is not used--files which the client
1171# can decide whether to ignore are not mentioned and the client sends the
1172# Questionable request for others.
1173sub req_update
1174{
1175 my ( $cmd, $data ) = @_;
1176
1177 $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
1178
1179 argsplit("update");
1180
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001181 #
Junio C Hamano5348b6e2006-04-25 23:59:28 -07001182 # It may just be a client exploring the available heads/modules
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001183 # in that case, list them as top level directories and leave it
1184 # at that. Eclipse uses this technique to offer you a list of
1185 # projects (heads in this case) to checkout.
1186 #
1187 if ($state->{module} eq '') {
Junio C Hamano46203ac2017-09-11 14:45:54 +09001188 my $showref = safe_pipe_capture(qw(git show-ref --heads));
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001189 print "E cvs update: Updating .\n";
Lars Noschinskib20171e2008-07-17 19:00:27 +02001190 for my $line (split '\n', $showref) {
1191 if ( $line =~ m% refs/heads/(.*)$% ) {
1192 print "E cvs update: New directory `$1'\n";
1193 }
1194 }
1195 print "ok\n";
1196 return 1;
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001197 }
1198
1199
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001200 # Grab a handle to the SQLite db and do any necessary updates
1201 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1202
1203 $updater->update();
1204
Martyn Smith7d900952006-03-27 15:51:42 +12001205 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001206
1207 #$log->debug("update state : " . Dumper($state));
1208
Matthew Ogilvie61717662012-10-13 23:42:31 -06001209 my($repoDir);
1210 $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
1211
1212 my %seendirs = ();
Sergei Organov8e4c4e72009-12-07 14:11:44 +03001213
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001214 # foreach file specified on the command line ...
Matthew Ogilvie61717662012-10-13 23:42:31 -06001215 foreach my $argsFilename ( @{$state->{args}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001216 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001217 my $filename;
1218 $filename = filecleanup($argsFilename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001219
Martyn Smith7d900952006-03-27 15:51:42 +12001220 $log->debug("Processing file $filename");
1221
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001222 # if we have a -C we should pretend we never saw modified stuff
1223 if ( exists ( $state->{opt}{C} ) )
1224 {
1225 delete $state->{entries}{$filename}{modified_hash};
1226 delete $state->{entries}{$filename}{modified_filename};
1227 $state->{entries}{$filename}{unchanged} = 1;
1228 }
1229
Matthew Ogilvie61717662012-10-13 23:42:31 -06001230 my $stickyInfo = resolveStickyInfo($filename,
1231 $state->{opt}{r},
1232 $state->{opt}{D},
1233 exists($state->{opt}{A}));
1234 my $meta = $updater->getmeta($filename, $stickyInfo);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001235
Damien Diederene78f69a2008-03-27 23:18:12 +01001236 # If -p was given, "print" the contents of the requested revision.
1237 if ( exists ( $state->{opt}{p} ) ) {
1238 if ( defined ( $meta->{revision} ) ) {
1239 $log->info("Printing '$filename' revision " . $meta->{revision});
1240
1241 transmitfile($meta->{filehash}, { print => 1 });
1242 }
1243
1244 next;
1245 }
1246
Matthew Ogilvie61717662012-10-13 23:42:31 -06001247 # Directories:
1248 prepDirForOutput(
1249 dirname($argsFilename),
1250 $repoDir,
1251 ".",
1252 \%seendirs,
1253 "update",
1254 $state->{dirArgs} );
1255
1256 my $wrev = revparse($filename);
1257
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001258 if ( ! defined $meta )
1259 {
1260 $meta = {
1261 name => $filename,
Matthew Ogilvieab076812012-10-13 23:42:21 -06001262 revision => '0',
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001263 filehash => 'added'
1264 };
Matthew Ogilvie61717662012-10-13 23:42:31 -06001265 if($wrev ne "0")
1266 {
1267 $meta->{filehash}='deleted';
1268 }
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001269 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001270
1271 my $oldmeta = $meta;
1272
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001273 # If the working copy is an old revision, lets get that version too for comparison.
Matthew Ogilvie61717662012-10-13 23:42:31 -06001274 my $oldWrev=$wrev;
1275 if(defined($oldWrev))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001276 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001277 $oldWrev=~s/^-//;
1278 if($oldWrev ne $meta->{revision})
1279 {
1280 $oldmeta = $updater->getmeta($filename, $oldWrev);
1281 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001282 }
1283
1284 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
1285
Martin Langhoffec58db12006-03-02 18:42:01 +13001286 # Files are up to date if the working copy and repo copy have the same revision,
1287 # and the working copy is unmodified _and_ the user hasn't specified -C
1288 next if ( defined ( $wrev )
1289 and defined($meta->{revision})
Matthew Ogilvieab076812012-10-13 23:42:21 -06001290 and $wrev eq $meta->{revision}
Martin Langhoffec58db12006-03-02 18:42:01 +13001291 and $state->{entries}{$filename}{unchanged}
1292 and not exists ( $state->{opt}{C} ) );
1293
1294 # If the working copy and repo copy have the same revision,
1295 # but the working copy is modified, tell the client it's modified
1296 if ( defined ( $wrev )
1297 and defined($meta->{revision})
Matthew Ogilvieab076812012-10-13 23:42:21 -06001298 and $wrev eq $meta->{revision}
Matthew Ogilvie61717662012-10-13 23:42:31 -06001299 and $wrev ne "0"
Frank Lichtenheldcb52d9a2007-04-11 22:38:19 +02001300 and defined($state->{entries}{$filename}{modified_hash})
Martin Langhoffec58db12006-03-02 18:42:01 +13001301 and not exists ( $state->{opt}{C} ) )
1302 {
1303 $log->info("Tell the client the file is modified");
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001304 print "MT text M \n";
Martin Langhoffec58db12006-03-02 18:42:01 +13001305 print "MT fname $filename\n";
1306 print "MT newline\n";
1307 next;
1308 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001309
Matthew Ogilvie61717662012-10-13 23:42:31 -06001310 if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001311 {
Matthew Ogilvied8574ff2012-10-13 23:42:17 -06001312 # TODO: If it has been modified in the sandbox, error out
1313 # with the appropriate message, rather than deleting a modified
1314 # file.
1315
Martyn Smith7d900952006-03-27 15:51:42 +12001316 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001317
1318 $log->info("Removing '$filename' from working copy (no longer in the repo)");
1319
1320 print "E cvs update: `$filename' is no longer in the repository\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001321 # Don't want to actually _DO_ the update if -n specified
1322 unless ( $state->{globaloptions}{-n} ) {
1323 print "Removed $dirpart\n";
1324 print "$filepart\n";
1325 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001326 }
Martin Langhoffec58db12006-03-02 18:42:01 +13001327 elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001328 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
1329 or $meta->{filehash} eq 'added' )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001330 {
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001331 # normal update, just send the new revision (either U=Update,
1332 # or A=Add, or R=Remove)
Matthew Ogilvieab076812012-10-13 23:42:21 -06001333 if ( defined($wrev) && ($wrev=~/^-/) )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001334 {
1335 $log->info("Tell the client the file is scheduled for removal");
1336 print "MT text R \n";
1337 print "MT fname $filename\n";
1338 print "MT newline\n";
1339 next;
1340 }
Matthew Ogilvieab076812012-10-13 23:42:21 -06001341 elsif ( (!defined($wrev) || $wrev eq '0') &&
1342 (!defined($meta->{revision}) || $meta->{revision} eq '0') )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001343 {
Andy Parkins535514f2007-01-22 10:56:27 +00001344 $log->info("Tell the client the file is scheduled for addition");
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001345 print "MT text A \n";
1346 print "MT fname $filename\n";
1347 print "MT newline\n";
1348 next;
1349
1350 }
1351 else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001352 $log->info("UpdatingX3 '$filename' to ".$meta->{revision});
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001353 print "MT +updated\n";
1354 print "MT text U \n";
1355 print "MT fname $filename\n";
1356 print "MT newline\n";
1357 print "MT -updated\n";
1358 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001359
Martyn Smith7d900952006-03-27 15:51:42 +12001360 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001361
Martyn Smith7d900952006-03-27 15:51:42 +12001362 # Don't want to actually _DO_ the update if -n specified
1363 unless ( $state->{globaloptions}{-n} )
1364 {
1365 if ( defined ( $wrev ) )
1366 {
1367 # instruct client we're sending a file to put in this path as a replacement
1368 print "Update-existing $dirpart\n";
1369 $log->debug("Updating existing file 'Update-existing $dirpart'");
1370 } else {
1371 # instruct client we're sending a file to put in this path as a new file
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001372
Martyn Smith7d900952006-03-27 15:51:42 +12001373 $log->debug("Creating new file 'Created $dirpart'");
1374 print "Created $dirpart\n";
1375 }
1376 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001377
Martyn Smith7d900952006-03-27 15:51:42 +12001378 # this is an "entries" line
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001379 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001380 my $entriesLine = "/$filepart/$meta->{revision}//$kopts/";
1381 $entriesLine .= getStickyTagOrDate($stickyInfo);
1382 $log->debug($entriesLine);
1383 print "$entriesLine\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001384
Martyn Smith7d900952006-03-27 15:51:42 +12001385 # permissions
1386 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1387 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1388
1389 # transmit file
1390 transmitfile($meta->{filehash});
1391 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001392 } else {
Martyn Smith7d900952006-03-27 15:51:42 +12001393 my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001394
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001395 my $mergeDir = setupTmpDir();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001396
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001397 my $file_local = $filepart . ".mine";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001398 my $mergedFile = "$mergeDir/$file_local";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001399 system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
1400 my $file_old = $filepart . "." . $oldmeta->{revision};
Damien Diederene78f69a2008-03-27 23:18:12 +01001401 transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001402 my $file_new = $filepart . "." . $meta->{revision};
Damien Diederene78f69a2008-03-27 23:18:12 +01001403 transmitfile($meta->{filehash}, { targetfile => $file_new });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001404
1405 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
1406 $log->info("Merging $file_local, $file_old, $file_new");
Matthew Ogilvieab076812012-10-13 23:42:21 -06001407 print "M Merging differences between $oldmeta->{revision} and $meta->{revision} into $filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001408
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001409 $log->debug("Temporary directory for merge is $mergeDir");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001410
Eric Wongc6b4fa92006-12-19 14:58:20 -08001411 my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001412 $return >>= 8;
1413
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001414 cleanupTmpDir();
1415
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001416 if ( $return == 0 )
1417 {
1418 $log->info("Merged successfully");
1419 print "M M $filename\n";
Frank Lichtenheld53877842007-03-06 10:42:24 +01001420 $log->debug("Merged $dirpart");
Martyn Smith7d900952006-03-27 15:51:42 +12001421
1422 # Don't want to actually _DO_ the update if -n specified
1423 unless ( $state->{globaloptions}{-n} )
1424 {
Frank Lichtenheld53877842007-03-06 10:42:24 +01001425 print "Merged $dirpart\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001426 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
1427 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001428 my $kopts = kopts_from_path("$dirpart/$filepart",
1429 "file",$mergedFile);
Matthew Ogilvieab076812012-10-13 23:42:21 -06001430 $log->debug("/$filepart/$meta->{revision}//$kopts/");
Matthew Ogilvie61717662012-10-13 23:42:31 -06001431 my $entriesLine="/$filepart/$meta->{revision}//$kopts/";
1432 $entriesLine .= getStickyTagOrDate($stickyInfo);
1433 print "$entriesLine\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001434 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001435 }
1436 elsif ( $return == 1 )
1437 {
1438 $log->info("Merged with conflicts");
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001439 print "E cvs update: conflicts found in $filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001440 print "M C $filename\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001441
1442 # Don't want to actually _DO_ the update if -n specified
1443 unless ( $state->{globaloptions}{-n} )
1444 {
Frank Lichtenheld53877842007-03-06 10:42:24 +01001445 print "Merged $dirpart\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001446 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001447 my $kopts = kopts_from_path("$dirpart/$filepart",
1448 "file",$mergedFile);
Matthew Ogilvie61717662012-10-13 23:42:31 -06001449 my $entriesLine = "/$filepart/$meta->{revision}/+/$kopts/";
1450 $entriesLine .= getStickyTagOrDate($stickyInfo);
1451 print "$entriesLine\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001452 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001453 }
1454 else
1455 {
1456 $log->warn("Merge failed");
1457 next;
1458 }
1459
Martyn Smith7d900952006-03-27 15:51:42 +12001460 # Don't want to actually _DO_ the update if -n specified
1461 unless ( $state->{globaloptions}{-n} )
1462 {
1463 # permissions
1464 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1465 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001466
Martyn Smith7d900952006-03-27 15:51:42 +12001467 # transmit file, format is single integer on a line by itself (file
1468 # size) followed by the file contents
1469 # TODO : we should copy files in blocks
joernchen27dd7382017-09-11 14:45:09 +09001470 my $data = safe_pipe_capture('cat', $mergedFile);
Martyn Smith7d900952006-03-27 15:51:42 +12001471 $log->debug("File size : " . length($data));
1472 print length($data) . "\n";
1473 print $data;
1474 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001475 }
1476
1477 }
1478
Matthew Ogilvie61717662012-10-13 23:42:31 -06001479 # prepDirForOutput() any other existing directories unless they already
1480 # have the right sticky tag:
1481 unless ( $state->{globaloptions}{n} )
1482 {
1483 my $dir;
1484 foreach $dir (keys(%{$state->{dirMap}}))
1485 {
1486 if( ! $seendirs{$dir} &&
1487 exists($state->{dirArgs}{$dir}) )
1488 {
1489 my($oldTag);
1490 $oldTag=$state->{dirMap}{$dir}{tagspec};
1491
1492 unless( ( exists($state->{opt}{A}) &&
1493 defined($oldTag) ) ||
1494 ( defined($state->{opt}{r}) &&
1495 ( !defined($oldTag) ||
1496 $state->{opt}{r} ne $oldTag ) ) )
1497 # TODO?: OR sticky dir is different...
1498 {
1499 next;
1500 }
1501
1502 prepDirForOutput(
1503 $dir,
1504 $repoDir,
1505 ".",
1506 \%seendirs,
1507 'update',
1508 $state->{dirArgs} );
1509 }
1510
1511 # TODO?: Consider sending a final duplicate Sticky response
1512 # to more closely mimic real CVS.
1513 }
1514 }
1515
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001516 print "ok\n";
1517}
1518
1519sub req_ci
1520{
1521 my ( $cmd, $data ) = @_;
1522
1523 argsplit("ci");
1524
1525 #$log->debug("State : " . Dumper($state));
1526
1527 $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1528
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00001529 if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
Martin Langhoff91a6bf42006-03-04 20:30:04 +13001530 {
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00001531 print "error 1 anonymous user cannot commit via pserver\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001532 cleanupWorkTree();
Martin Langhoff91a6bf42006-03-04 20:30:04 +13001533 exit;
1534 }
1535
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001536 if ( -e $state->{CVSROOT} . "/index" )
1537 {
Martyn Smith568907f2006-03-17 13:33:19 +13001538 $log->warn("file 'index' already exists in the git repository");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001539 print "error 1 Index already exists in git repo\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001540 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001541 exit;
1542 }
1543
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001544 # Grab a handle to the SQLite db and do any necessary updates
1545 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1546 $updater->update();
1547
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001548 my @committedfiles = ();
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001549 my %oldmeta;
Matthew Ogilvie61717662012-10-13 23:42:31 -06001550 my $stickyInfo;
1551 my $branchRef;
1552 my $parenthash;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001553
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001554 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001555 foreach my $filename ( @{$state->{args}} )
1556 {
Martyn Smith7d900952006-03-27 15:51:42 +12001557 my $committedfile = $filename;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001558 $filename = filecleanup($filename);
1559
1560 next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1561
Matthew Ogilvie61717662012-10-13 23:42:31 -06001562 #####
1563 # Figure out which branch and parenthash we are committing
1564 # to, and setup worktree:
1565
1566 # should always come from entries:
1567 my $fileStickyInfo = resolveStickyInfo($filename);
1568 if( !defined($branchRef) )
1569 {
1570 $stickyInfo = $fileStickyInfo;
1571 if( defined($stickyInfo) &&
1572 ( defined($stickyInfo->{date}) ||
1573 !defined($stickyInfo->{tag}) ) )
1574 {
1575 print "error 1 cannot commit with sticky date for file `$filename'\n";
1576 cleanupWorkTree();
1577 exit;
1578 }
1579
1580 $branchRef = "refs/heads/$state->{module}";
1581 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1582 {
1583 $branchRef = "refs/heads/$stickyInfo->{tag}";
1584 }
1585
joernchen27dd7382017-09-11 14:45:09 +09001586 $parenthash = safe_pipe_capture('git', 'show-ref', '-s', $branchRef);
Matthew Ogilvie61717662012-10-13 23:42:31 -06001587 chomp $parenthash;
brian m. carlson05ea93d2020-06-22 18:04:16 +00001588 if ($parenthash !~ /^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilvie61717662012-10-13 23:42:31 -06001589 {
1590 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1591 {
1592 print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
1593 }
1594 else
1595 {
1596 print "error 1 pserver cannot find the current HEAD of module";
1597 }
1598 cleanupWorkTree();
1599 exit;
1600 }
1601
1602 setupWorkTree($parenthash);
1603
1604 $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
1605
1606 $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
1607 }
1608 elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )
1609 {
1610 #TODO: We could split the cvs commit into multiple
1611 # git commits by distinct stickyTag values, but that
1612 # is lowish priority.
1613 print "error 1 Committing different files to different"
1614 . " branches is not currently supported\n";
1615 cleanupWorkTree();
1616 exit;
1617 }
1618
1619 #####
1620 # Process this file:
1621
1622 my $meta = $updater->getmeta($filename,$stickyInfo);
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001623 $oldmeta{$filename} = $meta;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001624
1625 my $wrev = revparse($filename);
1626
1627 my ( $filepart, $dirpart ) = filenamesplit($filename);
1628
Michael Wittencdf63282007-11-23 04:12:54 -05001629 # do a checkout of the file if it is part of this tree
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001630 if ($wrev) {
Gerrit Paped2feb012009-09-02 09:23:10 +00001631 system('git', 'checkout-index', '-f', '-u', $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001632 unless ($? == 0) {
1633 die "Error running git-checkout-index -f -u $filename : $!";
1634 }
1635 }
1636
1637 my $addflag = 0;
1638 my $rmflag = 0;
Matthew Ogilvieab076812012-10-13 23:42:21 -06001639 $rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001640 $addflag = 1 unless ( -e $filename );
1641
1642 # Do up to date checking
Matthew Ogilvieab076812012-10-13 23:42:21 -06001643 unless ( $addflag or $wrev eq $meta->{revision} or
1644 ( $rmflag and $wrev eq "-$meta->{revision}" ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001645 {
1646 # fail everything if an up to date check fails
1647 print "error 1 Up to date check failed for $filename\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001648 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001649 exit;
1650 }
1651
Martyn Smith7d900952006-03-27 15:51:42 +12001652 push @committedfiles, $committedfile;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001653 $log->info("Committing $filename");
1654
1655 system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1656
1657 unless ( $rmflag )
1658 {
1659 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1660 rename $state->{entries}{$filename}{modified_filename},$filename;
1661
1662 # Calculate modes to remove
1663 my $invmode = "";
1664 foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1665
1666 $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1667 system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1668 }
1669
1670 if ( $rmflag )
1671 {
1672 $log->info("Removing file '$filename'");
1673 unlink($filename);
Gerrit Paped2feb012009-09-02 09:23:10 +00001674 system("git", "update-index", "--remove", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001675 }
1676 elsif ( $addflag )
1677 {
1678 $log->info("Adding file '$filename'");
Gerrit Paped2feb012009-09-02 09:23:10 +00001679 system("git", "update-index", "--add", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001680 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001681 $log->info("UpdatingX2 file '$filename'");
Gerrit Paped2feb012009-09-02 09:23:10 +00001682 system("git", "update-index", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001683 }
1684 }
1685
1686 unless ( scalar(@committedfiles) > 0 )
1687 {
1688 print "E No files to commit\n";
1689 print "ok\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001690 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001691 return;
1692 }
1693
Junio C Hamano46203ac2017-09-11 14:45:54 +09001694 my $treehash = safe_pipe_capture(qw(git write-tree));
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001695 chomp $treehash;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001696
1697 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1698
1699 # write our commit message out if we have one ...
1700 my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1701 print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
Fabian Emmes280514e2009-01-02 16:40:13 +01001702 if ( defined ( $cfg->{gitcvs}{commitmsgannotation} ) ) {
1703 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/ ) {
1704 print $msg_fh "\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"
1705 }
1706 } else {
1707 print $msg_fh "\n\nvia git-CVS emulator\n";
1708 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001709 close $msg_fh;
1710
joernchen27dd7382017-09-11 14:45:09 +09001711 my $commithash = safe_pipe_capture('git', 'commit-tree', $treehash, '-p', $parenthash, '-F', $msg_filename);
Andy Parkins1872ada2007-02-27 12:49:09 +00001712 chomp($commithash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001713 $log->info("Commit hash : $commithash");
1714
brian m. carlson05ea93d2020-06-22 18:04:16 +00001715 unless ( $commithash =~ /[a-zA-Z0-9]{$state->{hexsz}}/ )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001716 {
1717 $log->warn("Commit failed (Invalid commit hash)");
1718 print "error 1 Commit failed (unknown reason)\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001719 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001720 exit;
1721 }
1722
Michael Wittencdf63282007-11-23 04:12:54 -05001723 ### Emulate git-receive-pack by running hooks/update
Matthew Ogilvie61717662012-10-13 23:42:31 -06001724 my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
Andy Parkinsb2741f62007-02-13 15:12:45 +00001725 $parenthash, $commithash );
Michael Wittencdf63282007-11-23 04:12:54 -05001726 if( -x $hook[0] ) {
1727 unless( system( @hook ) == 0 )
Andy Parkinsb2741f62007-02-13 15:12:45 +00001728 {
1729 $log->warn("Commit failed (update hook declined to update ref)");
1730 print "error 1 Commit failed (update hook declined)\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001731 cleanupWorkTree();
Andy Parkinsb2741f62007-02-13 15:12:45 +00001732 exit;
1733 }
1734 }
1735
Michael Wittencdf63282007-11-23 04:12:54 -05001736 ### Update the ref
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001737 if (system(qw(git update-ref -m), "cvsserver ci",
Matthew Ogilvie61717662012-10-13 23:42:31 -06001738 $branchRef, $commithash, $parenthash)) {
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001739 $log->warn("update-ref for $state->{module} failed.");
1740 print "error 1 Cannot commit -- update first\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001741 cleanupWorkTree();
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001742 exit;
1743 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001744
Michael Wittencdf63282007-11-23 04:12:54 -05001745 ### Emulate git-receive-pack by running hooks/post-receive
1746 my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
1747 if( -x $hook ) {
1748 open(my $pipe, "| $hook") || die "can't fork $!";
1749
1750 local $SIG{PIPE} = sub { die 'pipe broke' };
1751
Matthew Ogilvie61717662012-10-13 23:42:31 -06001752 print $pipe "$parenthash $commithash $branchRef\n";
Michael Wittencdf63282007-11-23 04:12:54 -05001753
1754 close $pipe || die "bad pipe: $! $?";
1755 }
1756
Stefan Karpinskiad8c3472009-01-29 13:58:02 -08001757 $updater->update();
1758
Junio C Hamano394d66d2007-12-05 01:15:01 -08001759 ### Then hooks/post-update
1760 $hook = $ENV{GIT_DIR}.'hooks/post-update';
1761 if (-x $hook) {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001762 system($hook, $branchRef);
Junio C Hamano394d66d2007-12-05 01:15:01 -08001763 }
1764
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001765 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001766 foreach my $filename ( @committedfiles )
1767 {
1768 $filename = filecleanup($filename);
1769
Matthew Ogilvie61717662012-10-13 23:42:31 -06001770 my $meta = $updater->getmeta($filename,$stickyInfo);
Martin Langhoff34865952007-01-09 15:10:41 +13001771 unless (defined $meta->{revision}) {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001772 $meta->{revision} = "1.1";
Martin Langhoff34865952007-01-09 15:10:41 +13001773 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001774
Martyn Smith7d900952006-03-27 15:51:42 +12001775 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001776
1777 $log->debug("Checked-in $dirpart : $filename");
1778
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001779 print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
Martin Langhoff34865952007-01-09 15:10:41 +13001780 if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001781 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001782 print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001783 print "Remove-entry $dirpart\n";
1784 print "$filename\n";
1785 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001786 if ($meta->{revision} eq "1.1") {
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001787 print "M initial revision: 1.1\n";
1788 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001789 print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001790 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001791 print "Checked-in $dirpart\n";
1792 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001793 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001794 print "/$filepart/$meta->{revision}//$kopts/" .
1795 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001796 }
1797 }
1798
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001799 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001800 print "ok\n";
1801}
1802
1803sub req_status
1804{
1805 my ( $cmd, $data ) = @_;
1806
1807 argsplit("status");
1808
1809 $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1810 #$log->debug("status state : " . Dumper($state));
1811
1812 # Grab a handle to the SQLite db and do any necessary updates
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001813 my $updater;
1814 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001815 $updater->update();
1816
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001817 # if no files were specified, we need to work out what files we should
1818 # be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12001819 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001820
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001821 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001822 foreach my $filename ( @{$state->{args}} )
1823 {
1824 $filename = filecleanup($filename);
1825
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001826 if ( exists($state->{opt}{l}) &&
1827 index($filename, '/', length($state->{prependdir})) >= 0 )
1828 {
1829 next;
1830 }
Damien Diederen852b9212008-03-27 23:17:53 +01001831
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001832 my $wrev = revparse($filename);
1833
Matthew Ogilvie61717662012-10-13 23:42:31 -06001834 my $stickyInfo = resolveStickyInfo($filename);
1835 my $meta = $updater->getmeta($filename,$stickyInfo);
1836 my $oldmeta = $meta;
1837
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001838 # If the working copy is an old revision, lets get that
1839 # version too for comparison.
Matthew Ogilvieab076812012-10-13 23:42:21 -06001840 if ( defined($wrev) and $wrev ne $meta->{revision} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001841 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001842 my($rmRev)=$wrev;
1843 $rmRev=~s/^-//;
1844 $oldmeta = $updater->getmeta($filename, $rmRev);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001845 }
1846
1847 # TODO : All possible statuses aren't yet implemented
1848 my $status;
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001849 # Files are up to date if the working copy and repo copy have
1850 # the same revision, and the working copy is unmodified
1851 if ( defined ( $wrev ) and defined($meta->{revision}) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001852 $wrev eq $meta->{revision} and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001853 ( ( $state->{entries}{$filename}{unchanged} and
1854 ( not defined ( $state->{entries}{$filename}{conflict} ) or
1855 $state->{entries}{$filename}{conflict} !~ /^\+=/ ) ) or
1856 ( defined($state->{entries}{$filename}{modified_hash}) and
1857 $state->{entries}{$filename}{modified_hash} eq
Matthew Ogilvieab076812012-10-13 23:42:21 -06001858 $meta->{filehash} ) ) )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001859 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001860 $status = "Up-to-date"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001861 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001862
Matthew Ogilvieab076812012-10-13 23:42:21 -06001863 # Need checkout if the working copy has a different (usually
1864 # older) revision than the repo copy, and the working copy is
1865 # unmodified
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001866 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001867 $meta->{revision} ne $wrev and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001868 ( $state->{entries}{$filename}{unchanged} or
1869 ( defined($state->{entries}{$filename}{modified_hash}) and
1870 $state->{entries}{$filename}{modified_hash} eq
1871 $oldmeta->{filehash} ) ) )
1872 {
1873 $status ||= "Needs Checkout";
1874 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001875
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001876 # Need checkout if it exists in the repo but doesn't have a working
1877 # copy
1878 if ( not defined ( $wrev ) and defined ( $meta->{revision} ) )
1879 {
1880 $status ||= "Needs Checkout";
1881 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001882
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001883 # Locally modified if working copy and repo copy have the
1884 # same revision but there are local changes
1885 if ( defined ( $wrev ) and defined($meta->{revision}) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001886 $wrev eq $meta->{revision} and
Matthew Ogilvie61717662012-10-13 23:42:31 -06001887 $wrev ne "0" and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001888 $state->{entries}{$filename}{modified_filename} )
1889 {
1890 $status ||= "Locally Modified";
1891 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001892
Matthew Ogilvieab076812012-10-13 23:42:21 -06001893 # Needs Merge if working copy revision is different
1894 # (usually older) than repo copy and there are local changes
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001895 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001896 $meta->{revision} ne $wrev and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001897 $state->{entries}{$filename}{modified_filename} )
1898 {
1899 $status ||= "Needs Merge";
1900 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001901
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001902 if ( defined ( $state->{entries}{$filename}{revision} ) and
Matthew Ogilvie61717662012-10-13 23:42:31 -06001903 ( !defined($meta->{revision}) ||
1904 $meta->{revision} eq "0" ) )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001905 {
1906 $status ||= "Locally Added";
1907 }
1908 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001909 $wrev eq "-$meta->{revision}" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001910 {
1911 $status ||= "Locally Removed";
1912 }
1913 if ( defined ( $state->{entries}{$filename}{conflict} ) and
1914 $state->{entries}{$filename}{conflict} =~ /^\+=/ )
1915 {
1916 $status ||= "Unresolved Conflict";
1917 }
1918 if ( 0 )
1919 {
1920 $status ||= "File had conflicts on merge";
1921 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001922
1923 $status ||= "Unknown";
1924
Damien Diederen23b71802008-03-27 23:17:42 +01001925 my ($filepart) = filenamesplit($filename);
1926
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001927 print "M =======" . ( "=" x 60 ) . "\n";
Damien Diederen23b71802008-03-27 23:17:42 +01001928 print "M File: $filepart\tStatus: $status\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001929 if ( defined($state->{entries}{$filename}{revision}) )
1930 {
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001931 print "M Working revision:\t" .
1932 $state->{entries}{$filename}{revision} . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001933 } else {
1934 print "M Working revision:\tNo entry for $filename\n";
1935 }
1936 if ( defined($meta->{revision}) )
1937 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001938 print "M Repository revision:\t" .
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001939 $meta->{revision} .
1940 "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
Matthew Ogilvieabd66f22012-10-13 23:42:23 -06001941 my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
1942 my($tag)=($tagOrDate=~m/^T(.+)$/);
1943 if( !defined($tag) )
1944 {
1945 $tag="(none)";
1946 }
1947 print "M Sticky Tag:\t\t$tag\n";
1948 my($date)=($tagOrDate=~m/^D(.+)$/);
1949 if( !defined($date) )
1950 {
1951 $date="(none)";
1952 }
1953 print "M Sticky Date:\t\t$date\n";
1954 my($options)=$state->{entries}{$filename}{options};
1955 if( $options eq "" )
1956 {
1957 $options="(none)";
1958 }
1959 print "M Sticky Options:\t\t$options\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001960 } else {
1961 print "M Repository revision:\tNo revision control file\n";
1962 }
1963 print "M\n";
1964 }
1965
1966 print "ok\n";
1967}
1968
1969sub req_diff
1970{
1971 my ( $cmd, $data ) = @_;
1972
1973 argsplit("diff");
1974
1975 $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1976 #$log->debug("status state : " . Dumper($state));
1977
1978 my ($revision1, $revision2);
1979 if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1980 {
1981 $revision1 = $state->{opt}{r}[0];
1982 $revision2 = $state->{opt}{r}[1];
1983 } else {
1984 $revision1 = $state->{opt}{r};
1985 }
1986
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001987 $log->debug("Diffing revisions " .
1988 ( defined($revision1) ? $revision1 : "[NULL]" ) .
1989 " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001990
1991 # Grab a handle to the SQLite db and do any necessary updates
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001992 my $updater;
1993 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001994 $updater->update();
1995
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001996 # if no files were specified, we need to work out what files we should
1997 # be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12001998 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001999
Matthew Ogilvie61717662012-10-13 23:42:31 -06002000 my($foundDiff);
2001
Pavel Roskinaddf88e2006-07-09 03:44:30 -04002002 # foreach file specified on the command line ...
Matthew Ogilvie61717662012-10-13 23:42:31 -06002003 foreach my $argFilename ( @{$state->{args}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002004 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002005 my($filename) = filecleanup($argFilename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002006
2007 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
2008
2009 my $wrev = revparse($filename);
2010
Matthew Ogilvie61717662012-10-13 23:42:31 -06002011 # Priority for revision1:
2012 # 1. First -r (missing file: check -N)
2013 # 2. wrev from client's Entry line
2014 # - missing line/file: check -N
2015 # - "0": added file not committed (empty contents for rev1)
2016 # - Prefixed with dash (to be removed): check -N
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002017
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002018 if ( defined ( $revision1 ) )
2019 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002020 $meta1 = $updater->getmeta($filename, $revision1);
Matthew Ogilvie61717662012-10-13 23:42:31 -06002021 }
2022 elsif( defined($wrev) && $wrev ne "0" )
2023 {
2024 my($rmRev)=$wrev;
2025 $rmRev=~s/^-//;
2026 $meta1 = $updater->getmeta($filename, $rmRev);
2027 }
2028 if ( !defined($meta1) ||
2029 $meta1->{filehash} eq "deleted" )
2030 {
2031 if( !exists($state->{opt}{N}) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002032 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002033 if(!defined($revision1))
2034 {
2035 print "E File $filename at revision $revision1 doesn't exist\n";
2036 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002037 next;
2038 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002039 elsif( !defined($meta1) )
2040 {
2041 $meta1 = {
2042 name => $filename,
2043 revision => '0',
2044 filehash => 'deleted'
2045 };
2046 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002047 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002048
2049 # Priority for revision2:
2050 # 1. Second -r (missing file: check -N)
2051 # 2. Modified file contents from client
2052 # 3. wrev from client's Entry line
2053 # - missing line/file: check -N
2054 # - Prefixed with dash (to be removed): check -N
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002055
2056 # if we have a second -r switch, use it too
2057 if ( defined ( $revision2 ) )
2058 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002059 $meta2 = $updater->getmeta($filename, $revision2);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002060 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002061 elsif(defined($state->{entries}{$filename}{modified_filename}))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002062 {
2063 $file2 = $state->{entries}{$filename}{modified_filename};
Matthew Ogilvie61717662012-10-13 23:42:31 -06002064 $meta2 = {
2065 name => $filename,
2066 revision => '0',
2067 filehash => 'modified'
2068 };
2069 }
2070 elsif( defined($wrev) && ($wrev!~/^-/) )
2071 {
2072 if(!defined($revision1)) # no revision and no modifications:
2073 {
2074 next;
2075 }
2076 $meta2 = $updater->getmeta($filename, $wrev);
2077 }
2078 if(!defined($file2))
2079 {
2080 if ( !defined($meta2) ||
2081 $meta2->{filehash} eq "deleted" )
2082 {
2083 if( !exists($state->{opt}{N}) )
2084 {
2085 if(!defined($revision2))
2086 {
2087 print "E File $filename at revision $revision2 doesn't exist\n";
2088 }
2089 next;
2090 }
2091 elsif( !defined($meta2) )
2092 {
2093 $meta2 = {
2094 name => $filename,
2095 revision => '0',
2096 filehash => 'deleted'
2097 };
2098 }
2099 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002100 }
2101
Matthew Ogilvie61717662012-10-13 23:42:31 -06002102 if( $meta1->{filehash} eq $meta2->{filehash} )
2103 {
2104 $log->info("unchanged $filename");
2105 next;
2106 }
2107
2108 # Retrieve revision contents:
2109 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2110 transmitfile($meta1->{filehash}, { targetfile => $file1 });
2111
2112 if(!defined($file2))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002113 {
2114 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
Damien Diederene78f69a2008-03-27 23:18:12 +01002115 transmitfile($meta2->{filehash}, { targetfile => $file2 });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002116 }
2117
Matthew Ogilvie61717662012-10-13 23:42:31 -06002118 # Generate the actual diff:
2119 print "M Index: $argFilename\n";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002120 print "M =======" . ( "=" x 60 ) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002121 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
Matthew Ogilvie61717662012-10-13 23:42:31 -06002122 if ( defined ( $meta1 ) && $meta1->{revision} ne "0" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002123 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002124 print "M retrieving revision $meta1->{revision}\n"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002125 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002126 if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002127 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002128 print "M retrieving revision $meta2->{revision}\n"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002129 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002130 print "M diff ";
Anders Kaseorg94629532013-10-30 04:44:43 -04002131 foreach my $opt ( sort keys %{$state->{opt}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002132 {
2133 if ( ref $state->{opt}{$opt} eq "ARRAY" )
2134 {
2135 foreach my $value ( @{$state->{opt}{$opt}} )
2136 {
2137 print "-$opt $value ";
2138 }
2139 } else {
2140 print "-$opt ";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002141 if ( defined ( $state->{opt}{$opt} ) )
2142 {
2143 print "$state->{opt}{$opt} "
2144 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002145 }
2146 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002147 print "$argFilename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002148
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002149 $log->info("Diffing $filename -r $meta1->{revision} -r " .
2150 ( $meta2->{revision} or "workingcopy" ));
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002151
Matthew Ogilvie61717662012-10-13 23:42:31 -06002152 # TODO: Use --label instead of -L because -L is no longer
Andrei Rybakabcb66c2021-06-11 13:18:50 +02002153 # documented and may go away someday. Not sure if there are
Matthew Ogilvie61717662012-10-13 23:42:31 -06002154 # versions that only support -L, which would make this change risky?
2155 # http://osdir.com/ml/bug-gnu-utils-gnu/2010-12/msg00060.html
2156 # ("man diff" should actually document the best migration strategy,
2157 # [current behavior, future changes, old compatibility issues
2158 # or lack thereof, etc], not just stop mentioning the option...)
2159 # TODO: Real CVS seems to include a date in the label, before
2160 # the revision part, without the keyword "revision". The following
2161 # has minimal changes compared to original versions of
2162 # git-cvsserver.perl. (Mostly tab vs space after filename.)
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002163
Matthew Ogilvie61717662012-10-13 23:42:31 -06002164 my (@diffCmd) = ( 'diff' );
2165 if ( exists($state->{opt}{N}) )
2166 {
2167 push @diffCmd,"-N";
2168 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002169 if ( exists $state->{opt}{u} )
2170 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002171 push @diffCmd,("-u","-L");
2172 if( $meta1->{filehash} eq "deleted" )
2173 {
2174 push @diffCmd,"/dev/null";
2175 } else {
2176 push @diffCmd,("$argFilename\trevision $meta1->{revision}");
2177 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002178
Matthew Ogilvie61717662012-10-13 23:42:31 -06002179 if( defined($meta2->{filehash}) )
2180 {
2181 if( $meta2->{filehash} eq "deleted" )
2182 {
2183 push @diffCmd,("-L","/dev/null");
2184 } else {
2185 push @diffCmd,("-L",
2186 "$argFilename\trevision $meta2->{revision}");
2187 }
2188 } else {
2189 push @diffCmd,("-L","$argFilename\tworking copy");
2190 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002191 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002192 push @diffCmd,($file1,$file2);
2193 if(!open(DIFF,"-|",@diffCmd))
2194 {
2195 $log->warn("Unable to run diff: $!");
2196 }
2197 my($diffLine);
2198 while(defined($diffLine=<DIFF>))
2199 {
2200 print "M $diffLine";
2201 $foundDiff=1;
2202 }
2203 close(DIFF);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002204 }
2205
Matthew Ogilvie61717662012-10-13 23:42:31 -06002206 if($foundDiff)
2207 {
2208 print "error \n";
2209 }
2210 else
2211 {
2212 print "ok\n";
2213 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002214}
2215
2216sub req_log
2217{
2218 my ( $cmd, $data ) = @_;
2219
2220 argsplit("log");
2221
2222 $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
2223 #$log->debug("log state : " . Dumper($state));
2224
Matthew Ogilvieab076812012-10-13 23:42:21 -06002225 my ( $revFilter );
2226 if ( defined ( $state->{opt}{r} ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002227 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002228 $revFilter = $state->{opt}{r};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002229 }
2230
2231 # Grab a handle to the SQLite db and do any necessary updates
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002232 my $updater;
2233 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002234 $updater->update();
2235
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002236 # if no files were specified, we need to work out what files we
2237 # should be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12002238 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002239
Pavel Roskinaddf88e2006-07-09 03:44:30 -04002240 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002241 foreach my $filename ( @{$state->{args}} )
2242 {
2243 $filename = filecleanup($filename);
2244
2245 my $headmeta = $updater->getmeta($filename);
2246
Matthew Ogilvieab076812012-10-13 23:42:21 -06002247 my ($revisions,$totalrevisions) = $updater->getlog($filename,
2248 $revFilter);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002249
2250 next unless ( scalar(@$revisions) );
2251
2252 print "M \n";
2253 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
2254 print "M Working file: $filename\n";
Matthew Ogilvieab076812012-10-13 23:42:21 -06002255 print "M head: $headmeta->{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002256 print "M branch:\n";
2257 print "M locks: strict\n";
2258 print "M access list:\n";
2259 print "M symbolic names:\n";
2260 print "M keyword substitution: kv\n";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002261 print "M total revisions: $totalrevisions;\tselected revisions: " .
2262 scalar(@$revisions) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002263 print "M description:\n";
2264
2265 foreach my $revision ( @$revisions )
2266 {
2267 print "M ----------------------------\n";
Matthew Ogilvieab076812012-10-13 23:42:21 -06002268 print "M revision $revision->{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002269 # reformat the date for log output
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002270 if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and
2271 defined($DATE_LIST->{$2}) )
2272 {
2273 $revision->{modified} = sprintf('%04d/%02d/%02d %s',
2274 $3, $DATE_LIST->{$2}, $1, $4 );
2275 }
Damien Diederenc1bc3062008-03-27 23:18:35 +01002276 $revision->{author} = cvs_author($revision->{author});
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002277 print "M date: $revision->{modified};" .
2278 " author: $revision->{author}; state: " .
2279 ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) .
2280 "; lines: +2 -3\n";
2281 my $commitmessage;
2282 $commitmessage = $updater->commitmessage($revision->{commithash});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002283 $commitmessage =~ s/^/M /mg;
2284 print $commitmessage . "\n";
2285 }
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002286 print "M =======" . ( "=" x 70 ) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002287 }
2288
2289 print "ok\n";
2290}
2291
2292sub req_annotate
2293{
2294 my ( $cmd, $data ) = @_;
2295
2296 argsplit("annotate");
2297
2298 $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
2299 #$log->debug("status state : " . Dumper($state));
2300
2301 # Grab a handle to the SQLite db and do any necessary updates
2302 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
2303 $updater->update();
2304
2305 # 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 +12002306 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002307
2308 # we'll need a temporary checkout dir
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002309 setupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002310
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002311 $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 +13002312
Pavel Roskinaddf88e2006-07-09 03:44:30 -04002313 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002314 foreach my $filename ( @{$state->{args}} )
2315 {
2316 $filename = filecleanup($filename);
2317
2318 my $meta = $updater->getmeta($filename);
2319
2320 next unless ( $meta->{revision} );
2321
2322 # get all the commits that this file was in
2323 # in dense format -- aka skip dead revisions
2324 my $revisions = $updater->gethistorydense($filename);
2325 my $lastseenin = $revisions->[0][2];
2326
2327 # populate the temporary index based on the latest commit were we saw
2328 # the file -- but do it cheaply without checking out any files
2329 # TODO: if we got a revision from the client, use that instead
2330 # to look up the commithash in sqlite (still good to default to
2331 # the current head as we do now)
Gerrit Paped2feb012009-09-02 09:23:10 +00002332 system("git", "read-tree", $lastseenin);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002333 unless ($? == 0)
2334 {
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002335 print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002336 return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002337 }
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002338 $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002339
2340 # do a checkout of the file
Gerrit Paped2feb012009-09-02 09:23:10 +00002341 system('git', 'checkout-index', '-f', '-u', $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002342 unless ($? == 0) {
Jim Meyeringa5e40792007-07-14 20:48:42 +02002343 print "E error running git-checkout-index -f -u $filename : $!\n";
2344 return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002345 }
2346
2347 $log->info("Annotate $filename");
2348
2349 # Prepare a file with the commits from the linearized
2350 # history that annotate should know about. This prevents
2351 # git-jsannotate telling us about commits we are hiding
2352 # from the client.
2353
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002354 my $a_hints = "$work->{workDir}/.annotate_hints";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002355 if (!open(ANNOTATEHINTS, '>', $a_hints)) {
2356 print "E failed to open '$a_hints' for writing: $!\n";
2357 return;
2358 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002359 for (my $i=0; $i < @$revisions; $i++)
2360 {
2361 print ANNOTATEHINTS $revisions->[$i][2];
2362 if ($i+1 < @$revisions) { # have we got a parent?
2363 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
2364 }
2365 print ANNOTATEHINTS "\n";
2366 }
2367
2368 print ANNOTATEHINTS "\n";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002369 close ANNOTATEHINTS
2370 or (print "E failed to write $a_hints: $!\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002371
Gerrit Paped2feb012009-09-02 09:23:10 +00002372 my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
Jim Meyeringa5e40792007-07-14 20:48:42 +02002373 if (!open(ANNOTATE, "-|", @cmd)) {
2374 print "E error invoking ". join(' ',@cmd) .": $!\n";
2375 return;
2376 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002377 my $metadata = {};
2378 print "E Annotations for $filename\n";
2379 print "E ***************\n";
2380 while ( <ANNOTATE> )
2381 {
brian m. carlson05ea93d2020-06-22 18:04:16 +00002382 if (m/^([a-zA-Z0-9]{$state->{hexsz}})\t\([^\)]*\)(.*)$/i)
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002383 {
2384 my $commithash = $1;
2385 my $data = $2;
2386 unless ( defined ( $metadata->{$commithash} ) )
2387 {
2388 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
Damien Diederenc1bc3062008-03-27 23:18:35 +01002389 $metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002390 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
2391 }
Matthew Ogilvieab076812012-10-13 23:42:21 -06002392 printf("M %-7s (%-8s %10s): %s\n",
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002393 $metadata->{$commithash}{revision},
2394 $metadata->{$commithash}{author},
2395 $metadata->{$commithash}{modified},
2396 $data
2397 );
2398 } else {
2399 $log->warn("Error in annotate output! LINE: $_");
2400 print "E Annotate error \n";
2401 next;
2402 }
2403 }
2404 close ANNOTATE;
2405 }
2406
2407 # done; get out of the tempdir
Lars Noschinskidf4b3ab2008-07-16 13:35:46 +02002408 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002409
2410 print "ok\n";
2411
2412}
2413
2414# This method takes the state->{arguments} array and produces two new arrays.
2415# The first is $state->{args} which is everything before the '--' argument, and
2416# the second is $state->{files} which is everything after it.
2417sub argsplit
2418{
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002419 $state->{args} = [];
2420 $state->{files} = [];
2421 $state->{opt} = {};
2422
Frank Lichtenheld1e76b702007-06-17 10:31:02 +02002423 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
2424
2425 my $type = shift;
2426
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002427 if ( defined($type) )
2428 {
2429 my $opt = {};
2430 $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" );
2431 $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
2432 $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 -06002433 $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 +13002434 $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
2435 $opt = { k => 1, m => 1 } if ( $type eq "add" );
2436 $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
2437 $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" );
2438
2439
2440 while ( scalar ( @{$state->{arguments}} ) > 0 )
2441 {
2442 my $arg = shift @{$state->{arguments}};
2443
2444 next if ( $arg eq "--" );
2445 next unless ( $arg =~ /\S/ );
2446
2447 # if the argument looks like a switch
2448 if ( $arg =~ /^-(\w)(.*)/ )
2449 {
2450 # if it's a switch that takes an argument
2451 if ( $opt->{$1} )
2452 {
2453 # If this switch has already been provided
2454 if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
2455 {
2456 $state->{opt}{$1} = [ $state->{opt}{$1} ];
2457 if ( length($2) > 0 )
2458 {
2459 push @{$state->{opt}{$1}},$2;
2460 } else {
2461 push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
2462 }
2463 } else {
2464 # if there's extra data in the arg, use that as the argument for the switch
2465 if ( length($2) > 0 )
2466 {
2467 $state->{opt}{$1} = $2;
2468 } else {
2469 $state->{opt}{$1} = shift @{$state->{arguments}};
2470 }
2471 }
2472 } else {
2473 $state->{opt}{$1} = undef;
2474 }
2475 }
2476 else
2477 {
2478 push @{$state->{args}}, $arg;
2479 }
2480 }
2481 }
2482 else
2483 {
2484 my $mode = 0;
2485
2486 foreach my $value ( @{$state->{arguments}} )
2487 {
2488 if ( $value eq "--" )
2489 {
2490 $mode++;
2491 next;
2492 }
2493 push @{$state->{args}}, $value if ( $mode == 0 );
2494 push @{$state->{files}}, $value if ( $mode == 1 );
2495 }
2496 }
2497}
2498
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002499# Used by argsfromdir
2500sub expandArg
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002501{
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002502 my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002503
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002504 my $fullPath = filecleanup($path);
Martyn Smith7d900952006-03-27 15:51:42 +12002505
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002506 # Is it a directory?
2507 if( defined($state->{dirMap}{$fullPath}) ||
2508 defined($state->{dirMap}{"$fullPath/"}) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002509 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002510 # It is a directory in the user's sandbox.
2511 $isDir=1;
Martyn Smith82000d72006-03-28 13:24:27 +12002512
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002513 if(defined($state->{entries}{$fullPath}))
Martyn Smith82000d72006-03-28 13:24:27 +12002514 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002515 $log->fatal("Inconsistent file/dir type");
2516 die "Inconsistent file/dir type";
2517 }
2518 }
2519 elsif(defined($state->{entries}{$fullPath}))
2520 {
2521 # It is a file in the user's sandbox.
2522 $isDir=0;
2523 }
2524 my($revDirMap,$otherRevDirMap);
2525 if(!defined($isDir) || $isDir)
2526 {
2527 # Resolve version tree for sticky tag:
2528 # (for now we only want list of files for the version, not
2529 # particular versions of those files: assume it is a directory
2530 # for the moment; ignore Entry's stick tag)
2531
2532 # Order of precedence of sticky tags:
2533 # -A [head]
2534 # -r /tag/
2535 # [file entry sticky tag, but that is only relevant to files]
2536 # [the tag specified in dir req_Sticky]
2537 # [the tag specified in a parent dir req_Sticky]
2538 # [head]
2539 # Also, -r may appear twice (for diff).
2540 #
2541 # FUTURE: When/if -j (merges) are supported, we also
2542 # need to add relevant files from one or two
2543 # versions specified with -j.
2544
2545 if(exists($state->{opt}{A}))
2546 {
2547 $revDirMap=$updater->getRevisionDirMap();
2548 }
2549 elsif( defined($state->{opt}{r}) and
2550 ref $state->{opt}{r} eq "ARRAY" )
2551 {
2552 $revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
2553 $otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
2554 }
2555 elsif(defined($state->{opt}{r}))
2556 {
2557 $revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
2558 }
2559 else
2560 {
2561 my($sticky)=getDirStickyInfo($fullPath);
2562 $revDirMap=$updater->getRevisionDirMap($sticky->{tag});
Martyn Smith82000d72006-03-28 13:24:27 +12002563 }
2564
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002565 # Is it a directory?
2566 if( defined($revDirMap->{$fullPath}) ||
2567 defined($otherRevDirMap->{$fullPath}) )
Martyn Smith82000d72006-03-28 13:24:27 +12002568 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002569 $isDir=1;
2570 }
2571 }
2572
2573 # What to do with it?
2574 if(!$isDir)
2575 {
2576 $outNameMap->{$fullPath}=1;
2577 }
2578 else
2579 {
2580 $outDirMap->{$fullPath}=1;
2581
2582 if(defined($revDirMap->{$fullPath}))
2583 {
2584 addDirMapFiles($updater,$outNameMap,$outDirMap,
2585 $revDirMap->{$fullPath});
2586 }
2587 if( defined($otherRevDirMap) &&
2588 defined($otherRevDirMap->{$fullPath}) )
2589 {
2590 addDirMapFiles($updater,$outNameMap,$outDirMap,
2591 $otherRevDirMap->{$fullPath});
Martyn Smith82000d72006-03-28 13:24:27 +12002592 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002593 }
2594}
2595
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002596# Used by argsfromdir
2597# Add entries from dirMap to outNameMap. Also recurse into entries
2598# that are subdirectories.
2599sub addDirMapFiles
2600{
2601 my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
2602
2603 my($fullName);
2604 foreach $fullName (keys(%$dirMap))
2605 {
2606 my $cleanName=$fullName;
2607 if(defined($state->{prependdir}))
2608 {
2609 if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
2610 {
2611 $log->fatal("internal error stripping prependdir");
2612 die "internal error stripping prependdir";
2613 }
2614 }
2615
2616 if($dirMap->{$fullName} eq "F")
2617 {
2618 $outNameMap->{$cleanName}=1;
2619 }
2620 elsif($dirMap->{$fullName} eq "D")
2621 {
2622 if(!$state->{opt}{l})
2623 {
2624 expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
2625 }
2626 }
2627 else
2628 {
2629 $log->fatal("internal error in addDirMapFiles");
2630 die "internal error in addDirMapFiles";
2631 }
2632 }
2633}
2634
2635# This method replaces $state->{args} with a directory-expanded
2636# list of all relevant filenames (recursively unless -d), based
2637# on $state->{entries}, and the "current" list of files in
2638# each directory. "Current" files as determined by
2639# either the requested (-r/-A) or "req_Sticky" version of
2640# that directory.
2641# Both the input args and the new output args are relative
2642# to the cvs-client's CWD, although some of the internal
2643# computations are relative to the top of the project.
2644sub argsfromdir
2645{
2646 my $updater = shift;
2647
2648 # Notes about requirements for specific callers:
2649 # update # "standard" case (entries; a single -r/-A/default; -l)
2650 # # Special case: -d for create missing directories.
2651 # diff # 0 or 1 -r's: "standard" case.
2652 # # 2 -r's: We could ignore entries (just use the two -r's),
2653 # # but it doesn't really matter.
2654 # annotate # "standard" case
2655 # log # Punting: log -r has a more complex non-"standard"
2656 # # meaning, and we don't currently try to support log'ing
2657 # # branches at all (need a lot of work to
2658 # # support CVS-consistent branch relative version
2659 # # numbering).
2660#HERE: But we still want to expand directories. Maybe we should
2661# essentially force "-A".
2662 # status # "standard", except that -r/-A/default are not possible.
2663 # # Mostly only used to expand entries only)
2664 #
2665 # Don't use argsfromdir at all:
2666 # add # Explicit arguments required. Directory args imply add
2667 # # the directory itself, not the files in it.
2668 # co # Obtain list directly.
2669 # remove # HERE: TEST: MAYBE client does the recursion for us,
2670 # # since it only makes sense to remove stuff already in
GyuYong Jung527d4a62016-02-17 11:14:58 +09002671 # # the sandbox?
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002672 # ci # HERE: Similar to remove...
2673 # # Don't try to implement the confusing/weird
2674 # # ci -r bug er.."feature".
2675
2676 if(scalar(@{$state->{args}})==0)
2677 {
2678 $state->{args} = [ "." ];
2679 }
2680 my %allArgs;
2681 my %allDirs;
2682 for my $file (@{$state->{args}})
2683 {
2684 expandArg($updater,\%allArgs,\%allDirs,$file);
2685 }
2686
2687 # Include any entries from sandbox. Generally client won't
2688 # send entries that shouldn't be used.
2689 foreach my $file (keys %{$state->{entries}})
2690 {
2691 $allArgs{remove_prependdir($file)} = 1;
2692 }
2693
2694 $state->{dirArgs} = \%allDirs;
2695 $state->{args} = [
2696 sort {
2697 # Sort priority: by directory depth, then actual file name:
2698 my @piecesA=split('/',$a);
2699 my @piecesB=split('/',$b);
2700
2701 my $count=scalar(@piecesA);
2702 my $tmp=scalar(@piecesB);
2703 return $count<=>$tmp if($count!=$tmp);
2704
2705 for($tmp=0;$tmp<$count;$tmp++)
2706 {
2707 if($piecesA[$tmp] ne $piecesB[$tmp])
2708 {
2709 return $piecesA[$tmp] cmp $piecesB[$tmp]
2710 }
2711 }
2712 return 0;
2713 } keys(%allArgs) ];
2714}
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -06002715
2716## look up directory sticky tag, of either fullPath or a parent:
2717sub getDirStickyInfo
2718{
2719 my($fullPath)=@_;
2720
2721 $fullPath=~s%/+$%%;
2722 while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
2723 {
2724 $fullPath=~s%/?[^/]*$%%;
2725 }
2726
2727 if( !defined($state->{dirMap}{"$fullPath/"}) &&
2728 ( $fullPath eq "" ||
2729 $fullPath eq "." ) )
2730 {
2731 return $state->{dirMap}{""}{stickyInfo};
2732 }
2733 else
2734 {
2735 return $state->{dirMap}{"$fullPath/"}{stickyInfo};
2736 }
2737}
2738
2739# Resolve precedence of various ways of specifying which version of
2740# a file you want. Returns undef (for default head), or a ref to a hash
2741# that contains "tag" and/or "date" keys.
2742sub resolveStickyInfo
2743{
2744 my($filename,$stickyTag,$stickyDate,$reset) = @_;
2745
2746 # Order of precedence of sticky tags:
2747 # -A [head]
2748 # -r /tag/
2749 # [file entry sticky tag]
2750 # [the tag specified in dir req_Sticky]
2751 # [the tag specified in a parent dir req_Sticky]
2752 # [head]
2753
2754 my $result;
2755 if($reset)
2756 {
2757 # $result=undef;
2758 }
2759 elsif( defined($stickyTag) && $stickyTag ne "" )
2760 # || ( defined($stickyDate) && $stickyDate ne "" ) # TODO
2761 {
2762 $result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
2763
2764 # TODO: Convert -D value into the form 2011.04.10.04.46.57,
2765 # similar to an entry line's sticky date, without the D prefix.
2766 # It sometimes (always?) arrives as something more like
2767 # '10 Apr 2011 04:46:57 -0000'...
2768 # $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
2769 }
2770 elsif( defined($state->{entries}{$filename}) &&
2771 defined($state->{entries}{$filename}{tag_or_date}) &&
2772 $state->{entries}{$filename}{tag_or_date} ne "" )
2773 {
2774 my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
2775 if($tagOrDate=~/^T([^ ]+)\s*$/)
2776 {
2777 $result = { 'tag' => $1 };
2778 }
2779 elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
2780 {
2781 $result= { 'date' => $1 };
2782 }
2783 else
2784 {
2785 die "Unknown tag_or_date format\n";
2786 }
2787 }
2788 else
2789 {
2790 $result=getDirStickyInfo($filename);
2791 }
2792
2793 return $result;
2794}
2795
2796# Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into
2797# a form appropriate for the sticky tag field of an Entries
2798# line (field index 5, 0-based).
2799sub getStickyTagOrDate
2800{
2801 my($stickyInfo)=@_;
2802
2803 my $result;
2804 if(defined($stickyInfo) && defined($stickyInfo->{tag}))
2805 {
2806 $result="T$stickyInfo->{tag}";
2807 }
2808 # TODO: When/if we actually pick versions by {date} properly,
2809 # also handle it here:
2810 # "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").
2811 else
2812 {
2813 $result="";
2814 }
2815
2816 return $result;
2817}
2818
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002819# This method cleans up the $state variable after a command that uses arguments has run
2820sub statecleanup
2821{
2822 $state->{files} = [];
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002823 $state->{dirArgs} = {};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002824 $state->{args} = [];
2825 $state->{arguments} = [];
2826 $state->{entries} = {};
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -06002827 $state->{dirMap} = {};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002828}
2829
Matthew Ogilvieab076812012-10-13 23:42:21 -06002830# Return working directory CVS revision "1.X" out
Li Peng832c0e52016-05-06 20:36:46 +08002831# of the working directory "entries" state, for the given filename.
Matthew Ogilvieab076812012-10-13 23:42:21 -06002832# This is prefixed with a dash if the file is scheduled for removal
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06002833# when it is committed.
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002834sub revparse
2835{
2836 my $filename = shift;
2837
Matthew Ogilvieab076812012-10-13 23:42:21 -06002838 return $state->{entries}{$filename}{revision};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002839}
2840
Damien Diederene78f69a2008-03-27 23:18:12 +01002841# This method takes a file hash and does a CVS "file transfer". Its
2842# exact behaviour depends on a second, optional hash table argument:
2843# - If $options->{targetfile}, dump the contents to that file;
2844# - If $options->{print}, use M/MT to transmit the contents one line
2845# at a time;
2846# - Otherwise, transmit the size of the file, followed by the file
2847# contents.
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002848sub transmitfile
2849{
2850 my $filehash = shift;
Damien Diederene78f69a2008-03-27 23:18:12 +01002851 my $options = shift;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002852
2853 if ( defined ( $filehash ) and $filehash eq "deleted" )
2854 {
2855 $log->warn("filehash is 'deleted'");
2856 return;
2857 }
2858
brian m. carlson05ea93d2020-06-22 18:04:16 +00002859 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002860
joernchen27dd7382017-09-11 14:45:09 +09002861 my $type = safe_pipe_capture('git', 'cat-file', '-t', $filehash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002862 chomp $type;
2863
2864 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2865
joernchen27dd7382017-09-11 14:45:09 +09002866 my $size = safe_pipe_capture('git', 'cat-file', '-s', $filehash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002867 chomp $size;
2868
2869 $log->debug("transmitfile($filehash) size=$size, type=$type");
2870
Gerrit Paped2feb012009-09-02 09:23:10 +00002871 if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002872 {
Damien Diederene78f69a2008-03-27 23:18:12 +01002873 if ( defined ( $options->{targetfile} ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002874 {
Damien Diederene78f69a2008-03-27 23:18:12 +01002875 my $targetfile = $options->{targetfile};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002876 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2877 print NEWFILE $_ while ( <$fh> );
Jim Meyeringa5e40792007-07-14 20:48:42 +02002878 close NEWFILE or die("Failed to write '$targetfile': $!");
Damien Diederene78f69a2008-03-27 23:18:12 +01002879 } elsif ( defined ( $options->{print} ) && $options->{print} ) {
2880 while ( <$fh> ) {
2881 if( /\n\z/ ) {
2882 print 'M ', $_;
2883 } else {
2884 print 'MT text ', $_, "\n";
2885 }
2886 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002887 } else {
2888 print "$size\n";
2889 print while ( <$fh> );
2890 }
Jim Meyeringa5e40792007-07-14 20:48:42 +02002891 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002892 } else {
2893 die("Couldn't execute git-cat-file");
2894 }
2895}
2896
2897# This method takes a file name, and returns ( $dirpart, $filepart ) which
Junio C Hamano5348b6e2006-04-25 23:59:28 -07002898# refers to the directory portion and the file portion of the filename
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002899# respectively
2900sub filenamesplit
2901{
2902 my $filename = shift;
Martyn Smith7d900952006-03-27 15:51:42 +12002903 my $fixforlocaldir = shift;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002904
2905 my ( $filepart, $dirpart ) = ( $filename, "." );
2906 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2907 $dirpart .= "/";
2908
Martyn Smith7d900952006-03-27 15:51:42 +12002909 if ( $fixforlocaldir )
2910 {
2911 $dirpart =~ s/^$state->{prependdir}//;
2912 }
2913
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002914 return ( $filepart, $dirpart );
2915}
2916
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002917# Cleanup various junk in filename (try to canonicalize it), and
Stefano Lattarini41ccfdd2013-04-12 00:36:10 +02002918# add prependdir to accommodate running CVS client from a
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002919# subdirectory (so the output is relative to top directory of the project).
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002920sub filecleanup
2921{
2922 my $filename = shift;
2923
2924 return undef unless(defined($filename));
2925 if ( $filename =~ /^\// )
2926 {
2927 print "E absolute filenames '$filename' not supported by server\n";
2928 return undef;
2929 }
2930
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002931 if($filename eq ".")
2932 {
2933 $filename="";
2934 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002935 $filename =~ s/^\.\///g;
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002936 $filename =~ s%/+%/%g;
Martyn Smith82000d72006-03-28 13:24:27 +12002937 $filename = $state->{prependdir} . $filename;
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002938 $filename =~ s%/$%%;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002939 return $filename;
2940}
2941
Li Peng832c0e52016-05-06 20:36:46 +08002942# Remove prependdir from the path, so that it is relative to the directory
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002943# the CVS client was started from, rather than the top of the project.
2944# Essentially the inverse of filecleanup().
2945sub remove_prependdir
2946{
2947 my($path) = @_;
2948 if(defined($state->{prependdir}) && $state->{prependdir} ne "")
2949 {
2950 my($pre)=$state->{prependdir};
2951 $pre=~s%/$%%;
2952 if(!($path=~s%^\Q$pre\E/?%%))
2953 {
2954 $log->fatal("internal error missing prependdir");
2955 die("internal error missing prependdir");
2956 }
2957 }
2958 return $path;
2959}
2960
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002961sub validateGitDir
2962{
2963 if( !defined($state->{CVSROOT}) )
2964 {
2965 print "error 1 CVSROOT not specified\n";
2966 cleanupWorkTree();
2967 exit;
2968 }
2969 if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
2970 {
2971 print "error 1 Internally inconsistent CVSROOT\n";
2972 cleanupWorkTree();
2973 exit;
2974 }
2975}
2976
2977# Setup working directory in a work tree with the requested version
2978# loaded in the index.
2979sub setupWorkTree
2980{
2981 my ($ver) = @_;
2982
2983 validateGitDir();
2984
2985 if( ( defined($work->{state}) && $work->{state} != 1 ) ||
2986 defined($work->{tmpDir}) )
2987 {
2988 $log->warn("Bad work tree state management");
2989 print "error 1 Internal setup multiple work trees without cleanup\n";
2990 cleanupWorkTree();
2991 exit;
2992 }
2993
2994 $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
2995
2996 if( !defined($work->{index}) )
2997 {
2998 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2999 }
3000
3001 chdir $work->{workDir} or
3002 die "Unable to chdir to $work->{workDir}\n";
3003
3004 $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
3005
3006 $ENV{GIT_WORK_TREE} = ".";
3007 $ENV{GIT_INDEX_FILE} = $work->{index};
3008 $work->{state} = 2;
3009
3010 if($ver)
3011 {
3012 system("git","read-tree",$ver);
3013 unless ($? == 0)
3014 {
3015 $log->warn("Error running git-read-tree");
3016 die "Error running git-read-tree $ver in $work->{workDir} $!\n";
3017 }
3018 }
3019 # else # req_annotate reads tree for each file
3020}
3021
3022# Ensure current directory is in some kind of working directory,
3023# with a recent version loaded in the index.
3024sub ensureWorkTree
3025{
3026 if( defined($work->{tmpDir}) )
3027 {
3028 $log->warn("Bad work tree state management [ensureWorkTree()]");
3029 print "error 1 Internal setup multiple dirs without cleanup\n";
3030 cleanupWorkTree();
3031 exit;
3032 }
3033 if( $work->{state} )
3034 {
3035 return;
3036 }
3037
3038 validateGitDir();
3039
3040 if( !defined($work->{emptyDir}) )
3041 {
3042 $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
3043 }
3044 chdir $work->{emptyDir} or
3045 die "Unable to chdir to $work->{emptyDir}\n";
3046
joernchen27dd7382017-09-11 14:45:09 +09003047 my $ver = safe_pipe_capture('git', 'show-ref', '-s', "refs/heads/$state->{module}");
Matthew Ogilvie044182e2008-05-14 22:35:46 -06003048 chomp $ver;
brian m. carlson05ea93d2020-06-22 18:04:16 +00003049 if ($ver !~ /^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilvie044182e2008-05-14 22:35:46 -06003050 {
3051 $log->warn("Error from git show-ref -s refs/head$state->{module}");
3052 print "error 1 cannot find the current HEAD of module";
3053 cleanupWorkTree();
3054 exit;
3055 }
3056
3057 if( !defined($work->{index}) )
3058 {
3059 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
3060 }
3061
3062 $ENV{GIT_WORK_TREE} = ".";
3063 $ENV{GIT_INDEX_FILE} = $work->{index};
3064 $work->{state} = 1;
3065
3066 system("git","read-tree",$ver);
3067 unless ($? == 0)
3068 {
3069 die "Error running git-read-tree $ver $!\n";
3070 }
3071}
3072
3073# Cleanup working directory that is not needed any longer.
3074sub cleanupWorkTree
3075{
3076 if( ! $work->{state} )
3077 {
3078 return;
3079 }
3080
3081 chdir "/" or die "Unable to chdir '/'\n";
3082
3083 if( defined($work->{workDir}) )
3084 {
3085 rmtree( $work->{workDir} );
3086 undef $work->{workDir};
3087 }
3088 undef $work->{state};
3089}
3090
3091# Setup a temporary directory (not a working tree), typically for
3092# merging dirty state as in req_update.
3093sub setupTmpDir
3094{
3095 $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
3096 chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
3097
3098 return $work->{tmpDir};
3099}
3100
3101# Clean up a previously setupTmpDir. Restore previous work tree if
3102# appropriate.
3103sub cleanupTmpDir
3104{
3105 if ( !defined($work->{tmpDir}) )
3106 {
3107 $log->warn("cleanup tmpdir that has not been setup");
3108 die "Cleanup tmpDir that has not been setup\n";
3109 }
3110 if( defined($work->{state}) )
3111 {
3112 if( $work->{state} == 1 )
3113 {
3114 chdir $work->{emptyDir} or
3115 die "Unable to chdir to $work->{emptyDir}\n";
3116 }
3117 elsif( $work->{state} == 2 )
3118 {
3119 chdir $work->{workDir} or
3120 die "Unable to chdir to $work->{emptyDir}\n";
3121 }
3122 else
3123 {
3124 $log->warn("Inconsistent work dir state");
3125 die "Inconsistent work dir state\n";
3126 }
3127 }
3128 else
3129 {
3130 chdir "/" or die "Unable to chdir '/'\n";
3131 }
3132}
3133
Andy Parkins8538e872007-02-27 13:46:55 +00003134# Given a path, this function returns a string containing the kopts
3135# that should go into that path's Entries line. For example, a binary
3136# file should get -kb.
3137sub kopts_from_path
3138{
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003139 my ($path, $srcType, $name) = @_;
Andy Parkins8538e872007-02-27 13:46:55 +00003140
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003141 if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
3142 $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
3143 {
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003144 my ($val) = check_attr( "text", $path );
3145 if ( $val eq "unspecified" )
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003146 {
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003147 $val = check_attr( "crlf", $path );
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003148 }
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003149 if ( $val eq "unset" )
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003150 {
3151 return "-kb"
3152 }
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003153 elsif ( check_attr( "eol", $path ) ne "unspecified" ||
3154 $val eq "set" || $val eq "input" )
3155 {
3156 return "";
3157 }
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003158 else
3159 {
3160 $log->info("Unrecognized check_attr crlf $path : $val");
3161 }
3162 }
Andy Parkins8538e872007-02-27 13:46:55 +00003163
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003164 if ( defined ( $cfg->{gitcvs}{allbinary} ) )
Andy Parkins8538e872007-02-27 13:46:55 +00003165 {
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003166 if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
3167 {
3168 return "-kb";
3169 }
3170 elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
3171 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003172 if( is_binary($srcType,$name) )
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003173 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003174 $log->debug("... as binary");
3175 return "-kb";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003176 }
3177 else
3178 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003179 $log->debug("... as text");
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003180 }
3181 }
Andy Parkins8538e872007-02-27 13:46:55 +00003182 }
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003183 # Return "" to give no special treatment to any path
3184 return "";
Andy Parkins8538e872007-02-27 13:46:55 +00003185}
3186
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003187sub check_attr
3188{
3189 my ($attr,$path) = @_;
3190 ensureWorkTree();
3191 if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
3192 {
3193 my $val = <$fh>;
3194 close $fh;
3195 $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
3196 return $val;
3197 }
3198 else
3199 {
3200 return undef;
3201 }
3202}
3203
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003204# This should have the same heuristics as convert.c:is_binary() and related.
3205# Note that the bare CR test is done by callers in convert.c.
3206sub is_binary
3207{
3208 my ($srcType,$name) = @_;
3209 $log->debug("is_binary($srcType,$name)");
3210
3211 # Minimize amount of interpreted code run in the inner per-character
3212 # loop for large files, by totalling each character value and
3213 # then analyzing the totals.
3214 my @counts;
3215 my $i;
3216 for($i=0;$i<256;$i++)
3217 {
3218 $counts[$i]=0;
3219 }
3220
3221 my $fh = open_blob_or_die($srcType,$name);
3222 my $line;
3223 while( defined($line=<$fh>) )
3224 {
3225 # Any '\0' and bare CR are considered binary.
3226 if( $line =~ /\0|(\r[^\n])/ )
3227 {
3228 close($fh);
3229 return 1;
3230 }
3231
3232 # Count up each character in the line:
3233 my $len=length($line);
3234 for($i=0;$i<$len;$i++)
3235 {
3236 $counts[ord(substr($line,$i,1))]++;
3237 }
3238 }
3239 close $fh;
3240
3241 # Don't count CR and LF as either printable/nonprintable
3242 $counts[ord("\n")]=0;
3243 $counts[ord("\r")]=0;
3244
3245 # Categorize individual character count into printable and nonprintable:
3246 my $printable=0;
3247 my $nonprintable=0;
3248 for($i=0;$i<256;$i++)
3249 {
3250 if( $i < 32 &&
3251 $i != ord("\b") &&
3252 $i != ord("\t") &&
3253 $i != 033 && # ESC
3254 $i != 014 ) # FF
3255 {
3256 $nonprintable+=$counts[$i];
3257 }
3258 elsif( $i==127 ) # DEL
3259 {
3260 $nonprintable+=$counts[$i];
3261 }
3262 else
3263 {
3264 $printable+=$counts[$i];
3265 }
3266 }
3267
3268 return ($printable >> 7) < $nonprintable;
3269}
3270
3271# Returns open file handle. Possible invocations:
3272# - open_blob_or_die("file",$filename);
3273# - open_blob_or_die("sha1",$filehash);
3274sub open_blob_or_die
3275{
3276 my ($srcType,$name) = @_;
3277 my ($fh);
3278 if( $srcType eq "file" )
3279 {
3280 if( !open $fh,"<",$name )
3281 {
3282 $log->warn("Unable to open file $name: $!");
3283 die "Unable to open file $name: $!\n";
3284 }
3285 }
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003286 elsif( $srcType eq "sha1" )
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003287 {
brian m. carlson05ea93d2020-06-22 18:04:16 +00003288 unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ )
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003289 {
3290 $log->warn("Need filehash");
3291 die "Need filehash\n";
3292 }
3293
joernchen27dd7382017-09-11 14:45:09 +09003294 my $type = safe_pipe_capture('git', 'cat-file', '-t', $name);
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003295 chomp $type;
3296
3297 unless ( defined ( $type ) and $type eq "blob" )
3298 {
3299 $log->warn("Invalid type '$type' for '$name'");
3300 die ( "Invalid type '$type' (expected 'blob')" )
3301 }
3302
joernchen27dd7382017-09-11 14:45:09 +09003303 my $size = safe_pipe_capture('git', 'cat-file', '-s', $name);
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003304 chomp $size;
3305
3306 $log->debug("open_blob_or_die($name) size=$size, type=$type");
3307
3308 unless( open $fh, '-|', "git", "cat-file", "blob", $name )
3309 {
3310 $log->warn("Unable to open sha1 $name");
3311 die "Unable to open sha1 $name\n";
3312 }
3313 }
3314 else
3315 {
3316 $log->warn("Unknown type of blob source: $srcType");
3317 die "Unknown type of blob source: $srcType\n";
3318 }
3319 return $fh;
3320}
3321
Fabian Emmesd500a1e2009-01-02 16:40:14 +01003322# Generate a CVS author name from Git author information, by taking the local
3323# part of the email address and replacing characters not in the Portable
3324# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS
3325# Login names are Unix login names, which should be restricted to this
3326# character set.
Damien Diederenc1bc3062008-03-27 23:18:35 +01003327sub cvs_author
3328{
3329 my $author_line = shift;
Fabian Emmesd500a1e2009-01-02 16:40:14 +01003330 (my $author) = $author_line =~ /<([^@>]*)/;
3331
3332 $author =~ s/[^-a-zA-Z0-9_.]/_/g;
3333 $author =~ s/^-/_/;
Damien Diederenc1bc3062008-03-27 23:18:35 +01003334
3335 $author;
3336}
3337
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003338
3339sub descramble
3340{
3341 # This table is from src/scramble.c in the CVS source
3342 my @SHIFTS = (
3343 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
3344 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
3345 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
3346 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
3347 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
3348 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
3349 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
3350 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
3351 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
3352 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
3353 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
3354 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
3355 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
3356 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
3357 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
3358 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
3359 );
3360 my ($str) = @_;
3361
Ævar Arnfjörð Bjarmasonfce338a2010-06-19 16:06:57 +00003362 # This should never happen, the same password format (A) has been
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003363 # used by CVS since the beginning of time
Ævar Arnfjörð Bjarmason1f0eb512010-06-19 16:06:58 +00003364 {
3365 my $fmt = substr($str, 0, 1);
3366 die "invalid password format `$fmt'" unless $fmt eq 'A';
3367 }
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003368
3369 my @str = unpack "C*", substr($str, 1);
3370 my $ret = join '', map { chr $SHIFTS[$_] } @str;
3371 return $ret;
3372}
3373
Matthew Ogilvie61717662012-10-13 23:42:31 -06003374# Test if the (deep) values of two references to a hash are the same.
3375sub refHashEqual
3376{
3377 my($v1,$v2) = @_;
3378
3379 my $out;
3380 if(!defined($v1))
3381 {
3382 if(!defined($v2))
3383 {
3384 $out=1;
3385 }
3386 }
3387 elsif( !defined($v2) ||
3388 scalar(keys(%{$v1})) != scalar(keys(%{$v2})) )
3389 {
3390 # $out=undef;
3391 }
3392 else
3393 {
3394 $out=1;
3395
3396 my $key;
3397 foreach $key (keys(%{$v1}))
3398 {
3399 if( !exists($v2->{$key}) ||
3400 defined($v1->{$key}) ne defined($v2->{$key}) ||
3401 ( defined($v1->{$key}) &&
3402 $v1->{$key} ne $v2->{$key} ) )
3403 {
3404 $out=undef;
3405 last;
3406 }
3407 }
3408 }
3409
3410 return $out;
3411}
3412
Junio C Hamanofce13af2017-09-11 14:44:24 +09003413# an alternative to `command` that allows input to be passed as an array
3414# to work around shell problems with weird characters in arguments
3415
3416sub safe_pipe_capture {
3417
3418 my @output;
3419
3420 if (my $pid = open my $child, '-|') {
3421 @output = (<$child>);
3422 close $child or die join(' ',@_).": $! $?";
3423 } else {
3424 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
3425 }
3426 return wantarray ? @output : join('',@output);
3427}
3428
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003429
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003430package GITCVS::log;
3431
3432####
3433#### Copyright The Open University UK - 2006.
3434####
3435#### Authors: Martyn Smith <martyn@catalyst.net.nz>
Junio C Hamanoadc31922010-10-05 12:44:08 -07003436#### Martin Langhoff <martin@laptop.org>
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003437####
3438####
3439
3440use strict;
3441use warnings;
3442
3443=head1 NAME
3444
3445GITCVS::log
3446
3447=head1 DESCRIPTION
3448
3449This module provides very crude logging with a similar interface to
3450Log::Log4perl
3451
3452=head1 METHODS
3453
3454=cut
3455
3456=head2 new
3457
3458Creates a new log object, optionally you can specify a filename here to
Junio C Hamano5348b6e2006-04-25 23:59:28 -07003459indicate the file to log to. If no log file is specified, you can specify one
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003460later with method setfile, or indicate you no longer want logging with method
3461nofile.
3462
3463Until one of these methods is called, all log calls will buffer messages ready
3464to write out.
3465
3466=cut
3467sub new
3468{
3469 my $class = shift;
3470 my $filename = shift;
3471
3472 my $self = {};
3473
3474 bless $self, $class;
3475
3476 if ( defined ( $filename ) )
3477 {
3478 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3479 }
3480
3481 return $self;
3482}
3483
3484=head2 setfile
3485
3486This methods takes a filename, and attempts to open that file as the log file.
3487If successful, all buffered data is written out to the file, and any further
3488logging is written directly to the file.
3489
3490=cut
3491sub setfile
3492{
3493 my $self = shift;
3494 my $filename = shift;
3495
3496 if ( defined ( $filename ) )
3497 {
3498 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3499 }
3500
3501 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3502
3503 while ( my $line = shift @{$self->{buffer}} )
3504 {
3505 print {$self->{fh}} $line;
3506 }
3507}
3508
3509=head2 nofile
3510
3511This method indicates no logging is going to be used. It flushes any entries in
3512the internal buffer, and sets a flag to ensure no further data is put there.
3513
3514=cut
3515sub nofile
3516{
3517 my $self = shift;
3518
3519 $self->{nolog} = 1;
3520
3521 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3522
3523 $self->{buffer} = [];
3524}
3525
3526=head2 _logopen
3527
3528Internal method. Returns true if the log file is open, false otherwise.
3529
3530=cut
3531sub _logopen
3532{
3533 my $self = shift;
3534
3535 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
3536 return 0;
3537}
3538
3539=head2 debug info warn fatal
3540
3541These four methods are wrappers to _log. They provide the actual interface for
3542logging data.
3543
3544=cut
3545sub debug { my $self = shift; $self->_log("debug", @_); }
3546sub info { my $self = shift; $self->_log("info" , @_); }
3547sub warn { my $self = shift; $self->_log("warn" , @_); }
3548sub fatal { my $self = shift; $self->_log("fatal", @_); }
3549
3550=head2 _log
3551
3552This is an internal method called by the logging functions. It generates a
3553timestamp and pushes the logged line either to file, or internal buffer.
3554
3555=cut
3556sub _log
3557{
3558 my $self = shift;
3559 my $level = shift;
3560
3561 return if ( $self->{nolog} );
3562
3563 my @time = localtime;
3564 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
3565 $time[5] + 1900,
3566 $time[4] + 1,
3567 $time[3],
3568 $time[2],
3569 $time[1],
3570 $time[0],
3571 uc $level,
3572 );
3573
3574 if ( $self->_logopen )
3575 {
3576 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
3577 } else {
3578 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
3579 }
3580}
3581
3582=head2 DESTROY
3583
3584This method simply closes the file handle if one is open
3585
3586=cut
3587sub DESTROY
3588{
3589 my $self = shift;
3590
3591 if ( $self->_logopen )
3592 {
3593 close $self->{fh};
3594 }
3595}
3596
3597package GITCVS::updater;
3598
3599####
3600#### Copyright The Open University UK - 2006.
3601####
3602#### Authors: Martyn Smith <martyn@catalyst.net.nz>
Junio C Hamanoadc31922010-10-05 12:44:08 -07003603#### Martin Langhoff <martin@laptop.org>
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003604####
3605####
3606
3607use strict;
3608use warnings;
3609use DBI;
Eric Wong412e4ca2021-10-29 00:15:52 +00003610our $_use_fsync;
3611
3612# n.b. consider using Git.pm
3613sub use_fsync {
3614 if (!defined($_use_fsync)) {
3615 my $x = $ENV{GIT_TEST_FSYNC};
3616 if (defined $x) {
3617 local $ENV{GIT_CONFIG};
3618 delete $ENV{GIT_CONFIG};
3619 my $v = ::safe_pipe_capture('git', '-c', "test.fsync=$x",
3620 qw(config --type=bool test.fsync));
3621 $_use_fsync = defined($v) ? ($v eq "true\n") : 1;
3622 }
3623 }
3624 $_use_fsync;
3625}
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003626
3627=head1 METHODS
3628
3629=cut
3630
3631=head2 new
3632
3633=cut
3634sub new
3635{
3636 my $class = shift;
3637 my $config = shift;
3638 my $module = shift;
3639 my $log = shift;
3640
3641 die "Need to specify a git repository" unless ( defined($config) and -d $config );
3642 die "Need to specify a module" unless ( defined($module) );
3643
3644 $class = ref($class) || $class;
3645
3646 my $self = {};
3647
3648 bless $self, $class;
3649
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003650 $self->{valid_tables} = {'revision' => 1,
3651 'revision_ix1' => 1,
3652 'revision_ix2' => 1,
3653 'head' => 1,
3654 'head_ix1' => 1,
3655 'properties' => 1,
3656 'commitmsgs' => 1};
3657
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003658 $self->{module} = $module;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003659 $self->{git_path} = $config . "/";
3660
3661 $self->{log} = $log;
3662
3663 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
3664
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06003665 # Stores full sha1's for various branch/tag names, abbreviations, etc:
3666 $self->{commitRefCache} = {};
3667
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003668 $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
Frank Lichtenheld473937e2007-04-07 16:58:09 +02003669 $cfg->{gitcvs}{dbdriver} || "SQLite";
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003670 $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
3671 $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
3672 $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
3673 $cfg->{gitcvs}{dbuser} || "";
3674 $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
3675 $cfg->{gitcvs}{dbpass} || "";
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003676 $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
3677 $cfg->{gitcvs}{dbtablenameprefix} || "";
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003678 my %mapping = ( m => $module,
3679 a => $state->{method},
3680 u => getlogin || getpwuid($<) || $<,
3681 G => $self->{git_path},
3682 g => mangle_dirname($self->{git_path}),
3683 );
3684 $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
3685 $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003686 $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
3687 $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003688
Frank Lichtenheld473937e2007-04-07 16:58:09 +02003689 die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
3690 die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
3691 $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003692 $self->{dbuser},
3693 $self->{dbpass});
Frank Lichtenheld920a4492007-03-19 16:56:01 +01003694 die "Error connecting to database\n" unless defined $self->{dbh};
Eric Wong412e4ca2021-10-29 00:15:52 +00003695 if ($self->{dbdriver} eq 'SQLite' && !use_fsync()) {
3696 $self->{dbh}->do('PRAGMA synchronous = OFF');
3697 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003698
3699 $self->{tables} = {};
Frank Lichtenheld0cf611a2007-03-31 15:57:47 +02003700 foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003701 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003702 $self->{tables}{$table} = 1;
3703 }
3704
3705 # Construct the revision table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003706 # The revision table stores an entry for each file, each time that file
3707 # changes.
3708 # numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
3709 # This is not sufficient to support "-r {commithash}" for any
3710 # files except files that were modified by that commit (also,
3711 # some places in the code ignore/effectively strip out -r in
3712 # some cases, before it gets passed to getmeta()).
3713 # The "filehash" field typically has a git blob hash, but can also
3714 # be set to "dead" to indicate that the given version of the file
3715 # should not exist in the sandbox.
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003716 unless ( $self->{tables}{$self->tablename("revision")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003717 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003718 my $tablename = $self->tablename("revision");
3719 my $ix1name = $self->tablename("revision_ix1");
3720 my $ix2name = $self->tablename("revision_ix2");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003721 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003722 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003723 name TEXT NOT NULL,
3724 revision INTEGER NOT NULL,
3725 filehash TEXT NOT NULL,
3726 commithash TEXT NOT NULL,
3727 author TEXT NOT NULL,
3728 modified TEXT NOT NULL,
3729 mode TEXT NOT NULL
3730 )
3731 ");
Shawn Pearce178e0152006-10-23 01:09:35 -04003732 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003733 CREATE INDEX $ix1name
3734 ON $tablename (name,revision)
Shawn Pearce178e0152006-10-23 01:09:35 -04003735 ");
3736 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003737 CREATE INDEX $ix2name
3738 ON $tablename (name,commithash)
Shawn Pearce178e0152006-10-23 01:09:35 -04003739 ");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003740 }
3741
Shawn Pearce178e0152006-10-23 01:09:35 -04003742 # Construct the head table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003743 # The head table (along with the "last_commit" entry in the property
3744 # table) is the persisted working state of the "sub update" subroutine.
3745 # All of it's data is read entirely first, and completely recreated
3746 # last, every time "sub update" runs.
3747 # This is also used by "sub getmeta" when it is asked for the latest
3748 # version of a file (as opposed to some specific version).
3749 # Another way of thinking about it is as a single slice out of
3750 # "revisions", giving just the most recent revision information for
3751 # each file.
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003752 unless ( $self->{tables}{$self->tablename("head")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003753 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003754 my $tablename = $self->tablename("head");
3755 my $ix1name = $self->tablename("head_ix1");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003756 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003757 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003758 name TEXT NOT NULL,
3759 revision INTEGER NOT NULL,
3760 filehash TEXT NOT NULL,
3761 commithash TEXT NOT NULL,
3762 author TEXT NOT NULL,
3763 modified TEXT NOT NULL,
3764 mode TEXT NOT NULL
3765 )
3766 ");
Shawn Pearce178e0152006-10-23 01:09:35 -04003767 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003768 CREATE INDEX $ix1name
3769 ON $tablename (name)
Shawn Pearce178e0152006-10-23 01:09:35 -04003770 ");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003771 }
3772
3773 # Construct the properties table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003774 # - "last_commit" - Used by "sub update".
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003775 unless ( $self->{tables}{$self->tablename("properties")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003776 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003777 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003778 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003779 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003780 key TEXT NOT NULL PRIMARY KEY,
3781 value TEXT
3782 )
3783 ");
3784 }
3785
3786 # Construct the commitmsgs table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003787 # The commitmsgs table is only used for merge commits, since
3788 # "sub update" will only keep one branch of parents. Shortlogs
3789 # for ignored commits (i.e. not on the chosen branch) will be used
3790 # to construct a replacement "collapsed" merge commit message,
3791 # which will be stored in this table. See also "sub commitmessage".
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003792 unless ( $self->{tables}{$self->tablename("commitmsgs")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003793 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003794 my $tablename = $self->tablename("commitmsgs");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003795 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003796 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003797 key TEXT NOT NULL PRIMARY KEY,
3798 value TEXT
3799 )
3800 ");
3801 }
3802
3803 return $self;
3804}
3805
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003806=head2 tablename
3807
3808=cut
3809sub tablename
3810{
3811 my $self = shift;
3812 my $name = shift;
3813
3814 if (exists $self->{valid_tables}{$name}) {
3815 return $self->{dbtablenameprefix} . $name;
3816 } else {
3817 return undef;
3818 }
3819}
3820
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003821=head2 update
3822
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003823Bring the database up to date with the latest changes from
3824the git repository.
3825
3826Internal working state is read out of the "head" table and the
3827"last_commit" property, then it updates "revisions" based on that, and
3828finally it writes the new internal state back to the "head" table
3829so it can be used as a starting point the next time update is called.
3830
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003831=cut
3832sub update
3833{
3834 my $self = shift;
3835
3836 # first lets get the commit list
3837 $ENV{GIT_DIR} = $self->{git_path};
3838
joernchen27dd7382017-09-11 14:45:09 +09003839 my $commitsha1 = ::safe_pipe_capture('git', 'rev-parse', $self->{module});
Martin Langhoff49fb9402007-01-09 15:10:32 +13003840 chomp $commitsha1;
3841
joernchen27dd7382017-09-11 14:45:09 +09003842 my $commitinfo = ::safe_pipe_capture('git', 'cat-file', 'commit', $self->{module});
brian m. carlson05ea93d2020-06-22 18:04:16 +00003843 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{$state->{hexsz}}/ )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003844 {
3845 die("Invalid module '$self->{module}'");
3846 }
3847
3848
3849 my $git_log;
3850 my $lastcommit = $self->_get_prop("last_commit");
3851
Martin Langhoff49fb9402007-01-09 15:10:32 +13003852 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
Matthew Ogilvie61717662012-10-13 23:42:31 -06003853 # invalidate the gethead cache
3854 $self->clearCommitRefCaches();
Martin Langhoff49fb9402007-01-09 15:10:32 +13003855 return 1;
3856 }
3857
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003858 # Start exclusive lock here...
3859 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
3860
3861 # TODO: log processing is memory bound
3862 # if we can parse into a 2nd file that is in reverse order
3863 # we can probably do something really efficient
Martin Langhoffa248c962006-05-04 10:51:46 +12003864 my @git_log_params = ('--pretty', '--parents', '--topo-order');
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003865
3866 if (defined $lastcommit) {
3867 push @git_log_params, "$lastcommit..$self->{module}";
3868 } else {
3869 push @git_log_params, $self->{module};
3870 }
Martin Langhoffa248c962006-05-04 10:51:46 +12003871 # git-rev-list is the backend / plumbing version of git-log
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003872 open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
3873 or die "Cannot call git-rev-list: $!";
3874 my @commits=readCommits($gitLogPipe);
3875 close $gitLogPipe;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003876
3877 # Now all the commits are in the @commits bucket
3878 # ordered by time DESC. for each commit that needs processing,
3879 # determine whether it's following the last head we've seen or if
3880 # it's on its own branch, grab a file list, and add whatever's changed
3881 # NOTE: $lastcommit refers to the last commit from previous run
3882 # $lastpicked is the last commit we picked in this run
3883 my $lastpicked;
3884 my $head = {};
3885 if (defined $lastcommit) {
3886 $lastpicked = $lastcommit;
3887 }
3888
3889 my $committotal = scalar(@commits);
3890 my $commitcount = 0;
3891
3892 # Load the head table into $head (for cached lookups during the update process)
Matthew Ogilvieab076812012-10-13 23:42:21 -06003893 foreach my $file ( @{$self->gethead(1)} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003894 {
3895 $head->{$file->{name}} = $file;
3896 }
3897
3898 foreach my $commit ( @commits )
3899 {
3900 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
3901 if (defined $lastpicked)
3902 {
3903 if (!in_array($lastpicked, @{$commit->{parents}}))
3904 {
3905 # skip, we'll see this delta
3906 # as part of a merge later
3907 # warn "skipping off-track $commit->{hash}\n";
3908 next;
3909 } elsif (@{$commit->{parents}} > 1) {
3910 # it is a merge commit, for each parent that is
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003911 # not $lastpicked (not given a CVS revision number),
3912 # see if we can get a log
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003913 # from the merge-base to that parent to put it
3914 # in the message as a merge summary.
3915 my @parents = @{$commit->{parents}};
3916 foreach my $parent (@parents) {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003917 if ($parent eq $lastpicked) {
3918 next;
3919 }
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003920 # git-merge-base can potentially (but rarely) throw
3921 # several candidate merge bases. let's assume
3922 # that the first one is the best one.
Steffen Prohaskae509db92008-01-26 10:54:06 +01003923 my $base = eval {
Junio C Hamanofce13af2017-09-11 14:44:24 +09003924 ::safe_pipe_capture('git', 'merge-base',
Jim Meyeringa5e40792007-07-14 20:48:42 +02003925 $lastpicked, $parent);
Steffen Prohaskae509db92008-01-26 10:54:06 +01003926 };
3927 # The two branches may not be related at all,
3928 # in which case merge base simply fails to find
3929 # any, but that's Ok.
3930 next if ($@);
3931
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003932 chomp $base;
3933 if ($base) {
3934 my @merged;
3935 # print "want to log between $base $parent \n";
Gerrit Paped2feb012009-09-02 09:23:10 +00003936 open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
Jim Meyeringa5e40792007-07-14 20:48:42 +02003937 or die "Cannot call git-log: $!";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003938 my $mergedhash;
3939 while (<GITLOG>) {
3940 chomp;
3941 if (!defined $mergedhash) {
3942 if (m/^commit\s+(.+)$/) {
3943 $mergedhash = $1;
3944 } else {
3945 next;
3946 }
3947 } else {
3948 # grab the first line that looks non-rfc822
3949 # aka has content after leading space
3950 if (m/^\s+(\S.*)$/) {
3951 my $title = $1;
3952 $title = substr($title,0,100); # truncate
3953 unshift @merged, "$mergedhash $title";
3954 undef $mergedhash;
3955 }
3956 }
3957 }
3958 close GITLOG;
3959 if (@merged) {
3960 $commit->{mergemsg} = $commit->{message};
3961 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
3962 foreach my $summary (@merged) {
3963 $commit->{mergemsg} .= "\t$summary\n";
3964 }
3965 $commit->{mergemsg} .= "\n\n";
3966 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
3967 }
3968 }
3969 }
3970 }
3971 }
3972
3973 # convert the date to CVS-happy format
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003974 my $cvsDate = convertToCvsDate($commit->{date});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003975
3976 if ( defined ( $lastpicked ) )
3977 {
Gerrit Paped2feb012009-09-02 09:23:10 +00003978 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 -08003979 local ($/) = "\0";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003980 while ( <FILELIST> )
3981 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003982 chomp;
brian m. carlson05ea93d2020-06-22 18:04:16 +00003983 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 +13003984 {
3985 die("Couldn't process git-diff-tree line : $_");
3986 }
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003987 my ($mode, $hash, $change) = ($1, $2, $3);
3988 my $name = <FILELIST>;
3989 chomp($name);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003990
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003991 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003992
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003993 my $dbMode = convertToDbMode($mode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003994
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003995 if ( $change eq "D" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003996 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003997 #$log->debug("DELETE $name");
3998 $head->{$name} = {
3999 name => $name,
4000 revision => $head->{$name}{revision} + 1,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004001 filehash => "deleted",
4002 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004003 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004004 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004005 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004006 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004007 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004008 }
Paolo Bonzini9027efe2008-03-16 20:00:21 +01004009 elsif ( $change eq "M" || $change eq "T" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004010 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004011 #$log->debug("MODIFIED $name");
4012 $head->{$name} = {
4013 name => $name,
4014 revision => $head->{$name}{revision} + 1,
4015 filehash => $hash,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004016 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004017 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004018 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004019 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004020 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004021 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004022 }
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004023 elsif ( $change eq "A" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004024 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004025 #$log->debug("ADDED $name");
4026 $head->{$name} = {
4027 name => $name,
Frank Lichtenhelda7da9ad2007-05-02 02:43:14 +02004028 revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004029 filehash => $hash,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004030 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004031 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004032 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004033 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004034 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004035 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004036 }
4037 else
4038 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004039 $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004040 die;
4041 }
4042 }
4043 close FILELIST;
4044 } else {
4045 # this is used to detect files removed from the repo
4046 my $seen_files = {};
4047
Gerrit Paped2feb012009-09-02 09:23:10 +00004048 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 -08004049 local $/ = "\0";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004050 while ( <FILELIST> )
4051 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004052 chomp;
4053 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004054 {
4055 die("Couldn't process git-ls-tree line : $_");
4056 }
4057
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004058 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004059
4060 $seen_files->{$git_filename} = 1;
4061
4062 my ( $oldhash, $oldrevision, $oldmode ) = (
4063 $head->{$git_filename}{filehash},
4064 $head->{$git_filename}{revision},
4065 $head->{$git_filename}{mode}
4066 );
4067
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004068 my $dbMode = convertToDbMode($mode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004069
4070 # unless the file exists with the same hash, we need to update it ...
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004071 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004072 {
4073 my $newrevision = ( $oldrevision or 0 ) + 1;
4074
4075 $head->{$git_filename} = {
4076 name => $git_filename,
4077 revision => $newrevision,
4078 filehash => $git_hash,
4079 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004080 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004081 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004082 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004083 };
4084
4085
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004086 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004087 }
4088 }
4089 close FILELIST;
4090
4091 # Detect deleted files
Anders Kaseorg94629532013-10-30 04:44:43 -04004092 foreach my $file ( sort keys %$head )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004093 {
4094 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
4095 {
4096 $head->{$file}{revision}++;
4097 $head->{$file}{filehash} = "deleted";
4098 $head->{$file}{commithash} = $commit->{hash};
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004099 $head->{$file}{modified} = $cvsDate;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004100 $head->{$file}{author} = $commit->{author};
4101
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004102 $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 +13004103 }
4104 }
4105 # END : "Detect deleted files"
4106 }
4107
4108
4109 if (exists $commit->{mergemsg})
4110 {
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004111 $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004112 }
4113
4114 $lastpicked = $commit->{hash};
4115
4116 $self->_set_prop("last_commit", $commit->{hash});
4117 }
4118
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004119 $self->delete_head();
Anders Kaseorg94629532013-10-30 04:44:43 -04004120 foreach my $file ( sort keys %$head )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004121 {
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004122 $self->insert_head(
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004123 $file,
4124 $head->{$file}{revision},
4125 $head->{$file}{filehash},
4126 $head->{$file}{commithash},
4127 $head->{$file}{modified},
4128 $head->{$file}{author},
4129 $head->{$file}{mode},
4130 );
4131 }
4132 # invalidate the gethead cache
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004133 $self->clearCommitRefCaches();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004134
4135
4136 # Ending exclusive lock here
4137 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
4138}
4139
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004140sub readCommits
4141{
4142 my $pipeHandle = shift;
4143 my @commits;
4144
4145 my %commit = ();
4146
4147 while ( <$pipeHandle> )
4148 {
4149 chomp;
4150 if (m/^commit\s+(.*)$/) {
4151 # on ^commit lines put the just seen commit in the stack
4152 # and prime things for the next one
4153 if (keys %commit) {
4154 my %copy = %commit;
4155 unshift @commits, \%copy;
4156 %commit = ();
4157 }
4158 my @parents = split(m/\s+/, $1);
4159 $commit{hash} = shift @parents;
4160 $commit{parents} = \@parents;
4161 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
4162 # on rfc822-like lines seen before we see any message,
4163 # lowercase the entry and put it in the hash as key-value
4164 $commit{lc($1)} = $2;
4165 } else {
4166 # message lines - skip initial empty line
4167 # and trim whitespace
4168 if (!exists($commit{message}) && m/^\s*$/) {
4169 # define it to mark the end of headers
4170 $commit{message} = '';
4171 next;
4172 }
4173 s/^\s+//; s/\s+$//; # trim ws
4174 $commit{message} .= $_ . "\n";
4175 }
4176 }
4177
4178 unshift @commits, \%commit if ( keys %commit );
4179
4180 return @commits;
4181}
4182
4183sub convertToCvsDate
4184{
4185 my $date = shift;
4186 # Convert from: "git rev-list --pretty" formatted date
4187 # Convert to: "the format specified by RFC822 as modified by RFC1123."
4188 # Example: 26 May 1997 13:01:40 -0400
4189 if( $date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ )
4190 {
4191 $date = "$2 $1 $4 $3 $5";
4192 }
4193
4194 return $date;
4195}
4196
4197sub convertToDbMode
4198{
4199 my $mode = shift;
4200
4201 # NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",
4202 # but the database "mode" column historically (and currently)
4203 # only stores the "rw" (for user) part of the string.
4204 # FUTURE: It might make more sense to persist the raw
4205 # octal mode (or perhaps the final full CVS form) instead of
4206 # this half-converted form, but it isn't currently worth the
4207 # backwards compatibility headaches.
4208
Junio C Hamano1b48d562013-09-10 15:33:06 -07004209 $mode=~/^\d{3}(\d)\d\d$/;
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004210 my $userBits=$1;
4211
4212 my $dbMode = "";
4213 $dbMode .= "r" if ( $userBits & 4 );
4214 $dbMode .= "w" if ( $userBits & 2 );
4215 $dbMode .= "x" if ( $userBits & 1 );
4216 $dbMode = "rw" if ( $dbMode eq "" );
4217
4218 return $dbMode;
4219}
4220
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004221sub insert_rev
4222{
4223 my $self = shift;
4224 my $name = shift;
4225 my $revision = shift;
4226 my $filehash = shift;
4227 my $commithash = shift;
4228 my $modified = shift;
4229 my $author = shift;
4230 my $mode = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004231 my $tablename = $self->tablename("revision");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004232
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004233 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 +02004234 $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4235}
4236
4237sub insert_mergelog
4238{
4239 my $self = shift;
4240 my $key = shift;
4241 my $value = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004242 my $tablename = $self->tablename("commitmsgs");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004243
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004244 my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004245 $insert_mergelog->execute($key, $value);
4246}
4247
4248sub delete_head
4249{
4250 my $self = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004251 my $tablename = $self->tablename("head");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004252
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004253 my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004254 $delete_head->execute();
4255}
4256
4257sub insert_head
4258{
4259 my $self = shift;
4260 my $name = shift;
4261 my $revision = shift;
4262 my $filehash = shift;
4263 my $commithash = shift;
4264 my $modified = shift;
4265 my $author = shift;
4266 my $mode = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004267 my $tablename = $self->tablename("head");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004268
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004269 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 +02004270 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4271}
4272
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004273sub _get_prop
4274{
4275 my $self = shift;
4276 my $key = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004277 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004278
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004279 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004280 $db_query->execute($key);
4281 my ( $value ) = $db_query->fetchrow_array;
4282
4283 return $value;
4284}
4285
4286sub _set_prop
4287{
4288 my $self = shift;
4289 my $key = shift;
4290 my $value = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004291 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004292
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004293 my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004294 $db_query->execute($value, $key);
4295
4296 unless ( $db_query->rows )
4297 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004298 $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004299 $db_query->execute($key, $value);
4300 }
4301
4302 return $value;
4303}
4304
4305=head2 gethead
4306
4307=cut
4308
4309sub gethead
4310{
4311 my $self = shift;
Matthew Ogilvieab076812012-10-13 23:42:21 -06004312 my $intRev = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004313 my $tablename = $self->tablename("head");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004314
4315 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
4316
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004317 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 +13004318 $db_query->execute();
4319
4320 my $tree = [];
4321 while ( my $file = $db_query->fetchrow_hashref )
4322 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06004323 if(!$intRev)
4324 {
4325 $file->{revision} = "1.$file->{revision}"
4326 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004327 push @$tree, $file;
4328 }
4329
4330 $self->{gethead_cache} = $tree;
4331
4332 return $tree;
4333}
4334
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004335=head2 getAnyHead
4336
4337Returns a reference to an array of getmeta structures, one
4338per file in the specified tree hash.
4339
4340=cut
4341
4342sub getAnyHead
4343{
4344 my ($self,$hash) = @_;
4345
4346 if(!defined($hash))
4347 {
4348 return $self->gethead();
4349 }
4350
4351 my @files;
4352 {
4353 open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4354 or die("Cannot call git-ls-tree : $!");
4355 local $/ = "\0";
4356 @files=<$filePipe>;
4357 close $filePipe;
4358 }
4359
4360 my $tree=[];
4361 my($line);
4362 foreach $line (@files)
4363 {
4364 $line=~s/\0$//;
4365 unless ( $line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4366 {
4367 die("Couldn't process git-ls-tree line : $_");
4368 }
4369
4370 my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4371 push @$tree, $self->getMetaFromCommithash($git_filename,$hash);
4372 }
4373
4374 return $tree;
4375}
4376
4377=head2 getRevisionDirMap
4378
4379A "revision dir map" contains all the plain-file filenames associated
Richard Hansenbb8040f2013-09-04 15:04:30 -04004380with a particular revision (tree-ish), organized by directory:
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004381
4382 $type = $out->{$dir}{$fullName}
4383
4384The type of each is "F" (for ordinary file) or "D" (for directory,
4385for which the map $out->{$fullName} will also exist).
4386
4387=cut
4388
4389sub getRevisionDirMap
4390{
4391 my ($self,$ver)=@_;
4392
4393 if(!defined($self->{revisionDirMapCache}))
4394 {
4395 $self->{revisionDirMapCache}={};
4396 }
4397
4398 # Get file list (previously cached results are dependent on HEAD,
4399 # but are early in each case):
4400 my $cacheKey;
4401 my (@fileList);
4402 if( !defined($ver) || $ver eq "" )
4403 {
4404 $cacheKey="";
4405 if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4406 {
4407 return $self->{revisionDirMapCache}{$cacheKey};
4408 }
4409
4410 my @head = @{$self->gethead()};
4411 foreach my $file ( @head )
4412 {
4413 next if ( $file->{filehash} eq "deleted" );
4414
4415 push @fileList,$file->{name};
4416 }
4417 }
4418 else
4419 {
4420 my ($hash)=$self->lookupCommitRef($ver);
4421 if( !defined($hash) )
4422 {
4423 return undef;
4424 }
4425
4426 $cacheKey=$hash;
4427 if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4428 {
4429 return $self->{revisionDirMapCache}{$cacheKey};
4430 }
4431
4432 open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4433 or die("Cannot call git-ls-tree : $!");
4434 local $/ = "\0";
4435 while ( <$filePipe> )
4436 {
4437 chomp;
4438 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4439 {
4440 die("Couldn't process git-ls-tree line : $_");
4441 }
4442
4443 my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4444
4445 push @fileList, $git_filename;
4446 }
4447 close $filePipe;
4448 }
4449
4450 # Convert to normalized form:
4451 my %revMap;
4452 my $file;
4453 foreach $file (@fileList)
4454 {
4455 my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);
4456 $dir='' if(!defined($dir));
4457
4458 # parent directories:
4459 # ... create empty dir maps for parent dirs:
4460 my($td)=$dir;
4461 while(!defined($revMap{$td}))
4462 {
4463 $revMap{$td}={};
4464
4465 my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4466 $tp='' if(!defined($tp));
4467 $td=$tp;
4468 }
4469 # ... add children to parent maps (now that they exist):
4470 $td=$dir;
4471 while($td ne "")
4472 {
4473 my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4474 $tp='' if(!defined($tp));
4475
4476 if(defined($revMap{$tp}{$td}))
4477 {
4478 if($revMap{$tp}{$td} ne 'D')
4479 {
4480 die "Weird file/directory inconsistency in $cacheKey";
4481 }
4482 last; # loop exit
4483 }
4484 $revMap{$tp}{$td}='D';
4485
4486 $td=$tp;
4487 }
4488
4489 # file
4490 $revMap{$dir}{$file}='F';
4491 }
4492
4493 # Save in cache:
4494 $self->{revisionDirMapCache}{$cacheKey}=\%revMap;
4495 return $self->{revisionDirMapCache}{$cacheKey};
4496}
4497
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004498=head2 getlog
4499
Matthew Ogilviea86c0982012-10-13 23:42:18 -06004500See also gethistorydense().
4501
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004502=cut
4503
4504sub getlog
4505{
4506 my $self = shift;
4507 my $filename = shift;
Matthew Ogilvieab076812012-10-13 23:42:21 -06004508 my $revFilter = shift;
4509
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004510 my $tablename = $self->tablename("revision");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004511
Matthew Ogilvieab076812012-10-13 23:42:21 -06004512 # Filters:
4513 # TODO: date, state, or by specific logins filters?
4514 # TODO: Handle comma-separated list of revFilter items, each item
4515 # can be a range [only case currently handled] or individual
4516 # rev or branch or "branch.".
4517 # TODO: Adjust $db_query WHERE clause based on revFilter, instead of
4518 # manually filtering the results of the query?
4519 my ( $minrev, $maxrev );
4520 if( defined($revFilter) and
4521 $state->{opt}{r} =~ /^(1.(\d+))?(::?)(1.(\d.+))?$/ )
4522 {
4523 my $control = $3;
4524 $minrev = $2;
4525 $maxrev = $5;
4526 $minrev++ if ( defined($minrev) and $control eq "::" );
4527 }
4528
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004529 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 +13004530 $db_query->execute($filename);
4531
Matthew Ogilvieab076812012-10-13 23:42:21 -06004532 my $totalRevs=0;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004533 my $tree = [];
4534 while ( my $file = $db_query->fetchrow_hashref )
4535 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06004536 $totalRevs++;
4537 if( defined($minrev) and $file->{revision} < $minrev )
4538 {
4539 next;
4540 }
4541 if( defined($maxrev) and $file->{revision} > $maxrev )
4542 {
4543 next;
4544 }
4545
4546 $file->{revision} = "1." . $file->{revision};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004547 push @$tree, $file;
4548 }
4549
Matthew Ogilvieab076812012-10-13 23:42:21 -06004550 return ($tree,$totalRevs);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004551}
4552
4553=head2 getmeta
4554
4555This function takes a filename (with path) argument and returns a hashref of
4556metadata for that file.
4557
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004558There are several ways $revision can be specified:
4559
4560 - A reference to hash that contains a "tag" that is the
4561 actual revision (one of the below). TODO: Also allow it to
4562 specify a "date" in the hash.
4563 - undef, to refer to the latest version on the main branch.
4564 - Full CVS client revision number (mapped to integer in DB, without the
4565 "1." prefix),
4566 - Complex CVS-compatible "special" revision number for
4567 non-linear history (see comment below)
4568 - git commit sha1 hash
4569 - branch or tag name
4570
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004571=cut
4572
4573sub getmeta
4574{
4575 my $self = shift;
4576 my $filename = shift;
4577 my $revision = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004578 my $tablename_rev = $self->tablename("revision");
4579 my $tablename_head = $self->tablename("head");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004580
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004581 if ( ref($revision) eq "HASH" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004582 {
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004583 $revision = $revision->{tag};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004584 }
4585
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004586 # Overview of CVS revision numbers:
4587 #
4588 # General CVS numbering scheme:
4589 # - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.
4590 # - Result of "cvs checkin -r" (possible, but not really
4591 # recommended): "2.1", "2.2", etc
4592 # - Branch tag: "1.2.0.n", where "1.2" is revision it was branched
4593 # from, "0" is a magic placeholder that identifies it as a
4594 # branch tag instead of a version tag, and n is 2 times the
4595 # branch number off of "1.2", starting with "2".
4596 # - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"
4597 # is branch number off of "1.2" (like n above), and "x" is
4598 # the version number on the branch.
4599 # - Branches can branch off of branches: "1.3.2.7.4.1" (even number
4600 # of components).
4601 # - Odd "n"s are used by "vendor branches" that result
4602 # from "cvs import". Vendor branches have additional
4603 # strangeness in the sense that the main rcs "head" of the main
4604 # branch will (temporarily until first normal commit) point
4605 # to the version on the vendor branch, rather than the actual
4606 # main branch. (FUTURE: This may provide an opportunity
4607 # to use "strange" revision numbers for fast-forward-merged
4608 # branch tip when CVS client is asking for the main branch.)
4609 #
4610 # git-cvsserver CVS-compatible special numbering schemes:
4611 # - Currently git-cvsserver only tries to be identical to CVS for
4612 # simple "1.x" numbers on the "main" branch (as identified
4613 # by the module name that was originally cvs checkout'ed).
4614 # - The database only stores the "x" part, for historical reasons.
4615 # But most of the rest of the cvsserver preserves
4616 # and thinks using the full revision number.
4617 # - To handle non-linear history, it uses a version of the form
4618 # "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely
4619 # identify this as a special revision number, and there are
4620 # 20 b's that together encode the sha1 git commit from which
4621 # this version of this file originated. Each b is
4622 # the numerical value of the corresponding byte plus
4623 # 100.
4624 # - "plus 100" avoids "0"s, and also reduces the
Stefano Lattarini41ccfdd2013-04-12 00:36:10 +02004625 # likelihood of a collision in the case that someone someday
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004626 # writes an import tool that tries to preserve original
4627 # CVS revision numbers, and the original CVS data had done
4628 # lots of branches off of branches and other strangeness to
4629 # end up with a real version number that just happens to look
4630 # like this special revision number form. Also, if needed
4631 # there are several ways to extend/identify alternative encodings
4632 # within the "2.1.1.2000" part if necessary.
4633 # - Unlike real CVS revisions, you can't really reconstruct what
4634 # relation a revision of this form has to other revisions.
4635 # - FUTURE: TODO: Rework database somehow to make up and remember
4636 # fully-CVS-compatible branches and branch version numbers.
4637
4638 my $meta;
4639 if ( defined($revision) )
4640 {
4641 if ( $revision =~ /^1\.(\d+)$/ )
4642 {
4643 my ($intRev) = $1;
4644 my $db_query;
4645 $db_query = $self->{dbh}->prepare_cached(
4646 "SELECT * FROM $tablename_rev WHERE name=? AND revision=?",
4647 {},1);
4648 $db_query->execute($filename, $intRev);
4649 $meta = $db_query->fetchrow_hashref;
4650 }
brian m. carlson05ea93d2020-06-22 18:04:16 +00004651 elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){$state->{rawsz}}$/ )
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004652 {
4653 my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
4654 $commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
brian m. carlson05ea93d2020-06-22 18:04:16 +00004655 if($commitHash=~/^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004656 {
4657 return $self->getMetaFromCommithash($filename,$commitHash);
4658 }
4659
4660 # error recovery: fall back on head version below
4661 print "E Failed to find $filename version=$revision or commit=$commitHash\n";
4662 $log->warning("failed get $revision with commithash=$commitHash");
4663 undef $revision;
4664 }
brian m. carlson05ea93d2020-06-22 18:04:16 +00004665 elsif ( $revision =~ /^[0-9a-f]{$state->{hexsz}}$/ )
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004666 {
4667 # Try DB first. This is mostly only useful for req_annotate(),
4668 # which only calls this for stuff that should already be in
4669 # the DB. It is fairly likely to be a waste of time
4670 # in most other cases [unless the file happened to be
4671 # modified in $revision specifically], but
4672 # it is probably in the noise compared to how long
4673 # getMetaFromCommithash() will take.
4674 my $db_query;
4675 $db_query = $self->{dbh}->prepare_cached(
4676 "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4677 {},1);
4678 $db_query->execute($filename, $revision);
4679 $meta = $db_query->fetchrow_hashref;
4680
4681 if(! $meta)
4682 {
4683 my($revCommit)=$self->lookupCommitRef($revision);
brian m. carlson05ea93d2020-06-22 18:04:16 +00004684 if($revCommit=~/^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004685 {
4686 return $self->getMetaFromCommithash($filename,$revCommit);
4687 }
4688
4689 # error recovery: nothing found:
4690 print "E Failed to find $filename version=$revision\n";
4691 $log->warning("failed get $revision");
4692 return $meta;
4693 }
4694 }
4695 else
4696 {
4697 my($revCommit)=$self->lookupCommitRef($revision);
brian m. carlson05ea93d2020-06-22 18:04:16 +00004698 if($revCommit=~/^[0-9a-f]{$state->{hexsz}}$/)
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004699 {
4700 return $self->getMetaFromCommithash($filename,$revCommit);
4701 }
4702
4703 # error recovery: fall back on head version below
4704 print "E Failed to find $filename version=$revision\n";
4705 $log->warning("failed get $revision");
4706 undef $revision; # Allow fallback
4707 }
4708 }
4709
4710 if(!defined($revision))
4711 {
4712 my $db_query;
4713 $db_query = $self->{dbh}->prepare_cached(
4714 "SELECT * FROM $tablename_head WHERE name=?",{},1);
4715 $db_query->execute($filename);
4716 $meta = $db_query->fetchrow_hashref;
4717 }
4718
Matthew Ogilvieab076812012-10-13 23:42:21 -06004719 if($meta)
4720 {
4721 $meta->{revision} = "1.$meta->{revision}";
4722 }
4723 return $meta;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004724}
4725
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004726sub getMetaFromCommithash
4727{
4728 my $self = shift;
4729 my $filename = shift;
4730 my $revCommit = shift;
4731
4732 # NOTE: This function doesn't scale well (lots of forks), especially
4733 # if you have many files that have not been modified for many commits
4734 # (each git-rev-parse redoes a lot of work for each file
4735 # that theoretically could be done in parallel by smarter
4736 # graph traversal).
4737 #
4738 # TODO: Possible optimization strategies:
4739 # - Solve the issue of assigning and remembering "real" CVS
4740 # revision numbers for branches, and ensure the
4741 # data structure can do this efficiently. Perhaps something
4742 # similar to "git notes", and carefully structured to take
4743 # advantage same-sha1-is-same-contents, to roll the same
4744 # unmodified subdirectory data onto multiple commits?
4745 # - Write and use a C tool that is like git-blame, but
4746 # operates on multiple files with file granularity, instead
4747 # of one file with line granularity. Cache
4748 # most-recently-modified in $self->{commitRefCache}{$revCommit}.
4749 # Try to be intelligent about how many files we do with
4750 # one fork (perhaps one directory at a time, without recursion,
4751 # and/or include directory as one line item, recurse from here
4752 # instead of in C tool?).
4753 # - Perhaps we could ask the DB for (filename,fileHash),
4754 # and just guess that it is correct (that the file hadn't
4755 # changed between $revCommit and the found commit, then
4756 # changed back, confusing anything trying to interpret
4757 # history). Probably need to add another index to revisions
4758 # DB table for this.
4759 # - NOTE: Trying to store all (commit,file) keys in DB [to
4760 # find "lastModfiedCommit] (instead of
4761 # just files that changed in each commit as we do now) is
4762 # probably not practical from a disk space perspective.
4763
4764 # Does the file exist in $revCommit?
4765 # TODO: Include file hash in dirmap cache.
4766 my($dirMap)=$self->getRevisionDirMap($revCommit);
4767 my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);
4768 if(!defined($dir))
4769 {
4770 $dir="";
4771 }
4772 if( !defined($dirMap->{$dir}) ||
4773 !defined($dirMap->{$dir}{$filename}) )
4774 {
4775 my($fileHash)="deleted";
4776
4777 my($retVal)={};
4778 $retVal->{name}=$filename;
4779 $retVal->{filehash}=$fileHash;
4780
4781 # not needed and difficult to compute:
4782 $retVal->{revision}="0"; # $revision;
4783 $retVal->{commithash}=$revCommit;
4784 #$retVal->{author}=$commit->{author};
4785 #$retVal->{modified}=convertToCvsDate($commit->{date});
4786 #$retVal->{mode}=convertToDbMode($mode);
4787
4788 return $retVal;
4789 }
4790
Junio C Hamanofce13af2017-09-11 14:44:24 +09004791 my($fileHash) = ::safe_pipe_capture("git","rev-parse","$revCommit:$filename");
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004792 chomp $fileHash;
brian m. carlson05ea93d2020-06-22 18:04:16 +00004793 if(!($fileHash=~/^[0-9a-f]{$state->{hexsz}}$/))
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004794 {
4795 die "Invalid fileHash '$fileHash' looking up"
4796 ." '$revCommit:$filename'\n";
4797 }
4798
4799 # information about most recent commit to modify $filename:
4800 open(my $gitLogPipe, '-|', 'git', 'rev-list',
4801 '--max-count=1', '--pretty', '--parents',
4802 $revCommit, '--', $filename)
4803 or die "Cannot call git-rev-list: $!";
4804 my @commits=readCommits($gitLogPipe);
4805 close $gitLogPipe;
4806 if(scalar(@commits)!=1)
4807 {
4808 die "Can't find most recent commit changing $filename\n";
4809 }
4810 my($commit)=$commits[0];
4811 if( !defined($commit) || !defined($commit->{hash}) )
4812 {
4813 return undef;
4814 }
4815
4816 # does this (commit,file) have a real assigned CVS revision number?
4817 my $tablename_rev = $self->tablename("revision");
4818 my $db_query;
4819 $db_query = $self->{dbh}->prepare_cached(
4820 "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4821 {},1);
4822 $db_query->execute($filename, $commit->{hash});
4823 my($meta)=$db_query->fetchrow_hashref;
4824 if($meta)
4825 {
4826 $meta->{revision} = "1.$meta->{revision}";
4827 return $meta;
4828 }
4829
4830 # fall back on special revision number
4831 my($revision)=$commit->{hash};
4832 $revision=~s/(..)/'.' . (hex($1)+100)/eg;
4833 $revision="2.1.1.2000$revision";
4834
4835 # meta data about $filename:
4836 open(my $filePipe, '-|', 'git', 'ls-tree', '-z',
4837 $commit->{hash}, '--', $filename)
4838 or die("Cannot call git-ls-tree : $!");
4839 local $/ = "\0";
4840 my $line;
4841 $line=<$filePipe>;
4842 if(defined(<$filePipe>))
4843 {
4844 die "Expected only a single file for git-ls-tree $filename\n";
4845 }
4846 close $filePipe;
4847
4848 chomp $line;
4849 unless ( $line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4850 {
4851 die("Couldn't process git-ls-tree line : $line\n");
4852 }
4853 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
4854
4855 # save result:
4856 my($retVal)={};
4857 $retVal->{name}=$filename;
4858 $retVal->{revision}=$revision;
4859 $retVal->{filehash}=$fileHash;
4860 $retVal->{commithash}=$revCommit;
4861 $retVal->{author}=$commit->{author};
4862 $retVal->{modified}=convertToCvsDate($commit->{date});
4863 $retVal->{mode}=convertToDbMode($mode);
4864
4865 return $retVal;
4866}
4867
4868=head2 lookupCommitRef
4869
4870Convert tag/branch/abbreviation/etc into a commit sha1 hash. Caches
4871the result so looking it up again is fast.
4872
4873=cut
4874
4875sub lookupCommitRef
4876{
4877 my $self = shift;
4878 my $ref = shift;
4879
4880 my $commitHash = $self->{commitRefCache}{$ref};
4881 if(defined($commitHash))
4882 {
4883 return $commitHash;
4884 }
4885
Junio C Hamanofce13af2017-09-11 14:44:24 +09004886 $commitHash = ::safe_pipe_capture("git","rev-parse","--verify","--quiet",
4887 $self->unescapeRefName($ref));
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004888 $commitHash=~s/\s*$//;
brian m. carlson05ea93d2020-06-22 18:04:16 +00004889 if(!($commitHash=~/^[0-9a-f]{$state->{hexsz}}$/))
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004890 {
4891 $commitHash=undef;
4892 }
4893
4894 if( defined($commitHash) )
4895 {
Junio C Hamanofce13af2017-09-11 14:44:24 +09004896 my $type = ::safe_pipe_capture("git","cat-file","-t",$commitHash);
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004897 if( ! ($type=~/^commit\s*$/ ) )
4898 {
4899 $commitHash=undef;
4900 }
4901 }
4902 if(defined($commitHash))
4903 {
4904 $self->{commitRefCache}{$ref}=$commitHash;
4905 }
4906 return $commitHash;
4907}
4908
4909=head2 clearCommitRefCaches
4910
4911Clears cached commit cache (sha1's for various tags/abbeviations/etc),
4912and related caches.
4913
4914=cut
4915
4916sub clearCommitRefCaches
4917{
4918 my $self = shift;
4919 $self->{commitRefCache} = {};
4920 $self->{revisionDirMapCache} = undef;
4921 $self->{gethead_cache} = undef;
4922}
4923
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004924=head2 commitmessage
4925
4926this function takes a commithash and returns the commit message for that commit
4927
4928=cut
4929sub commitmessage
4930{
4931 my $self = shift;
4932 my $commithash = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004933 my $tablename = $self->tablename("commitmsgs");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004934
brian m. carlson05ea93d2020-06-22 18:04:16 +00004935 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{$state->{hexsz}}$/ );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004936
4937 my $db_query;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004938 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004939 $db_query->execute($commithash);
4940
4941 my ( $message ) = $db_query->fetchrow_array;
4942
4943 if ( defined ( $message ) )
4944 {
4945 $message .= " " if ( $message =~ /\n$/ );
4946 return $message;
4947 }
4948
Junio C Hamanofce13af2017-09-11 14:44:24 +09004949 my @lines = ::safe_pipe_capture("git", "cat-file", "commit", $commithash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004950 shift @lines while ( $lines[0] =~ /\S/ );
4951 $message = join("",@lines);
4952 $message .= " " if ( $message =~ /\n$/ );
4953 return $message;
4954}
4955
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004956=head2 gethistorydense
4957
4958This function takes a filename (with path) argument and returns an arrayofarrays
4959containing revision,filehash,commithash ordered by revision descending.
4960
4961This version of gethistory skips deleted entries -- so it is useful for annotate.
4962The 'dense' part is a reference to a '--dense' option available for git-rev-list
4963and other git tools that depend on it.
4964
Matthew Ogilviea86c0982012-10-13 23:42:18 -06004965See also getlog().
4966
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004967=cut
4968sub gethistorydense
4969{
4970 my $self = shift;
4971 my $filename = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004972 my $tablename = $self->tablename("revision");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004973
4974 my $db_query;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004975 $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 +13004976 $db_query->execute($filename);
4977
Matthew Ogilvieab076812012-10-13 23:42:21 -06004978 my $result = $db_query->fetchall_arrayref;
4979
4980 my $i;
4981 for($i=0 ; $i<scalar(@$result) ; $i++)
4982 {
4983 $result->[$i][0]="1." . $result->[$i][0];
4984 }
4985
4986 return $result;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004987}
4988
Matthew Ogilvie51a7e6d2012-10-13 23:42:26 -06004989=head2 escapeRefName
4990
4991Apply an escape mechanism to compensate for characters that
4992git ref names can have that CVS tags can not.
4993
4994=cut
4995sub escapeRefName
4996{
4997 my($self,$refName)=@_;
4998
4999 # CVS officially only allows [-_A-Za-z0-9] in tag names (or in
5000 # many contexts it can also be a CVS revision number).
5001 #
5002 # Git tags commonly use '/' and '.' as well, but also handle
5003 # anything else just in case:
5004 #
5005 # = "_-s-" For '/'.
5006 # = "_-p-" For '.'.
5007 # = "_-u-" For underscore, in case someone wants a literal "_-" in
5008 # a tag name.
5009 # = "_-xx-" Where "xx" is the hexadecimal representation of the
5010 # desired ASCII character byte. (for anything else)
5011
5012 if(! $refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)
5013 {
5014 $refName=~s/_-/_-u--/g;
5015 $refName=~s/\./_-p-/g;
5016 $refName=~s%/%_-s-%g;
5017 $refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;
5018 }
5019}
5020
5021=head2 unescapeRefName
5022
5023Undo an escape mechanism to compensate for characters that
5024git ref names can have that CVS tags can not.
5025
5026=cut
5027sub unescapeRefName
5028{
5029 my($self,$refName)=@_;
5030
5031 # see escapeRefName() for description of escape mechanism.
5032
5033 $refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;
5034
5035 # allowed tag names
5036 # TODO: Perhaps use git check-ref-format, with an in-process cache of
5037 # validated names?
5038 if( !( $refName=~m%^[^-][-a-zA-Z0-9_/.]*$% ) ||
5039 ( $refName=~m%[/.]$% ) ||
5040 ( $refName=~/\.lock$/ ) ||
5041 ( $refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) ) # matching }
5042 {
5043 # Error:
5044 $log->warn("illegal refName: $refName");
5045 $refName=undef;
5046 }
5047 return $refName;
5048}
5049
5050sub unescapeRefNameChar
5051{
5052 my($char)=@_;
5053
5054 if($char eq "s")
5055 {
5056 $char="/";
5057 }
5058 elsif($char eq "p")
5059 {
5060 $char=".";
5061 }
5062 elsif($char eq "u")
5063 {
5064 $char="_";
5065 }
5066 elsif($char=~/^[0-9a-f][0-9a-f]$/)
5067 {
5068 $char=chr(hex($char));
5069 }
5070 else
5071 {
5072 # Error case: Maybe it has come straight from user, and
5073 # wasn't supposed to be escaped? Restore it the way we got it:
5074 $char="_-$char-";
5075 }
5076
5077 return $char;
5078}
5079
Martin Langhoff3fda8c42006-02-22 22:50:15 +13005080=head2 in_array()
5081
5082from Array::PAT - mimics the in_array() function
5083found in PHP. Yuck but works for small arrays.
5084
5085=cut
5086sub in_array
5087{
5088 my ($check, @array) = @_;
5089 my $retval = 0;
5090 foreach my $test (@array){
5091 if($check eq $test){
5092 $retval = 1;
5093 }
5094 }
5095 return $retval;
5096}
5097
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01005098=head2 mangle_dirname
5099
5100create a string from a directory name that is suitable to use as
5101part of a filename, mainly by converting all chars except \w.- to _
5102
5103=cut
5104sub mangle_dirname {
5105 my $dirname = shift;
5106 return unless defined $dirname;
5107
5108 $dirname =~ s/[^\w.-]/_/g;
5109
5110 return $dirname;
5111}
Martin Langhoff3fda8c42006-02-22 22:50:15 +13005112
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07005113=head2 mangle_tablename
5114
5115create a string from a that is suitable to use as part of an SQL table
5116name, mainly by converting all chars except \w to _
5117
5118=cut
5119sub mangle_tablename {
5120 my $tablename = shift;
5121 return unless defined $tablename;
5122
5123 $tablename =~ s/[^\w_]/_/g;
5124
5125 return $tablename;
5126}
5127
Martin Langhoff3fda8c42006-02-22 22:50:15 +130051281;