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 190unless($usereq'anonymous') { 191# Trying to authenticate a user 192if(not exists$cfg->{gitcvs}->{authdb}) { 193print"E the repo config file needs a [gitcvs.authdb] section with a filename\n"; 194print"I HATE YOU\n"; 195exit1; 196} 197 198my$auth_ok; 199open my$passwd,"<",$cfg->{gitcvs}->{authdb}or die$!; 200while(<$passwd>) { 201if(m{^\Q$user\E:(.*)}) { 202if(crypt($user,$1)eq$1) { 203$auth_ok=1; 204} 205}; 206} 207close$passwd; 208 209unless($auth_ok) { 210print"I HATE YOU\n"; 211exit1; 212} 213# else fall through to LOVE 214} 215 216# For checking whether the user is anonymous on commit 217$state->{user} =$user; 218 219$line= <STDIN>;chomp$line; 220unless($lineeq"END$requestREQUEST") { 221die"E Do not understand$line-- expecting END$requestREQUEST\n"; 222} 223print"I LOVE YOU\n"; 224exit if$requesteq'VERIFICATION';# cvs login 225# and now back to our regular programme... 226} 227 228# Keep going until the client closes the connection 229while(<STDIN>) 230{ 231chomp; 232 233# Check to see if we've seen this method, and call appropriate function. 234if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 235{ 236# use the $methods hash to call the appropriate sub for this command 237#$log->info("Method : $1"); 238&{$methods->{$1}}($1,$2); 239}else{ 240# log fatal because we don't understand this function. If this happens 241# we're fairly screwed because we don't know if the client is expecting 242# a response. If it is, the client will hang, we'll hang, and the whole 243# thing will be custard. 244$log->fatal("Don't understand command$_\n"); 245die("Unknown command$_"); 246} 247} 248 249$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 250$log->info("--------------- FINISH -----------------"); 251 252chdir'/'; 253exit0; 254 255# Magic catchall method. 256# This is the method that will handle all commands we haven't yet 257# implemented. It simply sends a warning to the log file indicating a 258# command that hasn't been implemented has been invoked. 259sub req_CATCHALL 260{ 261my($cmd,$data) =@_; 262$log->warn("Unhandled command : req_$cmd:$data"); 263} 264 265# This method invariably succeeds with an empty response. 266sub req_EMPTY 267{ 268print"ok\n"; 269} 270 271# Root pathname \n 272# Response expected: no. Tell the server which CVSROOT to use. Note that 273# pathname is a local directory and not a fully qualified CVSROOT variable. 274# pathname must already exist; if creating a new root, use the init 275# request, not Root. pathname does not include the hostname of the server, 276# how to access the server, etc.; by the time the CVS protocol is in use, 277# connection, authentication, etc., are already taken care of. The Root 278# request must be sent only once, and it must be sent before any requests 279# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 280sub req_Root 281{ 282my($cmd,$data) =@_; 283$log->debug("req_Root :$data"); 284 285unless($data=~ m#^/#) { 286print"error 1 Root must be an absolute pathname\n"; 287return0; 288} 289 290my$cvsroot=$state->{'base-path'} ||''; 291$cvsroot=~ s#/+$##; 292$cvsroot.=$data; 293 294if($state->{CVSROOT} 295&& ($state->{CVSROOT}ne$cvsroot)) { 296print"error 1 Conflicting roots specified\n"; 297return0; 298} 299 300$state->{CVSROOT} =$cvsroot; 301 302$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 303 304if(@{$state->{allowed_roots}}) { 305my$allowed=0; 306foreachmy$dir(@{$state->{allowed_roots}}) { 307next unless$dir=~ m#^/#; 308$dir=~ s#/+$##; 309if($state->{'strict-paths'}) { 310if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 311$allowed=1; 312last; 313} 314}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 315$allowed=1; 316last; 317} 318} 319 320unless($allowed) { 321print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 322print"E\n"; 323print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 324return0; 325} 326} 327 328unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 329print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 330print"E\n"; 331print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 332return0; 333} 334 335my@gitvars=`git config -l`; 336if($?) { 337print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 338print"E\n"; 339print"error 1 - problem executing git-config\n"; 340return0; 341} 342foreachmy$line(@gitvars) 343{ 344next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 345unless($2) { 346$cfg->{$1}{$3} =$4; 347}else{ 348$cfg->{$1}{$2}{$3} =$4; 349} 350} 351 352my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 353||$cfg->{gitcvs}{enabled}); 354unless($state->{'export-all'} || 355($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 356print"E GITCVS emulation needs to be enabled on this repo\n"; 357print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 358print"E\n"; 359print"error 1 GITCVS emulation disabled\n"; 360return0; 361} 362 363my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 364if($logfile) 365{ 366$log->setfile($logfile); 367}else{ 368$log->nofile(); 369} 370 371return1; 372} 373 374# Global_option option \n 375# Response expected: no. Transmit one of the global options `-q', `-Q', 376# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 377# variations (such as combining of options) are allowed. For graceful 378# handling of valid-requests, it is probably better to make new global 379# options separate requests, rather than trying to add them to this 380# request. 381sub req_Globaloption 382{ 383my($cmd,$data) =@_; 384$log->debug("req_Globaloption :$data"); 385$state->{globaloptions}{$data} =1; 386} 387 388# Valid-responses request-list \n 389# Response expected: no. Tell the server what responses the client will 390# accept. request-list is a space separated list of tokens. 391sub req_Validresponses 392{ 393my($cmd,$data) =@_; 394$log->debug("req_Validresponses :$data"); 395 396# TODO : re-enable this, currently it's not particularly useful 397#$state->{validresponses} = [ split /\s+/, $data ]; 398} 399 400# valid-requests \n 401# Response expected: yes. Ask the server to send back a Valid-requests 402# response. 403sub req_validrequests 404{ 405my($cmd,$data) =@_; 406 407$log->debug("req_validrequests"); 408 409$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 410$log->debug("SEND : ok"); 411 412print"Valid-requests ".join(" ",keys%$methods) ."\n"; 413print"ok\n"; 414} 415 416# Directory local-directory \n 417# Additional data: repository \n. Response expected: no. Tell the server 418# what directory to use. The repository should be a directory name from a 419# previous server response. Note that this both gives a default for Entry 420# and Modified and also for ci and the other commands; normal usage is to 421# send Directory for each directory in which there will be an Entry or 422# Modified, and then a final Directory for the original directory, then the 423# command. The local-directory is relative to the top level at which the 424# command is occurring (i.e. the last Directory which is sent before the 425# command); to indicate that top level, `.' should be sent for 426# local-directory. 427sub req_Directory 428{ 429my($cmd,$data) =@_; 430 431my$repository= <STDIN>; 432chomp$repository; 433 434 435$state->{localdir} =$data; 436$state->{repository} =$repository; 437$state->{path} =$repository; 438$state->{path} =~s/^\Q$state->{CVSROOT}\E\///; 439$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 440$state->{path} .="/"if($state->{path} =~ /\S/ ); 441 442$state->{directory} =$state->{localdir}; 443$state->{directory} =""if($state->{directory}eq"."); 444$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 445 446if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 447{ 448$log->info("Setting prepend to '$state->{path}'"); 449$state->{prependdir} =$state->{path}; 450foreachmy$entry(keys%{$state->{entries}} ) 451{ 452$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 453delete$state->{entries}{$entry}; 454} 455} 456 457if(defined($state->{prependdir} ) ) 458{ 459$log->debug("Prepending '$state->{prependdir}' to state|directory"); 460$state->{directory} =$state->{prependdir} .$state->{directory} 461} 462$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 463} 464 465# Entry entry-line \n 466# Response expected: no. Tell the server what version of a file is on the 467# local machine. The name in entry-line is a name relative to the directory 468# most recently specified with Directory. If the user is operating on only 469# some files in a directory, Entry requests for only those files need be 470# included. If an Entry request is sent without Modified, Is-modified, or 471# Unchanged, it means the file is lost (does not exist in the working 472# directory). If both Entry and one of Modified, Is-modified, or Unchanged 473# are sent for the same file, Entry must be sent first. For a given file, 474# one can send Modified, Is-modified, or Unchanged, but not more than one 475# of these three. 476sub req_Entry 477{ 478my($cmd,$data) =@_; 479 480#$log->debug("req_Entry : $data"); 481 482my@data=split(/\//,$data); 483 484$state->{entries}{$state->{directory}.$data[1]} = { 485 revision =>$data[2], 486 conflict =>$data[3], 487 options =>$data[4], 488 tag_or_date =>$data[5], 489}; 490 491$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 492} 493 494# Questionable filename \n 495# Response expected: no. Additional data: no. Tell the server to check 496# whether filename should be ignored, and if not, next time the server 497# sends responses, send (in a M response) `?' followed by the directory and 498# filename. filename must not contain `/'; it needs to be a file in the 499# directory named by the most recent Directory request. 500sub req_Questionable 501{ 502my($cmd,$data) =@_; 503 504$log->debug("req_Questionable :$data"); 505$state->{entries}{$state->{directory}.$data}{questionable} =1; 506} 507 508# add \n 509# Response expected: yes. Add a file or directory. This uses any previous 510# Argument, Directory, Entry, or Modified requests, if they have been sent. 511# The last Directory sent specifies the working directory at the time of 512# the operation. To add a directory, send the directory to be added using 513# Directory and Argument requests. 514sub req_add 515{ 516my($cmd,$data) =@_; 517 518 argsplit("add"); 519 520my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 521$updater->update(); 522 523 argsfromdir($updater); 524 525my$addcount=0; 526 527foreachmy$filename( @{$state->{args}} ) 528{ 529$filename= filecleanup($filename); 530 531my$meta=$updater->getmeta($filename); 532my$wrev= revparse($filename); 533 534if($wrev&&$meta&& ($wrev<0)) 535{ 536# previously removed file, add back 537$log->info("added file$filenamewas previously removed, send 1.$meta->{revision}"); 538 539print"MT +updated\n"; 540print"MT text U\n"; 541print"MT fname$filename\n"; 542print"MT newline\n"; 543print"MT -updated\n"; 544 545unless($state->{globaloptions}{-n} ) 546{ 547my($filepart,$dirpart) = filenamesplit($filename,1); 548 549print"Created$dirpart\n"; 550print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 551 552# this is an "entries" line 553my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 554$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 555print"/$filepart/1.$meta->{revision}//$kopts/\n"; 556# permissions 557$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 558print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 559# transmit file 560 transmitfile($meta->{filehash}); 561} 562 563next; 564} 565 566unless(defined($state->{entries}{$filename}{modified_filename} ) ) 567{ 568print"E cvs add: nothing known about `$filename'\n"; 569next; 570} 571# TODO : check we're not squashing an already existing file 572if(defined($state->{entries}{$filename}{revision} ) ) 573{ 574print"E cvs add: `$filename' has already been entered\n"; 575next; 576} 577 578my($filepart,$dirpart) = filenamesplit($filename,1); 579 580print"E cvs add: scheduling file `$filename' for addition\n"; 581 582print"Checked-in$dirpart\n"; 583print"$filename\n"; 584my$kopts= kopts_from_path($filename,"file", 585$state->{entries}{$filename}{modified_filename}); 586print"/$filepart/0//$kopts/\n"; 587 588my$requestedKopts=$state->{opt}{k}; 589if(defined($requestedKopts)) 590{ 591$requestedKopts="-k$requestedKopts"; 592} 593else 594{ 595$requestedKopts=""; 596} 597if($koptsne$requestedKopts) 598{ 599$log->warn("Ignoring requested -k='$requestedKopts'" 600." for '$filename'; detected -k='$kopts' instead"); 601#TODO: Also have option to send warning to user? 602} 603 604$addcount++; 605} 606 607if($addcount==1) 608{ 609print"E cvs add: use `cvs commit' to add this file permanently\n"; 610} 611elsif($addcount>1) 612{ 613print"E cvs add: use `cvs commit' to add these files permanently\n"; 614} 615 616print"ok\n"; 617} 618 619# remove \n 620# Response expected: yes. Remove a file. This uses any previous Argument, 621# Directory, Entry, or Modified requests, if they have been sent. The last 622# Directory sent specifies the working directory at the time of the 623# operation. Note that this request does not actually do anything to the 624# repository; the only effect of a successful remove request is to supply 625# the client with a new entries line containing `-' to indicate a removed 626# file. In fact, the client probably could perform this operation without 627# contacting the server, although using remove may cause the server to 628# perform a few more checks. The client sends a subsequent ci request to 629# actually record the removal in the repository. 630sub req_remove 631{ 632my($cmd,$data) =@_; 633 634 argsplit("remove"); 635 636# Grab a handle to the SQLite db and do any necessary updates 637my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 638$updater->update(); 639 640#$log->debug("add state : " . Dumper($state)); 641 642my$rmcount=0; 643 644foreachmy$filename( @{$state->{args}} ) 645{ 646$filename= filecleanup($filename); 647 648if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 649{ 650print"E cvs remove: file `$filename' still in working directory\n"; 651next; 652} 653 654my$meta=$updater->getmeta($filename); 655my$wrev= revparse($filename); 656 657unless(defined($wrev) ) 658{ 659print"E cvs remove: nothing known about `$filename'\n"; 660next; 661} 662 663if(defined($wrev)and$wrev<0) 664{ 665print"E cvs remove: file `$filename' already scheduled for removal\n"; 666next; 667} 668 669unless($wrev==$meta->{revision} ) 670{ 671# TODO : not sure if the format of this message is quite correct. 672print"E cvs remove: Up to date check failed for `$filename'\n"; 673next; 674} 675 676 677my($filepart,$dirpart) = filenamesplit($filename,1); 678 679print"E cvs remove: scheduling `$filename' for removal\n"; 680 681print"Checked-in$dirpart\n"; 682print"$filename\n"; 683my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 684print"/$filepart/-1.$wrev//$kopts/\n"; 685 686$rmcount++; 687} 688 689if($rmcount==1) 690{ 691print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 692} 693elsif($rmcount>1) 694{ 695print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 696} 697 698print"ok\n"; 699} 700 701# Modified filename \n 702# Response expected: no. Additional data: mode, \n, file transmission. Send 703# the server a copy of one locally modified file. filename is a file within 704# the most recent directory sent with Directory; it must not contain `/'. 705# If the user is operating on only some files in a directory, only those 706# files need to be included. This can also be sent without Entry, if there 707# is no entry for the file. 708sub req_Modified 709{ 710my($cmd,$data) =@_; 711 712my$mode= <STDIN>; 713defined$mode 714or(print"E end of file reading mode for$data\n"),return; 715chomp$mode; 716my$size= <STDIN>; 717defined$size 718or(print"E end of file reading size of$data\n"),return; 719chomp$size; 720 721# Grab config information 722my$blocksize=8192; 723my$bytesleft=$size; 724my$tmp; 725 726# Get a filehandle/name to write it to 727my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 728 729# Loop over file data writing out to temporary file. 730while($bytesleft) 731{ 732$blocksize=$bytesleftif($bytesleft<$blocksize); 733read STDIN,$tmp,$blocksize; 734print$fh $tmp; 735$bytesleft-=$blocksize; 736} 737 738close$fh 739or(print"E failed to write temporary,$filename:$!\n"),return; 740 741# Ensure we have something sensible for the file mode 742if($mode=~/u=(\w+)/) 743{ 744$mode=$1; 745}else{ 746$mode="rw"; 747} 748 749# Save the file data in $state 750$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 751$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 752$state->{entries}{$state->{directory}.$data}{modified_hash} =`git hash-object$filename`; 753$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 754 755 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 756} 757 758# Unchanged filename\n 759# Response expected: no. Tell the server that filename has not been 760# modified in the checked out directory. The filename is a file within the 761# most recent directory sent with Directory; it must not contain `/'. 762sub req_Unchanged 763{ 764 my ($cmd,$data) =@_; 765 766$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 767 768 #$log->debug("req_Unchanged :$data"); 769} 770 771# Argument text\n 772# Response expected: no. Save argument for use in a subsequent command. 773# Arguments accumulate until an argument-using command is given, at which 774# point they are forgotten. 775# Argumentx text\n 776# Response expected: no. Append\nfollowed by text to the current argument 777# being saved. 778sub req_Argument 779{ 780 my ($cmd,$data) =@_; 781 782 # Argumentx means: append to last Argument (with a newline in front) 783 784$log->debug("$cmd:$data"); 785 786 if ($cmdeq 'Argumentx') { 787 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 788 } else { 789 push @{$state->{arguments}},$data; 790 } 791} 792 793# expand-modules\n 794# Response expected: yes. Expand the modules which are specified in the 795# arguments. Returns the data in Module-expansion responses. Note that the 796# server can assume that this is checkout or export, not rtag or rdiff; the 797# latter do not access the working directory and thus have no need to 798# expand modules on the client side. Expand may not be the best word for 799# what this request does. It does not necessarily tell you all the files 800# contained in a module, for example. Basically it is a way of telling you 801# which working directories the server needs to know about in order to 802# handle a checkout of the specified modules. For example, suppose that the 803# server has a module defined by 804# aliasmodule -a 1dir 805# That is, one can check out aliasmodule and it will take 1dir in the 806# repository and check it out to 1dir in the working directory. Now suppose 807# the client already has this module checked out and is planning on using 808# the co request to update it. Without using expand-modules, the client 809# would have two bad choices: it could either send information about all 810# working directories under the current directory, which could be 811# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 812# stands for 1dir, and neglect to send information for 1dir, which would 813# lead to incorrect operation. With expand-modules, the client would first 814# ask for the module to be expanded: 815sub req_expandmodules 816{ 817 my ($cmd,$data) =@_; 818 819 argsplit(); 820 821$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 822 823 unless ( ref$state->{arguments} eq "ARRAY" ) 824 { 825 print "ok\n"; 826 return; 827 } 828 829 foreach my$module( @{$state->{arguments}} ) 830 { 831$log->debug("SEND : Module-expansion$module"); 832 print "Module-expansion$module\n"; 833 } 834 835 print "ok\n"; 836 statecleanup(); 837} 838 839# co\n 840# Response expected: yes. Get files from the repository. This uses any 841# previous Argument, Directory, Entry, or Modified requests, if they have 842# been sent. Arguments to this command are module names; the client cannot 843# know what directories they correspond to except by (1) just sending the 844# co request, and then seeing what directory names the server sends back in 845# its responses, and (2) the expand-modules request. 846sub req_co 847{ 848 my ($cmd,$data) =@_; 849 850 argsplit("co"); 851 852 # Provide list of modules, if -c was used. 853 if (exists$state->{opt}{c}) { 854 my$showref= `git show-ref --heads`; 855 for my$line(split '\n',$showref) { 856 if ($line=~ m% refs/heads/(.*)$%) { 857 print "M$1\t$1\n"; 858 } 859 } 860 print "ok\n"; 861 return 1; 862 } 863 864 my$module=$state->{args}[0]; 865$state->{module} =$module; 866 my$checkout_path=$module; 867 868 # use the user specified directory if we're given it 869$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 870 871$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 872 873$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 874 875$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 876 877# Grab a handle to the SQLite db and do any necessary updates 878my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 879$updater->update(); 880 881$checkout_path=~ s|/$||;# get rid of trailing slashes 882 883# Eclipse seems to need the Clear-sticky command 884# to prepare the 'Entries' file for the new directory. 885print"Clear-sticky$checkout_path/\n"; 886print$state->{CVSROOT} ."/$module/\n"; 887print"Clear-static-directory$checkout_path/\n"; 888print$state->{CVSROOT} ."/$module/\n"; 889print"Clear-sticky$checkout_path/\n";# yes, twice 890print$state->{CVSROOT} ."/$module/\n"; 891print"Template$checkout_path/\n"; 892print$state->{CVSROOT} ."/$module/\n"; 893print"0\n"; 894 895# instruct the client that we're checking out to $checkout_path 896print"E cvs checkout: Updating$checkout_path\n"; 897 898my%seendirs= (); 899my$lastdir=''; 900 901# recursive 902sub prepdir { 903my($dir,$repodir,$remotedir,$seendirs) =@_; 904my$parent= dirname($dir); 905$dir=~ s|/+$||; 906$repodir=~ s|/+$||; 907$remotedir=~ s|/+$||; 908$parent=~ s|/+$||; 909$log->debug("announcedir$dir,$repodir,$remotedir"); 910 911if($parenteq'.'||$parenteq'./') { 912$parent=''; 913} 914# recurse to announce unseen parents first 915if(length($parent) && !exists($seendirs->{$parent})) { 916 prepdir($parent,$repodir,$remotedir,$seendirs); 917} 918# Announce that we are going to modify at the parent level 919if($parent) { 920print"E cvs checkout: Updating$remotedir/$parent\n"; 921}else{ 922print"E cvs checkout: Updating$remotedir\n"; 923} 924print"Clear-sticky$remotedir/$parent/\n"; 925print"$repodir/$parent/\n"; 926 927print"Clear-static-directory$remotedir/$dir/\n"; 928print"$repodir/$dir/\n"; 929print"Clear-sticky$remotedir/$parent/\n";# yes, twice 930print"$repodir/$parent/\n"; 931print"Template$remotedir/$dir/\n"; 932print"$repodir/$dir/\n"; 933print"0\n"; 934 935$seendirs->{$dir} =1; 936} 937 938foreachmy$git( @{$updater->gethead} ) 939{ 940# Don't want to check out deleted files 941next if($git->{filehash}eq"deleted"); 942 943my$fullName=$git->{name}; 944($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 945 946if(length($git->{dir}) &&$git->{dir}ne'./' 947&&$git->{dir}ne$lastdir) { 948unless(exists($seendirs{$git->{dir}})) { 949 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 950$checkout_path, \%seendirs); 951$lastdir=$git->{dir}; 952$seendirs{$git->{dir}} =1; 953} 954print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 955} 956 957# modification time of this file 958print"Mod-time$git->{modified}\n"; 959 960# print some information to the client 961if(defined($git->{dir} )and$git->{dir}ne"./") 962{ 963print"M U$checkout_path/$git->{dir}$git->{name}\n"; 964}else{ 965print"M U$checkout_path/$git->{name}\n"; 966} 967 968# instruct client we're sending a file to put in this path 969print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 970 971print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 972 973# this is an "entries" line 974my$kopts= kopts_from_path($fullName,"sha1",$git->{filehash}); 975print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 976# permissions 977print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 978 979# transmit file 980 transmitfile($git->{filehash}); 981} 982 983print"ok\n"; 984 985 statecleanup(); 986} 987 988# update \n 989# Response expected: yes. Actually do a cvs update command. This uses any 990# previous Argument, Directory, Entry, or Modified requests, if they have 991# been sent. The last Directory sent specifies the working directory at the 992# time of the operation. The -I option is not used--files which the client 993# can decide whether to ignore are not mentioned and the client sends the 994# Questionable request for others. 995sub req_update 996{ 997my($cmd,$data) =@_; 998 999$log->debug("req_update : ". (defined($data) ?$data:"[NULL]"));10001001 argsplit("update");10021003#1004# It may just be a client exploring the available heads/modules1005# in that case, list them as top level directories and leave it1006# at that. Eclipse uses this technique to offer you a list of1007# projects (heads in this case) to checkout.1008#1009if($state->{module}eq'') {1010my$showref=`git show-ref --heads`;1011print"E cvs update: Updating .\n";1012formy$line(split'\n',$showref) {1013if($line=~ m% refs/heads/(.*)$%) {1014print"E cvs update: New directory `$1'\n";1015}1016}1017print"ok\n";1018return1;1019}102010211022# Grab a handle to the SQLite db and do any necessary updates1023my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);10241025$updater->update();10261027 argsfromdir($updater);10281029#$log->debug("update state : " . Dumper($state));10301031my$last_dirname="///";10321033# foreach file specified on the command line ...1034foreachmy$filename( @{$state->{args}} )1035{1036$filename= filecleanup($filename);10371038$log->debug("Processing file$filename");10391040unless($state->{globaloptions}{-Q} ||$state->{globaloptions}{-q} )1041{1042my$cur_dirname= dirname($filename);1043if($cur_dirnamene$last_dirname)1044{1045$last_dirname=$cur_dirname;1046if($cur_dirnameeq"")1047{1048$cur_dirname=".";1049}1050print"E cvs update: Updating$cur_dirname\n";1051}1052}10531054# if we have a -C we should pretend we never saw modified stuff1055if(exists($state->{opt}{C} ) )1056{1057delete$state->{entries}{$filename}{modified_hash};1058delete$state->{entries}{$filename}{modified_filename};1059$state->{entries}{$filename}{unchanged} =1;1060}10611062my$meta;1063if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/)1064{1065$meta=$updater->getmeta($filename,$1);1066}else{1067$meta=$updater->getmeta($filename);1068}10691070# If -p was given, "print" the contents of the requested revision.1071if(exists($state->{opt}{p} ) ) {1072if(defined($meta->{revision} ) ) {1073$log->info("Printing '$filename' revision ".$meta->{revision});10741075 transmitfile($meta->{filehash}, {print=>1});1076}10771078next;1079}10801081if( !defined$meta)1082{1083$meta= {1084 name =>$filename,1085 revision =>0,1086 filehash =>'added'1087};1088}10891090my$oldmeta=$meta;10911092my$wrev= revparse($filename);10931094# If the working copy is an old revision, lets get that version too for comparison.1095if(defined($wrev)and$wrev!=$meta->{revision} )1096{1097$oldmeta=$updater->getmeta($filename,$wrev);1098}10991100#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");11011102# Files are up to date if the working copy and repo copy have the same revision,1103# and the working copy is unmodified _and_ the user hasn't specified -C1104next if(defined($wrev)1105and defined($meta->{revision})1106and$wrev==$meta->{revision}1107and$state->{entries}{$filename}{unchanged}1108and not exists($state->{opt}{C} ) );11091110# If the working copy and repo copy have the same revision,1111# but the working copy is modified, tell the client it's modified1112if(defined($wrev)1113and defined($meta->{revision})1114and$wrev==$meta->{revision}1115and defined($state->{entries}{$filename}{modified_hash})1116and not exists($state->{opt}{C} ) )1117{1118$log->info("Tell the client the file is modified");1119print"MT text M\n";1120print"MT fname$filename\n";1121print"MT newline\n";1122next;1123}11241125if($meta->{filehash}eq"deleted")1126{1127my($filepart,$dirpart) = filenamesplit($filename,1);11281129$log->info("Removing '$filename' from working copy (no longer in the repo)");11301131print"E cvs update: `$filename' is no longer in the repository\n";1132# Don't want to actually _DO_ the update if -n specified1133unless($state->{globaloptions}{-n} ) {1134print"Removed$dirpart\n";1135print"$filepart\n";1136}1137}1138elsif(not defined($state->{entries}{$filename}{modified_hash} )1139or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1140or$meta->{filehash}eq'added')1141{1142# normal update, just send the new revision (either U=Update,1143# or A=Add, or R=Remove)1144if(defined($wrev) &&$wrev<0)1145{1146$log->info("Tell the client the file is scheduled for removal");1147print"MT text R\n";1148print"MT fname$filename\n";1149print"MT newline\n";1150next;1151}1152elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) )1153{1154$log->info("Tell the client the file is scheduled for addition");1155print"MT text A\n";1156print"MT fname$filename\n";1157print"MT newline\n";1158next;11591160}1161else{1162$log->info("Updating '$filename' to ".$meta->{revision});1163print"MT +updated\n";1164print"MT text U\n";1165print"MT fname$filename\n";1166print"MT newline\n";1167print"MT -updated\n";1168}11691170my($filepart,$dirpart) = filenamesplit($filename,1);11711172# Don't want to actually _DO_ the update if -n specified1173unless($state->{globaloptions}{-n} )1174{1175if(defined($wrev) )1176{1177# instruct client we're sending a file to put in this path as a replacement1178print"Update-existing$dirpart\n";1179$log->debug("Updating existing file 'Update-existing$dirpart'");1180}else{1181# instruct client we're sending a file to put in this path as a new file1182print"Clear-static-directory$dirpart\n";1183print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1184print"Clear-sticky$dirpart\n";1185print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";11861187$log->debug("Creating new file 'Created$dirpart'");1188print"Created$dirpart\n";1189}1190print$state->{CVSROOT} ."/$state->{module}/$filename\n";11911192# this is an "entries" line1193my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1194$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1195print"/$filepart/1.$meta->{revision}//$kopts/\n";11961197# permissions1198$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1199print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";12001201# transmit file1202 transmitfile($meta->{filehash});1203}1204}else{1205$log->info("Updating '$filename'");1206my($filepart,$dirpart) = filenamesplit($meta->{name},1);12071208my$mergeDir= setupTmpDir();12091210my$file_local=$filepart.".mine";1211my$mergedFile="$mergeDir/$file_local";1212system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1213my$file_old=$filepart.".".$oldmeta->{revision};1214 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1215my$file_new=$filepart.".".$meta->{revision};1216 transmitfile($meta->{filehash}, { targetfile =>$file_new});12171218# we need to merge with the local changes ( M=successful merge, C=conflict merge )1219$log->info("Merging$file_local,$file_old,$file_new");1220print"M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into$filename\n";12211222$log->debug("Temporary directory for merge is$mergeDir");12231224my$return=system("git","merge-file",$file_local,$file_old,$file_new);1225$return>>=8;12261227 cleanupTmpDir();12281229if($return==0)1230{1231$log->info("Merged successfully");1232print"M M$filename\n";1233$log->debug("Merged$dirpart");12341235# Don't want to actually _DO_ the update if -n specified1236unless($state->{globaloptions}{-n} )1237{1238print"Merged$dirpart\n";1239$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1240print$state->{CVSROOT} ."/$state->{module}/$filename\n";1241my$kopts= kopts_from_path("$dirpart/$filepart",1242"file",$mergedFile);1243$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1244print"/$filepart/1.$meta->{revision}//$kopts/\n";1245}1246}1247elsif($return==1)1248{1249$log->info("Merged with conflicts");1250print"E cvs update: conflicts found in$filename\n";1251print"M C$filename\n";12521253# Don't want to actually _DO_ the update if -n specified1254unless($state->{globaloptions}{-n} )1255{1256print"Merged$dirpart\n";1257print$state->{CVSROOT} ."/$state->{module}/$filename\n";1258my$kopts= kopts_from_path("$dirpart/$filepart",1259"file",$mergedFile);1260print"/$filepart/1.$meta->{revision}/+/$kopts/\n";1261}1262}1263else1264{1265$log->warn("Merge failed");1266next;1267}12681269# Don't want to actually _DO_ the update if -n specified1270unless($state->{globaloptions}{-n} )1271{1272# permissions1273$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1274print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";12751276# transmit file, format is single integer on a line by itself (file1277# size) followed by the file contents1278# TODO : we should copy files in blocks1279my$data=`cat$mergedFile`;1280$log->debug("File size : " . length($data));1281 print length($data) . "\n";1282 print$data;1283 }1284 }12851286 }12871288 print "ok\n";1289}12901291sub req_ci1292{1293 my ($cmd,$data) =@_;12941295 argsplit("ci");12961297 #$log->debug("State : " . Dumper($state));12981299$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));13001301 if ($state->{method} eq 'pserver' and$state->{user} eq 'anonymous' )1302 {1303 print "error 1 anonymous user cannot commit via pserver\n";1304 cleanupWorkTree();1305 exit;1306 }13071308 if ( -e$state->{CVSROOT} . "/index" )1309 {1310$log->warn("file 'index' already exists in the git repository");1311 print "error 1 Index already exists in git repo\n";1312 cleanupWorkTree();1313 exit;1314 }13151316 # Grab a handle to the SQLite db and do any necessary updates1317 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1318$updater->update();13191320 # Remember where the head was at the beginning.1321 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1322 chomp$parenthash;1323 if ($parenthash!~ /^[0-9a-f]{40}$/) {1324 print "error 1 pserver cannot find the current HEAD of module";1325 cleanupWorkTree();1326 exit;1327 }13281329 setupWorkTree($parenthash);13301331$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");13321333$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");13341335 my@committedfiles= ();1336 my%oldmeta;13371338 # foreach file specified on the command line ...1339 foreach my$filename( @{$state->{args}} )1340 {1341 my$committedfile=$filename;1342$filename= filecleanup($filename);13431344 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );13451346 my$meta=$updater->getmeta($filename);1347$oldmeta{$filename} =$meta;13481349 my$wrev= revparse($filename);13501351 my ($filepart,$dirpart) = filenamesplit($filename);13521353 # do a checkout of the file if it is part of this tree1354 if ($wrev) {1355 system('git', 'checkout-index', '-f', '-u',$filename);1356 unless ($?== 0) {1357 die "Error running git-checkout-index -f -u$filename:$!";1358 }1359 }13601361 my$addflag= 0;1362 my$rmflag= 0;1363$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1364$addflag= 1 unless ( -e$filename);13651366 # Do up to date checking1367 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1368 {1369 # fail everything if an up to date check fails1370 print "error 1 Up to date check failed for$filename\n";1371 cleanupWorkTree();1372 exit;1373 }13741375 push@committedfiles,$committedfile;1376$log->info("Committing$filename");13771378 system("mkdir","-p",$dirpart) unless ( -d$dirpart);13791380 unless ($rmflag)1381 {1382$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1383 rename$state->{entries}{$filename}{modified_filename},$filename;13841385 # Calculate modes to remove1386 my$invmode= "";1387 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }13881389$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1390 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1391 }13921393 if ($rmflag)1394 {1395$log->info("Removing file '$filename'");1396 unlink($filename);1397 system("git", "update-index", "--remove",$filename);1398 }1399 elsif ($addflag)1400 {1401$log->info("Adding file '$filename'");1402 system("git", "update-index", "--add",$filename);1403 } else {1404$log->info("Updating file '$filename'");1405 system("git", "update-index",$filename);1406 }1407 }14081409 unless ( scalar(@committedfiles) > 0 )1410 {1411 print "E No files to commit\n";1412 print "ok\n";1413 cleanupWorkTree();1414 return;1415 }14161417 my$treehash= `git write-tree`;1418 chomp$treehash;14191420$log->debug("Treehash :$treehash, Parenthash :$parenthash");14211422 # write our commit message out if we have one ...1423 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1424 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1425 if ( defined ($cfg->{gitcvs}{commitmsgannotation} ) ) {1426 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/) {1427 print$msg_fh"\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"1428 }1429 } else {1430 print$msg_fh"\n\nvia git-CVS emulator\n";1431 }1432 close$msg_fh;14331434 my$commithash= `git commit-tree $treehash-p $parenthash<$msg_filename`;1435chomp($commithash);1436$log->info("Commit hash :$commithash");14371438unless($commithash=~/[a-zA-Z0-9]{40}/)1439{1440$log->warn("Commit failed (Invalid commit hash)");1441print"error 1 Commit failed (unknown reason)\n";1442 cleanupWorkTree();1443exit;1444}14451446### Emulate git-receive-pack by running hooks/update1447my@hook= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1448$parenthash,$commithash);1449if( -x $hook[0] ) {1450unless(system(@hook) ==0)1451{1452$log->warn("Commit failed (update hook declined to update ref)");1453print"error 1 Commit failed (update hook declined)\n";1454 cleanupWorkTree();1455exit;1456}1457}14581459### Update the ref1460if(system(qw(git update-ref -m),"cvsserver ci",1461"refs/heads/$state->{module}",$commithash,$parenthash)) {1462$log->warn("update-ref for$state->{module} failed.");1463print"error 1 Cannot commit -- update first\n";1464 cleanupWorkTree();1465exit;1466}14671468### Emulate git-receive-pack by running hooks/post-receive1469my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1470if( -x $hook) {1471open(my$pipe,"|$hook") ||die"can't fork$!";14721473local$SIG{PIPE} =sub{die'pipe broke'};14741475print$pipe"$parenthash$commithashrefs/heads/$state->{module}\n";14761477close$pipe||die"bad pipe:$!$?";1478}14791480$updater->update();14811482### Then hooks/post-update1483$hook=$ENV{GIT_DIR}.'hooks/post-update';1484if(-x $hook) {1485system($hook,"refs/heads/$state->{module}");1486}14871488# foreach file specified on the command line ...1489foreachmy$filename(@committedfiles)1490{1491$filename= filecleanup($filename);14921493my$meta=$updater->getmeta($filename);1494unless(defined$meta->{revision}) {1495$meta->{revision} =1;1496}14971498my($filepart,$dirpart) = filenamesplit($filename,1);14991500$log->debug("Checked-in$dirpart:$filename");15011502print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1503if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1504{1505print"M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";1506print"Remove-entry$dirpart\n";1507print"$filename\n";1508}else{1509if($meta->{revision} ==1) {1510print"M initial revision: 1.1\n";1511}else{1512print"M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";1513}1514print"Checked-in$dirpart\n";1515print"$filename\n";1516my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1517print"/$filepart/1.$meta->{revision}//$kopts/\n";1518}1519}15201521 cleanupWorkTree();1522print"ok\n";1523}15241525sub req_status1526{1527my($cmd,$data) =@_;15281529 argsplit("status");15301531$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1532#$log->debug("status state : " . Dumper($state));15331534# Grab a handle to the SQLite db and do any necessary updates1535my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1536$updater->update();15371538# if no files were specified, we need to work out what files we should be providing status on ...1539 argsfromdir($updater);15401541# foreach file specified on the command line ...1542foreachmy$filename( @{$state->{args}} )1543{1544$filename= filecleanup($filename);15451546next ifexists($state->{opt}{l}) &&index($filename,'/',length($state->{prependdir})) >=0;15471548my$meta=$updater->getmeta($filename);1549my$oldmeta=$meta;15501551my$wrev= revparse($filename);15521553# If the working copy is an old revision, lets get that version too for comparison.1554if(defined($wrev)and$wrev!=$meta->{revision} )1555{1556$oldmeta=$updater->getmeta($filename,$wrev);1557}15581559# TODO : All possible statuses aren't yet implemented1560my$status;1561# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1562$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1563and1564( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1565or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1566);15671568# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1569$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1570and1571($state->{entries}{$filename}{unchanged}1572or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1573);15741575# Need checkout if it exists in the repo but doesn't have a working copy1576$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );15771578# Locally modified if working copy and repo copy have the same revision but there are local changes1579$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );15801581# Needs Merge if working copy revision is less than repo copy and there are local changes1582$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );15831584$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1585$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1586$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1587$status||="File had conflicts on merge"if(0);15881589$status||="Unknown";15901591my($filepart) = filenamesplit($filename);15921593print"M ===================================================================\n";1594print"M File:$filepart\tStatus:$status\n";1595if(defined($state->{entries}{$filename}{revision}) )1596{1597print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1598}else{1599print"M Working revision:\tNo entry for$filename\n";1600}1601if(defined($meta->{revision}) )1602{1603print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1604print"M Sticky Tag:\t\t(none)\n";1605print"M Sticky Date:\t\t(none)\n";1606print"M Sticky Options:\t\t(none)\n";1607}else{1608print"M Repository revision:\tNo revision control file\n";1609}1610print"M\n";1611}16121613print"ok\n";1614}16151616sub req_diff1617{1618my($cmd,$data) =@_;16191620 argsplit("diff");16211622$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1623#$log->debug("status state : " . Dumper($state));16241625my($revision1,$revision2);1626if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1627{1628$revision1=$state->{opt}{r}[0];1629$revision2=$state->{opt}{r}[1];1630}else{1631$revision1=$state->{opt}{r};1632}16331634$revision1=~s/^1\.//if(defined($revision1) );1635$revision2=~s/^1\.//if(defined($revision2) );16361637$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );16381639# Grab a handle to the SQLite db and do any necessary updates1640my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1641$updater->update();16421643# if no files were specified, we need to work out what files we should be providing status on ...1644 argsfromdir($updater);16451646# foreach file specified on the command line ...1647foreachmy$filename( @{$state->{args}} )1648{1649$filename= filecleanup($filename);16501651my($fh,$file1,$file2,$meta1,$meta2,$filediff);16521653my$wrev= revparse($filename);16541655# We need _something_ to diff against1656next unless(defined($wrev) );16571658# if we have a -r switch, use it1659if(defined($revision1) )1660{1661(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1662$meta1=$updater->getmeta($filename,$revision1);1663unless(defined($meta1)and$meta1->{filehash}ne"deleted")1664{1665print"E File$filenameat revision 1.$revision1doesn't exist\n";1666next;1667}1668 transmitfile($meta1->{filehash}, { targetfile =>$file1});1669}1670# otherwise we just use the working copy revision1671else1672{1673(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1674$meta1=$updater->getmeta($filename,$wrev);1675 transmitfile($meta1->{filehash}, { targetfile =>$file1});1676}16771678# if we have a second -r switch, use it too1679if(defined($revision2) )1680{1681(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1682$meta2=$updater->getmeta($filename,$revision2);16831684unless(defined($meta2)and$meta2->{filehash}ne"deleted")1685{1686print"E File$filenameat revision 1.$revision2doesn't exist\n";1687next;1688}16891690 transmitfile($meta2->{filehash}, { targetfile =>$file2});1691}1692# otherwise we just use the working copy1693else1694{1695$file2=$state->{entries}{$filename}{modified_filename};1696}16971698# if we have been given -r, and we don't have a $file2 yet, lets get one1699if(defined($revision1)and not defined($file2) )1700{1701(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1702$meta2=$updater->getmeta($filename,$wrev);1703 transmitfile($meta2->{filehash}, { targetfile =>$file2});1704}17051706# We need to have retrieved something useful1707next unless(defined($meta1) );17081709# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1710next if(not defined($meta2)and$wrev==$meta1->{revision}1711and1712( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1713or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1714);17151716# Apparently we only show diffs for locally modified files1717next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );17181719print"M Index:$filename\n";1720print"M ===================================================================\n";1721print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1722print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1723print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1724print"M diff ";1725foreachmy$opt(keys%{$state->{opt}} )1726{1727if(ref$state->{opt}{$opt}eq"ARRAY")1728{1729foreachmy$value( @{$state->{opt}{$opt}} )1730{1731print"-$opt$value";1732}1733}else{1734print"-$opt";1735print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1736}1737}1738print"$filename\n";17391740$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));17411742($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);17431744if(exists$state->{opt}{u} )1745{1746system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1747}else{1748system("diff$file1$file2>$filediff");1749}17501751while( <$fh> )1752{1753print"M$_";1754}1755close$fh;1756}17571758print"ok\n";1759}17601761sub req_log1762{1763my($cmd,$data) =@_;17641765 argsplit("log");17661767$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1768#$log->debug("log state : " . Dumper($state));17691770my($minrev,$maxrev);1771if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1772{1773my$control=$2;1774$minrev=$1;1775$maxrev=$3;1776$minrev=~s/^1\.//if(defined($minrev) );1777$maxrev=~s/^1\.//if(defined($maxrev) );1778$minrev++if(defined($minrev)and$controleq"::");1779}17801781# Grab a handle to the SQLite db and do any necessary updates1782my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1783$updater->update();17841785# if no files were specified, we need to work out what files we should be providing status on ...1786 argsfromdir($updater);17871788# foreach file specified on the command line ...1789foreachmy$filename( @{$state->{args}} )1790{1791$filename= filecleanup($filename);17921793my$headmeta=$updater->getmeta($filename);17941795my$revisions=$updater->getlog($filename);1796my$totalrevisions=scalar(@$revisions);17971798if(defined($minrev) )1799{1800$log->debug("Removing revisions less than$minrev");1801while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1802{1803pop@$revisions;1804}1805}1806if(defined($maxrev) )1807{1808$log->debug("Removing revisions greater than$maxrev");1809while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1810{1811shift@$revisions;1812}1813}18141815next unless(scalar(@$revisions) );18161817print"M\n";1818print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1819print"M Working file:$filename\n";1820print"M head: 1.$headmeta->{revision}\n";1821print"M branch:\n";1822print"M locks: strict\n";1823print"M access list:\n";1824print"M symbolic names:\n";1825print"M keyword substitution: kv\n";1826print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1827print"M description:\n";18281829foreachmy$revision(@$revisions)1830{1831print"M ----------------------------\n";1832print"M revision 1.$revision->{revision}\n";1833# reformat the date for log output1834$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}) );1835$revision->{author} = cvs_author($revision->{author});1836print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1837my$commitmessage=$updater->commitmessage($revision->{commithash});1838$commitmessage=~s/^/M /mg;1839print$commitmessage."\n";1840}1841print"M =============================================================================\n";1842}18431844print"ok\n";1845}18461847sub req_annotate1848{1849my($cmd,$data) =@_;18501851 argsplit("annotate");18521853$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1854#$log->debug("status state : " . Dumper($state));18551856# Grab a handle to the SQLite db and do any necessary updates1857my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1858$updater->update();18591860# if no files were specified, we need to work out what files we should be providing annotate on ...1861 argsfromdir($updater);18621863# we'll need a temporary checkout dir1864 setupWorkTree();18651866$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");18671868# foreach file specified on the command line ...1869foreachmy$filename( @{$state->{args}} )1870{1871$filename= filecleanup($filename);18721873my$meta=$updater->getmeta($filename);18741875next unless($meta->{revision} );18761877# get all the commits that this file was in1878# in dense format -- aka skip dead revisions1879my$revisions=$updater->gethistorydense($filename);1880my$lastseenin=$revisions->[0][2];18811882# populate the temporary index based on the latest commit were we saw1883# the file -- but do it cheaply without checking out any files1884# TODO: if we got a revision from the client, use that instead1885# to look up the commithash in sqlite (still good to default to1886# the current head as we do now)1887system("git","read-tree",$lastseenin);1888unless($?==0)1889{1890print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";1891return;1892}1893$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");18941895# do a checkout of the file1896system('git','checkout-index','-f','-u',$filename);1897unless($?==0) {1898print"E error running git-checkout-index -f -u$filename:$!\n";1899return;1900}19011902$log->info("Annotate$filename");19031904# Prepare a file with the commits from the linearized1905# history that annotate should know about. This prevents1906# git-jsannotate telling us about commits we are hiding1907# from the client.19081909my$a_hints="$work->{workDir}/.annotate_hints";1910if(!open(ANNOTATEHINTS,'>',$a_hints)) {1911print"E failed to open '$a_hints' for writing:$!\n";1912return;1913}1914for(my$i=0;$i<@$revisions;$i++)1915{1916print ANNOTATEHINTS $revisions->[$i][2];1917if($i+1<@$revisions) {# have we got a parent?1918print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1919}1920print ANNOTATEHINTS "\n";1921}19221923print ANNOTATEHINTS "\n";1924close ANNOTATEHINTS1925or(print"E failed to write$a_hints:$!\n"),return;19261927my@cmd= (qw(git annotate -l -S),$a_hints,$filename);1928if(!open(ANNOTATE,"-|",@cmd)) {1929print"E error invoking ".join(' ',@cmd) .":$!\n";1930return;1931}1932my$metadata= {};1933print"E Annotations for$filename\n";1934print"E ***************\n";1935while( <ANNOTATE> )1936{1937if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1938{1939my$commithash=$1;1940my$data=$2;1941unless(defined($metadata->{$commithash} ) )1942{1943$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1944$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});1945$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1946}1947printf("M 1.%-5d (%-8s%10s):%s\n",1948$metadata->{$commithash}{revision},1949$metadata->{$commithash}{author},1950$metadata->{$commithash}{modified},1951$data1952);1953}else{1954$log->warn("Error in annotate output! LINE:$_");1955print"E Annotate error\n";1956next;1957}1958}1959close ANNOTATE;1960}19611962# done; get out of the tempdir1963 cleanupWorkTree();19641965print"ok\n";19661967}19681969# This method takes the state->{arguments} array and produces two new arrays.1970# The first is $state->{args} which is everything before the '--' argument, and1971# the second is $state->{files} which is everything after it.1972sub argsplit1973{1974$state->{args} = [];1975$state->{files} = [];1976$state->{opt} = {};19771978return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");19791980my$type=shift;19811982if(defined($type) )1983{1984my$opt= {};1985$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");1986$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1987$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");1988$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1989$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1990$opt= { k =>1, m =>1}if($typeeq"add");1991$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1992$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");199319941995while(scalar( @{$state->{arguments}} ) >0)1996{1997my$arg=shift@{$state->{arguments}};19981999next if($argeq"--");2000next unless($arg=~/\S/);20012002# if the argument looks like a switch2003if($arg=~/^-(\w)(.*)/)2004{2005# if it's a switch that takes an argument2006if($opt->{$1} )2007{2008# If this switch has already been provided2009if($opt->{$1} >1and exists($state->{opt}{$1} ) )2010{2011$state->{opt}{$1} = [$state->{opt}{$1} ];2012if(length($2) >0)2013{2014push@{$state->{opt}{$1}},$2;2015}else{2016push@{$state->{opt}{$1}},shift@{$state->{arguments}};2017}2018}else{2019# if there's extra data in the arg, use that as the argument for the switch2020if(length($2) >0)2021{2022$state->{opt}{$1} =$2;2023}else{2024$state->{opt}{$1} =shift@{$state->{arguments}};2025}2026}2027}else{2028$state->{opt}{$1} =undef;2029}2030}2031else2032{2033push@{$state->{args}},$arg;2034}2035}2036}2037else2038{2039my$mode=0;20402041foreachmy$value( @{$state->{arguments}} )2042{2043if($valueeq"--")2044{2045$mode++;2046next;2047}2048push@{$state->{args}},$valueif($mode==0);2049push@{$state->{files}},$valueif($mode==1);2050}2051}2052}20532054# This method uses $state->{directory} to populate $state->{args} with a list of filenames2055sub argsfromdir2056{2057my$updater=shift;20582059$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");20602061return if(scalar( @{$state->{args}} ) >1);20622063my@gethead= @{$updater->gethead};20642065# push added files2066foreachmy$file(keys%{$state->{entries}}) {2067if(exists$state->{entries}{$file}{revision} &&2068$state->{entries}{$file}{revision} ==0)2069{2070push@gethead, { name =>$file, filehash =>'added'};2071}2072}20732074if(scalar(@{$state->{args}}) ==1)2075{2076my$arg=$state->{args}[0];2077$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );20782079$log->info("Only one arg specified, checking for directory expansion on '$arg'");20802081foreachmy$file(@gethead)2082{2083next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2084next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);2085push@{$state->{args}},$file->{name};2086}20872088shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);2089}else{2090$log->info("Only one arg specified, populating file list automatically");20912092$state->{args} = [];20932094foreachmy$file(@gethead)2095{2096next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2097next unless($file->{name} =~s/^$state->{prependdir}//);2098push@{$state->{args}},$file->{name};2099}2100}2101}21022103# This method cleans up the $state variable after a command that uses arguments has run2104sub statecleanup2105{2106$state->{files} = [];2107$state->{args} = [];2108$state->{arguments} = [];2109$state->{entries} = {};2110}21112112sub revparse2113{2114my$filename=shift;21152116returnundefunless(defined($state->{entries}{$filename}{revision} ) );21172118return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);2119return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);21202121returnundef;2122}21232124# This method takes a file hash and does a CVS "file transfer". Its2125# exact behaviour depends on a second, optional hash table argument:2126# - If $options->{targetfile}, dump the contents to that file;2127# - If $options->{print}, use M/MT to transmit the contents one line2128# at a time;2129# - Otherwise, transmit the size of the file, followed by the file2130# contents.2131sub transmitfile2132{2133my$filehash=shift;2134my$options=shift;21352136if(defined($filehash)and$filehasheq"deleted")2137{2138$log->warn("filehash is 'deleted'");2139return;2140}21412142die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);21432144my$type=`git cat-file -t$filehash`;2145 chomp$type;21462147 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );21482149 my$size= `git cat-file -s $filehash`;2150chomp$size;21512152$log->debug("transmitfile($filehash) size=$size, type=$type");21532154if(open my$fh,'-|',"git","cat-file","blob",$filehash)2155{2156if(defined($options->{targetfile} ) )2157{2158my$targetfile=$options->{targetfile};2159open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2160print NEWFILE $_while( <$fh> );2161close NEWFILE or die("Failed to write '$targetfile':$!");2162}elsif(defined($options->{print} ) &&$options->{print} ) {2163while( <$fh> ) {2164if(/\n\z/) {2165print'M ',$_;2166}else{2167print'MT text ',$_,"\n";2168}2169}2170}else{2171print"$size\n";2172printwhile( <$fh> );2173}2174close$fhor die("Couldn't close filehandle for transmitfile():$!");2175}else{2176die("Couldn't execute git-cat-file");2177}2178}21792180# This method takes a file name, and returns ( $dirpart, $filepart ) which2181# refers to the directory portion and the file portion of the filename2182# respectively2183sub filenamesplit2184{2185my$filename=shift;2186my$fixforlocaldir=shift;21872188my($filepart,$dirpart) = ($filename,".");2189($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2190$dirpart.="/";21912192if($fixforlocaldir)2193{2194$dirpart=~s/^$state->{prependdir}//;2195}21962197return($filepart,$dirpart);2198}21992200sub filecleanup2201{2202my$filename=shift;22032204returnundefunless(defined($filename));2205if($filename=~/^\// )2206{2207print"E absolute filenames '$filename' not supported by server\n";2208returnundef;2209}22102211$filename=~s/^\.\///g;2212$filename=$state->{prependdir} .$filename;2213return$filename;2214}22152216sub validateGitDir2217{2218if( !defined($state->{CVSROOT}) )2219{2220print"error 1 CVSROOT not specified\n";2221 cleanupWorkTree();2222exit;2223}2224if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2225{2226print"error 1 Internally inconsistent CVSROOT\n";2227 cleanupWorkTree();2228exit;2229}2230}22312232# Setup working directory in a work tree with the requested version2233# loaded in the index.2234sub setupWorkTree2235{2236my($ver) =@_;22372238 validateGitDir();22392240if( (defined($work->{state}) &&$work->{state} !=1) ||2241defined($work->{tmpDir}) )2242{2243$log->warn("Bad work tree state management");2244print"error 1 Internal setup multiple work trees without cleanup\n";2245 cleanupWorkTree();2246exit;2247}22482249$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);22502251if( !defined($work->{index}) )2252{2253(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2254}22552256chdir$work->{workDir}or2257die"Unable to chdir to$work->{workDir}\n";22582259$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");22602261$ENV{GIT_WORK_TREE} =".";2262$ENV{GIT_INDEX_FILE} =$work->{index};2263$work->{state} =2;22642265if($ver)2266{2267system("git","read-tree",$ver);2268unless($?==0)2269{2270$log->warn("Error running git-read-tree");2271die"Error running git-read-tree$verin$work->{workDir}$!\n";2272}2273}2274# else # req_annotate reads tree for each file2275}22762277# Ensure current directory is in some kind of working directory,2278# with a recent version loaded in the index.2279sub ensureWorkTree2280{2281if(defined($work->{tmpDir}) )2282{2283$log->warn("Bad work tree state management [ensureWorkTree()]");2284print"error 1 Internal setup multiple dirs without cleanup\n";2285 cleanupWorkTree();2286exit;2287}2288if($work->{state} )2289{2290return;2291}22922293 validateGitDir();22942295if( !defined($work->{emptyDir}) )2296{2297$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);2298}2299chdir$work->{emptyDir}or2300die"Unable to chdir to$work->{emptyDir}\n";23012302my$ver=`git show-ref -s refs/heads/$state->{module}`;2303chomp$ver;2304if($ver!~/^[0-9a-f]{40}$/)2305{2306$log->warn("Error from git show-ref -s refs/head$state->{module}");2307print"error 1 cannot find the current HEAD of module";2308 cleanupWorkTree();2309exit;2310}23112312if( !defined($work->{index}) )2313{2314(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2315}23162317$ENV{GIT_WORK_TREE} =".";2318$ENV{GIT_INDEX_FILE} =$work->{index};2319$work->{state} =1;23202321system("git","read-tree",$ver);2322unless($?==0)2323{2324die"Error running git-read-tree$ver$!\n";2325}2326}23272328# Cleanup working directory that is not needed any longer.2329sub cleanupWorkTree2330{2331if( !$work->{state} )2332{2333return;2334}23352336chdir"/"or die"Unable to chdir '/'\n";23372338if(defined($work->{workDir}) )2339{2340 rmtree($work->{workDir} );2341undef$work->{workDir};2342}2343undef$work->{state};2344}23452346# Setup a temporary directory (not a working tree), typically for2347# merging dirty state as in req_update.2348sub setupTmpDir2349{2350$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);2351chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";23522353return$work->{tmpDir};2354}23552356# Clean up a previously setupTmpDir. Restore previous work tree if2357# appropriate.2358sub cleanupTmpDir2359{2360if( !defined($work->{tmpDir}) )2361{2362$log->warn("cleanup tmpdir that has not been setup");2363die"Cleanup tmpDir that has not been setup\n";2364}2365if(defined($work->{state}) )2366{2367if($work->{state} ==1)2368{2369chdir$work->{emptyDir}or2370die"Unable to chdir to$work->{emptyDir}\n";2371}2372elsif($work->{state} ==2)2373{2374chdir$work->{workDir}or2375die"Unable to chdir to$work->{emptyDir}\n";2376}2377else2378{2379$log->warn("Inconsistent work dir state");2380die"Inconsistent work dir state\n";2381}2382}2383else2384{2385chdir"/"or die"Unable to chdir '/'\n";2386}2387}23882389# Given a path, this function returns a string containing the kopts2390# that should go into that path's Entries line. For example, a binary2391# file should get -kb.2392sub kopts_from_path2393{2394my($path,$srcType,$name) =@_;23952396if(defined($cfg->{gitcvs}{usecrlfattr} )and2397$cfg->{gitcvs}{usecrlfattr} =~/\s*(1|true|yes)\s*$/i)2398{2399my($val) = check_attr("crlf",$path);2400if($valeq"set")2401{2402return"";2403}2404elsif($valeq"unset")2405{2406return"-kb"2407}2408else2409{2410$log->info("Unrecognized check_attr crlf$path:$val");2411}2412}24132414if(defined($cfg->{gitcvs}{allbinary} ) )2415{2416if( ($cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i) )2417{2418return"-kb";2419}2420elsif( ($cfg->{gitcvs}{allbinary} =~/^\s*guess\s*$/i) )2421{2422if($srcTypeeq"sha1Or-k"&&2423!defined($name) )2424{2425my($ret)=$state->{entries}{$path}{options};2426if( !defined($ret) )2427{2428$ret=$state->{opt}{k};2429if(defined($ret))2430{2431$ret="-k$ret";2432}2433else2434{2435$ret="";2436}2437}2438if( ! ($ret=~/^(|-kb|-kkv|-kkvl|-kk|-ko|-kv)$/) )2439{2440print"E Bad -k option\n";2441$log->warn("Bad -k option:$ret");2442die"Error: Bad -k option:$ret\n";2443}24442445return$ret;2446}2447else2448{2449if( is_binary($srcType,$name) )2450{2451$log->debug("... as binary");2452return"-kb";2453}2454else2455{2456$log->debug("... as text");2457}2458}2459}2460}2461# Return "" to give no special treatment to any path2462return"";2463}24642465sub check_attr2466{2467my($attr,$path) =@_;2468 ensureWorkTree();2469if(open my$fh,'-|',"git","check-attr",$attr,"--",$path)2470{2471my$val= <$fh>;2472close$fh;2473$val=~s/.*: ([^:\r\n]*)\s*$/$1/;2474return$val;2475}2476else2477{2478returnundef;2479}2480}24812482# This should have the same heuristics as convert.c:is_binary() and related.2483# Note that the bare CR test is done by callers in convert.c.2484sub is_binary2485{2486my($srcType,$name) =@_;2487$log->debug("is_binary($srcType,$name)");24882489# Minimize amount of interpreted code run in the inner per-character2490# loop for large files, by totalling each character value and2491# then analyzing the totals.2492my@counts;2493my$i;2494for($i=0;$i<256;$i++)2495{2496$counts[$i]=0;2497}24982499my$fh= open_blob_or_die($srcType,$name);2500my$line;2501while(defined($line=<$fh>) )2502{2503# Any '\0' and bare CR are considered binary.2504if($line=~/\0|(\r[^\n])/)2505{2506close($fh);2507return1;2508}25092510# Count up each character in the line:2511my$len=length($line);2512for($i=0;$i<$len;$i++)2513{2514$counts[ord(substr($line,$i,1))]++;2515}2516}2517close$fh;25182519# Don't count CR and LF as either printable/nonprintable2520$counts[ord("\n")]=0;2521$counts[ord("\r")]=0;25222523# Categorize individual character count into printable and nonprintable:2524my$printable=0;2525my$nonprintable=0;2526for($i=0;$i<256;$i++)2527{2528if($i<32&&2529$i!=ord("\b") &&2530$i!=ord("\t") &&2531$i!=033&&# ESC2532$i!=014)# FF2533{2534$nonprintable+=$counts[$i];2535}2536elsif($i==127)# DEL2537{2538$nonprintable+=$counts[$i];2539}2540else2541{2542$printable+=$counts[$i];2543}2544}25452546return($printable>>7) <$nonprintable;2547}25482549# Returns open file handle. Possible invocations:2550# - open_blob_or_die("file",$filename);2551# - open_blob_or_die("sha1",$filehash);2552sub open_blob_or_die2553{2554my($srcType,$name) =@_;2555my($fh);2556if($srcTypeeq"file")2557{2558if( !open$fh,"<",$name)2559{2560$log->warn("Unable to open file$name:$!");2561die"Unable to open file$name:$!\n";2562}2563}2564elsif($srcTypeeq"sha1"||$srcTypeeq"sha1Or-k")2565{2566unless(defined($name)and$name=~/^[a-zA-Z0-9]{40}$/)2567{2568$log->warn("Need filehash");2569die"Need filehash\n";2570}25712572my$type=`git cat-file -t$name`;2573 chomp$type;25742575 unless ( defined ($type) and$typeeq "blob" )2576 {2577$log->warn("Invalid type '$type' for '$name'");2578 die ( "Invalid type '$type' (expected 'blob')" )2579 }25802581 my$size= `git cat-file -s $name`;2582chomp$size;25832584$log->debug("open_blob_or_die($name) size=$size, type=$type");25852586unless(open$fh,'-|',"git","cat-file","blob",$name)2587{2588$log->warn("Unable to open sha1$name");2589die"Unable to open sha1$name\n";2590}2591}2592else2593{2594$log->warn("Unknown type of blob source:$srcType");2595die"Unknown type of blob source:$srcType\n";2596}2597return$fh;2598}25992600# Generate a CVS author name from Git author information, by taking the local2601# part of the email address and replacing characters not in the Portable2602# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS2603# Login names are Unix login names, which should be restricted to this2604# character set.2605sub cvs_author2606{2607my$author_line=shift;2608(my$author) =$author_line=~/<([^@>]*)/;26092610$author=~s/[^-a-zA-Z0-9_.]/_/g;2611$author=~s/^-/_/;26122613$author;2614}261526162617sub descramble2618{2619# This table is from src/scramble.c in the CVS source2620my@SHIFTS= (26210,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,262216,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,2623114,120,53,79,96,109,72,108,70,64,76,67,116,74,68,87,2624111,52,75,119,49,34,82,81,95,65,112,86,118,110,122,105,262541,57,83,43,46,102,40,89,38,103,45,50,42,123,91,35,2626125,55,54,66,124,126,59,47,92,71,115,78,88,107,106,56,262736,121,117,104,101,100,69,73,99,63,94,93,39,37,61,48,262858,113,32,90,44,98,60,51,33,97,62,77,84,80,85,223,2629225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,2630199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,2631174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,2632207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,2633192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,2634227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,2635182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,2636243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,1522637);2638my($str) =@_;26392640# This should never happen, the same password format (A) bas been2641# used by CVS since the beginning of time2642die"invalid password format$1"unlesssubstr($str,0,1)eq'A';26432644my@str=unpack"C*",substr($str,1);2645my$ret=join'',map{chr$SHIFTS[$_] }@str;2646return$ret;2647}264826492650package GITCVS::log;26512652####2653#### Copyright The Open University UK - 2006.2654####2655#### Authors: Martyn Smith <martyn@catalyst.net.nz>2656#### Martin Langhoff <martin@catalyst.net.nz>2657####2658####26592660use strict;2661use warnings;26622663=head1 NAME26642665GITCVS::log26662667=head1 DESCRIPTION26682669This module provides very crude logging with a similar interface to2670Log::Log4perl26712672=head1 METHODS26732674=cut26752676=head2 new26772678Creates a new log object, optionally you can specify a filename here to2679indicate the file to log to. If no log file is specified, you can specify one2680later with method setfile, or indicate you no longer want logging with method2681nofile.26822683Until one of these methods is called, all log calls will buffer messages ready2684to write out.26852686=cut2687sub new2688{2689my$class=shift;2690my$filename=shift;26912692my$self= {};26932694bless$self,$class;26952696if(defined($filename) )2697{2698open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2699}27002701return$self;2702}27032704=head2 setfile27052706This methods takes a filename, and attempts to open that file as the log file.2707If successful, all buffered data is written out to the file, and any further2708logging is written directly to the file.27092710=cut2711sub setfile2712{2713my$self=shift;2714my$filename=shift;27152716if(defined($filename) )2717{2718open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2719}27202721return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");27222723while(my$line=shift@{$self->{buffer}} )2724{2725print{$self->{fh}}$line;2726}2727}27282729=head2 nofile27302731This method indicates no logging is going to be used. It flushes any entries in2732the internal buffer, and sets a flag to ensure no further data is put there.27332734=cut2735sub nofile2736{2737my$self=shift;27382739$self->{nolog} =1;27402741return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");27422743$self->{buffer} = [];2744}27452746=head2 _logopen27472748Internal method. Returns true if the log file is open, false otherwise.27492750=cut2751sub _logopen2752{2753my$self=shift;27542755return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2756return0;2757}27582759=head2 debug info warn fatal27602761These four methods are wrappers to _log. They provide the actual interface for2762logging data.27632764=cut2765sub debug {my$self=shift;$self->_log("debug",@_); }2766sub info {my$self=shift;$self->_log("info",@_); }2767subwarn{my$self=shift;$self->_log("warn",@_); }2768sub fatal {my$self=shift;$self->_log("fatal",@_); }27692770=head2 _log27712772This is an internal method called by the logging functions. It generates a2773timestamp and pushes the logged line either to file, or internal buffer.27742775=cut2776sub _log2777{2778my$self=shift;2779my$level=shift;27802781return if($self->{nolog} );27822783my@time=localtime;2784my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2785$time[5] +1900,2786$time[4] +1,2787$time[3],2788$time[2],2789$time[1],2790$time[0],2791uc$level,2792);27932794if($self->_logopen)2795{2796print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2797}else{2798push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2799}2800}28012802=head2 DESTROY28032804This method simply closes the file handle if one is open28052806=cut2807sub DESTROY2808{2809my$self=shift;28102811if($self->_logopen)2812{2813close$self->{fh};2814}2815}28162817package GITCVS::updater;28182819####2820#### Copyright The Open University UK - 2006.2821####2822#### Authors: Martyn Smith <martyn@catalyst.net.nz>2823#### Martin Langhoff <martin@catalyst.net.nz>2824####2825####28262827use strict;2828use warnings;2829use DBI;28302831=head1 METHODS28322833=cut28342835=head2 new28362837=cut2838sub new2839{2840my$class=shift;2841my$config=shift;2842my$module=shift;2843my$log=shift;28442845die"Need to specify a git repository"unless(defined($config)and-d $config);2846die"Need to specify a module"unless(defined($module) );28472848$class=ref($class) ||$class;28492850my$self= {};28512852bless$self,$class;28532854$self->{valid_tables} = {'revision'=>1,2855'revision_ix1'=>1,2856'revision_ix2'=>1,2857'head'=>1,2858'head_ix1'=>1,2859'properties'=>1,2860'commitmsgs'=>1};28612862$self->{module} =$module;2863$self->{git_path} =$config."/";28642865$self->{log} =$log;28662867die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );28682869$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2870$cfg->{gitcvs}{dbdriver} ||"SQLite";2871$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2872$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2873$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2874$cfg->{gitcvs}{dbuser} ||"";2875$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2876$cfg->{gitcvs}{dbpass} ||"";2877$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||2878$cfg->{gitcvs}{dbtablenameprefix} ||"";2879my%mapping= ( m =>$module,2880 a =>$state->{method},2881 u =>getlogin||getpwuid($<) || $<,2882 G =>$self->{git_path},2883 g => mangle_dirname($self->{git_path}),2884);2885$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2886$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;2887$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;2888$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});28892890die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2891die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2892$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2893$self->{dbuser},2894$self->{dbpass});2895die"Error connecting to database\n"unlessdefined$self->{dbh};28962897$self->{tables} = {};2898foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2899{2900$self->{tables}{$table} =1;2901}29022903# Construct the revision table if required2904unless($self->{tables}{$self->tablename("revision")} )2905{2906my$tablename=$self->tablename("revision");2907my$ix1name=$self->tablename("revision_ix1");2908my$ix2name=$self->tablename("revision_ix2");2909$self->{dbh}->do("2910 CREATE TABLE$tablename(2911 name TEXT NOT NULL,2912 revision INTEGER NOT NULL,2913 filehash TEXT NOT NULL,2914 commithash TEXT NOT NULL,2915 author TEXT NOT NULL,2916 modified TEXT NOT NULL,2917 mode TEXT NOT NULL2918 )2919 ");2920$self->{dbh}->do("2921 CREATE INDEX$ix1name2922 ON$tablename(name,revision)2923 ");2924$self->{dbh}->do("2925 CREATE INDEX$ix2name2926 ON$tablename(name,commithash)2927 ");2928}29292930# Construct the head table if required2931unless($self->{tables}{$self->tablename("head")} )2932{2933my$tablename=$self->tablename("head");2934my$ix1name=$self->tablename("head_ix1");2935$self->{dbh}->do("2936 CREATE TABLE$tablename(2937 name TEXT NOT NULL,2938 revision INTEGER NOT NULL,2939 filehash TEXT NOT NULL,2940 commithash TEXT NOT NULL,2941 author TEXT NOT NULL,2942 modified TEXT NOT NULL,2943 mode TEXT NOT NULL2944 )2945 ");2946$self->{dbh}->do("2947 CREATE INDEX$ix1name2948 ON$tablename(name)2949 ");2950}29512952# Construct the properties table if required2953unless($self->{tables}{$self->tablename("properties")} )2954{2955my$tablename=$self->tablename("properties");2956$self->{dbh}->do("2957 CREATE TABLE$tablename(2958 key TEXT NOT NULL PRIMARY KEY,2959 value TEXT2960 )2961 ");2962}29632964# Construct the commitmsgs table if required2965unless($self->{tables}{$self->tablename("commitmsgs")} )2966{2967my$tablename=$self->tablename("commitmsgs");2968$self->{dbh}->do("2969 CREATE TABLE$tablename(2970 key TEXT NOT NULL PRIMARY KEY,2971 value TEXT2972 )2973 ");2974}29752976return$self;2977}29782979=head2 tablename29802981=cut2982sub tablename2983{2984my$self=shift;2985my$name=shift;29862987if(exists$self->{valid_tables}{$name}) {2988return$self->{dbtablenameprefix} .$name;2989}else{2990returnundef;2991}2992}29932994=head2 update29952996=cut2997sub update2998{2999my$self=shift;30003001# first lets get the commit list3002$ENV{GIT_DIR} =$self->{git_path};30033004my$commitsha1=`git rev-parse$self->{module}`;3005chomp$commitsha1;30063007my$commitinfo=`git cat-file commit$self->{module} 2>&1`;3008unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)3009{3010die("Invalid module '$self->{module}'");3011}301230133014my$git_log;3015my$lastcommit=$self->_get_prop("last_commit");30163017if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date3018return1;3019}30203021# Start exclusive lock here...3022$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";30233024# TODO: log processing is memory bound3025# if we can parse into a 2nd file that is in reverse order3026# we can probably do something really efficient3027my@git_log_params= ('--pretty','--parents','--topo-order');30283029if(defined$lastcommit) {3030push@git_log_params,"$lastcommit..$self->{module}";3031}else{3032push@git_log_params,$self->{module};3033}3034# git-rev-list is the backend / plumbing version of git-log3035open(GITLOG,'-|','git','rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";30363037my@commits;30383039my%commit= ();30403041while( <GITLOG> )3042{3043chomp;3044if(m/^commit\s+(.*)$/) {3045# on ^commit lines put the just seen commit in the stack3046# and prime things for the next one3047if(keys%commit) {3048my%copy=%commit;3049unshift@commits, \%copy;3050%commit= ();3051}3052my@parents=split(m/\s+/,$1);3053$commit{hash} =shift@parents;3054$commit{parents} = \@parents;3055}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {3056# on rfc822-like lines seen before we see any message,3057# lowercase the entry and put it in the hash as key-value3058$commit{lc($1)} =$2;3059}else{3060# message lines - skip initial empty line3061# and trim whitespace3062if(!exists($commit{message}) &&m/^\s*$/) {3063# define it to mark the end of headers3064$commit{message} ='';3065next;3066}3067s/^\s+//;s/\s+$//;# trim ws3068$commit{message} .=$_."\n";3069}3070}3071close GITLOG;30723073unshift@commits, \%commitif(keys%commit);30743075# Now all the commits are in the @commits bucket3076# ordered by time DESC. for each commit that needs processing,3077# determine whether it's following the last head we've seen or if3078# it's on its own branch, grab a file list, and add whatever's changed3079# NOTE: $lastcommit refers to the last commit from previous run3080# $lastpicked is the last commit we picked in this run3081my$lastpicked;3082my$head= {};3083if(defined$lastcommit) {3084$lastpicked=$lastcommit;3085}30863087my$committotal=scalar(@commits);3088my$commitcount=0;30893090# Load the head table into $head (for cached lookups during the update process)3091foreachmy$file( @{$self->gethead()} )3092{3093$head->{$file->{name}} =$file;3094}30953096foreachmy$commit(@commits)3097{3098$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3099if(defined$lastpicked)3100{3101if(!in_array($lastpicked, @{$commit->{parents}}))3102{3103# skip, we'll see this delta3104# as part of a merge later3105# warn "skipping off-track $commit->{hash}\n";3106next;3107}elsif(@{$commit->{parents}} >1) {3108# it is a merge commit, for each parent that is3109# not $lastpicked, see if we can get a log3110# from the merge-base to that parent to put it3111# in the message as a merge summary.3112my@parents= @{$commit->{parents}};3113foreachmy$parent(@parents) {3114# git-merge-base can potentially (but rarely) throw3115# several candidate merge bases. let's assume3116# that the first one is the best one.3117if($parenteq$lastpicked) {3118next;3119}3120my$base=eval{3121 safe_pipe_capture('git','merge-base',3122$lastpicked,$parent);3123};3124# The two branches may not be related at all,3125# in which case merge base simply fails to find3126# any, but that's Ok.3127next if($@);31283129chomp$base;3130if($base) {3131my@merged;3132# print "want to log between $base $parent \n";3133open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3134or die"Cannot call git-log:$!";3135my$mergedhash;3136while(<GITLOG>) {3137chomp;3138if(!defined$mergedhash) {3139if(m/^commit\s+(.+)$/) {3140$mergedhash=$1;3141}else{3142next;3143}3144}else{3145# grab the first line that looks non-rfc8223146# aka has content after leading space3147if(m/^\s+(\S.*)$/) {3148my$title=$1;3149$title=substr($title,0,100);# truncate3150unshift@merged,"$mergedhash$title";3151undef$mergedhash;3152}3153}3154}3155close GITLOG;3156if(@merged) {3157$commit->{mergemsg} =$commit->{message};3158$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3159foreachmy$summary(@merged) {3160$commit->{mergemsg} .="\t$summary\n";3161}3162$commit->{mergemsg} .="\n\n";3163# print "Message for $commit->{hash} \n$commit->{mergemsg}";3164}3165}3166}3167}3168}31693170# convert the date to CVS-happy format3171$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);31723173if(defined($lastpicked) )3174{3175my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3176local($/) ="\0";3177while( <FILELIST> )3178{3179chomp;3180unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)3181{3182die("Couldn't process git-diff-tree line :$_");3183}3184my($mode,$hash,$change) = ($1,$2,$3);3185my$name= <FILELIST>;3186chomp($name);31873188# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");31893190my$git_perms="";3191$git_perms.="r"if($mode&4);3192$git_perms.="w"if($mode&2);3193$git_perms.="x"if($mode&1);3194$git_perms="rw"if($git_permseq"");31953196if($changeeq"D")3197{3198#$log->debug("DELETE $name");3199$head->{$name} = {3200 name =>$name,3201 revision =>$head->{$name}{revision} +1,3202 filehash =>"deleted",3203 commithash =>$commit->{hash},3204 modified =>$commit->{date},3205 author =>$commit->{author},3206 mode =>$git_perms,3207};3208$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3209}3210elsif($changeeq"M"||$changeeq"T")3211{3212#$log->debug("MODIFIED $name");3213$head->{$name} = {3214 name =>$name,3215 revision =>$head->{$name}{revision} +1,3216 filehash =>$hash,3217 commithash =>$commit->{hash},3218 modified =>$commit->{date},3219 author =>$commit->{author},3220 mode =>$git_perms,3221};3222$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3223}3224elsif($changeeq"A")3225{3226#$log->debug("ADDED $name");3227$head->{$name} = {3228 name =>$name,3229 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3230 filehash =>$hash,3231 commithash =>$commit->{hash},3232 modified =>$commit->{date},3233 author =>$commit->{author},3234 mode =>$git_perms,3235};3236$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3237}3238else3239{3240$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");3241die;3242}3243}3244close FILELIST;3245}else{3246# this is used to detect files removed from the repo3247my$seen_files= {};32483249my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");3250local$/="\0";3251while( <FILELIST> )3252{3253chomp;3254unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)3255{3256die("Couldn't process git-ls-tree line :$_");3257}32583259my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);32603261$seen_files->{$git_filename} =1;32623263my($oldhash,$oldrevision,$oldmode) = (3264$head->{$git_filename}{filehash},3265$head->{$git_filename}{revision},3266$head->{$git_filename}{mode}3267);32683269if($git_perms=~/^\d\d\d(\d)\d\d/o)3270{3271$git_perms="";3272$git_perms.="r"if($1&4);3273$git_perms.="w"if($1&2);3274$git_perms.="x"if($1&1);3275}else{3276$git_perms="rw";3277}32783279# unless the file exists with the same hash, we need to update it ...3280unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)3281{3282my$newrevision= ($oldrevisionor0) +1;32833284$head->{$git_filename} = {3285 name =>$git_filename,3286 revision =>$newrevision,3287 filehash =>$git_hash,3288 commithash =>$commit->{hash},3289 modified =>$commit->{date},3290 author =>$commit->{author},3291 mode =>$git_perms,3292};329332943295$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3296}3297}3298close FILELIST;32993300# Detect deleted files3301foreachmy$file(keys%$head)3302{3303unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")3304{3305$head->{$file}{revision}++;3306$head->{$file}{filehash} ="deleted";3307$head->{$file}{commithash} =$commit->{hash};3308$head->{$file}{modified} =$commit->{date};3309$head->{$file}{author} =$commit->{author};33103311$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});3312}3313}3314# END : "Detect deleted files"3315}331633173318if(exists$commit->{mergemsg})3319{3320$self->insert_mergelog($commit->{hash},$commit->{mergemsg});3321}33223323$lastpicked=$commit->{hash};33243325$self->_set_prop("last_commit",$commit->{hash});3326}33273328$self->delete_head();3329foreachmy$file(keys%$head)3330{3331$self->insert_head(3332$file,3333$head->{$file}{revision},3334$head->{$file}{filehash},3335$head->{$file}{commithash},3336$head->{$file}{modified},3337$head->{$file}{author},3338$head->{$file}{mode},3339);3340}3341# invalidate the gethead cache3342$self->{gethead_cache} =undef;334333443345# Ending exclusive lock here3346$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3347}33483349sub insert_rev3350{3351my$self=shift;3352my$name=shift;3353my$revision=shift;3354my$filehash=shift;3355my$commithash=shift;3356my$modified=shift;3357my$author=shift;3358my$mode=shift;3359my$tablename=$self->tablename("revision");33603361my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3362$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3363}33643365sub insert_mergelog3366{3367my$self=shift;3368my$key=shift;3369my$value=shift;3370my$tablename=$self->tablename("commitmsgs");33713372my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3373$insert_mergelog->execute($key,$value);3374}33753376sub delete_head3377{3378my$self=shift;3379my$tablename=$self->tablename("head");33803381my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3382$delete_head->execute();3383}33843385sub insert_head3386{3387my$self=shift;3388my$name=shift;3389my$revision=shift;3390my$filehash=shift;3391my$commithash=shift;3392my$modified=shift;3393my$author=shift;3394my$mode=shift;3395my$tablename=$self->tablename("head");33963397my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3398$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3399}34003401sub _headrev3402{3403my$self=shift;3404my$filename=shift;3405my$tablename=$self->tablename("head");34063407my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM$tablenameWHERE name=?",{},1);3408$db_query->execute($filename);3409my($hash,$revision,$mode) =$db_query->fetchrow_array;34103411return($hash,$revision,$mode);3412}34133414sub _get_prop3415{3416my$self=shift;3417my$key=shift;3418my$tablename=$self->tablename("properties");34193420my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3421$db_query->execute($key);3422my($value) =$db_query->fetchrow_array;34233424return$value;3425}34263427sub _set_prop3428{3429my$self=shift;3430my$key=shift;3431my$value=shift;3432my$tablename=$self->tablename("properties");34333434my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3435$db_query->execute($value,$key);34363437unless($db_query->rows)3438{3439$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3440$db_query->execute($key,$value);3441}34423443return$value;3444}34453446=head2 gethead34473448=cut34493450sub gethead3451{3452my$self=shift;3453my$tablename=$self->tablename("head");34543455return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );34563457my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3458$db_query->execute();34593460my$tree= [];3461while(my$file=$db_query->fetchrow_hashref)3462{3463push@$tree,$file;3464}34653466$self->{gethead_cache} =$tree;34673468return$tree;3469}34703471=head2 getlog34723473=cut34743475sub getlog3476{3477my$self=shift;3478my$filename=shift;3479my$tablename=$self->tablename("revision");34803481my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3482$db_query->execute($filename);34833484my$tree= [];3485while(my$file=$db_query->fetchrow_hashref)3486{3487push@$tree,$file;3488}34893490return$tree;3491}34923493=head2 getmeta34943495This function takes a filename (with path) argument and returns a hashref of3496metadata for that file.34973498=cut34993500sub getmeta3501{3502my$self=shift;3503my$filename=shift;3504my$revision=shift;3505my$tablename_rev=$self->tablename("revision");3506my$tablename_head=$self->tablename("head");35073508my$db_query;3509if(defined($revision)and$revision=~/^\d+$/)3510{3511$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND revision=?",{},1);3512$db_query->execute($filename,$revision);3513}3514elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)3515{3516$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND commithash=?",{},1);3517$db_query->execute($filename,$revision);3518}else{3519$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_headWHERE name=?",{},1);3520$db_query->execute($filename);3521}35223523return$db_query->fetchrow_hashref;3524}35253526=head2 commitmessage35273528this function takes a commithash and returns the commit message for that commit35293530=cut3531sub commitmessage3532{3533my$self=shift;3534my$commithash=shift;3535my$tablename=$self->tablename("commitmsgs");35363537die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);35383539my$db_query;3540$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3541$db_query->execute($commithash);35423543my($message) =$db_query->fetchrow_array;35443545if(defined($message) )3546{3547$message.=" "if($message=~/\n$/);3548return$message;3549}35503551my@lines= safe_pipe_capture("git","cat-file","commit",$commithash);3552shift@lineswhile($lines[0] =~/\S/);3553$message=join("",@lines);3554$message.=" "if($message=~/\n$/);3555return$message;3556}35573558=head2 gethistory35593560This function takes a filename (with path) argument and returns an arrayofarrays3561containing revision,filehash,commithash ordered by revision descending35623563=cut3564sub gethistory3565{3566my$self=shift;3567my$filename=shift;3568my$tablename=$self->tablename("revision");35693570my$db_query;3571$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3572$db_query->execute($filename);35733574return$db_query->fetchall_arrayref;3575}35763577=head2 gethistorydense35783579This function takes a filename (with path) argument and returns an arrayofarrays3580containing revision,filehash,commithash ordered by revision descending.35813582This version of gethistory skips deleted entries -- so it is useful for annotate.3583The 'dense' part is a reference to a '--dense' option available for git-rev-list3584and other git tools that depend on it.35853586=cut3587sub gethistorydense3588{3589my$self=shift;3590my$filename=shift;3591my$tablename=$self->tablename("revision");35923593my$db_query;3594$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);3595$db_query->execute($filename);35963597return$db_query->fetchall_arrayref;3598}35993600=head2 in_array()36013602from Array::PAT - mimics the in_array() function3603found in PHP. Yuck but works for small arrays.36043605=cut3606sub in_array3607{3608my($check,@array) =@_;3609my$retval=0;3610foreachmy$test(@array){3611if($checkeq$test){3612$retval=1;3613}3614}3615return$retval;3616}36173618=head2 safe_pipe_capture36193620an alternative to `command` that allows input to be passed as an array3621to work around shell problems with weird characters in arguments36223623=cut3624sub safe_pipe_capture {36253626my@output;36273628if(my$pid=open my$child,'-|') {3629@output= (<$child>);3630close$childor die join(' ',@_).":$!$?";3631}else{3632exec(@_)or die"$!$?";# exec() can fail the executable can't be found3633}3634returnwantarray?@output:join('',@output);3635}36363637=head2 mangle_dirname36383639create a string from a directory name that is suitable to use as3640part of a filename, mainly by converting all chars except \w.- to _36413642=cut3643sub mangle_dirname {3644my$dirname=shift;3645return unlessdefined$dirname;36463647$dirname=~s/[^\w.-]/_/g;36483649return$dirname;3650}36513652=head2 mangle_tablename36533654create a string from a that is suitable to use as part of an SQL table3655name, mainly by converting all chars except \w to _36563657=cut3658sub mangle_tablename {3659my$tablename=shift;3660return unlessdefined$tablename;36613662$tablename=~s/[^\w_]/_/g;36633664return$tablename;3665}366636671;