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