repo-config: trim white-space before comment

[git.git] / git-cvsserver.perl

diff --git a/git-cvsserver.perl b/git-cvsserver.perl
index d20d1a8..11d153c 100755 (executable)
--- a/git-cvsserver.perl
+++ b/git-cvsserver.perl
@@ -53,6 +53,7 @@ my $methods = {
     'Entry'           => \&req_Entry,
     'Modified'        => \&req_Modified,
     'Unchanged'       => \&req_Unchanged,
     'Entry'           => \&req_Entry,
     'Modified'        => \&req_Modified,
     'Unchanged'       => \&req_Unchanged,

+    'Questionable'    => \&req_Questionable,

     'Argument'        => \&req_Argument,
     'Argumentx'       => \&req_Argument,
     'expand-modules'  => \&req_expandmodules,
     'Argument'        => \&req_Argument,
     'Argumentx'       => \&req_Argument,
     'expand-modules'  => \&req_expandmodules,


@@ -63,6 +64,7 @@ my $methods = {
     'ci'              => \&req_ci,
     'diff'            => \&req_diff,
     'log'             => \&req_log,
     'ci'              => \&req_ci,
     'diff'            => \&req_diff,
     'log'             => \&req_log,

+    'rlog'            => \&req_log,

     'tag'             => \&req_CATCHALL,
     'status'          => \&req_status,
     'admin'           => \&req_CATCHALL,
     'tag'             => \&req_CATCHALL,
     'status'          => \&req_status,
     'admin'           => \&req_CATCHALL,


@@ -85,12 +87,37 @@ $log->info("--------------- STARTING -----------------");
 my $TEMP_DIR = tempdir( CLEANUP => 1 );
 $log->debug("Temporary directory is '$TEMP_DIR'");
 
 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 entering 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>)
 {
     chomp;
 
 # Keep going until the client closes the connection
 while (<STDIN>)
 {
     chomp;
 

-    # Check to see if we've seen this method, and call appropiate function.
+    # Check to see if we've seen this method, and call appropriate function.

     if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
     {
         # use the $methods hash to call the appropriate sub for this command
     if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
     {
         # use the $methods hash to call the appropriate sub for this command


@@ -137,8 +164,21 @@ sub req_Root
     $state->{CVSROOT} = $data;
 
     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
     $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-repo-config -l`;
+    if ($?) {
+       print "E problems executing git-repo-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
+        print "E \n";
+        print "error 1 - problem executing git-repo-config\n";
+       return 0;
+    }
+    foreach my $line ( @gitvars )

     {
         next unless ( $line =~ /^(.*?)\.(.*?)=(.*)$/ );
         $cfg->{$1}{$2} = $3;
     {
         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";
         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} ) )
     }
 
     if ( defined ( $cfg->{gitcvs}{logfile} ) )


@@ -158,6 +199,8 @@ sub req_Root
     } else {
         $log->nofile();
     }
     } else {
         $log->nofile();
     }

+
+    return 1;

 }
 
 # Global_option option \n
 }
 
 # Global_option option \n


@@ -181,7 +224,7 @@ sub req_Globaloption
 sub req_Validresponses
 {
     my ( $cmd, $data ) = @_;
 sub req_Validresponses
 {
     my ( $cmd, $data ) = @_;

-    $log->debug("req_Validrepsonses : $data");
+    $log->debug("req_Validresponses : $data");

 
     # TODO : re-enable this, currently it's not particularly useful
     #$state->{validresponses} = [ split /\s+/, $data ];
 
     # TODO : re-enable this, currently it's not particularly useful
     #$state->{validresponses} = [ split /\s+/, $data ];


@@ -459,6 +502,22 @@ sub req_Unchanged
     #$log->debug("req_Unchanged : $data");
 }
 
     #$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
 # 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();
 
     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
     # 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} )
     {
 
     foreach my $git ( @{$updater->gethead} )
     {


@@ -563,25 +676,32 @@ sub req_co
 
         ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
 
 
         ( $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
         # 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 "./" )
         {
         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 {
         } 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";
 
         # this is an "entries" line
         print "/$git->{name}/1.$git->{revision}///\n";


@@ -612,6 +732,26 @@ sub req_update
 
     argsplit("update");
 
 
     argsplit("update");
 

+    #
+    # It may just be a client exploring the available heads/modules
+    # 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);
 
     # 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");
 
 
         #$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" )
         {
 
         if ( $meta->{filehash} eq "deleted" )
         {


@@ -670,7 +829,8 @@ sub req_update
             print "Removed $dirpart\n";
             print "$filepart\n";
         }
             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)
         {
             $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 {
             # transmit file
             transmitfile($meta->{filehash});
         } else {

+            $log->info("Updating '$filename'");

             my ( $filepart, $dirpart ) = filenamesplit($meta->{name});
 
             my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
             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]" ));
 
 
     $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";
     if ( -e $state->{CVSROOT} . "/index" )
     {
         print "error 1 Index already exists in git repo\n";


@@ -1564,7 +1731,7 @@ sub transmitfile
 }
 
 # This method takes a file name, and returns ( $dirpart, $filepart ) which
 }
 
 # This method takes a file name, and returns ( $dirpart, $filepart ) which

-# refers to the directory porition and the file portion of the filename
+# refers to the directory portion and the file portion of the filename

 # respectively
 sub filenamesplit
 {
 # respectively
 sub filenamesplit
 {


@@ -1623,7 +1790,7 @@ Log::Log4perl
 =head2 new
 
 Creates a new log object, optionally you can specify a filename here to
 =head2 new
 
 Creates a new log object, optionally you can specify a filename here to

-indicate the file to log to. If no log file is specified, you can specifiy one
+indicate the file to log to. If no log file is specified, you can specify one

 later with method setfile, or indicate you no longer want logging with method
 nofile.
 
 later with method setfile, or indicate you no longer want logging with method
 nofile.
 


@@ -2271,7 +2438,7 @@ sub gethead
 
     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
 
 
     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 = [];
     $db_query->execute();
 
     my $tree = [];


@@ -2428,7 +2595,7 @@ sub in_array
 
 =head2 safe_pipe_capture
 
 
 =head2 safe_pipe_capture
 

-an alterative to `command` that allows input to be passed as an array
+an alternative to `command` that allows input to be passed as an array

 to work around shell problems with weird characters in arguments
 
 =cut
 to work around shell problems with weird characters in arguments
 
 =cut