1#!/usr/bin/perl 2 3#### 4#### This application is a CVS emulation layer for git. 5#### It is intended for clients to connect over SSH. 6#### See the documentation for more details. 7#### 8#### Copyright The Open University UK - 2006. 9#### 10#### Authors: Martyn Smith <martyn@catalyst.net.nz> 11#### Martin Langhoff <martin@catalyst.net.nz> 12#### 13#### 14#### Released under the GNU Public License, version 2. 15#### 16#### 17 18use strict; 19use warnings; 20use bytes; 21 22use Fcntl; 23use File::Temp qw/tempdir tempfile/; 24use File::Path qw/rmtree/; 25use File::Basename; 26use Getopt::Long qw(:config require_order no_ignore_case); 27 28my$VERSION='@@GIT_VERSION@@'; 29 30my$log= GITCVS::log->new(); 31my$cfg; 32 33my$DATE_LIST= { 34 Jan =>"01", 35 Feb =>"02", 36 Mar =>"03", 37 Apr =>"04", 38 May =>"05", 39 Jun =>"06", 40 Jul =>"07", 41 Aug =>"08", 42 Sep =>"09", 43 Oct =>"10", 44 Nov =>"11", 45 Dec =>"12", 46}; 47 48# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 49$| =1; 50 51#### Definition and mappings of functions #### 52 53my$methods= { 54'Root'=> \&req_Root, 55'Valid-responses'=> \&req_Validresponses, 56'valid-requests'=> \&req_validrequests, 57'Directory'=> \&req_Directory, 58'Entry'=> \&req_Entry, 59'Modified'=> \&req_Modified, 60'Unchanged'=> \&req_Unchanged, 61'Questionable'=> \&req_Questionable, 62'Argument'=> \&req_Argument, 63'Argumentx'=> \&req_Argument, 64'expand-modules'=> \&req_expandmodules, 65'add'=> \&req_add, 66'remove'=> \&req_remove, 67'co'=> \&req_co, 68'update'=> \&req_update, 69'ci'=> \&req_ci, 70'diff'=> \&req_diff, 71'log'=> \&req_log, 72'rlog'=> \&req_log, 73'tag'=> \&req_CATCHALL, 74'status'=> \&req_status, 75'admin'=> \&req_CATCHALL, 76'history'=> \&req_CATCHALL, 77'watchers'=> \&req_EMPTY, 78'editors'=> \&req_EMPTY, 79'noop'=> \&req_EMPTY, 80'annotate'=> \&req_annotate, 81'Global_option'=> \&req_Globaloption, 82#'annotate' => \&req_CATCHALL, 83}; 84 85############################################## 86 87 88# $state holds all the bits of information the clients sends us that could 89# potentially be useful when it comes to actually _doing_ something. 90my$state= { prependdir =>''}; 91 92# Work is for managing temporary working directory 93my$work= 94{ 95state=>undef,# undef, 1 (empty), 2 (with stuff) 96 workDir =>undef, 97index=>undef, 98 emptyDir =>undef, 99 tmpDir =>undef 100}; 101 102$log->info("--------------- STARTING -----------------"); 103 104my$usage= 105"Usage: git cvsserver [options] [pserver|server] [<directory> ...]\n". 106" --base-path <path> : Prepend to requested CVSROOT\n". 107" Can be read from GIT_CVSSERVER_BASE_PATH\n". 108" --strict-paths : Don't allow recursing into subdirectories\n". 109" --export-all : Don't check for gitcvs.enabled in config\n". 110" --version, -V : Print version information and exit\n". 111" --help, -h, -H : Print usage information and exit\n". 112"\n". 113"<directory> ... is a list of allowed directories. If no directories\n". 114"are given, all are allowed. This is an additional restriction, gitcvs\n". 115"access still needs to be enabled by the gitcvs.enabled config option.\n". 116"Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n"; 117 118my@opts= ('help|h|H','version|V', 119'base-path=s','strict-paths','export-all'); 120GetOptions($state,@opts) 121or die$usage; 122 123if($state->{version}) { 124print"git-cvsserver version$VERSION\n"; 125exit; 126} 127if($state->{help}) { 128print$usage; 129exit; 130} 131 132my$TEMP_DIR= tempdir( CLEANUP =>1); 133$log->debug("Temporary directory is '$TEMP_DIR'"); 134 135$state->{method} ='ext'; 136if(@ARGV) { 137if($ARGV[0]eq'pserver') { 138$state->{method} ='pserver'; 139shift@ARGV; 140}elsif($ARGV[0]eq'server') { 141shift@ARGV; 142} 143} 144 145# everything else is a directory 146$state->{allowed_roots} = [@ARGV]; 147 148# don't export the whole system unless the users requests it 149if($state->{'export-all'} && !@{$state->{allowed_roots}}) { 150die"--export-all can only be used together with an explicit whitelist\n"; 151} 152 153# Environment handling for running under git-shell 154if(exists$ENV{GIT_CVSSERVER_BASE_PATH}) { 155if($state->{'base-path'}) { 156die"Cannot specify base path both ways.\n"; 157} 158my$base_path=$ENV{GIT_CVSSERVER_BASE_PATH}; 159$state->{'base-path'} =$base_path; 160$log->debug("Picked up base path '$base_path' from environment.\n"); 161} 162if(exists$ENV{GIT_CVSSERVER_ROOT}) { 163if(@{$state->{allowed_roots}}) { 164die"Cannot specify roots both ways:@ARGV\n"; 165} 166my$allowed_root=$ENV{GIT_CVSSERVER_ROOT}; 167$state->{allowed_roots} = [$allowed_root]; 168$log->debug("Picked up allowed root '$allowed_root' from environment.\n"); 169} 170 171# if we are called with a pserver argument, 172# deal with the authentication cat before entering the 173# main loop 174if($state->{method}eq'pserver') { 175my$line= <STDIN>;chomp$line; 176unless($line=~/^BEGIN (AUTH|VERIFICATION) REQUEST$/) { 177die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 178} 179my$request=$1; 180$line= <STDIN>;chomp$line; 181unless(req_Root('root',$line)) {# reuse Root 182print"E Invalid root$line\n"; 183exit1; 184} 185$line= <STDIN>;chomp$line; 186my$user=$line; 187$line= <STDIN>;chomp$line; 188my$password=$line; 189 190if($usereq'anonymous') { 191# "A" will be 1 byte, use length instead in case the 192# encryption method ever changes (yeah, right!) 193if(length($password) >1) { 194print"E Don't supply a password for the `anonymous' user\n"; 195print"I HATE YOU\n"; 196exit1; 197} 198 199# Fall through to LOVE 200}else{ 201# Trying to authenticate a user 202if(not exists$cfg->{gitcvs}->{authdb}) { 203print"E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n"; 204print"I HATE YOU\n"; 205exit1; 206} 207 208my$authdb=$cfg->{gitcvs}->{authdb}; 209 210unless(-e $authdb) { 211print"E The authentication database specified in [gitcvs.authdb] does not exist\n"; 212print"I HATE YOU\n"; 213exit1; 214} 215 216my$auth_ok; 217open my$passwd,"<",$authdbor die$!; 218while(<$passwd>) { 219if(m{^\Q$user\E:(.*)}) { 220if(crypt($user, descramble($password))eq$1) { 221$auth_ok=1; 222} 223}; 224} 225close$passwd; 226 227unless($auth_ok) { 228print"I HATE YOU\n"; 229exit1; 230} 231 232# Fall through to LOVE 233} 234 235# For checking whether the user is anonymous on commit 236$state->{user} =$user; 237 238$line= <STDIN>;chomp$line; 239unless($lineeq"END$requestREQUEST") { 240die"E Do not understand$line-- expecting END$requestREQUEST\n"; 241} 242print"I LOVE YOU\n"; 243exit if$requesteq'VERIFICATION';# cvs login 244# and now back to our regular programme... 245} 246 247# Keep going until the client closes the connection 248while(<STDIN>) 249{ 250chomp; 251 252# Check to see if we've seen this method, and call appropriate function. 253if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 254{ 255# use the $methods hash to call the appropriate sub for this command 256#$log->info("Method : $1"); 257&{$methods->{$1}}($1,$2); 258}else{ 259# log fatal because we don't understand this function. If this happens 260# we're fairly screwed because we don't know if the client is expecting 261# a response. If it is, the client will hang, we'll hang, and the whole 262# thing will be custard. 263$log->fatal("Don't understand command$_\n"); 264die("Unknown command$_"); 265} 266} 267 268$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 269$log->info("--------------- FINISH -----------------"); 270 271chdir'/'; 272exit0; 273 274# Magic catchall method. 275# This is the method that will handle all commands we haven't yet 276# implemented. It simply sends a warning to the log file indicating a 277# command that hasn't been implemented has been invoked. 278sub req_CATCHALL 279{ 280my($cmd,$data) =@_; 281$log->warn("Unhandled command : req_$cmd:$data"); 282} 283 284# This method invariably succeeds with an empty response. 285sub req_EMPTY 286{ 287print"ok\n"; 288} 289 290# Root pathname \n 291# Response expected: no. Tell the server which CVSROOT to use. Note that 292# pathname is a local directory and not a fully qualified CVSROOT variable. 293# pathname must already exist; if creating a new root, use the init 294# request, not Root. pathname does not include the hostname of the server, 295# how to access the server, etc.; by the time the CVS protocol is in use, 296# connection, authentication, etc., are already taken care of. The Root 297# request must be sent only once, and it must be sent before any requests 298# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 299sub req_Root 300{ 301my($cmd,$data) =@_; 302$log->debug("req_Root :$data"); 303 304unless($data=~ m#^/#) { 305print"error 1 Root must be an absolute pathname\n"; 306return0; 307} 308 309my$cvsroot=$state->{'base-path'} ||''; 310$cvsroot=~ s#/+$##; 311$cvsroot.=$data; 312 313if($state->{CVSROOT} 314&& ($state->{CVSROOT}ne$cvsroot)) { 315print"error 1 Conflicting roots specified\n"; 316return0; 317} 318 319$state->{CVSROOT} =$cvsroot; 320 321$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 322 323if(@{$state->{allowed_roots}}) { 324my$allowed=0; 325foreachmy$dir(@{$state->{allowed_roots}}) { 326next unless$dir=~ m#^/#; 327$dir=~ s#/+$##; 328if($state->{'strict-paths'}) { 329if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 330$allowed=1; 331last; 332} 333}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 334$allowed=1; 335last; 336} 337} 338 339unless($allowed) { 340print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 341print"E\n"; 342print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 343return0; 344} 345} 346 347unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 348print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 349print"E\n"; 350print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 351return0; 352} 353 354my@gitvars=`git config -l`; 355if($?) { 356print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 357print"E\n"; 358print"error 1 - problem executing git-config\n"; 359return0; 360} 361foreachmy$line(@gitvars) 362{ 363next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 364unless($2) { 365$cfg->{$1}{$3} =$4; 366}else{ 367$cfg->{$1}{$2}{$3} =$4; 368} 369} 370 371my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 372||$cfg->{gitcvs}{enabled}); 373unless($state->{'export-all'} || 374($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 375print"E GITCVS emulation needs to be enabled on this repo\n"; 376print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 377print"E\n"; 378print"error 1 GITCVS emulation disabled\n"; 379return0; 380} 381 382my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 383if($logfile) 384{ 385$log->setfile($logfile); 386}else{ 387$log->nofile(); 388} 389 390return1; 391} 392 393# Global_option option \n 394# Response expected: no. Transmit one of the global options `-q', `-Q', 395# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 396# variations (such as combining of options) are allowed. For graceful 397# handling of valid-requests, it is probably better to make new global 398# options separate requests, rather than trying to add them to this 399# request. 400sub req_Globaloption 401{ 402my($cmd,$data) =@_; 403$log->debug("req_Globaloption :$data"); 404$state->{globaloptions}{$data} =1; 405} 406 407# Valid-responses request-list \n 408# Response expected: no. Tell the server what responses the client will 409# accept. request-list is a space separated list of tokens. 410sub req_Validresponses 411{ 412my($cmd,$data) =@_; 413$log->debug("req_Validresponses :$data"); 414 415# TODO : re-enable this, currently it's not particularly useful 416#$state->{validresponses} = [ split /\s+/, $data ]; 417} 418 419# valid-requests \n 420# Response expected: yes. Ask the server to send back a Valid-requests 421# response. 422sub req_validrequests 423{ 424my($cmd,$data) =@_; 425 426$log->debug("req_validrequests"); 427 428$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 429$log->debug("SEND : ok"); 430 431print"Valid-requests ".join(" ",keys%$methods) ."\n"; 432print"ok\n"; 433} 434 435# Directory local-directory \n 436# Additional data: repository \n. Response expected: no. Tell the server 437# what directory to use. The repository should be a directory name from a 438# previous server response. Note that this both gives a default for Entry 439# and Modified and also for ci and the other commands; normal usage is to 440# send Directory for each directory in which there will be an Entry or 441# Modified, and then a final Directory for the original directory, then the 442# command. The local-directory is relative to the top level at which the 443# command is occurring (i.e. the last Directory which is sent before the 444# command); to indicate that top level, `.' should be sent for 445# local-directory. 446sub req_Directory 447{ 448my($cmd,$data) =@_; 449 450my$repository= <STDIN>; 451chomp$repository; 452 453 454$state->{localdir} =$data; 455$state->{repository} =$repository; 456$state->{path} =$repository; 457$state->{path} =~s/^\Q$state->{CVSROOT}\E\///; 458$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 459$state->{path} .="/"if($state->{path} =~ /\S/ ); 460 461$state->{directory} =$state->{localdir}; 462$state->{directory} =""if($state->{directory}eq"."); 463$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 464 465if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 466{ 467$log->info("Setting prepend to '$state->{path}'"); 468$state->{prependdir} =$state->{path}; 469foreachmy$entry(keys%{$state->{entries}} ) 470{ 471$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 472delete$state->{entries}{$entry}; 473} 474} 475 476if(defined($state->{prependdir} ) ) 477{ 478$log->debug("Prepending '$state->{prependdir}' to state|directory"); 479$state->{directory} =$state->{prependdir} .$state->{directory} 480} 481$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 482} 483 484# Entry entry-line \n 485# Response expected: no. Tell the server what version of a file is on the 486# local machine. The name in entry-line is a name relative to the directory 487# most recently specified with Directory. If the user is operating on only 488# some files in a directory, Entry requests for only those files need be 489# included. If an Entry request is sent without Modified, Is-modified, or 490# Unchanged, it means the file is lost (does not exist in the working 491# directory). If both Entry and one of Modified, Is-modified, or Unchanged 492# are sent for the same file, Entry must be sent first. For a given file, 493# one can send Modified, Is-modified, or Unchanged, but not more than one 494# of these three. 495sub req_Entry 496{ 497my($cmd,$data) =@_; 498 499#$log->debug("req_Entry : $data"); 500 501my@data=split(/\//,$data); 502 503$state->{entries}{$state->{directory}.$data[1]} = { 504 revision =>$data[2], 505 conflict =>$data[3], 506 options =>$data[4], 507 tag_or_date =>$data[5], 508}; 509 510$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 511} 512 513# Questionable filename \n 514# Response expected: no. Additional data: no. Tell the server to check 515# whether filename should be ignored, and if not, next time the server 516# sends responses, send (in a M response) `?' followed by the directory and 517# filename. filename must not contain `/'; it needs to be a file in the 518# directory named by the most recent Directory request. 519sub req_Questionable 520{ 521my($cmd,$data) =@_; 522 523$log->debug("req_Questionable :$data"); 524$state->{entries}{$state->{directory}.$data}{questionable} =1; 525} 526 527# add \n 528# Response expected: yes. Add a file or directory. This uses any previous 529# Argument, Directory, Entry, or Modified requests, if they have been sent. 530# The last Directory sent specifies the working directory at the time of 531# the operation. To add a directory, send the directory to be added using 532# Directory and Argument requests. 533sub req_add 534{ 535my($cmd,$data) =@_; 536 537 argsplit("add"); 538 539my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 540$updater->update(); 541 542 argsfromdir($updater); 543 544my$addcount=0; 545 546foreachmy$filename( @{$state->{args}} ) 547{ 548$filename= filecleanup($filename); 549 550my$meta=$updater->getmeta($filename); 551my$wrev= revparse($filename); 552 553if($wrev&&$meta&& ($wrev<0)) 554{ 555# previously removed file, add back 556$log->info("added file$filenamewas previously removed, send 1.$meta->{revision}"); 557 558print"MT +updated\n"; 559print"MT text U\n"; 560print"MT fname$filename\n"; 561print"MT newline\n"; 562print"MT -updated\n"; 563 564unless($state->{globaloptions}{-n} ) 565{ 566my($filepart,$dirpart) = filenamesplit($filename,1); 567 568print"Created$dirpart\n"; 569print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 570 571# this is an "entries" line 572my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 573$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 574print"/$filepart/1.$meta->{revision}//$kopts/\n"; 575# permissions 576$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 577print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 578# transmit file 579 transmitfile($meta->{filehash}); 580} 581 582next; 583} 584 585unless(defined($state->{entries}{$filename}{modified_filename} ) ) 586{ 587print"E cvs add: nothing known about `$filename'\n"; 588next; 589} 590# TODO : check we're not squashing an already existing file 591if(defined($state->{entries}{$filename}{revision} ) ) 592{ 593print"E cvs add: `$filename' has already been entered\n"; 594next; 595} 596 597my($filepart,$dirpart) = filenamesplit($filename,1); 598 599print"E cvs add: scheduling file `$filename' for addition\n"; 600 601print"Checked-in$dirpart\n"; 602print"$filename\n"; 603my$kopts= kopts_from_path($filename,"file", 604$state->{entries}{$filename}{modified_filename}); 605print"/$filepart/0//$kopts/\n"; 606 607my$requestedKopts=$state->{opt}{k}; 608if(defined($requestedKopts)) 609{ 610$requestedKopts="-k$requestedKopts"; 611} 612else 613{ 614$requestedKopts=""; 615} 616if($koptsne$requestedKopts) 617{ 618$log->warn("Ignoring requested -k='$requestedKopts'" 619." for '$filename'; detected -k='$kopts' instead"); 620#TODO: Also have option to send warning to user? 621} 622 623$addcount++; 624} 625 626if($addcount==1) 627{ 628print"E cvs add: use `cvs commit' to add this file permanently\n"; 629} 630elsif($addcount>1) 631{ 632print"E cvs add: use `cvs commit' to add these files permanently\n"; 633} 634 635print"ok\n"; 636} 637 638# remove \n 639# Response expected: yes. Remove a file. This uses any previous Argument, 640# Directory, Entry, or Modified requests, if they have been sent. The last 641# Directory sent specifies the working directory at the time of the 642# operation. Note that this request does not actually do anything to the 643# repository; the only effect of a successful remove request is to supply 644# the client with a new entries line containing `-' to indicate a removed 645# file. In fact, the client probably could perform this operation without 646# contacting the server, although using remove may cause the server to 647# perform a few more checks. The client sends a subsequent ci request to 648# actually record the removal in the repository. 649sub req_remove 650{ 651my($cmd,$data) =@_; 652 653 argsplit("remove"); 654 655# Grab a handle to the SQLite db and do any necessary updates 656my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 657$updater->update(); 658 659#$log->debug("add state : " . Dumper($state)); 660 661my$rmcount=0; 662 663foreachmy$filename( @{$state->{args}} ) 664{ 665$filename= filecleanup($filename); 666 667if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 668{ 669print"E cvs remove: file `$filename' still in working directory\n"; 670next; 671} 672 673my$meta=$updater->getmeta($filename); 674my$wrev= revparse($filename); 675 676unless(defined($wrev) ) 677{ 678print"E cvs remove: nothing known about `$filename'\n"; 679next; 680} 681 682if(defined($wrev)and$wrev<0) 683{ 684print"E cvs remove: file `$filename' already scheduled for removal\n"; 685next; 686} 687 688unless($wrev==$meta->{revision} ) 689{ 690# TODO : not sure if the format of this message is quite correct. 691print"E cvs remove: Up to date check failed for `$filename'\n"; 692next; 693} 694 695 696my($filepart,$dirpart) = filenamesplit($filename,1); 697 698print"E cvs remove: scheduling `$filename' for removal\n"; 699 700print"Checked-in$dirpart\n"; 701print"$filename\n"; 702my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 703print"/$filepart/-1.$wrev//$kopts/\n"; 704 705$rmcount++; 706} 707 708if($rmcount==1) 709{ 710print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 711} 712elsif($rmcount>1) 713{ 714print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 715} 716 717print"ok\n"; 718} 719 720# Modified filename \n 721# Response expected: no. Additional data: mode, \n, file transmission. Send 722# the server a copy of one locally modified file. filename is a file within 723# the most recent directory sent with Directory; it must not contain `/'. 724# If the user is operating on only some files in a directory, only those 725# files need to be included. This can also be sent without Entry, if there 726# is no entry for the file. 727sub req_Modified 728{ 729my($cmd,$data) =@_; 730 731my$mode= <STDIN>; 732defined$mode 733or(print"E end of file reading mode for$data\n"),return; 734chomp$mode; 735my$size= <STDIN>; 736defined$size 737or(print"E end of file reading size of$data\n"),return; 738chomp$size; 739 740# Grab config information 741my$blocksize=8192; 742my$bytesleft=$size; 743my$tmp; 744 745# Get a filehandle/name to write it to 746my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 747 748# Loop over file data writing out to temporary file. 749while($bytesleft) 750{ 751$blocksize=$bytesleftif($bytesleft<$blocksize); 752read STDIN,$tmp,$blocksize; 753print$fh $tmp; 754$bytesleft-=$blocksize; 755} 756 757close$fh 758or(print"E failed to write temporary,$filename:$!\n"),return; 759 760# Ensure we have something sensible for the file mode 761if($mode=~/u=(\w+)/) 762{ 763$mode=$1; 764}else{ 765$mode="rw"; 766} 767 768# Save the file data in $state 769$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 770$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 771$state->{entries}{$state->{directory}.$data}{modified_hash} =`git hash-object$filename`; 772$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 773 774 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 775} 776 777# Unchanged filename\n 778# Response expected: no. Tell the server that filename has not been 779# modified in the checked out directory. The filename is a file within the 780# most recent directory sent with Directory; it must not contain `/'. 781sub req_Unchanged 782{ 783 my ($cmd,$data) =@_; 784 785$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 786 787 #$log->debug("req_Unchanged :$data"); 788} 789 790# Argument text\n 791# Response expected: no. Save argument for use in a subsequent command. 792# Arguments accumulate until an argument-using command is given, at which 793# point they are forgotten. 794# Argumentx text\n 795# Response expected: no. Append\nfollowed by text to the current argument 796# being saved. 797sub req_Argument 798{ 799 my ($cmd,$data) =@_; 800 801 # Argumentx means: append to last Argument (with a newline in front) 802 803$log->debug("$cmd:$data"); 804 805 if ($cmdeq 'Argumentx') { 806 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 807 } else { 808 push @{$state->{arguments}},$data; 809 } 810} 811 812# expand-modules\n 813# Response expected: yes. Expand the modules which are specified in the 814# arguments. Returns the data in Module-expansion responses. Note that the 815# server can assume that this is checkout or export, not rtag or rdiff; the 816# latter do not access the working directory and thus have no need to 817# expand modules on the client side. Expand may not be the best word for 818# what this request does. It does not necessarily tell you all the files 819# contained in a module, for example. Basically it is a way of telling you 820# which working directories the server needs to know about in order to 821# handle a checkout of the specified modules. For example, suppose that the 822# server has a module defined by 823# aliasmodule -a 1dir 824# That is, one can check out aliasmodule and it will take 1dir in the 825# repository and check it out to 1dir in the working directory. Now suppose 826# the client already has this module checked out and is planning on using 827# the co request to update it. Without using expand-modules, the client 828# would have two bad choices: it could either send information about all 829# working directories under the current directory, which could be 830# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 831# stands for 1dir, and neglect to send information for 1dir, which would 832# lead to incorrect operation. With expand-modules, the client would first 833# ask for the module to be expanded: 834sub req_expandmodules 835{ 836 my ($cmd,$data) =@_; 837 838 argsplit(); 839 840$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 841 842 unless ( ref$state->{arguments} eq "ARRAY" ) 843 { 844 print "ok\n"; 845 return; 846 } 847 848 foreach my$module( @{$state->{arguments}} ) 849 { 850$log->debug("SEND : Module-expansion$module"); 851 print "Module-expansion$module\n"; 852 } 853 854 print "ok\n"; 855 statecleanup(); 856} 857 858# co\n 859# Response expected: yes. Get files from the repository. This uses any 860# previous Argument, Directory, Entry, or Modified requests, if they have 861# been sent. Arguments to this command are module names; the client cannot 862# know what directories they correspond to except by (1) just sending the 863# co request, and then seeing what directory names the server sends back in 864# its responses, and (2) the expand-modules request. 865sub req_co 866{ 867 my ($cmd,$data) =@_; 868 869 argsplit("co"); 870 871 # Provide list of modules, if -c was used. 872 if (exists$state->{opt}{c}) { 873 my$showref= `git show-ref --heads`; 874 for my$line(split '\n',$showref) { 875 if ($line=~ m% refs/heads/(.*)$%) { 876 print "M$1\t$1\n"; 877 } 878 } 879 print "ok\n"; 880 return 1; 881 } 882 883 my$module=$state->{args}[0]; 884$state->{module} =$module; 885 my$checkout_path=$module; 886 887 # use the user specified directory if we're given it 888$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 889 890$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 891 892$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 893 894$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 895 896# Grab a handle to the SQLite db and do any necessary updates 897my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 898$updater->update(); 899 900$checkout_path=~ s|/$||;# get rid of trailing slashes 901 902# Eclipse seems to need the Clear-sticky command 903# to prepare the 'Entries' file for the new directory. 904print"Clear-sticky$checkout_path/\n"; 905print$state->{CVSROOT} ."/$module/\n"; 906print"Clear-static-directory$checkout_path/\n"; 907print$state->{CVSROOT} ."/$module/\n"; 908print"Clear-sticky$checkout_path/\n";# yes, twice 909print$state->{CVSROOT} ."/$module/\n"; 910print"Template$checkout_path/\n"; 911print$state->{CVSROOT} ."/$module/\n"; 912print"0\n"; 913 914# instruct the client that we're checking out to $checkout_path 915print"E cvs checkout: Updating$checkout_path\n"; 916 917my%seendirs= (); 918my$lastdir=''; 919 920# recursive 921sub prepdir { 922my($dir,$repodir,$remotedir,$seendirs) =@_; 923my$parent= dirname($dir); 924$dir=~ s|/+$||; 925$repodir=~ s|/+$||; 926$remotedir=~ s|/+$||; 927$parent=~ s|/+$||; 928$log->debug("announcedir$dir,$repodir,$remotedir"); 929 930if($parenteq'.'||$parenteq'./') { 931$parent=''; 932} 933# recurse to announce unseen parents first 934if(length($parent) && !exists($seendirs->{$parent})) { 935 prepdir($parent,$repodir,$remotedir,$seendirs); 936} 937# Announce that we are going to modify at the parent level 938if($parent) { 939print"E cvs checkout: Updating$remotedir/$parent\n"; 940}else{ 941print"E cvs checkout: Updating$remotedir\n"; 942} 943print"Clear-sticky$remotedir/$parent/\n"; 944print"$repodir/$parent/\n"; 945 946print"Clear-static-directory$remotedir/$dir/\n"; 947print"$repodir/$dir/\n"; 948print"Clear-sticky$remotedir/$parent/\n";# yes, twice 949print"$repodir/$parent/\n"; 950print"Template$remotedir/$dir/\n"; 951print"$repodir/$dir/\n"; 952print"0\n"; 953 954$seendirs->{$dir} =1; 955} 956 957foreachmy$git( @{$updater->gethead} ) 958{ 959# Don't want to check out deleted files 960next if($git->{filehash}eq"deleted"); 961 962my$fullName=$git->{name}; 963($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 964 965if(length($git->{dir}) &&$git->{dir}ne'./' 966&&$git->{dir}ne$lastdir) { 967unless(exists($seendirs{$git->{dir}})) { 968 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 969$checkout_path, \%seendirs); 970$lastdir=$git->{dir}; 971$seendirs{$git->{dir}} =1; 972} 973print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 974} 975 976# modification time of this file 977print"Mod-time$git->{modified}\n"; 978 979# print some information to the client 980if(defined($git->{dir} )and$git->{dir}ne"./") 981{ 982print"M U$checkout_path/$git->{dir}$git->{name}\n"; 983}else{ 984print"M U$checkout_path/$git->{name}\n"; 985} 986 987# instruct client we're sending a file to put in this path 988print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 989 990print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 991 992# this is an "entries" line 993my$kopts= kopts_from_path($fullName,"sha1",$git->{filehash}); 994print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 995# permissions 996print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 997 998# transmit file 999 transmitfile($git->{filehash});1000}10011002print"ok\n";10031004 statecleanup();1005}10061007# update \n1008# Response expected: yes. Actually do a cvs update command. This uses any1009# previous Argument, Directory, Entry, or Modified requests, if they have1010# been sent. The last Directory sent specifies the working directory at the1011# time of the operation. The -I option is not used--files which the client1012# can decide whether to ignore are not mentioned and the client sends the1013# Questionable request for others.1014sub req_update1015{1016my($cmd,$data) =@_;10171018$log->debug("req_update : ". (defined($data) ?$data:"[NULL]"));10191020 argsplit("update");10211022#1023# It may just be a client exploring the available heads/modules1024# in that case, list them as top level directories and leave it1025# at that. Eclipse uses this technique to offer you a list of1026# projects (heads in this case) to checkout.1027#1028if($state->{module}eq'') {1029my$showref=`git show-ref --heads`;1030print"E cvs update: Updating .\n";1031formy$line(split'\n',$showref) {1032if($line=~ m% refs/heads/(.*)$%) {1033print"E cvs update: New directory `$1'\n";1034}1035}1036print"ok\n";1037return1;1038}103910401041# Grab a handle to the SQLite db and do any necessary updates1042my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);10431044$updater->update();10451046 argsfromdir($updater);10471048#$log->debug("update state : " . Dumper($state));10491050my$last_dirname="///";10511052# foreach file specified on the command line ...1053foreachmy$filename( @{$state->{args}} )1054{1055$filename= filecleanup($filename);10561057$log->debug("Processing file$filename");10581059unless($state->{globaloptions}{-Q} ||$state->{globaloptions}{-q} )1060{1061my$cur_dirname= dirname($filename);1062if($cur_dirnamene$last_dirname)1063{1064$last_dirname=$cur_dirname;1065if($cur_dirnameeq"")1066{1067$cur_dirname=".";1068}1069print"E cvs update: Updating$cur_dirname\n";1070}1071}10721073# if we have a -C we should pretend we never saw modified stuff1074if(exists($state->{opt}{C} ) )1075{1076delete$state->{entries}{$filename}{modified_hash};1077delete$state->{entries}{$filename}{modified_filename};1078$state->{entries}{$filename}{unchanged} =1;1079}10801081my$meta;1082if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/)1083{1084$meta=$updater->getmeta($filename,$1);1085}else{1086$meta=$updater->getmeta($filename);1087}10881089# If -p was given, "print" the contents of the requested revision.1090if(exists($state->{opt}{p} ) ) {1091if(defined($meta->{revision} ) ) {1092$log->info("Printing '$filename' revision ".$meta->{revision});10931094 transmitfile($meta->{filehash}, {print=>1});1095}10961097next;1098}10991100if( !defined$meta)1101{1102$meta= {1103 name =>$filename,1104 revision =>0,1105 filehash =>'added'1106};1107}11081109my$oldmeta=$meta;11101111my$wrev= revparse($filename);11121113# If the working copy is an old revision, lets get that version too for comparison.1114if(defined($wrev)and$wrev!=$meta->{revision} )1115{1116$oldmeta=$updater->getmeta($filename,$wrev);1117}11181119#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");11201121# Files are up to date if the working copy and repo copy have the same revision,1122# and the working copy is unmodified _and_ the user hasn't specified -C1123next if(defined($wrev)1124and defined($meta->{revision})1125and$wrev==$meta->{revision}1126and$state->{entries}{$filename}{unchanged}1127and not exists($state->{opt}{C} ) );11281129# If the working copy and repo copy have the same revision,1130# but the working copy is modified, tell the client it's modified1131if(defined($wrev)1132and defined($meta->{revision})1133and$wrev==$meta->{revision}1134and defined($state->{entries}{$filename}{modified_hash})1135and not exists($state->{opt}{C} ) )1136{1137$log->info("Tell the client the file is modified");1138print"MT text M\n";1139print"MT fname$filename\n";1140print"MT newline\n";1141next;1142}11431144if($meta->{filehash}eq"deleted")1145{1146my($filepart,$dirpart) = filenamesplit($filename,1);11471148$log->info("Removing '$filename' from working copy (no longer in the repo)");11491150print"E cvs update: `$filename' is no longer in the repository\n";1151# Don't want to actually _DO_ the update if -n specified1152unless($state->{globaloptions}{-n} ) {1153print"Removed$dirpart\n";1154print"$filepart\n";1155}1156}1157elsif(not defined($state->{entries}{$filename}{modified_hash} )1158or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1159or$meta->{filehash}eq'added')1160{1161# normal update, just send the new revision (either U=Update,1162# or A=Add, or R=Remove)1163if(defined($wrev) &&$wrev<0)1164{1165$log->info("Tell the client the file is scheduled for removal");1166print"MT text R\n";1167print"MT fname$filename\n";1168print"MT newline\n";1169next;1170}1171elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) )1172{1173$log->info("Tell the client the file is scheduled for addition");1174print"MT text A\n";1175print"MT fname$filename\n";1176print"MT newline\n";1177next;11781179}1180else{1181$log->info("Updating '$filename' to ".$meta->{revision});1182print"MT +updated\n";1183print"MT text U\n";1184print"MT fname$filename\n";1185print"MT newline\n";1186print"MT -updated\n";1187}11881189my($filepart,$dirpart) = filenamesplit($filename,1);11901191# Don't want to actually _DO_ the update if -n specified1192unless($state->{globaloptions}{-n} )1193{1194if(defined($wrev) )1195{1196# instruct client we're sending a file to put in this path as a replacement1197print"Update-existing$dirpart\n";1198$log->debug("Updating existing file 'Update-existing$dirpart'");1199}else{1200# instruct client we're sending a file to put in this path as a new file1201print"Clear-static-directory$dirpart\n";1202print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1203print"Clear-sticky$dirpart\n";1204print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";12051206$log->debug("Creating new file 'Created$dirpart'");1207print"Created$dirpart\n";1208}1209print$state->{CVSROOT} ."/$state->{module}/$filename\n";12101211# this is an "entries" line1212my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1213$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1214print"/$filepart/1.$meta->{revision}//$kopts/\n";12151216# permissions1217$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1218print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";12191220# transmit file1221 transmitfile($meta->{filehash});1222}1223}else{1224$log->info("Updating '$filename'");1225my($filepart,$dirpart) = filenamesplit($meta->{name},1);12261227my$mergeDir= setupTmpDir();12281229my$file_local=$filepart.".mine";1230my$mergedFile="$mergeDir/$file_local";1231system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1232my$file_old=$filepart.".".$oldmeta->{revision};1233 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1234my$file_new=$filepart.".".$meta->{revision};1235 transmitfile($meta->{filehash}, { targetfile =>$file_new});12361237# we need to merge with the local changes ( M=successful merge, C=conflict merge )1238$log->info("Merging$file_local,$file_old,$file_new");1239print"M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into$filename\n";12401241$log->debug("Temporary directory for merge is$mergeDir");12421243my$return=system("git","merge-file",$file_local,$file_old,$file_new);1244$return>>=8;12451246 cleanupTmpDir();12471248if($return==0)1249{1250$log->info("Merged successfully");1251print"M M$filename\n";1252$log->debug("Merged$dirpart");12531254# Don't want to actually _DO_ the update if -n specified1255unless($state->{globaloptions}{-n} )1256{1257print"Merged$dirpart\n";1258$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1259print$state->{CVSROOT} ."/$state->{module}/$filename\n";1260my$kopts= kopts_from_path("$dirpart/$filepart",1261"file",$mergedFile);1262$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1263print"/$filepart/1.$meta->{revision}//$kopts/\n";1264}1265}1266elsif($return==1)1267{1268$log->info("Merged with conflicts");1269print"E cvs update: conflicts found in$filename\n";1270print"M C$filename\n";12711272# Don't want to actually _DO_ the update if -n specified1273unless($state->{globaloptions}{-n} )1274{1275print"Merged$dirpart\n";1276print$state->{CVSROOT} ."/$state->{module}/$filename\n";1277my$kopts= kopts_from_path("$dirpart/$filepart",1278"file",$mergedFile);1279print"/$filepart/1.$meta->{revision}/+/$kopts/\n";1280}1281}1282else1283{1284$log->warn("Merge failed");1285next;1286}12871288# Don't want to actually _DO_ the update if -n specified1289unless($state->{globaloptions}{-n} )1290{1291# permissions1292$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1293print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";12941295# transmit file, format is single integer on a line by itself (file1296# size) followed by the file contents1297# TODO : we should copy files in blocks1298my$data=`cat$mergedFile`;1299$log->debug("File size : " . length($data));1300 print length($data) . "\n";1301 print$data;1302 }1303 }13041305 }13061307 print "ok\n";1308}13091310sub req_ci1311{1312 my ($cmd,$data) =@_;13131314 argsplit("ci");13151316 #$log->debug("State : " . Dumper($state));13171318$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));13191320 if ($state->{method} eq 'pserver' and$state->{user} eq 'anonymous' )1321 {1322 print "error 1 anonymous user cannot commit via pserver\n";1323 cleanupWorkTree();1324 exit;1325 }13261327 if ( -e$state->{CVSROOT} . "/index" )1328 {1329$log->warn("file 'index' already exists in the git repository");1330 print "error 1 Index already exists in git repo\n";1331 cleanupWorkTree();1332 exit;1333 }13341335 # Grab a handle to the SQLite db and do any necessary updates1336 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1337$updater->update();13381339 # Remember where the head was at the beginning.1340 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1341 chomp$parenthash;1342 if ($parenthash!~ /^[0-9a-f]{40}$/) {1343 print "error 1 pserver cannot find the current HEAD of module";1344 cleanupWorkTree();1345 exit;1346 }13471348 setupWorkTree($parenthash);13491350$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");13511352$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");13531354 my@committedfiles= ();1355 my%oldmeta;13561357 # foreach file specified on the command line ...1358 foreach my$filename( @{$state->{args}} )1359 {1360 my$committedfile=$filename;1361$filename= filecleanup($filename);13621363 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );13641365 my$meta=$updater->getmeta($filename);1366$oldmeta{$filename} =$meta;13671368 my$wrev= revparse($filename);13691370 my ($filepart,$dirpart) = filenamesplit($filename);13711372 # do a checkout of the file if it is part of this tree1373 if ($wrev) {1374 system('git', 'checkout-index', '-f', '-u',$filename);1375 unless ($?== 0) {1376 die "Error running git-checkout-index -f -u$filename:$!";1377 }1378 }13791380 my$addflag= 0;1381 my$rmflag= 0;1382$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1383$addflag= 1 unless ( -e$filename);13841385 # Do up to date checking1386 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1387 {1388 # fail everything if an up to date check fails1389 print "error 1 Up to date check failed for$filename\n";1390 cleanupWorkTree();1391 exit;1392 }13931394 push@committedfiles,$committedfile;1395$log->info("Committing$filename");13961397 system("mkdir","-p",$dirpart) unless ( -d$dirpart);13981399 unless ($rmflag)1400 {1401$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1402 rename$state->{entries}{$filename}{modified_filename},$filename;14031404 # Calculate modes to remove1405 my$invmode= "";1406 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }14071408$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1409 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1410 }14111412 if ($rmflag)1413 {1414$log->info("Removing file '$filename'");1415 unlink($filename);1416 system("git", "update-index", "--remove",$filename);1417 }1418 elsif ($addflag)1419 {1420$log->info("Adding file '$filename'");1421 system("git", "update-index", "--add",$filename);1422 } else {1423$log->info("Updating file '$filename'");1424 system("git", "update-index",$filename);1425 }1426 }14271428 unless ( scalar(@committedfiles) > 0 )1429 {1430 print "E No files to commit\n";1431 print "ok\n";1432 cleanupWorkTree();1433 return;1434 }14351436 my$treehash= `git write-tree`;1437 chomp$treehash;14381439$log->debug("Treehash :$treehash, Parenthash :$parenthash");14401441 # write our commit message out if we have one ...1442 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1443 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1444 if ( defined ($cfg->{gitcvs}{commitmsgannotation} ) ) {1445 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/) {1446 print$msg_fh"\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"1447 }1448 } else {1449 print$msg_fh"\n\nvia git-CVS emulator\n";1450 }1451 close$msg_fh;14521453 my$commithash= `git commit-tree $treehash-p $parenthash<$msg_filename`;1454chomp($commithash);1455$log->info("Commit hash :$commithash");14561457unless($commithash=~/[a-zA-Z0-9]{40}/)1458{1459$log->warn("Commit failed (Invalid commit hash)");1460print"error 1 Commit failed (unknown reason)\n";1461 cleanupWorkTree();1462exit;1463}14641465### Emulate git-receive-pack by running hooks/update1466my@hook= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1467$parenthash,$commithash);1468if( -x $hook[0] ) {1469unless(system(@hook) ==0)1470{1471$log->warn("Commit failed (update hook declined to update ref)");1472print"error 1 Commit failed (update hook declined)\n";1473 cleanupWorkTree();1474exit;1475}1476}14771478### Update the ref1479if(system(qw(git update-ref -m),"cvsserver ci",1480"refs/heads/$state->{module}",$commithash,$parenthash)) {1481$log->warn("update-ref for$state->{module} failed.");1482print"error 1 Cannot commit -- update first\n";1483 cleanupWorkTree();1484exit;1485}14861487### Emulate git-receive-pack by running hooks/post-receive1488my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1489if( -x $hook) {1490open(my$pipe,"|$hook") ||die"can't fork$!";14911492local$SIG{PIPE} =sub{die'pipe broke'};14931494print$pipe"$parenthash$commithashrefs/heads/$state->{module}\n";14951496close$pipe||die"bad pipe:$!$?";1497}14981499$updater->update();15001501### Then hooks/post-update1502$hook=$ENV{GIT_DIR}.'hooks/post-update';1503if(-x $hook) {1504system($hook,"refs/heads/$state->{module}");1505}15061507# foreach file specified on the command line ...1508foreachmy$filename(@committedfiles)1509{1510$filename= filecleanup($filename);15111512my$meta=$updater->getmeta($filename);1513unless(defined$meta->{revision}) {1514$meta->{revision} =1;1515}15161517my($filepart,$dirpart) = filenamesplit($filename,1);15181519$log->debug("Checked-in$dirpart:$filename");15201521print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1522if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1523{1524print"M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";1525print"Remove-entry$dirpart\n";1526print"$filename\n";1527}else{1528if($meta->{revision} ==1) {1529print"M initial revision: 1.1\n";1530}else{1531print"M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";1532}1533print"Checked-in$dirpart\n";1534print"$filename\n";1535my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1536print"/$filepart/1.$meta->{revision}//$kopts/\n";1537}1538}15391540 cleanupWorkTree();1541print"ok\n";1542}15431544sub req_status1545{1546my($cmd,$data) =@_;15471548 argsplit("status");15491550$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1551#$log->debug("status state : " . Dumper($state));15521553# Grab a handle to the SQLite db and do any necessary updates1554my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1555$updater->update();15561557# if no files were specified, we need to work out what files we should be providing status on ...1558 argsfromdir($updater);15591560# foreach file specified on the command line ...1561foreachmy$filename( @{$state->{args}} )1562{1563$filename= filecleanup($filename);15641565next ifexists($state->{opt}{l}) &&index($filename,'/',length($state->{prependdir})) >=0;15661567my$meta=$updater->getmeta($filename);1568my$oldmeta=$meta;15691570my$wrev= revparse($filename);15711572# If the working copy is an old revision, lets get that version too for comparison.1573if(defined($wrev)and$wrev!=$meta->{revision} )1574{1575$oldmeta=$updater->getmeta($filename,$wrev);1576}15771578# TODO : All possible statuses aren't yet implemented1579my$status;1580# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1581$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1582and1583( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1584or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1585);15861587# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1588$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1589and1590($state->{entries}{$filename}{unchanged}1591or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1592);15931594# Need checkout if it exists in the repo but doesn't have a working copy1595$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );15961597# Locally modified if working copy and repo copy have the same revision but there are local changes1598$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );15991600# Needs Merge if working copy revision is less than repo copy and there are local changes1601$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );16021603$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1604$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1605$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1606$status||="File had conflicts on merge"if(0);16071608$status||="Unknown";16091610my($filepart) = filenamesplit($filename);16111612print"M ===================================================================\n";1613print"M File:$filepart\tStatus:$status\n";1614if(defined($state->{entries}{$filename}{revision}) )1615{1616print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1617}else{1618print"M Working revision:\tNo entry for$filename\n";1619}1620if(defined($meta->{revision}) )1621{1622print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1623print"M Sticky Tag:\t\t(none)\n";1624print"M Sticky Date:\t\t(none)\n";1625print"M Sticky Options:\t\t(none)\n";1626}else{1627print"M Repository revision:\tNo revision control file\n";1628}1629print"M\n";1630}16311632print"ok\n";1633}16341635sub req_diff1636{1637my($cmd,$data) =@_;16381639 argsplit("diff");16401641$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1642#$log->debug("status state : " . Dumper($state));16431644my($revision1,$revision2);1645if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1646{1647$revision1=$state->{opt}{r}[0];1648$revision2=$state->{opt}{r}[1];1649}else{1650$revision1=$state->{opt}{r};1651}16521653$revision1=~s/^1\.//if(defined($revision1) );1654$revision2=~s/^1\.//if(defined($revision2) );16551656$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );16571658# Grab a handle to the SQLite db and do any necessary updates1659my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1660$updater->update();16611662# if no files were specified, we need to work out what files we should be providing status on ...1663 argsfromdir($updater);16641665# foreach file specified on the command line ...1666foreachmy$filename( @{$state->{args}} )1667{1668$filename= filecleanup($filename);16691670my($fh,$file1,$file2,$meta1,$meta2,$filediff);16711672my$wrev= revparse($filename);16731674# We need _something_ to diff against1675next unless(defined($wrev) );16761677# if we have a -r switch, use it1678if(defined($revision1) )1679{1680(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1681$meta1=$updater->getmeta($filename,$revision1);1682unless(defined($meta1)and$meta1->{filehash}ne"deleted")1683{1684print"E File$filenameat revision 1.$revision1doesn't exist\n";1685next;1686}1687 transmitfile($meta1->{filehash}, { targetfile =>$file1});1688}1689# otherwise we just use the working copy revision1690else1691{1692(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1693$meta1=$updater->getmeta($filename,$wrev);1694 transmitfile($meta1->{filehash}, { targetfile =>$file1});1695}16961697# if we have a second -r switch, use it too1698if(defined($revision2) )1699{1700(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1701$meta2=$updater->getmeta($filename,$revision2);17021703unless(defined($meta2)and$meta2->{filehash}ne"deleted")1704{1705print"E File$filenameat revision 1.$revision2doesn't exist\n";1706next;1707}17081709 transmitfile($meta2->{filehash}, { targetfile =>$file2});1710}1711# otherwise we just use the working copy1712else1713{1714$file2=$state->{entries}{$filename}{modified_filename};1715}17161717# if we have been given -r, and we don't have a $file2 yet, lets get one1718if(defined($revision1)and not defined($file2) )1719{1720(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1721$meta2=$updater->getmeta($filename,$wrev);1722 transmitfile($meta2->{filehash}, { targetfile =>$file2});1723}17241725# We need to have retrieved something useful1726next unless(defined($meta1) );17271728# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1729next if(not defined($meta2)and$wrev==$meta1->{revision}1730and1731( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1732or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1733);17341735# Apparently we only show diffs for locally modified files1736next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );17371738print"M Index:$filename\n";1739print"M ===================================================================\n";1740print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1741print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1742print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1743print"M diff ";1744foreachmy$opt(keys%{$state->{opt}} )1745{1746if(ref$state->{opt}{$opt}eq"ARRAY")1747{1748foreachmy$value( @{$state->{opt}{$opt}} )1749{1750print"-$opt$value";1751}1752}else{1753print"-$opt";1754print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1755}1756}1757print"$filename\n";17581759$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));17601761($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);17621763if(exists$state->{opt}{u} )1764{1765system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1766}else{1767system("diff$file1$file2>$filediff");1768}17691770while( <$fh> )1771{1772print"M$_";1773}1774close$fh;1775}17761777print"ok\n";1778}17791780sub req_log1781{1782my($cmd,$data) =@_;17831784 argsplit("log");17851786$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1787#$log->debug("log state : " . Dumper($state));17881789my($minrev,$maxrev);1790if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1791{1792my$control=$2;1793$minrev=$1;1794$maxrev=$3;1795$minrev=~s/^1\.//if(defined($minrev) );1796$maxrev=~s/^1\.//if(defined($maxrev) );1797$minrev++if(defined($minrev)and$controleq"::");1798}17991800# Grab a handle to the SQLite db and do any necessary updates1801my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1802$updater->update();18031804# if no files were specified, we need to work out what files we should be providing status on ...1805 argsfromdir($updater);18061807# foreach file specified on the command line ...1808foreachmy$filename( @{$state->{args}} )1809{1810$filename= filecleanup($filename);18111812my$headmeta=$updater->getmeta($filename);18131814my$revisions=$updater->getlog($filename);1815my$totalrevisions=scalar(@$revisions);18161817if(defined($minrev) )1818{1819$log->debug("Removing revisions less than$minrev");1820while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1821{1822pop@$revisions;1823}1824}1825if(defined($maxrev) )1826{1827$log->debug("Removing revisions greater than$maxrev");1828while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1829{1830shift@$revisions;1831}1832}18331834next unless(scalar(@$revisions) );18351836print"M\n";1837print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1838print"M Working file:$filename\n";1839print"M head: 1.$headmeta->{revision}\n";1840print"M branch:\n";1841print"M locks: strict\n";1842print"M access list:\n";1843print"M symbolic names:\n";1844print"M keyword substitution: kv\n";1845print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1846print"M description:\n";18471848foreachmy$revision(@$revisions)1849{1850print"M ----------------------------\n";1851print"M revision 1.$revision->{revision}\n";1852# reformat the date for log output1853$revision->{modified} =sprintf('%04d/%02d/%02d%s',$3,$DATE_LIST->{$2},$1,$4)if($revision->{modified} =~/(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/and defined($DATE_LIST->{$2}) );1854$revision->{author} = cvs_author($revision->{author});1855print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1856my$commitmessage=$updater->commitmessage($revision->{commithash});1857$commitmessage=~s/^/M /mg;1858print$commitmessage."\n";1859}1860print"M =============================================================================\n";1861}18621863print"ok\n";1864}18651866sub req_annotate1867{1868my($cmd,$data) =@_;18691870 argsplit("annotate");18711872$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1873#$log->debug("status state : " . Dumper($state));18741875# Grab a handle to the SQLite db and do any necessary updates1876my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1877$updater->update();18781879# if no files were specified, we need to work out what files we should be providing annotate on ...1880 argsfromdir($updater);18811882# we'll need a temporary checkout dir1883 setupWorkTree();18841885$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");18861887# foreach file specified on the command line ...1888foreachmy$filename( @{$state->{args}} )1889{1890$filename= filecleanup($filename);18911892my$meta=$updater->getmeta($filename);18931894next unless($meta->{revision} );18951896# get all the commits that this file was in1897# in dense format -- aka skip dead revisions1898my$revisions=$updater->gethistorydense($filename);1899my$lastseenin=$revisions->[0][2];19001901# populate the temporary index based on the latest commit were we saw1902# the file -- but do it cheaply without checking out any files1903# TODO: if we got a revision from the client, use that instead1904# to look up the commithash in sqlite (still good to default to1905# the current head as we do now)1906system("git","read-tree",$lastseenin);1907unless($?==0)1908{1909print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";1910return;1911}1912$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");19131914# do a checkout of the file1915system('git','checkout-index','-f','-u',$filename);1916unless($?==0) {1917print"E error running git-checkout-index -f -u$filename:$!\n";1918return;1919}19201921$log->info("Annotate$filename");19221923# Prepare a file with the commits from the linearized1924# history that annotate should know about. This prevents1925# git-jsannotate telling us about commits we are hiding1926# from the client.19271928my$a_hints="$work->{workDir}/.annotate_hints";1929if(!open(ANNOTATEHINTS,'>',$a_hints)) {1930print"E failed to open '$a_hints' for writing:$!\n";1931return;1932}1933for(my$i=0;$i<@$revisions;$i++)1934{1935print ANNOTATEHINTS $revisions->[$i][2];1936if($i+1<@$revisions) {# have we got a parent?1937print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1938}1939print ANNOTATEHINTS "\n";1940}19411942print ANNOTATEHINTS "\n";1943close ANNOTATEHINTS1944or(print"E failed to write$a_hints:$!\n"),return;19451946my@cmd= (qw(git annotate -l -S),$a_hints,$filename);1947if(!open(ANNOTATE,"-|",@cmd)) {1948print"E error invoking ".join(' ',@cmd) .":$!\n";1949return;1950}1951my$metadata= {};1952print"E Annotations for$filename\n";1953print"E ***************\n";1954while( <ANNOTATE> )1955{1956if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1957{1958my$commithash=$1;1959my$data=$2;1960unless(defined($metadata->{$commithash} ) )1961{1962$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1963$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});1964$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1965}1966printf("M 1.%-5d (%-8s%10s):%s\n",1967$metadata->{$commithash}{revision},1968$metadata->{$commithash}{author},1969$metadata->{$commithash}{modified},1970$data1971);1972}else{1973$log->warn("Error in annotate output! LINE:$_");1974print"E Annotate error\n";1975next;1976}1977}1978close ANNOTATE;1979}19801981# done; get out of the tempdir1982 cleanupWorkTree();19831984print"ok\n";19851986}19871988# This method takes the state->{arguments} array and produces two new arrays.1989# The first is $state->{args} which is everything before the '--' argument, and1990# the second is $state->{files} which is everything after it.1991sub argsplit1992{1993$state->{args} = [];1994$state->{files} = [];1995$state->{opt} = {};19961997return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");19981999my$type=shift;20002001if(defined($type) )2002{2003my$opt= {};2004$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");2005$opt= { v =>0, l =>0, R =>0}if($typeeq"status");2006$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");2007$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");2008$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");2009$opt= { k =>1, m =>1}if($typeeq"add");2010$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");2011$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");201220132014while(scalar( @{$state->{arguments}} ) >0)2015{2016my$arg=shift@{$state->{arguments}};20172018next if($argeq"--");2019next unless($arg=~/\S/);20202021# if the argument looks like a switch2022if($arg=~/^-(\w)(.*)/)2023{2024# if it's a switch that takes an argument2025if($opt->{$1} )2026{2027# If this switch has already been provided2028if($opt->{$1} >1and exists($state->{opt}{$1} ) )2029{2030$state->{opt}{$1} = [$state->{opt}{$1} ];2031if(length($2) >0)2032{2033push@{$state->{opt}{$1}},$2;2034}else{2035push@{$state->{opt}{$1}},shift@{$state->{arguments}};2036}2037}else{2038# if there's extra data in the arg, use that as the argument for the switch2039if(length($2) >0)2040{2041$state->{opt}{$1} =$2;2042}else{2043$state->{opt}{$1} =shift@{$state->{arguments}};2044}2045}2046}else{2047$state->{opt}{$1} =undef;2048}2049}2050else2051{2052push@{$state->{args}},$arg;2053}2054}2055}2056else2057{2058my$mode=0;20592060foreachmy$value( @{$state->{arguments}} )2061{2062if($valueeq"--")2063{2064$mode++;2065next;2066}2067push@{$state->{args}},$valueif($mode==0);2068push@{$state->{files}},$valueif($mode==1);2069}2070}2071}20722073# This method uses $state->{directory} to populate $state->{args} with a list of filenames2074sub argsfromdir2075{2076my$updater=shift;20772078$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");20792080return if(scalar( @{$state->{args}} ) >1);20812082my@gethead= @{$updater->gethead};20832084# push added files2085foreachmy$file(keys%{$state->{entries}}) {2086if(exists$state->{entries}{$file}{revision} &&2087$state->{entries}{$file}{revision} ==0)2088{2089push@gethead, { name =>$file, filehash =>'added'};2090}2091}20922093if(scalar(@{$state->{args}}) ==1)2094{2095my$arg=$state->{args}[0];2096$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );20972098$log->info("Only one arg specified, checking for directory expansion on '$arg'");20992100foreachmy$file(@gethead)2101{2102next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2103next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);2104push@{$state->{args}},$file->{name};2105}21062107shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);2108}else{2109$log->info("Only one arg specified, populating file list automatically");21102111$state->{args} = [];21122113foreachmy$file(@gethead)2114{2115next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2116next unless($file->{name} =~s/^$state->{prependdir}//);2117push@{$state->{args}},$file->{name};2118}2119}2120}21212122# This method cleans up the $state variable after a command that uses arguments has run2123sub statecleanup2124{2125$state->{files} = [];2126$state->{args} = [];2127$state->{arguments} = [];2128$state->{entries} = {};2129}21302131sub revparse2132{2133my$filename=shift;21342135returnundefunless(defined($state->{entries}{$filename}{revision} ) );21362137return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);2138return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);21392140returnundef;2141}21422143# This method takes a file hash and does a CVS "file transfer". Its2144# exact behaviour depends on a second, optional hash table argument:2145# - If $options->{targetfile}, dump the contents to that file;2146# - If $options->{print}, use M/MT to transmit the contents one line2147# at a time;2148# - Otherwise, transmit the size of the file, followed by the file2149# contents.2150sub transmitfile2151{2152my$filehash=shift;2153my$options=shift;21542155if(defined($filehash)and$filehasheq"deleted")2156{2157$log->warn("filehash is 'deleted'");2158return;2159}21602161die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);21622163my$type=`git cat-file -t$filehash`;2164 chomp$type;21652166 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );21672168 my$size= `git cat-file -s $filehash`;2169chomp$size;21702171$log->debug("transmitfile($filehash) size=$size, type=$type");21722173if(open my$fh,'-|',"git","cat-file","blob",$filehash)2174{2175if(defined($options->{targetfile} ) )2176{2177my$targetfile=$options->{targetfile};2178open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2179print NEWFILE $_while( <$fh> );2180close NEWFILE or die("Failed to write '$targetfile':$!");2181}elsif(defined($options->{print} ) &&$options->{print} ) {2182while( <$fh> ) {2183if(/\n\z/) {2184print'M ',$_;2185}else{2186print'MT text ',$_,"\n";2187}2188}2189}else{2190print"$size\n";2191printwhile( <$fh> );2192}2193close$fhor die("Couldn't close filehandle for transmitfile():$!");2194}else{2195die("Couldn't execute git-cat-file");2196}2197}21982199# This method takes a file name, and returns ( $dirpart, $filepart ) which2200# refers to the directory portion and the file portion of the filename2201# respectively2202sub filenamesplit2203{2204my$filename=shift;2205my$fixforlocaldir=shift;22062207my($filepart,$dirpart) = ($filename,".");2208($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2209$dirpart.="/";22102211if($fixforlocaldir)2212{2213$dirpart=~s/^$state->{prependdir}//;2214}22152216return($filepart,$dirpart);2217}22182219sub filecleanup2220{2221my$filename=shift;22222223returnundefunless(defined($filename));2224if($filename=~/^\// )2225{2226print"E absolute filenames '$filename' not supported by server\n";2227returnundef;2228}22292230$filename=~s/^\.\///g;2231$filename=$state->{prependdir} .$filename;2232return$filename;2233}22342235sub validateGitDir2236{2237if( !defined($state->{CVSROOT}) )2238{2239print"error 1 CVSROOT not specified\n";2240 cleanupWorkTree();2241exit;2242}2243if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2244{2245print"error 1 Internally inconsistent CVSROOT\n";2246 cleanupWorkTree();2247exit;2248}2249}22502251# Setup working directory in a work tree with the requested version2252# loaded in the index.2253sub setupWorkTree2254{2255my($ver) =@_;22562257 validateGitDir();22582259if( (defined($work->{state}) &&$work->{state} !=1) ||2260defined($work->{tmpDir}) )2261{2262$log->warn("Bad work tree state management");2263print"error 1 Internal setup multiple work trees without cleanup\n";2264 cleanupWorkTree();2265exit;2266}22672268$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);22692270if( !defined($work->{index}) )2271{2272(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2273}22742275chdir$work->{workDir}or2276die"Unable to chdir to$work->{workDir}\n";22772278$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");22792280$ENV{GIT_WORK_TREE} =".";2281$ENV{GIT_INDEX_FILE} =$work->{index};2282$work->{state} =2;22832284if($ver)2285{2286system("git","read-tree",$ver);2287unless($?==0)2288{2289$log->warn("Error running git-read-tree");2290die"Error running git-read-tree$verin$work->{workDir}$!\n";2291}2292}2293# else # req_annotate reads tree for each file2294}22952296# Ensure current directory is in some kind of working directory,2297# with a recent version loaded in the index.2298sub ensureWorkTree2299{2300if(defined($work->{tmpDir}) )2301{2302$log->warn("Bad work tree state management [ensureWorkTree()]");2303print"error 1 Internal setup multiple dirs without cleanup\n";2304 cleanupWorkTree();2305exit;2306}2307if($work->{state} )2308{2309return;2310}23112312 validateGitDir();23132314if( !defined($work->{emptyDir}) )2315{2316$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);2317}2318chdir$work->{emptyDir}or2319die"Unable to chdir to$work->{emptyDir}\n";23202321my$ver=`git show-ref -s refs/heads/$state->{module}`;2322chomp$ver;2323if($ver!~/^[0-9a-f]{40}$/)2324{2325$log->warn("Error from git show-ref -s refs/head$state->{module}");2326print"error 1 cannot find the current HEAD of module";2327 cleanupWorkTree();2328exit;2329}23302331if( !defined($work->{index}) )2332{2333(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2334}23352336$ENV{GIT_WORK_TREE} =".";2337$ENV{GIT_INDEX_FILE} =$work->{index};2338$work->{state} =1;23392340system("git","read-tree",$ver);2341unless($?==0)2342{2343die"Error running git-read-tree$ver$!\n";2344}2345}23462347# Cleanup working directory that is not needed any longer.2348sub cleanupWorkTree2349{2350if( !$work->{state} )2351{2352return;2353}23542355chdir"/"or die"Unable to chdir '/'\n";23562357if(defined($work->{workDir}) )2358{2359 rmtree($work->{workDir} );2360undef$work->{workDir};2361}2362undef$work->{state};2363}23642365# Setup a temporary directory (not a working tree), typically for2366# merging dirty state as in req_update.2367sub setupTmpDir2368{2369$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);2370chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";23712372return$work->{tmpDir};2373}23742375# Clean up a previously setupTmpDir. Restore previous work tree if2376# appropriate.2377sub cleanupTmpDir2378{2379if( !defined($work->{tmpDir}) )2380{2381$log->warn("cleanup tmpdir that has not been setup");2382die"Cleanup tmpDir that has not been setup\n";2383}2384if(defined($work->{state}) )2385{2386if($work->{state} ==1)2387{2388chdir$work->{emptyDir}or2389die"Unable to chdir to$work->{emptyDir}\n";2390}2391elsif($work->{state} ==2)2392{2393chdir$work->{workDir}or2394die"Unable to chdir to$work->{emptyDir}\n";2395}2396else2397{2398$log->warn("Inconsistent work dir state");2399die"Inconsistent work dir state\n";2400}2401}2402else2403{2404chdir"/"or die"Unable to chdir '/'\n";2405}2406}24072408# Given a path, this function returns a string containing the kopts2409# that should go into that path's Entries line. For example, a binary2410# file should get -kb.2411sub kopts_from_path2412{2413my($path,$srcType,$name) =@_;24142415if(defined($cfg->{gitcvs}{usecrlfattr} )and2416$cfg->{gitcvs}{usecrlfattr} =~/\s*(1|true|yes)\s*$/i)2417{2418my($val) = check_attr("crlf",$path);2419if($valeq"set")2420{2421return"";2422}2423elsif($valeq"unset")2424{2425return"-kb"2426}2427else2428{2429$log->info("Unrecognized check_attr crlf$path:$val");2430}2431}24322433if(defined($cfg->{gitcvs}{allbinary} ) )2434{2435if( ($cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i) )2436{2437return"-kb";2438}2439elsif( ($cfg->{gitcvs}{allbinary} =~/^\s*guess\s*$/i) )2440{2441if($srcTypeeq"sha1Or-k"&&2442!defined($name) )2443{2444my($ret)=$state->{entries}{$path}{options};2445if( !defined($ret) )2446{2447$ret=$state->{opt}{k};2448if(defined($ret))2449{2450$ret="-k$ret";2451}2452else2453{2454$ret="";2455}2456}2457if( ! ($ret=~/^(|-kb|-kkv|-kkvl|-kk|-ko|-kv)$/) )2458{2459print"E Bad -k option\n";2460$log->warn("Bad -k option:$ret");2461die"Error: Bad -k option:$ret\n";2462}24632464return$ret;2465}2466else2467{2468if( is_binary($srcType,$name) )2469{2470$log->debug("... as binary");2471return"-kb";2472}2473else2474{2475$log->debug("... as text");2476}2477}2478}2479}2480# Return "" to give no special treatment to any path2481return"";2482}24832484sub check_attr2485{2486my($attr,$path) =@_;2487 ensureWorkTree();2488if(open my$fh,'-|',"git","check-attr",$attr,"--",$path)2489{2490my$val= <$fh>;2491close$fh;2492$val=~s/.*: ([^:\r\n]*)\s*$/$1/;2493return$val;2494}2495else2496{2497returnundef;2498}2499}25002501# This should have the same heuristics as convert.c:is_binary() and related.2502# Note that the bare CR test is done by callers in convert.c.2503sub is_binary2504{2505my($srcType,$name) =@_;2506$log->debug("is_binary($srcType,$name)");25072508# Minimize amount of interpreted code run in the inner per-character2509# loop for large files, by totalling each character value and2510# then analyzing the totals.2511my@counts;2512my$i;2513for($i=0;$i<256;$i++)2514{2515$counts[$i]=0;2516}25172518my$fh= open_blob_or_die($srcType,$name);2519my$line;2520while(defined($line=<$fh>) )2521{2522# Any '\0' and bare CR are considered binary.2523if($line=~/\0|(\r[^\n])/)2524{2525close($fh);2526return1;2527}25282529# Count up each character in the line:2530my$len=length($line);2531for($i=0;$i<$len;$i++)2532{2533$counts[ord(substr($line,$i,1))]++;2534}2535}2536close$fh;25372538# Don't count CR and LF as either printable/nonprintable2539$counts[ord("\n")]=0;2540$counts[ord("\r")]=0;25412542# Categorize individual character count into printable and nonprintable:2543my$printable=0;2544my$nonprintable=0;2545for($i=0;$i<256;$i++)2546{2547if($i<32&&2548$i!=ord("\b") &&2549$i!=ord("\t") &&2550$i!=033&&# ESC2551$i!=014)# FF2552{2553$nonprintable+=$counts[$i];2554}2555elsif($i==127)# DEL2556{2557$nonprintable+=$counts[$i];2558}2559else2560{2561$printable+=$counts[$i];2562}2563}25642565return($printable>>7) <$nonprintable;2566}25672568# Returns open file handle. Possible invocations:2569# - open_blob_or_die("file",$filename);2570# - open_blob_or_die("sha1",$filehash);2571sub open_blob_or_die2572{2573my($srcType,$name) =@_;2574my($fh);2575if($srcTypeeq"file")2576{2577if( !open$fh,"<",$name)2578{2579$log->warn("Unable to open file$name:$!");2580die"Unable to open file$name:$!\n";2581}2582}2583elsif($srcTypeeq"sha1"||$srcTypeeq"sha1Or-k")2584{2585unless(defined($name)and$name=~/^[a-zA-Z0-9]{40}$/)2586{2587$log->warn("Need filehash");2588die"Need filehash\n";2589}25902591my$type=`git cat-file -t$name`;2592 chomp$type;25932594 unless ( defined ($type) and$typeeq "blob" )2595 {2596$log->warn("Invalid type '$type' for '$name'");2597 die ( "Invalid type '$type' (expected 'blob')" )2598 }25992600 my$size= `git cat-file -s $name`;2601chomp$size;26022603$log->debug("open_blob_or_die($name) size=$size, type=$type");26042605unless(open$fh,'-|',"git","cat-file","blob",$name)2606{2607$log->warn("Unable to open sha1$name");2608die"Unable to open sha1$name\n";2609}2610}2611else2612{2613$log->warn("Unknown type of blob source:$srcType");2614die"Unknown type of blob source:$srcType\n";2615}2616return$fh;2617}26182619# Generate a CVS author name from Git author information, by taking the local2620# part of the email address and replacing characters not in the Portable2621# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS2622# Login names are Unix login names, which should be restricted to this2623# character set.2624sub cvs_author2625{2626my$author_line=shift;2627(my$author) =$author_line=~/<([^@>]*)/;26282629$author=~s/[^-a-zA-Z0-9_.]/_/g;2630$author=~s/^-/_/;26312632$author;2633}263426352636sub descramble2637{2638# This table is from src/scramble.c in the CVS source2639my@SHIFTS= (26400,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,264116,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,2642114,120,53,79,96,109,72,108,70,64,76,67,116,74,68,87,2643111,52,75,119,49,34,82,81,95,65,112,86,118,110,122,105,264441,57,83,43,46,102,40,89,38,103,45,50,42,123,91,35,2645125,55,54,66,124,126,59,47,92,71,115,78,88,107,106,56,264636,121,117,104,101,100,69,73,99,63,94,93,39,37,61,48,264758,113,32,90,44,98,60,51,33,97,62,77,84,80,85,223,2648225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,2649199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,2650174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,2651207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,2652192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,2653227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,2654182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,2655243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,1522656);2657my($str) =@_;26582659# This should never happen, the same password format (A) has been2660# used by CVS since the beginning of time2661die"invalid password format$1"unlesssubstr($str,0,1)eq'A';26622663my@str=unpack"C*",substr($str,1);2664my$ret=join'',map{chr$SHIFTS[$_] }@str;2665return$ret;2666}266726682669package GITCVS::log;26702671####2672#### Copyright The Open University UK - 2006.2673####2674#### Authors: Martyn Smith <martyn@catalyst.net.nz>2675#### Martin Langhoff <martin@catalyst.net.nz>2676####2677####26782679use strict;2680use warnings;26812682=head1 NAME26832684GITCVS::log26852686=head1 DESCRIPTION26872688This module provides very crude logging with a similar interface to2689Log::Log4perl26902691=head1 METHODS26922693=cut26942695=head2 new26962697Creates a new log object, optionally you can specify a filename here to2698indicate the file to log to. If no log file is specified, you can specify one2699later with method setfile, or indicate you no longer want logging with method2700nofile.27012702Until one of these methods is called, all log calls will buffer messages ready2703to write out.27042705=cut2706sub new2707{2708my$class=shift;2709my$filename=shift;27102711my$self= {};27122713bless$self,$class;27142715if(defined($filename) )2716{2717open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2718}27192720return$self;2721}27222723=head2 setfile27242725This methods takes a filename, and attempts to open that file as the log file.2726If successful, all buffered data is written out to the file, and any further2727logging is written directly to the file.27282729=cut2730sub setfile2731{2732my$self=shift;2733my$filename=shift;27342735if(defined($filename) )2736{2737open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2738}27392740return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");27412742while(my$line=shift@{$self->{buffer}} )2743{2744print{$self->{fh}}$line;2745}2746}27472748=head2 nofile27492750This method indicates no logging is going to be used. It flushes any entries in2751the internal buffer, and sets a flag to ensure no further data is put there.27522753=cut2754sub nofile2755{2756my$self=shift;27572758$self->{nolog} =1;27592760return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");27612762$self->{buffer} = [];2763}27642765=head2 _logopen27662767Internal method. Returns true if the log file is open, false otherwise.27682769=cut2770sub _logopen2771{2772my$self=shift;27732774return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2775return0;2776}27772778=head2 debug info warn fatal27792780These four methods are wrappers to _log. They provide the actual interface for2781logging data.27822783=cut2784sub debug {my$self=shift;$self->_log("debug",@_); }2785sub info {my$self=shift;$self->_log("info",@_); }2786subwarn{my$self=shift;$self->_log("warn",@_); }2787sub fatal {my$self=shift;$self->_log("fatal",@_); }27882789=head2 _log27902791This is an internal method called by the logging functions. It generates a2792timestamp and pushes the logged line either to file, or internal buffer.27932794=cut2795sub _log2796{2797my$self=shift;2798my$level=shift;27992800return if($self->{nolog} );28012802my@time=localtime;2803my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2804$time[5] +1900,2805$time[4] +1,2806$time[3],2807$time[2],2808$time[1],2809$time[0],2810uc$level,2811);28122813if($self->_logopen)2814{2815print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2816}else{2817push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2818}2819}28202821=head2 DESTROY28222823This method simply closes the file handle if one is open28242825=cut2826sub DESTROY2827{2828my$self=shift;28292830if($self->_logopen)2831{2832close$self->{fh};2833}2834}28352836package GITCVS::updater;28372838####2839#### Copyright The Open University UK - 2006.2840####2841#### Authors: Martyn Smith <martyn@catalyst.net.nz>2842#### Martin Langhoff <martin@catalyst.net.nz>2843####2844####28452846use strict;2847use warnings;2848use DBI;28492850=head1 METHODS28512852=cut28532854=head2 new28552856=cut2857sub new2858{2859my$class=shift;2860my$config=shift;2861my$module=shift;2862my$log=shift;28632864die"Need to specify a git repository"unless(defined($config)and-d $config);2865die"Need to specify a module"unless(defined($module) );28662867$class=ref($class) ||$class;28682869my$self= {};28702871bless$self,$class;28722873$self->{valid_tables} = {'revision'=>1,2874'revision_ix1'=>1,2875'revision_ix2'=>1,2876'head'=>1,2877'head_ix1'=>1,2878'properties'=>1,2879'commitmsgs'=>1};28802881$self->{module} =$module;2882$self->{git_path} =$config."/";28832884$self->{log} =$log;28852886die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );28872888$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2889$cfg->{gitcvs}{dbdriver} ||"SQLite";2890$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2891$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2892$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2893$cfg->{gitcvs}{dbuser} ||"";2894$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2895$cfg->{gitcvs}{dbpass} ||"";2896$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||2897$cfg->{gitcvs}{dbtablenameprefix} ||"";2898my%mapping= ( m =>$module,2899 a =>$state->{method},2900 u =>getlogin||getpwuid($<) || $<,2901 G =>$self->{git_path},2902 g => mangle_dirname($self->{git_path}),2903);2904$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2905$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;2906$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;2907$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});29082909die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2910die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2911$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2912$self->{dbuser},2913$self->{dbpass});2914die"Error connecting to database\n"unlessdefined$self->{dbh};29152916$self->{tables} = {};2917foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2918{2919$self->{tables}{$table} =1;2920}29212922# Construct the revision table if required2923unless($self->{tables}{$self->tablename("revision")} )2924{2925my$tablename=$self->tablename("revision");2926my$ix1name=$self->tablename("revision_ix1");2927my$ix2name=$self->tablename("revision_ix2");2928$self->{dbh}->do("2929 CREATE TABLE$tablename(2930 name TEXT NOT NULL,2931 revision INTEGER NOT NULL,2932 filehash TEXT NOT NULL,2933 commithash TEXT NOT NULL,2934 author TEXT NOT NULL,2935 modified TEXT NOT NULL,2936 mode TEXT NOT NULL2937 )2938 ");2939$self->{dbh}->do("2940 CREATE INDEX$ix1name2941 ON$tablename(name,revision)2942 ");2943$self->{dbh}->do("2944 CREATE INDEX$ix2name2945 ON$tablename(name,commithash)2946 ");2947}29482949# Construct the head table if required2950unless($self->{tables}{$self->tablename("head")} )2951{2952my$tablename=$self->tablename("head");2953my$ix1name=$self->tablename("head_ix1");2954$self->{dbh}->do("2955 CREATE TABLE$tablename(2956 name TEXT NOT NULL,2957 revision INTEGER NOT NULL,2958 filehash TEXT NOT NULL,2959 commithash TEXT NOT NULL,2960 author TEXT NOT NULL,2961 modified TEXT NOT NULL,2962 mode TEXT NOT NULL2963 )2964 ");2965$self->{dbh}->do("2966 CREATE INDEX$ix1name2967 ON$tablename(name)2968 ");2969}29702971# Construct the properties table if required2972unless($self->{tables}{$self->tablename("properties")} )2973{2974my$tablename=$self->tablename("properties");2975$self->{dbh}->do("2976 CREATE TABLE$tablename(2977 key TEXT NOT NULL PRIMARY KEY,2978 value TEXT2979 )2980 ");2981}29822983# Construct the commitmsgs table if required2984unless($self->{tables}{$self->tablename("commitmsgs")} )2985{2986my$tablename=$self->tablename("commitmsgs");2987$self->{dbh}->do("2988 CREATE TABLE$tablename(2989 key TEXT NOT NULL PRIMARY KEY,2990 value TEXT2991 )2992 ");2993}29942995return$self;2996}29972998=head2 tablename29993000=cut3001sub tablename3002{3003my$self=shift;3004my$name=shift;30053006if(exists$self->{valid_tables}{$name}) {3007return$self->{dbtablenameprefix} .$name;3008}else{3009returnundef;3010}3011}30123013=head2 update30143015=cut3016sub update3017{3018my$self=shift;30193020# first lets get the commit list3021$ENV{GIT_DIR} =$self->{git_path};30223023my$commitsha1=`git rev-parse$self->{module}`;3024chomp$commitsha1;30253026my$commitinfo=`git cat-file commit$self->{module} 2>&1`;3027unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)3028{3029die("Invalid module '$self->{module}'");3030}303130323033my$git_log;3034my$lastcommit=$self->_get_prop("last_commit");30353036if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date3037return1;3038}30393040# Start exclusive lock here...3041$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";30423043# TODO: log processing is memory bound3044# if we can parse into a 2nd file that is in reverse order3045# we can probably do something really efficient3046my@git_log_params= ('--pretty','--parents','--topo-order');30473048if(defined$lastcommit) {3049push@git_log_params,"$lastcommit..$self->{module}";3050}else{3051push@git_log_params,$self->{module};3052}3053# git-rev-list is the backend / plumbing version of git-log3054open(GITLOG,'-|','git','rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";30553056my@commits;30573058my%commit= ();30593060while( <GITLOG> )3061{3062chomp;3063if(m/^commit\s+(.*)$/) {3064# on ^commit lines put the just seen commit in the stack3065# and prime things for the next one3066if(keys%commit) {3067my%copy=%commit;3068unshift@commits, \%copy;3069%commit= ();3070}3071my@parents=split(m/\s+/,$1);3072$commit{hash} =shift@parents;3073$commit{parents} = \@parents;3074}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {3075# on rfc822-like lines seen before we see any message,3076# lowercase the entry and put it in the hash as key-value3077$commit{lc($1)} =$2;3078}else{3079# message lines - skip initial empty line3080# and trim whitespace3081if(!exists($commit{message}) &&m/^\s*$/) {3082# define it to mark the end of headers3083$commit{message} ='';3084next;3085}3086s/^\s+//;s/\s+$//;# trim ws3087$commit{message} .=$_."\n";3088}3089}3090close GITLOG;30913092unshift@commits, \%commitif(keys%commit);30933094# Now all the commits are in the @commits bucket3095# ordered by time DESC. for each commit that needs processing,3096# determine whether it's following the last head we've seen or if3097# it's on its own branch, grab a file list, and add whatever's changed3098# NOTE: $lastcommit refers to the last commit from previous run3099# $lastpicked is the last commit we picked in this run3100my$lastpicked;3101my$head= {};3102if(defined$lastcommit) {3103$lastpicked=$lastcommit;3104}31053106my$committotal=scalar(@commits);3107my$commitcount=0;31083109# Load the head table into $head (for cached lookups during the update process)3110foreachmy$file( @{$self->gethead()} )3111{3112$head->{$file->{name}} =$file;3113}31143115foreachmy$commit(@commits)3116{3117$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3118if(defined$lastpicked)3119{3120if(!in_array($lastpicked, @{$commit->{parents}}))3121{3122# skip, we'll see this delta3123# as part of a merge later3124# warn "skipping off-track $commit->{hash}\n";3125next;3126}elsif(@{$commit->{parents}} >1) {3127# it is a merge commit, for each parent that is3128# not $lastpicked, see if we can get a log3129# from the merge-base to that parent to put it3130# in the message as a merge summary.3131my@parents= @{$commit->{parents}};3132foreachmy$parent(@parents) {3133# git-merge-base can potentially (but rarely) throw3134# several candidate merge bases. let's assume3135# that the first one is the best one.3136if($parenteq$lastpicked) {3137next;3138}3139my$base=eval{3140 safe_pipe_capture('git','merge-base',3141$lastpicked,$parent);3142};3143# The two branches may not be related at all,3144# in which case merge base simply fails to find3145# any, but that's Ok.3146next if($@);31473148chomp$base;3149if($base) {3150my@merged;3151# print "want to log between $base $parent \n";3152open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3153or die"Cannot call git-log:$!";3154my$mergedhash;3155while(<GITLOG>) {3156chomp;3157if(!defined$mergedhash) {3158if(m/^commit\s+(.+)$/) {3159$mergedhash=$1;3160}else{3161next;3162}3163}else{3164# grab the first line that looks non-rfc8223165# aka has content after leading space3166if(m/^\s+(\S.*)$/) {3167my$title=$1;3168$title=substr($title,0,100);# truncate3169unshift@merged,"$mergedhash$title";3170undef$mergedhash;3171}3172}3173}3174close GITLOG;3175if(@merged) {3176$commit->{mergemsg} =$commit->{message};3177$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3178foreachmy$summary(@merged) {3179$commit->{mergemsg} .="\t$summary\n";3180}3181$commit->{mergemsg} .="\n\n";3182# print "Message for $commit->{hash} \n$commit->{mergemsg}";3183}3184}3185}3186}3187}31883189# convert the date to CVS-happy format3190$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);31913192if(defined($lastpicked) )3193{3194my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3195local($/) ="\0";3196while( <FILELIST> )3197{3198chomp;3199unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)3200{3201die("Couldn't process git-diff-tree line :$_");3202}3203my($mode,$hash,$change) = ($1,$2,$3);3204my$name= <FILELIST>;3205chomp($name);32063207# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");32083209my$git_perms="";3210$git_perms.="r"if($mode&4);3211$git_perms.="w"if($mode&2);3212$git_perms.="x"if($mode&1);3213$git_perms="rw"if($git_permseq"");32143215if($changeeq"D")3216{3217#$log->debug("DELETE $name");3218$head->{$name} = {3219 name =>$name,3220 revision =>$head->{$name}{revision} +1,3221 filehash =>"deleted",3222 commithash =>$commit->{hash},3223 modified =>$commit->{date},3224 author =>$commit->{author},3225 mode =>$git_perms,3226};3227$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3228}3229elsif($changeeq"M"||$changeeq"T")3230{3231#$log->debug("MODIFIED $name");3232$head->{$name} = {3233 name =>$name,3234 revision =>$head->{$name}{revision} +1,3235 filehash =>$hash,3236 commithash =>$commit->{hash},3237 modified =>$commit->{date},3238 author =>$commit->{author},3239 mode =>$git_perms,3240};3241$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3242}3243elsif($changeeq"A")3244{3245#$log->debug("ADDED $name");3246$head->{$name} = {3247 name =>$name,3248 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3249 filehash =>$hash,3250 commithash =>$commit->{hash},3251 modified =>$commit->{date},3252 author =>$commit->{author},3253 mode =>$git_perms,3254};3255$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3256}3257else3258{3259$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");3260die;3261}3262}3263close FILELIST;3264}else{3265# this is used to detect files removed from the repo3266my$seen_files= {};32673268my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");3269local$/="\0";3270while( <FILELIST> )3271{3272chomp;3273unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)3274{3275die("Couldn't process git-ls-tree line :$_");3276}32773278my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);32793280$seen_files->{$git_filename} =1;32813282my($oldhash,$oldrevision,$oldmode) = (3283$head->{$git_filename}{filehash},3284$head->{$git_filename}{revision},3285$head->{$git_filename}{mode}3286);32873288if($git_perms=~/^\d\d\d(\d)\d\d/o)3289{3290$git_perms="";3291$git_perms.="r"if($1&4);3292$git_perms.="w"if($1&2);3293$git_perms.="x"if($1&1);3294}else{3295$git_perms="rw";3296}32973298# unless the file exists with the same hash, we need to update it ...3299unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)3300{3301my$newrevision= ($oldrevisionor0) +1;33023303$head->{$git_filename} = {3304 name =>$git_filename,3305 revision =>$newrevision,3306 filehash =>$git_hash,3307 commithash =>$commit->{hash},3308 modified =>$commit->{date},3309 author =>$commit->{author},3310 mode =>$git_perms,3311};331233133314$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3315}3316}3317close FILELIST;33183319# Detect deleted files3320foreachmy$file(keys%$head)3321{3322unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")3323{3324$head->{$file}{revision}++;3325$head->{$file}{filehash} ="deleted";3326$head->{$file}{commithash} =$commit->{hash};3327$head->{$file}{modified} =$commit->{date};3328$head->{$file}{author} =$commit->{author};33293330$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});3331}3332}3333# END : "Detect deleted files"3334}333533363337if(exists$commit->{mergemsg})3338{3339$self->insert_mergelog($commit->{hash},$commit->{mergemsg});3340}33413342$lastpicked=$commit->{hash};33433344$self->_set_prop("last_commit",$commit->{hash});3345}33463347$self->delete_head();3348foreachmy$file(keys%$head)3349{3350$self->insert_head(3351$file,3352$head->{$file}{revision},3353$head->{$file}{filehash},3354$head->{$file}{commithash},3355$head->{$file}{modified},3356$head->{$file}{author},3357$head->{$file}{mode},3358);3359}3360# invalidate the gethead cache3361$self->{gethead_cache} =undef;336233633364# Ending exclusive lock here3365$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3366}33673368sub insert_rev3369{3370my$self=shift;3371my$name=shift;3372my$revision=shift;3373my$filehash=shift;3374my$commithash=shift;3375my$modified=shift;3376my$author=shift;3377my$mode=shift;3378my$tablename=$self->tablename("revision");33793380my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3381$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3382}33833384sub insert_mergelog3385{3386my$self=shift;3387my$key=shift;3388my$value=shift;3389my$tablename=$self->tablename("commitmsgs");33903391my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3392$insert_mergelog->execute($key,$value);3393}33943395sub delete_head3396{3397my$self=shift;3398my$tablename=$self->tablename("head");33993400my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3401$delete_head->execute();3402}34033404sub insert_head3405{3406my$self=shift;3407my$name=shift;3408my$revision=shift;3409my$filehash=shift;3410my$commithash=shift;3411my$modified=shift;3412my$author=shift;3413my$mode=shift;3414my$tablename=$self->tablename("head");34153416my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3417$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3418}34193420sub _headrev3421{3422my$self=shift;3423my$filename=shift;3424my$tablename=$self->tablename("head");34253426my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM$tablenameWHERE name=?",{},1);3427$db_query->execute($filename);3428my($hash,$revision,$mode) =$db_query->fetchrow_array;34293430return($hash,$revision,$mode);3431}34323433sub _get_prop3434{3435my$self=shift;3436my$key=shift;3437my$tablename=$self->tablename("properties");34383439my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3440$db_query->execute($key);3441my($value) =$db_query->fetchrow_array;34423443return$value;3444}34453446sub _set_prop3447{3448my$self=shift;3449my$key=shift;3450my$value=shift;3451my$tablename=$self->tablename("properties");34523453my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3454$db_query->execute($value,$key);34553456unless($db_query->rows)3457{3458$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3459$db_query->execute($key,$value);3460}34613462return$value;3463}34643465=head2 gethead34663467=cut34683469sub gethead3470{3471my$self=shift;3472my$tablename=$self->tablename("head");34733474return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );34753476my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3477$db_query->execute();34783479my$tree= [];3480while(my$file=$db_query->fetchrow_hashref)3481{3482push@$tree,$file;3483}34843485$self->{gethead_cache} =$tree;34863487return$tree;3488}34893490=head2 getlog34913492=cut34933494sub getlog3495{3496my$self=shift;3497my$filename=shift;3498my$tablename=$self->tablename("revision");34993500my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3501$db_query->execute($filename);35023503my$tree= [];3504while(my$file=$db_query->fetchrow_hashref)3505{3506push@$tree,$file;3507}35083509return$tree;3510}35113512=head2 getmeta35133514This function takes a filename (with path) argument and returns a hashref of3515metadata for that file.35163517=cut35183519sub getmeta3520{3521my$self=shift;3522my$filename=shift;3523my$revision=shift;3524my$tablename_rev=$self->tablename("revision");3525my$tablename_head=$self->tablename("head");35263527my$db_query;3528if(defined($revision)and$revision=~/^\d+$/)3529{3530$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND revision=?",{},1);3531$db_query->execute($filename,$revision);3532}3533elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)3534{3535$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND commithash=?",{},1);3536$db_query->execute($filename,$revision);3537}else{3538$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_headWHERE name=?",{},1);3539$db_query->execute($filename);3540}35413542return$db_query->fetchrow_hashref;3543}35443545=head2 commitmessage35463547this function takes a commithash and returns the commit message for that commit35483549=cut3550sub commitmessage3551{3552my$self=shift;3553my$commithash=shift;3554my$tablename=$self->tablename("commitmsgs");35553556die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);35573558my$db_query;3559$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3560$db_query->execute($commithash);35613562my($message) =$db_query->fetchrow_array;35633564if(defined($message) )3565{3566$message.=" "if($message=~/\n$/);3567return$message;3568}35693570my@lines= safe_pipe_capture("git","cat-file","commit",$commithash);3571shift@lineswhile($lines[0] =~/\S/);3572$message=join("",@lines);3573$message.=" "if($message=~/\n$/);3574return$message;3575}35763577=head2 gethistory35783579This function takes a filename (with path) argument and returns an arrayofarrays3580containing revision,filehash,commithash ordered by revision descending35813582=cut3583sub gethistory3584{3585my$self=shift;3586my$filename=shift;3587my$tablename=$self->tablename("revision");35883589my$db_query;3590$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3591$db_query->execute($filename);35923593return$db_query->fetchall_arrayref;3594}35953596=head2 gethistorydense35973598This function takes a filename (with path) argument and returns an arrayofarrays3599containing revision,filehash,commithash ordered by revision descending.36003601This version of gethistory skips deleted entries -- so it is useful for annotate.3602The 'dense' part is a reference to a '--dense' option available for git-rev-list3603and other git tools that depend on it.36043605=cut3606sub gethistorydense3607{3608my$self=shift;3609my$filename=shift;3610my$tablename=$self->tablename("revision");36113612my$db_query;3613$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);3614$db_query->execute($filename);36153616return$db_query->fetchall_arrayref;3617}36183619=head2 in_array()36203621from Array::PAT - mimics the in_array() function3622found in PHP. Yuck but works for small arrays.36233624=cut3625sub in_array3626{3627my($check,@array) =@_;3628my$retval=0;3629foreachmy$test(@array){3630if($checkeq$test){3631$retval=1;3632}3633}3634return$retval;3635}36363637=head2 safe_pipe_capture36383639an alternative to `command` that allows input to be passed as an array3640to work around shell problems with weird characters in arguments36413642=cut3643sub safe_pipe_capture {36443645my@output;36463647if(my$pid=open my$child,'-|') {3648@output= (<$child>);3649close$childor die join(' ',@_).":$!$?";3650}else{3651exec(@_)or die"$!$?";# exec() can fail the executable can't be found3652}3653returnwantarray?@output:join('',@output);3654}36553656=head2 mangle_dirname36573658create a string from a directory name that is suitable to use as3659part of a filename, mainly by converting all chars except \w.- to _36603661=cut3662sub mangle_dirname {3663my$dirname=shift;3664return unlessdefined$dirname;36653666$dirname=~s/[^\w.-]/_/g;36673668return$dirname;3669}36703671=head2 mangle_tablename36723673create a string from a that is suitable to use as part of an SQL table3674name, mainly by converting all chars except \w to _36753676=cut3677sub mangle_tablename {3678my$tablename=shift;3679return unlessdefined$tablename;36803681$tablename=~s/[^\w_]/_/g;36823683return$tablename;3684}368536861;