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@laptop.org> 12#### 13#### 14#### Released under the GNU Public License, version 2. 15#### 16#### 17 18use5.008; 19use strict; 20use warnings; 21use bytes; 22 23use Fcntl; 24use File::Temp qw/tempdir tempfile/; 25use File::Path qw/rmtree/; 26use File::Basename; 27use Getopt::Long qw(:config require_order no_ignore_case); 28 29my$VERSION='@@GIT_VERSION@@'; 30 31my$log= GITCVS::log->new(); 32my$cfg; 33 34my$DATE_LIST= { 35 Jan =>"01", 36 Feb =>"02", 37 Mar =>"03", 38 Apr =>"04", 39 May =>"05", 40 Jun =>"06", 41 Jul =>"07", 42 Aug =>"08", 43 Sep =>"09", 44 Oct =>"10", 45 Nov =>"11", 46 Dec =>"12", 47}; 48 49# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 50$| =1; 51 52#### Definition and mappings of functions #### 53 54# NOTE: Despite the existence of req_CATCHALL and req_EMPTY unimplemented 55# requests, this list is incomplete. It is missing many rarer/optional 56# requests. Perhaps some clients require a claim of support for 57# these specific requests for main functionality to work? 58my$methods= { 59'Root'=> \&req_Root, 60'Valid-responses'=> \&req_Validresponses, 61'valid-requests'=> \&req_validrequests, 62'Directory'=> \&req_Directory, 63'Entry'=> \&req_Entry, 64'Modified'=> \&req_Modified, 65'Unchanged'=> \&req_Unchanged, 66'Questionable'=> \&req_Questionable, 67'Argument'=> \&req_Argument, 68'Argumentx'=> \&req_Argument, 69'expand-modules'=> \&req_expandmodules, 70'add'=> \&req_add, 71'remove'=> \&req_remove, 72'co'=> \&req_co, 73'update'=> \&req_update, 74'ci'=> \&req_ci, 75'diff'=> \&req_diff, 76'log'=> \&req_log, 77'rlog'=> \&req_log, 78'tag'=> \&req_CATCHALL, 79'status'=> \&req_status, 80'admin'=> \&req_CATCHALL, 81'history'=> \&req_CATCHALL, 82'watchers'=> \&req_EMPTY, 83'editors'=> \&req_EMPTY, 84'noop'=> \&req_EMPTY, 85'annotate'=> \&req_annotate, 86'Global_option'=> \&req_Globaloption, 87}; 88 89############################################## 90 91 92# $state holds all the bits of information the clients sends us that could 93# potentially be useful when it comes to actually _doing_ something. 94my$state= { prependdir =>''}; 95 96# Work is for managing temporary working directory 97my$work= 98{ 99state=>undef,# undef, 1 (empty), 2 (with stuff) 100 workDir =>undef, 101index=>undef, 102 emptyDir =>undef, 103 tmpDir =>undef 104}; 105 106$log->info("--------------- STARTING -----------------"); 107 108my$usage= 109"Usage: git cvsserver [options] [pserver|server] [<directory> ...]\n". 110" --base-path <path> : Prepend to requested CVSROOT\n". 111" Can be read from GIT_CVSSERVER_BASE_PATH\n". 112" --strict-paths : Don't allow recursing into subdirectories\n". 113" --export-all : Don't check for gitcvs.enabled in config\n". 114" --version, -V : Print version information and exit\n". 115" -h, -H : Print usage information and exit\n". 116"\n". 117"<directory> ... is a list of allowed directories. If no directories\n". 118"are given, all are allowed. This is an additional restriction, gitcvs\n". 119"access still needs to be enabled by the gitcvs.enabled config option.\n". 120"Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n"; 121 122my@opts= ('h|H','version|V', 123'base-path=s','strict-paths','export-all'); 124GetOptions($state,@opts) 125or die$usage; 126 127if($state->{version}) { 128print"git-cvsserver version$VERSION\n"; 129exit; 130} 131if($state->{help}) { 132print$usage; 133exit; 134} 135 136my$TEMP_DIR= tempdir( CLEANUP =>1); 137$log->debug("Temporary directory is '$TEMP_DIR'"); 138 139$state->{method} ='ext'; 140if(@ARGV) { 141if($ARGV[0]eq'pserver') { 142$state->{method} ='pserver'; 143shift@ARGV; 144}elsif($ARGV[0]eq'server') { 145shift@ARGV; 146} 147} 148 149# everything else is a directory 150$state->{allowed_roots} = [@ARGV]; 151 152# don't export the whole system unless the users requests it 153if($state->{'export-all'} && !@{$state->{allowed_roots}}) { 154die"--export-all can only be used together with an explicit whitelist\n"; 155} 156 157# Environment handling for running under git-shell 158if(exists$ENV{GIT_CVSSERVER_BASE_PATH}) { 159if($state->{'base-path'}) { 160die"Cannot specify base path both ways.\n"; 161} 162my$base_path=$ENV{GIT_CVSSERVER_BASE_PATH}; 163$state->{'base-path'} =$base_path; 164$log->debug("Picked up base path '$base_path' from environment.\n"); 165} 166if(exists$ENV{GIT_CVSSERVER_ROOT}) { 167if(@{$state->{allowed_roots}}) { 168die"Cannot specify roots both ways:@ARGV\n"; 169} 170my$allowed_root=$ENV{GIT_CVSSERVER_ROOT}; 171$state->{allowed_roots} = [$allowed_root]; 172$log->debug("Picked up allowed root '$allowed_root' from environment.\n"); 173} 174 175# if we are called with a pserver argument, 176# deal with the authentication cat before entering the 177# main loop 178if($state->{method}eq'pserver') { 179my$line= <STDIN>;chomp$line; 180unless($line=~/^BEGIN (AUTH|VERIFICATION) REQUEST$/) { 181die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 182} 183my$request=$1; 184$line= <STDIN>;chomp$line; 185unless(req_Root('root',$line)) {# reuse Root 186print"E Invalid root$line\n"; 187exit1; 188} 189$line= <STDIN>;chomp$line; 190my$user=$line; 191$line= <STDIN>;chomp$line; 192my$password=$line; 193 194if($usereq'anonymous') { 195# "A" will be 1 byte, use length instead in case the 196# encryption method ever changes (yeah, right!) 197if(length($password) >1) { 198print"E Don't supply a password for the `anonymous' user\n"; 199print"I HATE YOU\n"; 200exit1; 201} 202 203# Fall through to LOVE 204}else{ 205# Trying to authenticate a user 206if(not exists$cfg->{gitcvs}->{authdb}) { 207print"E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n"; 208print"I HATE YOU\n"; 209exit1; 210} 211 212my$authdb=$cfg->{gitcvs}->{authdb}; 213 214unless(-e $authdb) { 215print"E The authentication database specified in [gitcvs.authdb] does not exist\n"; 216print"I HATE YOU\n"; 217exit1; 218} 219 220my$auth_ok; 221open my$passwd,"<",$authdbor die$!; 222while(<$passwd>) { 223if(m{^\Q$user\E:(.*)}) { 224if(crypt($user, descramble($password))eq$1) { 225$auth_ok=1; 226} 227}; 228} 229close$passwd; 230 231unless($auth_ok) { 232print"I HATE YOU\n"; 233exit1; 234} 235 236# Fall through to LOVE 237} 238 239# For checking whether the user is anonymous on commit 240$state->{user} =$user; 241 242$line= <STDIN>;chomp$line; 243unless($lineeq"END$requestREQUEST") { 244die"E Do not understand$line-- expecting END$requestREQUEST\n"; 245} 246print"I LOVE YOU\n"; 247exit if$requesteq'VERIFICATION';# cvs login 248# and now back to our regular programme... 249} 250 251# Keep going until the client closes the connection 252while(<STDIN>) 253{ 254chomp; 255 256# Check to see if we've seen this method, and call appropriate function. 257if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 258{ 259# use the $methods hash to call the appropriate sub for this command 260#$log->info("Method : $1"); 261&{$methods->{$1}}($1,$2); 262}else{ 263# log fatal because we don't understand this function. If this happens 264# we're fairly screwed because we don't know if the client is expecting 265# a response. If it is, the client will hang, we'll hang, and the whole 266# thing will be custard. 267$log->fatal("Don't understand command$_\n"); 268die("Unknown command$_"); 269} 270} 271 272$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 273$log->info("--------------- FINISH -----------------"); 274 275chdir'/'; 276exit0; 277 278# Magic catchall method. 279# This is the method that will handle all commands we haven't yet 280# implemented. It simply sends a warning to the log file indicating a 281# command that hasn't been implemented has been invoked. 282sub req_CATCHALL 283{ 284my($cmd,$data) =@_; 285$log->warn("Unhandled command : req_$cmd:$data"); 286} 287 288# This method invariably succeeds with an empty response. 289sub req_EMPTY 290{ 291print"ok\n"; 292} 293 294# Root pathname \n 295# Response expected: no. Tell the server which CVSROOT to use. Note that 296# pathname is a local directory and not a fully qualified CVSROOT variable. 297# pathname must already exist; if creating a new root, use the init 298# request, not Root. pathname does not include the hostname of the server, 299# how to access the server, etc.; by the time the CVS protocol is in use, 300# connection, authentication, etc., are already taken care of. The Root 301# request must be sent only once, and it must be sent before any requests 302# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 303sub req_Root 304{ 305my($cmd,$data) =@_; 306$log->debug("req_Root :$data"); 307 308unless($data=~ m#^/#) { 309print"error 1 Root must be an absolute pathname\n"; 310return0; 311} 312 313my$cvsroot=$state->{'base-path'} ||''; 314$cvsroot=~ s#/+$##; 315$cvsroot.=$data; 316 317if($state->{CVSROOT} 318&& ($state->{CVSROOT}ne$cvsroot)) { 319print"error 1 Conflicting roots specified\n"; 320return0; 321} 322 323$state->{CVSROOT} =$cvsroot; 324 325$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 326 327if(@{$state->{allowed_roots}}) { 328my$allowed=0; 329foreachmy$dir(@{$state->{allowed_roots}}) { 330next unless$dir=~ m#^/#; 331$dir=~ s#/+$##; 332if($state->{'strict-paths'}) { 333if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 334$allowed=1; 335last; 336} 337}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 338$allowed=1; 339last; 340} 341} 342 343unless($allowed) { 344print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 345print"E\n"; 346print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 347return0; 348} 349} 350 351unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 352print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 353print"E\n"; 354print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 355return0; 356} 357 358my@gitvars=`git config -l`; 359if($?) { 360print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 361print"E\n"; 362print"error 1 - problem executing git-config\n"; 363return0; 364} 365foreachmy$line(@gitvars) 366{ 367next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 368unless($2) { 369$cfg->{$1}{$3} =$4; 370}else{ 371$cfg->{$1}{$2}{$3} =$4; 372} 373} 374 375my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 376||$cfg->{gitcvs}{enabled}); 377unless($state->{'export-all'} || 378($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 379print"E GITCVS emulation needs to be enabled on this repo\n"; 380print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 381print"E\n"; 382print"error 1 GITCVS emulation disabled\n"; 383return0; 384} 385 386my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 387if($logfile) 388{ 389$log->setfile($logfile); 390}else{ 391$log->nofile(); 392} 393 394return1; 395} 396 397# Global_option option \n 398# Response expected: no. Transmit one of the global options `-q', `-Q', 399# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 400# variations (such as combining of options) are allowed. For graceful 401# handling of valid-requests, it is probably better to make new global 402# options separate requests, rather than trying to add them to this 403# request. 404sub req_Globaloption 405{ 406my($cmd,$data) =@_; 407$log->debug("req_Globaloption :$data"); 408$state->{globaloptions}{$data} =1; 409} 410 411# Valid-responses request-list \n 412# Response expected: no. Tell the server what responses the client will 413# accept. request-list is a space separated list of tokens. 414sub req_Validresponses 415{ 416my($cmd,$data) =@_; 417$log->debug("req_Validresponses :$data"); 418 419# TODO : re-enable this, currently it's not particularly useful 420#$state->{validresponses} = [ split /\s+/, $data ]; 421} 422 423# valid-requests \n 424# Response expected: yes. Ask the server to send back a Valid-requests 425# response. 426sub req_validrequests 427{ 428my($cmd,$data) =@_; 429 430$log->debug("req_validrequests"); 431 432$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 433$log->debug("SEND : ok"); 434 435print"Valid-requests ".join(" ",keys%$methods) ."\n"; 436print"ok\n"; 437} 438 439# Directory local-directory \n 440# Additional data: repository \n. Response expected: no. Tell the server 441# what directory to use. The repository should be a directory name from a 442# previous server response. Note that this both gives a default for Entry 443# and Modified and also for ci and the other commands; normal usage is to 444# send Directory for each directory in which there will be an Entry or 445# Modified, and then a final Directory for the original directory, then the 446# command. The local-directory is relative to the top level at which the 447# command is occurring (i.e. the last Directory which is sent before the 448# command); to indicate that top level, `.' should be sent for 449# local-directory. 450sub req_Directory 451{ 452my($cmd,$data) =@_; 453 454my$repository= <STDIN>; 455chomp$repository; 456 457 458$state->{localdir} =$data; 459$state->{repository} =$repository; 460$state->{path} =$repository; 461$state->{path} =~s/^\Q$state->{CVSROOT}\E\///; 462$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 463$state->{path} .="/"if($state->{path} =~ /\S/ ); 464 465$state->{directory} =$state->{localdir}; 466$state->{directory} =""if($state->{directory}eq"."); 467$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 468 469if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 470{ 471$log->info("Setting prepend to '$state->{path}'"); 472$state->{prependdir} =$state->{path}; 473foreachmy$entry(keys%{$state->{entries}} ) 474{ 475$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 476delete$state->{entries}{$entry}; 477} 478} 479 480if(defined($state->{prependdir} ) ) 481{ 482$log->debug("Prepending '$state->{prependdir}' to state|directory"); 483$state->{directory} =$state->{prependdir} .$state->{directory} 484} 485$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 486} 487 488# Entry entry-line \n 489# Response expected: no. Tell the server what version of a file is on the 490# local machine. The name in entry-line is a name relative to the directory 491# most recently specified with Directory. If the user is operating on only 492# some files in a directory, Entry requests for only those files need be 493# included. If an Entry request is sent without Modified, Is-modified, or 494# Unchanged, it means the file is lost (does not exist in the working 495# directory). If both Entry and one of Modified, Is-modified, or Unchanged 496# are sent for the same file, Entry must be sent first. For a given file, 497# one can send Modified, Is-modified, or Unchanged, but not more than one 498# of these three. 499sub req_Entry 500{ 501my($cmd,$data) =@_; 502 503#$log->debug("req_Entry : $data"); 504 505my@data=split(/\//,$data); 506 507$state->{entries}{$state->{directory}.$data[1]} = { 508 revision =>$data[2], 509 conflict =>$data[3], 510 options =>$data[4], 511 tag_or_date =>$data[5], 512}; 513 514$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 515} 516 517# Questionable filename \n 518# Response expected: no. Additional data: no. Tell the server to check 519# whether filename should be ignored, and if not, next time the server 520# sends responses, send (in a M response) `?' followed by the directory and 521# filename. filename must not contain `/'; it needs to be a file in the 522# directory named by the most recent Directory request. 523sub req_Questionable 524{ 525my($cmd,$data) =@_; 526 527$log->debug("req_Questionable :$data"); 528$state->{entries}{$state->{directory}.$data}{questionable} =1; 529} 530 531# add \n 532# Response expected: yes. Add a file or directory. This uses any previous 533# Argument, Directory, Entry, or Modified requests, if they have been sent. 534# The last Directory sent specifies the working directory at the time of 535# the operation. To add a directory, send the directory to be added using 536# Directory and Argument requests. 537sub req_add 538{ 539my($cmd,$data) =@_; 540 541 argsplit("add"); 542 543my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 544$updater->update(); 545 546 argsfromdir($updater); 547 548my$addcount=0; 549 550foreachmy$filename( @{$state->{args}} ) 551{ 552$filename= filecleanup($filename); 553 554my$meta=$updater->getmeta($filename); 555my$wrev= revparse($filename); 556 557if($wrev&&$meta&& ($wrev=~/^-/)) 558{ 559# previously removed file, add back 560$log->info("added file$filenamewas previously removed, send$meta->{revision}"); 561 562print"MT +updated\n"; 563print"MT text U\n"; 564print"MT fname$filename\n"; 565print"MT newline\n"; 566print"MT -updated\n"; 567 568unless($state->{globaloptions}{-n} ) 569{ 570my($filepart,$dirpart) = filenamesplit($filename,1); 571 572print"Created$dirpart\n"; 573print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 574 575# this is an "entries" line 576my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 577$log->debug("/$filepart/$meta->{revision}//$kopts/"); 578print"/$filepart/$meta->{revision}//$kopts/\n"; 579# permissions 580$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 581print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 582# transmit file 583 transmitfile($meta->{filehash}); 584} 585 586next; 587} 588 589unless(defined($state->{entries}{$filename}{modified_filename} ) ) 590{ 591print"E cvs add: nothing known about `$filename'\n"; 592next; 593} 594# TODO : check we're not squashing an already existing file 595if(defined($state->{entries}{$filename}{revision} ) ) 596{ 597print"E cvs add: `$filename' has already been entered\n"; 598next; 599} 600 601my($filepart,$dirpart) = filenamesplit($filename,1); 602 603print"E cvs add: scheduling file `$filename' for addition\n"; 604 605print"Checked-in$dirpart\n"; 606print"$filename\n"; 607my$kopts= kopts_from_path($filename,"file", 608$state->{entries}{$filename}{modified_filename}); 609print"/$filepart/0//$kopts/\n"; 610 611my$requestedKopts=$state->{opt}{k}; 612if(defined($requestedKopts)) 613{ 614$requestedKopts="-k$requestedKopts"; 615} 616else 617{ 618$requestedKopts=""; 619} 620if($koptsne$requestedKopts) 621{ 622$log->warn("Ignoring requested -k='$requestedKopts'" 623." for '$filename'; detected -k='$kopts' instead"); 624#TODO: Also have option to send warning to user? 625} 626 627$addcount++; 628} 629 630if($addcount==1) 631{ 632print"E cvs add: use `cvs commit' to add this file permanently\n"; 633} 634elsif($addcount>1) 635{ 636print"E cvs add: use `cvs commit' to add these files permanently\n"; 637} 638 639print"ok\n"; 640} 641 642# remove \n 643# Response expected: yes. Remove a file. This uses any previous Argument, 644# Directory, Entry, or Modified requests, if they have been sent. The last 645# Directory sent specifies the working directory at the time of the 646# operation. Note that this request does not actually do anything to the 647# repository; the only effect of a successful remove request is to supply 648# the client with a new entries line containing `-' to indicate a removed 649# file. In fact, the client probably could perform this operation without 650# contacting the server, although using remove may cause the server to 651# perform a few more checks. The client sends a subsequent ci request to 652# actually record the removal in the repository. 653sub req_remove 654{ 655my($cmd,$data) =@_; 656 657 argsplit("remove"); 658 659# Grab a handle to the SQLite db and do any necessary updates 660my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 661$updater->update(); 662 663#$log->debug("add state : " . Dumper($state)); 664 665my$rmcount=0; 666 667foreachmy$filename( @{$state->{args}} ) 668{ 669$filename= filecleanup($filename); 670 671if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 672{ 673print"E cvs remove: file `$filename' still in working directory\n"; 674next; 675} 676 677my$meta=$updater->getmeta($filename); 678my$wrev= revparse($filename); 679 680unless(defined($wrev) ) 681{ 682print"E cvs remove: nothing known about `$filename'\n"; 683next; 684} 685 686if(defined($wrev)and($wrev=~/^-/) ) 687{ 688print"E cvs remove: file `$filename' already scheduled for removal\n"; 689next; 690} 691 692unless($wreveq$meta->{revision} ) 693{ 694# TODO : not sure if the format of this message is quite correct. 695print"E cvs remove: Up to date check failed for `$filename'\n"; 696next; 697} 698 699 700my($filepart,$dirpart) = filenamesplit($filename,1); 701 702print"E cvs remove: scheduling `$filename' for removal\n"; 703 704print"Checked-in$dirpart\n"; 705print"$filename\n"; 706my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 707print"/$filepart/-$wrev//$kopts/\n"; 708 709$rmcount++; 710} 711 712if($rmcount==1) 713{ 714print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 715} 716elsif($rmcount>1) 717{ 718print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 719} 720 721print"ok\n"; 722} 723 724# Modified filename \n 725# Response expected: no. Additional data: mode, \n, file transmission. Send 726# the server a copy of one locally modified file. filename is a file within 727# the most recent directory sent with Directory; it must not contain `/'. 728# If the user is operating on only some files in a directory, only those 729# files need to be included. This can also be sent without Entry, if there 730# is no entry for the file. 731sub req_Modified 732{ 733my($cmd,$data) =@_; 734 735my$mode= <STDIN>; 736defined$mode 737or(print"E end of file reading mode for$data\n"),return; 738chomp$mode; 739my$size= <STDIN>; 740defined$size 741or(print"E end of file reading size of$data\n"),return; 742chomp$size; 743 744# Grab config information 745my$blocksize=8192; 746my$bytesleft=$size; 747my$tmp; 748 749# Get a filehandle/name to write it to 750my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 751 752# Loop over file data writing out to temporary file. 753while($bytesleft) 754{ 755$blocksize=$bytesleftif($bytesleft<$blocksize); 756read STDIN,$tmp,$blocksize; 757print$fh $tmp; 758$bytesleft-=$blocksize; 759} 760 761close$fh 762or(print"E failed to write temporary,$filename:$!\n"),return; 763 764# Ensure we have something sensible for the file mode 765if($mode=~/u=(\w+)/) 766{ 767$mode=$1; 768}else{ 769$mode="rw"; 770} 771 772# Save the file data in $state 773$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 774$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 775$state->{entries}{$state->{directory}.$data}{modified_hash} =`git hash-object$filename`; 776$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 777 778 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 779} 780 781# Unchanged filename\n 782# Response expected: no. Tell the server that filename has not been 783# modified in the checked out directory. The filename is a file within the 784# most recent directory sent with Directory; it must not contain `/'. 785sub req_Unchanged 786{ 787 my ($cmd,$data) =@_; 788 789$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 790 791 #$log->debug("req_Unchanged :$data"); 792} 793 794# Argument text\n 795# Response expected: no. Save argument for use in a subsequent command. 796# Arguments accumulate until an argument-using command is given, at which 797# point they are forgotten. 798# Argumentx text\n 799# Response expected: no. Append\nfollowed by text to the current argument 800# being saved. 801sub req_Argument 802{ 803 my ($cmd,$data) =@_; 804 805 # Argumentx means: append to last Argument (with a newline in front) 806 807$log->debug("$cmd:$data"); 808 809 if ($cmdeq 'Argumentx') { 810 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 811 } else { 812 push @{$state->{arguments}},$data; 813 } 814} 815 816# expand-modules\n 817# Response expected: yes. Expand the modules which are specified in the 818# arguments. Returns the data in Module-expansion responses. Note that the 819# server can assume that this is checkout or export, not rtag or rdiff; the 820# latter do not access the working directory and thus have no need to 821# expand modules on the client side. Expand may not be the best word for 822# what this request does. It does not necessarily tell you all the files 823# contained in a module, for example. Basically it is a way of telling you 824# which working directories the server needs to know about in order to 825# handle a checkout of the specified modules. For example, suppose that the 826# server has a module defined by 827# aliasmodule -a 1dir 828# That is, one can check out aliasmodule and it will take 1dir in the 829# repository and check it out to 1dir in the working directory. Now suppose 830# the client already has this module checked out and is planning on using 831# the co request to update it. Without using expand-modules, the client 832# would have two bad choices: it could either send information about all 833# working directories under the current directory, which could be 834# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 835# stands for 1dir, and neglect to send information for 1dir, which would 836# lead to incorrect operation. With expand-modules, the client would first 837# ask for the module to be expanded: 838sub req_expandmodules 839{ 840 my ($cmd,$data) =@_; 841 842 argsplit(); 843 844$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 845 846 unless ( ref$state->{arguments} eq "ARRAY" ) 847 { 848 print "ok\n"; 849 return; 850 } 851 852 foreach my$module( @{$state->{arguments}} ) 853 { 854$log->debug("SEND : Module-expansion$module"); 855 print "Module-expansion$module\n"; 856 } 857 858 print "ok\n"; 859 statecleanup(); 860} 861 862# co\n 863# Response expected: yes. Get files from the repository. This uses any 864# previous Argument, Directory, Entry, or Modified requests, if they have 865# been sent. Arguments to this command are module names; the client cannot 866# know what directories they correspond to except by (1) just sending the 867# co request, and then seeing what directory names the server sends back in 868# its responses, and (2) the expand-modules request. 869sub req_co 870{ 871 my ($cmd,$data) =@_; 872 873 argsplit("co"); 874 875 # Provide list of modules, if -c was used. 876 if (exists$state->{opt}{c}) { 877 my$showref= `git show-ref --heads`; 878 for my$line(split '\n',$showref) { 879 if ($line=~ m% refs/heads/(.*)$%) { 880 print "M$1\t$1\n"; 881 } 882 } 883 print "ok\n"; 884 return 1; 885 } 886 887 my$module=$state->{args}[0]; 888$state->{module} =$module; 889 my$checkout_path=$module; 890 891 # use the user specified directory if we're given it 892$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 893 894$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 895 896$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 897 898$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 899 900# Grab a handle to the SQLite db and do any necessary updates 901my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 902$updater->update(); 903 904$checkout_path=~ s|/$||;# get rid of trailing slashes 905 906# Eclipse seems to need the Clear-sticky command 907# to prepare the 'Entries' file for the new directory. 908print"Clear-sticky$checkout_path/\n"; 909print$state->{CVSROOT} ."/$module/\n"; 910print"Clear-static-directory$checkout_path/\n"; 911print$state->{CVSROOT} ."/$module/\n"; 912print"Clear-sticky$checkout_path/\n";# yes, twice 913print$state->{CVSROOT} ."/$module/\n"; 914print"Template$checkout_path/\n"; 915print$state->{CVSROOT} ."/$module/\n"; 916print"0\n"; 917 918# instruct the client that we're checking out to $checkout_path 919print"E cvs checkout: Updating$checkout_path\n"; 920 921my%seendirs= (); 922my$lastdir=''; 923 924# recursive 925sub prepdir { 926my($dir,$repodir,$remotedir,$seendirs) =@_; 927my$parent= dirname($dir); 928$dir=~ s|/+$||; 929$repodir=~ s|/+$||; 930$remotedir=~ s|/+$||; 931$parent=~ s|/+$||; 932$log->debug("announcedir$dir,$repodir,$remotedir"); 933 934if($parenteq'.'||$parenteq'./') { 935$parent=''; 936} 937# recurse to announce unseen parents first 938if(length($parent) && !exists($seendirs->{$parent})) { 939 prepdir($parent,$repodir,$remotedir,$seendirs); 940} 941# Announce that we are going to modify at the parent level 942if($parent) { 943print"E cvs checkout: Updating$remotedir/$parent\n"; 944}else{ 945print"E cvs checkout: Updating$remotedir\n"; 946} 947print"Clear-sticky$remotedir/$parent/\n"; 948print"$repodir/$parent/\n"; 949 950print"Clear-static-directory$remotedir/$dir/\n"; 951print"$repodir/$dir/\n"; 952print"Clear-sticky$remotedir/$parent/\n";# yes, twice 953print"$repodir/$parent/\n"; 954print"Template$remotedir/$dir/\n"; 955print"$repodir/$dir/\n"; 956print"0\n"; 957 958$seendirs->{$dir} =1; 959} 960 961foreachmy$git( @{$updater->gethead} ) 962{ 963# Don't want to check out deleted files 964next if($git->{filehash}eq"deleted"); 965 966my$fullName=$git->{name}; 967($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 968 969if(length($git->{dir}) &&$git->{dir}ne'./' 970&&$git->{dir}ne$lastdir) { 971unless(exists($seendirs{$git->{dir}})) { 972 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 973$checkout_path, \%seendirs); 974$lastdir=$git->{dir}; 975$seendirs{$git->{dir}} =1; 976} 977print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 978} 979 980# modification time of this file 981print"Mod-time$git->{modified}\n"; 982 983# print some information to the client 984if(defined($git->{dir} )and$git->{dir}ne"./") 985{ 986print"M U$checkout_path/$git->{dir}$git->{name}\n"; 987}else{ 988print"M U$checkout_path/$git->{name}\n"; 989} 990 991# instruct client we're sending a file to put in this path 992print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 993 994print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 995 996# this is an "entries" line 997my$kopts= kopts_from_path($fullName,"sha1",$git->{filehash}); 998print"/$git->{name}/$git->{revision}//$kopts/\n"; 999# permissions1000print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";10011002# transmit file1003 transmitfile($git->{filehash});1004}10051006print"ok\n";10071008 statecleanup();1009}10101011# update \n1012# Response expected: yes. Actually do a cvs update command. This uses any1013# previous Argument, Directory, Entry, or Modified requests, if they have1014# been sent. The last Directory sent specifies the working directory at the1015# time of the operation. The -I option is not used--files which the client1016# can decide whether to ignore are not mentioned and the client sends the1017# Questionable request for others.1018sub req_update1019{1020my($cmd,$data) =@_;10211022$log->debug("req_update : ". (defined($data) ?$data:"[NULL]"));10231024 argsplit("update");10251026#1027# It may just be a client exploring the available heads/modules1028# in that case, list them as top level directories and leave it1029# at that. Eclipse uses this technique to offer you a list of1030# projects (heads in this case) to checkout.1031#1032if($state->{module}eq'') {1033my$showref=`git show-ref --heads`;1034print"E cvs update: Updating .\n";1035formy$line(split'\n',$showref) {1036if($line=~ m% refs/heads/(.*)$%) {1037print"E cvs update: New directory `$1'\n";1038}1039}1040print"ok\n";1041return1;1042}104310441045# Grab a handle to the SQLite db and do any necessary updates1046my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);10471048$updater->update();10491050 argsfromdir($updater);10511052#$log->debug("update state : " . Dumper($state));10531054my$last_dirname="///";10551056# foreach file specified on the command line ...1057foreachmy$filename( @{$state->{args}} )1058{1059$filename= filecleanup($filename);10601061$log->debug("Processing file$filename");10621063unless($state->{globaloptions}{-Q} ||$state->{globaloptions}{-q} )1064{1065my$cur_dirname= dirname($filename);1066if($cur_dirnamene$last_dirname)1067{1068$last_dirname=$cur_dirname;1069if($cur_dirnameeq"")1070{1071$cur_dirname=".";1072}1073print"E cvs update: Updating$cur_dirname\n";1074}1075}10761077# if we have a -C we should pretend we never saw modified stuff1078if(exists($state->{opt}{C} ) )1079{1080delete$state->{entries}{$filename}{modified_hash};1081delete$state->{entries}{$filename}{modified_filename};1082$state->{entries}{$filename}{unchanged} =1;1083}10841085my$meta;1086if(defined($state->{opt}{r})and$state->{opt}{r} =~/^(1\.\d+)$/)1087{1088$meta=$updater->getmeta($filename,$1);1089}else{1090$meta=$updater->getmeta($filename);1091}10921093# If -p was given, "print" the contents of the requested revision.1094if(exists($state->{opt}{p} ) ) {1095if(defined($meta->{revision} ) ) {1096$log->info("Printing '$filename' revision ".$meta->{revision});10971098 transmitfile($meta->{filehash}, {print=>1});1099}11001101next;1102}11031104if( !defined$meta)1105{1106$meta= {1107 name =>$filename,1108 revision =>'0',1109 filehash =>'added'1110};1111}11121113my$oldmeta=$meta;11141115my$wrev= revparse($filename);11161117# If the working copy is an old revision, lets get that version too for comparison.1118if(defined($wrev)and$wrevne$meta->{revision} )1119{1120$oldmeta=$updater->getmeta($filename,$wrev);1121}11221123#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");11241125# Files are up to date if the working copy and repo copy have the same revision,1126# and the working copy is unmodified _and_ the user hasn't specified -C1127next if(defined($wrev)1128and defined($meta->{revision})1129and$wreveq$meta->{revision}1130and$state->{entries}{$filename}{unchanged}1131and not exists($state->{opt}{C} ) );11321133# If the working copy and repo copy have the same revision,1134# but the working copy is modified, tell the client it's modified1135if(defined($wrev)1136and defined($meta->{revision})1137and$wreveq$meta->{revision}1138and defined($state->{entries}{$filename}{modified_hash})1139and not exists($state->{opt}{C} ) )1140{1141$log->info("Tell the client the file is modified");1142print"MT text M\n";1143print"MT fname$filename\n";1144print"MT newline\n";1145next;1146}11471148if($meta->{filehash}eq"deleted")1149{1150# TODO: If it has been modified in the sandbox, error out1151# with the appropriate message, rather than deleting a modified1152# file.11531154my($filepart,$dirpart) = filenamesplit($filename,1);11551156$log->info("Removing '$filename' from working copy (no longer in the repo)");11571158print"E cvs update: `$filename' is no longer in the repository\n";1159# Don't want to actually _DO_ the update if -n specified1160unless($state->{globaloptions}{-n} ) {1161print"Removed$dirpart\n";1162print"$filepart\n";1163}1164}1165elsif(not defined($state->{entries}{$filename}{modified_hash} )1166or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1167or$meta->{filehash}eq'added')1168{1169# normal update, just send the new revision (either U=Update,1170# or A=Add, or R=Remove)1171if(defined($wrev) && ($wrev=~/^-/) )1172{1173$log->info("Tell the client the file is scheduled for removal");1174print"MT text R\n";1175print"MT fname$filename\n";1176print"MT newline\n";1177next;1178}1179elsif( (!defined($wrev) ||$wreveq'0') &&1180(!defined($meta->{revision}) ||$meta->{revision}eq'0') )1181{1182$log->info("Tell the client the file is scheduled for addition");1183print"MT text A\n";1184print"MT fname$filename\n";1185print"MT newline\n";1186next;11871188}1189else{1190$log->info("UpdatingX3 '$filename' to ".$meta->{revision});1191print"MT +updated\n";1192print"MT text U\n";1193print"MT fname$filename\n";1194print"MT newline\n";1195print"MT -updated\n";1196}11971198my($filepart,$dirpart) = filenamesplit($filename,1);11991200# Don't want to actually _DO_ the update if -n specified1201unless($state->{globaloptions}{-n} )1202{1203if(defined($wrev) )1204{1205# instruct client we're sending a file to put in this path as a replacement1206print"Update-existing$dirpart\n";1207$log->debug("Updating existing file 'Update-existing$dirpart'");1208}else{1209# instruct client we're sending a file to put in this path as a new file1210print"Clear-static-directory$dirpart\n";1211print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1212print"Clear-sticky$dirpart\n";1213print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";12141215$log->debug("Creating new file 'Created$dirpart'");1216print"Created$dirpart\n";1217}1218print$state->{CVSROOT} ."/$state->{module}/$filename\n";12191220# this is an "entries" line1221my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1222$log->debug("/$filepart/$meta->{revision}//$kopts/");1223print"/$filepart/$meta->{revision}//$kopts/\n";12241225# permissions1226$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1227print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";12281229# transmit file1230 transmitfile($meta->{filehash});1231}1232}else{1233my($filepart,$dirpart) = filenamesplit($meta->{name},1);12341235my$mergeDir= setupTmpDir();12361237my$file_local=$filepart.".mine";1238my$mergedFile="$mergeDir/$file_local";1239system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1240my$file_old=$filepart.".".$oldmeta->{revision};1241 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1242my$file_new=$filepart.".".$meta->{revision};1243 transmitfile($meta->{filehash}, { targetfile =>$file_new});12441245# we need to merge with the local changes ( M=successful merge, C=conflict merge )1246$log->info("Merging$file_local,$file_old,$file_new");1247print"M Merging differences between$oldmeta->{revision} and$meta->{revision} into$filename\n";12481249$log->debug("Temporary directory for merge is$mergeDir");12501251my$return=system("git","merge-file",$file_local,$file_old,$file_new);1252$return>>=8;12531254 cleanupTmpDir();12551256if($return==0)1257{1258$log->info("Merged successfully");1259print"M M$filename\n";1260$log->debug("Merged$dirpart");12611262# Don't want to actually _DO_ the update if -n specified1263unless($state->{globaloptions}{-n} )1264{1265print"Merged$dirpart\n";1266$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1267print$state->{CVSROOT} ."/$state->{module}/$filename\n";1268my$kopts= kopts_from_path("$dirpart/$filepart",1269"file",$mergedFile);1270$log->debug("/$filepart/$meta->{revision}//$kopts/");1271print"/$filepart/$meta->{revision}//$kopts/\n";1272}1273}1274elsif($return==1)1275{1276$log->info("Merged with conflicts");1277print"E cvs update: conflicts found in$filename\n";1278print"M C$filename\n";12791280# Don't want to actually _DO_ the update if -n specified1281unless($state->{globaloptions}{-n} )1282{1283print"Merged$dirpart\n";1284print$state->{CVSROOT} ."/$state->{module}/$filename\n";1285my$kopts= kopts_from_path("$dirpart/$filepart",1286"file",$mergedFile);1287print"/$filepart/$meta->{revision}/+/$kopts/\n";1288}1289}1290else1291{1292$log->warn("Merge failed");1293next;1294}12951296# Don't want to actually _DO_ the update if -n specified1297unless($state->{globaloptions}{-n} )1298{1299# permissions1300$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1301print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";13021303# transmit file, format is single integer on a line by itself (file1304# size) followed by the file contents1305# TODO : we should copy files in blocks1306my$data=`cat$mergedFile`;1307$log->debug("File size : " . length($data));1308 print length($data) . "\n";1309 print$data;1310 }1311 }13121313 }13141315 print "ok\n";1316}13171318sub req_ci1319{1320 my ($cmd,$data) =@_;13211322 argsplit("ci");13231324 #$log->debug("State : " . Dumper($state));13251326$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));13271328 if ($state->{method} eq 'pserver' and$state->{user} eq 'anonymous' )1329 {1330 print "error 1 anonymous user cannot commit via pserver\n";1331 cleanupWorkTree();1332 exit;1333 }13341335 if ( -e$state->{CVSROOT} . "/index" )1336 {1337$log->warn("file 'index' already exists in the git repository");1338 print "error 1 Index already exists in git repo\n";1339 cleanupWorkTree();1340 exit;1341 }13421343 # Grab a handle to the SQLite db and do any necessary updates1344 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1345$updater->update();13461347 # Remember where the head was at the beginning.1348 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1349 chomp$parenthash;1350 if ($parenthash!~ /^[0-9a-f]{40}$/) {1351 print "error 1 pserver cannot find the current HEAD of module";1352 cleanupWorkTree();1353 exit;1354 }13551356 setupWorkTree($parenthash);13571358$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");13591360$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");13611362 my@committedfiles= ();1363 my%oldmeta;13641365 # foreach file specified on the command line ...1366 foreach my$filename( @{$state->{args}} )1367 {1368 my$committedfile=$filename;1369$filename= filecleanup($filename);13701371 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );13721373 my$meta=$updater->getmeta($filename);1374$oldmeta{$filename} =$meta;13751376 my$wrev= revparse($filename);13771378 my ($filepart,$dirpart) = filenamesplit($filename);13791380 # do a checkout of the file if it is part of this tree1381 if ($wrev) {1382 system('git', 'checkout-index', '-f', '-u',$filename);1383 unless ($?== 0) {1384 die "Error running git-checkout-index -f -u$filename:$!";1385 }1386 }13871388 my$addflag= 0;1389 my$rmflag= 0;1390$rmflag= 1 if ( defined($wrev) and ($wrev=~/^-/) );1391$addflag= 1 unless ( -e$filename);13921393 # Do up to date checking1394 unless ($addflagor$wreveq$meta->{revision} or1395 ($rmflagand$wreveq "-$meta->{revision}" ) )1396 {1397 # fail everything if an up to date check fails1398 print "error 1 Up to date check failed for$filename\n";1399 cleanupWorkTree();1400 exit;1401 }14021403 push@committedfiles,$committedfile;1404$log->info("Committing$filename");14051406 system("mkdir","-p",$dirpart) unless ( -d$dirpart);14071408 unless ($rmflag)1409 {1410$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1411 rename$state->{entries}{$filename}{modified_filename},$filename;14121413 # Calculate modes to remove1414 my$invmode= "";1415 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }14161417$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1418 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1419 }14201421 if ($rmflag)1422 {1423$log->info("Removing file '$filename'");1424 unlink($filename);1425 system("git", "update-index", "--remove",$filename);1426 }1427 elsif ($addflag)1428 {1429$log->info("Adding file '$filename'");1430 system("git", "update-index", "--add",$filename);1431 } else {1432$log->info("UpdatingX2 file '$filename'");1433 system("git", "update-index",$filename);1434 }1435 }14361437 unless ( scalar(@committedfiles) > 0 )1438 {1439 print "E No files to commit\n";1440 print "ok\n";1441 cleanupWorkTree();1442 return;1443 }14441445 my$treehash= `git write-tree`;1446 chomp$treehash;14471448$log->debug("Treehash :$treehash, Parenthash :$parenthash");14491450 # write our commit message out if we have one ...1451 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1452 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1453 if ( defined ($cfg->{gitcvs}{commitmsgannotation} ) ) {1454 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/) {1455 print$msg_fh"\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"1456 }1457 } else {1458 print$msg_fh"\n\nvia git-CVS emulator\n";1459 }1460 close$msg_fh;14611462 my$commithash= `git commit-tree $treehash-p $parenthash<$msg_filename`;1463chomp($commithash);1464$log->info("Commit hash :$commithash");14651466unless($commithash=~/[a-zA-Z0-9]{40}/)1467{1468$log->warn("Commit failed (Invalid commit hash)");1469print"error 1 Commit failed (unknown reason)\n";1470 cleanupWorkTree();1471exit;1472}14731474### Emulate git-receive-pack by running hooks/update1475my@hook= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1476$parenthash,$commithash);1477if( -x $hook[0] ) {1478unless(system(@hook) ==0)1479{1480$log->warn("Commit failed (update hook declined to update ref)");1481print"error 1 Commit failed (update hook declined)\n";1482 cleanupWorkTree();1483exit;1484}1485}14861487### Update the ref1488if(system(qw(git update-ref -m),"cvsserver ci",1489"refs/heads/$state->{module}",$commithash,$parenthash)) {1490$log->warn("update-ref for$state->{module} failed.");1491print"error 1 Cannot commit -- update first\n";1492 cleanupWorkTree();1493exit;1494}14951496### Emulate git-receive-pack by running hooks/post-receive1497my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1498if( -x $hook) {1499open(my$pipe,"|$hook") ||die"can't fork$!";15001501local$SIG{PIPE} =sub{die'pipe broke'};15021503print$pipe"$parenthash$commithashrefs/heads/$state->{module}\n";15041505close$pipe||die"bad pipe:$!$?";1506}15071508$updater->update();15091510### Then hooks/post-update1511$hook=$ENV{GIT_DIR}.'hooks/post-update';1512if(-x $hook) {1513system($hook,"refs/heads/$state->{module}");1514}15151516# foreach file specified on the command line ...1517foreachmy$filename(@committedfiles)1518{1519$filename= filecleanup($filename);15201521my$meta=$updater->getmeta($filename);1522unless(defined$meta->{revision}) {1523$meta->{revision} ="1.1";1524}15251526my($filepart,$dirpart) = filenamesplit($filename,1);15271528$log->debug("Checked-in$dirpart:$filename");15291530print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1531if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1532{1533print"M new revision: delete; previous revision:$oldmeta{$filename}{revision}\n";1534print"Remove-entry$dirpart\n";1535print"$filename\n";1536}else{1537if($meta->{revision}eq"1.1") {1538print"M initial revision: 1.1\n";1539}else{1540print"M new revision:$meta->{revision}; previous revision:$oldmeta{$filename}{revision}\n";1541}1542print"Checked-in$dirpart\n";1543print"$filename\n";1544my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1545print"/$filepart/$meta->{revision}//$kopts/\n";1546}1547}15481549 cleanupWorkTree();1550print"ok\n";1551}15521553sub req_status1554{1555my($cmd,$data) =@_;15561557 argsplit("status");15581559$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1560#$log->debug("status state : " . Dumper($state));15611562# Grab a handle to the SQLite db and do any necessary updates1563my$updater;1564$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1565$updater->update();15661567# if no files were specified, we need to work out what files we should1568# be providing status on ...1569 argsfromdir($updater);15701571# foreach file specified on the command line ...1572foreachmy$filename( @{$state->{args}} )1573{1574$filename= filecleanup($filename);15751576if(exists($state->{opt}{l}) &&1577index($filename,'/',length($state->{prependdir})) >=0)1578{1579next;1580}15811582my$meta=$updater->getmeta($filename);1583my$oldmeta=$meta;15841585my$wrev= revparse($filename);15861587# If the working copy is an old revision, lets get that1588# version too for comparison.1589if(defined($wrev)and$wrevne$meta->{revision} )1590{1591$oldmeta=$updater->getmeta($filename,$wrev);1592}15931594# TODO : All possible statuses aren't yet implemented1595my$status;1596# Files are up to date if the working copy and repo copy have1597# the same revision, and the working copy is unmodified1598if(defined($wrev)and defined($meta->{revision})and1599$wreveq$meta->{revision}and1600( ($state->{entries}{$filename}{unchanged}and1601(not defined($state->{entries}{$filename}{conflict} )or1602$state->{entries}{$filename}{conflict} !~/^\+=/) )or1603(defined($state->{entries}{$filename}{modified_hash})and1604$state->{entries}{$filename}{modified_hash}eq1605$meta->{filehash} ) ) )1606{1607$status="Up-to-date"1608}16091610# Need checkout if the working copy has a different (usually1611# older) revision than the repo copy, and the working copy is1612# unmodified1613if(defined($wrev)and defined($meta->{revision} )and1614$meta->{revision}ne$wrevand1615($state->{entries}{$filename}{unchanged}or1616(defined($state->{entries}{$filename}{modified_hash})and1617$state->{entries}{$filename}{modified_hash}eq1618$oldmeta->{filehash} ) ) )1619{1620$status||="Needs Checkout";1621}16221623# Need checkout if it exists in the repo but doesn't have a working1624# copy1625if(not defined($wrev)and defined($meta->{revision} ) )1626{1627$status||="Needs Checkout";1628}16291630# Locally modified if working copy and repo copy have the1631# same revision but there are local changes1632if(defined($wrev)and defined($meta->{revision})and1633$wreveq$meta->{revision}and1634$state->{entries}{$filename}{modified_filename} )1635{1636$status||="Locally Modified";1637}16381639# Needs Merge if working copy revision is different1640# (usually older) than repo copy and there are local changes1641if(defined($wrev)and defined($meta->{revision} )and1642$meta->{revision}ne$wrevand1643$state->{entries}{$filename}{modified_filename} )1644{1645$status||="Needs Merge";1646}16471648if(defined($state->{entries}{$filename}{revision} )and1649not defined($meta->{revision} ) )1650{1651$status||="Locally Added";1652}1653if(defined($wrev)and defined($meta->{revision} )and1654$wreveq"-$meta->{revision}")1655{1656$status||="Locally Removed";1657}1658if(defined($state->{entries}{$filename}{conflict} )and1659$state->{entries}{$filename}{conflict} =~/^\+=/)1660{1661$status||="Unresolved Conflict";1662}1663if(0)1664{1665$status||="File had conflicts on merge";1666}16671668$status||="Unknown";16691670my($filepart) = filenamesplit($filename);16711672print"M =======". ("=" x 60) ."\n";1673print"M File:$filepart\tStatus:$status\n";1674if(defined($state->{entries}{$filename}{revision}) )1675{1676print"M Working revision:\t".1677$state->{entries}{$filename}{revision} ."\n";1678}else{1679print"M Working revision:\tNo entry for$filename\n";1680}1681if(defined($meta->{revision}) )1682{1683print"M Repository revision:\t".1684$meta->{revision} .1685"\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1686print"M Sticky Tag:\t\t(none)\n";1687print"M Sticky Date:\t\t(none)\n";1688print"M Sticky Options:\t\t(none)\n";1689}else{1690print"M Repository revision:\tNo revision control file\n";1691}1692print"M\n";1693}16941695print"ok\n";1696}16971698sub req_diff1699{1700my($cmd,$data) =@_;17011702 argsplit("diff");17031704$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1705#$log->debug("status state : " . Dumper($state));17061707my($revision1,$revision2);1708if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1709{1710$revision1=$state->{opt}{r}[0];1711$revision2=$state->{opt}{r}[1];1712}else{1713$revision1=$state->{opt}{r};1714}17151716$log->debug("Diffing revisions ".1717(defined($revision1) ?$revision1:"[NULL]") .1718" and ". (defined($revision2) ?$revision2:"[NULL]") );17191720# Grab a handle to the SQLite db and do any necessary updates1721my$updater;1722$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1723$updater->update();17241725# if no files were specified, we need to work out what files we should1726# be providing status on ...1727 argsfromdir($updater);17281729# foreach file specified on the command line ...1730foreachmy$filename( @{$state->{args}} )1731{1732$filename= filecleanup($filename);17331734my($fh,$file1,$file2,$meta1,$meta2,$filediff);17351736my$wrev= revparse($filename);17371738# We need _something_ to diff against1739next unless(defined($wrev) );17401741# if we have a -r switch, use it1742if(defined($revision1) )1743{1744(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1745$meta1=$updater->getmeta($filename,$revision1);1746unless(defined($meta1)and$meta1->{filehash}ne"deleted")1747{1748print"E File$filenameat revision$revision1doesn't exist\n";1749next;1750}1751 transmitfile($meta1->{filehash}, { targetfile =>$file1});1752}1753# otherwise we just use the working copy revision1754else1755{1756(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1757$meta1=$updater->getmeta($filename,$wrev);1758 transmitfile($meta1->{filehash}, { targetfile =>$file1});1759}17601761# if we have a second -r switch, use it too1762if(defined($revision2) )1763{1764(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1765$meta2=$updater->getmeta($filename,$revision2);17661767unless(defined($meta2)and$meta2->{filehash}ne"deleted")1768{1769print"E File$filenameat revision$revision2doesn't exist\n";1770next;1771}17721773 transmitfile($meta2->{filehash}, { targetfile =>$file2});1774}1775# otherwise we just use the working copy1776else1777{1778$file2=$state->{entries}{$filename}{modified_filename};1779}17801781# if we have been given -r, and we don't have a $file2 yet, lets1782# get one1783if(defined($revision1)and not defined($file2) )1784{1785(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1786$meta2=$updater->getmeta($filename,$wrev);1787 transmitfile($meta2->{filehash}, { targetfile =>$file2});1788}17891790# We need to have retrieved something useful1791next unless(defined($meta1) );17921793# Files to date if the working copy and repo copy have the same1794# revision, and the working copy is unmodified1795if(not defined($meta2)and$wreveq$meta1->{revision}and1796( ($state->{entries}{$filename}{unchanged}and1797(not defined($state->{entries}{$filename}{conflict} )or1798$state->{entries}{$filename}{conflict} !~/^\+=/) )or1799(defined($state->{entries}{$filename}{modified_hash})and1800$state->{entries}{$filename}{modified_hash}eq1801$meta1->{filehash} ) ) )1802{1803next;1804}18051806# Apparently we only show diffs for locally modified files1807unless(defined($meta2)or1808defined($state->{entries}{$filename}{modified_filename} ) )1809{1810next;1811}18121813print"M Index:$filename\n";1814print"M =======". ("=" x 60) ."\n";1815print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1816if(defined($meta1) )1817{1818print"M retrieving revision$meta1->{revision}\n"1819}1820if(defined($meta2) )1821{1822print"M retrieving revision$meta2->{revision}\n"1823}1824print"M diff ";1825foreachmy$opt(keys%{$state->{opt}} )1826{1827if(ref$state->{opt}{$opt}eq"ARRAY")1828{1829foreachmy$value( @{$state->{opt}{$opt}} )1830{1831print"-$opt$value";1832}1833}else{1834print"-$opt";1835if(defined($state->{opt}{$opt} ) )1836{1837print"$state->{opt}{$opt} "1838}1839}1840}1841print"$filename\n";18421843$log->info("Diffing$filename-r$meta1->{revision} -r ".1844($meta2->{revision}or"workingcopy"));18451846($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);18471848if(exists$state->{opt}{u} )1849{1850system("diff -u -L '$filenamerevision$meta1->{revision}'".1851" -L '$filename".1852(defined($meta2->{revision}) ?1853"revision$meta2->{revision}":1854"working copy") .1855"'$file1$file2>$filediff");1856}else{1857system("diff$file1$file2>$filediff");1858}18591860while( <$fh> )1861{1862print"M$_";1863}1864close$fh;1865}18661867print"ok\n";1868}18691870sub req_log1871{1872my($cmd,$data) =@_;18731874 argsplit("log");18751876$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1877#$log->debug("log state : " . Dumper($state));18781879my($revFilter);1880if(defined($state->{opt}{r} ) )1881{1882$revFilter=$state->{opt}{r};1883}18841885# Grab a handle to the SQLite db and do any necessary updates1886my$updater;1887$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1888$updater->update();18891890# if no files were specified, we need to work out what files we1891# should be providing status on ...1892 argsfromdir($updater);18931894# foreach file specified on the command line ...1895foreachmy$filename( @{$state->{args}} )1896{1897$filename= filecleanup($filename);18981899my$headmeta=$updater->getmeta($filename);19001901my($revisions,$totalrevisions) =$updater->getlog($filename,1902$revFilter);19031904next unless(scalar(@$revisions) );19051906print"M\n";1907print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1908print"M Working file:$filename\n";1909print"M head:$headmeta->{revision}\n";1910print"M branch:\n";1911print"M locks: strict\n";1912print"M access list:\n";1913print"M symbolic names:\n";1914print"M keyword substitution: kv\n";1915print"M total revisions:$totalrevisions;\tselected revisions: ".1916scalar(@$revisions) ."\n";1917print"M description:\n";19181919foreachmy$revision(@$revisions)1920{1921print"M ----------------------------\n";1922print"M revision$revision->{revision}\n";1923# reformat the date for log output1924if($revision->{modified} =~/(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/and1925defined($DATE_LIST->{$2}) )1926{1927$revision->{modified} =sprintf('%04d/%02d/%02d%s',1928$3,$DATE_LIST->{$2},$1,$4);1929}1930$revision->{author} = cvs_author($revision->{author});1931print"M date:$revision->{modified};".1932" author:$revision->{author}; state: ".1933($revision->{filehash}eq"deleted"?"dead":"Exp") .1934"; lines: +2 -3\n";1935my$commitmessage;1936$commitmessage=$updater->commitmessage($revision->{commithash});1937$commitmessage=~s/^/M /mg;1938print$commitmessage."\n";1939}1940print"M =======". ("=" x 70) ."\n";1941}19421943print"ok\n";1944}19451946sub req_annotate1947{1948my($cmd,$data) =@_;19491950 argsplit("annotate");19511952$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1953#$log->debug("status state : " . Dumper($state));19541955# Grab a handle to the SQLite db and do any necessary updates1956my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1957$updater->update();19581959# if no files were specified, we need to work out what files we should be providing annotate on ...1960 argsfromdir($updater);19611962# we'll need a temporary checkout dir1963 setupWorkTree();19641965$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");19661967# foreach file specified on the command line ...1968foreachmy$filename( @{$state->{args}} )1969{1970$filename= filecleanup($filename);19711972my$meta=$updater->getmeta($filename);19731974next unless($meta->{revision} );19751976# get all the commits that this file was in1977# in dense format -- aka skip dead revisions1978my$revisions=$updater->gethistorydense($filename);1979my$lastseenin=$revisions->[0][2];19801981# populate the temporary index based on the latest commit were we saw1982# the file -- but do it cheaply without checking out any files1983# TODO: if we got a revision from the client, use that instead1984# to look up the commithash in sqlite (still good to default to1985# the current head as we do now)1986system("git","read-tree",$lastseenin);1987unless($?==0)1988{1989print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";1990return;1991}1992$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");19931994# do a checkout of the file1995system('git','checkout-index','-f','-u',$filename);1996unless($?==0) {1997print"E error running git-checkout-index -f -u$filename:$!\n";1998return;1999}20002001$log->info("Annotate$filename");20022003# Prepare a file with the commits from the linearized2004# history that annotate should know about. This prevents2005# git-jsannotate telling us about commits we are hiding2006# from the client.20072008my$a_hints="$work->{workDir}/.annotate_hints";2009if(!open(ANNOTATEHINTS,'>',$a_hints)) {2010print"E failed to open '$a_hints' for writing:$!\n";2011return;2012}2013for(my$i=0;$i<@$revisions;$i++)2014{2015print ANNOTATEHINTS $revisions->[$i][2];2016if($i+1<@$revisions) {# have we got a parent?2017print ANNOTATEHINTS ' '.$revisions->[$i+1][2];2018}2019print ANNOTATEHINTS "\n";2020}20212022print ANNOTATEHINTS "\n";2023close ANNOTATEHINTS2024or(print"E failed to write$a_hints:$!\n"),return;20252026my@cmd= (qw(git annotate -l -S),$a_hints,$filename);2027if(!open(ANNOTATE,"-|",@cmd)) {2028print"E error invoking ".join(' ',@cmd) .":$!\n";2029return;2030}2031my$metadata= {};2032print"E Annotations for$filename\n";2033print"E ***************\n";2034while( <ANNOTATE> )2035{2036if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)2037{2038my$commithash=$1;2039my$data=$2;2040unless(defined($metadata->{$commithash} ) )2041{2042$metadata->{$commithash} =$updater->getmeta($filename,$commithash);2043$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});2044$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);2045}2046printf("M %-7s (%-8s%10s):%s\n",2047$metadata->{$commithash}{revision},2048$metadata->{$commithash}{author},2049$metadata->{$commithash}{modified},2050$data2051);2052}else{2053$log->warn("Error in annotate output! LINE:$_");2054print"E Annotate error\n";2055next;2056}2057}2058close ANNOTATE;2059}20602061# done; get out of the tempdir2062 cleanupWorkTree();20632064print"ok\n";20652066}20672068# This method takes the state->{arguments} array and produces two new arrays.2069# The first is $state->{args} which is everything before the '--' argument, and2070# the second is $state->{files} which is everything after it.2071sub argsplit2072{2073$state->{args} = [];2074$state->{files} = [];2075$state->{opt} = {};20762077return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");20782079my$type=shift;20802081if(defined($type) )2082{2083my$opt= {};2084$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");2085$opt= { v =>0, l =>0, R =>0}if($typeeq"status");2086$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");2087$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");2088$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");2089$opt= { k =>1, m =>1}if($typeeq"add");2090$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");2091$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");209220932094while(scalar( @{$state->{arguments}} ) >0)2095{2096my$arg=shift@{$state->{arguments}};20972098next if($argeq"--");2099next unless($arg=~/\S/);21002101# if the argument looks like a switch2102if($arg=~/^-(\w)(.*)/)2103{2104# if it's a switch that takes an argument2105if($opt->{$1} )2106{2107# If this switch has already been provided2108if($opt->{$1} >1and exists($state->{opt}{$1} ) )2109{2110$state->{opt}{$1} = [$state->{opt}{$1} ];2111if(length($2) >0)2112{2113push@{$state->{opt}{$1}},$2;2114}else{2115push@{$state->{opt}{$1}},shift@{$state->{arguments}};2116}2117}else{2118# if there's extra data in the arg, use that as the argument for the switch2119if(length($2) >0)2120{2121$state->{opt}{$1} =$2;2122}else{2123$state->{opt}{$1} =shift@{$state->{arguments}};2124}2125}2126}else{2127$state->{opt}{$1} =undef;2128}2129}2130else2131{2132push@{$state->{args}},$arg;2133}2134}2135}2136else2137{2138my$mode=0;21392140foreachmy$value( @{$state->{arguments}} )2141{2142if($valueeq"--")2143{2144$mode++;2145next;2146}2147push@{$state->{args}},$valueif($mode==0);2148push@{$state->{files}},$valueif($mode==1);2149}2150}2151}21522153# This method uses $state->{directory} to populate $state->{args} with a list of filenames2154sub argsfromdir2155{2156my$updater=shift;21572158$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");21592160return if(scalar( @{$state->{args}} ) >1);21612162my@gethead= @{$updater->gethead};21632164# push added files2165foreachmy$file(keys%{$state->{entries}}) {2166if(exists$state->{entries}{$file}{revision} &&2167$state->{entries}{$file}{revision}eq'0')2168{2169push@gethead, { name =>$file, filehash =>'added'};2170}2171}21722173if(scalar(@{$state->{args}}) ==1)2174{2175my$arg=$state->{args}[0];2176$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );21772178$log->info("Only one arg specified, checking for directory expansion on '$arg'");21792180foreachmy$file(@gethead)2181{2182next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2183next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);2184push@{$state->{args}},$file->{name};2185}21862187shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);2188}else{2189$log->info("Only one arg specified, populating file list automatically");21902191$state->{args} = [];21922193foreachmy$file(@gethead)2194{2195next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2196next unless($file->{name} =~s/^$state->{prependdir}//);2197push@{$state->{args}},$file->{name};2198}2199}2200}22012202# This method cleans up the $state variable after a command that uses arguments has run2203sub statecleanup2204{2205$state->{files} = [];2206$state->{args} = [];2207$state->{arguments} = [];2208$state->{entries} = {};2209}22102211# Return working directory CVS revision "1.X" out2212# of the the working directory "entries" state, for the given filename.2213# This is prefixed with a dash if the file is scheduled for removal2214# when it is committed.2215sub revparse2216{2217my$filename=shift;22182219return$state->{entries}{$filename}{revision};2220}22212222# This method takes a file hash and does a CVS "file transfer". Its2223# exact behaviour depends on a second, optional hash table argument:2224# - If $options->{targetfile}, dump the contents to that file;2225# - If $options->{print}, use M/MT to transmit the contents one line2226# at a time;2227# - Otherwise, transmit the size of the file, followed by the file2228# contents.2229sub transmitfile2230{2231my$filehash=shift;2232my$options=shift;22332234if(defined($filehash)and$filehasheq"deleted")2235{2236$log->warn("filehash is 'deleted'");2237return;2238}22392240die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);22412242my$type=`git cat-file -t$filehash`;2243 chomp$type;22442245 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );22462247 my$size= `git cat-file -s $filehash`;2248chomp$size;22492250$log->debug("transmitfile($filehash) size=$size, type=$type");22512252if(open my$fh,'-|',"git","cat-file","blob",$filehash)2253{2254if(defined($options->{targetfile} ) )2255{2256my$targetfile=$options->{targetfile};2257open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2258print NEWFILE $_while( <$fh> );2259close NEWFILE or die("Failed to write '$targetfile':$!");2260}elsif(defined($options->{print} ) &&$options->{print} ) {2261while( <$fh> ) {2262if(/\n\z/) {2263print'M ',$_;2264}else{2265print'MT text ',$_,"\n";2266}2267}2268}else{2269print"$size\n";2270printwhile( <$fh> );2271}2272close$fhor die("Couldn't close filehandle for transmitfile():$!");2273}else{2274die("Couldn't execute git-cat-file");2275}2276}22772278# This method takes a file name, and returns ( $dirpart, $filepart ) which2279# refers to the directory portion and the file portion of the filename2280# respectively2281sub filenamesplit2282{2283my$filename=shift;2284my$fixforlocaldir=shift;22852286my($filepart,$dirpart) = ($filename,".");2287($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2288$dirpart.="/";22892290if($fixforlocaldir)2291{2292$dirpart=~s/^$state->{prependdir}//;2293}22942295return($filepart,$dirpart);2296}22972298sub filecleanup2299{2300my$filename=shift;23012302returnundefunless(defined($filename));2303if($filename=~/^\// )2304{2305print"E absolute filenames '$filename' not supported by server\n";2306returnundef;2307}23082309$filename=~s/^\.\///g;2310$filename=$state->{prependdir} .$filename;2311return$filename;2312}23132314sub validateGitDir2315{2316if( !defined($state->{CVSROOT}) )2317{2318print"error 1 CVSROOT not specified\n";2319 cleanupWorkTree();2320exit;2321}2322if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2323{2324print"error 1 Internally inconsistent CVSROOT\n";2325 cleanupWorkTree();2326exit;2327}2328}23292330# Setup working directory in a work tree with the requested version2331# loaded in the index.2332sub setupWorkTree2333{2334my($ver) =@_;23352336 validateGitDir();23372338if( (defined($work->{state}) &&$work->{state} !=1) ||2339defined($work->{tmpDir}) )2340{2341$log->warn("Bad work tree state management");2342print"error 1 Internal setup multiple work trees without cleanup\n";2343 cleanupWorkTree();2344exit;2345}23462347$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);23482349if( !defined($work->{index}) )2350{2351(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2352}23532354chdir$work->{workDir}or2355die"Unable to chdir to$work->{workDir}\n";23562357$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");23582359$ENV{GIT_WORK_TREE} =".";2360$ENV{GIT_INDEX_FILE} =$work->{index};2361$work->{state} =2;23622363if($ver)2364{2365system("git","read-tree",$ver);2366unless($?==0)2367{2368$log->warn("Error running git-read-tree");2369die"Error running git-read-tree$verin$work->{workDir}$!\n";2370}2371}2372# else # req_annotate reads tree for each file2373}23742375# Ensure current directory is in some kind of working directory,2376# with a recent version loaded in the index.2377sub ensureWorkTree2378{2379if(defined($work->{tmpDir}) )2380{2381$log->warn("Bad work tree state management [ensureWorkTree()]");2382print"error 1 Internal setup multiple dirs without cleanup\n";2383 cleanupWorkTree();2384exit;2385}2386if($work->{state} )2387{2388return;2389}23902391 validateGitDir();23922393if( !defined($work->{emptyDir}) )2394{2395$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);2396}2397chdir$work->{emptyDir}or2398die"Unable to chdir to$work->{emptyDir}\n";23992400my$ver=`git show-ref -s refs/heads/$state->{module}`;2401chomp$ver;2402if($ver!~/^[0-9a-f]{40}$/)2403{2404$log->warn("Error from git show-ref -s refs/head$state->{module}");2405print"error 1 cannot find the current HEAD of module";2406 cleanupWorkTree();2407exit;2408}24092410if( !defined($work->{index}) )2411{2412(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2413}24142415$ENV{GIT_WORK_TREE} =".";2416$ENV{GIT_INDEX_FILE} =$work->{index};2417$work->{state} =1;24182419system("git","read-tree",$ver);2420unless($?==0)2421{2422die"Error running git-read-tree$ver$!\n";2423}2424}24252426# Cleanup working directory that is not needed any longer.2427sub cleanupWorkTree2428{2429if( !$work->{state} )2430{2431return;2432}24332434chdir"/"or die"Unable to chdir '/'\n";24352436if(defined($work->{workDir}) )2437{2438 rmtree($work->{workDir} );2439undef$work->{workDir};2440}2441undef$work->{state};2442}24432444# Setup a temporary directory (not a working tree), typically for2445# merging dirty state as in req_update.2446sub setupTmpDir2447{2448$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);2449chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";24502451return$work->{tmpDir};2452}24532454# Clean up a previously setupTmpDir. Restore previous work tree if2455# appropriate.2456sub cleanupTmpDir2457{2458if( !defined($work->{tmpDir}) )2459{2460$log->warn("cleanup tmpdir that has not been setup");2461die"Cleanup tmpDir that has not been setup\n";2462}2463if(defined($work->{state}) )2464{2465if($work->{state} ==1)2466{2467chdir$work->{emptyDir}or2468die"Unable to chdir to$work->{emptyDir}\n";2469}2470elsif($work->{state} ==2)2471{2472chdir$work->{workDir}or2473die"Unable to chdir to$work->{emptyDir}\n";2474}2475else2476{2477$log->warn("Inconsistent work dir state");2478die"Inconsistent work dir state\n";2479}2480}2481else2482{2483chdir"/"or die"Unable to chdir '/'\n";2484}2485}24862487# Given a path, this function returns a string containing the kopts2488# that should go into that path's Entries line. For example, a binary2489# file should get -kb.2490sub kopts_from_path2491{2492my($path,$srcType,$name) =@_;24932494if(defined($cfg->{gitcvs}{usecrlfattr} )and2495$cfg->{gitcvs}{usecrlfattr} =~/\s*(1|true|yes)\s*$/i)2496{2497my($val) = check_attr("text",$path);2498if($valeq"unspecified")2499{2500$val= check_attr("crlf",$path);2501}2502if($valeq"unset")2503{2504return"-kb"2505}2506elsif( check_attr("eol",$path)ne"unspecified"||2507$valeq"set"||$valeq"input")2508{2509return"";2510}2511else2512{2513$log->info("Unrecognized check_attr crlf$path:$val");2514}2515}25162517if(defined($cfg->{gitcvs}{allbinary} ) )2518{2519if( ($cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i) )2520{2521return"-kb";2522}2523elsif( ($cfg->{gitcvs}{allbinary} =~/^\s*guess\s*$/i) )2524{2525if( is_binary($srcType,$name) )2526{2527$log->debug("... as binary");2528return"-kb";2529}2530else2531{2532$log->debug("... as text");2533}2534}2535}2536# Return "" to give no special treatment to any path2537return"";2538}25392540sub check_attr2541{2542my($attr,$path) =@_;2543 ensureWorkTree();2544if(open my$fh,'-|',"git","check-attr",$attr,"--",$path)2545{2546my$val= <$fh>;2547close$fh;2548$val=~s/.*: ([^:\r\n]*)\s*$/$1/;2549return$val;2550}2551else2552{2553returnundef;2554}2555}25562557# This should have the same heuristics as convert.c:is_binary() and related.2558# Note that the bare CR test is done by callers in convert.c.2559sub is_binary2560{2561my($srcType,$name) =@_;2562$log->debug("is_binary($srcType,$name)");25632564# Minimize amount of interpreted code run in the inner per-character2565# loop for large files, by totalling each character value and2566# then analyzing the totals.2567my@counts;2568my$i;2569for($i=0;$i<256;$i++)2570{2571$counts[$i]=0;2572}25732574my$fh= open_blob_or_die($srcType,$name);2575my$line;2576while(defined($line=<$fh>) )2577{2578# Any '\0' and bare CR are considered binary.2579if($line=~/\0|(\r[^\n])/)2580{2581close($fh);2582return1;2583}25842585# Count up each character in the line:2586my$len=length($line);2587for($i=0;$i<$len;$i++)2588{2589$counts[ord(substr($line,$i,1))]++;2590}2591}2592close$fh;25932594# Don't count CR and LF as either printable/nonprintable2595$counts[ord("\n")]=0;2596$counts[ord("\r")]=0;25972598# Categorize individual character count into printable and nonprintable:2599my$printable=0;2600my$nonprintable=0;2601for($i=0;$i<256;$i++)2602{2603if($i<32&&2604$i!=ord("\b") &&2605$i!=ord("\t") &&2606$i!=033&&# ESC2607$i!=014)# FF2608{2609$nonprintable+=$counts[$i];2610}2611elsif($i==127)# DEL2612{2613$nonprintable+=$counts[$i];2614}2615else2616{2617$printable+=$counts[$i];2618}2619}26202621return($printable>>7) <$nonprintable;2622}26232624# Returns open file handle. Possible invocations:2625# - open_blob_or_die("file",$filename);2626# - open_blob_or_die("sha1",$filehash);2627sub open_blob_or_die2628{2629my($srcType,$name) =@_;2630my($fh);2631if($srcTypeeq"file")2632{2633if( !open$fh,"<",$name)2634{2635$log->warn("Unable to open file$name:$!");2636die"Unable to open file$name:$!\n";2637}2638}2639elsif($srcTypeeq"sha1")2640{2641unless(defined($name)and$name=~/^[a-zA-Z0-9]{40}$/)2642{2643$log->warn("Need filehash");2644die"Need filehash\n";2645}26462647my$type=`git cat-file -t$name`;2648 chomp$type;26492650 unless ( defined ($type) and$typeeq "blob" )2651 {2652$log->warn("Invalid type '$type' for '$name'");2653 die ( "Invalid type '$type' (expected 'blob')" )2654 }26552656 my$size= `git cat-file -s $name`;2657chomp$size;26582659$log->debug("open_blob_or_die($name) size=$size, type=$type");26602661unless(open$fh,'-|',"git","cat-file","blob",$name)2662{2663$log->warn("Unable to open sha1$name");2664die"Unable to open sha1$name\n";2665}2666}2667else2668{2669$log->warn("Unknown type of blob source:$srcType");2670die"Unknown type of blob source:$srcType\n";2671}2672return$fh;2673}26742675# Generate a CVS author name from Git author information, by taking the local2676# part of the email address and replacing characters not in the Portable2677# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS2678# Login names are Unix login names, which should be restricted to this2679# character set.2680sub cvs_author2681{2682my$author_line=shift;2683(my$author) =$author_line=~/<([^@>]*)/;26842685$author=~s/[^-a-zA-Z0-9_.]/_/g;2686$author=~s/^-/_/;26872688$author;2689}269026912692sub descramble2693{2694# This table is from src/scramble.c in the CVS source2695my@SHIFTS= (26960,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,269716,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,2698114,120,53,79,96,109,72,108,70,64,76,67,116,74,68,87,2699111,52,75,119,49,34,82,81,95,65,112,86,118,110,122,105,270041,57,83,43,46,102,40,89,38,103,45,50,42,123,91,35,2701125,55,54,66,124,126,59,47,92,71,115,78,88,107,106,56,270236,121,117,104,101,100,69,73,99,63,94,93,39,37,61,48,270358,113,32,90,44,98,60,51,33,97,62,77,84,80,85,223,2704225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,2705199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,2706174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,2707207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,2708192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,2709227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,2710182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,2711243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,1522712);2713my($str) =@_;27142715# This should never happen, the same password format (A) has been2716# used by CVS since the beginning of time2717{2718my$fmt=substr($str,0,1);2719die"invalid password format `$fmt'"unless$fmteq'A';2720}27212722my@str=unpack"C*",substr($str,1);2723my$ret=join'',map{chr$SHIFTS[$_] }@str;2724return$ret;2725}272627272728package GITCVS::log;27292730####2731#### Copyright The Open University UK - 2006.2732####2733#### Authors: Martyn Smith <martyn@catalyst.net.nz>2734#### Martin Langhoff <martin@laptop.org>2735####2736####27372738use strict;2739use warnings;27402741=head1 NAME27422743GITCVS::log27442745=head1 DESCRIPTION27462747This module provides very crude logging with a similar interface to2748Log::Log4perl27492750=head1 METHODS27512752=cut27532754=head2 new27552756Creates a new log object, optionally you can specify a filename here to2757indicate the file to log to. If no log file is specified, you can specify one2758later with method setfile, or indicate you no longer want logging with method2759nofile.27602761Until one of these methods is called, all log calls will buffer messages ready2762to write out.27632764=cut2765sub new2766{2767my$class=shift;2768my$filename=shift;27692770my$self= {};27712772bless$self,$class;27732774if(defined($filename) )2775{2776open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2777}27782779return$self;2780}27812782=head2 setfile27832784This methods takes a filename, and attempts to open that file as the log file.2785If successful, all buffered data is written out to the file, and any further2786logging is written directly to the file.27872788=cut2789sub setfile2790{2791my$self=shift;2792my$filename=shift;27932794if(defined($filename) )2795{2796open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2797}27982799return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");28002801while(my$line=shift@{$self->{buffer}} )2802{2803print{$self->{fh}}$line;2804}2805}28062807=head2 nofile28082809This method indicates no logging is going to be used. It flushes any entries in2810the internal buffer, and sets a flag to ensure no further data is put there.28112812=cut2813sub nofile2814{2815my$self=shift;28162817$self->{nolog} =1;28182819return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");28202821$self->{buffer} = [];2822}28232824=head2 _logopen28252826Internal method. Returns true if the log file is open, false otherwise.28272828=cut2829sub _logopen2830{2831my$self=shift;28322833return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2834return0;2835}28362837=head2 debug info warn fatal28382839These four methods are wrappers to _log. They provide the actual interface for2840logging data.28412842=cut2843sub debug {my$self=shift;$self->_log("debug",@_); }2844sub info {my$self=shift;$self->_log("info",@_); }2845subwarn{my$self=shift;$self->_log("warn",@_); }2846sub fatal {my$self=shift;$self->_log("fatal",@_); }28472848=head2 _log28492850This is an internal method called by the logging functions. It generates a2851timestamp and pushes the logged line either to file, or internal buffer.28522853=cut2854sub _log2855{2856my$self=shift;2857my$level=shift;28582859return if($self->{nolog} );28602861my@time=localtime;2862my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2863$time[5] +1900,2864$time[4] +1,2865$time[3],2866$time[2],2867$time[1],2868$time[0],2869uc$level,2870);28712872if($self->_logopen)2873{2874print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2875}else{2876push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2877}2878}28792880=head2 DESTROY28812882This method simply closes the file handle if one is open28832884=cut2885sub DESTROY2886{2887my$self=shift;28882889if($self->_logopen)2890{2891close$self->{fh};2892}2893}28942895package GITCVS::updater;28962897####2898#### Copyright The Open University UK - 2006.2899####2900#### Authors: Martyn Smith <martyn@catalyst.net.nz>2901#### Martin Langhoff <martin@laptop.org>2902####2903####29042905use strict;2906use warnings;2907use DBI;29082909=head1 METHODS29102911=cut29122913=head2 new29142915=cut2916sub new2917{2918my$class=shift;2919my$config=shift;2920my$module=shift;2921my$log=shift;29222923die"Need to specify a git repository"unless(defined($config)and-d $config);2924die"Need to specify a module"unless(defined($module) );29252926$class=ref($class) ||$class;29272928my$self= {};29292930bless$self,$class;29312932$self->{valid_tables} = {'revision'=>1,2933'revision_ix1'=>1,2934'revision_ix2'=>1,2935'head'=>1,2936'head_ix1'=>1,2937'properties'=>1,2938'commitmsgs'=>1};29392940$self->{module} =$module;2941$self->{git_path} =$config."/";29422943$self->{log} =$log;29442945die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );29462947$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2948$cfg->{gitcvs}{dbdriver} ||"SQLite";2949$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2950$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2951$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2952$cfg->{gitcvs}{dbuser} ||"";2953$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2954$cfg->{gitcvs}{dbpass} ||"";2955$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||2956$cfg->{gitcvs}{dbtablenameprefix} ||"";2957my%mapping= ( m =>$module,2958 a =>$state->{method},2959 u =>getlogin||getpwuid($<) || $<,2960 G =>$self->{git_path},2961 g => mangle_dirname($self->{git_path}),2962);2963$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2964$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;2965$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;2966$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});29672968die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2969die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2970$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2971$self->{dbuser},2972$self->{dbpass});2973die"Error connecting to database\n"unlessdefined$self->{dbh};29742975$self->{tables} = {};2976foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2977{2978$self->{tables}{$table} =1;2979}29802981# Construct the revision table if required2982# The revision table stores an entry for each file, each time that file2983# changes.2984# numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )2985# This is not sufficient to support "-r {commithash}" for any2986# files except files that were modified by that commit (also,2987# some places in the code ignore/effectively strip out -r in2988# some cases, before it gets passed to getmeta()).2989# The "filehash" field typically has a git blob hash, but can also2990# be set to "dead" to indicate that the given version of the file2991# should not exist in the sandbox.2992unless($self->{tables}{$self->tablename("revision")} )2993{2994my$tablename=$self->tablename("revision");2995my$ix1name=$self->tablename("revision_ix1");2996my$ix2name=$self->tablename("revision_ix2");2997$self->{dbh}->do("2998 CREATE TABLE$tablename(2999 name TEXT NOT NULL,3000 revision INTEGER NOT NULL,3001 filehash TEXT NOT NULL,3002 commithash TEXT NOT NULL,3003 author TEXT NOT NULL,3004 modified TEXT NOT NULL,3005 mode TEXT NOT NULL3006 )3007 ");3008$self->{dbh}->do("3009 CREATE INDEX$ix1name3010 ON$tablename(name,revision)3011 ");3012$self->{dbh}->do("3013 CREATE INDEX$ix2name3014 ON$tablename(name,commithash)3015 ");3016}30173018# Construct the head table if required3019# The head table (along with the "last_commit" entry in the property3020# table) is the persisted working state of the "sub update" subroutine.3021# All of it's data is read entirely first, and completely recreated3022# last, every time "sub update" runs.3023# This is also used by "sub getmeta" when it is asked for the latest3024# version of a file (as opposed to some specific version).3025# Another way of thinking about it is as a single slice out of3026# "revisions", giving just the most recent revision information for3027# each file.3028unless($self->{tables}{$self->tablename("head")} )3029{3030my$tablename=$self->tablename("head");3031my$ix1name=$self->tablename("head_ix1");3032$self->{dbh}->do("3033 CREATE TABLE$tablename(3034 name TEXT NOT NULL,3035 revision INTEGER NOT NULL,3036 filehash TEXT NOT NULL,3037 commithash TEXT NOT NULL,3038 author TEXT NOT NULL,3039 modified TEXT NOT NULL,3040 mode TEXT NOT NULL3041 )3042 ");3043$self->{dbh}->do("3044 CREATE INDEX$ix1name3045 ON$tablename(name)3046 ");3047}30483049# Construct the properties table if required3050# - "last_commit" - Used by "sub update".3051unless($self->{tables}{$self->tablename("properties")} )3052{3053my$tablename=$self->tablename("properties");3054$self->{dbh}->do("3055 CREATE TABLE$tablename(3056 key TEXT NOT NULL PRIMARY KEY,3057 value TEXT3058 )3059 ");3060}30613062# Construct the commitmsgs table if required3063# The commitmsgs table is only used for merge commits, since3064# "sub update" will only keep one branch of parents. Shortlogs3065# for ignored commits (i.e. not on the chosen branch) will be used3066# to construct a replacement "collapsed" merge commit message,3067# which will be stored in this table. See also "sub commitmessage".3068unless($self->{tables}{$self->tablename("commitmsgs")} )3069{3070my$tablename=$self->tablename("commitmsgs");3071$self->{dbh}->do("3072 CREATE TABLE$tablename(3073 key TEXT NOT NULL PRIMARY KEY,3074 value TEXT3075 )3076 ");3077}30783079return$self;3080}30813082=head2 tablename30833084=cut3085sub tablename3086{3087my$self=shift;3088my$name=shift;30893090if(exists$self->{valid_tables}{$name}) {3091return$self->{dbtablenameprefix} .$name;3092}else{3093returnundef;3094}3095}30963097=head2 update30983099Bring the database up to date with the latest changes from3100the git repository.31013102Internal working state is read out of the "head" table and the3103"last_commit" property, then it updates "revisions" based on that, and3104finally it writes the new internal state back to the "head" table3105so it can be used as a starting point the next time update is called.31063107=cut3108sub update3109{3110my$self=shift;31113112# first lets get the commit list3113$ENV{GIT_DIR} =$self->{git_path};31143115my$commitsha1=`git rev-parse$self->{module}`;3116chomp$commitsha1;31173118my$commitinfo=`git cat-file commit$self->{module} 2>&1`;3119unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)3120{3121die("Invalid module '$self->{module}'");3122}312331243125my$git_log;3126my$lastcommit=$self->_get_prop("last_commit");31273128if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date3129return1;3130}31313132# Start exclusive lock here...3133$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";31343135# TODO: log processing is memory bound3136# if we can parse into a 2nd file that is in reverse order3137# we can probably do something really efficient3138my@git_log_params= ('--pretty','--parents','--topo-order');31393140if(defined$lastcommit) {3141push@git_log_params,"$lastcommit..$self->{module}";3142}else{3143push@git_log_params,$self->{module};3144}3145# git-rev-list is the backend / plumbing version of git-log3146open(GITLOG,'-|','git','rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";31473148my@commits;31493150my%commit= ();31513152while( <GITLOG> )3153{3154chomp;3155if(m/^commit\s+(.*)$/) {3156# on ^commit lines put the just seen commit in the stack3157# and prime things for the next one3158if(keys%commit) {3159my%copy=%commit;3160unshift@commits, \%copy;3161%commit= ();3162}3163my@parents=split(m/\s+/,$1);3164$commit{hash} =shift@parents;3165$commit{parents} = \@parents;3166}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {3167# on rfc822-like lines seen before we see any message,3168# lowercase the entry and put it in the hash as key-value3169$commit{lc($1)} =$2;3170}else{3171# message lines - skip initial empty line3172# and trim whitespace3173if(!exists($commit{message}) &&m/^\s*$/) {3174# define it to mark the end of headers3175$commit{message} ='';3176next;3177}3178s/^\s+//;s/\s+$//;# trim ws3179$commit{message} .=$_."\n";3180}3181}3182close GITLOG;31833184unshift@commits, \%commitif(keys%commit);31853186# Now all the commits are in the @commits bucket3187# ordered by time DESC. for each commit that needs processing,3188# determine whether it's following the last head we've seen or if3189# it's on its own branch, grab a file list, and add whatever's changed3190# NOTE: $lastcommit refers to the last commit from previous run3191# $lastpicked is the last commit we picked in this run3192my$lastpicked;3193my$head= {};3194if(defined$lastcommit) {3195$lastpicked=$lastcommit;3196}31973198my$committotal=scalar(@commits);3199my$commitcount=0;32003201# Load the head table into $head (for cached lookups during the update process)3202foreachmy$file( @{$self->gethead(1)} )3203{3204$head->{$file->{name}} =$file;3205}32063207foreachmy$commit(@commits)3208{3209$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3210if(defined$lastpicked)3211{3212if(!in_array($lastpicked, @{$commit->{parents}}))3213{3214# skip, we'll see this delta3215# as part of a merge later3216# warn "skipping off-track $commit->{hash}\n";3217next;3218}elsif(@{$commit->{parents}} >1) {3219# it is a merge commit, for each parent that is3220# not $lastpicked (not given a CVS revision number),3221# see if we can get a log3222# from the merge-base to that parent to put it3223# in the message as a merge summary.3224my@parents= @{$commit->{parents}};3225foreachmy$parent(@parents) {3226if($parenteq$lastpicked) {3227next;3228}3229# git-merge-base can potentially (but rarely) throw3230# several candidate merge bases. let's assume3231# that the first one is the best one.3232my$base=eval{3233 safe_pipe_capture('git','merge-base',3234$lastpicked,$parent);3235};3236# The two branches may not be related at all,3237# in which case merge base simply fails to find3238# any, but that's Ok.3239next if($@);32403241chomp$base;3242if($base) {3243my@merged;3244# print "want to log between $base $parent \n";3245open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3246or die"Cannot call git-log:$!";3247my$mergedhash;3248while(<GITLOG>) {3249chomp;3250if(!defined$mergedhash) {3251if(m/^commit\s+(.+)$/) {3252$mergedhash=$1;3253}else{3254next;3255}3256}else{3257# grab the first line that looks non-rfc8223258# aka has content after leading space3259if(m/^\s+(\S.*)$/) {3260my$title=$1;3261$title=substr($title,0,100);# truncate3262unshift@merged,"$mergedhash$title";3263undef$mergedhash;3264}3265}3266}3267close GITLOG;3268if(@merged) {3269$commit->{mergemsg} =$commit->{message};3270$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3271foreachmy$summary(@merged) {3272$commit->{mergemsg} .="\t$summary\n";3273}3274$commit->{mergemsg} .="\n\n";3275# print "Message for $commit->{hash} \n$commit->{mergemsg}";3276}3277}3278}3279}3280}32813282# convert the date to CVS-happy format3283$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);32843285if(defined($lastpicked) )3286{3287my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3288local($/) ="\0";3289while( <FILELIST> )3290{3291chomp;3292unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)3293{3294die("Couldn't process git-diff-tree line :$_");3295}3296my($mode,$hash,$change) = ($1,$2,$3);3297my$name= <FILELIST>;3298chomp($name);32993300# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");33013302my$git_perms="";3303$git_perms.="r"if($mode&4);3304$git_perms.="w"if($mode&2);3305$git_perms.="x"if($mode&1);3306$git_perms="rw"if($git_permseq"");33073308if($changeeq"D")3309{3310#$log->debug("DELETE $name");3311$head->{$name} = {3312 name =>$name,3313 revision =>$head->{$name}{revision} +1,3314 filehash =>"deleted",3315 commithash =>$commit->{hash},3316 modified =>$commit->{date},3317 author =>$commit->{author},3318 mode =>$git_perms,3319};3320$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3321}3322elsif($changeeq"M"||$changeeq"T")3323{3324#$log->debug("MODIFIED $name");3325$head->{$name} = {3326 name =>$name,3327 revision =>$head->{$name}{revision} +1,3328 filehash =>$hash,3329 commithash =>$commit->{hash},3330 modified =>$commit->{date},3331 author =>$commit->{author},3332 mode =>$git_perms,3333};3334$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3335}3336elsif($changeeq"A")3337{3338#$log->debug("ADDED $name");3339$head->{$name} = {3340 name =>$name,3341 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3342 filehash =>$hash,3343 commithash =>$commit->{hash},3344 modified =>$commit->{date},3345 author =>$commit->{author},3346 mode =>$git_perms,3347};3348$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3349}3350else3351{3352$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");3353die;3354}3355}3356close FILELIST;3357}else{3358# this is used to detect files removed from the repo3359my$seen_files= {};33603361my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");3362local$/="\0";3363while( <FILELIST> )3364{3365chomp;3366unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)3367{3368die("Couldn't process git-ls-tree line :$_");3369}33703371my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);33723373$seen_files->{$git_filename} =1;33743375my($oldhash,$oldrevision,$oldmode) = (3376$head->{$git_filename}{filehash},3377$head->{$git_filename}{revision},3378$head->{$git_filename}{mode}3379);33803381if($git_perms=~/^\d\d\d(\d)\d\d/o)3382{3383$git_perms="";3384$git_perms.="r"if($1&4);3385$git_perms.="w"if($1&2);3386$git_perms.="x"if($1&1);3387}else{3388$git_perms="rw";3389}33903391# unless the file exists with the same hash, we need to update it ...3392unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)3393{3394my$newrevision= ($oldrevisionor0) +1;33953396$head->{$git_filename} = {3397 name =>$git_filename,3398 revision =>$newrevision,3399 filehash =>$git_hash,3400 commithash =>$commit->{hash},3401 modified =>$commit->{date},3402 author =>$commit->{author},3403 mode =>$git_perms,3404};340534063407$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3408}3409}3410close FILELIST;34113412# Detect deleted files3413foreachmy$file(keys%$head)3414{3415unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")3416{3417$head->{$file}{revision}++;3418$head->{$file}{filehash} ="deleted";3419$head->{$file}{commithash} =$commit->{hash};3420$head->{$file}{modified} =$commit->{date};3421$head->{$file}{author} =$commit->{author};34223423$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});3424}3425}3426# END : "Detect deleted files"3427}342834293430if(exists$commit->{mergemsg})3431{3432$self->insert_mergelog($commit->{hash},$commit->{mergemsg});3433}34343435$lastpicked=$commit->{hash};34363437$self->_set_prop("last_commit",$commit->{hash});3438}34393440$self->delete_head();3441foreachmy$file(keys%$head)3442{3443$self->insert_head(3444$file,3445$head->{$file}{revision},3446$head->{$file}{filehash},3447$head->{$file}{commithash},3448$head->{$file}{modified},3449$head->{$file}{author},3450$head->{$file}{mode},3451);3452}3453# invalidate the gethead cache3454$self->{gethead_cache} =undef;345534563457# Ending exclusive lock here3458$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3459}34603461sub insert_rev3462{3463my$self=shift;3464my$name=shift;3465my$revision=shift;3466my$filehash=shift;3467my$commithash=shift;3468my$modified=shift;3469my$author=shift;3470my$mode=shift;3471my$tablename=$self->tablename("revision");34723473my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3474$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3475}34763477sub insert_mergelog3478{3479my$self=shift;3480my$key=shift;3481my$value=shift;3482my$tablename=$self->tablename("commitmsgs");34833484my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3485$insert_mergelog->execute($key,$value);3486}34873488sub delete_head3489{3490my$self=shift;3491my$tablename=$self->tablename("head");34923493my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3494$delete_head->execute();3495}34963497sub insert_head3498{3499my$self=shift;3500my$name=shift;3501my$revision=shift;3502my$filehash=shift;3503my$commithash=shift;3504my$modified=shift;3505my$author=shift;3506my$mode=shift;3507my$tablename=$self->tablename("head");35083509my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3510$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3511}35123513sub _get_prop3514{3515my$self=shift;3516my$key=shift;3517my$tablename=$self->tablename("properties");35183519my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3520$db_query->execute($key);3521my($value) =$db_query->fetchrow_array;35223523return$value;3524}35253526sub _set_prop3527{3528my$self=shift;3529my$key=shift;3530my$value=shift;3531my$tablename=$self->tablename("properties");35323533my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3534$db_query->execute($value,$key);35353536unless($db_query->rows)3537{3538$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3539$db_query->execute($key,$value);3540}35413542return$value;3543}35443545=head2 gethead35463547=cut35483549sub gethead3550{3551my$self=shift;3552my$intRev=shift;3553my$tablename=$self->tablename("head");35543555return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );35563557my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3558$db_query->execute();35593560my$tree= [];3561while(my$file=$db_query->fetchrow_hashref)3562{3563if(!$intRev)3564{3565$file->{revision} ="1.$file->{revision}"3566}3567push@$tree,$file;3568}35693570$self->{gethead_cache} =$tree;35713572return$tree;3573}35743575=head2 getlog35763577See also gethistorydense().35783579=cut35803581sub getlog3582{3583my$self=shift;3584my$filename=shift;3585my$revFilter=shift;35863587my$tablename=$self->tablename("revision");35883589# Filters:3590# TODO: date, state, or by specific logins filters?3591# TODO: Handle comma-separated list of revFilter items, each item3592# can be a range [only case currently handled] or individual3593# rev or branch or "branch.".3594# TODO: Adjust $db_query WHERE clause based on revFilter, instead of3595# manually filtering the results of the query?3596my($minrev,$maxrev);3597if(defined($revFilter)and3598$state->{opt}{r} =~/^(1.(\d+))?(::?)(1.(\d.+))?$/)3599{3600my$control=$3;3601$minrev=$2;3602$maxrev=$5;3603$minrev++if(defined($minrev)and$controleq"::");3604}36053606my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3607$db_query->execute($filename);36083609my$totalRevs=0;3610my$tree= [];3611while(my$file=$db_query->fetchrow_hashref)3612{3613$totalRevs++;3614if(defined($minrev)and$file->{revision} <$minrev)3615{3616next;3617}3618if(defined($maxrev)and$file->{revision} >$maxrev)3619{3620next;3621}36223623$file->{revision} ="1.".$file->{revision};3624push@$tree,$file;3625}36263627return($tree,$totalRevs);3628}36293630=head2 getmeta36313632This function takes a filename (with path) argument and returns a hashref of3633metadata for that file.36343635=cut36363637sub getmeta3638{3639my$self=shift;3640my$filename=shift;3641my$revision=shift;3642my$tablename_rev=$self->tablename("revision");3643my$tablename_head=$self->tablename("head");36443645my$db_query;3646if(defined($revision)and$revision=~/^1\.(\d+)$/)3647{3648my($intRev) =$1;3649$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND revision=?",{},1);3650$db_query->execute($filename,$intRev);3651}3652elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)3653{3654$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND commithash=?",{},1);3655$db_query->execute($filename,$revision);3656}else{3657$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_headWHERE name=?",{},1);3658$db_query->execute($filename);3659}36603661my$meta=$db_query->fetchrow_hashref;3662if($meta)3663{3664$meta->{revision} ="1.$meta->{revision}";3665}3666return$meta;3667}36683669=head2 commitmessage36703671this function takes a commithash and returns the commit message for that commit36723673=cut3674sub commitmessage3675{3676my$self=shift;3677my$commithash=shift;3678my$tablename=$self->tablename("commitmsgs");36793680die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);36813682my$db_query;3683$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3684$db_query->execute($commithash);36853686my($message) =$db_query->fetchrow_array;36873688if(defined($message) )3689{3690$message.=" "if($message=~/\n$/);3691return$message;3692}36933694my@lines= safe_pipe_capture("git","cat-file","commit",$commithash);3695shift@lineswhile($lines[0] =~/\S/);3696$message=join("",@lines);3697$message.=" "if($message=~/\n$/);3698return$message;3699}37003701=head2 gethistorydense37023703This function takes a filename (with path) argument and returns an arrayofarrays3704containing revision,filehash,commithash ordered by revision descending.37053706This version of gethistory skips deleted entries -- so it is useful for annotate.3707The 'dense' part is a reference to a '--dense' option available for git-rev-list3708and other git tools that depend on it.37093710See also getlog().37113712=cut3713sub gethistorydense3714{3715my$self=shift;3716my$filename=shift;3717my$tablename=$self->tablename("revision");37183719my$db_query;3720$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);3721$db_query->execute($filename);37223723my$result=$db_query->fetchall_arrayref;37243725my$i;3726for($i=0;$i<scalar(@$result) ;$i++)3727{3728$result->[$i][0]="1.".$result->[$i][0];3729}37303731return$result;3732}37333734=head2 in_array()37353736from Array::PAT - mimics the in_array() function3737found in PHP. Yuck but works for small arrays.37383739=cut3740sub in_array3741{3742my($check,@array) =@_;3743my$retval=0;3744foreachmy$test(@array){3745if($checkeq$test){3746$retval=1;3747}3748}3749return$retval;3750}37513752=head2 safe_pipe_capture37533754an alternative to `command` that allows input to be passed as an array3755to work around shell problems with weird characters in arguments37563757=cut3758sub safe_pipe_capture {37593760my@output;37613762if(my$pid=open my$child,'-|') {3763@output= (<$child>);3764close$childor die join(' ',@_).":$!$?";3765}else{3766exec(@_)or die"$!$?";# exec() can fail the executable can't be found3767}3768returnwantarray?@output:join('',@output);3769}37703771=head2 mangle_dirname37723773create a string from a directory name that is suitable to use as3774part of a filename, mainly by converting all chars except \w.- to _37753776=cut3777sub mangle_dirname {3778my$dirname=shift;3779return unlessdefined$dirname;37803781$dirname=~s/[^\w.-]/_/g;37823783return$dirname;3784}37853786=head2 mangle_tablename37873788create a string from a that is suitable to use as part of an SQL table3789name, mainly by converting all chars except \w to _37903791=cut3792sub mangle_tablename {3793my$tablename=shift;3794return unlessdefined$tablename;37953796$tablename=~s/[^\w_]/_/g;37973798return$tablename;3799}380038011;