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 18use strict; 19use warnings; 20use bytes; 21 22use Fcntl; 23use File::Temp qw/tempdir tempfile/; 24use File::Basename; 25 26my$log= GITCVS::log->new(); 27my$cfg; 28 29my$DATE_LIST= { 30 Jan =>"01", 31 Feb =>"02", 32 Mar =>"03", 33 Apr =>"04", 34 May =>"05", 35 Jun =>"06", 36 Jul =>"07", 37 Aug =>"08", 38 Sep =>"09", 39 Oct =>"10", 40 Nov =>"11", 41 Dec =>"12", 42}; 43 44# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 45$| =1; 46 47#### Definition and mappings of functions #### 48 49my$methods= { 50'Root'=> \&req_Root, 51'Valid-responses'=> \&req_Validresponses, 52'valid-requests'=> \&req_validrequests, 53'Directory'=> \&req_Directory, 54'Entry'=> \&req_Entry, 55'Modified'=> \&req_Modified, 56'Unchanged'=> \&req_Unchanged, 57'Questionable'=> \&req_Questionable, 58'Argument'=> \&req_Argument, 59'Argumentx'=> \&req_Argument, 60'expand-modules'=> \&req_expandmodules, 61'add'=> \&req_add, 62'remove'=> \&req_remove, 63'co'=> \&req_co, 64'update'=> \&req_update, 65'ci'=> \&req_ci, 66'diff'=> \&req_diff, 67'log'=> \&req_log, 68'rlog'=> \&req_log, 69'tag'=> \&req_CATCHALL, 70'status'=> \&req_status, 71'admin'=> \&req_CATCHALL, 72'history'=> \&req_CATCHALL, 73'watchers'=> \&req_CATCHALL, 74'editors'=> \&req_CATCHALL, 75'annotate'=> \&req_annotate, 76'Global_option'=> \&req_Globaloption, 77#'annotate' => \&req_CATCHALL, 78}; 79 80############################################## 81 82 83# $state holds all the bits of information the clients sends us that could 84# potentially be useful when it comes to actually _doing_ something. 85my$state= { prependdir =>''}; 86$log->info("--------------- STARTING -----------------"); 87 88my$TEMP_DIR= tempdir( CLEANUP =>1); 89$log->debug("Temporary directory is '$TEMP_DIR'"); 90 91# if we are called with a pserver argument, 92# deal with the authentication cat before entering the 93# main loop 94$state->{method} ='ext'; 95if(@ARGV&&$ARGV[0]eq'pserver') { 96$state->{method} ='pserver'; 97my$line= <STDIN>;chomp$line; 98unless($lineeq'BEGIN AUTH REQUEST') { 99die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 100} 101$line= <STDIN>;chomp$line; 102 req_Root('root',$line)# reuse Root 103or die"E Invalid root$line\n"; 104$line= <STDIN>;chomp$line; 105unless($lineeq'anonymous') { 106print"E Only anonymous user allowed via pserver\n"; 107print"I HATE YOU\n"; 108} 109$line= <STDIN>;chomp$line;# validate the password? 110$line= <STDIN>;chomp$line; 111unless($lineeq'END AUTH REQUEST') { 112die"E Do not understand$line-- expecting END AUTH REQUEST\n"; 113} 114print"I LOVE YOU\n"; 115# and now back to our regular programme... 116} 117 118# Keep going until the client closes the connection 119while(<STDIN>) 120{ 121chomp; 122 123# Check to see if we've seen this method, and call appropriate function. 124if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 125{ 126# use the $methods hash to call the appropriate sub for this command 127#$log->info("Method : $1"); 128&{$methods->{$1}}($1,$2); 129}else{ 130# log fatal because we don't understand this function. If this happens 131# we're fairly screwed because we don't know if the client is expecting 132# a response. If it is, the client will hang, we'll hang, and the whole 133# thing will be custard. 134$log->fatal("Don't understand command$_\n"); 135die("Unknown command$_"); 136} 137} 138 139$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 140$log->info("--------------- FINISH -----------------"); 141 142# Magic catchall method. 143# This is the method that will handle all commands we haven't yet 144# implemented. It simply sends a warning to the log file indicating a 145# command that hasn't been implemented has been invoked. 146sub req_CATCHALL 147{ 148my($cmd,$data) =@_; 149$log->warn("Unhandled command : req_$cmd:$data"); 150} 151 152 153# Root pathname \n 154# Response expected: no. Tell the server which CVSROOT to use. Note that 155# pathname is a local directory and not a fully qualified CVSROOT variable. 156# pathname must already exist; if creating a new root, use the init 157# request, not Root. pathname does not include the hostname of the server, 158# how to access the server, etc.; by the time the CVS protocol is in use, 159# connection, authentication, etc., are already taken care of. The Root 160# request must be sent only once, and it must be sent before any requests 161# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 162sub req_Root 163{ 164my($cmd,$data) =@_; 165$log->debug("req_Root :$data"); 166 167$state->{CVSROOT} =$data; 168 169$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 170unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 171print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 172print"E\n"; 173print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 174return0; 175} 176 177my@gitvars=`git-config -l`; 178if($?) { 179print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 180print"E\n"; 181print"error 1 - problem executing git-config\n"; 182return0; 183} 184foreachmy$line(@gitvars) 185{ 186next unless($line=~/^(.*?)\.(.*?)=(.*)$/); 187$cfg->{$1}{$2} =$3; 188} 189 190unless(defined($cfg->{gitcvs}{enabled} )and$cfg->{gitcvs}{enabled} =~/^\s*(1|true|yes)\s*$/i) 191{ 192print"E GITCVS emulation needs to be enabled on this repo\n"; 193print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 194print"E\n"; 195print"error 1 GITCVS emulation disabled\n"; 196return0; 197} 198 199if(defined($cfg->{gitcvs}{logfile} ) ) 200{ 201$log->setfile($cfg->{gitcvs}{logfile}); 202}else{ 203$log->nofile(); 204} 205 206return1; 207} 208 209# Global_option option \n 210# Response expected: no. Transmit one of the global options `-q', `-Q', 211# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 212# variations (such as combining of options) are allowed. For graceful 213# handling of valid-requests, it is probably better to make new global 214# options separate requests, rather than trying to add them to this 215# request. 216sub req_Globaloption 217{ 218my($cmd,$data) =@_; 219$log->debug("req_Globaloption :$data"); 220$state->{globaloptions}{$data} =1; 221} 222 223# Valid-responses request-list \n 224# Response expected: no. Tell the server what responses the client will 225# accept. request-list is a space separated list of tokens. 226sub req_Validresponses 227{ 228my($cmd,$data) =@_; 229$log->debug("req_Validresponses :$data"); 230 231# TODO : re-enable this, currently it's not particularly useful 232#$state->{validresponses} = [ split /\s+/, $data ]; 233} 234 235# valid-requests \n 236# Response expected: yes. Ask the server to send back a Valid-requests 237# response. 238sub req_validrequests 239{ 240my($cmd,$data) =@_; 241 242$log->debug("req_validrequests"); 243 244$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 245$log->debug("SEND : ok"); 246 247print"Valid-requests ".join(" ",keys%$methods) ."\n"; 248print"ok\n"; 249} 250 251# Directory local-directory \n 252# Additional data: repository \n. Response expected: no. Tell the server 253# what directory to use. The repository should be a directory name from a 254# previous server response. Note that this both gives a default for Entry 255# and Modified and also for ci and the other commands; normal usage is to 256# send Directory for each directory in which there will be an Entry or 257# Modified, and then a final Directory for the original directory, then the 258# command. The local-directory is relative to the top level at which the 259# command is occurring (i.e. the last Directory which is sent before the 260# command); to indicate that top level, `.' should be sent for 261# local-directory. 262sub req_Directory 263{ 264my($cmd,$data) =@_; 265 266my$repository= <STDIN>; 267chomp$repository; 268 269 270$state->{localdir} =$data; 271$state->{repository} =$repository; 272$state->{path} =$repository; 273$state->{path} =~s/^$state->{CVSROOT}\///; 274$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 275$state->{path} .="/"if($state->{path} =~ /\S/ ); 276 277$state->{directory} =$state->{localdir}; 278$state->{directory} =""if($state->{directory}eq"."); 279$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 280 281if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 282{ 283$log->info("Setting prepend to '$state->{path}'"); 284$state->{prependdir} =$state->{path}; 285foreachmy$entry(keys%{$state->{entries}} ) 286{ 287$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 288delete$state->{entries}{$entry}; 289} 290} 291 292if(defined($state->{prependdir} ) ) 293{ 294$log->debug("Prepending '$state->{prependdir}' to state|directory"); 295$state->{directory} =$state->{prependdir} .$state->{directory} 296} 297$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 298} 299 300# Entry entry-line \n 301# Response expected: no. Tell the server what version of a file is on the 302# local machine. The name in entry-line is a name relative to the directory 303# most recently specified with Directory. If the user is operating on only 304# some files in a directory, Entry requests for only those files need be 305# included. If an Entry request is sent without Modified, Is-modified, or 306# Unchanged, it means the file is lost (does not exist in the working 307# directory). If both Entry and one of Modified, Is-modified, or Unchanged 308# are sent for the same file, Entry must be sent first. For a given file, 309# one can send Modified, Is-modified, or Unchanged, but not more than one 310# of these three. 311sub req_Entry 312{ 313my($cmd,$data) =@_; 314 315#$log->debug("req_Entry : $data"); 316 317my@data=split(/\//,$data); 318 319$state->{entries}{$state->{directory}.$data[1]} = { 320 revision =>$data[2], 321 conflict =>$data[3], 322 options =>$data[4], 323 tag_or_date =>$data[5], 324}; 325 326$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 327} 328 329# Questionable filename \n 330# Response expected: no. Additional data: no. Tell the server to check 331# whether filename should be ignored, and if not, next time the server 332# sends responses, send (in a M response) `?' followed by the directory and 333# filename. filename must not contain `/'; it needs to be a file in the 334# directory named by the most recent Directory request. 335sub req_Questionable 336{ 337my($cmd,$data) =@_; 338 339$log->debug("req_Questionable :$data"); 340$state->{entries}{$state->{directory}.$data}{questionable} =1; 341} 342 343# add \n 344# Response expected: yes. Add a file or directory. This uses any previous 345# Argument, Directory, Entry, or Modified requests, if they have been sent. 346# The last Directory sent specifies the working directory at the time of 347# the operation. To add a directory, send the directory to be added using 348# Directory and Argument requests. 349sub req_add 350{ 351my($cmd,$data) =@_; 352 353 argsplit("add"); 354 355my$addcount=0; 356 357foreachmy$filename( @{$state->{args}} ) 358{ 359$filename= filecleanup($filename); 360 361unless(defined($state->{entries}{$filename}{modified_filename} ) ) 362{ 363print"E cvs add: nothing known about `$filename'\n"; 364next; 365} 366# TODO : check we're not squashing an already existing file 367if(defined($state->{entries}{$filename}{revision} ) ) 368{ 369print"E cvs add: `$filename' has already been entered\n"; 370next; 371} 372 373my($filepart,$dirpart) = filenamesplit($filename,1); 374 375print"E cvs add: scheduling file `$filename' for addition\n"; 376 377print"Checked-in$dirpart\n"; 378print"$filename\n"; 379my$kopts= kopts_from_path($filepart); 380print"/$filepart/0//$kopts/\n"; 381 382$addcount++; 383} 384 385if($addcount==1) 386{ 387print"E cvs add: use `cvs commit' to add this file permanently\n"; 388} 389elsif($addcount>1) 390{ 391print"E cvs add: use `cvs commit' to add these files permanently\n"; 392} 393 394print"ok\n"; 395} 396 397# remove \n 398# Response expected: yes. Remove a file. This uses any previous Argument, 399# Directory, Entry, or Modified requests, if they have been sent. The last 400# Directory sent specifies the working directory at the time of the 401# operation. Note that this request does not actually do anything to the 402# repository; the only effect of a successful remove request is to supply 403# the client with a new entries line containing `-' to indicate a removed 404# file. In fact, the client probably could perform this operation without 405# contacting the server, although using remove may cause the server to 406# perform a few more checks. The client sends a subsequent ci request to 407# actually record the removal in the repository. 408sub req_remove 409{ 410my($cmd,$data) =@_; 411 412 argsplit("remove"); 413 414# Grab a handle to the SQLite db and do any necessary updates 415my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 416$updater->update(); 417 418#$log->debug("add state : " . Dumper($state)); 419 420my$rmcount=0; 421 422foreachmy$filename( @{$state->{args}} ) 423{ 424$filename= filecleanup($filename); 425 426if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 427{ 428print"E cvs remove: file `$filename' still in working directory\n"; 429next; 430} 431 432my$meta=$updater->getmeta($filename); 433my$wrev= revparse($filename); 434 435unless(defined($wrev) ) 436{ 437print"E cvs remove: nothing known about `$filename'\n"; 438next; 439} 440 441if(defined($wrev)and$wrev<0) 442{ 443print"E cvs remove: file `$filename' already scheduled for removal\n"; 444next; 445} 446 447unless($wrev==$meta->{revision} ) 448{ 449# TODO : not sure if the format of this message is quite correct. 450print"E cvs remove: Up to date check failed for `$filename'\n"; 451next; 452} 453 454 455my($filepart,$dirpart) = filenamesplit($filename,1); 456 457print"E cvs remove: scheduling `$filename' for removal\n"; 458 459print"Checked-in$dirpart\n"; 460print"$filename\n"; 461my$kopts= kopts_from_path($filepart); 462print"/$filepart/-1.$wrev//$kopts/\n"; 463 464$rmcount++; 465} 466 467if($rmcount==1) 468{ 469print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 470} 471elsif($rmcount>1) 472{ 473print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 474} 475 476print"ok\n"; 477} 478 479# Modified filename \n 480# Response expected: no. Additional data: mode, \n, file transmission. Send 481# the server a copy of one locally modified file. filename is a file within 482# the most recent directory sent with Directory; it must not contain `/'. 483# If the user is operating on only some files in a directory, only those 484# files need to be included. This can also be sent without Entry, if there 485# is no entry for the file. 486sub req_Modified 487{ 488my($cmd,$data) =@_; 489 490my$mode= <STDIN>; 491chomp$mode; 492my$size= <STDIN>; 493chomp$size; 494 495# Grab config information 496my$blocksize=8192; 497my$bytesleft=$size; 498my$tmp; 499 500# Get a filehandle/name to write it to 501my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 502 503# Loop over file data writing out to temporary file. 504while($bytesleft) 505{ 506$blocksize=$bytesleftif($bytesleft<$blocksize); 507read STDIN,$tmp,$blocksize; 508print$fh $tmp; 509$bytesleft-=$blocksize; 510} 511 512close$fh; 513 514# Ensure we have something sensible for the file mode 515if($mode=~/u=(\w+)/) 516{ 517$mode=$1; 518}else{ 519$mode="rw"; 520} 521 522# Save the file data in $state 523$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 524$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 525$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 526$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 527 528 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 529} 530 531# Unchanged filename\n 532# Response expected: no. Tell the server that filename has not been 533# modified in the checked out directory. The filename is a file within the 534# most recent directory sent with Directory; it must not contain `/'. 535sub req_Unchanged 536{ 537 my ($cmd,$data) =@_; 538 539$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 540 541 #$log->debug("req_Unchanged :$data"); 542} 543 544# Argument text\n 545# Response expected: no. Save argument for use in a subsequent command. 546# Arguments accumulate until an argument-using command is given, at which 547# point they are forgotten. 548# Argumentx text\n 549# Response expected: no. Append\nfollowed by text to the current argument 550# being saved. 551sub req_Argument 552{ 553 my ($cmd,$data) =@_; 554 555 # Argumentx means: append to last Argument (with a newline in front) 556 557$log->debug("$cmd:$data"); 558 559 if ($cmdeq 'Argumentx') { 560 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 561 } else { 562 push @{$state->{arguments}},$data; 563 } 564} 565 566# expand-modules\n 567# Response expected: yes. Expand the modules which are specified in the 568# arguments. Returns the data in Module-expansion responses. Note that the 569# server can assume that this is checkout or export, not rtag or rdiff; the 570# latter do not access the working directory and thus have no need to 571# expand modules on the client side. Expand may not be the best word for 572# what this request does. It does not necessarily tell you all the files 573# contained in a module, for example. Basically it is a way of telling you 574# which working directories the server needs to know about in order to 575# handle a checkout of the specified modules. For example, suppose that the 576# server has a module defined by 577# aliasmodule -a 1dir 578# That is, one can check out aliasmodule and it will take 1dir in the 579# repository and check it out to 1dir in the working directory. Now suppose 580# the client already has this module checked out and is planning on using 581# the co request to update it. Without using expand-modules, the client 582# would have two bad choices: it could either send information about all 583# working directories under the current directory, which could be 584# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 585# stands for 1dir, and neglect to send information for 1dir, which would 586# lead to incorrect operation. With expand-modules, the client would first 587# ask for the module to be expanded: 588sub req_expandmodules 589{ 590 my ($cmd,$data) =@_; 591 592 argsplit(); 593 594$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 595 596 unless ( ref$state->{arguments} eq "ARRAY" ) 597 { 598 print "ok\n"; 599 return; 600 } 601 602 foreach my$module( @{$state->{arguments}} ) 603 { 604$log->debug("SEND : Module-expansion$module"); 605 print "Module-expansion$module\n"; 606 } 607 608 print "ok\n"; 609 statecleanup(); 610} 611 612# co\n 613# Response expected: yes. Get files from the repository. This uses any 614# previous Argument, Directory, Entry, or Modified requests, if they have 615# been sent. Arguments to this command are module names; the client cannot 616# know what directories they correspond to except by (1) just sending the 617# co request, and then seeing what directory names the server sends back in 618# its responses, and (2) the expand-modules request. 619sub req_co 620{ 621 my ($cmd,$data) =@_; 622 623 argsplit("co"); 624 625 my$module=$state->{args}[0]; 626 my$checkout_path=$module; 627 628 # use the user specified directory if we're given it 629$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 630 631$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 632 633$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 634 635$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 636 637# Grab a handle to the SQLite db and do any necessary updates 638my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 639$updater->update(); 640 641$checkout_path=~ s|/$||;# get rid of trailing slashes 642 643# Eclipse seems to need the Clear-sticky command 644# to prepare the 'Entries' file for the new directory. 645print"Clear-sticky$checkout_path/\n"; 646print$state->{CVSROOT} ."/$module/\n"; 647print"Clear-static-directory$checkout_path/\n"; 648print$state->{CVSROOT} ."/$module/\n"; 649print"Clear-sticky$checkout_path/\n";# yes, twice 650print$state->{CVSROOT} ."/$module/\n"; 651print"Template$checkout_path/\n"; 652print$state->{CVSROOT} ."/$module/\n"; 653print"0\n"; 654 655# instruct the client that we're checking out to $checkout_path 656print"E cvs checkout: Updating$checkout_path\n"; 657 658my%seendirs= (); 659my$lastdir=''; 660 661# recursive 662sub prepdir { 663my($dir,$repodir,$remotedir,$seendirs) =@_; 664my$parent= dirname($dir); 665$dir=~ s|/+$||; 666$repodir=~ s|/+$||; 667$remotedir=~ s|/+$||; 668$parent=~ s|/+$||; 669$log->debug("announcedir$dir,$repodir,$remotedir"); 670 671if($parenteq'.'||$parenteq'./') { 672$parent=''; 673} 674# recurse to announce unseen parents first 675if(length($parent) && !exists($seendirs->{$parent})) { 676 prepdir($parent,$repodir,$remotedir,$seendirs); 677} 678# Announce that we are going to modify at the parent level 679if($parent) { 680print"E cvs checkout: Updating$remotedir/$parent\n"; 681}else{ 682print"E cvs checkout: Updating$remotedir\n"; 683} 684print"Clear-sticky$remotedir/$parent/\n"; 685print"$repodir/$parent/\n"; 686 687print"Clear-static-directory$remotedir/$dir/\n"; 688print"$repodir/$dir/\n"; 689print"Clear-sticky$remotedir/$parent/\n";# yes, twice 690print"$repodir/$parent/\n"; 691print"Template$remotedir/$dir/\n"; 692print"$repodir/$dir/\n"; 693print"0\n"; 694 695$seendirs->{$dir} =1; 696} 697 698foreachmy$git( @{$updater->gethead} ) 699{ 700# Don't want to check out deleted files 701next if($git->{filehash}eq"deleted"); 702 703($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 704 705if(length($git->{dir}) &&$git->{dir}ne'./' 706&&$git->{dir}ne$lastdir) { 707unless(exists($seendirs{$git->{dir}})) { 708 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 709$checkout_path, \%seendirs); 710$lastdir=$git->{dir}; 711$seendirs{$git->{dir}} =1; 712} 713print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 714} 715 716# modification time of this file 717print"Mod-time$git->{modified}\n"; 718 719# print some information to the client 720if(defined($git->{dir} )and$git->{dir}ne"./") 721{ 722print"M U$checkout_path/$git->{dir}$git->{name}\n"; 723}else{ 724print"M U$checkout_path/$git->{name}\n"; 725} 726 727# instruct client we're sending a file to put in this path 728print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 729 730print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 731 732# this is an "entries" line 733my$kopts= kopts_from_path($git->{name}); 734print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 735# permissions 736print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 737 738# transmit file 739 transmitfile($git->{filehash}); 740} 741 742print"ok\n"; 743 744 statecleanup(); 745} 746 747# update \n 748# Response expected: yes. Actually do a cvs update command. This uses any 749# previous Argument, Directory, Entry, or Modified requests, if they have 750# been sent. The last Directory sent specifies the working directory at the 751# time of the operation. The -I option is not used--files which the client 752# can decide whether to ignore are not mentioned and the client sends the 753# Questionable request for others. 754sub req_update 755{ 756my($cmd,$data) =@_; 757 758$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 759 760 argsplit("update"); 761 762# 763# It may just be a client exploring the available heads/modules 764# in that case, list them as top level directories and leave it 765# at that. Eclipse uses this technique to offer you a list of 766# projects (heads in this case) to checkout. 767# 768if($state->{module}eq'') { 769print"E cvs update: Updating .\n"; 770opendir HEADS,$state->{CVSROOT} .'/refs/heads'; 771while(my$head=readdir(HEADS)) { 772if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 773print"E cvs update: New directory `$head'\n"; 774} 775} 776closedir HEADS; 777print"ok\n"; 778return1; 779} 780 781 782# Grab a handle to the SQLite db and do any necessary updates 783my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 784 785$updater->update(); 786 787 argsfromdir($updater); 788 789#$log->debug("update state : " . Dumper($state)); 790 791# foreach file specified on the command line ... 792foreachmy$filename( @{$state->{args}} ) 793{ 794$filename= filecleanup($filename); 795 796$log->debug("Processing file$filename"); 797 798# if we have a -C we should pretend we never saw modified stuff 799if(exists($state->{opt}{C} ) ) 800{ 801delete$state->{entries}{$filename}{modified_hash}; 802delete$state->{entries}{$filename}{modified_filename}; 803$state->{entries}{$filename}{unchanged} =1; 804} 805 806my$meta; 807if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 808{ 809$meta=$updater->getmeta($filename,$1); 810}else{ 811$meta=$updater->getmeta($filename); 812} 813 814if( !defined$meta) 815{ 816$meta= { 817 name =>$filename, 818 revision =>0, 819 filehash =>'added' 820}; 821} 822 823my$oldmeta=$meta; 824 825my$wrev= revparse($filename); 826 827# If the working copy is an old revision, lets get that version too for comparison. 828if(defined($wrev)and$wrev!=$meta->{revision} ) 829{ 830$oldmeta=$updater->getmeta($filename,$wrev); 831} 832 833#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 834 835# Files are up to date if the working copy and repo copy have the same revision, 836# and the working copy is unmodified _and_ the user hasn't specified -C 837next if(defined($wrev) 838and defined($meta->{revision}) 839and$wrev==$meta->{revision} 840and$state->{entries}{$filename}{unchanged} 841and not exists($state->{opt}{C} ) ); 842 843# If the working copy and repo copy have the same revision, 844# but the working copy is modified, tell the client it's modified 845if(defined($wrev) 846and defined($meta->{revision}) 847and$wrev==$meta->{revision} 848and not exists($state->{opt}{C} ) ) 849{ 850$log->info("Tell the client the file is modified"); 851print"MT text M\n"; 852print"MT fname$filename\n"; 853print"MT newline\n"; 854next; 855} 856 857if($meta->{filehash}eq"deleted") 858{ 859my($filepart,$dirpart) = filenamesplit($filename,1); 860 861$log->info("Removing '$filename' from working copy (no longer in the repo)"); 862 863print"E cvs update: `$filename' is no longer in the repository\n"; 864# Don't want to actually _DO_ the update if -n specified 865unless($state->{globaloptions}{-n} ) { 866print"Removed$dirpart\n"; 867print"$filepart\n"; 868} 869} 870elsif(not defined($state->{entries}{$filename}{modified_hash} ) 871or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} 872or$meta->{filehash}eq'added') 873{ 874# normal update, just send the new revision (either U=Update, 875# or A=Add, or R=Remove) 876if(defined($wrev) &&$wrev<0) 877{ 878$log->info("Tell the client the file is scheduled for removal"); 879print"MT text R\n"; 880print"MT fname$filename\n"; 881print"MT newline\n"; 882next; 883} 884elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) ) 885{ 886$log->info("Tell the client the file is scheduled for addition"); 887print"MT text A\n"; 888print"MT fname$filename\n"; 889print"MT newline\n"; 890next; 891 892} 893else{ 894$log->info("Updating '$filename' to ".$meta->{revision}); 895print"MT +updated\n"; 896print"MT text U\n"; 897print"MT fname$filename\n"; 898print"MT newline\n"; 899print"MT -updated\n"; 900} 901 902my($filepart,$dirpart) = filenamesplit($filename,1); 903 904# Don't want to actually _DO_ the update if -n specified 905unless($state->{globaloptions}{-n} ) 906{ 907if(defined($wrev) ) 908{ 909# instruct client we're sending a file to put in this path as a replacement 910print"Update-existing$dirpart\n"; 911$log->debug("Updating existing file 'Update-existing$dirpart'"); 912}else{ 913# instruct client we're sending a file to put in this path as a new file 914print"Clear-static-directory$dirpart\n"; 915print$state->{CVSROOT} ."/$state->{module}/$dirpart\n"; 916print"Clear-sticky$dirpart\n"; 917print$state->{CVSROOT} ."/$state->{module}/$dirpart\n"; 918 919$log->debug("Creating new file 'Created$dirpart'"); 920print"Created$dirpart\n"; 921} 922print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 923 924# this is an "entries" line 925my$kopts= kopts_from_path($filepart); 926$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 927print"/$filepart/1.$meta->{revision}//$kopts/\n"; 928 929# permissions 930$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 931print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 932 933# transmit file 934 transmitfile($meta->{filehash}); 935} 936}else{ 937$log->info("Updating '$filename'"); 938my($filepart,$dirpart) = filenamesplit($meta->{name},1); 939 940my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 941 942chdir$dir; 943my$file_local=$filepart.".mine"; 944system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 945my$file_old=$filepart.".".$oldmeta->{revision}; 946 transmitfile($oldmeta->{filehash},$file_old); 947my$file_new=$filepart.".".$meta->{revision}; 948 transmitfile($meta->{filehash},$file_new); 949 950# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 951$log->info("Merging$file_local,$file_old,$file_new"); 952print"M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into$filename\n"; 953 954$log->debug("Temporary directory for merge is$dir"); 955 956my$return=system("git","merge-file",$file_local,$file_old,$file_new); 957$return>>=8; 958 959if($return==0) 960{ 961$log->info("Merged successfully"); 962print"M M$filename\n"; 963$log->debug("Merged$dirpart"); 964 965# Don't want to actually _DO_ the update if -n specified 966unless($state->{globaloptions}{-n} ) 967{ 968print"Merged$dirpart\n"; 969$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 970print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 971my$kopts= kopts_from_path($filepart); 972$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 973print"/$filepart/1.$meta->{revision}//$kopts/\n"; 974} 975} 976elsif($return==1) 977{ 978$log->info("Merged with conflicts"); 979print"E cvs update: conflicts found in$filename\n"; 980print"M C$filename\n"; 981 982# Don't want to actually _DO_ the update if -n specified 983unless($state->{globaloptions}{-n} ) 984{ 985print"Merged$dirpart\n"; 986print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 987my$kopts= kopts_from_path($filepart); 988print"/$filepart/1.$meta->{revision}/+/$kopts/\n"; 989} 990} 991else 992{ 993$log->warn("Merge failed"); 994next; 995} 996 997# Don't want to actually _DO_ the update if -n specified 998unless($state->{globaloptions}{-n} ) 999{1000# permissions1001$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1002print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";10031004# transmit file, format is single integer on a line by itself (file1005# size) followed by the file contents1006# TODO : we should copy files in blocks1007my$data=`cat$file_local`;1008$log->debug("File size : " . length($data));1009 print length($data) . "\n";1010 print$data;1011 }10121013 chdir "/";1014 }10151016 }10171018 print "ok\n";1019}10201021sub req_ci1022{1023 my ($cmd,$data) =@_;10241025 argsplit("ci");10261027 #$log->debug("State : " . Dumper($state));10281029$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));10301031 if ($state->{method} eq 'pserver')1032 {1033 print "error 1 pserver access cannot commit\n";1034 exit;1035 }10361037 if ( -e$state->{CVSROOT} . "/index" )1038 {1039$log->warn("file 'index' already exists in the git repository");1040 print "error 1 Index already exists in git repo\n";1041 exit;1042 }10431044 # Grab a handle to the SQLite db and do any necessary updates1045 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1046$updater->update();10471048 my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1049 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 );1050$log->info("Lockless commit start, basing commit on '$tmpdir', index file is '$file_index'");10511052$ENV{GIT_DIR} =$state->{CVSROOT} . "/";1053$ENV{GIT_INDEX_FILE} =$file_index;10541055 # Remember where the head was at the beginning.1056 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1057 chomp$parenthash;1058 if ($parenthash!~ /^[0-9a-f]{40}$/) {1059 print "error 1 pserver cannot find the current HEAD of module";1060 exit;1061 }10621063 chdir$tmpdir;10641065 # populate the temporary index based1066 system("git-read-tree",$parenthash);1067 unless ($?== 0)1068 {1069 die "Error running git-read-tree$state->{module}$file_index$!";1070 }1071$log->info("Created index '$file_index' with for head$state->{module} - exit status$?");10721073 my@committedfiles= ();1074 my%oldmeta;10751076 # foreach file specified on the command line ...1077 foreach my$filename( @{$state->{args}} )1078 {1079 my$committedfile=$filename;1080$filename= filecleanup($filename);10811082 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );10831084 my$meta=$updater->getmeta($filename);1085$oldmeta{$filename} =$meta;10861087 my$wrev= revparse($filename);10881089 my ($filepart,$dirpart) = filenamesplit($filename);10901091 # do a checkout of the file if it part of this tree1092 if ($wrev) {1093 system('git-checkout-index', '-f', '-u',$filename);1094 unless ($?== 0) {1095 die "Error running git-checkout-index -f -u$filename:$!";1096 }1097 }10981099 my$addflag= 0;1100 my$rmflag= 0;1101$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1102$addflag= 1 unless ( -e$filename);11031104 # Do up to date checking1105 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1106 {1107 # fail everything if an up to date check fails1108 print "error 1 Up to date check failed for$filename\n";1109 chdir "/";1110 exit;1111 }11121113 push@committedfiles,$committedfile;1114$log->info("Committing$filename");11151116 system("mkdir","-p",$dirpart) unless ( -d$dirpart);11171118 unless ($rmflag)1119 {1120$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1121 rename$state->{entries}{$filename}{modified_filename},$filename;11221123 # Calculate modes to remove1124 my$invmode= "";1125 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }11261127$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1128 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1129 }11301131 if ($rmflag)1132 {1133$log->info("Removing file '$filename'");1134 unlink($filename);1135 system("git-update-index", "--remove",$filename);1136 }1137 elsif ($addflag)1138 {1139$log->info("Adding file '$filename'");1140 system("git-update-index", "--add",$filename);1141 } else {1142$log->info("Updating file '$filename'");1143 system("git-update-index",$filename);1144 }1145 }11461147 unless ( scalar(@committedfiles) > 0 )1148 {1149 print "E No files to commit\n";1150 print "ok\n";1151 chdir "/";1152 return;1153 }11541155 my$treehash= `git-write-tree`;1156 chomp$treehash;11571158$log->debug("Treehash :$treehash, Parenthash :$parenthash");11591160 # write our commit message out if we have one ...1161 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1162 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1163 print$msg_fh"\n\nvia git-CVS emulator\n";1164 close$msg_fh;11651166 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;1167chomp($commithash);1168$log->info("Commit hash :$commithash");11691170unless($commithash=~/[a-zA-Z0-9]{40}/)1171{1172$log->warn("Commit failed (Invalid commit hash)");1173print"error 1 Commit failed (unknown reason)\n";1174chdir"/";1175exit;1176}11771178# Check that this is allowed, just as we would with a receive-pack1179my@cmd= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1180$parenthash,$commithash);1181if( -x $cmd[0] ) {1182unless(system(@cmd) ==0)1183{1184$log->warn("Commit failed (update hook declined to update ref)");1185print"error 1 Commit failed (update hook declined)\n";1186chdir"/";1187exit;1188}1189}11901191if(system(qw(git update-ref -m),"cvsserver ci",1192"refs/heads/$state->{module}",$commithash,$parenthash)) {1193$log->warn("update-ref for$state->{module} failed.");1194print"error 1 Cannot commit -- update first\n";1195exit;1196}11971198$updater->update();11991200# foreach file specified on the command line ...1201foreachmy$filename(@committedfiles)1202{1203$filename= filecleanup($filename);12041205my$meta=$updater->getmeta($filename);1206unless(defined$meta->{revision}) {1207$meta->{revision} =1;1208}12091210my($filepart,$dirpart) = filenamesplit($filename,1);12111212$log->debug("Checked-in$dirpart:$filename");12131214print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1215if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1216{1217print"M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";1218print"Remove-entry$dirpart\n";1219print"$filename\n";1220}else{1221if($meta->{revision} ==1) {1222print"M initial revision: 1.1\n";1223}else{1224print"M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";1225}1226print"Checked-in$dirpart\n";1227print"$filename\n";1228my$kopts= kopts_from_path($filepart);1229print"/$filepart/1.$meta->{revision}//$kopts/\n";1230}1231}12321233chdir"/";1234print"ok\n";1235}12361237sub req_status1238{1239my($cmd,$data) =@_;12401241 argsplit("status");12421243$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1244#$log->debug("status state : " . Dumper($state));12451246# Grab a handle to the SQLite db and do any necessary updates1247my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1248$updater->update();12491250# if no files were specified, we need to work out what files we should be providing status on ...1251 argsfromdir($updater);12521253# foreach file specified on the command line ...1254foreachmy$filename( @{$state->{args}} )1255{1256$filename= filecleanup($filename);12571258my$meta=$updater->getmeta($filename);1259my$oldmeta=$meta;12601261my$wrev= revparse($filename);12621263# If the working copy is an old revision, lets get that version too for comparison.1264if(defined($wrev)and$wrev!=$meta->{revision} )1265{1266$oldmeta=$updater->getmeta($filename,$wrev);1267}12681269# TODO : All possible statuses aren't yet implemented1270my$status;1271# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1272$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1273and1274( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1275or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1276);12771278# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1279$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1280and1281($state->{entries}{$filename}{unchanged}1282or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1283);12841285# Need checkout if it exists in the repo but doesn't have a working copy1286$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );12871288# Locally modified if working copy and repo copy have the same revision but there are local changes1289$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );12901291# Needs Merge if working copy revision is less than repo copy and there are local changes1292$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );12931294$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1295$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1296$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1297$status||="File had conflicts on merge"if(0);12981299$status||="Unknown";13001301print"M ===================================================================\n";1302print"M File:$filename\tStatus:$status\n";1303if(defined($state->{entries}{$filename}{revision}) )1304{1305print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1306}else{1307print"M Working revision:\tNo entry for$filename\n";1308}1309if(defined($meta->{revision}) )1310{1311print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1312print"M Sticky Tag:\t\t(none)\n";1313print"M Sticky Date:\t\t(none)\n";1314print"M Sticky Options:\t\t(none)\n";1315}else{1316print"M Repository revision:\tNo revision control file\n";1317}1318print"M\n";1319}13201321print"ok\n";1322}13231324sub req_diff1325{1326my($cmd,$data) =@_;13271328 argsplit("diff");13291330$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1331#$log->debug("status state : " . Dumper($state));13321333my($revision1,$revision2);1334if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1335{1336$revision1=$state->{opt}{r}[0];1337$revision2=$state->{opt}{r}[1];1338}else{1339$revision1=$state->{opt}{r};1340}13411342$revision1=~s/^1\.//if(defined($revision1) );1343$revision2=~s/^1\.//if(defined($revision2) );13441345$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );13461347# Grab a handle to the SQLite db and do any necessary updates1348my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1349$updater->update();13501351# if no files were specified, we need to work out what files we should be providing status on ...1352 argsfromdir($updater);13531354# foreach file specified on the command line ...1355foreachmy$filename( @{$state->{args}} )1356{1357$filename= filecleanup($filename);13581359my($fh,$file1,$file2,$meta1,$meta2,$filediff);13601361my$wrev= revparse($filename);13621363# We need _something_ to diff against1364next unless(defined($wrev) );13651366# if we have a -r switch, use it1367if(defined($revision1) )1368{1369(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1370$meta1=$updater->getmeta($filename,$revision1);1371unless(defined($meta1)and$meta1->{filehash}ne"deleted")1372{1373print"E File$filenameat revision 1.$revision1doesn't exist\n";1374next;1375}1376 transmitfile($meta1->{filehash},$file1);1377}1378# otherwise we just use the working copy revision1379else1380{1381(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1382$meta1=$updater->getmeta($filename,$wrev);1383 transmitfile($meta1->{filehash},$file1);1384}13851386# if we have a second -r switch, use it too1387if(defined($revision2) )1388{1389(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1390$meta2=$updater->getmeta($filename,$revision2);13911392unless(defined($meta2)and$meta2->{filehash}ne"deleted")1393{1394print"E File$filenameat revision 1.$revision2doesn't exist\n";1395next;1396}13971398 transmitfile($meta2->{filehash},$file2);1399}1400# otherwise we just use the working copy1401else1402{1403$file2=$state->{entries}{$filename}{modified_filename};1404}14051406# if we have been given -r, and we don't have a $file2 yet, lets get one1407if(defined($revision1)and not defined($file2) )1408{1409(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1410$meta2=$updater->getmeta($filename,$wrev);1411 transmitfile($meta2->{filehash},$file2);1412}14131414# We need to have retrieved something useful1415next unless(defined($meta1) );14161417# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1418next if(not defined($meta2)and$wrev==$meta1->{revision}1419and1420( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1421or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1422);14231424# Apparently we only show diffs for locally modified files1425next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );14261427print"M Index:$filename\n";1428print"M ===================================================================\n";1429print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1430print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1431print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1432print"M diff ";1433foreachmy$opt(keys%{$state->{opt}} )1434{1435if(ref$state->{opt}{$opt}eq"ARRAY")1436{1437foreachmy$value( @{$state->{opt}{$opt}} )1438{1439print"-$opt$value";1440}1441}else{1442print"-$opt";1443print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1444}1445}1446print"$filename\n";14471448$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));14491450($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);14511452if(exists$state->{opt}{u} )1453{1454system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1455}else{1456system("diff$file1$file2>$filediff");1457}14581459while( <$fh> )1460{1461print"M$_";1462}1463close$fh;1464}14651466print"ok\n";1467}14681469sub req_log1470{1471my($cmd,$data) =@_;14721473 argsplit("log");14741475$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1476#$log->debug("log state : " . Dumper($state));14771478my($minrev,$maxrev);1479if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1480{1481my$control=$2;1482$minrev=$1;1483$maxrev=$3;1484$minrev=~s/^1\.//if(defined($minrev) );1485$maxrev=~s/^1\.//if(defined($maxrev) );1486$minrev++if(defined($minrev)and$controleq"::");1487}14881489# Grab a handle to the SQLite db and do any necessary updates1490my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1491$updater->update();14921493# if no files were specified, we need to work out what files we should be providing status on ...1494 argsfromdir($updater);14951496# foreach file specified on the command line ...1497foreachmy$filename( @{$state->{args}} )1498{1499$filename= filecleanup($filename);15001501my$headmeta=$updater->getmeta($filename);15021503my$revisions=$updater->getlog($filename);1504my$totalrevisions=scalar(@$revisions);15051506if(defined($minrev) )1507{1508$log->debug("Removing revisions less than$minrev");1509while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1510{1511pop@$revisions;1512}1513}1514if(defined($maxrev) )1515{1516$log->debug("Removing revisions greater than$maxrev");1517while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1518{1519shift@$revisions;1520}1521}15221523next unless(scalar(@$revisions) );15241525print"M\n";1526print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1527print"M Working file:$filename\n";1528print"M head: 1.$headmeta->{revision}\n";1529print"M branch:\n";1530print"M locks: strict\n";1531print"M access list:\n";1532print"M symbolic names:\n";1533print"M keyword substitution: kv\n";1534print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1535print"M description:\n";15361537foreachmy$revision(@$revisions)1538{1539print"M ----------------------------\n";1540print"M revision 1.$revision->{revision}\n";1541# reformat the date for log output1542$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}) );1543$revision->{author} =~s/\s+.*//;1544$revision->{author} =~s/^(.{8}).*/$1/;1545print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1546my$commitmessage=$updater->commitmessage($revision->{commithash});1547$commitmessage=~s/^/M /mg;1548print$commitmessage."\n";1549}1550print"M =============================================================================\n";1551}15521553print"ok\n";1554}15551556sub req_annotate1557{1558my($cmd,$data) =@_;15591560 argsplit("annotate");15611562$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1563#$log->debug("status state : " . Dumper($state));15641565# Grab a handle to the SQLite db and do any necessary updates1566my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1567$updater->update();15681569# if no files were specified, we need to work out what files we should be providing annotate on ...1570 argsfromdir($updater);15711572# we'll need a temporary checkout dir1573my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1574my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1575$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");15761577$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1578$ENV{GIT_INDEX_FILE} =$file_index;15791580chdir$tmpdir;15811582# foreach file specified on the command line ...1583foreachmy$filename( @{$state->{args}} )1584{1585$filename= filecleanup($filename);15861587my$meta=$updater->getmeta($filename);15881589next unless($meta->{revision} );15901591# get all the commits that this file was in1592# in dense format -- aka skip dead revisions1593my$revisions=$updater->gethistorydense($filename);1594my$lastseenin=$revisions->[0][2];15951596# populate the temporary index based on the latest commit were we saw1597# the file -- but do it cheaply without checking out any files1598# TODO: if we got a revision from the client, use that instead1599# to look up the commithash in sqlite (still good to default to1600# the current head as we do now)1601system("git-read-tree",$lastseenin);1602unless($?==0)1603{1604die"Error running git-read-tree$lastseenin$file_index$!";1605}1606$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");16071608# do a checkout of the file1609system('git-checkout-index','-f','-u',$filename);1610unless($?==0) {1611die"Error running git-checkout-index -f -u$filename:$!";1612}16131614$log->info("Annotate$filename");16151616# Prepare a file with the commits from the linearized1617# history that annotate should know about. This prevents1618# git-jsannotate telling us about commits we are hiding1619# from the client.16201621open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1622for(my$i=0;$i<@$revisions;$i++)1623{1624print ANNOTATEHINTS $revisions->[$i][2];1625if($i+1<@$revisions) {# have we got a parent?1626print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1627}1628print ANNOTATEHINTS "\n";1629}16301631print ANNOTATEHINTS "\n";1632close ANNOTATEHINTS;16331634my$annotatecmd='git-annotate';1635open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1636or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1637my$metadata= {};1638print"E Annotations for$filename\n";1639print"E ***************\n";1640while( <ANNOTATE> )1641{1642if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1643{1644my$commithash=$1;1645my$data=$2;1646unless(defined($metadata->{$commithash} ) )1647{1648$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1649$metadata->{$commithash}{author} =~s/\s+.*//;1650$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1651$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1652}1653printf("M 1.%-5d (%-8s%10s):%s\n",1654$metadata->{$commithash}{revision},1655$metadata->{$commithash}{author},1656$metadata->{$commithash}{modified},1657$data1658);1659}else{1660$log->warn("Error in annotate output! LINE:$_");1661print"E Annotate error\n";1662next;1663}1664}1665close ANNOTATE;1666}16671668# done; get out of the tempdir1669chdir"/";16701671print"ok\n";16721673}16741675# This method takes the state->{arguments} array and produces two new arrays.1676# The first is $state->{args} which is everything before the '--' argument, and1677# the second is $state->{files} which is everything after it.1678sub argsplit1679{1680return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");16811682my$type=shift;16831684$state->{args} = [];1685$state->{files} = [];1686$state->{opt} = {};16871688if(defined($type) )1689{1690my$opt= {};1691$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($typeeq"co");1692$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1693$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($typeeq"update");1694$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1695$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1696$opt= { k =>1, m =>1}if($typeeq"add");1697$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1698$opt= { l =>0, b =>0, h =>0, R =>0, t =>0, N =>0, S =>0, r =>1, d =>1, s =>1, w =>1}if($typeeq"log");169917001701while(scalar( @{$state->{arguments}} ) >0)1702{1703my$arg=shift@{$state->{arguments}};17041705next if($argeq"--");1706next unless($arg=~/\S/);17071708# if the argument looks like a switch1709if($arg=~/^-(\w)(.*)/)1710{1711# if it's a switch that takes an argument1712if($opt->{$1} )1713{1714# If this switch has already been provided1715if($opt->{$1} >1and exists($state->{opt}{$1} ) )1716{1717$state->{opt}{$1} = [$state->{opt}{$1} ];1718if(length($2) >0)1719{1720push@{$state->{opt}{$1}},$2;1721}else{1722push@{$state->{opt}{$1}},shift@{$state->{arguments}};1723}1724}else{1725# if there's extra data in the arg, use that as the argument for the switch1726if(length($2) >0)1727{1728$state->{opt}{$1} =$2;1729}else{1730$state->{opt}{$1} =shift@{$state->{arguments}};1731}1732}1733}else{1734$state->{opt}{$1} =undef;1735}1736}1737else1738{1739push@{$state->{args}},$arg;1740}1741}1742}1743else1744{1745my$mode=0;17461747foreachmy$value( @{$state->{arguments}} )1748{1749if($valueeq"--")1750{1751$mode++;1752next;1753}1754push@{$state->{args}},$valueif($mode==0);1755push@{$state->{files}},$valueif($mode==1);1756}1757}1758}17591760# This method uses $state->{directory} to populate $state->{args} with a list of filenames1761sub argsfromdir1762{1763my$updater=shift;17641765$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");17661767return if(scalar( @{$state->{args}} ) >1);17681769my@gethead= @{$updater->gethead};17701771# push added files1772foreachmy$file(keys%{$state->{entries}}) {1773if(exists$state->{entries}{$file}{revision} &&1774$state->{entries}{$file}{revision} ==0)1775{1776push@gethead, { name =>$file, filehash =>'added'};1777}1778}17791780if(scalar(@{$state->{args}}) ==1)1781{1782my$arg=$state->{args}[0];1783$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );17841785$log->info("Only one arg specified, checking for directory expansion on '$arg'");17861787foreachmy$file(@gethead)1788{1789next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1790next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);1791push@{$state->{args}},$file->{name};1792}17931794shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);1795}else{1796$log->info("Only one arg specified, populating file list automatically");17971798$state->{args} = [];17991800foreachmy$file(@gethead)1801{1802next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1803next unless($file->{name} =~s/^$state->{prependdir}//);1804push@{$state->{args}},$file->{name};1805}1806}1807}18081809# This method cleans up the $state variable after a command that uses arguments has run1810sub statecleanup1811{1812$state->{files} = [];1813$state->{args} = [];1814$state->{arguments} = [];1815$state->{entries} = {};1816}18171818sub revparse1819{1820my$filename=shift;18211822returnundefunless(defined($state->{entries}{$filename}{revision} ) );18231824return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1825return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);18261827returnundef;1828}18291830# This method takes a file hash and does a CVS "file transfer" which transmits the1831# size of the file, and then the file contents.1832# If a second argument $targetfile is given, the file is instead written out to1833# a file by the name of $targetfile1834sub transmitfile1835{1836my$filehash=shift;1837my$targetfile=shift;18381839if(defined($filehash)and$filehasheq"deleted")1840{1841$log->warn("filehash is 'deleted'");1842return;1843}18441845die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);18461847my$type=`git-cat-file -t$filehash`;1848 chomp$type;18491850 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );18511852 my$size= `git-cat-file -s $filehash`;1853chomp$size;18541855$log->debug("transmitfile($filehash) size=$size, type=$type");18561857if(open my$fh,'-|',"git-cat-file","blob",$filehash)1858{1859if(defined($targetfile) )1860{1861open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1862print NEWFILE $_while( <$fh> );1863close NEWFILE;1864}else{1865print"$size\n";1866printwhile( <$fh> );1867}1868close$fhor die("Couldn't close filehandle for transmitfile()");1869}else{1870die("Couldn't execute git-cat-file");1871}1872}18731874# This method takes a file name, and returns ( $dirpart, $filepart ) which1875# refers to the directory portion and the file portion of the filename1876# respectively1877sub filenamesplit1878{1879my$filename=shift;1880my$fixforlocaldir=shift;18811882my($filepart,$dirpart) = ($filename,".");1883($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1884$dirpart.="/";18851886if($fixforlocaldir)1887{1888$dirpart=~s/^$state->{prependdir}//;1889}18901891return($filepart,$dirpart);1892}18931894sub filecleanup1895{1896my$filename=shift;18971898returnundefunless(defined($filename));1899if($filename=~/^\// )1900{1901print"E absolute filenames '$filename' not supported by server\n";1902returnundef;1903}19041905$filename=~s/^\.\///g;1906$filename=$state->{prependdir} .$filename;1907return$filename;1908}19091910# Given a path, this function returns a string containing the kopts1911# that should go into that path's Entries line. For example, a binary1912# file should get -kb.1913sub kopts_from_path1914{1915my($path) =@_;19161917# Once it exists, the git attributes system should be used to look up1918# what attributes apply to this path.19191920# Until then, take the setting from the config file1921unless(defined($cfg->{gitcvs}{allbinary} )and$cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i)1922{1923# Return "" to give no special treatment to any path1924return"";1925}else{1926# Alternatively, to have all files treated as if they are binary (which1927# is more like git itself), always return the "-kb" option1928return"-kb";1929}1930}19311932package GITCVS::log;19331934####1935#### Copyright The Open University UK - 2006.1936####1937#### Authors: Martyn Smith <martyn@catalyst.net.nz>1938#### Martin Langhoff <martin@catalyst.net.nz>1939####1940####19411942use strict;1943use warnings;19441945=head1 NAME19461947GITCVS::log19481949=head1 DESCRIPTION19501951This module provides very crude logging with a similar interface to1952Log::Log4perl19531954=head1 METHODS19551956=cut19571958=head2 new19591960Creates a new log object, optionally you can specify a filename here to1961indicate the file to log to. If no log file is specified, you can specify one1962later with method setfile, or indicate you no longer want logging with method1963nofile.19641965Until one of these methods is called, all log calls will buffer messages ready1966to write out.19671968=cut1969sub new1970{1971my$class=shift;1972my$filename=shift;19731974my$self= {};19751976bless$self,$class;19771978if(defined($filename) )1979{1980open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1981}19821983return$self;1984}19851986=head2 setfile19871988This methods takes a filename, and attempts to open that file as the log file.1989If successful, all buffered data is written out to the file, and any further1990logging is written directly to the file.19911992=cut1993sub setfile1994{1995my$self=shift;1996my$filename=shift;19971998if(defined($filename) )1999{2000open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2001}20022003return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");20042005while(my$line=shift@{$self->{buffer}} )2006{2007print{$self->{fh}}$line;2008}2009}20102011=head2 nofile20122013This method indicates no logging is going to be used. It flushes any entries in2014the internal buffer, and sets a flag to ensure no further data is put there.20152016=cut2017sub nofile2018{2019my$self=shift;20202021$self->{nolog} =1;20222023return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");20242025$self->{buffer} = [];2026}20272028=head2 _logopen20292030Internal method. Returns true if the log file is open, false otherwise.20312032=cut2033sub _logopen2034{2035my$self=shift;20362037return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2038return0;2039}20402041=head2 debug info warn fatal20422043These four methods are wrappers to _log. They provide the actual interface for2044logging data.20452046=cut2047sub debug {my$self=shift;$self->_log("debug",@_); }2048sub info {my$self=shift;$self->_log("info",@_); }2049subwarn{my$self=shift;$self->_log("warn",@_); }2050sub fatal {my$self=shift;$self->_log("fatal",@_); }20512052=head2 _log20532054This is an internal method called by the logging functions. It generates a2055timestamp and pushes the logged line either to file, or internal buffer.20562057=cut2058sub _log2059{2060my$self=shift;2061my$level=shift;20622063return if($self->{nolog} );20642065my@time=localtime;2066my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2067$time[5] +1900,2068$time[4] +1,2069$time[3],2070$time[2],2071$time[1],2072$time[0],2073uc$level,2074);20752076if($self->_logopen)2077{2078print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2079}else{2080push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2081}2082}20832084=head2 DESTROY20852086This method simply closes the file handle if one is open20872088=cut2089sub DESTROY2090{2091my$self=shift;20922093if($self->_logopen)2094{2095close$self->{fh};2096}2097}20982099package GITCVS::updater;21002101####2102#### Copyright The Open University UK - 2006.2103####2104#### Authors: Martyn Smith <martyn@catalyst.net.nz>2105#### Martin Langhoff <martin@catalyst.net.nz>2106####2107####21082109use strict;2110use warnings;2111use DBI;21122113=head1 METHODS21142115=cut21162117=head2 new21182119=cut2120sub new2121{2122my$class=shift;2123my$config=shift;2124my$module=shift;2125my$log=shift;21262127die"Need to specify a git repository"unless(defined($config)and-d $config);2128die"Need to specify a module"unless(defined($module) );21292130$class=ref($class) ||$class;21312132my$self= {};21332134bless$self,$class;21352136$self->{dbdir} =$config."/";2137die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );21382139$self->{module} =$module;2140$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";21412142$self->{git_path} =$config."/";21432144$self->{log} =$log;21452146die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );21472148$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");21492150$self->{tables} = {};2151foreachmy$table($self->{dbh}->tables)2152{2153$table=~s/^"//;2154$table=~s/"$//;2155$self->{tables}{$table} =1;2156}21572158# Construct the revision table if required2159unless($self->{tables}{revision} )2160{2161$self->{dbh}->do("2162 CREATE TABLE revision (2163 name TEXT NOT NULL,2164 revision INTEGER NOT NULL,2165 filehash TEXT NOT NULL,2166 commithash TEXT NOT NULL,2167 author TEXT NOT NULL,2168 modified TEXT NOT NULL,2169 mode TEXT NOT NULL2170 )2171 ");2172$self->{dbh}->do("2173 CREATE INDEX revision_ix12174 ON revision (name,revision)2175 ");2176$self->{dbh}->do("2177 CREATE INDEX revision_ix22178 ON revision (name,commithash)2179 ");2180}21812182# Construct the head table if required2183unless($self->{tables}{head} )2184{2185$self->{dbh}->do("2186 CREATE TABLE head (2187 name TEXT NOT NULL,2188 revision INTEGER NOT NULL,2189 filehash TEXT NOT NULL,2190 commithash TEXT NOT NULL,2191 author TEXT NOT NULL,2192 modified TEXT NOT NULL,2193 mode TEXT NOT NULL2194 )2195 ");2196$self->{dbh}->do("2197 CREATE INDEX head_ix12198 ON head (name)2199 ");2200}22012202# Construct the properties table if required2203unless($self->{tables}{properties} )2204{2205$self->{dbh}->do("2206 CREATE TABLE properties (2207 key TEXT NOT NULL PRIMARY KEY,2208 value TEXT2209 )2210 ");2211}22122213# Construct the commitmsgs table if required2214unless($self->{tables}{commitmsgs} )2215{2216$self->{dbh}->do("2217 CREATE TABLE commitmsgs (2218 key TEXT NOT NULL PRIMARY KEY,2219 value TEXT2220 )2221 ");2222}22232224return$self;2225}22262227=head2 update22282229=cut2230sub update2231{2232my$self=shift;22332234# first lets get the commit list2235$ENV{GIT_DIR} =$self->{git_path};22362237my$commitsha1=`git rev-parse$self->{module}`;2238chomp$commitsha1;22392240my$commitinfo=`git cat-file commit$self->{module} 2>&1`;2241unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2242{2243die("Invalid module '$self->{module}'");2244}224522462247my$git_log;2248my$lastcommit=$self->_get_prop("last_commit");22492250if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date2251return1;2252}22532254# Start exclusive lock here...2255$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";22562257# TODO: log processing is memory bound2258# if we can parse into a 2nd file that is in reverse order2259# we can probably do something really efficient2260my@git_log_params= ('--pretty','--parents','--topo-order');22612262if(defined$lastcommit) {2263push@git_log_params,"$lastcommit..$self->{module}";2264}else{2265push@git_log_params,$self->{module};2266}2267# git-rev-list is the backend / plumbing version of git-log2268open(GITLOG,'-|','git-rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";22692270my@commits;22712272my%commit= ();22732274while( <GITLOG> )2275{2276chomp;2277if(m/^commit\s+(.*)$/) {2278# on ^commit lines put the just seen commit in the stack2279# and prime things for the next one2280if(keys%commit) {2281my%copy=%commit;2282unshift@commits, \%copy;2283%commit= ();2284}2285my@parents=split(m/\s+/,$1);2286$commit{hash} =shift@parents;2287$commit{parents} = \@parents;2288}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2289# on rfc822-like lines seen before we see any message,2290# lowercase the entry and put it in the hash as key-value2291$commit{lc($1)} =$2;2292}else{2293# message lines - skip initial empty line2294# and trim whitespace2295if(!exists($commit{message}) &&m/^\s*$/) {2296# define it to mark the end of headers2297$commit{message} ='';2298next;2299}2300s/^\s+//;s/\s+$//;# trim ws2301$commit{message} .=$_."\n";2302}2303}2304close GITLOG;23052306unshift@commits, \%commitif(keys%commit);23072308# Now all the commits are in the @commits bucket2309# ordered by time DESC. for each commit that needs processing,2310# determine whether it's following the last head we've seen or if2311# it's on its own branch, grab a file list, and add whatever's changed2312# NOTE: $lastcommit refers to the last commit from previous run2313# $lastpicked is the last commit we picked in this run2314my$lastpicked;2315my$head= {};2316if(defined$lastcommit) {2317$lastpicked=$lastcommit;2318}23192320my$committotal=scalar(@commits);2321my$commitcount=0;23222323# Load the head table into $head (for cached lookups during the update process)2324foreachmy$file( @{$self->gethead()} )2325{2326$head->{$file->{name}} =$file;2327}23282329foreachmy$commit(@commits)2330{2331$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2332if(defined$lastpicked)2333{2334if(!in_array($lastpicked, @{$commit->{parents}}))2335{2336# skip, we'll see this delta2337# as part of a merge later2338# warn "skipping off-track $commit->{hash}\n";2339next;2340}elsif(@{$commit->{parents}} >1) {2341# it is a merge commit, for each parent that is2342# not $lastpicked, see if we can get a log2343# from the merge-base to that parent to put it2344# in the message as a merge summary.2345my@parents= @{$commit->{parents}};2346foreachmy$parent(@parents) {2347# git-merge-base can potentially (but rarely) throw2348# several candidate merge bases. let's assume2349# that the first one is the best one.2350if($parenteq$lastpicked) {2351next;2352}2353open my$p,'git-merge-base '.$lastpicked.' '2354.$parent.'|';2355my@output= (<$p>);2356close$p;2357my$base=join('',@output);2358chomp$base;2359if($base) {2360my@merged;2361# print "want to log between $base $parent \n";2362open(GITLOG,'-|','git-log',"$base..$parent")2363or die"Cannot call git-log:$!";2364my$mergedhash;2365while(<GITLOG>) {2366chomp;2367if(!defined$mergedhash) {2368if(m/^commit\s+(.+)$/) {2369$mergedhash=$1;2370}else{2371next;2372}2373}else{2374# grab the first line that looks non-rfc8222375# aka has content after leading space2376if(m/^\s+(\S.*)$/) {2377my$title=$1;2378$title=substr($title,0,100);# truncate2379unshift@merged,"$mergedhash$title";2380undef$mergedhash;2381}2382}2383}2384close GITLOG;2385if(@merged) {2386$commit->{mergemsg} =$commit->{message};2387$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2388foreachmy$summary(@merged) {2389$commit->{mergemsg} .="\t$summary\n";2390}2391$commit->{mergemsg} .="\n\n";2392# print "Message for $commit->{hash} \n$commit->{mergemsg}";2393}2394}2395}2396}2397}23982399# convert the date to CVS-happy format2400$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);24012402if(defined($lastpicked) )2403{2404my$filepipe=open(FILELIST,'-|','git-diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2405local($/) ="\0";2406while( <FILELIST> )2407{2408chomp;2409unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)2410{2411die("Couldn't process git-diff-tree line :$_");2412}2413my($mode,$hash,$change) = ($1,$2,$3);2414my$name= <FILELIST>;2415chomp($name);24162417# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");24182419my$git_perms="";2420$git_perms.="r"if($mode&4);2421$git_perms.="w"if($mode&2);2422$git_perms.="x"if($mode&1);2423$git_perms="rw"if($git_permseq"");24242425if($changeeq"D")2426{2427#$log->debug("DELETE $name");2428$head->{$name} = {2429 name =>$name,2430 revision =>$head->{$name}{revision} +1,2431 filehash =>"deleted",2432 commithash =>$commit->{hash},2433 modified =>$commit->{date},2434 author =>$commit->{author},2435 mode =>$git_perms,2436};2437$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2438}2439elsif($changeeq"M")2440{2441#$log->debug("MODIFIED $name");2442$head->{$name} = {2443 name =>$name,2444 revision =>$head->{$name}{revision} +1,2445 filehash =>$hash,2446 commithash =>$commit->{hash},2447 modified =>$commit->{date},2448 author =>$commit->{author},2449 mode =>$git_perms,2450};2451$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2452}2453elsif($changeeq"A")2454{2455#$log->debug("ADDED $name");2456$head->{$name} = {2457 name =>$name,2458 revision =>1,2459 filehash =>$hash,2460 commithash =>$commit->{hash},2461 modified =>$commit->{date},2462 author =>$commit->{author},2463 mode =>$git_perms,2464};2465$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2466}2467else2468{2469$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");2470die;2471}2472}2473close FILELIST;2474}else{2475# this is used to detect files removed from the repo2476my$seen_files= {};24772478my$filepipe=open(FILELIST,'-|','git-ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2479local$/="\0";2480while( <FILELIST> )2481{2482chomp;2483unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)2484{2485die("Couldn't process git-ls-tree line :$_");2486}24872488my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);24892490$seen_files->{$git_filename} =1;24912492my($oldhash,$oldrevision,$oldmode) = (2493$head->{$git_filename}{filehash},2494$head->{$git_filename}{revision},2495$head->{$git_filename}{mode}2496);24972498if($git_perms=~/^\d\d\d(\d)\d\d/o)2499{2500$git_perms="";2501$git_perms.="r"if($1&4);2502$git_perms.="w"if($1&2);2503$git_perms.="x"if($1&1);2504}else{2505$git_perms="rw";2506}25072508# unless the file exists with the same hash, we need to update it ...2509unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2510{2511my$newrevision= ($oldrevisionor0) +1;25122513$head->{$git_filename} = {2514 name =>$git_filename,2515 revision =>$newrevision,2516 filehash =>$git_hash,2517 commithash =>$commit->{hash},2518 modified =>$commit->{date},2519 author =>$commit->{author},2520 mode =>$git_perms,2521};252225232524$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2525}2526}2527close FILELIST;25282529# Detect deleted files2530foreachmy$file(keys%$head)2531{2532unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2533{2534$head->{$file}{revision}++;2535$head->{$file}{filehash} ="deleted";2536$head->{$file}{commithash} =$commit->{hash};2537$head->{$file}{modified} =$commit->{date};2538$head->{$file}{author} =$commit->{author};25392540$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2541}2542}2543# END : "Detect deleted files"2544}254525462547if(exists$commit->{mergemsg})2548{2549$self->insert_mergelog($commit->{hash},$commit->{mergemsg});2550}25512552$lastpicked=$commit->{hash};25532554$self->_set_prop("last_commit",$commit->{hash});2555}25562557$self->delete_head();2558foreachmy$file(keys%$head)2559{2560$self->insert_head(2561$file,2562$head->{$file}{revision},2563$head->{$file}{filehash},2564$head->{$file}{commithash},2565$head->{$file}{modified},2566$head->{$file}{author},2567$head->{$file}{mode},2568);2569}2570# invalidate the gethead cache2571$self->{gethead_cache} =undef;257225732574# Ending exclusive lock here2575$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2576}25772578sub insert_rev2579{2580my$self=shift;2581my$name=shift;2582my$revision=shift;2583my$filehash=shift;2584my$commithash=shift;2585my$modified=shift;2586my$author=shift;2587my$mode=shift;25882589my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2590$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);2591}25922593sub insert_mergelog2594{2595my$self=shift;2596my$key=shift;2597my$value=shift;25982599my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);2600$insert_mergelog->execute($key,$value);2601}26022603sub delete_head2604{2605my$self=shift;26062607my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);2608$delete_head->execute();2609}26102611sub insert_head2612{2613my$self=shift;2614my$name=shift;2615my$revision=shift;2616my$filehash=shift;2617my$commithash=shift;2618my$modified=shift;2619my$author=shift;2620my$mode=shift;26212622my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2623$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);2624}26252626sub _headrev2627{2628my$self=shift;2629my$filename=shift;26302631my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2632$db_query->execute($filename);2633my($hash,$revision,$mode) =$db_query->fetchrow_array;26342635return($hash,$revision,$mode);2636}26372638sub _get_prop2639{2640my$self=shift;2641my$key=shift;26422643my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2644$db_query->execute($key);2645my($value) =$db_query->fetchrow_array;26462647return$value;2648}26492650sub _set_prop2651{2652my$self=shift;2653my$key=shift;2654my$value=shift;26552656my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2657$db_query->execute($value,$key);26582659unless($db_query->rows)2660{2661$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2662$db_query->execute($key,$value);2663}26642665return$value;2666}26672668=head2 gethead26692670=cut26712672sub gethead2673{2674my$self=shift;26752676return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );26772678my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);2679$db_query->execute();26802681my$tree= [];2682while(my$file=$db_query->fetchrow_hashref)2683{2684push@$tree,$file;2685}26862687$self->{gethead_cache} =$tree;26882689return$tree;2690}26912692=head2 getlog26932694=cut26952696sub getlog2697{2698my$self=shift;2699my$filename=shift;27002701my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2702$db_query->execute($filename);27032704my$tree= [];2705while(my$file=$db_query->fetchrow_hashref)2706{2707push@$tree,$file;2708}27092710return$tree;2711}27122713=head2 getmeta27142715This function takes a filename (with path) argument and returns a hashref of2716metadata for that file.27172718=cut27192720sub getmeta2721{2722my$self=shift;2723my$filename=shift;2724my$revision=shift;27252726my$db_query;2727if(defined($revision)and$revision=~/^\d+$/)2728{2729$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2730$db_query->execute($filename,$revision);2731}2732elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2733{2734$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2735$db_query->execute($filename,$revision);2736}else{2737$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2738$db_query->execute($filename);2739}27402741return$db_query->fetchrow_hashref;2742}27432744=head2 commitmessage27452746this function takes a commithash and returns the commit message for that commit27472748=cut2749sub commitmessage2750{2751my$self=shift;2752my$commithash=shift;27532754die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);27552756my$db_query;2757$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2758$db_query->execute($commithash);27592760my($message) =$db_query->fetchrow_array;27612762if(defined($message) )2763{2764$message.=" "if($message=~/\n$/);2765return$message;2766}27672768my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2769shift@lineswhile($lines[0] =~/\S/);2770$message=join("",@lines);2771$message.=" "if($message=~/\n$/);2772return$message;2773}27742775=head2 gethistory27762777This function takes a filename (with path) argument and returns an arrayofarrays2778containing revision,filehash,commithash ordered by revision descending27792780=cut2781sub gethistory2782{2783my$self=shift;2784my$filename=shift;27852786my$db_query;2787$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2788$db_query->execute($filename);27892790return$db_query->fetchall_arrayref;2791}27922793=head2 gethistorydense27942795This function takes a filename (with path) argument and returns an arrayofarrays2796containing revision,filehash,commithash ordered by revision descending.27972798This version of gethistory skips deleted entries -- so it is useful for annotate.2799The 'dense' part is a reference to a '--dense' option available for git-rev-list2800and other git tools that depend on it.28012802=cut2803sub gethistorydense2804{2805my$self=shift;2806my$filename=shift;28072808my$db_query;2809$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2810$db_query->execute($filename);28112812return$db_query->fetchall_arrayref;2813}28142815=head2 in_array()28162817from Array::PAT - mimics the in_array() function2818found in PHP. Yuck but works for small arrays.28192820=cut2821sub in_array2822{2823my($check,@array) =@_;2824my$retval=0;2825foreachmy$test(@array){2826if($checkeq$test){2827$retval=1;2828}2829}2830return$retval;2831}28322833=head2 safe_pipe_capture28342835an alternative to `command` that allows input to be passed as an array2836to work around shell problems with weird characters in arguments28372838=cut2839sub safe_pipe_capture {28402841my@output;28422843if(my$pid=open my$child,'-|') {2844@output= (<$child>);2845close$childor die join(' ',@_).":$!$?";2846}else{2847exec(@_)or die"$!$?";# exec() can fail the executable can't be found2848}2849returnwantarray?@output:join('',@output);2850}2851285228531;