blob: 95e69b19a70ba63f2055d6a2ec3f9af0092a0832 [file] [log] [blame]
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001#!/usr/bin/perl
2
3####
4#### This application is a CVS emulation layer for git.
5#### It is intended for clients to connect over SSH.
6#### See the documentation for more details.
7####
8#### Copyright The Open University UK - 2006.
9####
10#### Authors: Martyn Smith <martyn@catalyst.net.nz>
Junio C Hamanoadc31922010-10-05 12:44:08 -070011#### Martin Langhoff <martin@laptop.org>
Martin Langhoff3fda8c42006-02-22 22:50:15 +130012####
13####
14#### Released under the GNU Public License, version 2.
15####
16####
17
Ævar Arnfjörð Bjarmasond48b2842010-09-24 20:00:52 +000018use 5.008;
Martin Langhoff3fda8c42006-02-22 22:50:15 +130019use strict;
20use warnings;
Martin Langhoff4f88d3e2006-12-07 16:38:50 +130021use bytes;
Martin Langhoff3fda8c42006-02-22 22:50:15 +130022
23use Fcntl;
24use File::Temp qw/tempdir tempfile/;
Matthew Ogilvie044182e2008-05-14 22:35:46 -060025use File::Path qw/rmtree/;
Martin Langhoff3fda8c42006-02-22 22:50:15 +130026use File::Basename;
Frank Lichtenheld693b6322007-06-07 16:57:01 +020027use Getopt::Long qw(:config require_order no_ignore_case);
28
29my $VERSION = '@@GIT_VERSION@@';
Martin Langhoff3fda8c42006-02-22 22:50:15 +130030
31my $log = GITCVS::log->new();
32my $cfg;
33
34my $DATE_LIST = {
35 Jan => "01",
36 Feb => "02",
37 Mar => "03",
38 Apr => "04",
39 May => "05",
40 Jun => "06",
41 Jul => "07",
42 Aug => "08",
43 Sep => "09",
44 Oct => "10",
45 Nov => "11",
46 Dec => "12",
47};
48
49# Enable autoflush for STDOUT (otherwise the whole thing falls apart)
50$| = 1;
51
52#### Definition and mappings of functions ####
53
Matthew Ogilvie566c69e2012-10-13 23:42:19 -060054# NOTE: Despite the existence of req_CATCHALL and req_EMPTY unimplemented
55# requests, this list is incomplete. It is missing many rarer/optional
56# requests. Perhaps some clients require a claim of support for
57# these specific requests for main functionality to work?
Martin Langhoff3fda8c42006-02-22 22:50:15 +130058my $methods = {
59 'Root' => \&req_Root,
60 'Valid-responses' => \&req_Validresponses,
61 'valid-requests' => \&req_validrequests,
62 'Directory' => \&req_Directory,
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -060063 'Sticky' => \&req_Sticky,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130064 'Entry' => \&req_Entry,
65 'Modified' => \&req_Modified,
66 'Unchanged' => \&req_Unchanged,
Martin Langhoff7172aab2006-03-01 19:30:35 +130067 'Questionable' => \&req_Questionable,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130068 'Argument' => \&req_Argument,
69 'Argumentx' => \&req_Argument,
70 'expand-modules' => \&req_expandmodules,
71 'add' => \&req_add,
72 'remove' => \&req_remove,
73 'co' => \&req_co,
74 'update' => \&req_update,
75 'ci' => \&req_ci,
76 'diff' => \&req_diff,
77 'log' => \&req_log,
Martin Langhoff7172aab2006-03-01 19:30:35 +130078 'rlog' => \&req_log,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130079 'tag' => \&req_CATCHALL,
80 'status' => \&req_status,
81 'admin' => \&req_CATCHALL,
82 'history' => \&req_CATCHALL,
Damien Diederen38bcd312008-03-27 23:17:26 +010083 'watchers' => \&req_EMPTY,
84 'editors' => \&req_EMPTY,
Stefan Karpinski499cc562009-01-29 17:12:27 -080085 'noop' => \&req_EMPTY,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130086 'annotate' => \&req_annotate,
87 'Global_option' => \&req_Globaloption,
Martin Langhoff3fda8c42006-02-22 22:50:15 +130088};
89
90##############################################
91
92
93# $state holds all the bits of information the clients sends us that could
94# potentially be useful when it comes to actually _doing_ something.
Johannes Schindelin42217f12006-07-25 12:48:52 +020095my $state = { prependdir => '' };
Matthew Ogilvie044182e2008-05-14 22:35:46 -060096
97# Work is for managing temporary working directory
98my $work =
99 {
100 state => undef, # undef, 1 (empty), 2 (with stuff)
101 workDir => undef,
102 index => undef,
103 emptyDir => undef,
104 tmpDir => undef
105 };
106
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300107$log->info("--------------- STARTING -----------------");
108
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200109my $usage =
David Aguilard2bb6242013-02-23 16:50:16 -0800110 "usage: git cvsserver [options] [pserver|server] [<directory> ...]\n".
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200111 " --base-path <path> : Prepend to requested CVSROOT\n".
Phil Miller03bd0d62009-12-30 13:35:31 -0600112 " Can be read from GIT_CVSSERVER_BASE_PATH\n".
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200113 " --strict-paths : Don't allow recursing into subdirectories\n".
114 " --export-all : Don't check for gitcvs.enabled in config\n".
115 " --version, -V : Print version information and exit\n".
Clemens Buchacher87182b12011-10-03 20:21:36 +0200116 " -h, -H : Print usage information and exit\n".
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200117 "\n".
118 "<directory> ... is a list of allowed directories. If no directories\n".
119 "are given, all are allowed. This is an additional restriction, gitcvs\n".
Phil Miller03bd0d62009-12-30 13:35:31 -0600120 "access still needs to be enabled by the gitcvs.enabled config option.\n".
121 "Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n";
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200122
Clemens Buchacher87182b12011-10-03 20:21:36 +0200123my @opts = ( 'h|H', 'version|V',
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200124 'base-path=s', 'strict-paths', 'export-all' );
125GetOptions( $state, @opts )
126 or die $usage;
127
128if ($state->{version}) {
129 print "git-cvsserver version $VERSION\n";
130 exit;
131}
132if ($state->{help}) {
133 print $usage;
134 exit;
135}
136
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300137my $TEMP_DIR = tempdir( CLEANUP => 1 );
138$log->debug("Temporary directory is '$TEMP_DIR'");
139
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200140$state->{method} = 'ext';
141if (@ARGV) {
142 if ($ARGV[0] eq 'pserver') {
143 $state->{method} = 'pserver';
144 shift @ARGV;
145 } elsif ($ARGV[0] eq 'server') {
146 shift @ARGV;
147 }
148}
149
150# everything else is a directory
151$state->{allowed_roots} = [ @ARGV ];
152
Frank Lichtenheld226bccb2007-06-15 03:01:53 +0200153# don't export the whole system unless the users requests it
154if ($state->{'export-all'} && !@{$state->{allowed_roots}}) {
155 die "--export-all can only be used together with an explicit whitelist\n";
156}
157
Phil Miller03bd0d62009-12-30 13:35:31 -0600158# Environment handling for running under git-shell
159if (exists $ENV{GIT_CVSSERVER_BASE_PATH}) {
160 if ($state->{'base-path'}) {
161 die "Cannot specify base path both ways.\n";
162 }
163 my $base_path = $ENV{GIT_CVSSERVER_BASE_PATH};
164 $state->{'base-path'} = $base_path;
165 $log->debug("Picked up base path '$base_path' from environment.\n");
166}
167if (exists $ENV{GIT_CVSSERVER_ROOT}) {
168 if (@{$state->{allowed_roots}}) {
169 die "Cannot specify roots both ways: @ARGV\n";
170 }
171 my $allowed_root = $ENV{GIT_CVSSERVER_ROOT};
172 $state->{allowed_roots} = [ $allowed_root ];
173 $log->debug("Picked up allowed root '$allowed_root' from environment.\n");
174}
175
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300176# if we are called with a pserver argument,
Junio C Hamano5348b6e2006-04-25 23:59:28 -0700177# deal with the authentication cat before entering the
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300178# main loop
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200179if ($state->{method} eq 'pserver') {
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300180 my $line = <STDIN>; chomp $line;
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200181 unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300182 die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
183 }
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200184 my $request = $1;
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300185 $line = <STDIN>; chomp $line;
Brian Gernhardt2a4b5d52007-10-17 10:05:47 -0400186 unless (req_Root('root', $line)) { # reuse Root
187 print "E Invalid root $line \n";
188 exit 1;
189 }
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300190 $line = <STDIN>; chomp $line;
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000191 my $user = $line;
192 $line = <STDIN>; chomp $line;
193 my $password = $line;
194
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000195 if ($user eq 'anonymous') {
196 # "A" will be 1 byte, use length instead in case the
197 # encryption method ever changes (yeah, right!)
198 if (length($password) > 1 ) {
199 print "E Don't supply a password for the `anonymous' user\n";
200 print "I HATE YOU\n";
201 exit 1;
202 }
203
204 # Fall through to LOVE
205 } else {
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000206 # Trying to authenticate a user
Sam Vilainc057bad2010-05-15 15:07:54 +0000207 if (not exists $cfg->{gitcvs}->{authdb}) {
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000208 print "E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n";
209 print "I HATE YOU\n";
210 exit 1;
211 }
212
213 my $authdb = $cfg->{gitcvs}->{authdb};
214
215 unless (-e $authdb) {
216 print "E The authentication database specified in [gitcvs.authdb] does not exist\n";
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000217 print "I HATE YOU\n";
218 exit 1;
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000219 }
Ævar Arnfjörð Bjarmason30525252010-05-15 02:46:01 +0000220
221 my $auth_ok;
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000222 open my $passwd, "<", $authdb or die $!;
Ævar Arnfjörð Bjarmason30525252010-05-15 02:46:01 +0000223 while (<$passwd>) {
224 if (m{^\Q$user\E:(.*)}) {
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000225 if (crypt($user, descramble($password)) eq $1) {
Ævar Arnfjörð Bjarmason30525252010-05-15 02:46:01 +0000226 $auth_ok = 1;
227 }
228 };
229 }
230 close $passwd;
231
232 unless ($auth_ok) {
Sam Vilainc057bad2010-05-15 15:07:54 +0000233 print "I HATE YOU\n";
234 exit 1;
235 }
Ævar Arnfjörð Bjarmason475357a2010-05-15 02:46:02 +0000236
237 # Fall through to LOVE
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300238 }
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +0000239
240 # For checking whether the user is anonymous on commit
241 $state->{user} = $user;
242
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300243 $line = <STDIN>; chomp $line;
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200244 unless ($line eq "END $request REQUEST") {
245 die "E Do not understand $line -- expecting END $request REQUEST\n";
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300246 }
247 print "I LOVE YOU\n";
Frank Lichtenheld24a97d82007-05-27 14:33:10 +0200248 exit if $request eq 'VERIFICATION'; # cvs login
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300249 # and now back to our regular programme...
250}
251
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300252# Keep going until the client closes the connection
253while (<STDIN>)
254{
255 chomp;
256
Junio C Hamano5348b6e2006-04-25 23:59:28 -0700257 # Check to see if we've seen this method, and call appropriate function.
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300258 if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
259 {
260 # use the $methods hash to call the appropriate sub for this command
261 #$log->info("Method : $1");
262 &{$methods->{$1}}($1,$2);
263 } else {
264 # log fatal because we don't understand this function. If this happens
265 # we're fairly screwed because we don't know if the client is expecting
266 # a response. If it is, the client will hang, we'll hang, and the whole
267 # thing will be custard.
268 $log->fatal("Don't understand command $_\n");
269 die("Unknown command $_");
270 }
271}
272
273$log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
274$log->info("--------------- FINISH -----------------");
275
Matthew Ogilvie044182e2008-05-14 22:35:46 -0600276chdir '/';
277exit 0;
278
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300279# Magic catchall method.
280# This is the method that will handle all commands we haven't yet
281# implemented. It simply sends a warning to the log file indicating a
282# command that hasn't been implemented has been invoked.
283sub req_CATCHALL
284{
285 my ( $cmd, $data ) = @_;
286 $log->warn("Unhandled command : req_$cmd : $data");
287}
288
Damien Diederen38bcd312008-03-27 23:17:26 +0100289# This method invariably succeeds with an empty response.
290sub req_EMPTY
291{
292 print "ok\n";
293}
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300294
295# Root pathname \n
296# Response expected: no. Tell the server which CVSROOT to use. Note that
297# pathname is a local directory and not a fully qualified CVSROOT variable.
298# pathname must already exist; if creating a new root, use the init
299# request, not Root. pathname does not include the hostname of the server,
300# how to access the server, etc.; by the time the CVS protocol is in use,
301# connection, authentication, etc., are already taken care of. The Root
302# request must be sent only once, and it must be sent before any requests
303# other than Valid-responses, valid-requests, UseUnchanged, Set or init.
304sub req_Root
305{
306 my ( $cmd, $data ) = @_;
307 $log->debug("req_Root : $data");
308
Frank Lichtenheld48908882007-06-07 16:57:00 +0200309 unless ($data =~ m#^/#) {
310 print "error 1 Root must be an absolute pathname\n";
311 return 0;
312 }
313
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200314 my $cvsroot = $state->{'base-path'} || '';
315 $cvsroot =~ s#/+$##;
316 $cvsroot .= $data;
317
Frank Lichtenheld48908882007-06-07 16:57:00 +0200318 if ($state->{CVSROOT}
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200319 && ($state->{CVSROOT} ne $cvsroot)) {
Frank Lichtenheld48908882007-06-07 16:57:00 +0200320 print "error 1 Conflicting roots specified\n";
321 return 0;
322 }
323
Frank Lichtenheldfd1cd912007-06-15 03:01:52 +0200324 $state->{CVSROOT} = $cvsroot;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300325
326 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200327
328 if (@{$state->{allowed_roots}}) {
329 my $allowed = 0;
330 foreach my $dir (@{$state->{allowed_roots}}) {
331 next unless $dir =~ m#^/#;
332 $dir =~ s#/+$##;
333 if ($state->{'strict-paths'}) {
334 if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
335 $allowed = 1;
336 last;
337 }
338 } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
339 $allowed = 1;
340 last;
341 }
342 }
343
344 unless ($allowed) {
345 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
346 print "E \n";
347 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
348 return 0;
349 }
350 }
351
Martin Langhoffcdb67602006-03-04 17:47:22 +1300352 unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
353 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
Frank Lichtenheld693b6322007-06-07 16:57:01 +0200354 print "E \n";
355 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
Martin Langhoffcdb67602006-03-04 17:47:22 +1300356 return 0;
357 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300358
Gerrit Paped2feb012009-09-02 09:23:10 +0000359 my @gitvars = `git config -l`;
Martin Langhoffcdb67602006-03-04 17:47:22 +1300360 if ($?) {
Tom Princee0d10e12007-01-28 16:16:53 -0800361 print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
Martin Langhoffcdb67602006-03-04 17:47:22 +1300362 print "E \n";
Tom Princee0d10e12007-01-28 16:16:53 -0800363 print "error 1 - problem executing git-config\n";
Martin Langhoffcdb67602006-03-04 17:47:22 +1300364 return 0;
365 }
366 foreach my $line ( @gitvars )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300367 {
Sam Vilainc057bad2010-05-15 15:07:54 +0000368 next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
Frank Lichtenheldf987afa2007-05-13 02:16:24 +0200369 unless ($2) {
370 $cfg->{$1}{$3} = $4;
Frank Lichtenheld92a39a12007-03-19 16:55:58 +0100371 } else {
372 $cfg->{$1}{$2}{$3} = $4;
373 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300374 }
375
Junio C Hamano523d12e2007-05-20 17:57:27 -0700376 my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
377 || $cfg->{gitcvs}{enabled});
Frank Lichtenheld226bccb2007-06-15 03:01:53 +0200378 unless ($state->{'export-all'} ||
379 ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300380 print "E GITCVS emulation needs to be enabled on this repo\n";
381 print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
382 print "E \n";
383 print "error 1 GITCVS emulation disabled\n";
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300384 return 0;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300385 }
386
Frank Lichtenheldd55820c2007-03-19 16:55:59 +0100387 my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
388 if ( $logfile )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300389 {
Frank Lichtenheldd55820c2007-03-19 16:55:59 +0100390 $log->setfile($logfile);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300391 } else {
392 $log->nofile();
393 }
Martin Langhoff91a6bf42006-03-04 20:30:04 +1300394
395 return 1;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300396}
397
398# Global_option option \n
399# Response expected: no. Transmit one of the global options `-q', `-Q',
400# `-l', `-t', `-r', or `-n'. option must be one of those strings, no
401# variations (such as combining of options) are allowed. For graceful
402# handling of valid-requests, it is probably better to make new global
403# options separate requests, rather than trying to add them to this
404# request.
405sub req_Globaloption
406{
407 my ( $cmd, $data ) = @_;
408 $log->debug("req_Globaloption : $data");
Martyn Smith7d900952006-03-27 15:51:42 +1200409 $state->{globaloptions}{$data} = 1;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300410}
411
412# Valid-responses request-list \n
413# Response expected: no. Tell the server what responses the client will
414# accept. request-list is a space separated list of tokens.
415sub req_Validresponses
416{
417 my ( $cmd, $data ) = @_;
Junio C Hamano5348b6e2006-04-25 23:59:28 -0700418 $log->debug("req_Validresponses : $data");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300419
420 # TODO : re-enable this, currently it's not particularly useful
421 #$state->{validresponses} = [ split /\s+/, $data ];
422}
423
424# valid-requests \n
425# Response expected: yes. Ask the server to send back a Valid-requests
426# response.
427sub req_validrequests
428{
429 my ( $cmd, $data ) = @_;
430
431 $log->debug("req_validrequests");
432
Anders Kaseorg94629532013-10-30 04:44:43 -0400433 $log->debug("SEND : Valid-requests " . join(" ",sort keys %$methods));
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300434 $log->debug("SEND : ok");
435
Anders Kaseorg94629532013-10-30 04:44:43 -0400436 print "Valid-requests " . join(" ",sort keys %$methods) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300437 print "ok\n";
438}
439
440# Directory local-directory \n
441# Additional data: repository \n. Response expected: no. Tell the server
442# what directory to use. The repository should be a directory name from a
443# previous server response. Note that this both gives a default for Entry
444# and Modified and also for ci and the other commands; normal usage is to
445# send Directory for each directory in which there will be an Entry or
446# Modified, and then a final Directory for the original directory, then the
447# command. The local-directory is relative to the top level at which the
448# command is occurring (i.e. the last Directory which is sent before the
449# command); to indicate that top level, `.' should be sent for
450# local-directory.
451sub req_Directory
452{
453 my ( $cmd, $data ) = @_;
454
455 my $repository = <STDIN>;
456 chomp $repository;
457
458
459 $state->{localdir} = $data;
460 $state->{repository} = $repository;
Martyn Smith7d900952006-03-27 15:51:42 +1200461 $state->{path} = $repository;
Gerrit Papef9acaea2010-01-26 14:47:16 +0000462 $state->{path} =~ s/^\Q$state->{CVSROOT}\E\///;
Martyn Smith7d900952006-03-27 15:51:42 +1200463 $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
464 $state->{path} .= "/" if ( $state->{path} =~ /\S/ );
465
466 $state->{directory} = $state->{localdir};
467 $state->{directory} = "" if ( $state->{directory} eq "." );
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300468 $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
469
Johannes Schindelind988b822006-10-11 00:33:28 +0200470 if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
Martyn Smith7d900952006-03-27 15:51:42 +1200471 {
472 $log->info("Setting prepend to '$state->{path}'");
473 $state->{prependdir} = $state->{path};
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600474 my %entries;
Martyn Smith7d900952006-03-27 15:51:42 +1200475 foreach my $entry ( keys %{$state->{entries}} )
476 {
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600477 $entries{$state->{prependdir} . $entry} = $state->{entries}{$entry};
Martyn Smith7d900952006-03-27 15:51:42 +1200478 }
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600479 $state->{entries}=\%entries;
480
481 my %dirMap;
482 foreach my $dir ( keys %{$state->{dirMap}} )
483 {
484 $dirMap{$state->{prependdir} . $dir} = $state->{dirMap}{$dir};
485 }
486 $state->{dirMap}=\%dirMap;
Martyn Smith7d900952006-03-27 15:51:42 +1200487 }
488
489 if ( defined ( $state->{prependdir} ) )
490 {
491 $log->debug("Prepending '$state->{prependdir}' to state|directory");
492 $state->{directory} = $state->{prependdir} . $state->{directory}
493 }
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600494
495 if ( ! defined($state->{dirMap}{$state->{directory}}) )
496 {
497 $state->{dirMap}{$state->{directory}} =
498 {
499 'names' => {}
500 #'tagspec' => undef
501 };
502 }
503
Martyn Smith82000d72006-03-28 13:24:27 +1200504 $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300505}
506
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600507# Sticky tagspec \n
508# Response expected: no. Tell the server that the directory most
509# recently specified with Directory has a sticky tag or date
510# tagspec. The first character of tagspec is T for a tag, D for
511# a date, or some other character supplied by a Set-sticky
512# response from a previous request to the server. The remainder
513# of tagspec contains the actual tag or date, again as supplied
514# by Set-sticky.
515# The server should remember Static-directory and Sticky requests
516# for a particular directory; the client need not resend them each
517# time it sends a Directory request for a given directory. However,
518# the server is not obliged to remember them beyond the context
519# of a single command.
520sub req_Sticky
521{
522 my ( $cmd, $tagspec ) = @_;
523
524 my ( $stickyInfo );
525 if($tagspec eq "")
526 {
527 # nothing
528 }
529 elsif($tagspec=~/^T([^ ]+)\s*$/)
530 {
531 $stickyInfo = { 'tag' => $1 };
532 }
533 elsif($tagspec=~/^D([0-9.]+)\s*$/)
534 {
535 $stickyInfo= { 'date' => $1 };
536 }
537 else
538 {
539 die "Unknown tag_or_date format\n";
540 }
541 $state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo;
542
543 $log->debug("req_Sticky : tagspec=$tagspec repository=$state->{repository}"
544 . " path=$state->{path} directory=$state->{directory}"
545 . " module=$state->{module}");
546}
547
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300548# Entry entry-line \n
549# Response expected: no. Tell the server what version of a file is on the
550# local machine. The name in entry-line is a name relative to the directory
551# most recently specified with Directory. If the user is operating on only
552# some files in a directory, Entry requests for only those files need be
553# included. If an Entry request is sent without Modified, Is-modified, or
554# Unchanged, it means the file is lost (does not exist in the working
555# directory). If both Entry and one of Modified, Is-modified, or Unchanged
556# are sent for the same file, Entry must be sent first. For a given file,
557# one can send Modified, Is-modified, or Unchanged, but not more than one
558# of these three.
559sub req_Entry
560{
561 my ( $cmd, $data ) = @_;
562
Martyn Smith7d900952006-03-27 15:51:42 +1200563 #$log->debug("req_Entry : $data");
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300564
Matthew Ogilvieabd66f22012-10-13 23:42:23 -0600565 my @data = split(/\//, $data, -1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300566
567 $state->{entries}{$state->{directory}.$data[1]} = {
568 revision => $data[2],
569 conflict => $data[3],
570 options => $data[4],
571 tag_or_date => $data[5],
572 };
Martyn Smith7d900952006-03-27 15:51:42 +1200573
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -0600574 $state->{dirMap}{$state->{directory}}{names}{$data[1]} = 'F';
575
Martyn Smith7d900952006-03-27 15:51:42 +1200576 $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
577}
578
579# Questionable filename \n
580# Response expected: no. Additional data: no. Tell the server to check
581# whether filename should be ignored, and if not, next time the server
582# sends responses, send (in a M response) `?' followed by the directory and
583# filename. filename must not contain `/'; it needs to be a file in the
584# directory named by the most recent Directory request.
585sub req_Questionable
586{
587 my ( $cmd, $data ) = @_;
588
589 $log->debug("req_Questionable : $data");
590 $state->{entries}{$state->{directory}.$data}{questionable} = 1;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300591}
592
593# add \n
594# Response expected: yes. Add a file or directory. This uses any previous
595# Argument, Directory, Entry, or Modified requests, if they have been sent.
596# The last Directory sent specifies the working directory at the time of
597# the operation. To add a directory, send the directory to be added using
598# Directory and Argument requests.
599sub req_add
600{
601 my ( $cmd, $data ) = @_;
602
603 argsplit("add");
604
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200605 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
606 $updater->update();
607
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300608 my $addcount = 0;
609
610 foreach my $filename ( @{$state->{args}} )
611 {
612 $filename = filecleanup($filename);
613
Matthew Ogilvie61717662012-10-13 23:42:31 -0600614 # no -r, -A, or -D with add
615 my $stickyInfo = resolveStickyInfo($filename);
616
617 my $meta = $updater->getmeta($filename,$stickyInfo);
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200618 my $wrev = revparse($filename);
619
Matthew Ogilvieab076812012-10-13 23:42:21 -0600620 if ($wrev && $meta && ($wrev=~/^-/))
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200621 {
622 # previously removed file, add back
Matthew Ogilvieab076812012-10-13 23:42:21 -0600623 $log->info("added file $filename was previously removed, send $meta->{revision}");
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200624
625 print "MT +updated\n";
626 print "MT text U \n";
627 print "MT fname $filename\n";
628 print "MT newline\n";
629 print "MT -updated\n";
630
631 unless ( $state->{globaloptions}{-n} )
632 {
633 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
634
635 print "Created $dirpart\n";
636 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
637
638 # this is an "entries" line
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600639 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600640 my $entryLine = "/$filepart/$meta->{revision}//$kopts/";
641 $entryLine .= getStickyTagOrDate($stickyInfo);
642 $log->debug($entryLine);
643 print "$entryLine\n";
Frank Lichtenheld4db0c8d2007-04-12 00:51:33 +0200644 # permissions
645 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
646 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
647 # transmit file
648 transmitfile($meta->{filehash});
649 }
650
651 next;
652 }
653
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300654 unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
655 {
656 print "E cvs add: nothing known about `$filename'\n";
657 next;
658 }
659 # TODO : check we're not squashing an already existing file
660 if ( defined ( $state->{entries}{$filename}{revision} ) )
661 {
662 print "E cvs add: `$filename' has already been entered\n";
663 next;
664 }
665
Martyn Smith7d900952006-03-27 15:51:42 +1200666 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300667
668 print "E cvs add: scheduling file `$filename' for addition\n";
669
670 print "Checked-in $dirpart\n";
671 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600672 my $kopts = kopts_from_path($filename,"file",
673 $state->{entries}{$filename}{modified_filename});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600674 print "/$filepart/0//$kopts/" .
675 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300676
Matthew Ogilvie8a06a632008-05-14 22:35:47 -0600677 my $requestedKopts = $state->{opt}{k};
678 if(defined($requestedKopts))
679 {
680 $requestedKopts = "-k$requestedKopts";
681 }
682 else
683 {
684 $requestedKopts = "";
685 }
686 if( $kopts ne $requestedKopts )
687 {
688 $log->warn("Ignoring requested -k='$requestedKopts'"
689 . " for '$filename'; detected -k='$kopts' instead");
690 #TODO: Also have option to send warning to user?
691 }
692
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300693 $addcount++;
694 }
695
696 if ( $addcount == 1 )
697 {
698 print "E cvs add: use `cvs commit' to add this file permanently\n";
699 }
700 elsif ( $addcount > 1 )
701 {
702 print "E cvs add: use `cvs commit' to add these files permanently\n";
703 }
704
705 print "ok\n";
706}
707
708# remove \n
709# Response expected: yes. Remove a file. This uses any previous Argument,
710# Directory, Entry, or Modified requests, if they have been sent. The last
711# Directory sent specifies the working directory at the time of the
712# operation. Note that this request does not actually do anything to the
713# repository; the only effect of a successful remove request is to supply
714# the client with a new entries line containing `-' to indicate a removed
715# file. In fact, the client probably could perform this operation without
716# contacting the server, although using remove may cause the server to
717# perform a few more checks. The client sends a subsequent ci request to
718# actually record the removal in the repository.
719sub req_remove
720{
721 my ( $cmd, $data ) = @_;
722
723 argsplit("remove");
724
725 # Grab a handle to the SQLite db and do any necessary updates
726 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
727 $updater->update();
728
729 #$log->debug("add state : " . Dumper($state));
730
731 my $rmcount = 0;
732
733 foreach my $filename ( @{$state->{args}} )
734 {
735 $filename = filecleanup($filename);
736
737 if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
738 {
739 print "E cvs remove: file `$filename' still in working directory\n";
740 next;
741 }
742
Matthew Ogilvie61717662012-10-13 23:42:31 -0600743 # only from entries
744 my $stickyInfo = resolveStickyInfo($filename);
745
746 my $meta = $updater->getmeta($filename,$stickyInfo);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300747 my $wrev = revparse($filename);
748
749 unless ( defined ( $wrev ) )
750 {
751 print "E cvs remove: nothing known about `$filename'\n";
752 next;
753 }
754
Matthew Ogilvieab076812012-10-13 23:42:21 -0600755 if ( defined($wrev) and ($wrev=~/^-/) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300756 {
757 print "E cvs remove: file `$filename' already scheduled for removal\n";
758 next;
759 }
760
Matthew Ogilvieab076812012-10-13 23:42:21 -0600761 unless ( $wrev eq $meta->{revision} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300762 {
763 # TODO : not sure if the format of this message is quite correct.
764 print "E cvs remove: Up to date check failed for `$filename'\n";
765 next;
766 }
767
768
Martyn Smith7d900952006-03-27 15:51:42 +1200769 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300770
771 print "E cvs remove: scheduling `$filename' for removal\n";
772
773 print "Checked-in $dirpart\n";
774 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -0600775 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -0600776 print "/$filepart/-$wrev//$kopts/" . getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300777
778 $rmcount++;
779 }
780
781 if ( $rmcount == 1 )
782 {
783 print "E cvs remove: use `cvs commit' to remove this file permanently\n";
784 }
785 elsif ( $rmcount > 1 )
786 {
787 print "E cvs remove: use `cvs commit' to remove these files permanently\n";
788 }
789
790 print "ok\n";
791}
792
793# Modified filename \n
794# Response expected: no. Additional data: mode, \n, file transmission. Send
795# the server a copy of one locally modified file. filename is a file within
796# the most recent directory sent with Directory; it must not contain `/'.
797# If the user is operating on only some files in a directory, only those
798# files need to be included. This can also be sent without Entry, if there
799# is no entry for the file.
800sub req_Modified
801{
802 my ( $cmd, $data ) = @_;
803
804 my $mode = <STDIN>;
Jim Meyeringa5e40792007-07-14 20:48:42 +0200805 defined $mode
806 or (print "E end of file reading mode for $data\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300807 chomp $mode;
808 my $size = <STDIN>;
Jim Meyeringa5e40792007-07-14 20:48:42 +0200809 defined $size
810 or (print "E end of file reading size of $data\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300811 chomp $size;
812
813 # Grab config information
814 my $blocksize = 8192;
815 my $bytesleft = $size;
816 my $tmp;
817
818 # Get a filehandle/name to write it to
819 my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
820
821 # Loop over file data writing out to temporary file.
822 while ( $bytesleft )
823 {
824 $blocksize = $bytesleft if ( $bytesleft < $blocksize );
825 read STDIN, $tmp, $blocksize;
826 print $fh $tmp;
827 $bytesleft -= $blocksize;
828 }
829
Jim Meyeringa5e40792007-07-14 20:48:42 +0200830 close $fh
831 or (print "E failed to write temporary, $filename: $!\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300832
833 # Ensure we have something sensible for the file mode
834 if ( $mode =~ /u=(\w+)/ )
835 {
836 $mode = $1;
837 } else {
838 $mode = "rw";
839 }
840
841 # Save the file data in $state
842 $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
843 $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
Gerrit Paped2feb012009-09-02 09:23:10 +0000844 $state->{entries}{$state->{directory}.$data}{modified_hash} = `git hash-object $filename`;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300845 $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
846
847 #$log->debug("req_Modified : file=$data mode=$mode size=$size");
848}
849
850# Unchanged filename \n
851# Response expected: no. Tell the server that filename has not been
852# modified in the checked out directory. The filename is a file within the
853# most recent directory sent with Directory; it must not contain `/'.
854sub req_Unchanged
855{
856 my ( $cmd, $data ) = @_;
857
858 $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
859
860 #$log->debug("req_Unchanged : $data");
861}
862
863# Argument text \n
864# Response expected: no. Save argument for use in a subsequent command.
865# Arguments accumulate until an argument-using command is given, at which
866# point they are forgotten.
867# Argumentx text \n
868# Response expected: no. Append \n followed by text to the current argument
869# being saved.
870sub req_Argument
871{
872 my ( $cmd, $data ) = @_;
873
Johannes Schindelin2c3cff42006-07-26 21:59:08 +0200874 # Argumentx means: append to last Argument (with a newline in front)
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300875
876 $log->debug("$cmd : $data");
877
Johannes Schindelin2c3cff42006-07-26 21:59:08 +0200878 if ( $cmd eq 'Argumentx') {
879 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
880 } else {
881 push @{$state->{arguments}}, $data;
882 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300883}
884
885# expand-modules \n
886# Response expected: yes. Expand the modules which are specified in the
887# arguments. Returns the data in Module-expansion responses. Note that the
888# server can assume that this is checkout or export, not rtag or rdiff; the
889# latter do not access the working directory and thus have no need to
890# expand modules on the client side. Expand may not be the best word for
891# what this request does. It does not necessarily tell you all the files
892# contained in a module, for example. Basically it is a way of telling you
893# which working directories the server needs to know about in order to
894# handle a checkout of the specified modules. For example, suppose that the
895# server has a module defined by
896# aliasmodule -a 1dir
897# That is, one can check out aliasmodule and it will take 1dir in the
898# repository and check it out to 1dir in the working directory. Now suppose
899# the client already has this module checked out and is planning on using
900# the co request to update it. Without using expand-modules, the client
901# would have two bad choices: it could either send information about all
902# working directories under the current directory, which could be
903# unnecessarily slow, or it could be ignorant of the fact that aliasmodule
904# stands for 1dir, and neglect to send information for 1dir, which would
905# lead to incorrect operation. With expand-modules, the client would first
906# ask for the module to be expanded:
907sub req_expandmodules
908{
909 my ( $cmd, $data ) = @_;
910
911 argsplit();
912
913 $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
914
915 unless ( ref $state->{arguments} eq "ARRAY" )
916 {
917 print "ok\n";
918 return;
919 }
920
921 foreach my $module ( @{$state->{arguments}} )
922 {
923 $log->debug("SEND : Module-expansion $module");
924 print "Module-expansion $module\n";
925 }
926
927 print "ok\n";
928 statecleanup();
929}
930
931# co \n
932# Response expected: yes. Get files from the repository. This uses any
933# previous Argument, Directory, Entry, or Modified requests, if they have
934# been sent. Arguments to this command are module names; the client cannot
935# know what directories they correspond to except by (1) just sending the
936# co request, and then seeing what directory names the server sends back in
937# its responses, and (2) the expand-modules request.
938sub req_co
939{
940 my ( $cmd, $data ) = @_;
941
942 argsplit("co");
943
Lars Noschinski89a91672008-07-17 19:00:29 +0200944 # Provide list of modules, if -c was used.
945 if (exists $state->{opt}{c}) {
946 my $showref = `git show-ref --heads`;
947 for my $line (split '\n', $showref) {
948 if ( $line =~ m% refs/heads/(.*)$% ) {
949 print "M $1\t$1\n";
950 }
951 }
952 print "ok\n";
953 return 1;
954 }
955
Matthew Ogilvie61717662012-10-13 23:42:31 -0600956 my $stickyInfo = { 'tag' => $state->{opt}{r},
957 'date' => $state->{opt}{D} };
958
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300959 my $module = $state->{args}[0];
Matthew Ogilvie8a06a632008-05-14 22:35:47 -0600960 $state->{module} = $module;
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300961 my $checkout_path = $module;
962
963 # use the user specified directory if we're given it
964 $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
965
966 $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
967
968 $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
969
970 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
971
972 # Grab a handle to the SQLite db and do any necessary updates
973 my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
974 $updater->update();
975
Matthew Ogilvie61717662012-10-13 23:42:31 -0600976 my $headHash;
977 if( defined($stickyInfo) && defined($stickyInfo->{tag}) )
978 {
979 $headHash = $updater->lookupCommitRef($stickyInfo->{tag});
980 if( !defined($headHash) )
981 {
982 print "error 1 no such tag `$stickyInfo->{tag}'\n";
983 cleanupWorkTree();
984 exit;
985 }
986 }
987
Martin Langhoffc8c4f222006-03-02 13:58:57 +1300988 $checkout_path =~ s|/$||; # get rid of trailing slashes
989
Martin Langhoffc8c4f222006-03-02 13:58:57 +1300990 my %seendirs = ();
Martin Langhoff501c7372006-03-03 16:38:03 +1300991 my $lastdir ='';
Martin Langhoff3fda8c42006-02-22 22:50:15 +1300992
Matthew Ogilvie61717662012-10-13 23:42:31 -0600993 prepDirForOutput(
994 ".",
995 $state->{CVSROOT} . "/$module",
996 $checkout_path,
997 \%seendirs,
998 'checkout',
999 $state->{dirArgs} );
Martin Langhoff6be32d42006-03-04 17:47:29 +13001000
Matthew Ogilvie61717662012-10-13 23:42:31 -06001001 foreach my $git ( @{$updater->getAnyHead($headHash)} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001002 {
1003 # Don't want to check out deleted files
1004 next if ( $git->{filehash} eq "deleted" );
1005
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06001006 my $fullName = $git->{name};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001007 ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
1008
Matthew Ogilvie61717662012-10-13 23:42:31 -06001009 unless (exists($seendirs{$git->{dir}})) {
1010 prepDirForOutput($git->{dir}, $state->{CVSROOT} . "/$module/",
1011 $checkout_path, \%seendirs, 'checkout',
1012 $state->{dirArgs} );
1013 $lastdir = $git->{dir};
1014 $seendirs{$git->{dir}} = 1;
1015 }
Martin Langhoff6be32d42006-03-04 17:47:29 +13001016
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001017 # modification time of this file
1018 print "Mod-time $git->{modified}\n";
1019
1020 # print some information to the client
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001021 if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
1022 {
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001023 print "M U $checkout_path/$git->{dir}$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001024 } else {
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001025 print "M U $checkout_path/$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001026 }
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001027
Martin Langhoff6be32d42006-03-04 17:47:29 +13001028 # instruct client we're sending a file to put in this path
1029 print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
Martin Langhoffc8c4f222006-03-02 13:58:57 +13001030
Martin Langhoff6be32d42006-03-04 17:47:29 +13001031 print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001032
1033 # this is an "entries" line
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001034 my $kopts = kopts_from_path($fullName,"sha1",$git->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001035 print "/$git->{name}/$git->{revision}//$kopts/" .
1036 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001037 # permissions
1038 print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
1039
1040 # transmit file
1041 transmitfile($git->{filehash});
1042 }
1043
1044 print "ok\n";
1045
1046 statecleanup();
1047}
1048
Matthew Ogilvie61717662012-10-13 23:42:31 -06001049# used by req_co and req_update to set up directories for files
1050# recursively handles parents
1051sub prepDirForOutput
1052{
1053 my ($dir, $repodir, $remotedir, $seendirs, $request, $dirArgs) = @_;
1054
1055 my $parent = dirname($dir);
1056 $dir =~ s|/+$||;
1057 $repodir =~ s|/+$||;
1058 $remotedir =~ s|/+$||;
1059 $parent =~ s|/+$||;
1060
1061 if ($parent eq '.' || $parent eq './')
1062 {
1063 $parent = '';
1064 }
1065 # recurse to announce unseen parents first
1066 if( length($parent) &&
1067 !exists($seendirs->{$parent}) &&
1068 ( $request eq "checkout" ||
1069 exists($dirArgs->{$parent}) ) )
1070 {
1071 prepDirForOutput($parent, $repodir, $remotedir,
1072 $seendirs, $request, $dirArgs);
1073 }
1074 # Announce that we are going to modify at the parent level
1075 if ($dir eq '.' || $dir eq './')
1076 {
1077 $dir = '';
1078 }
1079 if(exists($seendirs->{$dir}))
1080 {
1081 return;
1082 }
1083 $log->debug("announcedir $dir, $repodir, $remotedir" );
1084 my($thisRemoteDir,$thisRepoDir);
1085 if ($dir ne "")
1086 {
1087 $thisRepoDir="$repodir/$dir";
1088 if($remotedir eq ".")
1089 {
1090 $thisRemoteDir=$dir;
1091 }
1092 else
1093 {
1094 $thisRemoteDir="$remotedir/$dir";
1095 }
1096 }
1097 else
1098 {
1099 $thisRepoDir=$repodir;
1100 $thisRemoteDir=$remotedir;
1101 }
1102 unless ( $state->{globaloptions}{-Q} || $state->{globaloptions}{-q} )
1103 {
1104 print "E cvs $request: Updating $thisRemoteDir\n";
1105 }
1106
1107 my ($opt_r)=$state->{opt}{r};
1108 my $stickyInfo;
1109 if(exists($state->{opt}{A}))
1110 {
1111 # $stickyInfo=undef;
1112 }
1113 elsif( defined($opt_r) && $opt_r ne "" )
1114 # || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO
1115 {
1116 $stickyInfo={ 'tag' => (defined($opt_r)?$opt_r:undef) };
1117
1118 # TODO: Convert -D value into the form 2011.04.10.04.46.57,
1119 # similar to an entry line's sticky date, without the D prefix.
1120 # It sometimes (always?) arrives as something more like
1121 # '10 Apr 2011 04:46:57 -0000'...
1122 # $stickyInfo={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
1123 }
1124 else
1125 {
1126 $stickyInfo=getDirStickyInfo($state->{prependdir} . $dir);
1127 }
1128
1129 my $stickyResponse;
1130 if(defined($stickyInfo))
1131 {
1132 $stickyResponse = "Set-sticky $thisRemoteDir/\n" .
1133 "$thisRepoDir/\n" .
1134 getStickyTagOrDate($stickyInfo) . "\n";
1135 }
1136 else
1137 {
1138 $stickyResponse = "Clear-sticky $thisRemoteDir/\n" .
1139 "$thisRepoDir/\n";
1140 }
1141
1142 unless ( $state->{globaloptions}{-n} )
1143 {
1144 print $stickyResponse;
1145
1146 print "Clear-static-directory $thisRemoteDir/\n";
1147 print "$thisRepoDir/\n";
1148 print $stickyResponse; # yes, twice
1149 print "Template $thisRemoteDir/\n";
1150 print "$thisRepoDir/\n";
1151 print "0\n";
1152 }
1153
1154 $seendirs->{$dir} = 1;
1155
1156 # FUTURE: This would more accurately emulate CVS by sending
1157 # another copy of sticky after processing the files in that
1158 # directory. Or intermediate: perhaps send all sticky's for
1159 # $seendirs after after processing all files.
1160}
1161
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001162# update \n
1163# Response expected: yes. Actually do a cvs update command. This uses any
1164# previous Argument, Directory, Entry, or Modified requests, if they have
1165# been sent. The last Directory sent specifies the working directory at the
1166# time of the operation. The -I option is not used--files which the client
1167# can decide whether to ignore are not mentioned and the client sends the
1168# Questionable request for others.
1169sub req_update
1170{
1171 my ( $cmd, $data ) = @_;
1172
1173 $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
1174
1175 argsplit("update");
1176
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001177 #
Junio C Hamano5348b6e2006-04-25 23:59:28 -07001178 # It may just be a client exploring the available heads/modules
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001179 # in that case, list them as top level directories and leave it
1180 # at that. Eclipse uses this technique to offer you a list of
1181 # projects (heads in this case) to checkout.
1182 #
1183 if ($state->{module} eq '') {
Lars Noschinskib20171e2008-07-17 19:00:27 +02001184 my $showref = `git show-ref --heads`;
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001185 print "E cvs update: Updating .\n";
Lars Noschinskib20171e2008-07-17 19:00:27 +02001186 for my $line (split '\n', $showref) {
1187 if ( $line =~ m% refs/heads/(.*)$% ) {
1188 print "E cvs update: New directory `$1'\n";
1189 }
1190 }
1191 print "ok\n";
1192 return 1;
Martin Langhoff858cbfb2006-03-01 20:03:58 +13001193 }
1194
1195
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001196 # Grab a handle to the SQLite db and do any necessary updates
1197 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1198
1199 $updater->update();
1200
Martyn Smith7d900952006-03-27 15:51:42 +12001201 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001202
1203 #$log->debug("update state : " . Dumper($state));
1204
Matthew Ogilvie61717662012-10-13 23:42:31 -06001205 my($repoDir);
1206 $repoDir=$state->{CVSROOT} . "/$state->{module}/$state->{prependdir}";
1207
1208 my %seendirs = ();
Sergei Organov8e4c4e72009-12-07 14:11:44 +03001209
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001210 # foreach file specified on the command line ...
Matthew Ogilvie61717662012-10-13 23:42:31 -06001211 foreach my $argsFilename ( @{$state->{args}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001212 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001213 my $filename;
1214 $filename = filecleanup($argsFilename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001215
Martyn Smith7d900952006-03-27 15:51:42 +12001216 $log->debug("Processing file $filename");
1217
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001218 # if we have a -C we should pretend we never saw modified stuff
1219 if ( exists ( $state->{opt}{C} ) )
1220 {
1221 delete $state->{entries}{$filename}{modified_hash};
1222 delete $state->{entries}{$filename}{modified_filename};
1223 $state->{entries}{$filename}{unchanged} = 1;
1224 }
1225
Matthew Ogilvie61717662012-10-13 23:42:31 -06001226 my $stickyInfo = resolveStickyInfo($filename,
1227 $state->{opt}{r},
1228 $state->{opt}{D},
1229 exists($state->{opt}{A}));
1230 my $meta = $updater->getmeta($filename, $stickyInfo);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001231
Damien Diederene78f69a2008-03-27 23:18:12 +01001232 # If -p was given, "print" the contents of the requested revision.
1233 if ( exists ( $state->{opt}{p} ) ) {
1234 if ( defined ( $meta->{revision} ) ) {
1235 $log->info("Printing '$filename' revision " . $meta->{revision});
1236
1237 transmitfile($meta->{filehash}, { print => 1 });
1238 }
1239
1240 next;
1241 }
1242
Matthew Ogilvie61717662012-10-13 23:42:31 -06001243 # Directories:
1244 prepDirForOutput(
1245 dirname($argsFilename),
1246 $repoDir,
1247 ".",
1248 \%seendirs,
1249 "update",
1250 $state->{dirArgs} );
1251
1252 my $wrev = revparse($filename);
1253
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001254 if ( ! defined $meta )
1255 {
1256 $meta = {
1257 name => $filename,
Matthew Ogilvieab076812012-10-13 23:42:21 -06001258 revision => '0',
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001259 filehash => 'added'
1260 };
Matthew Ogilvie61717662012-10-13 23:42:31 -06001261 if($wrev ne "0")
1262 {
1263 $meta->{filehash}='deleted';
1264 }
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001265 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001266
1267 my $oldmeta = $meta;
1268
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001269 # If the working copy is an old revision, lets get that version too for comparison.
Matthew Ogilvie61717662012-10-13 23:42:31 -06001270 my $oldWrev=$wrev;
1271 if(defined($oldWrev))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001272 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001273 $oldWrev=~s/^-//;
1274 if($oldWrev ne $meta->{revision})
1275 {
1276 $oldmeta = $updater->getmeta($filename, $oldWrev);
1277 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001278 }
1279
1280 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
1281
Martin Langhoffec58db12006-03-02 18:42:01 +13001282 # Files are up to date if the working copy and repo copy have the same revision,
1283 # and the working copy is unmodified _and_ the user hasn't specified -C
1284 next if ( defined ( $wrev )
1285 and defined($meta->{revision})
Matthew Ogilvieab076812012-10-13 23:42:21 -06001286 and $wrev eq $meta->{revision}
Martin Langhoffec58db12006-03-02 18:42:01 +13001287 and $state->{entries}{$filename}{unchanged}
1288 and not exists ( $state->{opt}{C} ) );
1289
1290 # If the working copy and repo copy have the same revision,
1291 # but the working copy is modified, tell the client it's modified
1292 if ( defined ( $wrev )
1293 and defined($meta->{revision})
Matthew Ogilvieab076812012-10-13 23:42:21 -06001294 and $wrev eq $meta->{revision}
Matthew Ogilvie61717662012-10-13 23:42:31 -06001295 and $wrev ne "0"
Frank Lichtenheldcb52d9a2007-04-11 22:38:19 +02001296 and defined($state->{entries}{$filename}{modified_hash})
Martin Langhoffec58db12006-03-02 18:42:01 +13001297 and not exists ( $state->{opt}{C} ) )
1298 {
1299 $log->info("Tell the client the file is modified");
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001300 print "MT text M \n";
Martin Langhoffec58db12006-03-02 18:42:01 +13001301 print "MT fname $filename\n";
1302 print "MT newline\n";
1303 next;
1304 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001305
Matthew Ogilvie61717662012-10-13 23:42:31 -06001306 if ( $meta->{filehash} eq "deleted" && $wrev ne "0" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001307 {
Matthew Ogilvied8574ff2012-10-13 23:42:17 -06001308 # TODO: If it has been modified in the sandbox, error out
1309 # with the appropriate message, rather than deleting a modified
1310 # file.
1311
Martyn Smith7d900952006-03-27 15:51:42 +12001312 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001313
1314 $log->info("Removing '$filename' from working copy (no longer in the repo)");
1315
1316 print "E cvs update: `$filename' is no longer in the repository\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001317 # Don't want to actually _DO_ the update if -n specified
1318 unless ( $state->{globaloptions}{-n} ) {
1319 print "Removed $dirpart\n";
1320 print "$filepart\n";
1321 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001322 }
Martin Langhoffec58db12006-03-02 18:42:01 +13001323 elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001324 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
1325 or $meta->{filehash} eq 'added' )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001326 {
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001327 # normal update, just send the new revision (either U=Update,
1328 # or A=Add, or R=Remove)
Matthew Ogilvieab076812012-10-13 23:42:21 -06001329 if ( defined($wrev) && ($wrev=~/^-/) )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001330 {
1331 $log->info("Tell the client the file is scheduled for removal");
1332 print "MT text R \n";
1333 print "MT fname $filename\n";
1334 print "MT newline\n";
1335 next;
1336 }
Matthew Ogilvieab076812012-10-13 23:42:21 -06001337 elsif ( (!defined($wrev) || $wrev eq '0') &&
1338 (!defined($meta->{revision}) || $meta->{revision} eq '0') )
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001339 {
Andy Parkins535514f2007-01-22 10:56:27 +00001340 $log->info("Tell the client the file is scheduled for addition");
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001341 print "MT text A \n";
1342 print "MT fname $filename\n";
1343 print "MT newline\n";
1344 next;
1345
1346 }
1347 else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001348 $log->info("UpdatingX3 '$filename' to ".$meta->{revision});
Johannes Schindelin0a7a9a12006-10-11 00:20:43 +02001349 print "MT +updated\n";
1350 print "MT text U \n";
1351 print "MT fname $filename\n";
1352 print "MT newline\n";
1353 print "MT -updated\n";
1354 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001355
Martyn Smith7d900952006-03-27 15:51:42 +12001356 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001357
Martyn Smith7d900952006-03-27 15:51:42 +12001358 # Don't want to actually _DO_ the update if -n specified
1359 unless ( $state->{globaloptions}{-n} )
1360 {
1361 if ( defined ( $wrev ) )
1362 {
1363 # instruct client we're sending a file to put in this path as a replacement
1364 print "Update-existing $dirpart\n";
1365 $log->debug("Updating existing file 'Update-existing $dirpart'");
1366 } else {
1367 # instruct client we're sending a file to put in this path as a new file
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001368
Martyn Smith7d900952006-03-27 15:51:42 +12001369 $log->debug("Creating new file 'Created $dirpart'");
1370 print "Created $dirpart\n";
1371 }
1372 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001373
Martyn Smith7d900952006-03-27 15:51:42 +12001374 # this is an "entries" line
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001375 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001376 my $entriesLine = "/$filepart/$meta->{revision}//$kopts/";
1377 $entriesLine .= getStickyTagOrDate($stickyInfo);
1378 $log->debug($entriesLine);
1379 print "$entriesLine\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001380
Martyn Smith7d900952006-03-27 15:51:42 +12001381 # permissions
1382 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1383 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1384
1385 # transmit file
1386 transmitfile($meta->{filehash});
1387 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001388 } else {
Martyn Smith7d900952006-03-27 15:51:42 +12001389 my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001390
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001391 my $mergeDir = setupTmpDir();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001392
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001393 my $file_local = $filepart . ".mine";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001394 my $mergedFile = "$mergeDir/$file_local";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001395 system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
1396 my $file_old = $filepart . "." . $oldmeta->{revision};
Damien Diederene78f69a2008-03-27 23:18:12 +01001397 transmitfile($oldmeta->{filehash}, { targetfile => $file_old });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001398 my $file_new = $filepart . "." . $meta->{revision};
Damien Diederene78f69a2008-03-27 23:18:12 +01001399 transmitfile($meta->{filehash}, { targetfile => $file_new });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001400
1401 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
1402 $log->info("Merging $file_local, $file_old, $file_new");
Matthew Ogilvieab076812012-10-13 23:42:21 -06001403 print "M Merging differences between $oldmeta->{revision} and $meta->{revision} into $filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001404
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001405 $log->debug("Temporary directory for merge is $mergeDir");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001406
Eric Wongc6b4fa92006-12-19 14:58:20 -08001407 my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001408 $return >>= 8;
1409
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001410 cleanupTmpDir();
1411
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001412 if ( $return == 0 )
1413 {
1414 $log->info("Merged successfully");
1415 print "M M $filename\n";
Frank Lichtenheld53877842007-03-06 10:42:24 +01001416 $log->debug("Merged $dirpart");
Martyn Smith7d900952006-03-27 15:51:42 +12001417
1418 # Don't want to actually _DO_ the update if -n specified
1419 unless ( $state->{globaloptions}{-n} )
1420 {
Frank Lichtenheld53877842007-03-06 10:42:24 +01001421 print "Merged $dirpart\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001422 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
1423 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001424 my $kopts = kopts_from_path("$dirpart/$filepart",
1425 "file",$mergedFile);
Matthew Ogilvieab076812012-10-13 23:42:21 -06001426 $log->debug("/$filepart/$meta->{revision}//$kopts/");
Matthew Ogilvie61717662012-10-13 23:42:31 -06001427 my $entriesLine="/$filepart/$meta->{revision}//$kopts/";
1428 $entriesLine .= getStickyTagOrDate($stickyInfo);
1429 print "$entriesLine\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001430 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001431 }
1432 elsif ( $return == 1 )
1433 {
1434 $log->info("Merged with conflicts");
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001435 print "E cvs update: conflicts found in $filename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001436 print "M C $filename\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001437
1438 # Don't want to actually _DO_ the update if -n specified
1439 unless ( $state->{globaloptions}{-n} )
1440 {
Frank Lichtenheld53877842007-03-06 10:42:24 +01001441 print "Merged $dirpart\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001442 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001443 my $kopts = kopts_from_path("$dirpart/$filepart",
1444 "file",$mergedFile);
Matthew Ogilvie61717662012-10-13 23:42:31 -06001445 my $entriesLine = "/$filepart/$meta->{revision}/+/$kopts/";
1446 $entriesLine .= getStickyTagOrDate($stickyInfo);
1447 print "$entriesLine\n";
Martyn Smith7d900952006-03-27 15:51:42 +12001448 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001449 }
1450 else
1451 {
1452 $log->warn("Merge failed");
1453 next;
1454 }
1455
Martyn Smith7d900952006-03-27 15:51:42 +12001456 # Don't want to actually _DO_ the update if -n specified
1457 unless ( $state->{globaloptions}{-n} )
1458 {
1459 # permissions
1460 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1461 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001462
Martyn Smith7d900952006-03-27 15:51:42 +12001463 # transmit file, format is single integer on a line by itself (file
1464 # size) followed by the file contents
1465 # TODO : we should copy files in blocks
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001466 my $data = `cat $mergedFile`;
Martyn Smith7d900952006-03-27 15:51:42 +12001467 $log->debug("File size : " . length($data));
1468 print length($data) . "\n";
1469 print $data;
1470 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001471 }
1472
1473 }
1474
Matthew Ogilvie61717662012-10-13 23:42:31 -06001475 # prepDirForOutput() any other existing directories unless they already
1476 # have the right sticky tag:
1477 unless ( $state->{globaloptions}{n} )
1478 {
1479 my $dir;
1480 foreach $dir (keys(%{$state->{dirMap}}))
1481 {
1482 if( ! $seendirs{$dir} &&
1483 exists($state->{dirArgs}{$dir}) )
1484 {
1485 my($oldTag);
1486 $oldTag=$state->{dirMap}{$dir}{tagspec};
1487
1488 unless( ( exists($state->{opt}{A}) &&
1489 defined($oldTag) ) ||
1490 ( defined($state->{opt}{r}) &&
1491 ( !defined($oldTag) ||
1492 $state->{opt}{r} ne $oldTag ) ) )
1493 # TODO?: OR sticky dir is different...
1494 {
1495 next;
1496 }
1497
1498 prepDirForOutput(
1499 $dir,
1500 $repoDir,
1501 ".",
1502 \%seendirs,
1503 'update',
1504 $state->{dirArgs} );
1505 }
1506
1507 # TODO?: Consider sending a final duplicate Sticky response
1508 # to more closely mimic real CVS.
1509 }
1510 }
1511
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001512 print "ok\n";
1513}
1514
1515sub req_ci
1516{
1517 my ( $cmd, $data ) = @_;
1518
1519 argsplit("ci");
1520
1521 #$log->debug("State : " . Dumper($state));
1522
1523 $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1524
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00001525 if ( $state->{method} eq 'pserver' and $state->{user} eq 'anonymous' )
Martin Langhoff91a6bf42006-03-04 20:30:04 +13001526 {
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00001527 print "error 1 anonymous user cannot commit via pserver\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001528 cleanupWorkTree();
Martin Langhoff91a6bf42006-03-04 20:30:04 +13001529 exit;
1530 }
1531
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001532 if ( -e $state->{CVSROOT} . "/index" )
1533 {
Martyn Smith568907f2006-03-17 13:33:19 +13001534 $log->warn("file 'index' already exists in the git repository");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001535 print "error 1 Index already exists in git repo\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001536 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001537 exit;
1538 }
1539
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001540 # Grab a handle to the SQLite db and do any necessary updates
1541 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1542 $updater->update();
1543
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001544 my @committedfiles = ();
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001545 my %oldmeta;
Matthew Ogilvie61717662012-10-13 23:42:31 -06001546 my $stickyInfo;
1547 my $branchRef;
1548 my $parenthash;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001549
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001550 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001551 foreach my $filename ( @{$state->{args}} )
1552 {
Martyn Smith7d900952006-03-27 15:51:42 +12001553 my $committedfile = $filename;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001554 $filename = filecleanup($filename);
1555
1556 next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1557
Matthew Ogilvie61717662012-10-13 23:42:31 -06001558 #####
1559 # Figure out which branch and parenthash we are committing
1560 # to, and setup worktree:
1561
1562 # should always come from entries:
1563 my $fileStickyInfo = resolveStickyInfo($filename);
1564 if( !defined($branchRef) )
1565 {
1566 $stickyInfo = $fileStickyInfo;
1567 if( defined($stickyInfo) &&
1568 ( defined($stickyInfo->{date}) ||
1569 !defined($stickyInfo->{tag}) ) )
1570 {
1571 print "error 1 cannot commit with sticky date for file `$filename'\n";
1572 cleanupWorkTree();
1573 exit;
1574 }
1575
1576 $branchRef = "refs/heads/$state->{module}";
1577 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1578 {
1579 $branchRef = "refs/heads/$stickyInfo->{tag}";
1580 }
1581
1582 $parenthash = `git show-ref -s $branchRef`;
1583 chomp $parenthash;
1584 if ($parenthash !~ /^[0-9a-f]{40}$/)
1585 {
1586 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )
1587 {
1588 print "error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";
1589 }
1590 else
1591 {
1592 print "error 1 pserver cannot find the current HEAD of module";
1593 }
1594 cleanupWorkTree();
1595 exit;
1596 }
1597
1598 setupWorkTree($parenthash);
1599
1600 $log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");
1601
1602 $log->info("Created index '$work->{index}' for head $state->{module} - exit status $?");
1603 }
1604 elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )
1605 {
1606 #TODO: We could split the cvs commit into multiple
1607 # git commits by distinct stickyTag values, but that
1608 # is lowish priority.
1609 print "error 1 Committing different files to different"
1610 . " branches is not currently supported\n";
1611 cleanupWorkTree();
1612 exit;
1613 }
1614
1615 #####
1616 # Process this file:
1617
1618 my $meta = $updater->getmeta($filename,$stickyInfo);
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001619 $oldmeta{$filename} = $meta;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001620
1621 my $wrev = revparse($filename);
1622
1623 my ( $filepart, $dirpart ) = filenamesplit($filename);
1624
Michael Wittencdf63282007-11-23 04:12:54 -05001625 # do a checkout of the file if it is part of this tree
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001626 if ($wrev) {
Gerrit Paped2feb012009-09-02 09:23:10 +00001627 system('git', 'checkout-index', '-f', '-u', $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001628 unless ($? == 0) {
1629 die "Error running git-checkout-index -f -u $filename : $!";
1630 }
1631 }
1632
1633 my $addflag = 0;
1634 my $rmflag = 0;
Matthew Ogilvieab076812012-10-13 23:42:21 -06001635 $rmflag = 1 if ( defined($wrev) and ($wrev=~/^-/) );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001636 $addflag = 1 unless ( -e $filename );
1637
1638 # Do up to date checking
Matthew Ogilvieab076812012-10-13 23:42:21 -06001639 unless ( $addflag or $wrev eq $meta->{revision} or
1640 ( $rmflag and $wrev eq "-$meta->{revision}" ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001641 {
1642 # fail everything if an up to date check fails
1643 print "error 1 Up to date check failed for $filename\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001644 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001645 exit;
1646 }
1647
Martyn Smith7d900952006-03-27 15:51:42 +12001648 push @committedfiles, $committedfile;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001649 $log->info("Committing $filename");
1650
1651 system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1652
1653 unless ( $rmflag )
1654 {
1655 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1656 rename $state->{entries}{$filename}{modified_filename},$filename;
1657
1658 # Calculate modes to remove
1659 my $invmode = "";
1660 foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1661
1662 $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1663 system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1664 }
1665
1666 if ( $rmflag )
1667 {
1668 $log->info("Removing file '$filename'");
1669 unlink($filename);
Gerrit Paped2feb012009-09-02 09:23:10 +00001670 system("git", "update-index", "--remove", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001671 }
1672 elsif ( $addflag )
1673 {
1674 $log->info("Adding file '$filename'");
Gerrit Paped2feb012009-09-02 09:23:10 +00001675 system("git", "update-index", "--add", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001676 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001677 $log->info("UpdatingX2 file '$filename'");
Gerrit Paped2feb012009-09-02 09:23:10 +00001678 system("git", "update-index", $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001679 }
1680 }
1681
1682 unless ( scalar(@committedfiles) > 0 )
1683 {
1684 print "E No files to commit\n";
1685 print "ok\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001686 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001687 return;
1688 }
1689
Gerrit Paped2feb012009-09-02 09:23:10 +00001690 my $treehash = `git write-tree`;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001691 chomp $treehash;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001692
1693 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1694
1695 # write our commit message out if we have one ...
1696 my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1697 print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
Fabian Emmes280514e2009-01-02 16:40:13 +01001698 if ( defined ( $cfg->{gitcvs}{commitmsgannotation} ) ) {
1699 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/ ) {
1700 print $msg_fh "\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"
1701 }
1702 } else {
1703 print $msg_fh "\n\nvia git-CVS emulator\n";
1704 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001705 close $msg_fh;
1706
Gerrit Paped2feb012009-09-02 09:23:10 +00001707 my $commithash = `git commit-tree $treehash -p $parenthash < $msg_filename`;
Andy Parkins1872ada2007-02-27 12:49:09 +00001708 chomp($commithash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001709 $log->info("Commit hash : $commithash");
1710
1711 unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1712 {
1713 $log->warn("Commit failed (Invalid commit hash)");
1714 print "error 1 Commit failed (unknown reason)\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001715 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001716 exit;
1717 }
1718
Michael Wittencdf63282007-11-23 04:12:54 -05001719 ### Emulate git-receive-pack by running hooks/update
Matthew Ogilvie61717662012-10-13 23:42:31 -06001720 my @hook = ( $ENV{GIT_DIR}.'hooks/update', $branchRef,
Andy Parkinsb2741f62007-02-13 15:12:45 +00001721 $parenthash, $commithash );
Michael Wittencdf63282007-11-23 04:12:54 -05001722 if( -x $hook[0] ) {
1723 unless( system( @hook ) == 0 )
Andy Parkinsb2741f62007-02-13 15:12:45 +00001724 {
1725 $log->warn("Commit failed (update hook declined to update ref)");
1726 print "error 1 Commit failed (update hook declined)\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001727 cleanupWorkTree();
Andy Parkinsb2741f62007-02-13 15:12:45 +00001728 exit;
1729 }
1730 }
1731
Michael Wittencdf63282007-11-23 04:12:54 -05001732 ### Update the ref
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001733 if (system(qw(git update-ref -m), "cvsserver ci",
Matthew Ogilvie61717662012-10-13 23:42:31 -06001734 $branchRef, $commithash, $parenthash)) {
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001735 $log->warn("update-ref for $state->{module} failed.");
1736 print "error 1 Cannot commit -- update first\n";
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001737 cleanupWorkTree();
Junio C Hamanoada5ef32007-02-20 21:54:39 -08001738 exit;
1739 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001740
Michael Wittencdf63282007-11-23 04:12:54 -05001741 ### Emulate git-receive-pack by running hooks/post-receive
1742 my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
1743 if( -x $hook ) {
1744 open(my $pipe, "| $hook") || die "can't fork $!";
1745
1746 local $SIG{PIPE} = sub { die 'pipe broke' };
1747
Matthew Ogilvie61717662012-10-13 23:42:31 -06001748 print $pipe "$parenthash $commithash $branchRef\n";
Michael Wittencdf63282007-11-23 04:12:54 -05001749
1750 close $pipe || die "bad pipe: $! $?";
1751 }
1752
Stefan Karpinskiad8c3472009-01-29 13:58:02 -08001753 $updater->update();
1754
Junio C Hamano394d66d2007-12-05 01:15:01 -08001755 ### Then hooks/post-update
1756 $hook = $ENV{GIT_DIR}.'hooks/post-update';
1757 if (-x $hook) {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001758 system($hook, $branchRef);
Junio C Hamano394d66d2007-12-05 01:15:01 -08001759 }
1760
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001761 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001762 foreach my $filename ( @committedfiles )
1763 {
1764 $filename = filecleanup($filename);
1765
Matthew Ogilvie61717662012-10-13 23:42:31 -06001766 my $meta = $updater->getmeta($filename,$stickyInfo);
Martin Langhoff34865952007-01-09 15:10:41 +13001767 unless (defined $meta->{revision}) {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001768 $meta->{revision} = "1.1";
Martin Langhoff34865952007-01-09 15:10:41 +13001769 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001770
Martyn Smith7d900952006-03-27 15:51:42 +12001771 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001772
1773 $log->debug("Checked-in $dirpart : $filename");
1774
Frank Lichtenheld392e2812007-03-13 18:25:23 +01001775 print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
Martin Langhoff34865952007-01-09 15:10:41 +13001776 if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001777 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001778 print "M new revision: delete; previous revision: $oldmeta{$filename}{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001779 print "Remove-entry $dirpart\n";
1780 print "$filename\n";
1781 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001782 if ($meta->{revision} eq "1.1") {
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001783 print "M initial revision: 1.1\n";
1784 } else {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001785 print "M new revision: $meta->{revision}; previous revision: $oldmeta{$filename}{revision}\n";
Frank Lichtenheld459bad72007-03-13 18:25:22 +01001786 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001787 print "Checked-in $dirpart\n";
1788 print "$filename\n";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06001789 my $kopts = kopts_from_path($filename,"sha1",$meta->{filehash});
Matthew Ogilvie61717662012-10-13 23:42:31 -06001790 print "/$filepart/$meta->{revision}//$kopts/" .
1791 getStickyTagOrDate($stickyInfo) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001792 }
1793 }
1794
Matthew Ogilvie044182e2008-05-14 22:35:46 -06001795 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001796 print "ok\n";
1797}
1798
1799sub req_status
1800{
1801 my ( $cmd, $data ) = @_;
1802
1803 argsplit("status");
1804
1805 $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1806 #$log->debug("status state : " . Dumper($state));
1807
1808 # Grab a handle to the SQLite db and do any necessary updates
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001809 my $updater;
1810 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001811 $updater->update();
1812
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001813 # if no files were specified, we need to work out what files we should
1814 # be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12001815 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001816
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001817 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001818 foreach my $filename ( @{$state->{args}} )
1819 {
1820 $filename = filecleanup($filename);
1821
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001822 if ( exists($state->{opt}{l}) &&
1823 index($filename, '/', length($state->{prependdir})) >= 0 )
1824 {
1825 next;
1826 }
Damien Diederen852b9212008-03-27 23:17:53 +01001827
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001828 my $wrev = revparse($filename);
1829
Matthew Ogilvie61717662012-10-13 23:42:31 -06001830 my $stickyInfo = resolveStickyInfo($filename);
1831 my $meta = $updater->getmeta($filename,$stickyInfo);
1832 my $oldmeta = $meta;
1833
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001834 # If the working copy is an old revision, lets get that
1835 # version too for comparison.
Matthew Ogilvieab076812012-10-13 23:42:21 -06001836 if ( defined($wrev) and $wrev ne $meta->{revision} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001837 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06001838 my($rmRev)=$wrev;
1839 $rmRev=~s/^-//;
1840 $oldmeta = $updater->getmeta($filename, $rmRev);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001841 }
1842
1843 # TODO : All possible statuses aren't yet implemented
1844 my $status;
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001845 # Files are up to date if the working copy and repo copy have
1846 # the same revision, and the working copy is unmodified
1847 if ( defined ( $wrev ) and defined($meta->{revision}) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001848 $wrev eq $meta->{revision} and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001849 ( ( $state->{entries}{$filename}{unchanged} and
1850 ( not defined ( $state->{entries}{$filename}{conflict} ) or
1851 $state->{entries}{$filename}{conflict} !~ /^\+=/ ) ) or
1852 ( defined($state->{entries}{$filename}{modified_hash}) and
1853 $state->{entries}{$filename}{modified_hash} eq
Matthew Ogilvieab076812012-10-13 23:42:21 -06001854 $meta->{filehash} ) ) )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001855 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001856 $status = "Up-to-date"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001857 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001858
Matthew Ogilvieab076812012-10-13 23:42:21 -06001859 # Need checkout if the working copy has a different (usually
1860 # older) revision than the repo copy, and the working copy is
1861 # unmodified
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001862 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001863 $meta->{revision} ne $wrev and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001864 ( $state->{entries}{$filename}{unchanged} or
1865 ( defined($state->{entries}{$filename}{modified_hash}) and
1866 $state->{entries}{$filename}{modified_hash} eq
1867 $oldmeta->{filehash} ) ) )
1868 {
1869 $status ||= "Needs Checkout";
1870 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001871
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001872 # Need checkout if it exists in the repo but doesn't have a working
1873 # copy
1874 if ( not defined ( $wrev ) and defined ( $meta->{revision} ) )
1875 {
1876 $status ||= "Needs Checkout";
1877 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001878
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001879 # Locally modified if working copy and repo copy have the
1880 # same revision but there are local changes
1881 if ( defined ( $wrev ) and defined($meta->{revision}) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001882 $wrev eq $meta->{revision} and
Matthew Ogilvie61717662012-10-13 23:42:31 -06001883 $wrev ne "0" and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001884 $state->{entries}{$filename}{modified_filename} )
1885 {
1886 $status ||= "Locally Modified";
1887 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001888
Matthew Ogilvieab076812012-10-13 23:42:21 -06001889 # Needs Merge if working copy revision is different
1890 # (usually older) than repo copy and there are local changes
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001891 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001892 $meta->{revision} ne $wrev and
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001893 $state->{entries}{$filename}{modified_filename} )
1894 {
1895 $status ||= "Needs Merge";
1896 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001897
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001898 if ( defined ( $state->{entries}{$filename}{revision} ) and
Matthew Ogilvie61717662012-10-13 23:42:31 -06001899 ( !defined($meta->{revision}) ||
1900 $meta->{revision} eq "0" ) )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001901 {
1902 $status ||= "Locally Added";
1903 }
1904 if ( defined ( $wrev ) and defined ( $meta->{revision} ) and
Matthew Ogilvieab076812012-10-13 23:42:21 -06001905 $wrev eq "-$meta->{revision}" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001906 {
1907 $status ||= "Locally Removed";
1908 }
1909 if ( defined ( $state->{entries}{$filename}{conflict} ) and
1910 $state->{entries}{$filename}{conflict} =~ /^\+=/ )
1911 {
1912 $status ||= "Unresolved Conflict";
1913 }
1914 if ( 0 )
1915 {
1916 $status ||= "File had conflicts on merge";
1917 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001918
1919 $status ||= "Unknown";
1920
Damien Diederen23b71802008-03-27 23:17:42 +01001921 my ($filepart) = filenamesplit($filename);
1922
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001923 print "M =======" . ( "=" x 60 ) . "\n";
Damien Diederen23b71802008-03-27 23:17:42 +01001924 print "M File: $filepart\tStatus: $status\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001925 if ( defined($state->{entries}{$filename}{revision}) )
1926 {
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001927 print "M Working revision:\t" .
1928 $state->{entries}{$filename}{revision} . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001929 } else {
1930 print "M Working revision:\tNo entry for $filename\n";
1931 }
1932 if ( defined($meta->{revision}) )
1933 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06001934 print "M Repository revision:\t" .
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001935 $meta->{revision} .
1936 "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
Matthew Ogilvieabd66f22012-10-13 23:42:23 -06001937 my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
1938 my($tag)=($tagOrDate=~m/^T(.+)$/);
1939 if( !defined($tag) )
1940 {
1941 $tag="(none)";
1942 }
1943 print "M Sticky Tag:\t\t$tag\n";
1944 my($date)=($tagOrDate=~m/^D(.+)$/);
1945 if( !defined($date) )
1946 {
1947 $date="(none)";
1948 }
1949 print "M Sticky Date:\t\t$date\n";
1950 my($options)=$state->{entries}{$filename}{options};
1951 if( $options eq "" )
1952 {
1953 $options="(none)";
1954 }
1955 print "M Sticky Options:\t\t$options\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001956 } else {
1957 print "M Repository revision:\tNo revision control file\n";
1958 }
1959 print "M\n";
1960 }
1961
1962 print "ok\n";
1963}
1964
1965sub req_diff
1966{
1967 my ( $cmd, $data ) = @_;
1968
1969 argsplit("diff");
1970
1971 $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1972 #$log->debug("status state : " . Dumper($state));
1973
1974 my ($revision1, $revision2);
1975 if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1976 {
1977 $revision1 = $state->{opt}{r}[0];
1978 $revision2 = $state->{opt}{r}[1];
1979 } else {
1980 $revision1 = $state->{opt}{r};
1981 }
1982
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001983 $log->debug("Diffing revisions " .
1984 ( defined($revision1) ? $revision1 : "[NULL]" ) .
1985 " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001986
1987 # Grab a handle to the SQLite db and do any necessary updates
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001988 my $updater;
1989 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001990 $updater->update();
1991
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06001992 # if no files were specified, we need to work out what files we should
1993 # be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12001994 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13001995
Matthew Ogilvie61717662012-10-13 23:42:31 -06001996 my($foundDiff);
1997
Pavel Roskinaddf88e2006-07-09 03:44:30 -04001998 # foreach file specified on the command line ...
Matthew Ogilvie61717662012-10-13 23:42:31 -06001999 foreach my $argFilename ( @{$state->{args}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002000 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002001 my($filename) = filecleanup($argFilename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002002
2003 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
2004
2005 my $wrev = revparse($filename);
2006
Matthew Ogilvie61717662012-10-13 23:42:31 -06002007 # Priority for revision1:
2008 # 1. First -r (missing file: check -N)
2009 # 2. wrev from client's Entry line
2010 # - missing line/file: check -N
2011 # - "0": added file not committed (empty contents for rev1)
2012 # - Prefixed with dash (to be removed): check -N
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002013
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002014 if ( defined ( $revision1 ) )
2015 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002016 $meta1 = $updater->getmeta($filename, $revision1);
Matthew Ogilvie61717662012-10-13 23:42:31 -06002017 }
2018 elsif( defined($wrev) && $wrev ne "0" )
2019 {
2020 my($rmRev)=$wrev;
2021 $rmRev=~s/^-//;
2022 $meta1 = $updater->getmeta($filename, $rmRev);
2023 }
2024 if ( !defined($meta1) ||
2025 $meta1->{filehash} eq "deleted" )
2026 {
2027 if( !exists($state->{opt}{N}) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002028 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002029 if(!defined($revision1))
2030 {
2031 print "E File $filename at revision $revision1 doesn't exist\n";
2032 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002033 next;
2034 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002035 elsif( !defined($meta1) )
2036 {
2037 $meta1 = {
2038 name => $filename,
2039 revision => '0',
2040 filehash => 'deleted'
2041 };
2042 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002043 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002044
2045 # Priority for revision2:
2046 # 1. Second -r (missing file: check -N)
2047 # 2. Modified file contents from client
2048 # 3. wrev from client's Entry line
2049 # - missing line/file: check -N
2050 # - Prefixed with dash (to be removed): check -N
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002051
2052 # if we have a second -r switch, use it too
2053 if ( defined ( $revision2 ) )
2054 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002055 $meta2 = $updater->getmeta($filename, $revision2);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002056 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002057 elsif(defined($state->{entries}{$filename}{modified_filename}))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002058 {
2059 $file2 = $state->{entries}{$filename}{modified_filename};
Matthew Ogilvie61717662012-10-13 23:42:31 -06002060 $meta2 = {
2061 name => $filename,
2062 revision => '0',
2063 filehash => 'modified'
2064 };
2065 }
2066 elsif( defined($wrev) && ($wrev!~/^-/) )
2067 {
2068 if(!defined($revision1)) # no revision and no modifications:
2069 {
2070 next;
2071 }
2072 $meta2 = $updater->getmeta($filename, $wrev);
2073 }
2074 if(!defined($file2))
2075 {
2076 if ( !defined($meta2) ||
2077 $meta2->{filehash} eq "deleted" )
2078 {
2079 if( !exists($state->{opt}{N}) )
2080 {
2081 if(!defined($revision2))
2082 {
2083 print "E File $filename at revision $revision2 doesn't exist\n";
2084 }
2085 next;
2086 }
2087 elsif( !defined($meta2) )
2088 {
2089 $meta2 = {
2090 name => $filename,
2091 revision => '0',
2092 filehash => 'deleted'
2093 };
2094 }
2095 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002096 }
2097
Matthew Ogilvie61717662012-10-13 23:42:31 -06002098 if( $meta1->{filehash} eq $meta2->{filehash} )
2099 {
2100 $log->info("unchanged $filename");
2101 next;
2102 }
2103
2104 # Retrieve revision contents:
2105 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
2106 transmitfile($meta1->{filehash}, { targetfile => $file1 });
2107
2108 if(!defined($file2))
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002109 {
2110 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
Damien Diederene78f69a2008-03-27 23:18:12 +01002111 transmitfile($meta2->{filehash}, { targetfile => $file2 });
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002112 }
2113
Matthew Ogilvie61717662012-10-13 23:42:31 -06002114 # Generate the actual diff:
2115 print "M Index: $argFilename\n";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002116 print "M =======" . ( "=" x 60 ) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002117 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
Matthew Ogilvie61717662012-10-13 23:42:31 -06002118 if ( defined ( $meta1 ) && $meta1->{revision} ne "0" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002119 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002120 print "M retrieving revision $meta1->{revision}\n"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002121 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002122 if ( defined ( $meta2 ) && $meta2->{revision} ne "0" )
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002123 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002124 print "M retrieving revision $meta2->{revision}\n"
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002125 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002126 print "M diff ";
Anders Kaseorg94629532013-10-30 04:44:43 -04002127 foreach my $opt ( sort keys %{$state->{opt}} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002128 {
2129 if ( ref $state->{opt}{$opt} eq "ARRAY" )
2130 {
2131 foreach my $value ( @{$state->{opt}{$opt}} )
2132 {
2133 print "-$opt $value ";
2134 }
2135 } else {
2136 print "-$opt ";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002137 if ( defined ( $state->{opt}{$opt} ) )
2138 {
2139 print "$state->{opt}{$opt} "
2140 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002141 }
2142 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002143 print "$argFilename\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002144
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002145 $log->info("Diffing $filename -r $meta1->{revision} -r " .
2146 ( $meta2->{revision} or "workingcopy" ));
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002147
Matthew Ogilvie61717662012-10-13 23:42:31 -06002148 # TODO: Use --label instead of -L because -L is no longer
2149 # documented and may go away someday. Not sure if there there are
2150 # versions that only support -L, which would make this change risky?
2151 # http://osdir.com/ml/bug-gnu-utils-gnu/2010-12/msg00060.html
2152 # ("man diff" should actually document the best migration strategy,
2153 # [current behavior, future changes, old compatibility issues
2154 # or lack thereof, etc], not just stop mentioning the option...)
2155 # TODO: Real CVS seems to include a date in the label, before
2156 # the revision part, without the keyword "revision". The following
2157 # has minimal changes compared to original versions of
2158 # git-cvsserver.perl. (Mostly tab vs space after filename.)
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002159
Matthew Ogilvie61717662012-10-13 23:42:31 -06002160 my (@diffCmd) = ( 'diff' );
2161 if ( exists($state->{opt}{N}) )
2162 {
2163 push @diffCmd,"-N";
2164 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002165 if ( exists $state->{opt}{u} )
2166 {
Matthew Ogilvie61717662012-10-13 23:42:31 -06002167 push @diffCmd,("-u","-L");
2168 if( $meta1->{filehash} eq "deleted" )
2169 {
2170 push @diffCmd,"/dev/null";
2171 } else {
2172 push @diffCmd,("$argFilename\trevision $meta1->{revision}");
2173 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002174
Matthew Ogilvie61717662012-10-13 23:42:31 -06002175 if( defined($meta2->{filehash}) )
2176 {
2177 if( $meta2->{filehash} eq "deleted" )
2178 {
2179 push @diffCmd,("-L","/dev/null");
2180 } else {
2181 push @diffCmd,("-L",
2182 "$argFilename\trevision $meta2->{revision}");
2183 }
2184 } else {
2185 push @diffCmd,("-L","$argFilename\tworking copy");
2186 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002187 }
Matthew Ogilvie61717662012-10-13 23:42:31 -06002188 push @diffCmd,($file1,$file2);
2189 if(!open(DIFF,"-|",@diffCmd))
2190 {
2191 $log->warn("Unable to run diff: $!");
2192 }
2193 my($diffLine);
2194 while(defined($diffLine=<DIFF>))
2195 {
2196 print "M $diffLine";
2197 $foundDiff=1;
2198 }
2199 close(DIFF);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002200 }
2201
Matthew Ogilvie61717662012-10-13 23:42:31 -06002202 if($foundDiff)
2203 {
2204 print "error \n";
2205 }
2206 else
2207 {
2208 print "ok\n";
2209 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002210}
2211
2212sub req_log
2213{
2214 my ( $cmd, $data ) = @_;
2215
2216 argsplit("log");
2217
2218 $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
2219 #$log->debug("log state : " . Dumper($state));
2220
Matthew Ogilvieab076812012-10-13 23:42:21 -06002221 my ( $revFilter );
2222 if ( defined ( $state->{opt}{r} ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002223 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06002224 $revFilter = $state->{opt}{r};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002225 }
2226
2227 # Grab a handle to the SQLite db and do any necessary updates
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002228 my $updater;
2229 $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002230 $updater->update();
2231
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002232 # if no files were specified, we need to work out what files we
2233 # should be providing status on ...
Martyn Smith7d900952006-03-27 15:51:42 +12002234 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002235
Pavel Roskinaddf88e2006-07-09 03:44:30 -04002236 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002237 foreach my $filename ( @{$state->{args}} )
2238 {
2239 $filename = filecleanup($filename);
2240
2241 my $headmeta = $updater->getmeta($filename);
2242
Matthew Ogilvieab076812012-10-13 23:42:21 -06002243 my ($revisions,$totalrevisions) = $updater->getlog($filename,
2244 $revFilter);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002245
2246 next unless ( scalar(@$revisions) );
2247
2248 print "M \n";
2249 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
2250 print "M Working file: $filename\n";
Matthew Ogilvieab076812012-10-13 23:42:21 -06002251 print "M head: $headmeta->{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002252 print "M branch:\n";
2253 print "M locks: strict\n";
2254 print "M access list:\n";
2255 print "M symbolic names:\n";
2256 print "M keyword substitution: kv\n";
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002257 print "M total revisions: $totalrevisions;\tselected revisions: " .
2258 scalar(@$revisions) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002259 print "M description:\n";
2260
2261 foreach my $revision ( @$revisions )
2262 {
2263 print "M ----------------------------\n";
Matthew Ogilvieab076812012-10-13 23:42:21 -06002264 print "M revision $revision->{revision}\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002265 # reformat the date for log output
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002266 if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and
2267 defined($DATE_LIST->{$2}) )
2268 {
2269 $revision->{modified} = sprintf('%04d/%02d/%02d %s',
2270 $3, $DATE_LIST->{$2}, $1, $4 );
2271 }
Damien Diederenc1bc3062008-03-27 23:18:35 +01002272 $revision->{author} = cvs_author($revision->{author});
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002273 print "M date: $revision->{modified};" .
2274 " author: $revision->{author}; state: " .
2275 ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) .
2276 "; lines: +2 -3\n";
2277 my $commitmessage;
2278 $commitmessage = $updater->commitmessage($revision->{commithash});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002279 $commitmessage =~ s/^/M /mg;
2280 print $commitmessage . "\n";
2281 }
Matthew Ogilvie4d804c02012-10-13 23:42:20 -06002282 print "M =======" . ( "=" x 70 ) . "\n";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002283 }
2284
2285 print "ok\n";
2286}
2287
2288sub req_annotate
2289{
2290 my ( $cmd, $data ) = @_;
2291
2292 argsplit("annotate");
2293
2294 $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
2295 #$log->debug("status state : " . Dumper($state));
2296
2297 # Grab a handle to the SQLite db and do any necessary updates
2298 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
2299 $updater->update();
2300
2301 # 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 +12002302 argsfromdir($updater);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002303
2304 # we'll need a temporary checkout dir
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002305 setupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002306
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002307 $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 +13002308
Pavel Roskinaddf88e2006-07-09 03:44:30 -04002309 # foreach file specified on the command line ...
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002310 foreach my $filename ( @{$state->{args}} )
2311 {
2312 $filename = filecleanup($filename);
2313
2314 my $meta = $updater->getmeta($filename);
2315
2316 next unless ( $meta->{revision} );
2317
2318 # get all the commits that this file was in
2319 # in dense format -- aka skip dead revisions
2320 my $revisions = $updater->gethistorydense($filename);
2321 my $lastseenin = $revisions->[0][2];
2322
2323 # populate the temporary index based on the latest commit were we saw
2324 # the file -- but do it cheaply without checking out any files
2325 # TODO: if we got a revision from the client, use that instead
2326 # to look up the commithash in sqlite (still good to default to
2327 # the current head as we do now)
Gerrit Paped2feb012009-09-02 09:23:10 +00002328 system("git", "read-tree", $lastseenin);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002329 unless ($? == 0)
2330 {
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002331 print "E error running git-read-tree $lastseenin $ENV{GIT_INDEX_FILE} $!\n";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002332 return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002333 }
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002334 $log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit $lastseenin - exit status $?");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002335
2336 # do a checkout of the file
Gerrit Paped2feb012009-09-02 09:23:10 +00002337 system('git', 'checkout-index', '-f', '-u', $filename);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002338 unless ($? == 0) {
Jim Meyeringa5e40792007-07-14 20:48:42 +02002339 print "E error running git-checkout-index -f -u $filename : $!\n";
2340 return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002341 }
2342
2343 $log->info("Annotate $filename");
2344
2345 # Prepare a file with the commits from the linearized
2346 # history that annotate should know about. This prevents
2347 # git-jsannotate telling us about commits we are hiding
2348 # from the client.
2349
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002350 my $a_hints = "$work->{workDir}/.annotate_hints";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002351 if (!open(ANNOTATEHINTS, '>', $a_hints)) {
2352 print "E failed to open '$a_hints' for writing: $!\n";
2353 return;
2354 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002355 for (my $i=0; $i < @$revisions; $i++)
2356 {
2357 print ANNOTATEHINTS $revisions->[$i][2];
2358 if ($i+1 < @$revisions) { # have we got a parent?
2359 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
2360 }
2361 print ANNOTATEHINTS "\n";
2362 }
2363
2364 print ANNOTATEHINTS "\n";
Jim Meyeringa5e40792007-07-14 20:48:42 +02002365 close ANNOTATEHINTS
2366 or (print "E failed to write $a_hints: $!\n"), return;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002367
Gerrit Paped2feb012009-09-02 09:23:10 +00002368 my @cmd = (qw(git annotate -l -S), $a_hints, $filename);
Jim Meyeringa5e40792007-07-14 20:48:42 +02002369 if (!open(ANNOTATE, "-|", @cmd)) {
2370 print "E error invoking ". join(' ',@cmd) .": $!\n";
2371 return;
2372 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002373 my $metadata = {};
2374 print "E Annotations for $filename\n";
2375 print "E ***************\n";
2376 while ( <ANNOTATE> )
2377 {
2378 if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
2379 {
2380 my $commithash = $1;
2381 my $data = $2;
2382 unless ( defined ( $metadata->{$commithash} ) )
2383 {
2384 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
Damien Diederenc1bc3062008-03-27 23:18:35 +01002385 $metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002386 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
2387 }
Matthew Ogilvieab076812012-10-13 23:42:21 -06002388 printf("M %-7s (%-8s %10s): %s\n",
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002389 $metadata->{$commithash}{revision},
2390 $metadata->{$commithash}{author},
2391 $metadata->{$commithash}{modified},
2392 $data
2393 );
2394 } else {
2395 $log->warn("Error in annotate output! LINE: $_");
2396 print "E Annotate error \n";
2397 next;
2398 }
2399 }
2400 close ANNOTATE;
2401 }
2402
2403 # done; get out of the tempdir
Lars Noschinskidf4b3ab2008-07-16 13:35:46 +02002404 cleanupWorkTree();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002405
2406 print "ok\n";
2407
2408}
2409
2410# This method takes the state->{arguments} array and produces two new arrays.
2411# The first is $state->{args} which is everything before the '--' argument, and
2412# the second is $state->{files} which is everything after it.
2413sub argsplit
2414{
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002415 $state->{args} = [];
2416 $state->{files} = [];
2417 $state->{opt} = {};
2418
Frank Lichtenheld1e76b702007-06-17 10:31:02 +02002419 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
2420
2421 my $type = shift;
2422
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002423 if ( defined($type) )
2424 {
2425 my $opt = {};
2426 $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" );
2427 $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
2428 $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 -06002429 $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 +13002430 $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
2431 $opt = { k => 1, m => 1 } if ( $type eq "add" );
2432 $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
2433 $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" );
2434
2435
2436 while ( scalar ( @{$state->{arguments}} ) > 0 )
2437 {
2438 my $arg = shift @{$state->{arguments}};
2439
2440 next if ( $arg eq "--" );
2441 next unless ( $arg =~ /\S/ );
2442
2443 # if the argument looks like a switch
2444 if ( $arg =~ /^-(\w)(.*)/ )
2445 {
2446 # if it's a switch that takes an argument
2447 if ( $opt->{$1} )
2448 {
2449 # If this switch has already been provided
2450 if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
2451 {
2452 $state->{opt}{$1} = [ $state->{opt}{$1} ];
2453 if ( length($2) > 0 )
2454 {
2455 push @{$state->{opt}{$1}},$2;
2456 } else {
2457 push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
2458 }
2459 } else {
2460 # if there's extra data in the arg, use that as the argument for the switch
2461 if ( length($2) > 0 )
2462 {
2463 $state->{opt}{$1} = $2;
2464 } else {
2465 $state->{opt}{$1} = shift @{$state->{arguments}};
2466 }
2467 }
2468 } else {
2469 $state->{opt}{$1} = undef;
2470 }
2471 }
2472 else
2473 {
2474 push @{$state->{args}}, $arg;
2475 }
2476 }
2477 }
2478 else
2479 {
2480 my $mode = 0;
2481
2482 foreach my $value ( @{$state->{arguments}} )
2483 {
2484 if ( $value eq "--" )
2485 {
2486 $mode++;
2487 next;
2488 }
2489 push @{$state->{args}}, $value if ( $mode == 0 );
2490 push @{$state->{files}}, $value if ( $mode == 1 );
2491 }
2492 }
2493}
2494
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002495# Used by argsfromdir
2496sub expandArg
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002497{
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002498 my ($updater,$outNameMap,$outDirMap,$path,$isDir) = @_;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002499
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002500 my $fullPath = filecleanup($path);
Martyn Smith7d900952006-03-27 15:51:42 +12002501
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002502 # Is it a directory?
2503 if( defined($state->{dirMap}{$fullPath}) ||
2504 defined($state->{dirMap}{"$fullPath/"}) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002505 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002506 # It is a directory in the user's sandbox.
2507 $isDir=1;
Martyn Smith82000d72006-03-28 13:24:27 +12002508
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002509 if(defined($state->{entries}{$fullPath}))
Martyn Smith82000d72006-03-28 13:24:27 +12002510 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002511 $log->fatal("Inconsistent file/dir type");
2512 die "Inconsistent file/dir type";
2513 }
2514 }
2515 elsif(defined($state->{entries}{$fullPath}))
2516 {
2517 # It is a file in the user's sandbox.
2518 $isDir=0;
2519 }
2520 my($revDirMap,$otherRevDirMap);
2521 if(!defined($isDir) || $isDir)
2522 {
2523 # Resolve version tree for sticky tag:
2524 # (for now we only want list of files for the version, not
2525 # particular versions of those files: assume it is a directory
2526 # for the moment; ignore Entry's stick tag)
2527
2528 # Order of precedence of sticky tags:
2529 # -A [head]
2530 # -r /tag/
2531 # [file entry sticky tag, but that is only relevant to files]
2532 # [the tag specified in dir req_Sticky]
2533 # [the tag specified in a parent dir req_Sticky]
2534 # [head]
2535 # Also, -r may appear twice (for diff).
2536 #
2537 # FUTURE: When/if -j (merges) are supported, we also
2538 # need to add relevant files from one or two
2539 # versions specified with -j.
2540
2541 if(exists($state->{opt}{A}))
2542 {
2543 $revDirMap=$updater->getRevisionDirMap();
2544 }
2545 elsif( defined($state->{opt}{r}) and
2546 ref $state->{opt}{r} eq "ARRAY" )
2547 {
2548 $revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);
2549 $otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);
2550 }
2551 elsif(defined($state->{opt}{r}))
2552 {
2553 $revDirMap=$updater->getRevisionDirMap($state->{opt}{r});
2554 }
2555 else
2556 {
2557 my($sticky)=getDirStickyInfo($fullPath);
2558 $revDirMap=$updater->getRevisionDirMap($sticky->{tag});
Martyn Smith82000d72006-03-28 13:24:27 +12002559 }
2560
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002561 # Is it a directory?
2562 if( defined($revDirMap->{$fullPath}) ||
2563 defined($otherRevDirMap->{$fullPath}) )
Martyn Smith82000d72006-03-28 13:24:27 +12002564 {
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002565 $isDir=1;
2566 }
2567 }
2568
2569 # What to do with it?
2570 if(!$isDir)
2571 {
2572 $outNameMap->{$fullPath}=1;
2573 }
2574 else
2575 {
2576 $outDirMap->{$fullPath}=1;
2577
2578 if(defined($revDirMap->{$fullPath}))
2579 {
2580 addDirMapFiles($updater,$outNameMap,$outDirMap,
2581 $revDirMap->{$fullPath});
2582 }
2583 if( defined($otherRevDirMap) &&
2584 defined($otherRevDirMap->{$fullPath}) )
2585 {
2586 addDirMapFiles($updater,$outNameMap,$outDirMap,
2587 $otherRevDirMap->{$fullPath});
Martyn Smith82000d72006-03-28 13:24:27 +12002588 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002589 }
2590}
2591
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002592# Used by argsfromdir
2593# Add entries from dirMap to outNameMap. Also recurse into entries
2594# that are subdirectories.
2595sub addDirMapFiles
2596{
2597 my($updater,$outNameMap,$outDirMap,$dirMap)=@_;
2598
2599 my($fullName);
2600 foreach $fullName (keys(%$dirMap))
2601 {
2602 my $cleanName=$fullName;
2603 if(defined($state->{prependdir}))
2604 {
2605 if(!($cleanName=~s/^\Q$state->{prependdir}\E//))
2606 {
2607 $log->fatal("internal error stripping prependdir");
2608 die "internal error stripping prependdir";
2609 }
2610 }
2611
2612 if($dirMap->{$fullName} eq "F")
2613 {
2614 $outNameMap->{$cleanName}=1;
2615 }
2616 elsif($dirMap->{$fullName} eq "D")
2617 {
2618 if(!$state->{opt}{l})
2619 {
2620 expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);
2621 }
2622 }
2623 else
2624 {
2625 $log->fatal("internal error in addDirMapFiles");
2626 die "internal error in addDirMapFiles";
2627 }
2628 }
2629}
2630
2631# This method replaces $state->{args} with a directory-expanded
2632# list of all relevant filenames (recursively unless -d), based
2633# on $state->{entries}, and the "current" list of files in
2634# each directory. "Current" files as determined by
2635# either the requested (-r/-A) or "req_Sticky" version of
2636# that directory.
2637# Both the input args and the new output args are relative
2638# to the cvs-client's CWD, although some of the internal
2639# computations are relative to the top of the project.
2640sub argsfromdir
2641{
2642 my $updater = shift;
2643
2644 # Notes about requirements for specific callers:
2645 # update # "standard" case (entries; a single -r/-A/default; -l)
2646 # # Special case: -d for create missing directories.
2647 # diff # 0 or 1 -r's: "standard" case.
2648 # # 2 -r's: We could ignore entries (just use the two -r's),
2649 # # but it doesn't really matter.
2650 # annotate # "standard" case
2651 # log # Punting: log -r has a more complex non-"standard"
2652 # # meaning, and we don't currently try to support log'ing
2653 # # branches at all (need a lot of work to
2654 # # support CVS-consistent branch relative version
2655 # # numbering).
2656#HERE: But we still want to expand directories. Maybe we should
2657# essentially force "-A".
2658 # status # "standard", except that -r/-A/default are not possible.
2659 # # Mostly only used to expand entries only)
2660 #
2661 # Don't use argsfromdir at all:
2662 # add # Explicit arguments required. Directory args imply add
2663 # # the directory itself, not the files in it.
2664 # co # Obtain list directly.
2665 # remove # HERE: TEST: MAYBE client does the recursion for us,
2666 # # since it only makes sense to remove stuff already in
2667 # # the sandobx?
2668 # ci # HERE: Similar to remove...
2669 # # Don't try to implement the confusing/weird
2670 # # ci -r bug er.."feature".
2671
2672 if(scalar(@{$state->{args}})==0)
2673 {
2674 $state->{args} = [ "." ];
2675 }
2676 my %allArgs;
2677 my %allDirs;
2678 for my $file (@{$state->{args}})
2679 {
2680 expandArg($updater,\%allArgs,\%allDirs,$file);
2681 }
2682
2683 # Include any entries from sandbox. Generally client won't
2684 # send entries that shouldn't be used.
2685 foreach my $file (keys %{$state->{entries}})
2686 {
2687 $allArgs{remove_prependdir($file)} = 1;
2688 }
2689
2690 $state->{dirArgs} = \%allDirs;
2691 $state->{args} = [
2692 sort {
2693 # Sort priority: by directory depth, then actual file name:
2694 my @piecesA=split('/',$a);
2695 my @piecesB=split('/',$b);
2696
2697 my $count=scalar(@piecesA);
2698 my $tmp=scalar(@piecesB);
2699 return $count<=>$tmp if($count!=$tmp);
2700
2701 for($tmp=0;$tmp<$count;$tmp++)
2702 {
2703 if($piecesA[$tmp] ne $piecesB[$tmp])
2704 {
2705 return $piecesA[$tmp] cmp $piecesB[$tmp]
2706 }
2707 }
2708 return 0;
2709 } keys(%allArgs) ];
2710}
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -06002711
2712## look up directory sticky tag, of either fullPath or a parent:
2713sub getDirStickyInfo
2714{
2715 my($fullPath)=@_;
2716
2717 $fullPath=~s%/+$%%;
2718 while($fullPath ne "" && !defined($state->{dirMap}{"$fullPath/"}))
2719 {
2720 $fullPath=~s%/?[^/]*$%%;
2721 }
2722
2723 if( !defined($state->{dirMap}{"$fullPath/"}) &&
2724 ( $fullPath eq "" ||
2725 $fullPath eq "." ) )
2726 {
2727 return $state->{dirMap}{""}{stickyInfo};
2728 }
2729 else
2730 {
2731 return $state->{dirMap}{"$fullPath/"}{stickyInfo};
2732 }
2733}
2734
2735# Resolve precedence of various ways of specifying which version of
2736# a file you want. Returns undef (for default head), or a ref to a hash
2737# that contains "tag" and/or "date" keys.
2738sub resolveStickyInfo
2739{
2740 my($filename,$stickyTag,$stickyDate,$reset) = @_;
2741
2742 # Order of precedence of sticky tags:
2743 # -A [head]
2744 # -r /tag/
2745 # [file entry sticky tag]
2746 # [the tag specified in dir req_Sticky]
2747 # [the tag specified in a parent dir req_Sticky]
2748 # [head]
2749
2750 my $result;
2751 if($reset)
2752 {
2753 # $result=undef;
2754 }
2755 elsif( defined($stickyTag) && $stickyTag ne "" )
2756 # || ( defined($stickyDate) && $stickyDate ne "" ) # TODO
2757 {
2758 $result={ 'tag' => (defined($stickyTag)?$stickyTag:undef) };
2759
2760 # TODO: Convert -D value into the form 2011.04.10.04.46.57,
2761 # similar to an entry line's sticky date, without the D prefix.
2762 # It sometimes (always?) arrives as something more like
2763 # '10 Apr 2011 04:46:57 -0000'...
2764 # $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };
2765 }
2766 elsif( defined($state->{entries}{$filename}) &&
2767 defined($state->{entries}{$filename}{tag_or_date}) &&
2768 $state->{entries}{$filename}{tag_or_date} ne "" )
2769 {
2770 my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};
2771 if($tagOrDate=~/^T([^ ]+)\s*$/)
2772 {
2773 $result = { 'tag' => $1 };
2774 }
2775 elsif($tagOrDate=~/^D([0-9.]+)\s*$/)
2776 {
2777 $result= { 'date' => $1 };
2778 }
2779 else
2780 {
2781 die "Unknown tag_or_date format\n";
2782 }
2783 }
2784 else
2785 {
2786 $result=getDirStickyInfo($filename);
2787 }
2788
2789 return $result;
2790}
2791
2792# Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into
2793# a form appropriate for the sticky tag field of an Entries
2794# line (field index 5, 0-based).
2795sub getStickyTagOrDate
2796{
2797 my($stickyInfo)=@_;
2798
2799 my $result;
2800 if(defined($stickyInfo) && defined($stickyInfo->{tag}))
2801 {
2802 $result="T$stickyInfo->{tag}";
2803 }
2804 # TODO: When/if we actually pick versions by {date} properly,
2805 # also handle it here:
2806 # "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").
2807 else
2808 {
2809 $result="";
2810 }
2811
2812 return $result;
2813}
2814
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002815# This method cleans up the $state variable after a command that uses arguments has run
2816sub statecleanup
2817{
2818 $state->{files} = [];
Matthew Ogilvied66e8f82012-10-13 23:42:30 -06002819 $state->{dirArgs} = {};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002820 $state->{args} = [];
2821 $state->{arguments} = [];
2822 $state->{entries} = {};
Matthew Ogilvieeb5dcb22012-10-13 23:42:28 -06002823 $state->{dirMap} = {};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002824}
2825
Matthew Ogilvieab076812012-10-13 23:42:21 -06002826# Return working directory CVS revision "1.X" out
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06002827# of the the working directory "entries" state, for the given filename.
Matthew Ogilvieab076812012-10-13 23:42:21 -06002828# This is prefixed with a dash if the file is scheduled for removal
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06002829# when it is committed.
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002830sub revparse
2831{
2832 my $filename = shift;
2833
Matthew Ogilvieab076812012-10-13 23:42:21 -06002834 return $state->{entries}{$filename}{revision};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002835}
2836
Damien Diederene78f69a2008-03-27 23:18:12 +01002837# This method takes a file hash and does a CVS "file transfer". Its
2838# exact behaviour depends on a second, optional hash table argument:
2839# - If $options->{targetfile}, dump the contents to that file;
2840# - If $options->{print}, use M/MT to transmit the contents one line
2841# at a time;
2842# - Otherwise, transmit the size of the file, followed by the file
2843# contents.
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002844sub transmitfile
2845{
2846 my $filehash = shift;
Damien Diederene78f69a2008-03-27 23:18:12 +01002847 my $options = shift;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002848
2849 if ( defined ( $filehash ) and $filehash eq "deleted" )
2850 {
2851 $log->warn("filehash is 'deleted'");
2852 return;
2853 }
2854
2855 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
2856
Gerrit Paped2feb012009-09-02 09:23:10 +00002857 my $type = `git cat-file -t $filehash`;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002858 chomp $type;
2859
2860 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2861
Gerrit Paped2feb012009-09-02 09:23:10 +00002862 my $size = `git cat-file -s $filehash`;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002863 chomp $size;
2864
2865 $log->debug("transmitfile($filehash) size=$size, type=$type");
2866
Gerrit Paped2feb012009-09-02 09:23:10 +00002867 if ( open my $fh, '-|', "git", "cat-file", "blob", $filehash )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002868 {
Damien Diederene78f69a2008-03-27 23:18:12 +01002869 if ( defined ( $options->{targetfile} ) )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002870 {
Damien Diederene78f69a2008-03-27 23:18:12 +01002871 my $targetfile = $options->{targetfile};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002872 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2873 print NEWFILE $_ while ( <$fh> );
Jim Meyeringa5e40792007-07-14 20:48:42 +02002874 close NEWFILE or die("Failed to write '$targetfile': $!");
Damien Diederene78f69a2008-03-27 23:18:12 +01002875 } elsif ( defined ( $options->{print} ) && $options->{print} ) {
2876 while ( <$fh> ) {
2877 if( /\n\z/ ) {
2878 print 'M ', $_;
2879 } else {
2880 print 'MT text ', $_, "\n";
2881 }
2882 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002883 } else {
2884 print "$size\n";
2885 print while ( <$fh> );
2886 }
Jim Meyeringa5e40792007-07-14 20:48:42 +02002887 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002888 } else {
2889 die("Couldn't execute git-cat-file");
2890 }
2891}
2892
2893# This method takes a file name, and returns ( $dirpart, $filepart ) which
Junio C Hamano5348b6e2006-04-25 23:59:28 -07002894# refers to the directory portion and the file portion of the filename
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002895# respectively
2896sub filenamesplit
2897{
2898 my $filename = shift;
Martyn Smith7d900952006-03-27 15:51:42 +12002899 my $fixforlocaldir = shift;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002900
2901 my ( $filepart, $dirpart ) = ( $filename, "." );
2902 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2903 $dirpart .= "/";
2904
Martyn Smith7d900952006-03-27 15:51:42 +12002905 if ( $fixforlocaldir )
2906 {
2907 $dirpart =~ s/^$state->{prependdir}//;
2908 }
2909
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002910 return ( $filepart, $dirpart );
2911}
2912
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002913# Cleanup various junk in filename (try to canonicalize it), and
Stefano Lattarini41ccfdd2013-04-12 00:36:10 +02002914# add prependdir to accommodate running CVS client from a
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002915# subdirectory (so the output is relative to top directory of the project).
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002916sub filecleanup
2917{
2918 my $filename = shift;
2919
2920 return undef unless(defined($filename));
2921 if ( $filename =~ /^\// )
2922 {
2923 print "E absolute filenames '$filename' not supported by server\n";
2924 return undef;
2925 }
2926
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002927 if($filename eq ".")
2928 {
2929 $filename="";
2930 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002931 $filename =~ s/^\.\///g;
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002932 $filename =~ s%/+%/%g;
Martyn Smith82000d72006-03-28 13:24:27 +12002933 $filename = $state->{prependdir} . $filename;
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002934 $filename =~ s%/$%%;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13002935 return $filename;
2936}
2937
Matthew Ogilvie1899cbc2012-10-13 23:42:25 -06002938# Remove prependdir from the path, so that is is relative to the directory
2939# the CVS client was started from, rather than the top of the project.
2940# Essentially the inverse of filecleanup().
2941sub remove_prependdir
2942{
2943 my($path) = @_;
2944 if(defined($state->{prependdir}) && $state->{prependdir} ne "")
2945 {
2946 my($pre)=$state->{prependdir};
2947 $pre=~s%/$%%;
2948 if(!($path=~s%^\Q$pre\E/?%%))
2949 {
2950 $log->fatal("internal error missing prependdir");
2951 die("internal error missing prependdir");
2952 }
2953 }
2954 return $path;
2955}
2956
Matthew Ogilvie044182e2008-05-14 22:35:46 -06002957sub validateGitDir
2958{
2959 if( !defined($state->{CVSROOT}) )
2960 {
2961 print "error 1 CVSROOT not specified\n";
2962 cleanupWorkTree();
2963 exit;
2964 }
2965 if( $ENV{GIT_DIR} ne ($state->{CVSROOT} . '/') )
2966 {
2967 print "error 1 Internally inconsistent CVSROOT\n";
2968 cleanupWorkTree();
2969 exit;
2970 }
2971}
2972
2973# Setup working directory in a work tree with the requested version
2974# loaded in the index.
2975sub setupWorkTree
2976{
2977 my ($ver) = @_;
2978
2979 validateGitDir();
2980
2981 if( ( defined($work->{state}) && $work->{state} != 1 ) ||
2982 defined($work->{tmpDir}) )
2983 {
2984 $log->warn("Bad work tree state management");
2985 print "error 1 Internal setup multiple work trees without cleanup\n";
2986 cleanupWorkTree();
2987 exit;
2988 }
2989
2990 $work->{workDir} = tempdir ( DIR => $TEMP_DIR );
2991
2992 if( !defined($work->{index}) )
2993 {
2994 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
2995 }
2996
2997 chdir $work->{workDir} or
2998 die "Unable to chdir to $work->{workDir}\n";
2999
3000 $log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");
3001
3002 $ENV{GIT_WORK_TREE} = ".";
3003 $ENV{GIT_INDEX_FILE} = $work->{index};
3004 $work->{state} = 2;
3005
3006 if($ver)
3007 {
3008 system("git","read-tree",$ver);
3009 unless ($? == 0)
3010 {
3011 $log->warn("Error running git-read-tree");
3012 die "Error running git-read-tree $ver in $work->{workDir} $!\n";
3013 }
3014 }
3015 # else # req_annotate reads tree for each file
3016}
3017
3018# Ensure current directory is in some kind of working directory,
3019# with a recent version loaded in the index.
3020sub ensureWorkTree
3021{
3022 if( defined($work->{tmpDir}) )
3023 {
3024 $log->warn("Bad work tree state management [ensureWorkTree()]");
3025 print "error 1 Internal setup multiple dirs without cleanup\n";
3026 cleanupWorkTree();
3027 exit;
3028 }
3029 if( $work->{state} )
3030 {
3031 return;
3032 }
3033
3034 validateGitDir();
3035
3036 if( !defined($work->{emptyDir}) )
3037 {
3038 $work->{emptyDir} = tempdir ( DIR => $TEMP_DIR, OPEN => 0);
3039 }
3040 chdir $work->{emptyDir} or
3041 die "Unable to chdir to $work->{emptyDir}\n";
3042
3043 my $ver = `git show-ref -s refs/heads/$state->{module}`;
3044 chomp $ver;
3045 if ($ver !~ /^[0-9a-f]{40}$/)
3046 {
3047 $log->warn("Error from git show-ref -s refs/head$state->{module}");
3048 print "error 1 cannot find the current HEAD of module";
3049 cleanupWorkTree();
3050 exit;
3051 }
3052
3053 if( !defined($work->{index}) )
3054 {
3055 (undef, $work->{index}) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
3056 }
3057
3058 $ENV{GIT_WORK_TREE} = ".";
3059 $ENV{GIT_INDEX_FILE} = $work->{index};
3060 $work->{state} = 1;
3061
3062 system("git","read-tree",$ver);
3063 unless ($? == 0)
3064 {
3065 die "Error running git-read-tree $ver $!\n";
3066 }
3067}
3068
3069# Cleanup working directory that is not needed any longer.
3070sub cleanupWorkTree
3071{
3072 if( ! $work->{state} )
3073 {
3074 return;
3075 }
3076
3077 chdir "/" or die "Unable to chdir '/'\n";
3078
3079 if( defined($work->{workDir}) )
3080 {
3081 rmtree( $work->{workDir} );
3082 undef $work->{workDir};
3083 }
3084 undef $work->{state};
3085}
3086
3087# Setup a temporary directory (not a working tree), typically for
3088# merging dirty state as in req_update.
3089sub setupTmpDir
3090{
3091 $work->{tmpDir} = tempdir ( DIR => $TEMP_DIR );
3092 chdir $work->{tmpDir} or die "Unable to chdir $work->{tmpDir}\n";
3093
3094 return $work->{tmpDir};
3095}
3096
3097# Clean up a previously setupTmpDir. Restore previous work tree if
3098# appropriate.
3099sub cleanupTmpDir
3100{
3101 if ( !defined($work->{tmpDir}) )
3102 {
3103 $log->warn("cleanup tmpdir that has not been setup");
3104 die "Cleanup tmpDir that has not been setup\n";
3105 }
3106 if( defined($work->{state}) )
3107 {
3108 if( $work->{state} == 1 )
3109 {
3110 chdir $work->{emptyDir} or
3111 die "Unable to chdir to $work->{emptyDir}\n";
3112 }
3113 elsif( $work->{state} == 2 )
3114 {
3115 chdir $work->{workDir} or
3116 die "Unable to chdir to $work->{emptyDir}\n";
3117 }
3118 else
3119 {
3120 $log->warn("Inconsistent work dir state");
3121 die "Inconsistent work dir state\n";
3122 }
3123 }
3124 else
3125 {
3126 chdir "/" or die "Unable to chdir '/'\n";
3127 }
3128}
3129
Andy Parkins8538e872007-02-27 13:46:55 +00003130# Given a path, this function returns a string containing the kopts
3131# that should go into that path's Entries line. For example, a binary
3132# file should get -kb.
3133sub kopts_from_path
3134{
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003135 my ($path, $srcType, $name) = @_;
Andy Parkins8538e872007-02-27 13:46:55 +00003136
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003137 if ( defined ( $cfg->{gitcvs}{usecrlfattr} ) and
3138 $cfg->{gitcvs}{usecrlfattr} =~ /\s*(1|true|yes)\s*$/i )
3139 {
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003140 my ($val) = check_attr( "text", $path );
3141 if ( $val eq "unspecified" )
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003142 {
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003143 $val = check_attr( "crlf", $path );
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003144 }
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003145 if ( $val eq "unset" )
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003146 {
3147 return "-kb"
3148 }
Eyvind Bernhardsen5ec3e672010-05-19 22:43:11 +02003149 elsif ( check_attr( "eol", $path ) ne "unspecified" ||
3150 $val eq "set" || $val eq "input" )
3151 {
3152 return "";
3153 }
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003154 else
3155 {
3156 $log->info("Unrecognized check_attr crlf $path : $val");
3157 }
3158 }
Andy Parkins8538e872007-02-27 13:46:55 +00003159
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003160 if ( defined ( $cfg->{gitcvs}{allbinary} ) )
Andy Parkins8538e872007-02-27 13:46:55 +00003161 {
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003162 if( ($cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i) )
3163 {
3164 return "-kb";
3165 }
3166 elsif( ($cfg->{gitcvs}{allbinary} =~ /^\s*guess\s*$/i) )
3167 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003168 if( is_binary($srcType,$name) )
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003169 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003170 $log->debug("... as binary");
3171 return "-kb";
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003172 }
3173 else
3174 {
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003175 $log->debug("... as text");
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003176 }
3177 }
Andy Parkins8538e872007-02-27 13:46:55 +00003178 }
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003179 # Return "" to give no special treatment to any path
3180 return "";
Andy Parkins8538e872007-02-27 13:46:55 +00003181}
3182
Matthew Ogilvie8a06a632008-05-14 22:35:47 -06003183sub check_attr
3184{
3185 my ($attr,$path) = @_;
3186 ensureWorkTree();
3187 if ( open my $fh, '-|', "git", "check-attr", $attr, "--", $path )
3188 {
3189 my $val = <$fh>;
3190 close $fh;
3191 $val =~ s/.*: ([^:\r\n]*)\s*$/$1/;
3192 return $val;
3193 }
3194 else
3195 {
3196 return undef;
3197 }
3198}
3199
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003200# This should have the same heuristics as convert.c:is_binary() and related.
3201# Note that the bare CR test is done by callers in convert.c.
3202sub is_binary
3203{
3204 my ($srcType,$name) = @_;
3205 $log->debug("is_binary($srcType,$name)");
3206
3207 # Minimize amount of interpreted code run in the inner per-character
3208 # loop for large files, by totalling each character value and
3209 # then analyzing the totals.
3210 my @counts;
3211 my $i;
3212 for($i=0;$i<256;$i++)
3213 {
3214 $counts[$i]=0;
3215 }
3216
3217 my $fh = open_blob_or_die($srcType,$name);
3218 my $line;
3219 while( defined($line=<$fh>) )
3220 {
3221 # Any '\0' and bare CR are considered binary.
3222 if( $line =~ /\0|(\r[^\n])/ )
3223 {
3224 close($fh);
3225 return 1;
3226 }
3227
3228 # Count up each character in the line:
3229 my $len=length($line);
3230 for($i=0;$i<$len;$i++)
3231 {
3232 $counts[ord(substr($line,$i,1))]++;
3233 }
3234 }
3235 close $fh;
3236
3237 # Don't count CR and LF as either printable/nonprintable
3238 $counts[ord("\n")]=0;
3239 $counts[ord("\r")]=0;
3240
3241 # Categorize individual character count into printable and nonprintable:
3242 my $printable=0;
3243 my $nonprintable=0;
3244 for($i=0;$i<256;$i++)
3245 {
3246 if( $i < 32 &&
3247 $i != ord("\b") &&
3248 $i != ord("\t") &&
3249 $i != 033 && # ESC
3250 $i != 014 ) # FF
3251 {
3252 $nonprintable+=$counts[$i];
3253 }
3254 elsif( $i==127 ) # DEL
3255 {
3256 $nonprintable+=$counts[$i];
3257 }
3258 else
3259 {
3260 $printable+=$counts[$i];
3261 }
3262 }
3263
3264 return ($printable >> 7) < $nonprintable;
3265}
3266
3267# Returns open file handle. Possible invocations:
3268# - open_blob_or_die("file",$filename);
3269# - open_blob_or_die("sha1",$filehash);
3270sub open_blob_or_die
3271{
3272 my ($srcType,$name) = @_;
3273 my ($fh);
3274 if( $srcType eq "file" )
3275 {
3276 if( !open $fh,"<",$name )
3277 {
3278 $log->warn("Unable to open file $name: $!");
3279 die "Unable to open file $name: $!\n";
3280 }
3281 }
Matthew Ogilvie39b6a4b2012-10-13 23:42:15 -06003282 elsif( $srcType eq "sha1" )
Matthew Ogilvie90948a42008-05-14 22:35:48 -06003283 {
3284 unless ( defined ( $name ) and $name =~ /^[a-zA-Z0-9]{40}$/ )
3285 {
3286 $log->warn("Need filehash");
3287 die "Need filehash\n";
3288 }
3289
3290 my $type = `git cat-file -t $name`;
3291 chomp $type;
3292
3293 unless ( defined ( $type ) and $type eq "blob" )
3294 {
3295 $log->warn("Invalid type '$type' for '$name'");
3296 die ( "Invalid type '$type' (expected 'blob')" )
3297 }
3298
3299 my $size = `git cat-file -s $name`;
3300 chomp $size;
3301
3302 $log->debug("open_blob_or_die($name) size=$size, type=$type");
3303
3304 unless( open $fh, '-|', "git", "cat-file", "blob", $name )
3305 {
3306 $log->warn("Unable to open sha1 $name");
3307 die "Unable to open sha1 $name\n";
3308 }
3309 }
3310 else
3311 {
3312 $log->warn("Unknown type of blob source: $srcType");
3313 die "Unknown type of blob source: $srcType\n";
3314 }
3315 return $fh;
3316}
3317
Fabian Emmesd500a1e2009-01-02 16:40:14 +01003318# Generate a CVS author name from Git author information, by taking the local
3319# part of the email address and replacing characters not in the Portable
3320# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS
3321# Login names are Unix login names, which should be restricted to this
3322# character set.
Damien Diederenc1bc3062008-03-27 23:18:35 +01003323sub cvs_author
3324{
3325 my $author_line = shift;
Fabian Emmesd500a1e2009-01-02 16:40:14 +01003326 (my $author) = $author_line =~ /<([^@>]*)/;
3327
3328 $author =~ s/[^-a-zA-Z0-9_.]/_/g;
3329 $author =~ s/^-/_/;
Damien Diederenc1bc3062008-03-27 23:18:35 +01003330
3331 $author;
3332}
3333
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003334
3335sub descramble
3336{
3337 # This table is from src/scramble.c in the CVS source
3338 my @SHIFTS = (
3339 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15,
3340 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31,
3341 114,120, 53, 79, 96,109, 72,108, 70, 64, 76, 67,116, 74, 68, 87,
3342 111, 52, 75,119, 49, 34, 82, 81, 95, 65,112, 86,118,110,122,105,
3343 41, 57, 83, 43, 46,102, 40, 89, 38,103, 45, 50, 42,123, 91, 35,
3344 125, 55, 54, 66,124,126, 59, 47, 92, 71,115, 78, 88,107,106, 56,
3345 36,121,117,104,101,100, 69, 73, 99, 63, 94, 93, 39, 37, 61, 48,
3346 58,113, 32, 90, 44, 98, 60, 51, 33, 97, 62, 77, 84, 80, 85,223,
3347 225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,
3348 199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,
3349 174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,
3350 207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,
3351 192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,
3352 227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,
3353 182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,
3354 243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,152
3355 );
3356 my ($str) = @_;
3357
Ævar Arnfjörð Bjarmasonfce338a2010-06-19 16:06:57 +00003358 # This should never happen, the same password format (A) has been
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003359 # used by CVS since the beginning of time
Ævar Arnfjörð Bjarmason1f0eb512010-06-19 16:06:58 +00003360 {
3361 my $fmt = substr($str, 0, 1);
3362 die "invalid password format `$fmt'" unless $fmt eq 'A';
3363 }
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003364
3365 my @str = unpack "C*", substr($str, 1);
3366 my $ret = join '', map { chr $SHIFTS[$_] } @str;
3367 return $ret;
3368}
3369
Matthew Ogilvie61717662012-10-13 23:42:31 -06003370# Test if the (deep) values of two references to a hash are the same.
3371sub refHashEqual
3372{
3373 my($v1,$v2) = @_;
3374
3375 my $out;
3376 if(!defined($v1))
3377 {
3378 if(!defined($v2))
3379 {
3380 $out=1;
3381 }
3382 }
3383 elsif( !defined($v2) ||
3384 scalar(keys(%{$v1})) != scalar(keys(%{$v2})) )
3385 {
3386 # $out=undef;
3387 }
3388 else
3389 {
3390 $out=1;
3391
3392 my $key;
3393 foreach $key (keys(%{$v1}))
3394 {
3395 if( !exists($v2->{$key}) ||
3396 defined($v1->{$key}) ne defined($v2->{$key}) ||
3397 ( defined($v1->{$key}) &&
3398 $v1->{$key} ne $v2->{$key} ) )
3399 {
3400 $out=undef;
3401 last;
3402 }
3403 }
3404 }
3405
3406 return $out;
3407}
3408
Ævar Arnfjörð Bjarmason031a0272010-05-15 15:06:46 +00003409
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003410package GITCVS::log;
3411
3412####
3413#### Copyright The Open University UK - 2006.
3414####
3415#### Authors: Martyn Smith <martyn@catalyst.net.nz>
Junio C Hamanoadc31922010-10-05 12:44:08 -07003416#### Martin Langhoff <martin@laptop.org>
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003417####
3418####
3419
3420use strict;
3421use warnings;
3422
3423=head1 NAME
3424
3425GITCVS::log
3426
3427=head1 DESCRIPTION
3428
3429This module provides very crude logging with a similar interface to
3430Log::Log4perl
3431
3432=head1 METHODS
3433
3434=cut
3435
3436=head2 new
3437
3438Creates a new log object, optionally you can specify a filename here to
Junio C Hamano5348b6e2006-04-25 23:59:28 -07003439indicate the file to log to. If no log file is specified, you can specify one
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003440later with method setfile, or indicate you no longer want logging with method
3441nofile.
3442
3443Until one of these methods is called, all log calls will buffer messages ready
3444to write out.
3445
3446=cut
3447sub new
3448{
3449 my $class = shift;
3450 my $filename = shift;
3451
3452 my $self = {};
3453
3454 bless $self, $class;
3455
3456 if ( defined ( $filename ) )
3457 {
3458 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3459 }
3460
3461 return $self;
3462}
3463
3464=head2 setfile
3465
3466This methods takes a filename, and attempts to open that file as the log file.
3467If successful, all buffered data is written out to the file, and any further
3468logging is written directly to the file.
3469
3470=cut
3471sub setfile
3472{
3473 my $self = shift;
3474 my $filename = shift;
3475
3476 if ( defined ( $filename ) )
3477 {
3478 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
3479 }
3480
3481 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3482
3483 while ( my $line = shift @{$self->{buffer}} )
3484 {
3485 print {$self->{fh}} $line;
3486 }
3487}
3488
3489=head2 nofile
3490
3491This method indicates no logging is going to be used. It flushes any entries in
3492the internal buffer, and sets a flag to ensure no further data is put there.
3493
3494=cut
3495sub nofile
3496{
3497 my $self = shift;
3498
3499 $self->{nolog} = 1;
3500
3501 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
3502
3503 $self->{buffer} = [];
3504}
3505
3506=head2 _logopen
3507
3508Internal method. Returns true if the log file is open, false otherwise.
3509
3510=cut
3511sub _logopen
3512{
3513 my $self = shift;
3514
3515 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
3516 return 0;
3517}
3518
3519=head2 debug info warn fatal
3520
3521These four methods are wrappers to _log. They provide the actual interface for
3522logging data.
3523
3524=cut
3525sub debug { my $self = shift; $self->_log("debug", @_); }
3526sub info { my $self = shift; $self->_log("info" , @_); }
3527sub warn { my $self = shift; $self->_log("warn" , @_); }
3528sub fatal { my $self = shift; $self->_log("fatal", @_); }
3529
3530=head2 _log
3531
3532This is an internal method called by the logging functions. It generates a
3533timestamp and pushes the logged line either to file, or internal buffer.
3534
3535=cut
3536sub _log
3537{
3538 my $self = shift;
3539 my $level = shift;
3540
3541 return if ( $self->{nolog} );
3542
3543 my @time = localtime;
3544 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
3545 $time[5] + 1900,
3546 $time[4] + 1,
3547 $time[3],
3548 $time[2],
3549 $time[1],
3550 $time[0],
3551 uc $level,
3552 );
3553
3554 if ( $self->_logopen )
3555 {
3556 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
3557 } else {
3558 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
3559 }
3560}
3561
3562=head2 DESTROY
3563
3564This method simply closes the file handle if one is open
3565
3566=cut
3567sub DESTROY
3568{
3569 my $self = shift;
3570
3571 if ( $self->_logopen )
3572 {
3573 close $self->{fh};
3574 }
3575}
3576
3577package GITCVS::updater;
3578
3579####
3580#### Copyright The Open University UK - 2006.
3581####
3582#### Authors: Martyn Smith <martyn@catalyst.net.nz>
Junio C Hamanoadc31922010-10-05 12:44:08 -07003583#### Martin Langhoff <martin@laptop.org>
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003584####
3585####
3586
3587use strict;
3588use warnings;
3589use DBI;
3590
3591=head1 METHODS
3592
3593=cut
3594
3595=head2 new
3596
3597=cut
3598sub new
3599{
3600 my $class = shift;
3601 my $config = shift;
3602 my $module = shift;
3603 my $log = shift;
3604
3605 die "Need to specify a git repository" unless ( defined($config) and -d $config );
3606 die "Need to specify a module" unless ( defined($module) );
3607
3608 $class = ref($class) || $class;
3609
3610 my $self = {};
3611
3612 bless $self, $class;
3613
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003614 $self->{valid_tables} = {'revision' => 1,
3615 'revision_ix1' => 1,
3616 'revision_ix2' => 1,
3617 'head' => 1,
3618 'head_ix1' => 1,
3619 'properties' => 1,
3620 'commitmsgs' => 1};
3621
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003622 $self->{module} = $module;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003623 $self->{git_path} = $config . "/";
3624
3625 $self->{log} = $log;
3626
3627 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
3628
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06003629 # Stores full sha1's for various branch/tag names, abbreviations, etc:
3630 $self->{commitRefCache} = {};
3631
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003632 $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
Frank Lichtenheld473937e2007-04-07 16:58:09 +02003633 $cfg->{gitcvs}{dbdriver} || "SQLite";
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003634 $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
3635 $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
3636 $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
3637 $cfg->{gitcvs}{dbuser} || "";
3638 $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
3639 $cfg->{gitcvs}{dbpass} || "";
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003640 $self->{dbtablenameprefix} = $cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||
3641 $cfg->{gitcvs}{dbtablenameprefix} || "";
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003642 my %mapping = ( m => $module,
3643 a => $state->{method},
3644 u => getlogin || getpwuid($<) || $<,
3645 G => $self->{git_path},
3646 g => mangle_dirname($self->{git_path}),
3647 );
3648 $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
3649 $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003650 $self->{dbtablenameprefix} =~ s/%([mauGg])/$mapping{$1}/eg;
3651 $self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003652
Frank Lichtenheld473937e2007-04-07 16:58:09 +02003653 die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
3654 die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
3655 $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01003656 $self->{dbuser},
3657 $self->{dbpass});
Frank Lichtenheld920a4492007-03-19 16:56:01 +01003658 die "Error connecting to database\n" unless defined $self->{dbh};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003659
3660 $self->{tables} = {};
Frank Lichtenheld0cf611a2007-03-31 15:57:47 +02003661 foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003662 {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003663 $self->{tables}{$table} = 1;
3664 }
3665
3666 # Construct the revision table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003667 # The revision table stores an entry for each file, each time that file
3668 # changes.
3669 # numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )
3670 # This is not sufficient to support "-r {commithash}" for any
3671 # files except files that were modified by that commit (also,
3672 # some places in the code ignore/effectively strip out -r in
3673 # some cases, before it gets passed to getmeta()).
3674 # The "filehash" field typically has a git blob hash, but can also
3675 # be set to "dead" to indicate that the given version of the file
3676 # should not exist in the sandbox.
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003677 unless ( $self->{tables}{$self->tablename("revision")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003678 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003679 my $tablename = $self->tablename("revision");
3680 my $ix1name = $self->tablename("revision_ix1");
3681 my $ix2name = $self->tablename("revision_ix2");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003682 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003683 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003684 name TEXT NOT NULL,
3685 revision INTEGER NOT NULL,
3686 filehash TEXT NOT NULL,
3687 commithash TEXT NOT NULL,
3688 author TEXT NOT NULL,
3689 modified TEXT NOT NULL,
3690 mode TEXT NOT NULL
3691 )
3692 ");
Shawn Pearce178e0152006-10-23 01:09:35 -04003693 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003694 CREATE INDEX $ix1name
3695 ON $tablename (name,revision)
Shawn Pearce178e0152006-10-23 01:09:35 -04003696 ");
3697 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003698 CREATE INDEX $ix2name
3699 ON $tablename (name,commithash)
Shawn Pearce178e0152006-10-23 01:09:35 -04003700 ");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003701 }
3702
Shawn Pearce178e0152006-10-23 01:09:35 -04003703 # Construct the head table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003704 # The head table (along with the "last_commit" entry in the property
3705 # table) is the persisted working state of the "sub update" subroutine.
3706 # All of it's data is read entirely first, and completely recreated
3707 # last, every time "sub update" runs.
3708 # This is also used by "sub getmeta" when it is asked for the latest
3709 # version of a file (as opposed to some specific version).
3710 # Another way of thinking about it is as a single slice out of
3711 # "revisions", giving just the most recent revision information for
3712 # each file.
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003713 unless ( $self->{tables}{$self->tablename("head")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003714 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003715 my $tablename = $self->tablename("head");
3716 my $ix1name = $self->tablename("head_ix1");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003717 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003718 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003719 name TEXT NOT NULL,
3720 revision INTEGER NOT NULL,
3721 filehash TEXT NOT NULL,
3722 commithash TEXT NOT NULL,
3723 author TEXT NOT NULL,
3724 modified TEXT NOT NULL,
3725 mode TEXT NOT NULL
3726 )
3727 ");
Shawn Pearce178e0152006-10-23 01:09:35 -04003728 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003729 CREATE INDEX $ix1name
3730 ON $tablename (name)
Shawn Pearce178e0152006-10-23 01:09:35 -04003731 ");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003732 }
3733
3734 # Construct the properties table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003735 # - "last_commit" - Used by "sub update".
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003736 unless ( $self->{tables}{$self->tablename("properties")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003737 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003738 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003739 $self->{dbh}->do("
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003740 CREATE TABLE $tablename (
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003741 key TEXT NOT NULL PRIMARY KEY,
3742 value TEXT
3743 )
3744 ");
3745 }
3746
3747 # Construct the commitmsgs table if required
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003748 # The commitmsgs table is only used for merge commits, since
3749 # "sub update" will only keep one branch of parents. Shortlogs
3750 # for ignored commits (i.e. not on the chosen branch) will be used
3751 # to construct a replacement "collapsed" merge commit message,
3752 # which will be stored in this table. See also "sub commitmessage".
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003753 unless ( $self->{tables}{$self->tablename("commitmsgs")} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003754 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003755 my $tablename = $self->tablename("commitmsgs");
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 key TEXT NOT NULL PRIMARY KEY,
3759 value TEXT
3760 )
3761 ");
3762 }
3763
3764 return $self;
3765}
3766
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07003767=head2 tablename
3768
3769=cut
3770sub tablename
3771{
3772 my $self = shift;
3773 my $name = shift;
3774
3775 if (exists $self->{valid_tables}{$name}) {
3776 return $self->{dbtablenameprefix} . $name;
3777 } else {
3778 return undef;
3779 }
3780}
3781
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003782=head2 update
3783
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003784Bring the database up to date with the latest changes from
3785the git repository.
3786
3787Internal working state is read out of the "head" table and the
3788"last_commit" property, then it updates "revisions" based on that, and
3789finally it writes the new internal state back to the "head" table
3790so it can be used as a starting point the next time update is called.
3791
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003792=cut
3793sub update
3794{
3795 my $self = shift;
3796
3797 # first lets get the commit list
3798 $ENV{GIT_DIR} = $self->{git_path};
3799
Martin Langhoff49fb9402007-01-09 15:10:32 +13003800 my $commitsha1 = `git rev-parse $self->{module}`;
3801 chomp $commitsha1;
3802
3803 my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003804 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
3805 {
3806 die("Invalid module '$self->{module}'");
3807 }
3808
3809
3810 my $git_log;
3811 my $lastcommit = $self->_get_prop("last_commit");
3812
Martin Langhoff49fb9402007-01-09 15:10:32 +13003813 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
Matthew Ogilvie61717662012-10-13 23:42:31 -06003814 # invalidate the gethead cache
3815 $self->clearCommitRefCaches();
Martin Langhoff49fb9402007-01-09 15:10:32 +13003816 return 1;
3817 }
3818
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003819 # Start exclusive lock here...
3820 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
3821
3822 # TODO: log processing is memory bound
3823 # if we can parse into a 2nd file that is in reverse order
3824 # we can probably do something really efficient
Martin Langhoffa248c962006-05-04 10:51:46 +12003825 my @git_log_params = ('--pretty', '--parents', '--topo-order');
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003826
3827 if (defined $lastcommit) {
3828 push @git_log_params, "$lastcommit..$self->{module}";
3829 } else {
3830 push @git_log_params, $self->{module};
3831 }
Martin Langhoffa248c962006-05-04 10:51:46 +12003832 # git-rev-list is the backend / plumbing version of git-log
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003833 open(my $gitLogPipe, '-|', 'git', 'rev-list', @git_log_params)
3834 or die "Cannot call git-rev-list: $!";
3835 my @commits=readCommits($gitLogPipe);
3836 close $gitLogPipe;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003837
3838 # Now all the commits are in the @commits bucket
3839 # ordered by time DESC. for each commit that needs processing,
3840 # determine whether it's following the last head we've seen or if
3841 # it's on its own branch, grab a file list, and add whatever's changed
3842 # NOTE: $lastcommit refers to the last commit from previous run
3843 # $lastpicked is the last commit we picked in this run
3844 my $lastpicked;
3845 my $head = {};
3846 if (defined $lastcommit) {
3847 $lastpicked = $lastcommit;
3848 }
3849
3850 my $committotal = scalar(@commits);
3851 my $commitcount = 0;
3852
3853 # Load the head table into $head (for cached lookups during the update process)
Matthew Ogilvieab076812012-10-13 23:42:21 -06003854 foreach my $file ( @{$self->gethead(1)} )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003855 {
3856 $head->{$file->{name}} = $file;
3857 }
3858
3859 foreach my $commit ( @commits )
3860 {
3861 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
3862 if (defined $lastpicked)
3863 {
3864 if (!in_array($lastpicked, @{$commit->{parents}}))
3865 {
3866 # skip, we'll see this delta
3867 # as part of a merge later
3868 # warn "skipping off-track $commit->{hash}\n";
3869 next;
3870 } elsif (@{$commit->{parents}} > 1) {
3871 # it is a merge commit, for each parent that is
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003872 # not $lastpicked (not given a CVS revision number),
3873 # see if we can get a log
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003874 # from the merge-base to that parent to put it
3875 # in the message as a merge summary.
3876 my @parents = @{$commit->{parents}};
3877 foreach my $parent (@parents) {
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003878 if ($parent eq $lastpicked) {
3879 next;
3880 }
Matthew Ogilvie196e48f2012-10-13 23:42:16 -06003881 # git-merge-base can potentially (but rarely) throw
3882 # several candidate merge bases. let's assume
3883 # that the first one is the best one.
Steffen Prohaskae509db92008-01-26 10:54:06 +01003884 my $base = eval {
Gerrit Paped2feb012009-09-02 09:23:10 +00003885 safe_pipe_capture('git', 'merge-base',
Jim Meyeringa5e40792007-07-14 20:48:42 +02003886 $lastpicked, $parent);
Steffen Prohaskae509db92008-01-26 10:54:06 +01003887 };
3888 # The two branches may not be related at all,
3889 # in which case merge base simply fails to find
3890 # any, but that's Ok.
3891 next if ($@);
3892
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003893 chomp $base;
3894 if ($base) {
3895 my @merged;
3896 # print "want to log between $base $parent \n";
Gerrit Paped2feb012009-09-02 09:23:10 +00003897 open(GITLOG, '-|', 'git', 'log', '--pretty=medium', "$base..$parent")
Jim Meyeringa5e40792007-07-14 20:48:42 +02003898 or die "Cannot call git-log: $!";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003899 my $mergedhash;
3900 while (<GITLOG>) {
3901 chomp;
3902 if (!defined $mergedhash) {
3903 if (m/^commit\s+(.+)$/) {
3904 $mergedhash = $1;
3905 } else {
3906 next;
3907 }
3908 } else {
3909 # grab the first line that looks non-rfc822
3910 # aka has content after leading space
3911 if (m/^\s+(\S.*)$/) {
3912 my $title = $1;
3913 $title = substr($title,0,100); # truncate
3914 unshift @merged, "$mergedhash $title";
3915 undef $mergedhash;
3916 }
3917 }
3918 }
3919 close GITLOG;
3920 if (@merged) {
3921 $commit->{mergemsg} = $commit->{message};
3922 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
3923 foreach my $summary (@merged) {
3924 $commit->{mergemsg} .= "\t$summary\n";
3925 }
3926 $commit->{mergemsg} .= "\n\n";
3927 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
3928 }
3929 }
3930 }
3931 }
3932 }
3933
3934 # convert the date to CVS-happy format
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003935 my $cvsDate = convertToCvsDate($commit->{date});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003936
3937 if ( defined ( $lastpicked ) )
3938 {
Gerrit Paped2feb012009-09-02 09:23:10 +00003939 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 -08003940 local ($/) = "\0";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003941 while ( <FILELIST> )
3942 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003943 chomp;
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003944 unless ( /^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/o )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003945 {
3946 die("Couldn't process git-diff-tree line : $_");
3947 }
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003948 my ($mode, $hash, $change) = ($1, $2, $3);
3949 my $name = <FILELIST>;
3950 chomp($name);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003951
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003952 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003953
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003954 my $dbMode = convertToDbMode($mode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003955
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003956 if ( $change eq "D" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003957 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003958 #$log->debug("DELETE $name");
3959 $head->{$name} = {
3960 name => $name,
3961 revision => $head->{$name}{revision} + 1,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003962 filehash => "deleted",
3963 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003964 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003965 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003966 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003967 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003968 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003969 }
Paolo Bonzini9027efe2008-03-16 20:00:21 +01003970 elsif ( $change eq "M" || $change eq "T" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003971 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003972 #$log->debug("MODIFIED $name");
3973 $head->{$name} = {
3974 name => $name,
3975 revision => $head->{$name}{revision} + 1,
3976 filehash => $hash,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003977 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003978 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003979 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003980 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003981 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003982 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003983 }
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003984 elsif ( $change eq "A" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003985 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003986 #$log->debug("ADDED $name");
3987 $head->{$name} = {
3988 name => $name,
Frank Lichtenhelda7da9ad2007-05-02 02:43:14 +02003989 revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
Junio C Hamanoe02cd632006-11-10 11:53:41 -08003990 filehash => $hash,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003991 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003992 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003993 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003994 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003995 };
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06003996 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13003997 }
3998 else
3999 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004000 $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004001 die;
4002 }
4003 }
4004 close FILELIST;
4005 } else {
4006 # this is used to detect files removed from the repo
4007 my $seen_files = {};
4008
Gerrit Paped2feb012009-09-02 09:23:10 +00004009 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 -08004010 local $/ = "\0";
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004011 while ( <FILELIST> )
4012 {
Junio C Hamanoe02cd632006-11-10 11:53:41 -08004013 chomp;
4014 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004015 {
4016 die("Couldn't process git-ls-tree line : $_");
4017 }
4018
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004019 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004020
4021 $seen_files->{$git_filename} = 1;
4022
4023 my ( $oldhash, $oldrevision, $oldmode ) = (
4024 $head->{$git_filename}{filehash},
4025 $head->{$git_filename}{revision},
4026 $head->{$git_filename}{mode}
4027 );
4028
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004029 my $dbMode = convertToDbMode($mode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004030
4031 # unless the file exists with the same hash, we need to update it ...
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004032 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $dbMode )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004033 {
4034 my $newrevision = ( $oldrevision or 0 ) + 1;
4035
4036 $head->{$git_filename} = {
4037 name => $git_filename,
4038 revision => $newrevision,
4039 filehash => $git_hash,
4040 commithash => $commit->{hash},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004041 modified => $cvsDate,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004042 author => $commit->{author},
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004043 mode => $dbMode,
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004044 };
4045
4046
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004047 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $cvsDate, $commit->{author}, $dbMode);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004048 }
4049 }
4050 close FILELIST;
4051
4052 # Detect deleted files
Anders Kaseorg94629532013-10-30 04:44:43 -04004053 foreach my $file ( sort keys %$head )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004054 {
4055 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
4056 {
4057 $head->{$file}{revision}++;
4058 $head->{$file}{filehash} = "deleted";
4059 $head->{$file}{commithash} = $commit->{hash};
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004060 $head->{$file}{modified} = $cvsDate;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004061 $head->{$file}{author} = $commit->{author};
4062
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004063 $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 +13004064 }
4065 }
4066 # END : "Detect deleted files"
4067 }
4068
4069
4070 if (exists $commit->{mergemsg})
4071 {
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004072 $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004073 }
4074
4075 $lastpicked = $commit->{hash};
4076
4077 $self->_set_prop("last_commit", $commit->{hash});
4078 }
4079
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004080 $self->delete_head();
Anders Kaseorg94629532013-10-30 04:44:43 -04004081 foreach my $file ( sort keys %$head )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004082 {
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004083 $self->insert_head(
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004084 $file,
4085 $head->{$file}{revision},
4086 $head->{$file}{filehash},
4087 $head->{$file}{commithash},
4088 $head->{$file}{modified},
4089 $head->{$file}{author},
4090 $head->{$file}{mode},
4091 );
4092 }
4093 # invalidate the gethead cache
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004094 $self->clearCommitRefCaches();
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004095
4096
4097 # Ending exclusive lock here
4098 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
4099}
4100
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004101sub readCommits
4102{
4103 my $pipeHandle = shift;
4104 my @commits;
4105
4106 my %commit = ();
4107
4108 while ( <$pipeHandle> )
4109 {
4110 chomp;
4111 if (m/^commit\s+(.*)$/) {
4112 # on ^commit lines put the just seen commit in the stack
4113 # and prime things for the next one
4114 if (keys %commit) {
4115 my %copy = %commit;
4116 unshift @commits, \%copy;
4117 %commit = ();
4118 }
4119 my @parents = split(m/\s+/, $1);
4120 $commit{hash} = shift @parents;
4121 $commit{parents} = \@parents;
4122 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
4123 # on rfc822-like lines seen before we see any message,
4124 # lowercase the entry and put it in the hash as key-value
4125 $commit{lc($1)} = $2;
4126 } else {
4127 # message lines - skip initial empty line
4128 # and trim whitespace
4129 if (!exists($commit{message}) && m/^\s*$/) {
4130 # define it to mark the end of headers
4131 $commit{message} = '';
4132 next;
4133 }
4134 s/^\s+//; s/\s+$//; # trim ws
4135 $commit{message} .= $_ . "\n";
4136 }
4137 }
4138
4139 unshift @commits, \%commit if ( keys %commit );
4140
4141 return @commits;
4142}
4143
4144sub convertToCvsDate
4145{
4146 my $date = shift;
4147 # Convert from: "git rev-list --pretty" formatted date
4148 # Convert to: "the format specified by RFC822 as modified by RFC1123."
4149 # Example: 26 May 1997 13:01:40 -0400
4150 if( $date =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ )
4151 {
4152 $date = "$2 $1 $4 $3 $5";
4153 }
4154
4155 return $date;
4156}
4157
4158sub convertToDbMode
4159{
4160 my $mode = shift;
4161
4162 # NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",
4163 # but the database "mode" column historically (and currently)
4164 # only stores the "rw" (for user) part of the string.
4165 # FUTURE: It might make more sense to persist the raw
4166 # octal mode (or perhaps the final full CVS form) instead of
4167 # this half-converted form, but it isn't currently worth the
4168 # backwards compatibility headaches.
4169
Junio C Hamano1b48d562013-09-10 15:33:06 -07004170 $mode=~/^\d{3}(\d)\d\d$/;
Matthew Ogilvie2c3af7e2012-10-13 23:42:24 -06004171 my $userBits=$1;
4172
4173 my $dbMode = "";
4174 $dbMode .= "r" if ( $userBits & 4 );
4175 $dbMode .= "w" if ( $userBits & 2 );
4176 $dbMode .= "x" if ( $userBits & 1 );
4177 $dbMode = "rw" if ( $dbMode eq "" );
4178
4179 return $dbMode;
4180}
4181
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004182sub insert_rev
4183{
4184 my $self = shift;
4185 my $name = shift;
4186 my $revision = shift;
4187 my $filehash = shift;
4188 my $commithash = shift;
4189 my $modified = shift;
4190 my $author = shift;
4191 my $mode = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004192 my $tablename = $self->tablename("revision");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004193
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004194 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 +02004195 $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4196}
4197
4198sub insert_mergelog
4199{
4200 my $self = shift;
4201 my $key = shift;
4202 my $value = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004203 my $tablename = $self->tablename("commitmsgs");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004204
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004205 my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004206 $insert_mergelog->execute($key, $value);
4207}
4208
4209sub delete_head
4210{
4211 my $self = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004212 my $tablename = $self->tablename("head");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004213
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004214 my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM $tablename",{},1);
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004215 $delete_head->execute();
4216}
4217
4218sub insert_head
4219{
4220 my $self = shift;
4221 my $name = shift;
4222 my $revision = shift;
4223 my $filehash = shift;
4224 my $commithash = shift;
4225 my $modified = shift;
4226 my $author = shift;
4227 my $mode = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004228 my $tablename = $self->tablename("head");
Johannes Schindelin96256bb2006-07-25 13:57:57 +02004229
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004230 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 +02004231 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
4232}
4233
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004234sub _get_prop
4235{
4236 my $self = shift;
4237 my $key = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004238 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004239
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004240 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004241 $db_query->execute($key);
4242 my ( $value ) = $db_query->fetchrow_array;
4243
4244 return $value;
4245}
4246
4247sub _set_prop
4248{
4249 my $self = shift;
4250 my $key = shift;
4251 my $value = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004252 my $tablename = $self->tablename("properties");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004253
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004254 my $db_query = $self->{dbh}->prepare_cached("UPDATE $tablename SET value=? WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004255 $db_query->execute($value, $key);
4256
4257 unless ( $db_query->rows )
4258 {
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004259 $db_query = $self->{dbh}->prepare_cached("INSERT INTO $tablename (key, value) VALUES (?,?)",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004260 $db_query->execute($key, $value);
4261 }
4262
4263 return $value;
4264}
4265
4266=head2 gethead
4267
4268=cut
4269
4270sub gethead
4271{
4272 my $self = shift;
Matthew Ogilvieab076812012-10-13 23:42:21 -06004273 my $intRev = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004274 my $tablename = $self->tablename("head");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004275
4276 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
4277
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004278 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 +13004279 $db_query->execute();
4280
4281 my $tree = [];
4282 while ( my $file = $db_query->fetchrow_hashref )
4283 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06004284 if(!$intRev)
4285 {
4286 $file->{revision} = "1.$file->{revision}"
4287 }
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004288 push @$tree, $file;
4289 }
4290
4291 $self->{gethead_cache} = $tree;
4292
4293 return $tree;
4294}
4295
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004296=head2 getAnyHead
4297
4298Returns a reference to an array of getmeta structures, one
4299per file in the specified tree hash.
4300
4301=cut
4302
4303sub getAnyHead
4304{
4305 my ($self,$hash) = @_;
4306
4307 if(!defined($hash))
4308 {
4309 return $self->gethead();
4310 }
4311
4312 my @files;
4313 {
4314 open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4315 or die("Cannot call git-ls-tree : $!");
4316 local $/ = "\0";
4317 @files=<$filePipe>;
4318 close $filePipe;
4319 }
4320
4321 my $tree=[];
4322 my($line);
4323 foreach $line (@files)
4324 {
4325 $line=~s/\0$//;
4326 unless ( $line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4327 {
4328 die("Couldn't process git-ls-tree line : $_");
4329 }
4330
4331 my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4332 push @$tree, $self->getMetaFromCommithash($git_filename,$hash);
4333 }
4334
4335 return $tree;
4336}
4337
4338=head2 getRevisionDirMap
4339
4340A "revision dir map" contains all the plain-file filenames associated
Richard Hansenbb8040f2013-09-04 15:04:30 -04004341with a particular revision (tree-ish), organized by directory:
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004342
4343 $type = $out->{$dir}{$fullName}
4344
4345The type of each is "F" (for ordinary file) or "D" (for directory,
4346for which the map $out->{$fullName} will also exist).
4347
4348=cut
4349
4350sub getRevisionDirMap
4351{
4352 my ($self,$ver)=@_;
4353
4354 if(!defined($self->{revisionDirMapCache}))
4355 {
4356 $self->{revisionDirMapCache}={};
4357 }
4358
4359 # Get file list (previously cached results are dependent on HEAD,
4360 # but are early in each case):
4361 my $cacheKey;
4362 my (@fileList);
4363 if( !defined($ver) || $ver eq "" )
4364 {
4365 $cacheKey="";
4366 if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4367 {
4368 return $self->{revisionDirMapCache}{$cacheKey};
4369 }
4370
4371 my @head = @{$self->gethead()};
4372 foreach my $file ( @head )
4373 {
4374 next if ( $file->{filehash} eq "deleted" );
4375
4376 push @fileList,$file->{name};
4377 }
4378 }
4379 else
4380 {
4381 my ($hash)=$self->lookupCommitRef($ver);
4382 if( !defined($hash) )
4383 {
4384 return undef;
4385 }
4386
4387 $cacheKey=$hash;
4388 if( defined($self->{revisionDirMapCache}{$cacheKey}) )
4389 {
4390 return $self->{revisionDirMapCache}{$cacheKey};
4391 }
4392
4393 open(my $filePipe, '-|', 'git', 'ls-tree', '-z', '-r', $hash)
4394 or die("Cannot call git-ls-tree : $!");
4395 local $/ = "\0";
4396 while ( <$filePipe> )
4397 {
4398 chomp;
4399 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4400 {
4401 die("Couldn't process git-ls-tree line : $_");
4402 }
4403
4404 my($mode, $git_type, $git_hash, $git_filename) = ($1, $2, $3, $4);
4405
4406 push @fileList, $git_filename;
4407 }
4408 close $filePipe;
4409 }
4410
4411 # Convert to normalized form:
4412 my %revMap;
4413 my $file;
4414 foreach $file (@fileList)
4415 {
4416 my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);
4417 $dir='' if(!defined($dir));
4418
4419 # parent directories:
4420 # ... create empty dir maps for parent dirs:
4421 my($td)=$dir;
4422 while(!defined($revMap{$td}))
4423 {
4424 $revMap{$td}={};
4425
4426 my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4427 $tp='' if(!defined($tp));
4428 $td=$tp;
4429 }
4430 # ... add children to parent maps (now that they exist):
4431 $td=$dir;
4432 while($td ne "")
4433 {
4434 my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);
4435 $tp='' if(!defined($tp));
4436
4437 if(defined($revMap{$tp}{$td}))
4438 {
4439 if($revMap{$tp}{$td} ne 'D')
4440 {
4441 die "Weird file/directory inconsistency in $cacheKey";
4442 }
4443 last; # loop exit
4444 }
4445 $revMap{$tp}{$td}='D';
4446
4447 $td=$tp;
4448 }
4449
4450 # file
4451 $revMap{$dir}{$file}='F';
4452 }
4453
4454 # Save in cache:
4455 $self->{revisionDirMapCache}{$cacheKey}=\%revMap;
4456 return $self->{revisionDirMapCache}{$cacheKey};
4457}
4458
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004459=head2 getlog
4460
Matthew Ogilviea86c0982012-10-13 23:42:18 -06004461See also gethistorydense().
4462
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004463=cut
4464
4465sub getlog
4466{
4467 my $self = shift;
4468 my $filename = shift;
Matthew Ogilvieab076812012-10-13 23:42:21 -06004469 my $revFilter = shift;
4470
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004471 my $tablename = $self->tablename("revision");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004472
Matthew Ogilvieab076812012-10-13 23:42:21 -06004473 # Filters:
4474 # TODO: date, state, or by specific logins filters?
4475 # TODO: Handle comma-separated list of revFilter items, each item
4476 # can be a range [only case currently handled] or individual
4477 # rev or branch or "branch.".
4478 # TODO: Adjust $db_query WHERE clause based on revFilter, instead of
4479 # manually filtering the results of the query?
4480 my ( $minrev, $maxrev );
4481 if( defined($revFilter) and
4482 $state->{opt}{r} =~ /^(1.(\d+))?(::?)(1.(\d.+))?$/ )
4483 {
4484 my $control = $3;
4485 $minrev = $2;
4486 $maxrev = $5;
4487 $minrev++ if ( defined($minrev) and $control eq "::" );
4488 }
4489
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004490 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 +13004491 $db_query->execute($filename);
4492
Matthew Ogilvieab076812012-10-13 23:42:21 -06004493 my $totalRevs=0;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004494 my $tree = [];
4495 while ( my $file = $db_query->fetchrow_hashref )
4496 {
Matthew Ogilvieab076812012-10-13 23:42:21 -06004497 $totalRevs++;
4498 if( defined($minrev) and $file->{revision} < $minrev )
4499 {
4500 next;
4501 }
4502 if( defined($maxrev) and $file->{revision} > $maxrev )
4503 {
4504 next;
4505 }
4506
4507 $file->{revision} = "1." . $file->{revision};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004508 push @$tree, $file;
4509 }
4510
Matthew Ogilvieab076812012-10-13 23:42:21 -06004511 return ($tree,$totalRevs);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004512}
4513
4514=head2 getmeta
4515
4516This function takes a filename (with path) argument and returns a hashref of
4517metadata for that file.
4518
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004519There are several ways $revision can be specified:
4520
4521 - A reference to hash that contains a "tag" that is the
4522 actual revision (one of the below). TODO: Also allow it to
4523 specify a "date" in the hash.
4524 - undef, to refer to the latest version on the main branch.
4525 - Full CVS client revision number (mapped to integer in DB, without the
4526 "1." prefix),
4527 - Complex CVS-compatible "special" revision number for
4528 non-linear history (see comment below)
4529 - git commit sha1 hash
4530 - branch or tag name
4531
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004532=cut
4533
4534sub getmeta
4535{
4536 my $self = shift;
4537 my $filename = shift;
4538 my $revision = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004539 my $tablename_rev = $self->tablename("revision");
4540 my $tablename_head = $self->tablename("head");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004541
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004542 if ( ref($revision) eq "HASH" )
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004543 {
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004544 $revision = $revision->{tag};
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004545 }
4546
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004547 # Overview of CVS revision numbers:
4548 #
4549 # General CVS numbering scheme:
4550 # - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.
4551 # - Result of "cvs checkin -r" (possible, but not really
4552 # recommended): "2.1", "2.2", etc
4553 # - Branch tag: "1.2.0.n", where "1.2" is revision it was branched
4554 # from, "0" is a magic placeholder that identifies it as a
4555 # branch tag instead of a version tag, and n is 2 times the
4556 # branch number off of "1.2", starting with "2".
4557 # - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"
4558 # is branch number off of "1.2" (like n above), and "x" is
4559 # the version number on the branch.
4560 # - Branches can branch off of branches: "1.3.2.7.4.1" (even number
4561 # of components).
4562 # - Odd "n"s are used by "vendor branches" that result
4563 # from "cvs import". Vendor branches have additional
4564 # strangeness in the sense that the main rcs "head" of the main
4565 # branch will (temporarily until first normal commit) point
4566 # to the version on the vendor branch, rather than the actual
4567 # main branch. (FUTURE: This may provide an opportunity
4568 # to use "strange" revision numbers for fast-forward-merged
4569 # branch tip when CVS client is asking for the main branch.)
4570 #
4571 # git-cvsserver CVS-compatible special numbering schemes:
4572 # - Currently git-cvsserver only tries to be identical to CVS for
4573 # simple "1.x" numbers on the "main" branch (as identified
4574 # by the module name that was originally cvs checkout'ed).
4575 # - The database only stores the "x" part, for historical reasons.
4576 # But most of the rest of the cvsserver preserves
4577 # and thinks using the full revision number.
4578 # - To handle non-linear history, it uses a version of the form
4579 # "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely
4580 # identify this as a special revision number, and there are
4581 # 20 b's that together encode the sha1 git commit from which
4582 # this version of this file originated. Each b is
4583 # the numerical value of the corresponding byte plus
4584 # 100.
4585 # - "plus 100" avoids "0"s, and also reduces the
Stefano Lattarini41ccfdd2013-04-12 00:36:10 +02004586 # likelihood of a collision in the case that someone someday
Matthew Ogilviebfdafa02012-10-13 23:42:29 -06004587 # writes an import tool that tries to preserve original
4588 # CVS revision numbers, and the original CVS data had done
4589 # lots of branches off of branches and other strangeness to
4590 # end up with a real version number that just happens to look
4591 # like this special revision number form. Also, if needed
4592 # there are several ways to extend/identify alternative encodings
4593 # within the "2.1.1.2000" part if necessary.
4594 # - Unlike real CVS revisions, you can't really reconstruct what
4595 # relation a revision of this form has to other revisions.
4596 # - FUTURE: TODO: Rework database somehow to make up and remember
4597 # fully-CVS-compatible branches and branch version numbers.
4598
4599 my $meta;
4600 if ( defined($revision) )
4601 {
4602 if ( $revision =~ /^1\.(\d+)$/ )
4603 {
4604 my ($intRev) = $1;
4605 my $db_query;
4606 $db_query = $self->{dbh}->prepare_cached(
4607 "SELECT * FROM $tablename_rev WHERE name=? AND revision=?",
4608 {},1);
4609 $db_query->execute($filename, $intRev);
4610 $meta = $db_query->fetchrow_hashref;
4611 }
4612 elsif ( $revision =~ /^2\.1\.1\.2000(\.[1-3][0-9][0-9]){20}$/ )
4613 {
4614 my ($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);
4615 $commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;
4616 if($commitHash=~/^[0-9a-f]{40}$/)
4617 {
4618 return $self->getMetaFromCommithash($filename,$commitHash);
4619 }
4620
4621 # error recovery: fall back on head version below
4622 print "E Failed to find $filename version=$revision or commit=$commitHash\n";
4623 $log->warning("failed get $revision with commithash=$commitHash");
4624 undef $revision;
4625 }
4626 elsif ( $revision =~ /^[0-9a-f]{40}$/ )
4627 {
4628 # Try DB first. This is mostly only useful for req_annotate(),
4629 # which only calls this for stuff that should already be in
4630 # the DB. It is fairly likely to be a waste of time
4631 # in most other cases [unless the file happened to be
4632 # modified in $revision specifically], but
4633 # it is probably in the noise compared to how long
4634 # getMetaFromCommithash() will take.
4635 my $db_query;
4636 $db_query = $self->{dbh}->prepare_cached(
4637 "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4638 {},1);
4639 $db_query->execute($filename, $revision);
4640 $meta = $db_query->fetchrow_hashref;
4641
4642 if(! $meta)
4643 {
4644 my($revCommit)=$self->lookupCommitRef($revision);
4645 if($revCommit=~/^[0-9a-f]{40}$/)
4646 {
4647 return $self->getMetaFromCommithash($filename,$revCommit);
4648 }
4649
4650 # error recovery: nothing found:
4651 print "E Failed to find $filename version=$revision\n";
4652 $log->warning("failed get $revision");
4653 return $meta;
4654 }
4655 }
4656 else
4657 {
4658 my($revCommit)=$self->lookupCommitRef($revision);
4659 if($revCommit=~/^[0-9a-f]{40}$/)
4660 {
4661 return $self->getMetaFromCommithash($filename,$revCommit);
4662 }
4663
4664 # error recovery: fall back on head version below
4665 print "E Failed to find $filename version=$revision\n";
4666 $log->warning("failed get $revision");
4667 undef $revision; # Allow fallback
4668 }
4669 }
4670
4671 if(!defined($revision))
4672 {
4673 my $db_query;
4674 $db_query = $self->{dbh}->prepare_cached(
4675 "SELECT * FROM $tablename_head WHERE name=?",{},1);
4676 $db_query->execute($filename);
4677 $meta = $db_query->fetchrow_hashref;
4678 }
4679
Matthew Ogilvieab076812012-10-13 23:42:21 -06004680 if($meta)
4681 {
4682 $meta->{revision} = "1.$meta->{revision}";
4683 }
4684 return $meta;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004685}
4686
Matthew Ogilvie658b57a2012-10-13 23:42:27 -06004687sub getMetaFromCommithash
4688{
4689 my $self = shift;
4690 my $filename = shift;
4691 my $revCommit = shift;
4692
4693 # NOTE: This function doesn't scale well (lots of forks), especially
4694 # if you have many files that have not been modified for many commits
4695 # (each git-rev-parse redoes a lot of work for each file
4696 # that theoretically could be done in parallel by smarter
4697 # graph traversal).
4698 #
4699 # TODO: Possible optimization strategies:
4700 # - Solve the issue of assigning and remembering "real" CVS
4701 # revision numbers for branches, and ensure the
4702 # data structure can do this efficiently. Perhaps something
4703 # similar to "git notes", and carefully structured to take
4704 # advantage same-sha1-is-same-contents, to roll the same
4705 # unmodified subdirectory data onto multiple commits?
4706 # - Write and use a C tool that is like git-blame, but
4707 # operates on multiple files with file granularity, instead
4708 # of one file with line granularity. Cache
4709 # most-recently-modified in $self->{commitRefCache}{$revCommit}.
4710 # Try to be intelligent about how many files we do with
4711 # one fork (perhaps one directory at a time, without recursion,
4712 # and/or include directory as one line item, recurse from here
4713 # instead of in C tool?).
4714 # - Perhaps we could ask the DB for (filename,fileHash),
4715 # and just guess that it is correct (that the file hadn't
4716 # changed between $revCommit and the found commit, then
4717 # changed back, confusing anything trying to interpret
4718 # history). Probably need to add another index to revisions
4719 # DB table for this.
4720 # - NOTE: Trying to store all (commit,file) keys in DB [to
4721 # find "lastModfiedCommit] (instead of
4722 # just files that changed in each commit as we do now) is
4723 # probably not practical from a disk space perspective.
4724
4725 # Does the file exist in $revCommit?
4726 # TODO: Include file hash in dirmap cache.
4727 my($dirMap)=$self->getRevisionDirMap($revCommit);
4728 my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);
4729 if(!defined($dir))
4730 {
4731 $dir="";
4732 }
4733 if( !defined($dirMap->{$dir}) ||
4734 !defined($dirMap->{$dir}{$filename}) )
4735 {
4736 my($fileHash)="deleted";
4737
4738 my($retVal)={};
4739 $retVal->{name}=$filename;
4740 $retVal->{filehash}=$fileHash;
4741
4742 # not needed and difficult to compute:
4743 $retVal->{revision}="0"; # $revision;
4744 $retVal->{commithash}=$revCommit;
4745 #$retVal->{author}=$commit->{author};
4746 #$retVal->{modified}=convertToCvsDate($commit->{date});
4747 #$retVal->{mode}=convertToDbMode($mode);
4748
4749 return $retVal;
4750 }
4751
4752 my($fileHash)=safe_pipe_capture("git","rev-parse","$revCommit:$filename");
4753 chomp $fileHash;
4754 if(!($fileHash=~/^[0-9a-f]{40}$/))
4755 {
4756 die "Invalid fileHash '$fileHash' looking up"
4757 ." '$revCommit:$filename'\n";
4758 }
4759
4760 # information about most recent commit to modify $filename:
4761 open(my $gitLogPipe, '-|', 'git', 'rev-list',
4762 '--max-count=1', '--pretty', '--parents',
4763 $revCommit, '--', $filename)
4764 or die "Cannot call git-rev-list: $!";
4765 my @commits=readCommits($gitLogPipe);
4766 close $gitLogPipe;
4767 if(scalar(@commits)!=1)
4768 {
4769 die "Can't find most recent commit changing $filename\n";
4770 }
4771 my($commit)=$commits[0];
4772 if( !defined($commit) || !defined($commit->{hash}) )
4773 {
4774 return undef;
4775 }
4776
4777 # does this (commit,file) have a real assigned CVS revision number?
4778 my $tablename_rev = $self->tablename("revision");
4779 my $db_query;
4780 $db_query = $self->{dbh}->prepare_cached(
4781 "SELECT * FROM $tablename_rev WHERE name=? AND commithash=?",
4782 {},1);
4783 $db_query->execute($filename, $commit->{hash});
4784 my($meta)=$db_query->fetchrow_hashref;
4785 if($meta)
4786 {
4787 $meta->{revision} = "1.$meta->{revision}";
4788 return $meta;
4789 }
4790
4791 # fall back on special revision number
4792 my($revision)=$commit->{hash};
4793 $revision=~s/(..)/'.' . (hex($1)+100)/eg;
4794 $revision="2.1.1.2000$revision";
4795
4796 # meta data about $filename:
4797 open(my $filePipe, '-|', 'git', 'ls-tree', '-z',
4798 $commit->{hash}, '--', $filename)
4799 or die("Cannot call git-ls-tree : $!");
4800 local $/ = "\0";
4801 my $line;
4802 $line=<$filePipe>;
4803 if(defined(<$filePipe>))
4804 {
4805 die "Expected only a single file for git-ls-tree $filename\n";
4806 }
4807 close $filePipe;
4808
4809 chomp $line;
4810 unless ( $line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
4811 {
4812 die("Couldn't process git-ls-tree line : $line\n");
4813 }
4814 my ( $mode, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
4815
4816 # save result:
4817 my($retVal)={};
4818 $retVal->{name}=$filename;
4819 $retVal->{revision}=$revision;
4820 $retVal->{filehash}=$fileHash;
4821 $retVal->{commithash}=$revCommit;
4822 $retVal->{author}=$commit->{author};
4823 $retVal->{modified}=convertToCvsDate($commit->{date});
4824 $retVal->{mode}=convertToDbMode($mode);
4825
4826 return $retVal;
4827}
4828
4829=head2 lookupCommitRef
4830
4831Convert tag/branch/abbreviation/etc into a commit sha1 hash. Caches
4832the result so looking it up again is fast.
4833
4834=cut
4835
4836sub lookupCommitRef
4837{
4838 my $self = shift;
4839 my $ref = shift;
4840
4841 my $commitHash = $self->{commitRefCache}{$ref};
4842 if(defined($commitHash))
4843 {
4844 return $commitHash;
4845 }
4846
4847 $commitHash=safe_pipe_capture("git","rev-parse","--verify","--quiet",
4848 $self->unescapeRefName($ref));
4849 $commitHash=~s/\s*$//;
4850 if(!($commitHash=~/^[0-9a-f]{40}$/))
4851 {
4852 $commitHash=undef;
4853 }
4854
4855 if( defined($commitHash) )
4856 {
4857 my $type=safe_pipe_capture("git","cat-file","-t",$commitHash);
4858 if( ! ($type=~/^commit\s*$/ ) )
4859 {
4860 $commitHash=undef;
4861 }
4862 }
4863 if(defined($commitHash))
4864 {
4865 $self->{commitRefCache}{$ref}=$commitHash;
4866 }
4867 return $commitHash;
4868}
4869
4870=head2 clearCommitRefCaches
4871
4872Clears cached commit cache (sha1's for various tags/abbeviations/etc),
4873and related caches.
4874
4875=cut
4876
4877sub clearCommitRefCaches
4878{
4879 my $self = shift;
4880 $self->{commitRefCache} = {};
4881 $self->{revisionDirMapCache} = undef;
4882 $self->{gethead_cache} = undef;
4883}
4884
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004885=head2 commitmessage
4886
4887this function takes a commithash and returns the commit message for that commit
4888
4889=cut
4890sub commitmessage
4891{
4892 my $self = shift;
4893 my $commithash = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004894 my $tablename = $self->tablename("commitmsgs");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004895
4896 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
4897
4898 my $db_query;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004899 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM $tablename WHERE key=?",{},1);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004900 $db_query->execute($commithash);
4901
4902 my ( $message ) = $db_query->fetchrow_array;
4903
4904 if ( defined ( $message ) )
4905 {
4906 $message .= " " if ( $message =~ /\n$/ );
4907 return $message;
4908 }
4909
Gerrit Paped2feb012009-09-02 09:23:10 +00004910 my @lines = safe_pipe_capture("git", "cat-file", "commit", $commithash);
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004911 shift @lines while ( $lines[0] =~ /\S/ );
4912 $message = join("",@lines);
4913 $message .= " " if ( $message =~ /\n$/ );
4914 return $message;
4915}
4916
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004917=head2 gethistorydense
4918
4919This function takes a filename (with path) argument and returns an arrayofarrays
4920containing revision,filehash,commithash ordered by revision descending.
4921
4922This version of gethistory skips deleted entries -- so it is useful for annotate.
4923The 'dense' part is a reference to a '--dense' option available for git-rev-list
4924and other git tools that depend on it.
4925
Matthew Ogilviea86c0982012-10-13 23:42:18 -06004926See also getlog().
4927
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004928=cut
4929sub gethistorydense
4930{
4931 my $self = shift;
4932 my $filename = shift;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004933 my $tablename = $self->tablename("revision");
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004934
4935 my $db_query;
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07004936 $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 +13004937 $db_query->execute($filename);
4938
Matthew Ogilvieab076812012-10-13 23:42:21 -06004939 my $result = $db_query->fetchall_arrayref;
4940
4941 my $i;
4942 for($i=0 ; $i<scalar(@$result) ; $i++)
4943 {
4944 $result->[$i][0]="1." . $result->[$i][0];
4945 }
4946
4947 return $result;
Martin Langhoff3fda8c42006-02-22 22:50:15 +13004948}
4949
Matthew Ogilvie51a7e6d2012-10-13 23:42:26 -06004950=head2 escapeRefName
4951
4952Apply an escape mechanism to compensate for characters that
4953git ref names can have that CVS tags can not.
4954
4955=cut
4956sub escapeRefName
4957{
4958 my($self,$refName)=@_;
4959
4960 # CVS officially only allows [-_A-Za-z0-9] in tag names (or in
4961 # many contexts it can also be a CVS revision number).
4962 #
4963 # Git tags commonly use '/' and '.' as well, but also handle
4964 # anything else just in case:
4965 #
4966 # = "_-s-" For '/'.
4967 # = "_-p-" For '.'.
4968 # = "_-u-" For underscore, in case someone wants a literal "_-" in
4969 # a tag name.
4970 # = "_-xx-" Where "xx" is the hexadecimal representation of the
4971 # desired ASCII character byte. (for anything else)
4972
4973 if(! $refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)
4974 {
4975 $refName=~s/_-/_-u--/g;
4976 $refName=~s/\./_-p-/g;
4977 $refName=~s%/%_-s-%g;
4978 $refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;
4979 }
4980}
4981
4982=head2 unescapeRefName
4983
4984Undo an escape mechanism to compensate for characters that
4985git ref names can have that CVS tags can not.
4986
4987=cut
4988sub unescapeRefName
4989{
4990 my($self,$refName)=@_;
4991
4992 # see escapeRefName() for description of escape mechanism.
4993
4994 $refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;
4995
4996 # allowed tag names
4997 # TODO: Perhaps use git check-ref-format, with an in-process cache of
4998 # validated names?
4999 if( !( $refName=~m%^[^-][-a-zA-Z0-9_/.]*$% ) ||
5000 ( $refName=~m%[/.]$% ) ||
5001 ( $refName=~/\.lock$/ ) ||
5002 ( $refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) ) # matching }
5003 {
5004 # Error:
5005 $log->warn("illegal refName: $refName");
5006 $refName=undef;
5007 }
5008 return $refName;
5009}
5010
5011sub unescapeRefNameChar
5012{
5013 my($char)=@_;
5014
5015 if($char eq "s")
5016 {
5017 $char="/";
5018 }
5019 elsif($char eq "p")
5020 {
5021 $char=".";
5022 }
5023 elsif($char eq "u")
5024 {
5025 $char="_";
5026 }
5027 elsif($char=~/^[0-9a-f][0-9a-f]$/)
5028 {
5029 $char=chr(hex($char));
5030 }
5031 else
5032 {
5033 # Error case: Maybe it has come straight from user, and
5034 # wasn't supposed to be escaped? Restore it the way we got it:
5035 $char="_-$char-";
5036 }
5037
5038 return $char;
5039}
5040
Martin Langhoff3fda8c42006-02-22 22:50:15 +13005041=head2 in_array()
5042
5043from Array::PAT - mimics the in_array() function
5044found in PHP. Yuck but works for small arrays.
5045
5046=cut
5047sub in_array
5048{
5049 my ($check, @array) = @_;
5050 my $retval = 0;
5051 foreach my $test (@array){
5052 if($check eq $test){
5053 $retval = 1;
5054 }
5055 }
5056 return $retval;
5057}
5058
5059=head2 safe_pipe_capture
5060
Junio C Hamano5348b6e2006-04-25 23:59:28 -07005061an alternative to `command` that allows input to be passed as an array
Martin Langhoff3fda8c42006-02-22 22:50:15 +13005062to work around shell problems with weird characters in arguments
5063
5064=cut
5065sub safe_pipe_capture {
5066
5067 my @output;
5068
5069 if (my $pid = open my $child, '-|') {
5070 @output = (<$child>);
5071 close $child or die join(' ',@_).": $! $?";
5072 } else {
5073 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
5074 }
5075 return wantarray ? @output : join('',@output);
5076}
5077
Frank Lichtenheldeb1780d2007-03-19 16:56:00 +01005078=head2 mangle_dirname
5079
5080create a string from a directory name that is suitable to use as
5081part of a filename, mainly by converting all chars except \w.- to _
5082
5083=cut
5084sub mangle_dirname {
5085 my $dirname = shift;
5086 return unless defined $dirname;
5087
5088 $dirname =~ s/[^\w.-]/_/g;
5089
5090 return $dirname;
5091}
Martin Langhoff3fda8c42006-02-22 22:50:15 +13005092
Josh Elsasser6aeeffd2008-03-27 14:02:14 -07005093=head2 mangle_tablename
5094
5095create a string from a that is suitable to use as part of an SQL table
5096name, mainly by converting all chars except \w to _
5097
5098=cut
5099sub mangle_tablename {
5100 my $tablename = shift;
5101 return unless defined $tablename;
5102
5103 $tablename =~ s/[^\w_]/_/g;
5104
5105 return $tablename;
5106}
5107
Martin Langhoff3fda8c42006-02-22 22:50:15 +130051081;