Merge branch 'jc/simpack' into next
[gitweb.git] / git-cvsserver.perl
index d20d1a8c4ba5a4e8d17fd47b1cca000fcf84dda5..7d3f78e375066c27f0881a92c23fda8d5c8d6dff 100755 (executable)
@@ -53,6 +53,7 @@
     'Entry'           => \&req_Entry,
     'Modified'        => \&req_Modified,
     'Unchanged'       => \&req_Unchanged,
+    'Questionable'    => \&req_Questionable,
     'Argument'        => \&req_Argument,
     'Argumentx'       => \&req_Argument,
     'expand-modules'  => \&req_expandmodules,
@@ -63,6 +64,7 @@
     'ci'              => \&req_ci,
     'diff'            => \&req_diff,
     'log'             => \&req_log,
+    'rlog'            => \&req_log,
     'tag'             => \&req_CATCHALL,
     'status'          => \&req_status,
     'admin'           => \&req_CATCHALL,
 my $TEMP_DIR = tempdir( CLEANUP => 1 );
 $log->debug("Temporary directory is '$TEMP_DIR'");
 
+# if we are called with a pserver argument,
+# deal with the authentication cat before entereing the
+# main loop
+if (@ARGV && $ARGV[0] eq 'pserver') {
+    my $line = <STDIN>; chomp $line;
+    unless( $line eq 'BEGIN AUTH REQUEST') {
+       die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
+    }
+    $line = <STDIN>; chomp $line;
+    req_Root('root', $line) # reuse Root
+       or die "E Invalid root $line \n";
+    $line = <STDIN>; chomp $line;
+    unless ($line eq 'anonymous') {
+       print "E Only anonymous user allowed via pserver\n";
+       print "I HATE YOU\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";
+    }
+    print "I LOVE YOU\n";
+    # and now back to our regular programme...
+}
+
 # Keep going until the client closes the connection
 while (<STDIN>)
 {
@@ -137,8 +164,21 @@ sub req_Root
     $state->{CVSROOT} = $data;
 
     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
+    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";
+       return 0;
+    }
 
-    foreach my $line ( `git-var -l` )
+    my @gitvars = `git-var -l`;
+    if ($?) {
+       print "E problems executing git-var on the server -- this is not a git repository or the PATH is not set correcly.\n";
+        print "E \n";
+        print "error 1 - problem executing git-var\n";
+       return 0;
+    }
+    foreach my $line ( @gitvars )
     {
         next unless ( $line =~ /^(.*?)\.(.*?)=(.*)$/ );
         $cfg->{$1}{$2} = $3;
@@ -150,6 +190,7 @@ sub req_Root
         print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
         print "E \n";
         print "error 1 GITCVS emulation disabled\n";
+        return 0;
     }
 
     if ( defined ( $cfg->{gitcvs}{logfile} ) )
@@ -158,6 +199,8 @@ sub req_Root
     } else {
         $log->nofile();
     }
+
+    return 1;
 }
 
 # Global_option option \n
@@ -459,6 +502,22 @@ sub req_Unchanged
     #$log->debug("req_Unchanged : $data");
 }
 
+# Questionable filename \n
+#     Response expected: no. Additional data: no.
+#     Tell the server to check whether filename should be ignored,
+#     and if not, next time the server sends responses, send (in
+#     a M response) `?' followed by the directory and filename.
+#     filename must not contain `/'; it needs to be a file in the
+#     directory named by the most recent Directory request.
+sub req_Questionable
+{
+    my ( $cmd, $data ) = @_;
+
+    $state->{entries}{$state->{directory}.$data}{questionable} = 1;
+
+    #$log->debug("req_Questionable : $data");
+}
+
 # Argument text \n
 #     Response expected: no. Save argument for use in a subsequent command.
 #     Arguments accumulate until an argument-using command is given, at which
@@ -553,8 +612,62 @@ sub req_co
     my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
     $updater->update();
 
+    $checkout_path =~ s|/$||; # get rid of trailing slashes
+
+    # Eclipse seems to need the Clear-sticky command
+    # to prepare the 'Entries' file for the new directory.
+    print "Clear-sticky $checkout_path/\n";
+    print $state->{CVSROOT} . "/$module/\n";
+    print "Clear-static-directory $checkout_path/\n";
+    print $state->{CVSROOT} . "/$module/\n";
+    print "Clear-sticky $checkout_path/\n"; # yes, twice
+    print $state->{CVSROOT} . "/$module/\n";
+    print "Template $checkout_path/\n";
+    print $state->{CVSROOT} . "/$module/\n";
+    print "0\n";
+
     # instruct the client that we're checking out to $checkout_path
-    print "E cvs server: updating $checkout_path\n";
+    print "E cvs checkout: Updating $checkout_path\n";
+
+    my %seendirs = ();
+    my $lastdir ='';
+
+    # recursive
+    sub prepdir {
+       my ($dir, $repodir, $remotedir, $seendirs) = @_;
+       my $parent = dirname($dir);
+       $dir       =~ s|/+$||;
+       $repodir   =~ s|/+$||;
+       $remotedir =~ s|/+$||;
+       $parent    =~ s|/+$||;
+       $log->debug("announcedir $dir, $repodir, $remotedir" );
+
+       if ($parent eq '.' || $parent eq './') {
+           $parent = '';
+       }
+       # recurse to announce unseen parents first
+       if (length($parent) && !exists($seendirs->{$parent})) {
+           prepdir($parent, $repodir, $remotedir, $seendirs);
+       }
+       # Announce that we are going to modify at the parent level
+       if ($parent) {
+           print "E cvs checkout: Updating $remotedir/$parent\n";
+       } else {
+           print "E cvs checkout: Updating $remotedir\n";
+       }
+       print "Clear-sticky $remotedir/$parent/\n";
+       print "$repodir/$parent/\n";
+
+       print "Clear-static-directory $remotedir/$dir/\n";
+       print "$repodir/$dir/\n";
+       print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
+       print "$repodir/$parent/\n";
+       print "Template $remotedir/$dir/\n";
+       print "$repodir/$dir/\n";
+       print "0\n";
+
+       $seendirs->{$dir} = 1;
+    }
 
     foreach my $git ( @{$updater->gethead} )
     {
@@ -563,25 +676,32 @@ sub req_co
 
         ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
 
+       if (length($git->{dir}) && $git->{dir} ne './'
+           && $git->{dir} ne $lastdir ) {
+           unless (exists($seendirs{$git->{dir}})) {
+               prepdir($git->{dir}, $state->{CVSROOT} . "/$module/",
+                       $checkout_path, \%seendirs);
+               $lastdir = $git->{dir};
+               $seendirs{$git->{dir}} = 1;
+           }
+           print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
+       }
+
         # modification time of this file
         print "Mod-time $git->{modified}\n";
 
         # print some information to the client
-        print "MT +updated\n";
-        print "MT text U\n";
         if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
         {
-            print "MT fname $checkout_path/$git->{dir}$git->{name}\n";
+            print "M U $checkout_path/$git->{dir}$git->{name}\n";
         } else {
-            print "MT fname $checkout_path/$git->{name}\n";
+            print "M U $checkout_path/$git->{name}\n";
         }
-        print "MT newline\n";
-        print "MT -updated\n";
 
-        # instruct client we're sending a file to put in this path
-        print "Created $checkout_path/" . ( defined ( $git->{dir} ) ? $git->{dir} . "/" : "" ) . "\n";
+       # instruct client we're sending a file to put in this path
+       print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
 
-        print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
+       print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
 
         # this is an "entries" line
         print "/$git->{name}/1.$git->{revision}///\n";
@@ -612,6 +732,26 @@ sub req_update
 
     argsplit("update");
 
+    #
+    # It may just be a client exploring the available heads/modukles
+    # in that case, list them as top level directories and leave it
+    # at that. Eclipse uses this technique to offer you a list of
+    # projects (heads in this case) to checkout.
+    #
+    if ($state->{module} eq '') {
+        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";
+           }
+       }
+       closedir HEADS;
+       print "ok\n";
+       return 1;
+    }
+
+
     # Grab a handle to the SQLite db and do any necessary updates
     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 
@@ -657,8 +797,27 @@ sub req_update
 
         #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
 
-        # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified _and_ the user hasn't specified -C
-        next if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{unchanged} and not exists ( $state->{opt}{C} ) );
+        # Files are up to date if the working copy and repo copy have the same revision,
+        # and the working copy is unmodified _and_ the user hasn't specified -C
+        next if ( defined ( $wrev )
+                  and defined($meta->{revision})
+                  and $wrev == $meta->{revision}
+                  and $state->{entries}{$filename}{unchanged}
+                  and not exists ( $state->{opt}{C} ) );
+
+        # If the working copy and repo copy have the same revision,
+        # but the working copy is modified, tell the client it's modified
+        if ( defined ( $wrev )
+             and defined($meta->{revision})
+             and $wrev == $meta->{revision}
+             and not exists ( $state->{opt}{C} ) )
+        {
+            $log->info("Tell the client the file is modified");
+            print "MT text U\n";
+            print "MT fname $filename\n";
+            print "MT newline\n";
+            next;
+        }
 
         if ( $meta->{filehash} eq "deleted" )
         {
@@ -670,7 +829,8 @@ sub req_update
             print "Removed $dirpart\n";
             print "$filepart\n";
         }
-        elsif ( not defined ( $state->{entries}{$filename}{modified_hash} ) or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} )
+        elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
+               or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} )
         {
             $log->info("Updating '$filename'");
             # normal update, just send the new revision (either U=Update, or A=Add, or R=Remove)
@@ -706,6 +866,7 @@ sub req_update
             # transmit file
             transmitfile($meta->{filehash});
         } else {
+            $log->info("Updating '$filename'");
             my ( $filepart, $dirpart ) = filenamesplit($meta->{name});
 
             my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
@@ -781,6 +942,12 @@ sub req_ci
 
     $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
 
+    if ( @ARGV && $ARGV[0] eq 'pserver')
+    {
+        print "error 1 pserver access cannot commit\n";
+        exit;
+    }
+
     if ( -e $state->{CVSROOT} . "/index" )
     {
         print "error 1 Index already exists in git repo\n";
@@ -2271,7 +2438,7 @@ sub gethead
 
     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
 
-    my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head",{},1);
+    my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
     $db_query->execute();
 
     my $tree = [];