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 time2661{2662my$fmt=substr($str,0,1);2663die"invalid password format `$fmt'"unless$fmteq'A';2664}26652666my@str=unpack"C*",substr($str,1);2667my$ret=join'',map{chr$SHIFTS[$_] }@str;2668return$ret;2669}267026712672package GITCVS::log;26732674####2675#### Copyright The Open University UK - 2006.2676####2677#### Authors: Martyn Smith <martyn@catalyst.net.nz>2678#### Martin Langhoff <martin@catalyst.net.nz>2679####2680####26812682use strict;2683use warnings;26842685=head1 NAME26862687GITCVS::log26882689=head1 DESCRIPTION26902691This module provides very crude logging with a similar interface to2692Log::Log4perl26932694=head1 METHODS26952696=cut26972698=head2 new26992700Creates a new log object, optionally you can specify a filename here to2701indicate the file to log to. If no log file is specified, you can specify one2702later with method setfile, or indicate you no longer want logging with method2703nofile.27042705Until one of these methods is called, all log calls will buffer messages ready2706to write out.27072708=cut2709sub new2710{2711my$class=shift;2712my$filename=shift;27132714my$self= {};27152716bless$self,$class;27172718if(defined($filename) )2719{2720open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2721}27222723return$self;2724}27252726=head2 setfile27272728This methods takes a filename, and attempts to open that file as the log file.2729If successful, all buffered data is written out to the file, and any further2730logging is written directly to the file.27312732=cut2733sub setfile2734{2735my$self=shift;2736my$filename=shift;27372738if(defined($filename) )2739{2740open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2741}27422743return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");27442745while(my$line=shift@{$self->{buffer}} )2746{2747print{$self->{fh}}$line;2748}2749}27502751=head2 nofile27522753This method indicates no logging is going to be used. It flushes any entries in2754the internal buffer, and sets a flag to ensure no further data is put there.27552756=cut2757sub nofile2758{2759my$self=shift;27602761$self->{nolog} =1;27622763return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");27642765$self->{buffer} = [];2766}27672768=head2 _logopen27692770Internal method. Returns true if the log file is open, false otherwise.27712772=cut2773sub _logopen2774{2775my$self=shift;27762777return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2778return0;2779}27802781=head2 debug info warn fatal27822783These four methods are wrappers to _log. They provide the actual interface for2784logging data.27852786=cut2787sub debug {my$self=shift;$self->_log("debug",@_); }2788sub info {my$self=shift;$self->_log("info",@_); }2789subwarn{my$self=shift;$self->_log("warn",@_); }2790sub fatal {my$self=shift;$self->_log("fatal",@_); }27912792=head2 _log27932794This is an internal method called by the logging functions. It generates a2795timestamp and pushes the logged line either to file, or internal buffer.27962797=cut2798sub _log2799{2800my$self=shift;2801my$level=shift;28022803return if($self->{nolog} );28042805my@time=localtime;2806my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2807$time[5] +1900,2808$time[4] +1,2809$time[3],2810$time[2],2811$time[1],2812$time[0],2813uc$level,2814);28152816if($self->_logopen)2817{2818print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2819}else{2820push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2821}2822}28232824=head2 DESTROY28252826This method simply closes the file handle if one is open28272828=cut2829sub DESTROY2830{2831my$self=shift;28322833if($self->_logopen)2834{2835close$self->{fh};2836}2837}28382839package GITCVS::updater;28402841####2842#### Copyright The Open University UK - 2006.2843####2844#### Authors: Martyn Smith <martyn@catalyst.net.nz>2845#### Martin Langhoff <martin@catalyst.net.nz>2846####2847####28482849use strict;2850use warnings;2851use DBI;28522853=head1 METHODS28542855=cut28562857=head2 new28582859=cut2860sub new2861{2862my$class=shift;2863my$config=shift;2864my$module=shift;2865my$log=shift;28662867die"Need to specify a git repository"unless(defined($config)and-d $config);2868die"Need to specify a module"unless(defined($module) );28692870$class=ref($class) ||$class;28712872my$self= {};28732874bless$self,$class;28752876$self->{valid_tables} = {'revision'=>1,2877'revision_ix1'=>1,2878'revision_ix2'=>1,2879'head'=>1,2880'head_ix1'=>1,2881'properties'=>1,2882'commitmsgs'=>1};28832884$self->{module} =$module;2885$self->{git_path} =$config."/";28862887$self->{log} =$log;28882889die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );28902891$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2892$cfg->{gitcvs}{dbdriver} ||"SQLite";2893$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2894$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2895$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2896$cfg->{gitcvs}{dbuser} ||"";2897$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2898$cfg->{gitcvs}{dbpass} ||"";2899$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||2900$cfg->{gitcvs}{dbtablenameprefix} ||"";2901my%mapping= ( m =>$module,2902 a =>$state->{method},2903 u =>getlogin||getpwuid($<) || $<,2904 G =>$self->{git_path},2905 g => mangle_dirname($self->{git_path}),2906);2907$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2908$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;2909$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;2910$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});29112912die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2913die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2914$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2915$self->{dbuser},2916$self->{dbpass});2917die"Error connecting to database\n"unlessdefined$self->{dbh};29182919$self->{tables} = {};2920foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2921{2922$self->{tables}{$table} =1;2923}29242925# Construct the revision table if required2926unless($self->{tables}{$self->tablename("revision")} )2927{2928my$tablename=$self->tablename("revision");2929my$ix1name=$self->tablename("revision_ix1");2930my$ix2name=$self->tablename("revision_ix2");2931$self->{dbh}->do("2932 CREATE TABLE$tablename(2933 name TEXT NOT NULL,2934 revision INTEGER NOT NULL,2935 filehash TEXT NOT NULL,2936 commithash TEXT NOT NULL,2937 author TEXT NOT NULL,2938 modified TEXT NOT NULL,2939 mode TEXT NOT NULL2940 )2941 ");2942$self->{dbh}->do("2943 CREATE INDEX$ix1name2944 ON$tablename(name,revision)2945 ");2946$self->{dbh}->do("2947 CREATE INDEX$ix2name2948 ON$tablename(name,commithash)2949 ");2950}29512952# Construct the head table if required2953unless($self->{tables}{$self->tablename("head")} )2954{2955my$tablename=$self->tablename("head");2956my$ix1name=$self->tablename("head_ix1");2957$self->{dbh}->do("2958 CREATE TABLE$tablename(2959 name TEXT NOT NULL,2960 revision INTEGER NOT NULL,2961 filehash TEXT NOT NULL,2962 commithash TEXT NOT NULL,2963 author TEXT NOT NULL,2964 modified TEXT NOT NULL,2965 mode TEXT NOT NULL2966 )2967 ");2968$self->{dbh}->do("2969 CREATE INDEX$ix1name2970 ON$tablename(name)2971 ");2972}29732974# Construct the properties table if required2975unless($self->{tables}{$self->tablename("properties")} )2976{2977my$tablename=$self->tablename("properties");2978$self->{dbh}->do("2979 CREATE TABLE$tablename(2980 key TEXT NOT NULL PRIMARY KEY,2981 value TEXT2982 )2983 ");2984}29852986# Construct the commitmsgs table if required2987unless($self->{tables}{$self->tablename("commitmsgs")} )2988{2989my$tablename=$self->tablename("commitmsgs");2990$self->{dbh}->do("2991 CREATE TABLE$tablename(2992 key TEXT NOT NULL PRIMARY KEY,2993 value TEXT2994 )2995 ");2996}29972998return$self;2999}30003001=head2 tablename30023003=cut3004sub tablename3005{3006my$self=shift;3007my$name=shift;30083009if(exists$self->{valid_tables}{$name}) {3010return$self->{dbtablenameprefix} .$name;3011}else{3012returnundef;3013}3014}30153016=head2 update30173018=cut3019sub update3020{3021my$self=shift;30223023# first lets get the commit list3024$ENV{GIT_DIR} =$self->{git_path};30253026my$commitsha1=`git rev-parse$self->{module}`;3027chomp$commitsha1;30283029my$commitinfo=`git cat-file commit$self->{module} 2>&1`;3030unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)3031{3032die("Invalid module '$self->{module}'");3033}303430353036my$git_log;3037my$lastcommit=$self->_get_prop("last_commit");30383039if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date3040return1;3041}30423043# Start exclusive lock here...3044$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";30453046# TODO: log processing is memory bound3047# if we can parse into a 2nd file that is in reverse order3048# we can probably do something really efficient3049my@git_log_params= ('--pretty','--parents','--topo-order');30503051if(defined$lastcommit) {3052push@git_log_params,"$lastcommit..$self->{module}";3053}else{3054push@git_log_params,$self->{module};3055}3056# git-rev-list is the backend / plumbing version of git-log3057open(GITLOG,'-|','git','rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";30583059my@commits;30603061my%commit= ();30623063while( <GITLOG> )3064{3065chomp;3066if(m/^commit\s+(.*)$/) {3067# on ^commit lines put the just seen commit in the stack3068# and prime things for the next one3069if(keys%commit) {3070my%copy=%commit;3071unshift@commits, \%copy;3072%commit= ();3073}3074my@parents=split(m/\s+/,$1);3075$commit{hash} =shift@parents;3076$commit{parents} = \@parents;3077}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {3078# on rfc822-like lines seen before we see any message,3079# lowercase the entry and put it in the hash as key-value3080$commit{lc($1)} =$2;3081}else{3082# message lines - skip initial empty line3083# and trim whitespace3084if(!exists($commit{message}) &&m/^\s*$/) {3085# define it to mark the end of headers3086$commit{message} ='';3087next;3088}3089s/^\s+//;s/\s+$//;# trim ws3090$commit{message} .=$_."\n";3091}3092}3093close GITLOG;30943095unshift@commits, \%commitif(keys%commit);30963097# Now all the commits are in the @commits bucket3098# ordered by time DESC. for each commit that needs processing,3099# determine whether it's following the last head we've seen or if3100# it's on its own branch, grab a file list, and add whatever's changed3101# NOTE: $lastcommit refers to the last commit from previous run3102# $lastpicked is the last commit we picked in this run3103my$lastpicked;3104my$head= {};3105if(defined$lastcommit) {3106$lastpicked=$lastcommit;3107}31083109my$committotal=scalar(@commits);3110my$commitcount=0;31113112# Load the head table into $head (for cached lookups during the update process)3113foreachmy$file( @{$self->gethead()} )3114{3115$head->{$file->{name}} =$file;3116}31173118foreachmy$commit(@commits)3119{3120$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3121if(defined$lastpicked)3122{3123if(!in_array($lastpicked, @{$commit->{parents}}))3124{3125# skip, we'll see this delta3126# as part of a merge later3127# warn "skipping off-track $commit->{hash}\n";3128next;3129}elsif(@{$commit->{parents}} >1) {3130# it is a merge commit, for each parent that is3131# not $lastpicked, see if we can get a log3132# from the merge-base to that parent to put it3133# in the message as a merge summary.3134my@parents= @{$commit->{parents}};3135foreachmy$parent(@parents) {3136# git-merge-base can potentially (but rarely) throw3137# several candidate merge bases. let's assume3138# that the first one is the best one.3139if($parenteq$lastpicked) {3140next;3141}3142my$base=eval{3143 safe_pipe_capture('git','merge-base',3144$lastpicked,$parent);3145};3146# The two branches may not be related at all,3147# in which case merge base simply fails to find3148# any, but that's Ok.3149next if($@);31503151chomp$base;3152if($base) {3153my@merged;3154# print "want to log between $base $parent \n";3155open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3156or die"Cannot call git-log:$!";3157my$mergedhash;3158while(<GITLOG>) {3159chomp;3160if(!defined$mergedhash) {3161if(m/^commit\s+(.+)$/) {3162$mergedhash=$1;3163}else{3164next;3165}3166}else{3167# grab the first line that looks non-rfc8223168# aka has content after leading space3169if(m/^\s+(\S.*)$/) {3170my$title=$1;3171$title=substr($title,0,100);# truncate3172unshift@merged,"$mergedhash$title";3173undef$mergedhash;3174}3175}3176}3177close GITLOG;3178if(@merged) {3179$commit->{mergemsg} =$commit->{message};3180$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3181foreachmy$summary(@merged) {3182$commit->{mergemsg} .="\t$summary\n";3183}3184$commit->{mergemsg} .="\n\n";3185# print "Message for $commit->{hash} \n$commit->{mergemsg}";3186}3187}3188}3189}3190}31913192# convert the date to CVS-happy format3193$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);31943195if(defined($lastpicked) )3196{3197my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3198local($/) ="\0";3199while( <FILELIST> )3200{3201chomp;3202unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)3203{3204die("Couldn't process git-diff-tree line :$_");3205}3206my($mode,$hash,$change) = ($1,$2,$3);3207my$name= <FILELIST>;3208chomp($name);32093210# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");32113212my$git_perms="";3213$git_perms.="r"if($mode&4);3214$git_perms.="w"if($mode&2);3215$git_perms.="x"if($mode&1);3216$git_perms="rw"if($git_permseq"");32173218if($changeeq"D")3219{3220#$log->debug("DELETE $name");3221$head->{$name} = {3222 name =>$name,3223 revision =>$head->{$name}{revision} +1,3224 filehash =>"deleted",3225 commithash =>$commit->{hash},3226 modified =>$commit->{date},3227 author =>$commit->{author},3228 mode =>$git_perms,3229};3230$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3231}3232elsif($changeeq"M"||$changeeq"T")3233{3234#$log->debug("MODIFIED $name");3235$head->{$name} = {3236 name =>$name,3237 revision =>$head->{$name}{revision} +1,3238 filehash =>$hash,3239 commithash =>$commit->{hash},3240 modified =>$commit->{date},3241 author =>$commit->{author},3242 mode =>$git_perms,3243};3244$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3245}3246elsif($changeeq"A")3247{3248#$log->debug("ADDED $name");3249$head->{$name} = {3250 name =>$name,3251 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3252 filehash =>$hash,3253 commithash =>$commit->{hash},3254 modified =>$commit->{date},3255 author =>$commit->{author},3256 mode =>$git_perms,3257};3258$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3259}3260else3261{3262$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");3263die;3264}3265}3266close FILELIST;3267}else{3268# this is used to detect files removed from the repo3269my$seen_files= {};32703271my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");3272local$/="\0";3273while( <FILELIST> )3274{3275chomp;3276unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)3277{3278die("Couldn't process git-ls-tree line :$_");3279}32803281my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);32823283$seen_files->{$git_filename} =1;32843285my($oldhash,$oldrevision,$oldmode) = (3286$head->{$git_filename}{filehash},3287$head->{$git_filename}{revision},3288$head->{$git_filename}{mode}3289);32903291if($git_perms=~/^\d\d\d(\d)\d\d/o)3292{3293$git_perms="";3294$git_perms.="r"if($1&4);3295$git_perms.="w"if($1&2);3296$git_perms.="x"if($1&1);3297}else{3298$git_perms="rw";3299}33003301# unless the file exists with the same hash, we need to update it ...3302unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)3303{3304my$newrevision= ($oldrevisionor0) +1;33053306$head->{$git_filename} = {3307 name =>$git_filename,3308 revision =>$newrevision,3309 filehash =>$git_hash,3310 commithash =>$commit->{hash},3311 modified =>$commit->{date},3312 author =>$commit->{author},3313 mode =>$git_perms,3314};331533163317$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3318}3319}3320close FILELIST;33213322# Detect deleted files3323foreachmy$file(keys%$head)3324{3325unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")3326{3327$head->{$file}{revision}++;3328$head->{$file}{filehash} ="deleted";3329$head->{$file}{commithash} =$commit->{hash};3330$head->{$file}{modified} =$commit->{date};3331$head->{$file}{author} =$commit->{author};33323333$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});3334}3335}3336# END : "Detect deleted files"3337}333833393340if(exists$commit->{mergemsg})3341{3342$self->insert_mergelog($commit->{hash},$commit->{mergemsg});3343}33443345$lastpicked=$commit->{hash};33463347$self->_set_prop("last_commit",$commit->{hash});3348}33493350$self->delete_head();3351foreachmy$file(keys%$head)3352{3353$self->insert_head(3354$file,3355$head->{$file}{revision},3356$head->{$file}{filehash},3357$head->{$file}{commithash},3358$head->{$file}{modified},3359$head->{$file}{author},3360$head->{$file}{mode},3361);3362}3363# invalidate the gethead cache3364$self->{gethead_cache} =undef;336533663367# Ending exclusive lock here3368$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3369}33703371sub insert_rev3372{3373my$self=shift;3374my$name=shift;3375my$revision=shift;3376my$filehash=shift;3377my$commithash=shift;3378my$modified=shift;3379my$author=shift;3380my$mode=shift;3381my$tablename=$self->tablename("revision");33823383my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3384$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3385}33863387sub insert_mergelog3388{3389my$self=shift;3390my$key=shift;3391my$value=shift;3392my$tablename=$self->tablename("commitmsgs");33933394my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3395$insert_mergelog->execute($key,$value);3396}33973398sub delete_head3399{3400my$self=shift;3401my$tablename=$self->tablename("head");34023403my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3404$delete_head->execute();3405}34063407sub insert_head3408{3409my$self=shift;3410my$name=shift;3411my$revision=shift;3412my$filehash=shift;3413my$commithash=shift;3414my$modified=shift;3415my$author=shift;3416my$mode=shift;3417my$tablename=$self->tablename("head");34183419my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3420$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3421}34223423sub _headrev3424{3425my$self=shift;3426my$filename=shift;3427my$tablename=$self->tablename("head");34283429my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM$tablenameWHERE name=?",{},1);3430$db_query->execute($filename);3431my($hash,$revision,$mode) =$db_query->fetchrow_array;34323433return($hash,$revision,$mode);3434}34353436sub _get_prop3437{3438my$self=shift;3439my$key=shift;3440my$tablename=$self->tablename("properties");34413442my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3443$db_query->execute($key);3444my($value) =$db_query->fetchrow_array;34453446return$value;3447}34483449sub _set_prop3450{3451my$self=shift;3452my$key=shift;3453my$value=shift;3454my$tablename=$self->tablename("properties");34553456my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3457$db_query->execute($value,$key);34583459unless($db_query->rows)3460{3461$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3462$db_query->execute($key,$value);3463}34643465return$value;3466}34673468=head2 gethead34693470=cut34713472sub gethead3473{3474my$self=shift;3475my$tablename=$self->tablename("head");34763477return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );34783479my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3480$db_query->execute();34813482my$tree= [];3483while(my$file=$db_query->fetchrow_hashref)3484{3485push@$tree,$file;3486}34873488$self->{gethead_cache} =$tree;34893490return$tree;3491}34923493=head2 getlog34943495=cut34963497sub getlog3498{3499my$self=shift;3500my$filename=shift;3501my$tablename=$self->tablename("revision");35023503my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3504$db_query->execute($filename);35053506my$tree= [];3507while(my$file=$db_query->fetchrow_hashref)3508{3509push@$tree,$file;3510}35113512return$tree;3513}35143515=head2 getmeta35163517This function takes a filename (with path) argument and returns a hashref of3518metadata for that file.35193520=cut35213522sub getmeta3523{3524my$self=shift;3525my$filename=shift;3526my$revision=shift;3527my$tablename_rev=$self->tablename("revision");3528my$tablename_head=$self->tablename("head");35293530my$db_query;3531if(defined($revision)and$revision=~/^\d+$/)3532{3533$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND revision=?",{},1);3534$db_query->execute($filename,$revision);3535}3536elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)3537{3538$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND commithash=?",{},1);3539$db_query->execute($filename,$revision);3540}else{3541$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_headWHERE name=?",{},1);3542$db_query->execute($filename);3543}35443545return$db_query->fetchrow_hashref;3546}35473548=head2 commitmessage35493550this function takes a commithash and returns the commit message for that commit35513552=cut3553sub commitmessage3554{3555my$self=shift;3556my$commithash=shift;3557my$tablename=$self->tablename("commitmsgs");35583559die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);35603561my$db_query;3562$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3563$db_query->execute($commithash);35643565my($message) =$db_query->fetchrow_array;35663567if(defined($message) )3568{3569$message.=" "if($message=~/\n$/);3570return$message;3571}35723573my@lines= safe_pipe_capture("git","cat-file","commit",$commithash);3574shift@lineswhile($lines[0] =~/\S/);3575$message=join("",@lines);3576$message.=" "if($message=~/\n$/);3577return$message;3578}35793580=head2 gethistory35813582This function takes a filename (with path) argument and returns an arrayofarrays3583containing revision,filehash,commithash ordered by revision descending35843585=cut3586sub gethistory3587{3588my$self=shift;3589my$filename=shift;3590my$tablename=$self->tablename("revision");35913592my$db_query;3593$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3594$db_query->execute($filename);35953596return$db_query->fetchall_arrayref;3597}35983599=head2 gethistorydense36003601This function takes a filename (with path) argument and returns an arrayofarrays3602containing revision,filehash,commithash ordered by revision descending.36033604This version of gethistory skips deleted entries -- so it is useful for annotate.3605The 'dense' part is a reference to a '--dense' option available for git-rev-list3606and other git tools that depend on it.36073608=cut3609sub gethistorydense3610{3611my$self=shift;3612my$filename=shift;3613my$tablename=$self->tablename("revision");36143615my$db_query;3616$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);3617$db_query->execute($filename);36183619return$db_query->fetchall_arrayref;3620}36213622=head2 in_array()36233624from Array::PAT - mimics the in_array() function3625found in PHP. Yuck but works for small arrays.36263627=cut3628sub in_array3629{3630my($check,@array) =@_;3631my$retval=0;3632foreachmy$test(@array){3633if($checkeq$test){3634$retval=1;3635}3636}3637return$retval;3638}36393640=head2 safe_pipe_capture36413642an alternative to `command` that allows input to be passed as an array3643to work around shell problems with weird characters in arguments36443645=cut3646sub safe_pipe_capture {36473648my@output;36493650if(my$pid=open my$child,'-|') {3651@output= (<$child>);3652close$childor die join(' ',@_).":$!$?";3653}else{3654exec(@_)or die"$!$?";# exec() can fail the executable can't be found3655}3656returnwantarray?@output:join('',@output);3657}36583659=head2 mangle_dirname36603661create a string from a directory name that is suitable to use as3662part of a filename, mainly by converting all chars except \w.- to _36633664=cut3665sub mangle_dirname {3666my$dirname=shift;3667return unlessdefined$dirname;36683669$dirname=~s/[^\w.-]/_/g;36703671return$dirname;3672}36733674=head2 mangle_tablename36753676create a string from a that is suitable to use as part of an SQL table3677name, mainly by converting all chars except \w to _36783679=cut3680sub mangle_tablename {3681my$tablename=shift;3682return unlessdefined$tablename;36833684$tablename=~s/[^\w_]/_/g;36853686return$tablename;3687}368836891;