git-p4: Unset P4DIFF environment variable when using 'p4 -du diff'
[gitweb.git] / git-cvsserver.perl
index 1de517791f8a293a9c770f6260ff48f9719845ad..7f632af20defd7a3cfd92008c51f7e599be13830 100755 (executable)
@@ -22,6 +22,9 @@
 use Fcntl;
 use File::Temp qw/tempdir tempfile/;
 use File::Basename;
+use Getopt::Long qw(:config require_order no_ignore_case);
+
+my $VERSION = '@@GIT_VERSION@@';
 
 my $log = GITCVS::log->new();
 my $cfg;
 my $state = { prependdir => '' };
 $log->info("--------------- STARTING -----------------");
 
+my $usage =
+    "Usage: git-cvsserver [options] [pserver|server] [<directory> ...]\n".
+    "    --base-path <path>  : Prepend to requested CVSROOT\n".
+    "    --strict-paths      : Don't allow recursing into subdirectories\n".
+    "    --export-all        : Don't check for gitcvs.enabled in config\n".
+    "    --version, -V       : Print version information and exit\n".
+    "    --help, -h, -H      : Print usage information and exit\n".
+    "\n".
+    "<directory> ... is a list of allowed directories. If no directories\n".
+    "are given, all are allowed. This is an additional restriction, gitcvs\n".
+    "access still needs to be enabled by the gitcvs.enabled config option.\n";
+
+my @opts = ( 'help|h|H', 'version|V',
+            'base-path=s', 'strict-paths', 'export-all' );
+GetOptions( $state, @opts )
+    or die $usage;
+
+if ($state->{version}) {
+    print "git-cvsserver version $VERSION\n";
+    exit;
+}
+if ($state->{help}) {
+    print $usage;
+    exit;
+}
+
 my $TEMP_DIR = tempdir( CLEANUP => 1 );
 $log->debug("Temporary directory is '$TEMP_DIR'");
 
+$state->{method} = 'ext';
+if (@ARGV) {
+    if ($ARGV[0] eq 'pserver') {
+       $state->{method} = 'pserver';
+       shift @ARGV;
+    } elsif ($ARGV[0] eq 'server') {
+       shift @ARGV;
+    }
+}
+
+# everything else is a directory
+$state->{allowed_roots} = [ @ARGV ];
+
+# don't export the whole system unless the users requests it
+if ($state->{'export-all'} && !@{$state->{allowed_roots}}) {
+    die "--export-all can only be used together with an explicit whitelist\n";
+}
+
 # if we are called with a pserver argument,
 # deal with the authentication cat before entering the
 # main loop
-$state->{method} = 'ext';
-if (@ARGV && $ARGV[0] eq 'pserver') {
-    $state->{method} = 'pserver';
+if ($state->{method} eq 'pserver') {
     my $line = <STDIN>; chomp $line;
-    unless( $line eq 'BEGIN AUTH REQUEST') {
+    unless( $line =~ /^BEGIN (AUTH|VERIFICATION) REQUEST$/) {
        die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
     }
+    my $request = $1;
     $line = <STDIN>; chomp $line;
-    req_Root('root', $line) # reuse Root
-       or die "E Invalid root $line \n";
+    unless (req_Root('root', $line)) { # reuse Root
+       print "E Invalid root $line \n";
+       exit 1;
+    }
     $line = <STDIN>; chomp $line;
     unless ($line eq 'anonymous') {
        print "E Only anonymous user allowed via pserver\n";
     }
     $line = <STDIN>; chomp $line;    # validate the password?
     $line = <STDIN>; chomp $line;
-    unless ($line eq 'END AUTH REQUEST') {
-       die "E Do not understand $line -- expecting END AUTH REQUEST\n";
+    unless ($line eq "END $request REQUEST") {
+       die "E Do not understand $line -- expecting END $request REQUEST\n";
     }
     print "I LOVE YOU\n";
+    exit if $request eq 'VERIFICATION'; # cvs login
     # and now back to our regular programme...
 }
 
@@ -165,13 +214,53 @@ sub req_Root
     my ( $cmd, $data ) = @_;
     $log->debug("req_Root : $data");
 
-    $state->{CVSROOT} = $data;
+    unless ($data =~ m#^/#) {
+       print "error 1 Root must be an absolute pathname\n";
+       return 0;
+    }
+
+    my $cvsroot = $state->{'base-path'} || '';
+    $cvsroot =~ s#/+$##;
+    $cvsroot .= $data;
+
+    if ($state->{CVSROOT}
+       && ($state->{CVSROOT} ne $cvsroot)) {
+       print "error 1 Conflicting roots specified\n";
+       return 0;
+    }
+
+    $state->{CVSROOT} = $cvsroot;
 
     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
+
+    if (@{$state->{allowed_roots}}) {
+       my $allowed = 0;
+       foreach my $dir (@{$state->{allowed_roots}}) {
+           next unless $dir =~ m#^/#;
+           $dir =~ s#/+$##;
+           if ($state->{'strict-paths'}) {
+               if ($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) {
+                   $allowed = 1;
+                   last;
+               }
+           } elsif ($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) {
+               $allowed = 1;
+               last;
+           }
+       }
+
+       unless ($allowed) {
+           print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
+           print "E \n";
+           print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
+           return 0;
+       }
+    }
+
     unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
        print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
-        print "E \n";
-        print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
+       print "E \n";
+       print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
        return 0;
     }
 
@@ -194,7 +283,8 @@ sub req_Root
 
     my $enabled = ($cfg->{gitcvs}{$state->{method}}{enabled}
                   || $cfg->{gitcvs}{enabled});
-    unless ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i) {
+    unless ($state->{'export-all'} ||
+           ($enabled && $enabled =~ /^\s*(1|true|yes)\s*$/i)) {
         print "E GITCVS emulation needs to be enabled on this repo\n";
         print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
         print "E \n";
@@ -535,8 +625,12 @@ sub req_Modified
     my ( $cmd, $data ) = @_;
 
     my $mode = <STDIN>;
+    defined $mode
+        or (print "E end of file reading mode for $data\n"), return;
     chomp $mode;
     my $size = <STDIN>;
+    defined $size
+        or (print "E end of file reading size of $data\n"), return;
     chomp $size;
 
     # Grab config information
@@ -556,7 +650,8 @@ sub req_Modified
         $bytesleft -= $blocksize;
     }
 
-    close $fh;
+    close $fh
+        or (print "E failed to write temporary, $filename: $!\n"), return;
 
     # Ensure we have something sensible for the file mode
     if ( $mode =~ /u=(\w+)/ )
@@ -813,8 +908,13 @@ sub req_update
     # projects (heads in this case) to checkout.
     #
     if ($state->{module} eq '') {
+       my $heads_dir = $state->{CVSROOT} . '/refs/heads';
+       if (!opendir HEADS, $heads_dir) {
+           print "E [server aborted]: Failed to open directory, "
+             . "$heads_dir: $!\nerror\n";
+           return 0;
+       }
         print "E cvs update: Updating .\n";
-       opendir HEADS, $state->{CVSROOT} . '/refs/heads';
        while (my $head = readdir(HEADS)) {
            if (-f $state->{CVSROOT} . '/refs/heads/' . $head) {
                print "E cvs update: New directory `$head'\n";
@@ -1098,6 +1198,7 @@ sub req_ci
     $log->info("Lockless commit start, basing commit on '$tmpdir', index file is '$file_index'");
 
     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
+    $ENV{GIT_WORK_TREE} = ".";
     $ENV{GIT_INDEX_FILE} = $file_index;
 
     # Remember where the head was at the beginning.
@@ -1110,13 +1211,13 @@ sub req_ci
 
     chdir $tmpdir;
 
-    # populate the temporary index based
+    # populate the temporary index
     system("git-read-tree", $parenthash);
     unless ($? == 0)
     {
        die "Error running git-read-tree $state->{module} $file_index $!";
     }
-    $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
+    $log->info("Created index '$file_index' for head $state->{module} - exit status $?");
 
     my @committedfiles = ();
     my %oldmeta;
@@ -1136,7 +1237,7 @@ sub req_ci
 
         my ( $filepart, $dirpart ) = filenamesplit($filename);
 
-        # do a checkout of the file if it part of this tree
+       # do a checkout of the file if it is part of this tree
         if ($wrev) {
             system('git-checkout-index', '-f', '-u', $filename);
             unless ($? == 0) {
@@ -1223,11 +1324,11 @@ sub req_ci
         exit;
     }
 
-       # Check that this is allowed, just as we would with a receive-pack
-       my @cmd = ( $ENV{GIT_DIR}.'hooks/update', "refs/heads/$state->{module}",
+       ### Emulate git-receive-pack by running hooks/update
+       my @hook = ( $ENV{GIT_DIR}.'hooks/update', "refs/heads/$state->{module}",
                        $parenthash, $commithash );
-       if( -x $cmd[0] ) {
-               unless( system( @cmd ) == 0 )
+       if( -x $hook[0] ) {
+               unless( system( @hook ) == 0 )
                {
                        $log->warn("Commit failed (update hook declined to update ref)");
                        print "error 1 Commit failed (update hook declined)\n";
@@ -1236,6 +1337,7 @@ sub req_ci
                }
        }
 
+       ### Update the ref
        if (system(qw(git update-ref -m), "cvsserver ci",
                        "refs/heads/$state->{module}", $commithash, $parenthash)) {
                $log->warn("update-ref for $state->{module} failed.");
@@ -1243,6 +1345,24 @@ sub req_ci
                exit;
        }
 
+       ### Emulate git-receive-pack by running hooks/post-receive
+       my $hook = $ENV{GIT_DIR}.'hooks/post-receive';
+       if( -x $hook ) {
+               open(my $pipe, "| $hook") || die "can't fork $!";
+
+               local $SIG{PIPE} = sub { die 'pipe broke' };
+
+               print $pipe "$parenthash $commithash refs/heads/$state->{module}\n";
+
+               close $pipe || die "bad pipe: $! $?";
+       }
+
+       ### Then hooks/post-update
+       $hook = $ENV{GIT_DIR}.'hooks/post-update';
+       if (-x $hook) {
+               system($hook, "refs/heads/$state->{module}");
+       }
+
     $updater->update();
 
     # foreach file specified on the command line ...
@@ -1623,6 +1743,7 @@ sub req_annotate
     $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
 
     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
+    $ENV{GIT_WORK_TREE} = ".";
     $ENV{GIT_INDEX_FILE} = $file_index;
 
     chdir $tmpdir;
@@ -1649,14 +1770,16 @@ sub req_annotate
        system("git-read-tree", $lastseenin);
        unless ($? == 0)
        {
-           die "Error running git-read-tree $lastseenin $file_index $!";
+           print "E error running git-read-tree $lastseenin $file_index $!\n";
+           return;
        }
        $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
 
         # do a checkout of the file
         system('git-checkout-index', '-f', '-u', $filename);
         unless ($? == 0) {
-            die "Error running git-checkout-index -f -u $filename : $!";
+            print "E error running git-checkout-index -f -u $filename : $!\n";
+            return;
         }
 
         $log->info("Annotate $filename");
@@ -1666,7 +1789,11 @@ sub req_annotate
         # git-jsannotate telling us about commits we are hiding
         # from the client.
 
-        open(ANNOTATEHINTS, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
+        my $a_hints = "$tmpdir/.annotate_hints";
+        if (!open(ANNOTATEHINTS, '>', $a_hints)) {
+            print "E failed to open '$a_hints' for writing: $!\n";
+            return;
+        }
         for (my $i=0; $i < @$revisions; $i++)
         {
             print ANNOTATEHINTS $revisions->[$i][2];
@@ -1677,11 +1804,14 @@ sub req_annotate
         }
 
         print ANNOTATEHINTS "\n";
-        close ANNOTATEHINTS;
+        close ANNOTATEHINTS
+            or (print "E failed to write $a_hints: $!\n"), return;
 
-        my $annotatecmd = 'git-annotate';
-        open(ANNOTATE, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
-           or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
+        my @cmd = (qw(git-annotate -l -S), $a_hints, $filename);
+        if (!open(ANNOTATE, "-|", @cmd)) {
+            print "E error invoking ". join(' ',@cmd) .": $!\n";
+            return;
+        }
         my $metadata = {};
         print "E Annotations for $filename\n";
         print "E ***************\n";
@@ -1725,14 +1855,14 @@ sub req_annotate
 # the second is $state->{files} which is everything after it.
 sub argsplit
 {
-    return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
-
-    my $type = shift;
-
     $state->{args} = [];
     $state->{files} = [];
     $state->{opt} = {};
 
+    return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
+
+    my $type = shift;
+
     if ( defined($type) )
     {
         my $opt = {};
@@ -1908,12 +2038,12 @@ sub transmitfile
         {
             open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
             print NEWFILE $_ while ( <$fh> );
-            close NEWFILE;
+            close NEWFILE or die("Failed to write '$targetfile': $!");
         } else {
             print "$size\n";
             print while ( <$fh> );
         }
-        close $fh or die ("Couldn't close filehandle for transmitfile()");
+        close $fh or die ("Couldn't close filehandle for transmitfile(): $!");
     } else {
         die("Couldn't execute git-cat-file");
     }
@@ -2413,17 +2543,21 @@ sub update
                     if ($parent eq $lastpicked) {
                         next;
                     }
-                    open my $p, 'git-merge-base '. $lastpicked . ' '
-                    . $parent . '|';
-                    my @output = (<$p>);
-                    close $p;
-                    my $base = join('', @output);
+                   my $base = eval {
+                           safe_pipe_capture('git-merge-base',
+                                                $lastpicked, $parent);
+                   };
+                   # The two branches may not be related at all,
+                   # in which case merge base simply fails to find
+                   # any, but that's Ok.
+                   next if ($@);
+
                     chomp $base;
                     if ($base) {
                         my @merged;
                         # print "want to log between  $base $parent \n";
-                        open(GITLOG, '-|', 'git-log', "$base..$parent")
-                        or die "Cannot call git-log: $!";
+                        open(GITLOG, '-|', 'git-log', '--pretty=medium', "$base..$parent")
+                         or die "Cannot call git-log: $!";
                         my $mergedhash;
                         while (<GITLOG>) {
                             chomp;