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.
8 #### Copyright The Open University UK - 2006.
10 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
11 #### Martin Langhoff <martin@catalyst.net.nz>
14 #### Released under the GNU Public License, version 2.
23 use File::Temp qw/tempdir tempfile/;
25 use Getopt::Long qw(:config require_order no_ignore_case);
27 my $VERSION = '@@GIT_VERSION@@';
29 my $log = GITCVS::log->new();
47 # Enable autoflush for STDOUT (otherwise the whole thing falls apart)
50 #### Definition and mappings of functions ####
54 'Valid-responses' => \&req_Validresponses,
55 'valid-requests' => \&req_validrequests,
56 'Directory' => \&req_Directory,
57 'Entry' => \&req_Entry,
58 'Modified' => \&req_Modified,
59 'Unchanged' => \&req_Unchanged,
60 'Questionable' => \&req_Questionable,
61 'Argument' => \&req_Argument,
62 'Argumentx' => \&req_Argument,
63 'expand-modules' => \&req_expandmodules,
65 'remove' => \&req_remove,
67 'update' => \&req_update,
72 'tag' => \&req_CATCHALL,
73 'status' => \&req_status,
74 'admin' => \&req_CATCHALL,
75 'history' => \&req_CATCHALL,
76 'watchers' => \&req_CATCHALL,
77 'editors' => \&req_CATCHALL,
78 'annotate' => \&req_annotate,
79 'Global_option' => \&req_Globaloption,
80 #'annotate' => \&req_CATCHALL,
83 ##############################################
86 # $state holds all the bits of information the clients sends us that could
87 # potentially be useful when it comes to actually _doing_ something.
88 my $state = { prependdir => '' };
89 $log->info("--------------- STARTING -----------------");
92 "Usage: git-cvsserver [options] [pserver|server] [<directory> ...]\n".
93 " --base-path <path> : Prepend to requested CVSROOT\n".
94 " --strict-paths : Don't allow recursing into subdirectories\n".
95 " --export-all : Don't check for gitcvs.enabled in config\n".
96 " --version, -V : Print version information and exit\n".
97 " --help, -h, -H : Print usage information and exit\n".
99 "<directory> ... is a list of allowed directories. If no directories\n".
100 "are given, all are allowed. This is an additional restriction, gitcvs\n".
101 "access still needs to be enabled by the gitcvs.enabled config option.\n";
103 my @opts = ( 'help|h|H', 'version|V',
104 'base-path=s', 'strict-paths', 'export-all' );
105 GetOptions( $state, @opts )
108 if ($state->{version}) {
109 print "git-cvsserver version $VERSION\n";
112 if ($state->{help}) {
117 my $TEMP_DIR = tempdir( CLEANUP => 1 );
118 $log->debug("Temporary directory is '$TEMP_DIR'");
120 $state->{method} = 'ext';
122 if ($ARGV[0] eq 'pserver') {
123 $state->{method} = 'pserver';
125 } elsif ($ARGV[0] eq 'server') {
130 # everything else is a directory
131 $state->{allowed_roots} = [ @ARGV ];
133 # don't export the whole system unless the users requests it
134 if ($state->{'export-all'} && !@{$state->{allowed_roots}}) {
135 die "--export-all can only be used together with an explicit whitelist\n";
138 # if we are called with a pserver argument,
139 # deal with the authentication cat before entering the
141 if ($state->{method} eq 'pserver') {
142 my $line = <STDIN>; chomp $line;
143 unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
144 die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
147 $line = <STDIN>; chomp $line;
148 unless (req_Root('root', $line)) { # reuse Root
149 print "E Invalid root $line \n";
152 $line = <STDIN>; chomp $line;
153 unless ($line eq 'anonymous') {
154 print "E Only anonymous user allowed via pserver\n";
155 print "I HATE YOU\n";
158 $line = <STDIN>; chomp $line; # validate the password?
159 $line = <STDIN>; chomp $line;
160 unless ($line eq "END $request REQUEST") {
161 die "E Do not understand $line -- expecting END $request REQUEST\n";
163 print "I LOVE YOU\n";
164 exit if $request eq 'VERIFICATION'; # cvs login
165 # and now back to our regular programme...
168 # Keep going until the client closes the connection
173 # Check to see if we've seen this method, and call appropriate function.
174 if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
176 # use the $methods hash to call the appropriate sub for this command
177 #$log->info("Method : $1");
178 &{$methods->{$1}}($1,$2);
180 # log fatal because we don't understand this function. If this happens
181 # we're fairly screwed because we don't know if the client is expecting
182 # a response. If it is, the client will hang, we'll hang, and the whole
183 # thing will be custard.
184 $log->fatal("Don't understand command $_\n");
185 die("Unknown command $_");
189 $log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
190 $log->info("--------------- FINISH -----------------");
192 # Magic catchall method.
193 # This is the method that will handle all commands we haven't yet
194 # implemented. It simply sends a warning to the log file indicating a
195 # command that hasn't been implemented has been invoked.
198 my ( $cmd, $data ) = @_;
199 $log->warn("Unhandled command : req_$cmd : $data");
204 # Response expected: no. Tell the server which CVSROOT to use. Note that
205 # pathname is a local directory and not a fully qualified CVSROOT variable.
206 # pathname must already exist; if creating a new root, use the init
207 # request, not Root. pathname does not include the hostname of the server,
208 # how to access the server, etc.; by the time the CVS protocol is in use,
209 # connection, authentication, etc., are already taken care of. The Root
210 # request must be sent only once, and it must be sent before any requests
211 # other than Valid-responses, valid-requests, UseUnchanged, Set or init.
214 my ( $cmd, $data ) = @_;
215 $log->debug("req_Root : $data");
217 unless ($data =~ m#^/#) {
218 print "error 1 Root must be an absolute pathname\n";
222 my $cvsroot = $state->{'base-path'} || '';
226 if ($state->{CVSROOT}
227 && ($state->{CVSROOT} ne $cvsroot)) {
228 print "error 1 Conflicting roots specified\n";
232 $state->{CVSROOT} = $cvsroot;
234 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
236 if (@{$state->{allowed_roots}}) {
238 foreach my $dir (@{$state->{allowed_roots}}) {
239 next unless $dir =~ m#^/#;
241 if ($state->{'strict-paths'}) {
242 if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
246 } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
253 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
255 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
260 unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
261 print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
263 print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
267 my @gitvars = `git-config -l`;
269 print "E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
271 print "error 1 - problem executing git-config\n";
274 foreach my $line ( @gitvars )
276 next unless ( $line =~ /^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/ );
280 $cfg->{$1}{$2}{$3} = $4;
284 my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
285 || $cfg->{gitcvs}{enabled});
286 unless ($state->{'export-all'} ||
287 ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
288 print "E GITCVS emulation needs to be enabled on this repo\n";
289 print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
291 print "error 1 GITCVS emulation disabled\n";
295 my $logfile = $cfg->{gitcvs}{$state->{method}}{logfile} || $cfg->{gitcvs}{logfile};
298 $log->setfile($logfile);
306 # Global_option option \n
307 # Response expected: no. Transmit one of the global options `-q', `-Q',
308 # `-l', `-t', `-r', or `-n'. option must be one of those strings, no
309 # variations (such as combining of options) are allowed. For graceful
310 # handling of valid-requests, it is probably better to make new global
311 # options separate requests, rather than trying to add them to this
315 my ( $cmd, $data ) = @_;
316 $log->debug("req_Globaloption : $data");
317 $state->{globaloptions}{$data} = 1;
320 # Valid-responses request-list \n
321 # Response expected: no. Tell the server what responses the client will
322 # accept. request-list is a space separated list of tokens.
323 sub req_Validresponses
325 my ( $cmd, $data ) = @_;
326 $log->debug("req_Validresponses : $data");
328 # TODO : re-enable this, currently it's not particularly useful
329 #$state->{validresponses} = [ split /\s+/, $data ];
333 # Response expected: yes. Ask the server to send back a Valid-requests
335 sub req_validrequests
337 my ( $cmd, $data ) = @_;
339 $log->debug("req_validrequests");
341 $log->debug("SEND : Valid-requests " . join(" ",keys %$methods));
342 $log->debug("SEND : ok");
344 print "Valid-requests " . join(" ",keys %$methods) . "\n";
348 # Directory local-directory \n
349 # Additional data: repository \n. Response expected: no. Tell the server
350 # what directory to use. The repository should be a directory name from a
351 # previous server response. Note that this both gives a default for Entry
352 # and Modified and also for ci and the other commands; normal usage is to
353 # send Directory for each directory in which there will be an Entry or
354 # Modified, and then a final Directory for the original directory, then the
355 # command. The local-directory is relative to the top level at which the
356 # command is occurring (i.e. the last Directory which is sent before the
357 # command); to indicate that top level, `.' should be sent for
361 my ( $cmd, $data ) = @_;
363 my $repository = <STDIN>;
367 $state->{localdir} = $data;
368 $state->{repository} = $repository;
369 $state->{path} = $repository;
370 $state->{path} =~ s/^$state->{CVSROOT}\///;
371 $state->{module} = $1 if ($state->{path} =~ s/^(.*?)(\/|$)//);
372 $state->{path} .= "/" if ( $state->{path} =~ /\S/ );
374 $state->{directory} = $state->{localdir};
375 $state->{directory} = "" if ( $state->{directory} eq "." );
376 $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
378 if ( (not defined($state->{prependdir}) or $state->{prependdir} eq '') and $state->{localdir} eq "." and $state->{path} =~ /\S/ )
380 $log->info("Setting prepend to '$state->{path}'");
381 $state->{prependdir} = $state->{path};
382 foreach my $entry ( keys %{$state->{entries}} )
384 $state->{entries}{$state->{prependdir} . $entry} = $state->{entries}{$entry};
385 delete $state->{entries}{$entry};
389 if ( defined ( $state->{prependdir} ) )
391 $log->debug("Prepending '$state->{prependdir}' to state|directory");
392 $state->{directory} = $state->{prependdir} . $state->{directory}
394 $log->debug("req_Directory : localdir=$data repository=$repository path=$state->{path} directory=$state->{directory} module=$state->{module}");
397 # Entry entry-line \n
398 # Response expected: no. Tell the server what version of a file is on the
399 # local machine. The name in entry-line is a name relative to the directory
400 # most recently specified with Directory. If the user is operating on only
401 # some files in a directory, Entry requests for only those files need be
402 # included. If an Entry request is sent without Modified, Is-modified, or
403 # Unchanged, it means the file is lost (does not exist in the working
404 # directory). If both Entry and one of Modified, Is-modified, or Unchanged
405 # are sent for the same file, Entry must be sent first. For a given file,
406 # one can send Modified, Is-modified, or Unchanged, but not more than one
410 my ( $cmd, $data ) = @_;
412 #$log->debug("req_Entry : $data");
414 my @data = split(/\//, $data);
416 $state->{entries}{$state->{directory}.$data[1]} = {
417 revision => $data[2],
418 conflict => $data[3],
420 tag_or_date => $data[5],
423 $log->info("Received entry line '$data' => '" . $state->{directory} . $data[1] . "'");
426 # Questionable filename \n
427 # Response expected: no. Additional data: no. Tell the server to check
428 # whether filename should be ignored, and if not, next time the server
429 # sends responses, send (in a M response) `?' followed by the directory and
430 # filename. filename must not contain `/'; it needs to be a file in the
431 # directory named by the most recent Directory request.
434 my ( $cmd, $data ) = @_;
436 $log->debug("req_Questionable : $data");
437 $state->{entries}{$state->{directory}.$data}{questionable} = 1;
441 # Response expected: yes. Add a file or directory. This uses any previous
442 # Argument, Directory, Entry, or Modified requests, if they have been sent.
443 # The last Directory sent specifies the working directory at the time of
444 # the operation. To add a directory, send the directory to be added using
445 # Directory and Argument requests.
448 my ( $cmd, $data ) = @_;
452 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
455 argsfromdir($updater);
459 foreach my $filename ( @{$state->{args}} )
461 $filename = filecleanup($filename);
463 my $meta = $updater->getmeta($filename);
464 my $wrev = revparse($filename);
466 if ($wrev && $meta && ($wrev < 0))
468 # previously removed file, add back
469 $log->info("added file $filename was previously removed, send 1.$meta->{revision}");
471 print "MT +updated\n";
472 print "MT text U \n";
473 print "MT fname $filename\n";
474 print "MT newline\n";
475 print "MT -updated\n";
477 unless ( $state->{globaloptions}{-n} )
479 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
481 print "Created $dirpart\n";
482 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
484 # this is an "entries" line
485 my $kopts = kopts_from_path($filepart);
486 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
487 print "/$filepart/1.$meta->{revision}//$kopts/\n";
489 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
490 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
492 transmitfile($meta->{filehash});
498 unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
500 print "E cvs add: nothing known about `$filename'\n";
503 # TODO : check we're not squashing an already existing file
504 if ( defined ( $state->{entries}{$filename}{revision} ) )
506 print "E cvs add: `$filename' has already been entered\n";
510 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
512 print "E cvs add: scheduling file `$filename' for addition\n";
514 print "Checked-in $dirpart\n";
516 my $kopts = kopts_from_path($filepart);
517 print "/$filepart/0//$kopts/\n";
522 if ( $addcount == 1 )
524 print "E cvs add: use `cvs commit' to add this file permanently\n";
526 elsif ( $addcount > 1 )
528 print "E cvs add: use `cvs commit' to add these files permanently\n";
535 # Response expected: yes. Remove a file. This uses any previous Argument,
536 # Directory, Entry, or Modified requests, if they have been sent. The last
537 # Directory sent specifies the working directory at the time of the
538 # operation. Note that this request does not actually do anything to the
539 # repository; the only effect of a successful remove request is to supply
540 # the client with a new entries line containing `-' to indicate a removed
541 # file. In fact, the client probably could perform this operation without
542 # contacting the server, although using remove may cause the server to
543 # perform a few more checks. The client sends a subsequent ci request to
544 # actually record the removal in the repository.
547 my ( $cmd, $data ) = @_;
551 # Grab a handle to the SQLite db and do any necessary updates
552 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
555 #$log->debug("add state : " . Dumper($state));
559 foreach my $filename ( @{$state->{args}} )
561 $filename = filecleanup($filename);
563 if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
565 print "E cvs remove: file `$filename' still in working directory\n";
569 my $meta = $updater->getmeta($filename);
570 my $wrev = revparse($filename);
572 unless ( defined ( $wrev ) )
574 print "E cvs remove: nothing known about `$filename'\n";
578 if ( defined($wrev) and $wrev < 0 )
580 print "E cvs remove: file `$filename' already scheduled for removal\n";
584 unless ( $wrev == $meta->{revision} )
586 # TODO : not sure if the format of this message is quite correct.
587 print "E cvs remove: Up to date check failed for `$filename'\n";
592 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
594 print "E cvs remove: scheduling `$filename' for removal\n";
596 print "Checked-in $dirpart\n";
598 my $kopts = kopts_from_path($filepart);
599 print "/$filepart/-1.$wrev//$kopts/\n";
606 print "E cvs remove: use `cvs commit' to remove this file permanently\n";
608 elsif ( $rmcount > 1 )
610 print "E cvs remove: use `cvs commit' to remove these files permanently\n";
616 # Modified filename \n
617 # Response expected: no. Additional data: mode, \n, file transmission. Send
618 # the server a copy of one locally modified file. filename is a file within
619 # the most recent directory sent with Directory; it must not contain `/'.
620 # If the user is operating on only some files in a directory, only those
621 # files need to be included. This can also be sent without Entry, if there
622 # is no entry for the file.
625 my ( $cmd, $data ) = @_;
629 or (print "E end of file reading mode for $data\n"), return;
633 or (print "E end of file reading size of $data\n"), return;
636 # Grab config information
637 my $blocksize = 8192;
638 my $bytesleft = $size;
641 # Get a filehandle/name to write it to
642 my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
644 # Loop over file data writing out to temporary file.
647 $blocksize = $bytesleft if ( $bytesleft < $blocksize );
648 read STDIN, $tmp, $blocksize;
650 $bytesleft -= $blocksize;
654 or (print "E failed to write temporary, $filename: $!\n"), return;
656 # Ensure we have something sensible for the file mode
657 if ( $mode =~ /u=(\w+)/ )
664 # Save the file data in $state
665 $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
666 $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
667 $state->{entries}{$state->{directory}.$data}{modified_hash} = `git-hash-object $filename`;
668 $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
670 #$log->debug("req_Modified : file=$data mode=$mode size=$size");
673 # Unchanged filename \n
674 # Response expected: no. Tell the server that filename has not been
675 # modified in the checked out directory. The filename is a file within the
676 # most recent directory sent with Directory; it must not contain `/'.
679 my ( $cmd, $data ) = @_;
681 $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
683 #$log->debug("req_Unchanged : $data");
687 # Response expected: no. Save argument for use in a subsequent command.
688 # Arguments accumulate until an argument-using command is given, at which
689 # point they are forgotten.
691 # Response expected: no. Append \n followed by text to the current argument
695 my ( $cmd, $data ) = @_;
697 # Argumentx means: append to last Argument (with a newline in front)
699 $log->debug("$cmd : $data");
701 if ( $cmd eq 'Argumentx') {
702 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" . $data;
704 push @{$state->{arguments}}, $data;
709 # Response expected: yes. Expand the modules which are specified in the
710 # arguments. Returns the data in Module-expansion responses. Note that the
711 # server can assume that this is checkout or export, not rtag or rdiff; the
712 # latter do not access the working directory and thus have no need to
713 # expand modules on the client side. Expand may not be the best word for
714 # what this request does. It does not necessarily tell you all the files
715 # contained in a module, for example. Basically it is a way of telling you
716 # which working directories the server needs to know about in order to
717 # handle a checkout of the specified modules. For example, suppose that the
718 # server has a module defined by
719 # aliasmodule -a 1dir
720 # That is, one can check out aliasmodule and it will take 1dir in the
721 # repository and check it out to 1dir in the working directory. Now suppose
722 # the client already has this module checked out and is planning on using
723 # the co request to update it. Without using expand-modules, the client
724 # would have two bad choices: it could either send information about all
725 # working directories under the current directory, which could be
726 # unnecessarily slow, or it could be ignorant of the fact that aliasmodule
727 # stands for 1dir, and neglect to send information for 1dir, which would
728 # lead to incorrect operation. With expand-modules, the client would first
729 # ask for the module to be expanded:
730 sub req_expandmodules
732 my ( $cmd, $data ) = @_;
736 $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
738 unless ( ref $state->{arguments} eq "ARRAY" )
744 foreach my $module ( @{$state->{arguments}} )
746 $log->debug("SEND : Module-expansion $module");
747 print "Module-expansion $module\n";
755 # Response expected: yes. Get files from the repository. This uses any
756 # previous Argument, Directory, Entry, or Modified requests, if they have
757 # been sent. Arguments to this command are module names; the client cannot
758 # know what directories they correspond to except by (1) just sending the
759 # co request, and then seeing what directory names the server sends back in
760 # its responses, and (2) the expand-modules request.
763 my ( $cmd, $data ) = @_;
767 my $module = $state->{args}[0];
768 my $checkout_path = $module;
770 # use the user specified directory if we're given it
771 $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
773 $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
775 $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
777 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
779 # Grab a handle to the SQLite db and do any necessary updates
780 my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
783 $checkout_path =~ s|/$||; # get rid of trailing slashes
785 # Eclipse seems to need the Clear-sticky command
786 # to prepare the 'Entries' file for the new directory.
787 print "Clear-sticky $checkout_path/\n";
788 print $state->{CVSROOT} . "/$module/\n";
789 print "Clear-static-directory $checkout_path/\n";
790 print $state->{CVSROOT} . "/$module/\n";
791 print "Clear-sticky $checkout_path/\n"; # yes, twice
792 print $state->{CVSROOT} . "/$module/\n";
793 print "Template $checkout_path/\n";
794 print $state->{CVSROOT} . "/$module/\n";
797 # instruct the client that we're checking out to $checkout_path
798 print "E cvs checkout: Updating $checkout_path\n";
805 my ($dir, $repodir, $remotedir, $seendirs) = @_;
806 my $parent = dirname($dir);
809 $remotedir =~ s|/+$||;
811 $log->debug("announcedir $dir, $repodir, $remotedir" );
813 if ($parent eq '.' || $parent eq './') {
816 # recurse to announce unseen parents first
817 if (length($parent) && !exists($seendirs->{$parent})) {
818 prepdir($parent, $repodir, $remotedir, $seendirs);
820 # Announce that we are going to modify at the parent level
822 print "E cvs checkout: Updating $remotedir/$parent\n";
824 print "E cvs checkout: Updating $remotedir\n";
826 print "Clear-sticky $remotedir/$parent/\n";
827 print "$repodir/$parent/\n";
829 print "Clear-static-directory $remotedir/$dir/\n";
830 print "$repodir/$dir/\n";
831 print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
832 print "$repodir/$parent/\n";
833 print "Template $remotedir/$dir/\n";
834 print "$repodir/$dir/\n";
837 $seendirs->{$dir} = 1;
840 foreach my $git ( @{$updater->gethead} )
842 # Don't want to check out deleted files
843 next if ( $git->{filehash} eq "deleted" );
845 ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
847 if (length($git->{dir}) && $git->{dir} ne './'
848 && $git->{dir} ne $lastdir ) {
849 unless (exists($seendirs{$git->{dir}})) {
850 prepdir($git->{dir}, $state->{CVSROOT} . "/$module/",
851 $checkout_path, \%seendirs);
852 $lastdir = $git->{dir};
853 $seendirs{$git->{dir}} = 1;
855 print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
858 # modification time of this file
859 print "Mod-time $git->{modified}\n";
861 # print some information to the client
862 if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
864 print "M U $checkout_path/$git->{dir}$git->{name}\n";
866 print "M U $checkout_path/$git->{name}\n";
869 # instruct client we're sending a file to put in this path
870 print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
872 print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
874 # this is an "entries" line
875 my $kopts = kopts_from_path($git->{name});
876 print "/$git->{name}/1.$git->{revision}//$kopts/\n";
878 print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
881 transmitfile($git->{filehash});
890 # Response expected: yes. Actually do a cvs update command. This uses any
891 # previous Argument, Directory, Entry, or Modified requests, if they have
892 # been sent. The last Directory sent specifies the working directory at the
893 # time of the operation. The -I option is not used--files which the client
894 # can decide whether to ignore are not mentioned and the client sends the
895 # Questionable request for others.
898 my ( $cmd, $data ) = @_;
900 $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
905 # It may just be a client exploring the available heads/modules
906 # in that case, list them as top level directories and leave it
907 # at that. Eclipse uses this technique to offer you a list of
908 # projects (heads in this case) to checkout.
910 if ($state->{module} eq '') {
911 my $heads_dir = $state->{CVSROOT} . '/refs/heads';
912 if (!opendir HEADS, $heads_dir) {
913 print "E [server aborted]: Failed to open directory, "
914 . "$heads_dir: $!\nerror\n";
917 print "E cvs update: Updating .\n";
918 while (my $head = readdir(HEADS)) {
919 if (-f $state->{CVSROOT} . '/refs/heads/' . $head) {
920 print "E cvs update: New directory `$head'\n";
929 # Grab a handle to the SQLite db and do any necessary updates
930 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
934 argsfromdir($updater);
936 #$log->debug("update state : " . Dumper($state));
938 # foreach file specified on the command line ...
939 foreach my $filename ( @{$state->{args}} )
941 $filename = filecleanup($filename);
943 $log->debug("Processing file $filename");
945 # if we have a -C we should pretend we never saw modified stuff
946 if ( exists ( $state->{opt}{C} ) )
948 delete $state->{entries}{$filename}{modified_hash};
949 delete $state->{entries}{$filename}{modified_filename};
950 $state->{entries}{$filename}{unchanged} = 1;
954 if ( defined($state->{opt}{r}) and $state->{opt}{r} =~ /^1\.(\d+)/ )
956 $meta = $updater->getmeta($filename, $1);
958 $meta = $updater->getmeta($filename);
961 if ( ! defined $meta )
972 my $wrev = revparse($filename);
974 # If the working copy is an old revision, lets get that version too for comparison.
975 if ( defined($wrev) and $wrev != $meta->{revision} )
977 $oldmeta = $updater->getmeta($filename, $wrev);
980 #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
982 # Files are up to date if the working copy and repo copy have the same revision,
983 # and the working copy is unmodified _and_ the user hasn't specified -C
984 next if ( defined ( $wrev )
985 and defined($meta->{revision})
986 and $wrev == $meta->{revision}
987 and $state->{entries}{$filename}{unchanged}
988 and not exists ( $state->{opt}{C} ) );
990 # If the working copy and repo copy have the same revision,
991 # but the working copy is modified, tell the client it's modified
992 if ( defined ( $wrev )
993 and defined($meta->{revision})
994 and $wrev == $meta->{revision}
995 and defined($state->{entries}{$filename}{modified_hash})
996 and not exists ( $state->{opt}{C} ) )
998 $log->info("Tell the client the file is modified");
999 print "MT text M \n";
1000 print "MT fname $filename\n";
1001 print "MT newline\n";
1005 if ( $meta->{filehash} eq "deleted" )
1007 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1009 $log->info("Removing '$filename' from working copy (no longer in the repo)");
1011 print "E cvs update: `$filename' is no longer in the repository\n";
1012 # Don't want to actually _DO_ the update if -n specified
1013 unless ( $state->{globaloptions}{-n} ) {
1014 print "Removed $dirpart\n";
1015 print "$filepart\n";
1018 elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
1019 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash}
1020 or $meta->{filehash} eq 'added' )
1022 # normal update, just send the new revision (either U=Update,
1023 # or A=Add, or R=Remove)
1024 if ( defined($wrev) && $wrev < 0 )
1026 $log->info("Tell the client the file is scheduled for removal");
1027 print "MT text R \n";
1028 print "MT fname $filename\n";
1029 print "MT newline\n";
1032 elsif ( (!defined($wrev) || $wrev == 0) && (!defined($meta->{revision}) || $meta->{revision} == 0) )
1034 $log->info("Tell the client the file is scheduled for addition");
1035 print "MT text A \n";
1036 print "MT fname $filename\n";
1037 print "MT newline\n";
1042 $log->info("Updating '$filename' to ".$meta->{revision});
1043 print "MT +updated\n";
1044 print "MT text U \n";
1045 print "MT fname $filename\n";
1046 print "MT newline\n";
1047 print "MT -updated\n";
1050 my ( $filepart, $dirpart ) = filenamesplit($filename,1);
1052 # Don't want to actually _DO_ the update if -n specified
1053 unless ( $state->{globaloptions}{-n} )
1055 if ( defined ( $wrev ) )
1057 # instruct client we're sending a file to put in this path as a replacement
1058 print "Update-existing $dirpart\n";
1059 $log->debug("Updating existing file 'Update-existing $dirpart'");
1061 # instruct client we're sending a file to put in this path as a new file
1062 print "Clear-static-directory $dirpart\n";
1063 print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
1064 print "Clear-sticky $dirpart\n";
1065 print $state->{CVSROOT} . "/$state->{module}/$dirpart\n";
1067 $log->debug("Creating new file 'Created $dirpart'");
1068 print "Created $dirpart\n";
1070 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1072 # this is an "entries" line
1073 my $kopts = kopts_from_path($filepart);
1074 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
1075 print "/$filepart/1.$meta->{revision}//$kopts/\n";
1078 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1079 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1082 transmitfile($meta->{filehash});
1085 $log->info("Updating '$filename'");
1086 my ( $filepart, $dirpart ) = filenamesplit($meta->{name},1);
1088 my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
1091 my $file_local = $filepart . ".mine";
1092 system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
1093 my $file_old = $filepart . "." . $oldmeta->{revision};
1094 transmitfile($oldmeta->{filehash}, $file_old);
1095 my $file_new = $filepart . "." . $meta->{revision};
1096 transmitfile($meta->{filehash}, $file_new);
1098 # we need to merge with the local changes ( M=successful merge, C=conflict merge )
1099 $log->info("Merging $file_local, $file_old, $file_new");
1100 print "M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into $filename\n";
1102 $log->debug("Temporary directory for merge is $dir");
1104 my $return = system("git", "merge-file", $file_local, $file_old, $file_new);
1109 $log->info("Merged successfully");
1110 print "M M $filename\n";
1111 $log->debug("Merged $dirpart");
1113 # Don't want to actually _DO_ the update if -n specified
1114 unless ( $state->{globaloptions}{-n} )
1116 print "Merged $dirpart\n";
1117 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
1118 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1119 my $kopts = kopts_from_path($filepart);
1120 $log->debug("/$filepart/1.$meta->{revision}//$kopts/");
1121 print "/$filepart/1.$meta->{revision}//$kopts/\n";
1124 elsif ( $return == 1 )
1126 $log->info("Merged with conflicts");
1127 print "E cvs update: conflicts found in $filename\n";
1128 print "M C $filename\n";
1130 # Don't want to actually _DO_ the update if -n specified
1131 unless ( $state->{globaloptions}{-n} )
1133 print "Merged $dirpart\n";
1134 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
1135 my $kopts = kopts_from_path($filepart);
1136 print "/$filepart/1.$meta->{revision}/+/$kopts/\n";
1141 $log->warn("Merge failed");
1145 # Don't want to actually _DO_ the update if -n specified
1146 unless ( $state->{globaloptions}{-n} )
1149 $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
1150 print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
1152 # transmit file, format is single integer on a line by itself (file
1153 # size) followed by the file contents
1154 # TODO : we should copy files in blocks
1155 my $data = `cat $file_local`;
1156 $log->debug("File size : " . length($data));
1157 print length($data) . "\n";
1171 my ( $cmd, $data ) = @_;
1175 #$log->debug("State : " . Dumper($state));
1177 $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
1179 if ( $state->{method} eq 'pserver')
1181 print "error 1 pserver access cannot commit\n";
1185 if ( -e $state->{CVSROOT} . "/index" )
1187 $log->warn("file 'index' already exists in the git repository");
1188 print "error 1 Index already exists in git repo\n";
1192 # Grab a handle to the SQLite db and do any necessary updates
1193 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1196 my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1197 my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1198 $log->info("Lockless commit start, basing commit on '$tmpdir', index file is '$file_index'");
1200 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1201 $ENV{GIT_WORK_TREE} = ".";
1202 $ENV{GIT_INDEX_FILE} = $file_index;
1204 # Remember where the head was at the beginning.
1205 my $parenthash = `git show-ref -s refs/heads/$state->{module}`;
1207 if ($parenthash !~ /^[0-9a-f]{40}$/) {
1208 print "error 1 pserver cannot find the current HEAD of module";
1214 # populate the temporary index
1215 system("git-read-tree", $parenthash);
1218 die "Error running git-read-tree $state->{module} $file_index $!";
1220 $log->info("Created index '$file_index' for head $state->{module} - exit status $?");
1222 my @committedfiles = ();
1225 # foreach file specified on the command line ...
1226 foreach my $filename ( @{$state->{args}} )
1228 my $committedfile = $filename;
1229 $filename = filecleanup($filename);
1231 next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
1233 my $meta = $updater->getmeta($filename);
1234 $oldmeta{$filename} = $meta;
1236 my $wrev = revparse($filename);
1238 my ( $filepart, $dirpart ) = filenamesplit($filename);
1240 # do a checkout of the file if it is part of this tree
1242 system('git-checkout-index', '-f', '-u', $filename);
1244 die "Error running git-checkout-index -f -u $filename : $!";
1250 $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1251 $addflag = 1 unless ( -e $filename );
1253 # Do up to date checking
1254 unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
1256 # fail everything if an up to date check fails
1257 print "error 1 Up to date check failed for $filename\n";
1262 push @committedfiles, $committedfile;
1263 $log->info("Committing $filename");
1265 system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1269 $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1270 rename $state->{entries}{$filename}{modified_filename},$filename;
1272 # Calculate modes to remove
1274 foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1276 $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1277 system("chmod","u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1282 $log->info("Removing file '$filename'");
1284 system("git-update-index", "--remove", $filename);
1288 $log->info("Adding file '$filename'");
1289 system("git-update-index", "--add", $filename);
1291 $log->info("Updating file '$filename'");
1292 system("git-update-index", $filename);
1296 unless ( scalar(@committedfiles) > 0 )
1298 print "E No files to commit\n";
1304 my $treehash = `git-write-tree`;
1307 $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1309 # write our commit message out if we have one ...
1310 my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1311 print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1312 print $msg_fh "\n\nvia git-CVS emulator\n";
1315 my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1317 $log->info("Commit hash : $commithash");
1319 unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1321 $log->warn("Commit failed (Invalid commit hash)");
1322 print "error 1 Commit failed (unknown reason)\n";
1327 ### Emulate git-receive-pack by running hooks/update
1328 my @hook = ( $ENV{GIT_DIR}.'hooks/update', "refs/heads/$state->{module}",
1329 $parenthash, $commithash );
1331 unless( system( @hook ) == 0 )
1333 $log->warn("Commit failed (update hook declined to update ref)");
1334 print "error 1 Commit failed (update hook declined)\n";
1341 if (system(qw(git update-ref -m), "cvsserver ci",
1342 "refs/heads/$state->{module}", $commithash, $parenthash)) {
1343 $log->warn("update-ref for $state->{module} failed.");
1344 print "error 1 Cannot commit -- update first\n";
1348 ### Emulate git-receive-pack by running hooks/post-receive
1349 my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
1351 open(my $pipe, "| $hook") || die "can't fork $!";
1353 local $SIG{PIPE} = sub { die 'pipe broke' };
1355 print $pipe "$parenthash $commithash refs/heads/$state->{module}\n";
1357 close $pipe || die "bad pipe: $! $?";
1362 # foreach file specified on the command line ...
1363 foreach my $filename ( @committedfiles )
1365 $filename = filecleanup($filename);
1367 my $meta = $updater->getmeta($filename);
1368 unless (defined $meta->{revision}) {
1369 $meta->{revision} = 1;
1372 my ( $filepart, $dirpart ) = filenamesplit($filename, 1);
1374 $log->debug("Checked-in $dirpart : $filename");
1376 print "M $state->{CVSROOT}/$state->{module}/$filename,v <-- $dirpart$filepart\n";
1377 if ( defined $meta->{filehash} && $meta->{filehash} eq "deleted" )
1379 print "M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";
1380 print "Remove-entry $dirpart\n";
1381 print "$filename\n";
1383 if ($meta->{revision} == 1) {
1384 print "M initial revision: 1.1\n";
1386 print "M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";
1388 print "Checked-in $dirpart\n";
1389 print "$filename\n";
1390 my $kopts = kopts_from_path($filepart);
1391 print "/$filepart/1.$meta->{revision}//$kopts/\n";
1401 my ( $cmd, $data ) = @_;
1405 $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1406 #$log->debug("status state : " . Dumper($state));
1408 # Grab a handle to the SQLite db and do any necessary updates
1409 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1412 # if no files were specified, we need to work out what files we should be providing status on ...
1413 argsfromdir($updater);
1415 # foreach file specified on the command line ...
1416 foreach my $filename ( @{$state->{args}} )
1418 $filename = filecleanup($filename);
1420 my $meta = $updater->getmeta($filename);
1421 my $oldmeta = $meta;
1423 my $wrev = revparse($filename);
1425 # If the working copy is an old revision, lets get that version too for comparison.
1426 if ( defined($wrev) and $wrev != $meta->{revision} )
1428 $oldmeta = $updater->getmeta($filename, $wrev);
1431 # TODO : All possible statuses aren't yet implemented
1433 # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1434 $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1436 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1437 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1440 # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1441 $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1443 ( $state->{entries}{$filename}{unchanged}
1444 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1447 # Need checkout if it exists in the repo but doesn't have a working copy
1448 $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1450 # Locally modified if working copy and repo copy have the same revision but there are local changes
1451 $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1453 # Needs Merge if working copy revision is less than repo copy and there are local changes
1454 $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1456 $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1457 $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1458 $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1459 $status ||= "File had conflicts on merge" if ( 0 );
1461 $status ||= "Unknown";
1463 print "M ===================================================================\n";
1464 print "M File: $filename\tStatus: $status\n";
1465 if ( defined($state->{entries}{$filename}{revision}) )
1467 print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1469 print "M Working revision:\tNo entry for $filename\n";
1471 if ( defined($meta->{revision}) )
1473 print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{CVSROOT}/$state->{module}/$filename,v\n";
1474 print "M Sticky Tag:\t\t(none)\n";
1475 print "M Sticky Date:\t\t(none)\n";
1476 print "M Sticky Options:\t\t(none)\n";
1478 print "M Repository revision:\tNo revision control file\n";
1488 my ( $cmd, $data ) = @_;
1492 $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1493 #$log->debug("status state : " . Dumper($state));
1495 my ($revision1, $revision2);
1496 if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1498 $revision1 = $state->{opt}{r}[0];
1499 $revision2 = $state->{opt}{r}[1];
1501 $revision1 = $state->{opt}{r};
1504 $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1505 $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1507 $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1509 # Grab a handle to the SQLite db and do any necessary updates
1510 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1513 # if no files were specified, we need to work out what files we should be providing status on ...
1514 argsfromdir($updater);
1516 # foreach file specified on the command line ...
1517 foreach my $filename ( @{$state->{args}} )
1519 $filename = filecleanup($filename);
1521 my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1523 my $wrev = revparse($filename);
1525 # We need _something_ to diff against
1526 next unless ( defined ( $wrev ) );
1528 # if we have a -r switch, use it
1529 if ( defined ( $revision1 ) )
1531 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1532 $meta1 = $updater->getmeta($filename, $revision1);
1533 unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1535 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1538 transmitfile($meta1->{filehash}, $file1);
1540 # otherwise we just use the working copy revision
1543 ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1544 $meta1 = $updater->getmeta($filename, $wrev);
1545 transmitfile($meta1->{filehash}, $file1);
1548 # if we have a second -r switch, use it too
1549 if ( defined ( $revision2 ) )
1551 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1552 $meta2 = $updater->getmeta($filename, $revision2);
1554 unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1556 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1560 transmitfile($meta2->{filehash}, $file2);
1562 # otherwise we just use the working copy
1565 $file2 = $state->{entries}{$filename}{modified_filename};
1568 # if we have been given -r, and we don't have a $file2 yet, lets get one
1569 if ( defined ( $revision1 ) and not defined ( $file2 ) )
1571 ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1572 $meta2 = $updater->getmeta($filename, $wrev);
1573 transmitfile($meta2->{filehash}, $file2);
1576 # We need to have retrieved something useful
1577 next unless ( defined ( $meta1 ) );
1579 # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1580 next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1582 ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1583 or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1586 # Apparently we only show diffs for locally modified files
1587 next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1589 print "M Index: $filename\n";
1590 print "M ===================================================================\n";
1591 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1592 print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1593 print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1595 foreach my $opt ( keys %{$state->{opt}} )
1597 if ( ref $state->{opt}{$opt} eq "ARRAY" )
1599 foreach my $value ( @{$state->{opt}{$opt}} )
1601 print "-$opt $value ";
1605 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1608 print "$filename\n";
1610 $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1612 ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1614 if ( exists $state->{opt}{u} )
1616 system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1618 system("diff $file1 $file2 > $filediff");
1633 my ( $cmd, $data ) = @_;
1637 $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1638 #$log->debug("log state : " . Dumper($state));
1640 my ( $minrev, $maxrev );
1641 if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1646 $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1647 $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1648 $minrev++ if ( defined($minrev) and $control eq "::" );
1651 # Grab a handle to the SQLite db and do any necessary updates
1652 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1655 # if no files were specified, we need to work out what files we should be providing status on ...
1656 argsfromdir($updater);
1658 # foreach file specified on the command line ...
1659 foreach my $filename ( @{$state->{args}} )
1661 $filename = filecleanup($filename);
1663 my $headmeta = $updater->getmeta($filename);
1665 my $revisions = $updater->getlog($filename);
1666 my $totalrevisions = scalar(@$revisions);
1668 if ( defined ( $minrev ) )
1670 $log->debug("Removing revisions less than $minrev");
1671 while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1676 if ( defined ( $maxrev ) )
1678 $log->debug("Removing revisions greater than $maxrev");
1679 while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1685 next unless ( scalar(@$revisions) );
1688 print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1689 print "M Working file: $filename\n";
1690 print "M head: 1.$headmeta->{revision}\n";
1691 print "M branch:\n";
1692 print "M locks: strict\n";
1693 print "M access list:\n";
1694 print "M symbolic names:\n";
1695 print "M keyword substitution: kv\n";
1696 print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1697 print "M description:\n";
1699 foreach my $revision ( @$revisions )
1701 print "M ----------------------------\n";
1702 print "M revision 1.$revision->{revision}\n";
1703 # reformat the date for log output
1704 $revision->{modified} = sprintf('%04d/%02d/%02d %s', $3, $DATE_LIST->{$2}, $1, $4 ) if ( $revision->{modified} =~ /(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/ and defined($DATE_LIST->{$2}) );
1705 $revision->{author} =~ s/\s+.*//;
1706 $revision->{author} =~ s/^(.{8}).*/$1/;
1707 print "M date: $revision->{modified}; author: $revision->{author}; state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . "; lines: +2 -3\n";
1708 my $commitmessage = $updater->commitmessage($revision->{commithash});
1709 $commitmessage =~ s/^/M /mg;
1710 print $commitmessage . "\n";
1712 print "M =============================================================================\n";
1720 my ( $cmd, $data ) = @_;
1722 argsplit("annotate");
1724 $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1725 #$log->debug("status state : " . Dumper($state));
1727 # Grab a handle to the SQLite db and do any necessary updates
1728 my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1731 # if no files were specified, we need to work out what files we should be providing annotate on ...
1732 argsfromdir($updater);
1734 # we'll need a temporary checkout dir
1735 my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1736 my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1737 $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1739 $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1740 $ENV{GIT_WORK_TREE} = ".";
1741 $ENV{GIT_INDEX_FILE} = $file_index;
1745 # foreach file specified on the command line ...
1746 foreach my $filename ( @{$state->{args}} )
1748 $filename = filecleanup($filename);
1750 my $meta = $updater->getmeta($filename);
1752 next unless ( $meta->{revision} );
1754 # get all the commits that this file was in
1755 # in dense format -- aka skip dead revisions
1756 my $revisions = $updater->gethistorydense($filename);
1757 my $lastseenin = $revisions->[0][2];
1759 # populate the temporary index based on the latest commit were we saw
1760 # the file -- but do it cheaply without checking out any files
1761 # TODO: if we got a revision from the client, use that instead
1762 # to look up the commithash in sqlite (still good to default to
1763 # the current head as we do now)
1764 system("git-read-tree", $lastseenin);
1767 print "E error running git-read-tree $lastseenin $file_index $!\n";
1770 $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1772 # do a checkout of the file
1773 system('git-checkout-index', '-f', '-u', $filename);
1775 print "E error running git-checkout-index -f -u $filename : $!\n";
1779 $log->info("Annotate $filename");
1781 # Prepare a file with the commits from the linearized
1782 # history that annotate should know about. This prevents
1783 # git-jsannotate telling us about commits we are hiding
1786 my $a_hints = "$tmpdir/.annotate_hints";
1787 if (!open(ANNOTATEHINTS, '>', $a_hints)) {
1788 print "E failed to open '$a_hints' for writing: $!\n";
1791 for (my $i=0; $i < @$revisions; $i++)
1793 print ANNOTATEHINTS $revisions->[$i][2];
1794 if ($i+1 < @$revisions) { # have we got a parent?
1795 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1797 print ANNOTATEHINTS "\n";
1800 print ANNOTATEHINTS "\n";
1802 or (print "E failed to write $a_hints: $!\n"), return;
1804 my @cmd = (qw(git-annotate -l -S), $a_hints, $filename);
1805 if (!open(ANNOTATE, "-|", @cmd)) {
1806 print "E error invoking ". join(' ',@cmd) .": $!\n";
1810 print "E Annotations for $filename\n";
1811 print "E ***************\n";
1812 while ( <ANNOTATE> )
1814 if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1816 my $commithash = $1;
1818 unless ( defined ( $metadata->{$commithash} ) )
1820 $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1821 $metadata->{$commithash}{author} =~ s/\s+.*//;
1822 $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1823 $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1825 printf("M 1.%-5d (%-8s %10s): %s\n",
1826 $metadata->{$commithash}{revision},
1827 $metadata->{$commithash}{author},
1828 $metadata->{$commithash}{modified},
1832 $log->warn("Error in annotate output! LINE: $_");
1833 print "E Annotate error \n";
1840 # done; get out of the tempdir
1847 # This method takes the state->{arguments} array and produces two new arrays.
1848 # The first is $state->{args} which is everything before the '--' argument, and
1849 # the second is $state->{files} which is everything after it.
1852 $state->{args} = [];
1853 $state->{files} = [];
1856 return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1860 if ( defined($type) )
1863 $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" );
1864 $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1865 $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" );
1866 $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1867 $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1868 $opt = { k => 1, m => 1 } if ( $type eq "add" );
1869 $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1870 $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" );
1873 while ( scalar ( @{$state->{arguments}} ) > 0 )
1875 my $arg = shift @{$state->{arguments}};
1877 next if ( $arg eq "--" );
1878 next unless ( $arg =~ /\S/ );
1880 # if the argument looks like a switch
1881 if ( $arg =~ /^-(\w)(.*)/ )
1883 # if it's a switch that takes an argument
1886 # If this switch has already been provided
1887 if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1889 $state->{opt}{$1} = [ $state->{opt}{$1} ];
1890 if ( length($2) > 0 )
1892 push @{$state->{opt}{$1}},$2;
1894 push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1897 # if there's extra data in the arg, use that as the argument for the switch
1898 if ( length($2) > 0 )
1900 $state->{opt}{$1} = $2;
1902 $state->{opt}{$1} = shift @{$state->{arguments}};
1906 $state->{opt}{$1} = undef;
1911 push @{$state->{args}}, $arg;
1919 foreach my $value ( @{$state->{arguments}} )
1921 if ( $value eq "--" )
1926 push @{$state->{args}}, $value if ( $mode == 0 );
1927 push @{$state->{files}}, $value if ( $mode == 1 );
1932 # This method uses $state->{directory} to populate $state->{args} with a list of filenames
1935 my $updater = shift;
1937 $state->{args} = [] if ( scalar(@{$state->{args}}) == 1 and $state->{args}[0] eq "." );
1939 return if ( scalar ( @{$state->{args}} ) > 1 );
1941 my @gethead = @{$updater->gethead};
1944 foreach my $file (keys %{$state->{entries}}) {
1945 if ( exists $state->{entries}{$file}{revision} &&
1946 $state->{entries}{$file}{revision} == 0 )
1948 push @gethead, { name => $file, filehash => 'added' };
1952 if ( scalar(@{$state->{args}}) == 1 )
1954 my $arg = $state->{args}[0];
1955 $arg .= $state->{prependdir} if ( defined ( $state->{prependdir} ) );
1957 $log->info("Only one arg specified, checking for directory expansion on '$arg'");
1959 foreach my $file ( @gethead )
1961 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1962 next unless ( $file->{name} =~ /^$arg\// or $file->{name} eq $arg );
1963 push @{$state->{args}}, $file->{name};
1966 shift @{$state->{args}} if ( scalar(@{$state->{args}}) > 1 );
1968 $log->info("Only one arg specified, populating file list automatically");
1970 $state->{args} = [];
1972 foreach my $file ( @gethead )
1974 next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1975 next unless ( $file->{name} =~ s/^$state->{prependdir}// );
1976 push @{$state->{args}}, $file->{name};
1981 # This method cleans up the $state variable after a command that uses arguments has run
1984 $state->{files} = [];
1985 $state->{args} = [];
1986 $state->{arguments} = [];
1987 $state->{entries} = {};
1992 my $filename = shift;
1994 return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
1996 return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
1997 return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
2002 # This method takes a file hash and does a CVS "file transfer" which transmits the
2003 # size of the file, and then the file contents.
2004 # If a second argument $targetfile is given, the file is instead written out to
2005 # a file by the name of $targetfile
2008 my $filehash = shift;
2009 my $targetfile = shift;
2011 if ( defined ( $filehash ) and $filehash eq "deleted" )
2013 $log->warn("filehash is 'deleted'");
2017 die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
2019 my $type = `git-cat-file -t $filehash`;
2022 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
2024 my $size = `git-cat-file -s $filehash`;
2027 $log->debug("transmitfile($filehash) size=$size, type=$type");
2029 if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
2031 if ( defined ( $targetfile ) )
2033 open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
2034 print NEWFILE $_ while ( <$fh> );
2035 close NEWFILE or die("Failed to write '$targetfile': $!");
2038 print while ( <$fh> );
2040 close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
2042 die("Couldn't execute git-cat-file");
2046 # This method takes a file name, and returns ( $dirpart, $filepart ) which
2047 # refers to the directory portion and the file portion of the filename
2051 my $filename = shift;
2052 my $fixforlocaldir = shift;
2054 my ( $filepart, $dirpart ) = ( $filename, "." );
2055 ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
2058 if ( $fixforlocaldir )
2060 $dirpart =~ s/^$state->{prependdir}//;
2063 return ( $filepart, $dirpart );
2068 my $filename = shift;
2070 return undef unless(defined($filename));
2071 if ( $filename =~ /^\// )
2073 print "E absolute filenames '$filename' not supported by server\n";
2077 $filename =~ s/^\.\///g;
2078 $filename = $state->{prependdir} . $filename;
2082 # Given a path, this function returns a string containing the kopts
2083 # that should go into that path's Entries line. For example, a binary
2084 # file should get -kb.
2089 # Once it exists, the git attributes system should be used to look up
2090 # what attributes apply to this path.
2092 # Until then, take the setting from the config file
2093 unless ( defined ( $cfg->{gitcvs}{allbinary} ) and $cfg->{gitcvs}{allbinary} =~ /^\s*(1|true|yes)\s*$/i )
2095 # Return "" to give no special treatment to any path
2098 # Alternatively, to have all files treated as if they are binary (which
2099 # is more like git itself), always return the "-kb" option
2104 package GITCVS::log;
2107 #### Copyright The Open University UK - 2006.
2109 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
2110 #### Martin Langhoff <martin@catalyst.net.nz>
2123 This module provides very crude logging with a similar interface to
2132 Creates a new log object, optionally you can specify a filename here to
2133 indicate the file to log to. If no log file is specified, you can specify one
2134 later with method setfile, or indicate you no longer want logging with method
2137 Until one of these methods is called, all log calls will buffer messages ready
2144 my $filename = shift;
2148 bless $self, $class;
2150 if ( defined ( $filename ) )
2152 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
2160 This methods takes a filename, and attempts to open that file as the log file.
2161 If successful, all buffered data is written out to the file, and any further
2162 logging is written directly to the file.
2168 my $filename = shift;
2170 if ( defined ( $filename ) )
2172 open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
2175 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
2177 while ( my $line = shift @{$self->{buffer}} )
2179 print {$self->{fh}} $line;
2185 This method indicates no logging is going to be used. It flushes any entries in
2186 the internal buffer, and sets a flag to ensure no further data is put there.
2195 return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
2197 $self->{buffer} = [];
2202 Internal method. Returns true if the log file is open, false otherwise.
2209 return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
2213 =head2 debug info warn fatal
2215 These four methods are wrappers to _log. They provide the actual interface for
2219 sub debug { my $self = shift; $self->_log("debug", @_); }
2220 sub info { my $self = shift; $self->_log("info" , @_); }
2221 sub warn { my $self = shift; $self->_log("warn" , @_); }
2222 sub fatal { my $self = shift; $self->_log("fatal", @_); }
2226 This is an internal method called by the logging functions. It generates a
2227 timestamp and pushes the logged line either to file, or internal buffer.
2235 return if ( $self->{nolog} );
2237 my @time = localtime;
2238 my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
2248 if ( $self->_logopen )
2250 print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
2252 push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
2258 This method simply closes the file handle if one is open
2265 if ( $self->_logopen )
2271 package GITCVS::updater;
2274 #### Copyright The Open University UK - 2006.
2276 #### Authors: Martyn Smith <martyn@catalyst.net.nz>
2277 #### Martin Langhoff <martin@catalyst.net.nz>
2299 die "Need to specify a git repository" unless ( defined($config) and -d $config );
2300 die "Need to specify a module" unless ( defined($module) );
2302 $class = ref($class) || $class;
2306 bless $self, $class;
2308 $self->{module} = $module;
2309 $self->{git_path} = $config . "/";
2311 $self->{log} = $log;
2313 die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
2315 $self->{dbdriver} = $cfg->{gitcvs}{$state->{method}}{dbdriver} ||
2316 $cfg->{gitcvs}{dbdriver} || "SQLite";
2317 $self->{dbname} = $cfg->{gitcvs}{$state->{method}}{dbname} ||
2318 $cfg->{gitcvs}{dbname} || "%Ggitcvs.%m.sqlite";
2319 $self->{dbuser} = $cfg->{gitcvs}{$state->{method}}{dbuser} ||
2320 $cfg->{gitcvs}{dbuser} || "";
2321 $self->{dbpass} = $cfg->{gitcvs}{$state->{method}}{dbpass} ||
2322 $cfg->{gitcvs}{dbpass} || "";
2323 my %mapping = ( m => $module,
2324 a => $state->{method},
2325 u => getlogin || getpwuid($<) || $<,
2326 G => $self->{git_path},
2327 g => mangle_dirname($self->{git_path}),
2329 $self->{dbname} =~ s/%([mauGg])/$mapping{$1}/eg;
2330 $self->{dbuser} =~ s/%([mauGg])/$mapping{$1}/eg;
2332 die "Invalid char ':' in dbdriver" if $self->{dbdriver} =~ /:/;
2333 die "Invalid char ';' in dbname" if $self->{dbname} =~ /;/;
2334 $self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",
2337 die "Error connecting to database\n" unless defined $self->{dbh};
2339 $self->{tables} = {};
2340 foreach my $table ( keys %{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )
2342 $self->{tables}{$table} = 1;
2345 # Construct the revision table if required
2346 unless ( $self->{tables}{revision} )
2349 CREATE TABLE revision (
2351 revision INTEGER NOT NULL,
2352 filehash TEXT NOT NULL,
2353 commithash TEXT NOT NULL,
2354 author TEXT NOT NULL,
2355 modified TEXT NOT NULL,
2360 CREATE INDEX revision_ix1
2361 ON revision (name,revision)
2364 CREATE INDEX revision_ix2
2365 ON revision (name,commithash)
2369 # Construct the head table if required
2370 unless ( $self->{tables}{head} )
2375 revision INTEGER NOT NULL,
2376 filehash TEXT NOT NULL,
2377 commithash TEXT NOT NULL,
2378 author TEXT NOT NULL,
2379 modified TEXT NOT NULL,
2384 CREATE INDEX head_ix1
2389 # Construct the properties table if required
2390 unless ( $self->{tables}{properties} )
2393 CREATE TABLE properties (
2394 key TEXT NOT NULL PRIMARY KEY,
2400 # Construct the commitmsgs table if required
2401 unless ( $self->{tables}{commitmsgs} )
2404 CREATE TABLE commitmsgs (
2405 key TEXT NOT NULL PRIMARY KEY,
2421 # first lets get the commit list
2422 $ENV{GIT_DIR} = $self->{git_path};
2424 my $commitsha1 = `git rev-parse $self->{module}`;
2427 my $commitinfo = `git cat-file commit $self->{module} 2>&1`;
2428 unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2430 die("Invalid module '$self->{module}'");
2435 my $lastcommit = $self->_get_prop("last_commit");
2437 if (defined $lastcommit && $lastcommit eq $commitsha1) { # up-to-date
2441 # Start exclusive lock here...
2442 $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2444 # TODO: log processing is memory bound
2445 # if we can parse into a 2nd file that is in reverse order
2446 # we can probably do something really efficient
2447 my @git_log_params = ('--pretty', '--parents', '--topo-order');
2449 if (defined $lastcommit) {
2450 push @git_log_params, "$lastcommit..$self->{module}";
2452 push @git_log_params, $self->{module};
2454 # git-rev-list is the backend / plumbing version of git-log
2455 open(GITLOG, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
2464 if (m/^commit\s+(.*)$/) {
2465 # on ^commit lines put the just seen commit in the stack
2466 # and prime things for the next one
2469 unshift @commits, \%copy;
2472 my @parents = split(m/\s+/, $1);
2473 $commit{hash} = shift @parents;
2474 $commit{parents} = \@parents;
2475 } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2476 # on rfc822-like lines seen before we see any message,
2477 # lowercase the entry and put it in the hash as key-value
2478 $commit{lc($1)} = $2;
2480 # message lines - skip initial empty line
2481 # and trim whitespace
2482 if (!exists($commit{message}) && m/^\s*$/) {
2483 # define it to mark the end of headers
2484 $commit{message} = '';
2487 s/^\s+//; s/\s+$//; # trim ws
2488 $commit{message} .= $_ . "\n";
2493 unshift @commits, \%commit if ( keys %commit );
2495 # Now all the commits are in the @commits bucket
2496 # ordered by time DESC. for each commit that needs processing,
2497 # determine whether it's following the last head we've seen or if
2498 # it's on its own branch, grab a file list, and add whatever's changed
2499 # NOTE: $lastcommit refers to the last commit from previous run
2500 # $lastpicked is the last commit we picked in this run
2503 if (defined $lastcommit) {
2504 $lastpicked = $lastcommit;
2507 my $committotal = scalar(@commits);
2508 my $commitcount = 0;
2510 # Load the head table into $head (for cached lookups during the update process)
2511 foreach my $file ( @{$self->gethead()} )
2513 $head->{$file->{name}} = $file;
2516 foreach my $commit ( @commits )
2518 $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2519 if (defined $lastpicked)
2521 if (!in_array($lastpicked, @{$commit->{parents}}))
2523 # skip, we'll see this delta
2524 # as part of a merge later
2525 # warn "skipping off-track $commit->{hash}\n";
2527 } elsif (@{$commit->{parents}} > 1) {
2528 # it is a merge commit, for each parent that is
2529 # not $lastpicked, see if we can get a log
2530 # from the merge-base to that parent to put it
2531 # in the message as a merge summary.
2532 my @parents = @{$commit->{parents}};
2533 foreach my $parent (@parents) {
2534 # git-merge-base can potentially (but rarely) throw
2535 # several candidate merge bases. let's assume
2536 # that the first one is the best one.
2537 if ($parent eq $lastpicked) {
2540 my $base = safe_pipe_capture('git-merge-base',
2541 $lastpicked, $parent);
2545 # print "want to log between $base $parent \n";
2546 open(GITLOG, '-|', 'git-log', "$base..$parent")
2547 or die "Cannot call git-log: $!";
2551 if (!defined $mergedhash) {
2552 if (m/^commit\s+(.+)$/) {
2558 # grab the first line that looks non-rfc822
2559 # aka has content after leading space
2560 if (m/^\s+(\S.*)$/) {
2562 $title = substr($title,0,100); # truncate
2563 unshift @merged, "$mergedhash $title";
2570 $commit->{mergemsg} = $commit->{message};
2571 $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2572 foreach my $summary (@merged) {
2573 $commit->{mergemsg} .= "\t$summary\n";
2575 $commit->{mergemsg} .= "\n\n";
2576 # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2583 # convert the date to CVS-happy format
2584 $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2586 if ( defined ( $lastpicked ) )
2588 my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-z', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2590 while ( <FILELIST> )
2593 unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o )
2595 die("Couldn't process git-diff-tree line : $_");
2597 my ($mode, $hash, $change) = ($1, $2, $3);
2598 my $name = <FILELIST>;
2601 # $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");
2604 $git_perms .= "r" if ( $mode & 4 );
2605 $git_perms .= "w" if ( $mode & 2 );
2606 $git_perms .= "x" if ( $mode & 1 );
2607 $git_perms = "rw" if ( $git_perms eq "" );
2609 if ( $change eq "D" )
2611 #$log->debug("DELETE $name");
2614 revision => $head->{$name}{revision} + 1,
2615 filehash => "deleted",
2616 commithash => $commit->{hash},
2617 modified => $commit->{date},
2618 author => $commit->{author},
2621 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2623 elsif ( $change eq "M" )
2625 #$log->debug("MODIFIED $name");
2628 revision => $head->{$name}{revision} + 1,
2630 commithash => $commit->{hash},
2631 modified => $commit->{date},
2632 author => $commit->{author},
2635 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2637 elsif ( $change eq "A" )
2639 #$log->debug("ADDED $name");
2642 revision => $head->{$name}{revision} ? $head->{$name}{revision}+1 : 1,
2644 commithash => $commit->{hash},
2645 modified => $commit->{date},
2646 author => $commit->{author},
2649 $self->insert_rev($name, $head->{$name}{revision}, $hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2653 $log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");
2659 # this is used to detect files removed from the repo
2660 my $seen_files = {};
2662 my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-z', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2664 while ( <FILELIST> )
2667 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o )
2669 die("Couldn't process git-ls-tree line : $_");
2672 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2674 $seen_files->{$git_filename} = 1;
2676 my ( $oldhash, $oldrevision, $oldmode ) = (
2677 $head->{$git_filename}{filehash},
2678 $head->{$git_filename}{revision},
2679 $head->{$git_filename}{mode}
2682 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2685 $git_perms .= "r" if ( $1 & 4 );
2686 $git_perms .= "w" if ( $1 & 2 );
2687 $git_perms .= "x" if ( $1 & 1 );
2692 # unless the file exists with the same hash, we need to update it ...
2693 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2695 my $newrevision = ( $oldrevision or 0 ) + 1;
2697 $head->{$git_filename} = {
2698 name => $git_filename,
2699 revision => $newrevision,
2700 filehash => $git_hash,
2701 commithash => $commit->{hash},
2702 modified => $commit->{date},
2703 author => $commit->{author},
2708 $self->insert_rev($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2713 # Detect deleted files
2714 foreach my $file ( keys %$head )
2716 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2718 $head->{$file}{revision}++;
2719 $head->{$file}{filehash} = "deleted";
2720 $head->{$file}{commithash} = $commit->{hash};
2721 $head->{$file}{modified} = $commit->{date};
2722 $head->{$file}{author} = $commit->{author};
2724 $self->insert_rev($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
2727 # END : "Detect deleted files"
2731 if (exists $commit->{mergemsg})
2733 $self->insert_mergelog($commit->{hash}, $commit->{mergemsg});
2736 $lastpicked = $commit->{hash};
2738 $self->_set_prop("last_commit", $commit->{hash});
2741 $self->delete_head();
2742 foreach my $file ( keys %$head )
2746 $head->{$file}{revision},
2747 $head->{$file}{filehash},
2748 $head->{$file}{commithash},
2749 $head->{$file}{modified},
2750 $head->{$file}{author},
2751 $head->{$file}{mode},
2754 # invalidate the gethead cache
2755 $self->{gethead_cache} = undef;
2758 # Ending exclusive lock here
2759 $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2766 my $revision = shift;
2767 my $filehash = shift;
2768 my $commithash = shift;
2769 my $modified = shift;
2773 my $insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2774 $insert_rev->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2783 my $insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2784 $insert_mergelog->execute($key, $value);
2791 my $delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2792 $delete_head->execute();
2799 my $revision = shift;
2800 my $filehash = shift;
2801 my $commithash = shift;
2802 my $modified = shift;
2806 my $insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2807 $insert_head->execute($name, $revision, $filehash, $commithash, $modified, $author, $mode);
2813 my $filename = shift;
2815 my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2816 $db_query->execute($filename);
2817 my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2819 return ( $hash, $revision, $mode );
2827 my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2828 $db_query->execute($key);
2829 my ( $value ) = $db_query->fetchrow_array;
2840 my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2841 $db_query->execute($value, $key);
2843 unless ( $db_query->rows )
2845 $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2846 $db_query->execute($key, $value);
2860 return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2862 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
2863 $db_query->execute();
2866 while ( my $file = $db_query->fetchrow_hashref )
2871 $self->{gethead_cache} = $tree;
2883 my $filename = shift;
2885 my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2886 $db_query->execute($filename);
2889 while ( my $file = $db_query->fetchrow_hashref )
2899 This function takes a filename (with path) argument and returns a hashref of
2900 metadata for that file.
2907 my $filename = shift;
2908 my $revision = shift;
2911 if ( defined($revision) and $revision =~ /^\d+$/ )
2913 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2914 $db_query->execute($filename, $revision);
2916 elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2918 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2919 $db_query->execute($filename, $revision);
2921 $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2922 $db_query->execute($filename);
2925 return $db_query->fetchrow_hashref;
2928 =head2 commitmessage
2930 this function takes a commithash and returns the commit message for that commit
2936 my $commithash = shift;
2938 die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2941 $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2942 $db_query->execute($commithash);
2944 my ( $message ) = $db_query->fetchrow_array;
2946 if ( defined ( $message ) )
2948 $message .= " " if ( $message =~ /\n$/ );
2952 my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2953 shift @lines while ( $lines[0] =~ /\S/ );
2954 $message = join("",@lines);
2955 $message .= " " if ( $message =~ /\n$/ );
2961 This function takes a filename (with path) argument and returns an arrayofarrays
2962 containing revision,filehash,commithash ordered by revision descending
2968 my $filename = shift;
2971 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2972 $db_query->execute($filename);
2974 return $db_query->fetchall_arrayref;
2977 =head2 gethistorydense
2979 This function takes a filename (with path) argument and returns an arrayofarrays
2980 containing revision,filehash,commithash ordered by revision descending.
2982 This version of gethistory skips deleted entries -- so it is useful for annotate.
2983 The 'dense' part is a reference to a '--dense' option available for git-rev-list
2984 and other git tools that depend on it.
2990 my $filename = shift;
2993 $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2994 $db_query->execute($filename);
2996 return $db_query->fetchall_arrayref;
3001 from Array::PAT - mimics the in_array() function
3002 found in PHP. Yuck but works for small arrays.
3007 my ($check, @array) = @_;
3009 foreach my $test (@array){
3010 if($check eq $test){
3017 =head2 safe_pipe_capture
3019 an alternative to `command` that allows input to be passed as an array
3020 to work around shell problems with weird characters in arguments
3023 sub safe_pipe_capture {
3027 if (my $pid = open my $child, '-|') {
3028 @output = (<$child>);
3029 close $child or die join(' ',@_).": $! $?";
3031 exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
3033 return wantarray ? @output : join('',@output);
3036 =head2 mangle_dirname
3038 create a string from a directory name that is suitable to use as
3039 part of a filename, mainly by converting all chars except \w.- to _
3042 sub mangle_dirname {
3043 my $dirname = shift;
3044 return unless defined $dirname;
3046 $dirname =~ s/[^\w.-]/_/g;