git-cvsserver.perl

   1 #!/usr/bin/perl
   2
   3 ####
   4 #### This application is a CVS emulation layer for git.
   5 #### It is intended for clients to connect over SSH.
   6 #### See the documentation for more details.
   7 ####
   8 #### Copyright The Open University UK - 2006.
   9 ####
  10 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
  11 ####          Martin Langhoff <martin@catalyst.net.nz>
  12 ####
  13 ####
  14 #### Released under the GNU Public License, version 2.
  15 ####
  16 ####
  17
  18 use strict;
  19 use warnings;
  20
  21 use Fcntl;
  22 use File::Temp qw/tempdir tempfile/;
  23 use File::Basename;
  24
  25 my $log = GITCVS::log->new();
  26 my $cfg;
  27
  28 my $DATE_LIST = {
  29     Jan => "01",
  30     Feb => "02",
  31     Mar => "03",
  32     Apr => "04",
  33     May => "05",
  34     Jun => "06",
  35     Jul => "07",
  36     Aug => "08",
  37     Sep => "09",
  38     Oct => "10",
  39     Nov => "11",
  40     Dec => "12",
  41 };
  42
  43 # Enable autoflush for STDOUT (otherwise the whole thing falls apart)
  44 $| = 1;
  45
  46 #### Definition and mappings of functions ####
  47
  48 my $methods = {
  49     'Root'            => \&req_Root,
  50     'Valid-responses' => \&req_Validresponses,
  51     'valid-requests'  => \&req_validrequests,
  52     'Directory'       => \&req_Directory,
  53     'Entry'           => \&req_Entry,
  54     'Modified'        => \&req_Modified,
  55     'Unchanged'       => \&req_Unchanged,
  56     'Questionable'    => \&req_Questionable,
  57     'Argument'        => \&req_Argument,
  58     'Argumentx'       => \&req_Argument,
  59     'expand-modules'  => \&req_expandmodules,
  60     'add'             => \&req_add,
  61     'remove'          => \&req_remove,
  62     'co'              => \&req_co,
  63     'update'          => \&req_update,
  64     'ci'              => \&req_ci,
  65     'diff'            => \&req_diff,
  66     'log'             => \&req_log,
  67     'rlog'            => \&req_log,
  68     'tag'             => \&req_CATCHALL,
  69     'status'          => \&req_status,
  70     'admin'           => \&req_CATCHALL,
  71     'history'         => \&req_CATCHALL,
  72     'watchers'        => \&req_CATCHALL,
  73     'editors'         => \&req_CATCHALL,
  74     'annotate'        => \&req_annotate,
  75     'Global_option'   => \&req_Globaloption,
  76     #'annotate'        => \&req_CATCHALL,
  77 };
  78
  79 ##############################################
  80
  81
  82 # $state holds all the bits of information the clients sends us that could
  83 # potentially be useful when it comes to actually _doing_ something.
  84 my $state = {};
  85 $log->info("--------------- STARTING -----------------");
  86
  87 my $TEMP_DIR = tempdir( CLEANUP => 1 );
  88 $log->debug("Temporary directory is '$TEMP_DIR'");
  89
  90 # if we are called with a pserver argument,
  91 # deal with the authentication cat before entering the
  92 # main loop
  93 if (@ARGV && $ARGV[0] eq 'pserver') {
  94     my $line = <STDIN>; chomp $line;
  95     unless( $line eq 'BEGIN AUTH REQUEST') {
  96        die "E Do not understand $line - expecting BEGIN AUTH REQUEST\n";
  97     }
  98     $line = <STDIN>; chomp $line;
  99     req_Root('root', $line) # reuse Root
 100        or die "E Invalid root $line \n";
 101     $line = <STDIN>; chomp $line;
 102     unless ($line eq 'anonymous') {
 103        print "E Only anonymous user allowed via pserver\n";
 104        print "I HATE YOU\n";
 105     }
 106     $line = <STDIN>; chomp $line;    # validate the password?
 107     $line = <STDIN>; chomp $line;
 108     unless ($line eq 'END AUTH REQUEST') {
 109        die "E Do not understand $line -- expecting END AUTH REQUEST\n";
 110     }
 111     print "I LOVE YOU\n";
 112     # and now back to our regular programme...
 113 }
 114
 115 # Keep going until the client closes the connection
 116 while (<STDIN>)
 117 {
 118     chomp;
 119
 120     # Check to see if we've seen this method, and call appropriate function.
 121     if ( /^([\w-]+)(?:\s+(.*))?$/ and defined($methods->{$1}) )
 122     {
 123         # use the $methods hash to call the appropriate sub for this command
 124         #$log->info("Method : $1");
 125         &{$methods->{$1}}($1,$2);
 126     } else {
 127         # log fatal because we don't understand this function. If this happens
 128         # we're fairly screwed because we don't know if the client is expecting
 129         # a response. If it is, the client will hang, we'll hang, and the whole
 130         # thing will be custard.
 131         $log->fatal("Don't understand command $_\n");
 132         die("Unknown command $_");
 133     }
 134 }
 135
 136 $log->debug("Processing time : user=" . (times)[0] . " system=" . (times)[1]);
 137 $log->info("--------------- FINISH -----------------");
 138
 139 # Magic catchall method.
 140 #    This is the method that will handle all commands we haven't yet
 141 #    implemented. It simply sends a warning to the log file indicating a
 142 #    command that hasn't been implemented has been invoked.
 143 sub req_CATCHALL
 144 {
 145     my ( $cmd, $data ) = @_;
 146     $log->warn("Unhandled command : req_$cmd : $data");
 147 }
 148
 149
 150 # Root pathname \n
 151 #     Response expected: no. Tell the server which CVSROOT to use. Note that
 152 #     pathname is a local directory and not a fully qualified CVSROOT variable.
 153 #     pathname must already exist; if creating a new root, use the init
 154 #     request, not Root. pathname does not include the hostname of the server,
 155 #     how to access the server, etc.; by the time the CVS protocol is in use,
 156 #     connection, authentication, etc., are already taken care of. The Root
 157 #     request must be sent only once, and it must be sent before any requests
 158 #     other than Valid-responses, valid-requests, UseUnchanged, Set or init.
 159 sub req_Root
 160 {
 161     my ( $cmd, $data ) = @_;
 162     $log->debug("req_Root : $data");
 163
 164     $state->{CVSROOT} = $data;
 165
 166     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 167     unless (-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') {
 168        print "E $ENV{GIT_DIR} does not seem to be a valid GIT repository\n";
 169         print "E \n";
 170         print "error 1 $ENV{GIT_DIR} is not a valid repository\n";
 171        return 0;
 172     }
 173
 174     my @gitvars = `git-repo-config -l`;
 175     if ($?) {
 176        print "E problems executing git-repo-config on the server -- this is not a git repository or the PATH is not set correctly.\n";
 177         print "E \n";
 178         print "error 1 - problem executing git-repo-config\n";
 179        return 0;
 180     }
 181     foreach my $line ( @gitvars )
 182     {
 183         next unless ( $line =~ /^(.*?)\.(.*?)=(.*)$/ );
 184         $cfg->{$1}{$2} = $3;
 185     }
 186
 187     unless ( defined ( $cfg->{gitcvs}{enabled} ) and $cfg->{gitcvs}{enabled} =~ /^\s*(1|true|yes)\s*$/i )
 188     {
 189         print "E GITCVS emulation needs to be enabled on this repo\n";
 190         print "E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n";
 191         print "E \n";
 192         print "error 1 GITCVS emulation disabled\n";
 193         return 0;
 194     }
 195
 196     if ( defined ( $cfg->{gitcvs}{logfile} ) )
 197     {
 198         $log->setfile($cfg->{gitcvs}{logfile});
 199     } else {
 200         $log->nofile();
 201     }
 202
 203     return 1;
 204 }
 205
 206 # Global_option option \n
 207 #     Response expected: no. Transmit one of the global options `-q', `-Q',
 208 #     `-l', `-t', `-r', or `-n'. option must be one of those strings, no
 209 #     variations (such as combining of options) are allowed. For graceful
 210 #     handling of valid-requests, it is probably better to make new global
 211 #     options separate requests, rather than trying to add them to this
 212 #     request.
 213 sub req_Globaloption
 214 {
 215     my ( $cmd, $data ) = @_;
 216     $log->debug("req_Globaloption : $data");
 217
 218     # TODO : is this data useful ???
 219 }
 220
 221 # Valid-responses request-list \n
 222 #     Response expected: no. Tell the server what responses the client will
 223 #     accept. request-list is a space separated list of tokens.
 224 sub req_Validresponses
 225 {
 226     my ( $cmd, $data ) = @_;
 227     $log->debug("req_Validresponses : $data");
 228
 229     # TODO : re-enable this, currently it's not particularly useful
 230     #$state->{validresponses} = [ split /\s+/, $data ];
 231 }
 232
 233 # valid-requests \n
 234 #     Response expected: yes. Ask the server to send back a Valid-requests
 235 #     response.
 236 sub req_validrequests
 237 {
 238     my ( $cmd, $data ) = @_;
 239
 240     $log->debug("req_validrequests");
 241
 242     $log->debug("SEND : Valid-requests " . join(" ",keys %$methods));
 243     $log->debug("SEND : ok");
 244
 245     print "Valid-requests " . join(" ",keys %$methods) . "\n";
 246     print "ok\n";
 247 }
 248
 249 # Directory local-directory \n
 250 #     Additional data: repository \n. Response expected: no. Tell the server
 251 #     what directory to use. The repository should be a directory name from a
 252 #     previous server response. Note that this both gives a default for Entry
 253 #     and Modified and also for ci and the other commands; normal usage is to
 254 #     send Directory for each directory in which there will be an Entry or
 255 #     Modified, and then a final Directory for the original directory, then the
 256 #     command. The local-directory is relative to the top level at which the
 257 #     command is occurring (i.e. the last Directory which is sent before the
 258 #     command); to indicate that top level, `.' should be sent for
 259 #     local-directory.
 260 sub req_Directory
 261 {
 262     my ( $cmd, $data ) = @_;
 263
 264     my $repository = <STDIN>;
 265     chomp $repository;
 266
 267
 268     $state->{localdir} = $data;
 269     $state->{repository} = $repository;
 270     $state->{directory} = $repository;
 271     $state->{directory} =~ s/^$state->{CVSROOT}\///;
 272     $state->{module} = $1 if ($state->{directory} =~ s/^(.*?)(\/|$)//);
 273     $state->{directory} .= "/" if ( $state->{directory} =~ /\S/ );
 274
 275     $log->debug("req_Directory : localdir=$data repository=$repository directory=$state->{directory} module=$state->{module}");
 276 }
 277
 278 # Entry entry-line \n
 279 #     Response expected: no. Tell the server what version of a file is on the
 280 #     local machine. The name in entry-line is a name relative to the directory
 281 #     most recently specified with Directory. If the user is operating on only
 282 #     some files in a directory, Entry requests for only those files need be
 283 #     included. If an Entry request is sent without Modified, Is-modified, or
 284 #     Unchanged, it means the file is lost (does not exist in the working
 285 #     directory). If both Entry and one of Modified, Is-modified, or Unchanged
 286 #     are sent for the same file, Entry must be sent first. For a given file,
 287 #     one can send Modified, Is-modified, or Unchanged, but not more than one
 288 #     of these three.
 289 sub req_Entry
 290 {
 291     my ( $cmd, $data ) = @_;
 292
 293     $log->debug("req_Entry : $data");
 294
 295     my @data = split(/\//, $data);
 296
 297     $state->{entries}{$state->{directory}.$data[1]} = {
 298         revision    => $data[2],
 299         conflict    => $data[3],
 300         options     => $data[4],
 301         tag_or_date => $data[5],
 302     };
 303 }
 304
 305 # add \n
 306 #     Response expected: yes. Add a file or directory. This uses any previous
 307 #     Argument, Directory, Entry, or Modified requests, if they have been sent.
 308 #     The last Directory sent specifies the working directory at the time of
 309 #     the operation. To add a directory, send the directory to be added using
 310 #     Directory and Argument requests.
 311 sub req_add
 312 {
 313     my ( $cmd, $data ) = @_;
 314
 315     argsplit("add");
 316
 317     my $addcount = 0;
 318
 319     foreach my $filename ( @{$state->{args}} )
 320     {
 321         $filename = filecleanup($filename);
 322
 323         unless ( defined ( $state->{entries}{$filename}{modified_filename} ) )
 324         {
 325             print "E cvs add: nothing known about `$filename'\n";
 326             next;
 327         }
 328         # TODO : check we're not squashing an already existing file
 329         if ( defined ( $state->{entries}{$filename}{revision} ) )
 330         {
 331             print "E cvs add: `$filename' has already been entered\n";
 332             next;
 333         }
 334
 335
 336         my ( $filepart, $dirpart ) = filenamesplit($filename);
 337
 338         print "E cvs add: scheduling file `$filename' for addition\n";
 339
 340         print "Checked-in $dirpart\n";
 341         print "$filename\n";
 342         print "/$filepart/0///\n";
 343
 344         $addcount++;
 345     }
 346
 347     if ( $addcount == 1 )
 348     {
 349         print "E cvs add: use `cvs commit' to add this file permanently\n";
 350     }
 351     elsif ( $addcount > 1 )
 352     {
 353         print "E cvs add: use `cvs commit' to add these files permanently\n";
 354     }
 355
 356     print "ok\n";
 357 }
 358
 359 # remove \n
 360 #     Response expected: yes. Remove a file. This uses any previous Argument,
 361 #     Directory, Entry, or Modified requests, if they have been sent. The last
 362 #     Directory sent specifies the working directory at the time of the
 363 #     operation. Note that this request does not actually do anything to the
 364 #     repository; the only effect of a successful remove request is to supply
 365 #     the client with a new entries line containing `-' to indicate a removed
 366 #     file. In fact, the client probably could perform this operation without
 367 #     contacting the server, although using remove may cause the server to
 368 #     perform a few more checks. The client sends a subsequent ci request to
 369 #     actually record the removal in the repository.
 370 sub req_remove
 371 {
 372     my ( $cmd, $data ) = @_;
 373
 374     argsplit("remove");
 375
 376     # Grab a handle to the SQLite db and do any necessary updates
 377     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 378     $updater->update();
 379
 380     #$log->debug("add state : " . Dumper($state));
 381
 382     my $rmcount = 0;
 383
 384     foreach my $filename ( @{$state->{args}} )
 385     {
 386         $filename = filecleanup($filename);
 387
 388         if ( defined ( $state->{entries}{$filename}{unchanged} ) or defined ( $state->{entries}{$filename}{modified_filename} ) )
 389         {
 390             print "E cvs remove: file `$filename' still in working directory\n";
 391             next;
 392         }
 393
 394         my $meta = $updater->getmeta($filename);
 395         my $wrev = revparse($filename);
 396
 397         unless ( defined ( $wrev ) )
 398         {
 399             print "E cvs remove: nothing known about `$filename'\n";
 400             next;
 401         }
 402
 403         if ( defined($wrev) and $wrev < 0 )
 404         {
 405             print "E cvs remove: file `$filename' already scheduled for removal\n";
 406             next;
 407         }
 408
 409         unless ( $wrev == $meta->{revision} )
 410         {
 411             # TODO : not sure if the format of this message is quite correct.
 412             print "E cvs remove: Up to date check failed for `$filename'\n";
 413             next;
 414         }
 415
 416
 417         my ( $filepart, $dirpart ) = filenamesplit($filename);
 418
 419         print "E cvs remove: scheduling `$filename' for removal\n";
 420
 421         print "Checked-in $dirpart\n";
 422         print "$filename\n";
 423         print "/$filepart/-1.$wrev///\n";
 424
 425         $rmcount++;
 426     }
 427
 428     if ( $rmcount == 1 )
 429     {
 430         print "E cvs remove: use `cvs commit' to remove this file permanently\n";
 431     }
 432     elsif ( $rmcount > 1 )
 433     {
 434         print "E cvs remove: use `cvs commit' to remove these files permanently\n";
 435     }
 436
 437     print "ok\n";
 438 }
 439
 440 # Modified filename \n
 441 #     Response expected: no. Additional data: mode, \n, file transmission. Send
 442 #     the server a copy of one locally modified file. filename is a file within
 443 #     the most recent directory sent with Directory; it must not contain `/'.
 444 #     If the user is operating on only some files in a directory, only those
 445 #     files need to be included. This can also be sent without Entry, if there
 446 #     is no entry for the file.
 447 sub req_Modified
 448 {
 449     my ( $cmd, $data ) = @_;
 450
 451     my $mode = <STDIN>;
 452     chomp $mode;
 453     my $size = <STDIN>;
 454     chomp $size;
 455
 456     # Grab config information
 457     my $blocksize = 8192;
 458     my $bytesleft = $size;
 459     my $tmp;
 460
 461     # Get a filehandle/name to write it to
 462     my ( $fh, $filename ) = tempfile( DIR => $TEMP_DIR );
 463
 464     # Loop over file data writing out to temporary file.
 465     while ( $bytesleft )
 466     {
 467         $blocksize = $bytesleft if ( $bytesleft < $blocksize );
 468         read STDIN, $tmp, $blocksize;
 469         print $fh $tmp;
 470         $bytesleft -= $blocksize;
 471     }
 472
 473     close $fh;
 474
 475     # Ensure we have something sensible for the file mode
 476     if ( $mode =~ /u=(\w+)/ )
 477     {
 478         $mode = $1;
 479     } else {
 480         $mode = "rw";
 481     }
 482
 483     # Save the file data in $state
 484     $state->{entries}{$state->{directory}.$data}{modified_filename} = $filename;
 485     $state->{entries}{$state->{directory}.$data}{modified_mode} = $mode;
 486     $state->{entries}{$state->{directory}.$data}{modified_hash} = `git-hash-object $filename`;
 487     $state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s;
 488
 489     #$log->debug("req_Modified : file=$data mode=$mode size=$size");
 490 }
 491
 492 # Unchanged filename \n
 493 #     Response expected: no. Tell the server that filename has not been
 494 #     modified in the checked out directory. The filename is a file within the
 495 #     most recent directory sent with Directory; it must not contain `/'.
 496 sub req_Unchanged
 497 {
 498     my ( $cmd, $data ) = @_;
 499
 500     $state->{entries}{$state->{directory}.$data}{unchanged} = 1;
 501
 502     #$log->debug("req_Unchanged : $data");
 503 }
 504
 505 # Questionable filename \n
 506 #     Response expected: no. Additional data: no.
 507 #     Tell the server to check whether filename should be ignored,
 508 #     and if not, next time the server sends responses, send (in
 509 #     a M response) `?' followed by the directory and filename.
 510 #     filename must not contain `/'; it needs to be a file in the
 511 #     directory named by the most recent Directory request.
 512 sub req_Questionable
 513 {
 514     my ( $cmd, $data ) = @_;
 515
 516     $state->{entries}{$state->{directory}.$data}{questionable} = 1;
 517
 518     #$log->debug("req_Questionable : $data");
 519 }
 520
 521 # Argument text \n
 522 #     Response expected: no. Save argument for use in a subsequent command.
 523 #     Arguments accumulate until an argument-using command is given, at which
 524 #     point they are forgotten.
 525 # Argumentx text \n
 526 #     Response expected: no. Append \n followed by text to the current argument
 527 #     being saved.
 528 sub req_Argument
 529 {
 530     my ( $cmd, $data ) = @_;
 531
 532     # TODO :  Not quite sure how Argument and Argumentx differ, but I assume
 533     # it's for multi-line arguments ... somehow ...
 534
 535     $log->debug("$cmd : $data");
 536
 537     push @{$state->{arguments}}, $data;
 538 }
 539
 540 # expand-modules \n
 541 #     Response expected: yes. Expand the modules which are specified in the
 542 #     arguments. Returns the data in Module-expansion responses. Note that the
 543 #     server can assume that this is checkout or export, not rtag or rdiff; the
 544 #     latter do not access the working directory and thus have no need to
 545 #     expand modules on the client side. Expand may not be the best word for
 546 #     what this request does. It does not necessarily tell you all the files
 547 #     contained in a module, for example. Basically it is a way of telling you
 548 #     which working directories the server needs to know about in order to
 549 #     handle a checkout of the specified modules. For example, suppose that the
 550 #     server has a module defined by
 551 #   aliasmodule -a 1dir
 552 #     That is, one can check out aliasmodule and it will take 1dir in the
 553 #     repository and check it out to 1dir in the working directory. Now suppose
 554 #     the client already has this module checked out and is planning on using
 555 #     the co request to update it. Without using expand-modules, the client
 556 #     would have two bad choices: it could either send information about all
 557 #     working directories under the current directory, which could be
 558 #     unnecessarily slow, or it could be ignorant of the fact that aliasmodule
 559 #     stands for 1dir, and neglect to send information for 1dir, which would
 560 #     lead to incorrect operation. With expand-modules, the client would first
 561 #     ask for the module to be expanded:
 562 sub req_expandmodules
 563 {
 564     my ( $cmd, $data ) = @_;
 565
 566     argsplit();
 567
 568     $log->debug("req_expandmodules : " . ( defined($data) ? $data : "[NULL]" ) );
 569
 570     unless ( ref $state->{arguments} eq "ARRAY" )
 571     {
 572         print "ok\n";
 573         return;
 574     }
 575
 576     foreach my $module ( @{$state->{arguments}} )
 577     {
 578         $log->debug("SEND : Module-expansion $module");
 579         print "Module-expansion $module\n";
 580     }
 581
 582     print "ok\n";
 583     statecleanup();
 584 }
 585
 586 # co \n
 587 #     Response expected: yes. Get files from the repository. This uses any
 588 #     previous Argument, Directory, Entry, or Modified requests, if they have
 589 #     been sent. Arguments to this command are module names; the client cannot
 590 #     know what directories they correspond to except by (1) just sending the
 591 #     co request, and then seeing what directory names the server sends back in
 592 #     its responses, and (2) the expand-modules request.
 593 sub req_co
 594 {
 595     my ( $cmd, $data ) = @_;
 596
 597     argsplit("co");
 598
 599     my $module = $state->{args}[0];
 600     my $checkout_path = $module;
 601
 602     # use the user specified directory if we're given it
 603     $checkout_path = $state->{opt}{d} if ( exists ( $state->{opt}{d} ) );
 604
 605     $log->debug("req_co : " . ( defined($data) ? $data : "[NULL]" ) );
 606
 607     $log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'");
 608
 609     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 610
 611     # Grab a handle to the SQLite db and do any necessary updates
 612     my $updater = GITCVS::updater->new($state->{CVSROOT}, $module, $log);
 613     $updater->update();
 614
 615     $checkout_path =~ s|/$||; # get rid of trailing slashes
 616
 617     # Eclipse seems to need the Clear-sticky command
 618     # to prepare the 'Entries' file for the new directory.
 619     print "Clear-sticky $checkout_path/\n";
 620     print $state->{CVSROOT} . "/$module/\n";
 621     print "Clear-static-directory $checkout_path/\n";
 622     print $state->{CVSROOT} . "/$module/\n";
 623     print "Clear-sticky $checkout_path/\n"; # yes, twice
 624     print $state->{CVSROOT} . "/$module/\n";
 625     print "Template $checkout_path/\n";
 626     print $state->{CVSROOT} . "/$module/\n";
 627     print "0\n";
 628
 629     # instruct the client that we're checking out to $checkout_path
 630     print "E cvs checkout: Updating $checkout_path\n";
 631
 632     my %seendirs = ();
 633     my $lastdir ='';
 634
 635     # recursive
 636     sub prepdir {
 637        my ($dir, $repodir, $remotedir, $seendirs) = @_;
 638        my $parent = dirname($dir);
 639        $dir       =~ s|/+$||;
 640        $repodir   =~ s|/+$||;
 641        $remotedir =~ s|/+$||;
 642        $parent    =~ s|/+$||;
 643        $log->debug("announcedir $dir, $repodir, $remotedir" );
 644
 645        if ($parent eq '.' || $parent eq './') {
 646            $parent = '';
 647        }
 648        # recurse to announce unseen parents first
 649        if (length($parent) && !exists($seendirs->{$parent})) {
 650            prepdir($parent, $repodir, $remotedir, $seendirs);
 651        }
 652        # Announce that we are going to modify at the parent level
 653        if ($parent) {
 654            print "E cvs checkout: Updating $remotedir/$parent\n";
 655        } else {
 656            print "E cvs checkout: Updating $remotedir\n";
 657        }
 658        print "Clear-sticky $remotedir/$parent/\n";
 659        print "$repodir/$parent/\n";
 660
 661        print "Clear-static-directory $remotedir/$dir/\n";
 662        print "$repodir/$dir/\n";
 663        print "Clear-sticky $remotedir/$parent/\n"; # yes, twice
 664        print "$repodir/$parent/\n";
 665        print "Template $remotedir/$dir/\n";
 666        print "$repodir/$dir/\n";
 667        print "0\n";
 668
 669        $seendirs->{$dir} = 1;
 670     }
 671
 672     foreach my $git ( @{$updater->gethead} )
 673     {
 674         # Don't want to check out deleted files
 675         next if ( $git->{filehash} eq "deleted" );
 676
 677         ( $git->{name}, $git->{dir} ) = filenamesplit($git->{name});
 678
 679        if (length($git->{dir}) && $git->{dir} ne './'
 680            && $git->{dir} ne $lastdir ) {
 681            unless (exists($seendirs{$git->{dir}})) {
 682                prepdir($git->{dir}, $state->{CVSROOT} . "/$module/",
 683                        $checkout_path, \%seendirs);
 684                $lastdir = $git->{dir};
 685                $seendirs{$git->{dir}} = 1;
 686            }
 687            print "E cvs checkout: Updating /$checkout_path/$git->{dir}\n";
 688        }
 689
 690         # modification time of this file
 691         print "Mod-time $git->{modified}\n";
 692
 693         # print some information to the client
 694         if ( defined ( $git->{dir} ) and $git->{dir} ne "./" )
 695         {
 696             print "M U $checkout_path/$git->{dir}$git->{name}\n";
 697         } else {
 698             print "M U $checkout_path/$git->{name}\n";
 699         }
 700
 701        # instruct client we're sending a file to put in this path
 702        print "Created $checkout_path/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "\n";
 703
 704        print $state->{CVSROOT} . "/$module/" . ( defined ( $git->{dir} ) and $git->{dir} ne "./" ? $git->{dir} . "/" : "" ) . "$git->{name}\n";
 705
 706         # this is an "entries" line
 707         print "/$git->{name}/1.$git->{revision}///\n";
 708         # permissions
 709         print "u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";
 710
 711         # transmit file
 712         transmitfile($git->{filehash});
 713     }
 714
 715     print "ok\n";
 716
 717     statecleanup();
 718 }
 719
 720 # update \n
 721 #     Response expected: yes. Actually do a cvs update command. This uses any
 722 #     previous Argument, Directory, Entry, or Modified requests, if they have
 723 #     been sent. The last Directory sent specifies the working directory at the
 724 #     time of the operation. The -I option is not used--files which the client
 725 #     can decide whether to ignore are not mentioned and the client sends the
 726 #     Questionable request for others.
 727 sub req_update
 728 {
 729     my ( $cmd, $data ) = @_;
 730
 731     $log->debug("req_update : " . ( defined($data) ? $data : "[NULL]" ));
 732
 733     argsplit("update");
 734
 735     #
 736     # It may just be a client exploring the available heads/modules
 737     # in that case, list them as top level directories and leave it
 738     # at that. Eclipse uses this technique to offer you a list of
 739     # projects (heads in this case) to checkout.
 740     #
 741     if ($state->{module} eq '') {
 742         print "E cvs update: Updating .\n";
 743         opendir HEADS, $state->{CVSROOT} . '/refs/heads';
 744         while (my $head = readdir(HEADS)) {
 745             if (-f $state->{CVSROOT} . '/refs/heads/' . $head) {
 746                 print "E cvs update: New directory `$head'\n";
 747             }
 748         }
 749         closedir HEADS;
 750         print "ok\n";
 751         return 1;
 752     }
 753
 754
 755     # Grab a handle to the SQLite db and do any necessary updates
 756     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 757
 758     $updater->update();
 759
 760     # if no files were specified, we need to work out what files we should be providing status on ...
 761     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
 762
 763     #$log->debug("update state : " . Dumper($state));
 764
 765     # foreach file specified on the commandline ...
 766     foreach my $filename ( @{$state->{args}} )
 767     {
 768         $filename = filecleanup($filename);
 769
 770         # if we have a -C we should pretend we never saw modified stuff
 771         if ( exists ( $state->{opt}{C} ) )
 772         {
 773             delete $state->{entries}{$filename}{modified_hash};
 774             delete $state->{entries}{$filename}{modified_filename};
 775             $state->{entries}{$filename}{unchanged} = 1;
 776         }
 777
 778         my $meta;
 779         if ( defined($state->{opt}{r}) and $state->{opt}{r} =~ /^1\.(\d+)/ )
 780         {
 781             $meta = $updater->getmeta($filename, $1);
 782         } else {
 783             $meta = $updater->getmeta($filename);
 784         }
 785
 786         next unless ( $meta->{revision} );
 787
 788         my $oldmeta = $meta;
 789
 790         my $wrev = revparse($filename);
 791
 792         # If the working copy is an old revision, lets get that version too for comparison.
 793         if ( defined($wrev) and $wrev != $meta->{revision} )
 794         {
 795             $oldmeta = $updater->getmeta($filename, $wrev);
 796         }
 797
 798         #$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");
 799
 800         # Files are up to date if the working copy and repo copy have the same revision,
 801         # and the working copy is unmodified _and_ the user hasn't specified -C
 802         next if ( defined ( $wrev )
 803                   and defined($meta->{revision})
 804                   and $wrev == $meta->{revision}
 805                   and $state->{entries}{$filename}{unchanged}
 806                   and not exists ( $state->{opt}{C} ) );
 807
 808         # If the working copy and repo copy have the same revision,
 809         # but the working copy is modified, tell the client it's modified
 810         if ( defined ( $wrev )
 811              and defined($meta->{revision})
 812              and $wrev == $meta->{revision}
 813              and not exists ( $state->{opt}{C} ) )
 814         {
 815             $log->info("Tell the client the file is modified");
 816             print "MT text U\n";
 817             print "MT fname $filename\n";
 818             print "MT newline\n";
 819             next;
 820         }
 821
 822         if ( $meta->{filehash} eq "deleted" )
 823         {
 824             my ( $filepart, $dirpart ) = filenamesplit($filename);
 825
 826             $log->info("Removing '$filename' from working copy (no longer in the repo)");
 827
 828             print "E cvs update: `$filename' is no longer in the repository\n";
 829             print "Removed $dirpart\n";
 830             print "$filepart\n";
 831         }
 832         elsif ( not defined ( $state->{entries}{$filename}{modified_hash} )
 833                 or $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} )
 834         {
 835             $log->info("Updating '$filename'");
 836             # normal update, just send the new revision (either U=Update, or A=Add, or R=Remove)
 837             print "MT +updated\n";
 838             print "MT text U\n";
 839             print "MT fname $filename\n";
 840             print "MT newline\n";
 841             print "MT -updated\n";
 842
 843             my ( $filepart, $dirpart ) = filenamesplit($filename);
 844             $dirpart =~ s/^$state->{directory}//;
 845
 846             if ( defined ( $wrev ) )
 847             {
 848                 # instruct client we're sending a file to put in this path as a replacement
 849                 print "Update-existing $dirpart\n";
 850                 $log->debug("Updating existing file 'Update-existing $dirpart'");
 851             } else {
 852                 # instruct client we're sending a file to put in this path as a new file
 853                 print "Created $dirpart\n";
 854                 $log->debug("Creating new file 'Created $dirpart'");
 855             }
 856             print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 857
 858             # this is an "entries" line
 859             $log->debug("/$filepart/1.$meta->{revision}///");
 860             print "/$filepart/1.$meta->{revision}///\n";
 861
 862             # permissions
 863             $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
 864             print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
 865
 866             # transmit file
 867             transmitfile($meta->{filehash});
 868         } else {
 869             $log->info("Updating '$filename'");
 870             my ( $filepart, $dirpart ) = filenamesplit($meta->{name});
 871
 872             my $dir = tempdir( DIR => $TEMP_DIR, CLEANUP => 1 ) . "/";
 873
 874             chdir $dir;
 875             my $file_local = $filepart . ".mine";
 876             system("ln","-s",$state->{entries}{$filename}{modified_filename}, $file_local);
 877             my $file_old = $filepart . "." . $oldmeta->{revision};
 878             transmitfile($oldmeta->{filehash}, $file_old);
 879             my $file_new = $filepart . "." . $meta->{revision};
 880             transmitfile($meta->{filehash}, $file_new);
 881
 882             # we need to merge with the local changes ( M=successful merge, C=conflict merge )
 883             $log->info("Merging $file_local, $file_old, $file_new");
 884
 885             $log->debug("Temporary directory for merge is $dir");
 886
 887             my $return = system("merge", $file_local, $file_old, $file_new);
 888             $return >>= 8;
 889
 890             if ( $return == 0 )
 891             {
 892                 $log->info("Merged successfully");
 893                 print "M M $filename\n";
 894                 $log->debug("Update-existing $dirpart");
 895                 print "Update-existing $dirpart\n";
 896                 $log->debug($state->{CVSROOT} . "/$state->{module}/$filename");
 897                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 898                 $log->debug("/$filepart/1.$meta->{revision}///");
 899                 print "/$filepart/1.$meta->{revision}///\n";
 900             }
 901             elsif ( $return == 1 )
 902             {
 903                 $log->info("Merged with conflicts");
 904                 print "M C $filename\n";
 905                 print "Update-existing $dirpart\n";
 906                 print $state->{CVSROOT} . "/$state->{module}/$filename\n";
 907                 print "/$filepart/1.$meta->{revision}/+//\n";
 908             }
 909             else
 910             {
 911                 $log->warn("Merge failed");
 912                 next;
 913             }
 914
 915             # permissions
 916             $log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");
 917             print "u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";
 918
 919             # transmit file, format is single integer on a line by itself (file
 920             # size) followed by the file contents
 921             # TODO : we should copy files in blocks
 922             my $data = `cat $file_local`;
 923             $log->debug("File size : " . length($data));
 924             print length($data) . "\n";
 925             print $data;
 926
 927             chdir "/";
 928         }
 929
 930     }
 931
 932     print "ok\n";
 933 }
 934
 935 sub req_ci
 936 {
 937     my ( $cmd, $data ) = @_;
 938
 939     argsplit("ci");
 940
 941     #$log->debug("State : " . Dumper($state));
 942
 943     $log->info("req_ci : " . ( defined($data) ? $data : "[NULL]" ));
 944
 945     if ( @ARGV && $ARGV[0] eq 'pserver')
 946     {
 947         print "error 1 pserver access cannot commit\n";
 948         exit;
 949     }
 950
 951     if ( -e $state->{CVSROOT} . "/index" )
 952     {
 953         $log->warn("file 'index' already exists in the git repository");
 954         print "error 1 Index already exists in git repo\n";
 955         exit;
 956     }
 957
 958     my $lockfile = "$state->{CVSROOT}/refs/heads/$state->{module}.lock";
 959     unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) )
 960     {
 961         $log->warn("lockfile '$lockfile' already exists, please try again");
 962         print "error 1 Lock file '$lockfile' already exists, please try again\n";
 963         exit;
 964     }
 965
 966     # Grab a handle to the SQLite db and do any necessary updates
 967     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
 968     $updater->update();
 969
 970     my $tmpdir = tempdir ( DIR => $TEMP_DIR );
 971     my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
 972     $log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");
 973
 974     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
 975     $ENV{GIT_INDEX_FILE} = $file_index;
 976
 977     chdir $tmpdir;
 978
 979     # populate the temporary index based
 980     system("git-read-tree", $state->{module});
 981     unless ($? == 0)
 982     {
 983         die "Error running git-read-tree $state->{module} $file_index $!";
 984     }
 985     $log->info("Created index '$file_index' with for head $state->{module} - exit status $?");
 986
 987
 988     my @committedfiles = ();
 989
 990     # foreach file specified on the commandline ...
 991     foreach my $filename ( @{$state->{args}} )
 992     {
 993         $filename = filecleanup($filename);
 994
 995         next unless ( exists $state->{entries}{$filename}{modified_filename} or not $state->{entries}{$filename}{unchanged} );
 996
 997         my $meta = $updater->getmeta($filename);
 998
 999         my $wrev = revparse($filename);
1000
1001         my ( $filepart, $dirpart ) = filenamesplit($filename);
1002
1003         # do a checkout of the file if it part of this tree
1004         if ($wrev) {
1005             system('git-checkout-index', '-f', '-u', $filename);
1006             unless ($? == 0) {
1007                 die "Error running git-checkout-index -f -u $filename : $!";
1008             }
1009         }
1010
1011         my $addflag = 0;
1012         my $rmflag = 0;
1013         $rmflag = 1 if ( defined($wrev) and $wrev < 0 );
1014         $addflag = 1 unless ( -e $filename );
1015
1016         # Do up to date checking
1017         unless ( $addflag or $wrev == $meta->{revision} or ( $rmflag and -$wrev == $meta->{revision} ) )
1018         {
1019             # fail everything if an up to date check fails
1020             print "error 1 Up to date check failed for $filename\n";
1021             close LOCKFILE;
1022             unlink($lockfile);
1023             chdir "/";
1024             exit;
1025         }
1026
1027         push @committedfiles, $filename;
1028         $log->info("Committing $filename");
1029
1030         system("mkdir","-p",$dirpart) unless ( -d $dirpart );
1031
1032         unless ( $rmflag )
1033         {
1034             $log->debug("rename $state->{entries}{$filename}{modified_filename} $filename");
1035             rename $state->{entries}{$filename}{modified_filename},$filename;
1036
1037             # Calculate modes to remove
1038             my $invmode = "";
1039             foreach ( qw (r w x) ) { $invmode .= $_ unless ( $state->{entries}{$filename}{modified_mode} =~ /$_/ ); }
1040
1041             $log->debug("chmod u+" . $state->{entries}{$filename}{modified_mode} . "-" . $invmode . " $filename");
1042             system("chmod","u+" .  $state->{entries}{$filename}{modified_mode} . "-" . $invmode, $filename);
1043         }
1044
1045         if ( $rmflag )
1046         {
1047             $log->info("Removing file '$filename'");
1048             unlink($filename);
1049             system("git-update-index", "--remove", $filename);
1050         }
1051         elsif ( $addflag )
1052         {
1053             $log->info("Adding file '$filename'");
1054             system("git-update-index", "--add", $filename);
1055         } else {
1056             $log->info("Updating file '$filename'");
1057             system("git-update-index", $filename);
1058         }
1059     }
1060
1061     unless ( scalar(@committedfiles) > 0 )
1062     {
1063         print "E No files to commit\n";
1064         print "ok\n";
1065         close LOCKFILE;
1066         unlink($lockfile);
1067         chdir "/";
1068         return;
1069     }
1070
1071     my $treehash = `git-write-tree`;
1072     my $parenthash = `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;
1073     chomp $treehash;
1074     chomp $parenthash;
1075
1076     $log->debug("Treehash : $treehash, Parenthash : $parenthash");
1077
1078     # write our commit message out if we have one ...
1079     my ( $msg_fh, $msg_filename ) = tempfile( DIR => $TEMP_DIR );
1080     print $msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );
1081     print $msg_fh "\n\nvia git-CVS emulator\n";
1082     close $msg_fh;
1083
1084     my $commithash = `git-commit-tree $treehash -p $parenthash < $msg_filename`;
1085     $log->info("Commit hash : $commithash");
1086
1087     unless ( $commithash =~ /[a-zA-Z0-9]{40}/ )
1088     {
1089         $log->warn("Commit failed (Invalid commit hash)");
1090         print "error 1 Commit failed (unknown reason)\n";
1091         close LOCKFILE;
1092         unlink($lockfile);
1093         chdir "/";
1094         exit;
1095     }
1096
1097     open FILE, ">", "$ENV{GIT_DIR}refs/heads/$state->{module}";
1098     print FILE $commithash;
1099     close FILE;
1100
1101     $updater->update();
1102
1103     # foreach file specified on the commandline ...
1104     foreach my $filename ( @committedfiles )
1105     {
1106         $filename = filecleanup($filename);
1107
1108         my $meta = $updater->getmeta($filename);
1109
1110         my ( $filepart, $dirpart ) = filenamesplit($filename);
1111
1112         $log->debug("Checked-in $dirpart : $filename");
1113
1114         if ( $meta->{filehash} eq "deleted" )
1115         {
1116             print "Remove-entry $dirpart\n";
1117             print "$filename\n";
1118         } else {
1119             print "Checked-in $dirpart\n";
1120             print "$filename\n";
1121             print "/$filepart/1.$meta->{revision}///\n";
1122         }
1123     }
1124
1125     close LOCKFILE;
1126     unlink($lockfile);
1127     chdir "/";
1128
1129     print "ok\n";
1130 }
1131
1132 sub req_status
1133 {
1134     my ( $cmd, $data ) = @_;
1135
1136     argsplit("status");
1137
1138     $log->info("req_status : " . ( defined($data) ? $data : "[NULL]" ));
1139     #$log->debug("status state : " . Dumper($state));
1140
1141     # Grab a handle to the SQLite db and do any necessary updates
1142     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1143     $updater->update();
1144
1145     # if no files were specified, we need to work out what files we should be providing status on ...
1146     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1147
1148     # foreach file specified on the commandline ...
1149     foreach my $filename ( @{$state->{args}} )
1150     {
1151         $filename = filecleanup($filename);
1152
1153         my $meta = $updater->getmeta($filename);
1154         my $oldmeta = $meta;
1155
1156         my $wrev = revparse($filename);
1157
1158         # If the working copy is an old revision, lets get that version too for comparison.
1159         if ( defined($wrev) and $wrev != $meta->{revision} )
1160         {
1161             $oldmeta = $updater->getmeta($filename, $wrev);
1162         }
1163
1164         # TODO : All possible statuses aren't yet implemented
1165         my $status;
1166         # Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1167         $status = "Up-to-date" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision}
1168                                     and
1169                                     ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1170                                       or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta->{filehash} ) )
1171                                    );
1172
1173         # Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified
1174         $status ||= "Needs Checkout" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev
1175                                           and
1176                                           ( $state->{entries}{$filename}{unchanged}
1177                                             or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $oldmeta->{filehash} ) )
1178                                         );
1179
1180         # Need checkout if it exists in the repo but doesn't have a working copy
1181         $status ||= "Needs Checkout" if ( not defined ( $wrev ) and defined ( $meta->{revision} ) );
1182
1183         # Locally modified if working copy and repo copy have the same revision but there are local changes
1184         $status ||= "Locally Modified" if ( defined ( $wrev ) and defined($meta->{revision}) and $wrev == $meta->{revision} and $state->{entries}{$filename}{modified_filename} );
1185
1186         # Needs Merge if working copy revision is less than repo copy and there are local changes
1187         $status ||= "Needs Merge" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and $meta->{revision} > $wrev and $state->{entries}{$filename}{modified_filename} );
1188
1189         $status ||= "Locally Added" if ( defined ( $state->{entries}{$filename}{revision} ) and not defined ( $meta->{revision} ) );
1190         $status ||= "Locally Removed" if ( defined ( $wrev ) and defined ( $meta->{revision} ) and -$wrev == $meta->{revision} );
1191         $status ||= "Unresolved Conflict" if ( defined ( $state->{entries}{$filename}{conflict} ) and $state->{entries}{$filename}{conflict} =~ /^\+=/ );
1192         $status ||= "File had conflicts on merge" if ( 0 );
1193
1194         $status ||= "Unknown";
1195
1196         print "M ===================================================================\n";
1197         print "M File: $filename\tStatus: $status\n";
1198         if ( defined($state->{entries}{$filename}{revision}) )
1199         {
1200             print "M Working revision:\t" . $state->{entries}{$filename}{revision} . "\n";
1201         } else {
1202             print "M Working revision:\tNo entry for $filename\n";
1203         }
1204         if ( defined($meta->{revision}) )
1205         {
1206             print "M Repository revision:\t1." . $meta->{revision} . "\t$state->{repository}/$filename,v\n";
1207             print "M Sticky Tag:\t\t(none)\n";
1208             print "M Sticky Date:\t\t(none)\n";
1209             print "M Sticky Options:\t\t(none)\n";
1210         } else {
1211             print "M Repository revision:\tNo revision control file\n";
1212         }
1213         print "M\n";
1214     }
1215
1216     print "ok\n";
1217 }
1218
1219 sub req_diff
1220 {
1221     my ( $cmd, $data ) = @_;
1222
1223     argsplit("diff");
1224
1225     $log->debug("req_diff : " . ( defined($data) ? $data : "[NULL]" ));
1226     #$log->debug("status state : " . Dumper($state));
1227
1228     my ($revision1, $revision2);
1229     if ( defined ( $state->{opt}{r} ) and ref $state->{opt}{r} eq "ARRAY" )
1230     {
1231         $revision1 = $state->{opt}{r}[0];
1232         $revision2 = $state->{opt}{r}[1];
1233     } else {
1234         $revision1 = $state->{opt}{r};
1235     }
1236
1237     $revision1 =~ s/^1\.// if ( defined ( $revision1 ) );
1238     $revision2 =~ s/^1\.// if ( defined ( $revision2 ) );
1239
1240     $log->debug("Diffing revisions " . ( defined($revision1) ? $revision1 : "[NULL]" ) . " and " . ( defined($revision2) ? $revision2 : "[NULL]" ) );
1241
1242     # Grab a handle to the SQLite db and do any necessary updates
1243     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1244     $updater->update();
1245
1246     # if no files were specified, we need to work out what files we should be providing status on ...
1247     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1248
1249     # foreach file specified on the commandline ...
1250     foreach my $filename ( @{$state->{args}} )
1251     {
1252         $filename = filecleanup($filename);
1253
1254         my ( $fh, $file1, $file2, $meta1, $meta2, $filediff );
1255
1256         my $wrev = revparse($filename);
1257
1258         # We need _something_ to diff against
1259         next unless ( defined ( $wrev ) );
1260
1261         # if we have a -r switch, use it
1262         if ( defined ( $revision1 ) )
1263         {
1264             ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1265             $meta1 = $updater->getmeta($filename, $revision1);
1266             unless ( defined ( $meta1 ) and $meta1->{filehash} ne "deleted" )
1267             {
1268                 print "E File $filename at revision 1.$revision1 doesn't exist\n";
1269                 next;
1270             }
1271             transmitfile($meta1->{filehash}, $file1);
1272         }
1273         # otherwise we just use the working copy revision
1274         else
1275         {
1276             ( undef, $file1 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1277             $meta1 = $updater->getmeta($filename, $wrev);
1278             transmitfile($meta1->{filehash}, $file1);
1279         }
1280
1281         # if we have a second -r switch, use it too
1282         if ( defined ( $revision2 ) )
1283         {
1284             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1285             $meta2 = $updater->getmeta($filename, $revision2);
1286
1287             unless ( defined ( $meta2 ) and $meta2->{filehash} ne "deleted" )
1288             {
1289                 print "E File $filename at revision 1.$revision2 doesn't exist\n";
1290                 next;
1291             }
1292
1293             transmitfile($meta2->{filehash}, $file2);
1294         }
1295         # otherwise we just use the working copy
1296         else
1297         {
1298             $file2 = $state->{entries}{$filename}{modified_filename};
1299         }
1300
1301         # if we have been given -r, and we don't have a $file2 yet, lets get one
1302         if ( defined ( $revision1 ) and not defined ( $file2 ) )
1303         {
1304             ( undef, $file2 ) = tempfile( DIR => $TEMP_DIR, OPEN => 0 );
1305             $meta2 = $updater->getmeta($filename, $wrev);
1306             transmitfile($meta2->{filehash}, $file2);
1307         }
1308
1309         # We need to have retrieved something useful
1310         next unless ( defined ( $meta1 ) );
1311
1312         # Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified
1313         next if ( not defined ( $meta2 ) and $wrev == $meta1->{revision}
1314                   and
1315                    ( ( $state->{entries}{$filename}{unchanged} and ( not defined ( $state->{entries}{$filename}{conflict} ) or $state->{entries}{$filename}{conflict} !~ /^\+=/ ) )
1316                      or ( defined($state->{entries}{$filename}{modified_hash}) and $state->{entries}{$filename}{modified_hash} eq $meta1->{filehash} ) )
1317                   );
1318
1319         # Apparently we only show diffs for locally modified files
1320         next unless ( defined($meta2) or defined ( $state->{entries}{$filename}{modified_filename} ) );
1321
1322         print "M Index: $filename\n";
1323         print "M ===================================================================\n";
1324         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1325         print "M retrieving revision 1.$meta1->{revision}\n" if ( defined ( $meta1 ) );
1326         print "M retrieving revision 1.$meta2->{revision}\n" if ( defined ( $meta2 ) );
1327         print "M diff ";
1328         foreach my $opt ( keys %{$state->{opt}} )
1329         {
1330             if ( ref $state->{opt}{$opt} eq "ARRAY" )
1331             {
1332                 foreach my $value ( @{$state->{opt}{$opt}} )
1333                 {
1334                     print "-$opt $value ";
1335                 }
1336             } else {
1337                 print "-$opt ";
1338                 print "$state->{opt}{$opt} " if ( defined ( $state->{opt}{$opt} ) );
1339             }
1340         }
1341         print "$filename\n";
1342
1343         $log->info("Diffing $filename -r $meta1->{revision} -r " . ( $meta2->{revision} or "workingcopy" ));
1344
1345         ( $fh, $filediff ) = tempfile ( DIR => $TEMP_DIR );
1346
1347         if ( exists $state->{opt}{u} )
1348         {
1349             system("diff -u -L '$filename revision 1.$meta1->{revision}' -L '$filename " . ( defined($meta2->{revision}) ? "revision 1.$meta2->{revision}" : "working copy" ) . "' $file1 $file2 > $filediff");
1350         } else {
1351             system("diff $file1 $file2 > $filediff");
1352         }
1353
1354         while ( <$fh> )
1355         {
1356             print "M $_";
1357         }
1358         close $fh;
1359     }
1360
1361     print "ok\n";
1362 }
1363
1364 sub req_log
1365 {
1366     my ( $cmd, $data ) = @_;
1367
1368     argsplit("log");
1369
1370     $log->debug("req_log : " . ( defined($data) ? $data : "[NULL]" ));
1371     #$log->debug("log state : " . Dumper($state));
1372
1373     my ( $minrev, $maxrev );
1374     if ( defined ( $state->{opt}{r} ) and $state->{opt}{r} =~ /([\d.]+)?(::?)([\d.]+)?/ )
1375     {
1376         my $control = $2;
1377         $minrev = $1;
1378         $maxrev = $3;
1379         $minrev =~ s/^1\.// if ( defined ( $minrev ) );
1380         $maxrev =~ s/^1\.// if ( defined ( $maxrev ) );
1381         $minrev++ if ( defined($minrev) and $control eq "::" );
1382     }
1383
1384     # Grab a handle to the SQLite db and do any necessary updates
1385     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1386     $updater->update();
1387
1388     # if no files were specified, we need to work out what files we should be providing status on ...
1389     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1390
1391     # foreach file specified on the commandline ...
1392     foreach my $filename ( @{$state->{args}} )
1393     {
1394         $filename = filecleanup($filename);
1395
1396         my $headmeta = $updater->getmeta($filename);
1397
1398         my $revisions = $updater->getlog($filename);
1399         my $totalrevisions = scalar(@$revisions);
1400
1401         if ( defined ( $minrev ) )
1402         {
1403             $log->debug("Removing revisions less than $minrev");
1404             while ( scalar(@$revisions) > 0 and $revisions->[-1]{revision} < $minrev )
1405             {
1406                 pop @$revisions;
1407             }
1408         }
1409         if ( defined ( $maxrev ) )
1410         {
1411             $log->debug("Removing revisions greater than $maxrev");
1412             while ( scalar(@$revisions) > 0 and $revisions->[0]{revision} > $maxrev )
1413             {
1414                 shift @$revisions;
1415             }
1416         }
1417
1418         next unless ( scalar(@$revisions) );
1419
1420         print "M \n";
1421         print "M RCS file: $state->{CVSROOT}/$state->{module}/$filename,v\n";
1422         print "M Working file: $filename\n";
1423         print "M head: 1.$headmeta->{revision}\n";
1424         print "M branch:\n";
1425         print "M locks: strict\n";
1426         print "M access list:\n";
1427         print "M symbolic names:\n";
1428         print "M keyword substitution: kv\n";
1429         print "M total revisions: $totalrevisions;\tselected revisions: " . scalar(@$revisions) . "\n";
1430         print "M description:\n";
1431
1432         foreach my $revision ( @$revisions )
1433         {
1434             print "M ----------------------------\n";
1435             print "M revision 1.$revision->{revision}\n";
1436             # reformat the date for log output
1437             $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}) );
1438             $revision->{author} =~ s/\s+.*//;
1439             $revision->{author} =~ s/^(.{8}).*/$1/;
1440             print "M date: $revision->{modified};  author: $revision->{author};  state: " . ( $revision->{filehash} eq "deleted" ? "dead" : "Exp" ) . ";  lines: +2 -3\n";
1441             my $commitmessage = $updater->commitmessage($revision->{commithash});
1442             $commitmessage =~ s/^/M /mg;
1443             print $commitmessage . "\n";
1444         }
1445         print "M =============================================================================\n";
1446     }
1447
1448     print "ok\n";
1449 }
1450
1451 sub req_annotate
1452 {
1453     my ( $cmd, $data ) = @_;
1454
1455     argsplit("annotate");
1456
1457     $log->info("req_annotate : " . ( defined($data) ? $data : "[NULL]" ));
1458     #$log->debug("status state : " . Dumper($state));
1459
1460     # Grab a handle to the SQLite db and do any necessary updates
1461     my $updater = GITCVS::updater->new($state->{CVSROOT}, $state->{module}, $log);
1462     $updater->update();
1463
1464     # if no files were specified, we need to work out what files we should be providing annotate on ...
1465     argsfromdir($updater) if ( scalar ( @{$state->{args}} ) == 0 );
1466
1467     # we'll need a temporary checkout dir
1468     my $tmpdir = tempdir ( DIR => $TEMP_DIR );
1469     my ( undef, $file_index ) = tempfile ( DIR => $TEMP_DIR, OPEN => 0 );
1470     $log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");
1471
1472     $ENV{GIT_DIR} = $state->{CVSROOT} . "/";
1473     $ENV{GIT_INDEX_FILE} = $file_index;
1474
1475     chdir $tmpdir;
1476
1477     # foreach file specified on the commandline ...
1478     foreach my $filename ( @{$state->{args}} )
1479     {
1480         $filename = filecleanup($filename);
1481
1482         my $meta = $updater->getmeta($filename);
1483
1484         next unless ( $meta->{revision} );
1485
1486         # get all the commits that this file was in
1487         # in dense format -- aka skip dead revisions
1488         my $revisions   = $updater->gethistorydense($filename);
1489         my $lastseenin  = $revisions->[0][2];
1490
1491         # populate the temporary index based on the latest commit were we saw
1492         # the file -- but do it cheaply without checking out any files
1493         # TODO: if we got a revision from the client, use that instead
1494         # to look up the commithash in sqlite (still good to default to
1495         # the current head as we do now)
1496         system("git-read-tree", $lastseenin);
1497         unless ($? == 0)
1498         {
1499             die "Error running git-read-tree $lastseenin $file_index $!";
1500         }
1501         $log->info("Created index '$file_index' with commit $lastseenin - exit status $?");
1502
1503         # do a checkout of the file
1504         system('git-checkout-index', '-f', '-u', $filename);
1505         unless ($? == 0) {
1506             die "Error running git-checkout-index -f -u $filename : $!";
1507         }
1508
1509         $log->info("Annotate $filename");
1510
1511         # Prepare a file with the commits from the linearized
1512         # history that annotate should know about. This prevents
1513         # git-jsannotate telling us about commits we are hiding
1514         # from the client.
1515
1516         open(ANNOTATEHINTS, ">$tmpdir/.annotate_hints") or die "Error opening > $tmpdir/.annotate_hints $!";
1517         for (my $i=0; $i < @$revisions; $i++)
1518         {
1519             print ANNOTATEHINTS $revisions->[$i][2];
1520             if ($i+1 < @$revisions) { # have we got a parent?
1521                 print ANNOTATEHINTS ' ' . $revisions->[$i+1][2];
1522             }
1523             print ANNOTATEHINTS "\n";
1524         }
1525
1526         print ANNOTATEHINTS "\n";
1527         close ANNOTATEHINTS;
1528
1529         my $annotatecmd = 'git-annotate';
1530         open(ANNOTATE, "-|", $annotatecmd, '-l', '-S', "$tmpdir/.annotate_hints", $filename)
1531             or die "Error invoking $annotatecmd -l -S $tmpdir/.annotate_hints $filename : $!";
1532         my $metadata = {};
1533         print "E Annotations for $filename\n";
1534         print "E ***************\n";
1535         while ( <ANNOTATE> )
1536         {
1537             if (m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)
1538             {
1539                 my $commithash = $1;
1540                 my $data = $2;
1541                 unless ( defined ( $metadata->{$commithash} ) )
1542                 {
1543                     $metadata->{$commithash} = $updater->getmeta($filename, $commithash);
1544                     $metadata->{$commithash}{author} =~ s/\s+.*//;
1545                     $metadata->{$commithash}{author} =~ s/^(.{8}).*/$1/;
1546                     $metadata->{$commithash}{modified} = sprintf("%02d-%s-%02d", $1, $2, $3) if ( $metadata->{$commithash}{modified} =~ /^(\d+)\s(\w+)\s\d\d(\d\d)/ );
1547                 }
1548                 printf("M 1.%-5d      (%-8s %10s): %s\n",
1549                     $metadata->{$commithash}{revision},
1550                     $metadata->{$commithash}{author},
1551                     $metadata->{$commithash}{modified},
1552                     $data
1553                 );
1554             } else {
1555                 $log->warn("Error in annotate output! LINE: $_");
1556                 print "E Annotate error \n";
1557                 next;
1558             }
1559         }
1560         close ANNOTATE;
1561     }
1562
1563     # done; get out of the tempdir
1564     chdir "/";
1565
1566     print "ok\n";
1567
1568 }
1569
1570 # This method takes the state->{arguments} array and produces two new arrays.
1571 # The first is $state->{args} which is everything before the '--' argument, and
1572 # the second is $state->{files} which is everything after it.
1573 sub argsplit
1574 {
1575     return unless( defined($state->{arguments}) and ref $state->{arguments} eq "ARRAY" );
1576
1577     my $type = shift;
1578
1579     $state->{args} = [];
1580     $state->{files} = [];
1581     $state->{opt} = {};
1582
1583     if ( defined($type) )
1584     {
1585         my $opt = {};
1586         $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" );
1587         $opt = { v => 0, l => 0, R => 0 } if ( $type eq "status" );
1588         $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" );
1589         $opt = { l => 0, R => 0, k => 1, D => 1, D => 1, r => 2 } if ( $type eq "diff" );
1590         $opt = { c => 0, R => 0, l => 0, f => 0, F => 1, m => 1, r => 1 } if ( $type eq "ci" );
1591         $opt = { k => 1, m => 1 } if ( $type eq "add" );
1592         $opt = { f => 0, l => 0, R => 0 } if ( $type eq "remove" );
1593         $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" );
1594
1595
1596         while ( scalar ( @{$state->{arguments}} ) > 0 )
1597         {
1598             my $arg = shift @{$state->{arguments}};
1599
1600             next if ( $arg eq "--" );
1601             next unless ( $arg =~ /\S/ );
1602
1603             # if the argument looks like a switch
1604             if ( $arg =~ /^-(\w)(.*)/ )
1605             {
1606                 # if it's a switch that takes an argument
1607                 if ( $opt->{$1} )
1608                 {
1609                     # If this switch has already been provided
1610                     if ( $opt->{$1} > 1 and exists ( $state->{opt}{$1} ) )
1611                     {
1612                         $state->{opt}{$1} = [ $state->{opt}{$1} ];
1613                         if ( length($2) > 0 )
1614                         {
1615                             push @{$state->{opt}{$1}},$2;
1616                         } else {
1617                             push @{$state->{opt}{$1}}, shift @{$state->{arguments}};
1618                         }
1619                     } else {
1620                         # if there's extra data in the arg, use that as the argument for the switch
1621                         if ( length($2) > 0 )
1622                         {
1623                             $state->{opt}{$1} = $2;
1624                         } else {
1625                             $state->{opt}{$1} = shift @{$state->{arguments}};
1626                         }
1627                     }
1628                 } else {
1629                     $state->{opt}{$1} = undef;
1630                 }
1631             }
1632             else
1633             {
1634                 push @{$state->{args}}, $arg;
1635             }
1636         }
1637     }
1638     else
1639     {
1640         my $mode = 0;
1641
1642         foreach my $value ( @{$state->{arguments}} )
1643         {
1644             if ( $value eq "--" )
1645             {
1646                 $mode++;
1647                 next;
1648             }
1649             push @{$state->{args}}, $value if ( $mode == 0 );
1650             push @{$state->{files}}, $value if ( $mode == 1 );
1651         }
1652     }
1653 }
1654
1655 # This method uses $state->{directory} to populate $state->{args} with a list of filenames
1656 sub argsfromdir
1657 {
1658     my $updater = shift;
1659
1660     $state->{args} = [];
1661
1662     foreach my $file ( @{$updater->gethead} )
1663     {
1664         next if ( $file->{filehash} eq "deleted" and not defined ( $state->{entries}{$file->{name}} ) );
1665         next unless ( $file->{name} =~ s/^$state->{directory}// );
1666         push @{$state->{args}}, $file->{name};
1667     }
1668 }
1669
1670 # This method cleans up the $state variable after a command that uses arguments has run
1671 sub statecleanup
1672 {
1673     $state->{files} = [];
1674     $state->{args} = [];
1675     $state->{arguments} = [];
1676     $state->{entries} = {};
1677 }
1678
1679 sub revparse
1680 {
1681     my $filename = shift;
1682
1683     return undef unless ( defined ( $state->{entries}{$filename}{revision} ) );
1684
1685     return $1 if ( $state->{entries}{$filename}{revision} =~ /^1\.(\d+)/ );
1686     return -$1 if ( $state->{entries}{$filename}{revision} =~ /^-1\.(\d+)/ );
1687
1688     return undef;
1689 }
1690
1691 # This method takes a file hash and does a CVS "file transfer" which transmits the
1692 # size of the file, and then the file contents.
1693 # If a second argument $targetfile is given, the file is instead written out to
1694 # a file by the name of $targetfile
1695 sub transmitfile
1696 {
1697     my $filehash = shift;
1698     my $targetfile = shift;
1699
1700     if ( defined ( $filehash ) and $filehash eq "deleted" )
1701     {
1702         $log->warn("filehash is 'deleted'");
1703         return;
1704     }
1705
1706     die "Need filehash" unless ( defined ( $filehash ) and $filehash =~ /^[a-zA-Z0-9]{40}$/ );
1707
1708     my $type = `git-cat-file -t $filehash`;
1709     chomp $type;
1710
1711     die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ( $type ) and $type eq "blob" );
1712
1713     my $size = `git-cat-file -s $filehash`;
1714     chomp $size;
1715
1716     $log->debug("transmitfile($filehash) size=$size, type=$type");
1717
1718     if ( open my $fh, '-|', "git-cat-file", "blob", $filehash )
1719     {
1720         if ( defined ( $targetfile ) )
1721         {
1722             open NEWFILE, ">", $targetfile or die("Couldn't open '$targetfile' for writing : $!");
1723             print NEWFILE $_ while ( <$fh> );
1724             close NEWFILE;
1725         } else {
1726             print "$size\n";
1727             print while ( <$fh> );
1728         }
1729         close $fh or die ("Couldn't close filehandle for transmitfile()");
1730     } else {
1731         die("Couldn't execute git-cat-file");
1732     }
1733 }
1734
1735 # This method takes a file name, and returns ( $dirpart, $filepart ) which
1736 # refers to the directory portion and the file portion of the filename
1737 # respectively
1738 sub filenamesplit
1739 {
1740     my $filename = shift;
1741
1742     my ( $filepart, $dirpart ) = ( $filename, "." );
1743     ( $filepart, $dirpart ) = ( $2, $1 ) if ( $filename =~ /(.*)\/(.*)/ );
1744     $dirpart .= "/";
1745
1746     return ( $filepart, $dirpart );
1747 }
1748
1749 sub filecleanup
1750 {
1751     my $filename = shift;
1752
1753     return undef unless(defined($filename));
1754     if ( $filename =~ /^\// )
1755     {
1756         print "E absolute filenames '$filename' not supported by server\n";
1757         return undef;
1758     }
1759
1760     $filename =~ s/^\.\///g;
1761     $filename = $state->{directory} . $filename;
1762
1763     return $filename;
1764 }
1765
1766 package GITCVS::log;
1767
1768 ####
1769 #### Copyright The Open University UK - 2006.
1770 ####
1771 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
1772 ####          Martin Langhoff <martin@catalyst.net.nz>
1773 ####
1774 ####
1775
1776 use strict;
1777 use warnings;
1778
1779 =head1 NAME
1780
1781 GITCVS::log
1782
1783 =head1 DESCRIPTION
1784
1785 This module provides very crude logging with a similar interface to
1786 Log::Log4perl
1787
1788 =head1 METHODS
1789
1790 =cut
1791
1792 =head2 new
1793
1794 Creates a new log object, optionally you can specify a filename here to
1795 indicate the file to log to. If no log file is specified, you can specify one
1796 later with method setfile, or indicate you no longer want logging with method
1797 nofile.
1798
1799 Until one of these methods is called, all log calls will buffer messages ready
1800 to write out.
1801
1802 =cut
1803 sub new
1804 {
1805     my $class = shift;
1806     my $filename = shift;
1807
1808     my $self = {};
1809
1810     bless $self, $class;
1811
1812     if ( defined ( $filename ) )
1813     {
1814         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1815     }
1816
1817     return $self;
1818 }
1819
1820 =head2 setfile
1821
1822 This methods takes a filename, and attempts to open that file as the log file.
1823 If successful, all buffered data is written out to the file, and any further
1824 logging is written directly to the file.
1825
1826 =cut
1827 sub setfile
1828 {
1829     my $self = shift;
1830     my $filename = shift;
1831
1832     if ( defined ( $filename ) )
1833     {
1834         open $self->{fh}, ">>", $filename or die("Couldn't open '$filename' for writing : $!");
1835     }
1836
1837     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1838
1839     while ( my $line = shift @{$self->{buffer}} )
1840     {
1841         print {$self->{fh}} $line;
1842     }
1843 }
1844
1845 =head2 nofile
1846
1847 This method indicates no logging is going to be used. It flushes any entries in
1848 the internal buffer, and sets a flag to ensure no further data is put there.
1849
1850 =cut
1851 sub nofile
1852 {
1853     my $self = shift;
1854
1855     $self->{nolog} = 1;
1856
1857     return unless ( defined ( $self->{buffer} ) and ref $self->{buffer} eq "ARRAY" );
1858
1859     $self->{buffer} = [];
1860 }
1861
1862 =head2 _logopen
1863
1864 Internal method. Returns true if the log file is open, false otherwise.
1865
1866 =cut
1867 sub _logopen
1868 {
1869     my $self = shift;
1870
1871     return 1 if ( defined ( $self->{fh} ) and ref $self->{fh} eq "GLOB" );
1872     return 0;
1873 }
1874
1875 =head2 debug info warn fatal
1876
1877 These four methods are wrappers to _log. They provide the actual interface for
1878 logging data.
1879
1880 =cut
1881 sub debug { my $self = shift; $self->_log("debug", @_); }
1882 sub info  { my $self = shift; $self->_log("info" , @_); }
1883 sub warn  { my $self = shift; $self->_log("warn" , @_); }
1884 sub fatal { my $self = shift; $self->_log("fatal", @_); }
1885
1886 =head2 _log
1887
1888 This is an internal method called by the logging functions. It generates a
1889 timestamp and pushes the logged line either to file, or internal buffer.
1890
1891 =cut
1892 sub _log
1893 {
1894     my $self = shift;
1895     my $level = shift;
1896
1897     return if ( $self->{nolog} );
1898
1899     my @time = localtime;
1900     my $timestring = sprintf("%4d-%02d-%02d %02d:%02d:%02d : %-5s",
1901         $time[5] + 1900,
1902         $time[4] + 1,
1903         $time[3],
1904         $time[2],
1905         $time[1],
1906         $time[0],
1907         uc $level,
1908     );
1909
1910     if ( $self->_logopen )
1911     {
1912         print {$self->{fh}} $timestring . " - " . join(" ",@_) . "\n";
1913     } else {
1914         push @{$self->{buffer}}, $timestring . " - " . join(" ",@_) . "\n";
1915     }
1916 }
1917
1918 =head2 DESTROY
1919
1920 This method simply closes the file handle if one is open
1921
1922 =cut
1923 sub DESTROY
1924 {
1925     my $self = shift;
1926
1927     if ( $self->_logopen )
1928     {
1929         close $self->{fh};
1930     }
1931 }
1932
1933 package GITCVS::updater;
1934
1935 ####
1936 #### Copyright The Open University UK - 2006.
1937 ####
1938 #### Authors: Martyn Smith    <martyn@catalyst.net.nz>
1939 ####          Martin Langhoff <martin@catalyst.net.nz>
1940 ####
1941 ####
1942
1943 use strict;
1944 use warnings;
1945 use DBI;
1946
1947 =head1 METHODS
1948
1949 =cut
1950
1951 =head2 new
1952
1953 =cut
1954 sub new
1955 {
1956     my $class = shift;
1957     my $config = shift;
1958     my $module = shift;
1959     my $log = shift;
1960
1961     die "Need to specify a git repository" unless ( defined($config) and -d $config );
1962     die "Need to specify a module" unless ( defined($module) );
1963
1964     $class = ref($class) || $class;
1965
1966     my $self = {};
1967
1968     bless $self, $class;
1969
1970     $self->{dbdir} = $config . "/";
1971     die "Database dir '$self->{dbdir}' isn't a directory" unless ( defined($self->{dbdir}) and -d $self->{dbdir} );
1972
1973     $self->{module} = $module;
1974     $self->{file} = $self->{dbdir} . "/gitcvs.$module.sqlite";
1975
1976     $self->{git_path} = $config . "/";
1977
1978     $self->{log} = $log;
1979
1980     die "Git repo '$self->{git_path}' doesn't exist" unless ( -d $self->{git_path} );
1981
1982     $self->{dbh} = DBI->connect("dbi:SQLite:dbname=" . $self->{file},"","");
1983
1984     $self->{tables} = {};
1985     foreach my $table ( $self->{dbh}->tables )
1986     {
1987         $table =~ s/^"//;
1988         $table =~ s/"$//;
1989         $self->{tables}{$table} = 1;
1990     }
1991
1992     # Construct the revision table if required
1993     unless ( $self->{tables}{revision} )
1994     {
1995         $self->{dbh}->do("
1996             CREATE TABLE revision (
1997                 name       TEXT NOT NULL,
1998                 revision   INTEGER NOT NULL,
1999                 filehash   TEXT NOT NULL,
2000                 commithash TEXT NOT NULL,
2001                 author     TEXT NOT NULL,
2002                 modified   TEXT NOT NULL,
2003                 mode       TEXT NOT NULL
2004             )
2005         ");
2006     }
2007
2008     # Construct the revision table if required
2009     unless ( $self->{tables}{head} )
2010     {
2011         $self->{dbh}->do("
2012             CREATE TABLE head (
2013                 name       TEXT NOT NULL,
2014                 revision   INTEGER NOT NULL,
2015                 filehash   TEXT NOT NULL,
2016                 commithash TEXT NOT NULL,
2017                 author     TEXT NOT NULL,
2018                 modified   TEXT NOT NULL,
2019                 mode       TEXT NOT NULL
2020             )
2021         ");
2022     }
2023
2024     # Construct the properties table if required
2025     unless ( $self->{tables}{properties} )
2026     {
2027         $self->{dbh}->do("
2028             CREATE TABLE properties (
2029                 key        TEXT NOT NULL PRIMARY KEY,
2030                 value      TEXT
2031             )
2032         ");
2033     }
2034
2035     # Construct the commitmsgs table if required
2036     unless ( $self->{tables}{commitmsgs} )
2037     {
2038         $self->{dbh}->do("
2039             CREATE TABLE commitmsgs (
2040                 key        TEXT NOT NULL PRIMARY KEY,
2041                 value      TEXT
2042             )
2043         ");
2044     }
2045
2046     return $self;
2047 }
2048
2049 =head2 update
2050
2051 =cut
2052 sub update
2053 {
2054     my $self = shift;
2055
2056     # first lets get the commit list
2057     $ENV{GIT_DIR} = $self->{git_path};
2058
2059     # prepare database queries
2060     my $db_insert_rev = $self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2061     my $db_insert_mergelog = $self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);
2062     my $db_delete_head = $self->{dbh}->prepare_cached("DELETE FROM head",{},1);
2063     my $db_insert_head = $self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);
2064
2065     my $commitinfo = `git-cat-file commit $self->{module} 2>&1`;
2066     unless ( $commitinfo =~ /tree\s+[a-zA-Z0-9]{40}/ )
2067     {
2068         die("Invalid module '$self->{module}'");
2069     }
2070
2071
2072     my $git_log;
2073     my $lastcommit = $self->_get_prop("last_commit");
2074
2075     # Start exclusive lock here...
2076     $self->{dbh}->begin_work() or die "Cannot lock database for BEGIN";
2077
2078     # TODO: log processing is memory bound
2079     # if we can parse into a 2nd file that is in reverse order
2080     # we can probably do something really efficient
2081     my @git_log_params = ('--pretty', '--parents', '--topo-order');
2082
2083     if (defined $lastcommit) {
2084         push @git_log_params, "$lastcommit..$self->{module}";
2085     } else {
2086         push @git_log_params, $self->{module};
2087     }
2088     # git-rev-list is the backend / plumbing version of git-log
2089     open(GITLOG, '-|', 'git-rev-list', @git_log_params) or die "Cannot call git-rev-list: $!";
2090
2091     my @commits;
2092
2093     my %commit = ();
2094
2095     while ( <GITLOG> )
2096     {
2097         chomp;
2098         if (m/^commit\s+(.*)$/) {
2099             # on ^commit lines put the just seen commit in the stack
2100             # and prime things for the next one
2101             if (keys %commit) {
2102                 my %copy = %commit;
2103                 unshift @commits, \%copy;
2104                 %commit = ();
2105             }
2106             my @parents = split(m/\s+/, $1);
2107             $commit{hash} = shift @parents;
2108             $commit{parents} = \@parents;
2109         } elsif (m/^(\w+?):\s+(.*)$/ && !exists($commit{message})) {
2110             # on rfc822-like lines seen before we see any message,
2111             # lowercase the entry and put it in the hash as key-value
2112             $commit{lc($1)} = $2;
2113         } else {
2114             # message lines - skip initial empty line
2115             # and trim whitespace
2116             if (!exists($commit{message}) && m/^\s*$/) {
2117                 # define it to mark the end of headers
2118                 $commit{message} = '';
2119                 next;
2120             }
2121             s/^\s+//; s/\s+$//; # trim ws
2122             $commit{message} .= $_ . "\n";
2123         }
2124     }
2125     close GITLOG;
2126
2127     unshift @commits, \%commit if ( keys %commit );
2128
2129     # Now all the commits are in the @commits bucket
2130     # ordered by time DESC. for each commit that needs processing,
2131     # determine whether it's following the last head we've seen or if
2132     # it's on its own branch, grab a file list, and add whatever's changed
2133     # NOTE: $lastcommit refers to the last commit from previous run
2134     #       $lastpicked is the last commit we picked in this run
2135     my $lastpicked;
2136     my $head = {};
2137     if (defined $lastcommit) {
2138         $lastpicked = $lastcommit;
2139     }
2140
2141     my $committotal = scalar(@commits);
2142     my $commitcount = 0;
2143
2144     # Load the head table into $head (for cached lookups during the update process)
2145     foreach my $file ( @{$self->gethead()} )
2146     {
2147         $head->{$file->{name}} = $file;
2148     }
2149
2150     foreach my $commit ( @commits )
2151     {
2152         $self->{log}->debug("GITCVS::updater - Processing commit $commit->{hash} (" . (++$commitcount) . " of $committotal)");
2153         if (defined $lastpicked)
2154         {
2155             if (!in_array($lastpicked, @{$commit->{parents}}))
2156             {
2157                 # skip, we'll see this delta
2158                 # as part of a merge later
2159                 # warn "skipping off-track  $commit->{hash}\n";
2160                 next;
2161             } elsif (@{$commit->{parents}} > 1) {
2162                 # it is a merge commit, for each parent that is
2163                 # not $lastpicked, see if we can get a log
2164                 # from the merge-base to that parent to put it
2165                 # in the message as a merge summary.
2166                 my @parents = @{$commit->{parents}};
2167                 foreach my $parent (@parents) {
2168                     # git-merge-base can potentially (but rarely) throw
2169                     # several candidate merge bases. let's assume
2170                     # that the first one is the best one.
2171                     if ($parent eq $lastpicked) {
2172                         next;
2173                     }
2174                     open my $p, 'git-merge-base '. $lastpicked . ' '
2175                     . $parent . '|';
2176                     my @output = (<$p>);
2177                     close $p;
2178                     my $base = join('', @output);
2179                     chomp $base;
2180                     if ($base) {
2181                         my @merged;
2182                         # print "want to log between  $base $parent \n";
2183                         open(GITLOG, '-|', 'git-log', "$base..$parent")
2184                         or die "Cannot call git-log: $!";
2185                         my $mergedhash;
2186                         while (<GITLOG>) {
2187                             chomp;
2188                             if (!defined $mergedhash) {
2189                                 if (m/^commit\s+(.+)$/) {
2190                                     $mergedhash = $1;
2191                                 } else {
2192                                     next;
2193                                 }
2194                             } else {
2195                                 # grab the first line that looks non-rfc822
2196                                 # aka has content after leading space
2197                                 if (m/^\s+(\S.*)$/) {
2198                                     my $title = $1;
2199                                     $title = substr($title,0,100); # truncate
2200                                     unshift @merged, "$mergedhash $title";
2201                                     undef $mergedhash;
2202                                 }
2203                             }
2204                         }
2205                         close GITLOG;
2206                         if (@merged) {
2207                             $commit->{mergemsg} = $commit->{message};
2208                             $commit->{mergemsg} .= "\nSummary of merged commits:\n\n";
2209                             foreach my $summary (@merged) {
2210                                 $commit->{mergemsg} .= "\t$summary\n";
2211                             }
2212                             $commit->{mergemsg} .= "\n\n";
2213                             # print "Message for $commit->{hash} \n$commit->{mergemsg}";
2214                         }
2215                     }
2216                 }
2217             }
2218         }
2219
2220         # convert the date to CVS-happy format
2221         $commit->{date} = "$2 $1 $4 $3 $5" if ( $commit->{date} =~ /^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/ );
2222
2223         if ( defined ( $lastpicked ) )
2224         {
2225             my $filepipe = open(FILELIST, '-|', 'git-diff-tree', '-r', $lastpicked, $commit->{hash}) or die("Cannot call git-diff-tree : $!");
2226             while ( <FILELIST> )
2227             {
2228                 unless ( /^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)\s+(.*)$/o )
2229                 {
2230                     die("Couldn't process git-diff-tree line : $_");
2231                 }
2232
2233                 # $log->debug("File mode=$1, hash=$2, change=$3, name=$4");
2234
2235                 my $git_perms = "";
2236                 $git_perms .= "r" if ( $1 & 4 );
2237                 $git_perms .= "w" if ( $1 & 2 );
2238                 $git_perms .= "x" if ( $1 & 1 );
2239                 $git_perms = "rw" if ( $git_perms eq "" );
2240
2241                 if ( $3 eq "D" )
2242                 {
2243                     #$log->debug("DELETE   $4");
2244                     $head->{$4} = {
2245                         name => $4,
2246                         revision => $head->{$4}{revision} + 1,
2247                         filehash => "deleted",
2248                         commithash => $commit->{hash},
2249                         modified => $commit->{date},
2250                         author => $commit->{author},
2251                         mode => $git_perms,
2252                     };
2253                     $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2254                 }
2255                 elsif ( $3 eq "M" )
2256                 {
2257                     #$log->debug("MODIFIED $4");
2258                     $head->{$4} = {
2259                         name => $4,
2260                         revision => $head->{$4}{revision} + 1,
2261                         filehash => $2,
2262                         commithash => $commit->{hash},
2263                         modified => $commit->{date},
2264                         author => $commit->{author},
2265                         mode => $git_perms,
2266                     };
2267                     $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2268                 }
2269                 elsif ( $3 eq "A" )
2270                 {
2271                     #$log->debug("ADDED    $4");
2272                     $head->{$4} = {
2273                         name => $4,
2274                         revision => 1,
2275                         filehash => $2,
2276                         commithash => $commit->{hash},
2277                         modified => $commit->{date},
2278                         author => $commit->{author},
2279                         mode => $git_perms,
2280                     };
2281                     $db_insert_rev->execute($4, $head->{$4}{revision}, $2, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2282                 }
2283                 else
2284                 {
2285                     $log->warn("UNKNOWN FILE CHANGE mode=$1, hash=$2, change=$3, name=$4");
2286                     die;
2287                 }
2288             }
2289             close FILELIST;
2290         } else {
2291             # this is used to detect files removed from the repo
2292             my $seen_files = {};
2293
2294             my $filepipe = open(FILELIST, '-|', 'git-ls-tree', '-r', $commit->{hash}) or die("Cannot call git-ls-tree : $!");
2295             while ( <FILELIST> )
2296             {
2297                 unless ( /^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\s+(.*)$/o )
2298                 {
2299                     die("Couldn't process git-ls-tree line : $_");
2300                 }
2301
2302                 my ( $git_perms, $git_type, $git_hash, $git_filename ) = ( $1, $2, $3, $4 );
2303
2304                 $seen_files->{$git_filename} = 1;
2305
2306                 my ( $oldhash, $oldrevision, $oldmode ) = (
2307                     $head->{$git_filename}{filehash},
2308                     $head->{$git_filename}{revision},
2309                     $head->{$git_filename}{mode}
2310                 );
2311
2312                 if ( $git_perms =~ /^\d\d\d(\d)\d\d/o )
2313                 {
2314                     $git_perms = "";
2315                     $git_perms .= "r" if ( $1 & 4 );
2316                     $git_perms .= "w" if ( $1 & 2 );
2317                     $git_perms .= "x" if ( $1 & 1 );
2318                 } else {
2319                     $git_perms = "rw";
2320                 }
2321
2322                 # unless the file exists with the same hash, we need to update it ...
2323                 unless ( defined($oldhash) and $oldhash eq $git_hash and defined($oldmode) and $oldmode eq $git_perms )
2324                 {
2325                     my $newrevision = ( $oldrevision or 0 ) + 1;
2326
2327                     $head->{$git_filename} = {
2328                         name => $git_filename,
2329                         revision => $newrevision,
2330                         filehash => $git_hash,
2331                         commithash => $commit->{hash},
2332                         modified => $commit->{date},
2333                         author => $commit->{author},
2334                         mode => $git_perms,
2335                     };
2336
2337
2338                     $db_insert_rev->execute($git_filename, $newrevision, $git_hash, $commit->{hash}, $commit->{date}, $commit->{author}, $git_perms);
2339                 }
2340             }
2341             close FILELIST;
2342
2343             # Detect deleted files
2344             foreach my $file ( keys %$head )
2345             {
2346                 unless ( exists $seen_files->{$file} or $head->{$file}{filehash} eq "deleted" )
2347                 {
2348                     $head->{$file}{revision}++;
2349                     $head->{$file}{filehash} = "deleted";
2350                     $head->{$file}{commithash} = $commit->{hash};
2351                     $head->{$file}{modified} = $commit->{date};
2352                     $head->{$file}{author} = $commit->{author};
2353
2354                     $db_insert_rev->execute($file, $head->{$file}{revision}, $head->{$file}{filehash}, $commit->{hash}, $commit->{date}, $commit->{author}, $head->{$file}{mode});
2355                 }
2356             }
2357             # END : "Detect deleted files"
2358         }
2359
2360
2361         if (exists $commit->{mergemsg})
2362         {
2363             $db_insert_mergelog->execute($commit->{hash}, $commit->{mergemsg});
2364         }
2365
2366         $lastpicked = $commit->{hash};
2367
2368         $self->_set_prop("last_commit", $commit->{hash});
2369     }
2370
2371     $db_delete_head->execute();
2372     foreach my $file ( keys %$head )
2373     {
2374         $db_insert_head->execute(
2375             $file,
2376             $head->{$file}{revision},
2377             $head->{$file}{filehash},
2378             $head->{$file}{commithash},
2379             $head->{$file}{modified},
2380             $head->{$file}{author},
2381             $head->{$file}{mode},
2382         );
2383     }
2384     # invalidate the gethead cache
2385     $self->{gethead_cache} = undef;
2386
2387
2388     # Ending exclusive lock here
2389     $self->{dbh}->commit() or die "Failed to commit changes to SQLite";
2390 }
2391
2392 sub _headrev
2393 {
2394     my $self = shift;
2395     my $filename = shift;
2396
2397     my $db_query = $self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);
2398     $db_query->execute($filename);
2399     my ( $hash, $revision, $mode ) = $db_query->fetchrow_array;
2400
2401     return ( $hash, $revision, $mode );
2402 }
2403
2404 sub _get_prop
2405 {
2406     my $self = shift;
2407     my $key = shift;
2408
2409     my $db_query = $self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);
2410     $db_query->execute($key);
2411     my ( $value ) = $db_query->fetchrow_array;
2412
2413     return $value;
2414 }
2415
2416 sub _set_prop
2417 {
2418     my $self = shift;
2419     my $key = shift;
2420     my $value = shift;
2421
2422     my $db_query = $self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);
2423     $db_query->execute($value, $key);
2424
2425     unless ( $db_query->rows )
2426     {
2427         $db_query = $self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);
2428         $db_query->execute($key, $value);
2429     }
2430
2431     return $value;
2432 }
2433
2434 =head2 gethead
2435
2436 =cut
2437
2438 sub gethead
2439 {
2440     my $self = shift;
2441
2442     return $self->{gethead_cache} if ( defined ( $self->{gethead_cache} ) );
2443
2444     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);
2445     $db_query->execute();
2446
2447     my $tree = [];
2448     while ( my $file = $db_query->fetchrow_hashref )
2449     {
2450         push @$tree, $file;
2451     }
2452
2453     $self->{gethead_cache} = $tree;
2454
2455     return $tree;
2456 }
2457
2458 =head2 getlog
2459
2460 =cut
2461
2462 sub getlog
2463 {
2464     my $self = shift;
2465     my $filename = shift;
2466
2467     my $db_query = $self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2468     $db_query->execute($filename);
2469
2470     my $tree = [];
2471     while ( my $file = $db_query->fetchrow_hashref )
2472     {
2473         push @$tree, $file;
2474     }
2475
2476     return $tree;
2477 }
2478
2479 =head2 getmeta
2480
2481 This function takes a filename (with path) argument and returns a hashref of
2482 metadata for that file.
2483
2484 =cut
2485
2486 sub getmeta
2487 {
2488     my $self = shift;
2489     my $filename = shift;
2490     my $revision = shift;
2491
2492     my $db_query;
2493     if ( defined($revision) and $revision =~ /^\d+$/ )
2494     {
2495         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);
2496         $db_query->execute($filename, $revision);
2497     }
2498     elsif ( defined($revision) and $revision =~ /^[a-zA-Z0-9]{40}$/ )
2499     {
2500         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);
2501         $db_query->execute($filename, $revision);
2502     } else {
2503         $db_query = $self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);
2504         $db_query->execute($filename);
2505     }
2506
2507     return $db_query->fetchrow_hashref;
2508 }
2509
2510 =head2 commitmessage
2511
2512 this function takes a commithash and returns the commit message for that commit
2513
2514 =cut
2515 sub commitmessage
2516 {
2517     my $self = shift;
2518     my $commithash = shift;
2519
2520     die("Need commithash") unless ( defined($commithash) and $commithash =~ /^[a-zA-Z0-9]{40}$/ );
2521
2522     my $db_query;
2523     $db_query = $self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);
2524     $db_query->execute($commithash);
2525
2526     my ( $message ) = $db_query->fetchrow_array;
2527
2528     if ( defined ( $message ) )
2529     {
2530         $message .= " " if ( $message =~ /\n$/ );
2531         return $message;
2532     }
2533
2534     my @lines = safe_pipe_capture("git-cat-file", "commit", $commithash);
2535     shift @lines while ( $lines[0] =~ /\S/ );
2536     $message = join("",@lines);
2537     $message .= " " if ( $message =~ /\n$/ );
2538     return $message;
2539 }
2540
2541 =head2 gethistory
2542
2543 This function takes a filename (with path) argument and returns an arrayofarrays
2544 containing revision,filehash,commithash ordered by revision descending
2545
2546 =cut
2547 sub gethistory
2548 {
2549     my $self = shift;
2550     my $filename = shift;
2551
2552     my $db_query;
2553     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);
2554     $db_query->execute($filename);
2555
2556     return $db_query->fetchall_arrayref;
2557 }
2558
2559 =head2 gethistorydense
2560
2561 This function takes a filename (with path) argument and returns an arrayofarrays
2562 containing revision,filehash,commithash ordered by revision descending.
2563
2564 This version of gethistory skips deleted entries -- so it is useful for annotate.
2565 The 'dense' part is a reference to a '--dense' option available for git-rev-list
2566 and other git tools that depend on it.
2567
2568 =cut
2569 sub gethistorydense
2570 {
2571     my $self = shift;
2572     my $filename = shift;
2573
2574     my $db_query;
2575     $db_query = $self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);
2576     $db_query->execute($filename);
2577
2578     return $db_query->fetchall_arrayref;
2579 }
2580
2581 =head2 in_array()
2582
2583 from Array::PAT - mimics the in_array() function
2584 found in PHP. Yuck but works for small arrays.
2585
2586 =cut
2587 sub in_array
2588 {
2589     my ($check, @array) = @_;
2590     my $retval = 0;
2591     foreach my $test (@array){
2592         if($check eq $test){
2593             $retval =  1;
2594         }
2595     }
2596     return $retval;
2597 }
2598
2599 =head2 safe_pipe_capture
2600
2601 an alternative to `command` that allows input to be passed as an array
2602 to work around shell problems with weird characters in arguments
2603
2604 =cut
2605 sub safe_pipe_capture {
2606
2607     my @output;
2608
2609     if (my $pid = open my $child, '-|') {
2610         @output = (<$child>);
2611         close $child or die join(' ',@_).": $! $?";
2612     } else {
2613         exec(@_) or die "$! $?"; # exec() can fail the executable can't be found
2614     }
2615     return wantarray ? @output : join('',@output);
2616 }
2617
2618
2619 1;