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'annotate'=> \&req_annotate, 80'Global_option'=> \&req_Globaloption, 81#'annotate' => \&req_CATCHALL, 82}; 83 84############################################## 85 86 87# $state holds all the bits of information the clients sends us that could 88# potentially be useful when it comes to actually _doing_ something. 89my$state= { prependdir =>''}; 90 91# Work is for managing temporary working directory 92my$work= 93{ 94state=>undef,# undef, 1 (empty), 2 (with stuff) 95 workDir =>undef, 96index=>undef, 97 emptyDir =>undef, 98 tmpDir =>undef 99}; 100 101$log->info("--------------- STARTING -----------------"); 102 103my$usage= 104"Usage: git cvsserver [options] [pserver|server] [<directory> ...]\n". 105" --base-path <path> : Prepend to requested CVSROOT\n". 106" --strict-paths : Don't allow recursing into subdirectories\n". 107" --export-all : Don't check for gitcvs.enabled in config\n". 108" --version, -V : Print version information and exit\n". 109" --help, -h, -H : Print usage information and exit\n". 110"\n". 111"<directory> ... is a list of allowed directories. If no directories\n". 112"are given, all are allowed. This is an additional restriction, gitcvs\n". 113"access still needs to be enabled by the gitcvs.enabled config option.\n"; 114 115my@opts= ('help|h|H','version|V', 116'base-path=s','strict-paths','export-all'); 117GetOptions($state,@opts) 118or die$usage; 119 120if($state->{version}) { 121print"git-cvsserver version$VERSION\n"; 122exit; 123} 124if($state->{help}) { 125print$usage; 126exit; 127} 128 129my$TEMP_DIR= tempdir( CLEANUP =>1); 130$log->debug("Temporary directory is '$TEMP_DIR'"); 131 132$state->{method} ='ext'; 133if(@ARGV) { 134if($ARGV[0]eq'pserver') { 135$state->{method} ='pserver'; 136shift@ARGV; 137}elsif($ARGV[0]eq'server') { 138shift@ARGV; 139} 140} 141 142# everything else is a directory 143$state->{allowed_roots} = [@ARGV]; 144 145# don't export the whole system unless the users requests it 146if($state->{'export-all'} && !@{$state->{allowed_roots}}) { 147die"--export-all can only be used together with an explicit whitelist\n"; 148} 149 150# if we are called with a pserver argument, 151# deal with the authentication cat before entering the 152# main loop 153if($state->{method}eq'pserver') { 154my$line= <STDIN>;chomp$line; 155unless($line=~/^BEGIN (AUTH|VERIFICATION) REQUEST$/) { 156die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 157} 158my$request=$1; 159$line= <STDIN>;chomp$line; 160unless(req_Root('root',$line)) {# reuse Root 161print"E Invalid root$line\n"; 162exit1; 163} 164$line= <STDIN>;chomp$line; 165unless($lineeq'anonymous') { 166print"E Only anonymous user allowed via pserver\n"; 167print"I HATE YOU\n"; 168exit1; 169} 170$line= <STDIN>;chomp$line;# validate the password? 171$line= <STDIN>;chomp$line; 172unless($lineeq"END$requestREQUEST") { 173die"E Do not understand$line-- expecting END$requestREQUEST\n"; 174} 175print"I LOVE YOU\n"; 176exit if$requesteq'VERIFICATION';# cvs login 177# and now back to our regular programme... 178} 179 180# Keep going until the client closes the connection 181while(<STDIN>) 182{ 183chomp; 184 185# Check to see if we've seen this method, and call appropriate function. 186if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 187{ 188# use the $methods hash to call the appropriate sub for this command 189#$log->info("Method : $1"); 190&{$methods->{$1}}($1,$2); 191}else{ 192# log fatal because we don't understand this function. If this happens 193# we're fairly screwed because we don't know if the client is expecting 194# a response. If it is, the client will hang, we'll hang, and the whole 195# thing will be custard. 196$log->fatal("Don't understand command$_\n"); 197die("Unknown command$_"); 198} 199} 200 201$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 202$log->info("--------------- FINISH -----------------"); 203 204chdir'/'; 205exit0; 206 207# Magic catchall method. 208# This is the method that will handle all commands we haven't yet 209# implemented. It simply sends a warning to the log file indicating a 210# command that hasn't been implemented has been invoked. 211sub req_CATCHALL 212{ 213my($cmd,$data) =@_; 214$log->warn("Unhandled command : req_$cmd:$data"); 215} 216 217# This method invariably succeeds with an empty response. 218sub req_EMPTY 219{ 220print"ok\n"; 221} 222 223# Root pathname \n 224# Response expected: no. Tell the server which CVSROOT to use. Note that 225# pathname is a local directory and not a fully qualified CVSROOT variable. 226# pathname must already exist; if creating a new root, use the init 227# request, not Root. pathname does not include the hostname of the server, 228# how to access the server, etc.; by the time the CVS protocol is in use, 229# connection, authentication, etc., are already taken care of. The Root 230# request must be sent only once, and it must be sent before any requests 231# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 232sub req_Root 233{ 234my($cmd,$data) =@_; 235$log->debug("req_Root :$data"); 236 237unless($data=~ m#^/#) { 238print"error 1 Root must be an absolute pathname\n"; 239return0; 240} 241 242my$cvsroot=$state->{'base-path'} ||''; 243$cvsroot=~ s#/+$##; 244$cvsroot.=$data; 245 246if($state->{CVSROOT} 247&& ($state->{CVSROOT}ne$cvsroot)) { 248print"error 1 Conflicting roots specified\n"; 249return0; 250} 251 252$state->{CVSROOT} =$cvsroot; 253 254$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 255 256if(@{$state->{allowed_roots}}) { 257my$allowed=0; 258foreachmy$dir(@{$state->{allowed_roots}}) { 259next unless$dir=~ m#^/#; 260$dir=~ s#/+$##; 261if($state->{'strict-paths'}) { 262if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 263$allowed=1; 264last; 265} 266}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 267$allowed=1; 268last; 269} 270} 271 272unless($allowed) { 273print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 274print"E\n"; 275print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 276return0; 277} 278} 279 280unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 281print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 282print"E\n"; 283print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 284return0; 285} 286 287my@gitvars=`git-config -l`; 288if($?) { 289print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 290print"E\n"; 291print"error 1 - problem executing git-config\n"; 292return0; 293} 294foreachmy$line(@gitvars) 295{ 296next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 297unless($2) { 298$cfg->{$1}{$3} =$4; 299}else{ 300$cfg->{$1}{$2}{$3} =$4; 301} 302} 303 304my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 305||$cfg->{gitcvs}{enabled}); 306unless($state->{'export-all'} || 307($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 308print"E GITCVS emulation needs to be enabled on this repo\n"; 309print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 310print"E\n"; 311print"error 1 GITCVS emulation disabled\n"; 312return0; 313} 314 315my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 316if($logfile) 317{ 318$log->setfile($logfile); 319}else{ 320$log->nofile(); 321} 322 323return1; 324} 325 326# Global_option option \n 327# Response expected: no. Transmit one of the global options `-q', `-Q', 328# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 329# variations (such as combining of options) are allowed. For graceful 330# handling of valid-requests, it is probably better to make new global 331# options separate requests, rather than trying to add them to this 332# request. 333sub req_Globaloption 334{ 335my($cmd,$data) =@_; 336$log->debug("req_Globaloption :$data"); 337$state->{globaloptions}{$data} =1; 338} 339 340# Valid-responses request-list \n 341# Response expected: no. Tell the server what responses the client will 342# accept. request-list is a space separated list of tokens. 343sub req_Validresponses 344{ 345my($cmd,$data) =@_; 346$log->debug("req_Validresponses :$data"); 347 348# TODO : re-enable this, currently it's not particularly useful 349#$state->{validresponses} = [ split /\s+/, $data ]; 350} 351 352# valid-requests \n 353# Response expected: yes. Ask the server to send back a Valid-requests 354# response. 355sub req_validrequests 356{ 357my($cmd,$data) =@_; 358 359$log->debug("req_validrequests"); 360 361$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 362$log->debug("SEND : ok"); 363 364print"Valid-requests ".join(" ",keys%$methods) ."\n"; 365print"ok\n"; 366} 367 368# Directory local-directory \n 369# Additional data: repository \n. Response expected: no. Tell the server 370# what directory to use. The repository should be a directory name from a 371# previous server response. Note that this both gives a default for Entry 372# and Modified and also for ci and the other commands; normal usage is to 373# send Directory for each directory in which there will be an Entry or 374# Modified, and then a final Directory for the original directory, then the 375# command. The local-directory is relative to the top level at which the 376# command is occurring (i.e. the last Directory which is sent before the 377# command); to indicate that top level, `.' should be sent for 378# local-directory. 379sub req_Directory 380{ 381my($cmd,$data) =@_; 382 383my$repository= <STDIN>; 384chomp$repository; 385 386 387$state->{localdir} =$data; 388$state->{repository} =$repository; 389$state->{path} =$repository; 390$state->{path} =~s/^$state->{CVSROOT}\///; 391$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 392$state->{path} .="/"if($state->{path} =~ /\S/ ); 393 394$state->{directory} =$state->{localdir}; 395$state->{directory} =""if($state->{directory}eq"."); 396$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 397 398if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 399{ 400$log->info("Setting prepend to '$state->{path}'"); 401$state->{prependdir} =$state->{path}; 402foreachmy$entry(keys%{$state->{entries}} ) 403{ 404$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 405delete$state->{entries}{$entry}; 406} 407} 408 409if(defined($state->{prependdir} ) ) 410{ 411$log->debug("Prepending '$state->{prependdir}' to state|directory"); 412$state->{directory} =$state->{prependdir} .$state->{directory} 413} 414$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 415} 416 417# Entry entry-line \n 418# Response expected: no. Tell the server what version of a file is on the 419# local machine. The name in entry-line is a name relative to the directory 420# most recently specified with Directory. If the user is operating on only 421# some files in a directory, Entry requests for only those files need be 422# included. If an Entry request is sent without Modified, Is-modified, or 423# Unchanged, it means the file is lost (does not exist in the working 424# directory). If both Entry and one of Modified, Is-modified, or Unchanged 425# are sent for the same file, Entry must be sent first. For a given file, 426# one can send Modified, Is-modified, or Unchanged, but not more than one 427# of these three. 428sub req_Entry 429{ 430my($cmd,$data) =@_; 431 432#$log->debug("req_Entry : $data"); 433 434my@data=split(/\//,$data); 435 436$state->{entries}{$state->{directory}.$data[1]} = { 437 revision =>$data[2], 438 conflict =>$data[3], 439 options =>$data[4], 440 tag_or_date =>$data[5], 441}; 442 443$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 444} 445 446# Questionable filename \n 447# Response expected: no. Additional data: no. Tell the server to check 448# whether filename should be ignored, and if not, next time the server 449# sends responses, send (in a M response) `?' followed by the directory and 450# filename. filename must not contain `/'; it needs to be a file in the 451# directory named by the most recent Directory request. 452sub req_Questionable 453{ 454my($cmd,$data) =@_; 455 456$log->debug("req_Questionable :$data"); 457$state->{entries}{$state->{directory}.$data}{questionable} =1; 458} 459 460# add \n 461# Response expected: yes. Add a file or directory. This uses any previous 462# Argument, Directory, Entry, or Modified requests, if they have been sent. 463# The last Directory sent specifies the working directory at the time of 464# the operation. To add a directory, send the directory to be added using 465# Directory and Argument requests. 466sub req_add 467{ 468my($cmd,$data) =@_; 469 470 argsplit("add"); 471 472my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 473$updater->update(); 474 475 argsfromdir($updater); 476 477my$addcount=0; 478 479foreachmy$filename( @{$state->{args}} ) 480{ 481$filename= filecleanup($filename); 482 483my$meta=$updater->getmeta($filename); 484my$wrev= revparse($filename); 485 486if($wrev&&$meta&& ($wrev<0)) 487{ 488# previously removed file, add back 489$log->info("added file$filenamewas previously removed, send 1.$meta->{revision}"); 490 491print"MT +updated\n"; 492print"MT text U\n"; 493print"MT fname$filename\n"; 494print"MT newline\n"; 495print"MT -updated\n"; 496 497unless($state->{globaloptions}{-n} ) 498{ 499my($filepart,$dirpart) = filenamesplit($filename,1); 500 501print"Created$dirpart\n"; 502print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 503 504# this is an "entries" line 505my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 506$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 507print"/$filepart/1.$meta->{revision}//$kopts/\n"; 508# permissions 509$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 510print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 511# transmit file 512 transmitfile($meta->{filehash}); 513} 514 515next; 516} 517 518unless(defined($state->{entries}{$filename}{modified_filename} ) ) 519{ 520print"E cvs add: nothing known about `$filename'\n"; 521next; 522} 523# TODO : check we're not squashing an already existing file 524if(defined($state->{entries}{$filename}{revision} ) ) 525{ 526print"E cvs add: `$filename' has already been entered\n"; 527next; 528} 529 530my($filepart,$dirpart) = filenamesplit($filename,1); 531 532print"E cvs add: scheduling file `$filename' for addition\n"; 533 534print"Checked-in$dirpart\n"; 535print"$filename\n"; 536my$kopts= kopts_from_path($filename,"file", 537$state->{entries}{$filename}{modified_filename}); 538print"/$filepart/0//$kopts/\n"; 539 540my$requestedKopts=$state->{opt}{k}; 541if(defined($requestedKopts)) 542{ 543$requestedKopts="-k$requestedKopts"; 544} 545else 546{ 547$requestedKopts=""; 548} 549if($koptsne$requestedKopts) 550{ 551$log->warn("Ignoring requested -k='$requestedKopts'" 552." for '$filename'; detected -k='$kopts' instead"); 553#TODO: Also have option to send warning to user? 554} 555 556$addcount++; 557} 558 559if($addcount==1) 560{ 561print"E cvs add: use `cvs commit' to add this file permanently\n"; 562} 563elsif($addcount>1) 564{ 565print"E cvs add: use `cvs commit' to add these files permanently\n"; 566} 567 568print"ok\n"; 569} 570 571# remove \n 572# Response expected: yes. Remove a file. This uses any previous Argument, 573# Directory, Entry, or Modified requests, if they have been sent. The last 574# Directory sent specifies the working directory at the time of the 575# operation. Note that this request does not actually do anything to the 576# repository; the only effect of a successful remove request is to supply 577# the client with a new entries line containing `-' to indicate a removed 578# file. In fact, the client probably could perform this operation without 579# contacting the server, although using remove may cause the server to 580# perform a few more checks. The client sends a subsequent ci request to 581# actually record the removal in the repository. 582sub req_remove 583{ 584my($cmd,$data) =@_; 585 586 argsplit("remove"); 587 588# Grab a handle to the SQLite db and do any necessary updates 589my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 590$updater->update(); 591 592#$log->debug("add state : " . Dumper($state)); 593 594my$rmcount=0; 595 596foreachmy$filename( @{$state->{args}} ) 597{ 598$filename= filecleanup($filename); 599 600if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 601{ 602print"E cvs remove: file `$filename' still in working directory\n"; 603next; 604} 605 606my$meta=$updater->getmeta($filename); 607my$wrev= revparse($filename); 608 609unless(defined($wrev) ) 610{ 611print"E cvs remove: nothing known about `$filename'\n"; 612next; 613} 614 615if(defined($wrev)and$wrev<0) 616{ 617print"E cvs remove: file `$filename' already scheduled for removal\n"; 618next; 619} 620 621unless($wrev==$meta->{revision} ) 622{ 623# TODO : not sure if the format of this message is quite correct. 624print"E cvs remove: Up to date check failed for `$filename'\n"; 625next; 626} 627 628 629my($filepart,$dirpart) = filenamesplit($filename,1); 630 631print"E cvs remove: scheduling `$filename' for removal\n"; 632 633print"Checked-in$dirpart\n"; 634print"$filename\n"; 635my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 636print"/$filepart/-1.$wrev//$kopts/\n"; 637 638$rmcount++; 639} 640 641if($rmcount==1) 642{ 643print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 644} 645elsif($rmcount>1) 646{ 647print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 648} 649 650print"ok\n"; 651} 652 653# Modified filename \n 654# Response expected: no. Additional data: mode, \n, file transmission. Send 655# the server a copy of one locally modified file. filename is a file within 656# the most recent directory sent with Directory; it must not contain `/'. 657# If the user is operating on only some files in a directory, only those 658# files need to be included. This can also be sent without Entry, if there 659# is no entry for the file. 660sub req_Modified 661{ 662my($cmd,$data) =@_; 663 664my$mode= <STDIN>; 665defined$mode 666or(print"E end of file reading mode for$data\n"),return; 667chomp$mode; 668my$size= <STDIN>; 669defined$size 670or(print"E end of file reading size of$data\n"),return; 671chomp$size; 672 673# Grab config information 674my$blocksize=8192; 675my$bytesleft=$size; 676my$tmp; 677 678# Get a filehandle/name to write it to 679my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 680 681# Loop over file data writing out to temporary file. 682while($bytesleft) 683{ 684$blocksize=$bytesleftif($bytesleft<$blocksize); 685read STDIN,$tmp,$blocksize; 686print$fh $tmp; 687$bytesleft-=$blocksize; 688} 689 690close$fh 691or(print"E failed to write temporary,$filename:$!\n"),return; 692 693# Ensure we have something sensible for the file mode 694if($mode=~/u=(\w+)/) 695{ 696$mode=$1; 697}else{ 698$mode="rw"; 699} 700 701# Save the file data in $state 702$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 703$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 704$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 705$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 706 707 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 708} 709 710# Unchanged filename\n 711# Response expected: no. Tell the server that filename has not been 712# modified in the checked out directory. The filename is a file within the 713# most recent directory sent with Directory; it must not contain `/'. 714sub req_Unchanged 715{ 716 my ($cmd,$data) =@_; 717 718$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 719 720 #$log->debug("req_Unchanged :$data"); 721} 722 723# Argument text\n 724# Response expected: no. Save argument for use in a subsequent command. 725# Arguments accumulate until an argument-using command is given, at which 726# point they are forgotten. 727# Argumentx text\n 728# Response expected: no. Append\nfollowed by text to the current argument 729# being saved. 730sub req_Argument 731{ 732 my ($cmd,$data) =@_; 733 734 # Argumentx means: append to last Argument (with a newline in front) 735 736$log->debug("$cmd:$data"); 737 738 if ($cmdeq 'Argumentx') { 739 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 740 } else { 741 push @{$state->{arguments}},$data; 742 } 743} 744 745# expand-modules\n 746# Response expected: yes. Expand the modules which are specified in the 747# arguments. Returns the data in Module-expansion responses. Note that the 748# server can assume that this is checkout or export, not rtag or rdiff; the 749# latter do not access the working directory and thus have no need to 750# expand modules on the client side. Expand may not be the best word for 751# what this request does. It does not necessarily tell you all the files 752# contained in a module, for example. Basically it is a way of telling you 753# which working directories the server needs to know about in order to 754# handle a checkout of the specified modules. For example, suppose that the 755# server has a module defined by 756# aliasmodule -a 1dir 757# That is, one can check out aliasmodule and it will take 1dir in the 758# repository and check it out to 1dir in the working directory. Now suppose 759# the client already has this module checked out and is planning on using 760# the co request to update it. Without using expand-modules, the client 761# would have two bad choices: it could either send information about all 762# working directories under the current directory, which could be 763# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 764# stands for 1dir, and neglect to send information for 1dir, which would 765# lead to incorrect operation. With expand-modules, the client would first 766# ask for the module to be expanded: 767sub req_expandmodules 768{ 769 my ($cmd,$data) =@_; 770 771 argsplit(); 772 773$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 774 775 unless ( ref$state->{arguments} eq "ARRAY" ) 776 { 777 print "ok\n"; 778 return; 779 } 780 781 foreach my$module( @{$state->{arguments}} ) 782 { 783$log->debug("SEND : Module-expansion$module"); 784 print "Module-expansion$module\n"; 785 } 786 787 print "ok\n"; 788 statecleanup(); 789} 790 791# co\n 792# Response expected: yes. Get files from the repository. This uses any 793# previous Argument, Directory, Entry, or Modified requests, if they have 794# been sent. Arguments to this command are module names; the client cannot 795# know what directories they correspond to except by (1) just sending the 796# co request, and then seeing what directory names the server sends back in 797# its responses, and (2) the expand-modules request. 798sub req_co 799{ 800 my ($cmd,$data) =@_; 801 802 argsplit("co"); 803 804 my$module=$state->{args}[0]; 805$state->{module} =$module; 806 my$checkout_path=$module; 807 808 # use the user specified directory if we're given it 809$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 810 811$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 812 813$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 814 815$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 816 817# Grab a handle to the SQLite db and do any necessary updates 818my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 819$updater->update(); 820 821$checkout_path=~ s|/$||;# get rid of trailing slashes 822 823# Eclipse seems to need the Clear-sticky command 824# to prepare the 'Entries' file for the new directory. 825print"Clear-sticky$checkout_path/\n"; 826print$state->{CVSROOT} ."/$module/\n"; 827print"Clear-static-directory$checkout_path/\n"; 828print$state->{CVSROOT} ."/$module/\n"; 829print"Clear-sticky$checkout_path/\n";# yes, twice 830print$state->{CVSROOT} ."/$module/\n"; 831print"Template$checkout_path/\n"; 832print$state->{CVSROOT} ."/$module/\n"; 833print"0\n"; 834 835# instruct the client that we're checking out to $checkout_path 836print"E cvs checkout: Updating$checkout_path\n"; 837 838my%seendirs= (); 839my$lastdir=''; 840 841# recursive 842sub prepdir { 843my($dir,$repodir,$remotedir,$seendirs) =@_; 844my$parent= dirname($dir); 845$dir=~ s|/+$||; 846$repodir=~ s|/+$||; 847$remotedir=~ s|/+$||; 848$parent=~ s|/+$||; 849$log->debug("announcedir$dir,$repodir,$remotedir"); 850 851if($parenteq'.'||$parenteq'./') { 852$parent=''; 853} 854# recurse to announce unseen parents first 855if(length($parent) && !exists($seendirs->{$parent})) { 856 prepdir($parent,$repodir,$remotedir,$seendirs); 857} 858# Announce that we are going to modify at the parent level 859if($parent) { 860print"E cvs checkout: Updating$remotedir/$parent\n"; 861}else{ 862print"E cvs checkout: Updating$remotedir\n"; 863} 864print"Clear-sticky$remotedir/$parent/\n"; 865print"$repodir/$parent/\n"; 866 867print"Clear-static-directory$remotedir/$dir/\n"; 868print"$repodir/$dir/\n"; 869print"Clear-sticky$remotedir/$parent/\n";# yes, twice 870print"$repodir/$parent/\n"; 871print"Template$remotedir/$dir/\n"; 872print"$repodir/$dir/\n"; 873print"0\n"; 874 875$seendirs->{$dir} =1; 876} 877 878foreachmy$git( @{$updater->gethead} ) 879{ 880# Don't want to check out deleted files 881next if($git->{filehash}eq"deleted"); 882 883my$fullName=$git->{name}; 884($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 885 886if(length($git->{dir}) &&$git->{dir}ne'./' 887&&$git->{dir}ne$lastdir) { 888unless(exists($seendirs{$git->{dir}})) { 889 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 890$checkout_path, \%seendirs); 891$lastdir=$git->{dir}; 892$seendirs{$git->{dir}} =1; 893} 894print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 895} 896 897# modification time of this file 898print"Mod-time$git->{modified}\n"; 899 900# print some information to the client 901if(defined($git->{dir} )and$git->{dir}ne"./") 902{ 903print"M U$checkout_path/$git->{dir}$git->{name}\n"; 904}else{ 905print"M U$checkout_path/$git->{name}\n"; 906} 907 908# instruct client we're sending a file to put in this path 909print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 910 911print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 912 913# this is an "entries" line 914my$kopts= kopts_from_path($fullName,"sha1",$git->{filehash}); 915print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 916# permissions 917print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 918 919# transmit file 920 transmitfile($git->{filehash}); 921} 922 923print"ok\n"; 924 925 statecleanup(); 926} 927 928# update \n 929# Response expected: yes. Actually do a cvs update command. This uses any 930# previous Argument, Directory, Entry, or Modified requests, if they have 931# been sent. The last Directory sent specifies the working directory at the 932# time of the operation. The -I option is not used--files which the client 933# can decide whether to ignore are not mentioned and the client sends the 934# Questionable request for others. 935sub req_update 936{ 937my($cmd,$data) =@_; 938 939$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 940 941 argsplit("update"); 942 943# 944# It may just be a client exploring the available heads/modules 945# in that case, list them as top level directories and leave it 946# at that. Eclipse uses this technique to offer you a list of 947# projects (heads in this case) to checkout. 948# 949if($state->{module}eq'') { 950my$showref=`git show-ref --heads`; 951print"E cvs update: Updating .\n"; 952formy$line(split'\n',$showref) { 953if($line=~ m% refs/heads/(.*)$%) { 954print"E cvs update: New directory `$1'\n"; 955} 956} 957print"ok\n"; 958return1; 959} 960 961 962# Grab a handle to the SQLite db and do any necessary updates 963my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 964 965$updater->update(); 966 967 argsfromdir($updater); 968 969#$log->debug("update state : " . Dumper($state)); 970 971# foreach file specified on the command line ... 972foreachmy$filename( @{$state->{args}} ) 973{ 974$filename= filecleanup($filename); 975 976$log->debug("Processing file$filename"); 977 978# if we have a -C we should pretend we never saw modified stuff 979if(exists($state->{opt}{C} ) ) 980{ 981delete$state->{entries}{$filename}{modified_hash}; 982delete$state->{entries}{$filename}{modified_filename}; 983$state->{entries}{$filename}{unchanged} =1; 984} 985 986my$meta; 987if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 988{ 989$meta=$updater->getmeta($filename,$1); 990}else{ 991$meta=$updater->getmeta($filename); 992} 993 994# If -p was given, "print" the contents of the requested revision. 995if(exists($state->{opt}{p} ) ) { 996if(defined($meta->{revision} ) ) { 997$log->info("Printing '$filename' revision ".$meta->{revision}); 998 999 transmitfile($meta->{filehash}, {print=>1});1000}10011002next;1003}10041005if( !defined$meta)1006{1007$meta= {1008 name =>$filename,1009 revision =>0,1010 filehash =>'added'1011};1012}10131014my$oldmeta=$meta;10151016my$wrev= revparse($filename);10171018# If the working copy is an old revision, lets get that version too for comparison.1019if(defined($wrev)and$wrev!=$meta->{revision} )1020{1021$oldmeta=$updater->getmeta($filename,$wrev);1022}10231024#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");10251026# Files are up to date if the working copy and repo copy have the same revision,1027# and the working copy is unmodified _and_ the user hasn't specified -C1028next if(defined($wrev)1029and defined($meta->{revision})1030and$wrev==$meta->{revision}1031and$state->{entries}{$filename}{unchanged}1032and not exists($state->{opt}{C} ) );10331034# If the working copy and repo copy have the same revision,1035# but the working copy is modified, tell the client it's modified1036if(defined($wrev)1037and defined($meta->{revision})1038and$wrev==$meta->{revision}1039and defined($state->{entries}{$filename}{modified_hash})1040and not exists($state->{opt}{C} ) )1041{1042$log->info("Tell the client the file is modified");1043print"MT text M\n";1044print"MT fname$filename\n";1045print"MT newline\n";1046next;1047}10481049if($meta->{filehash}eq"deleted")1050{1051my($filepart,$dirpart) = filenamesplit($filename,1);10521053$log->info("Removing '$filename' from working copy (no longer in the repo)");10541055print"E cvs update: `$filename' is no longer in the repository\n";1056# Don't want to actually _DO_ the update if -n specified1057unless($state->{globaloptions}{-n} ) {1058print"Removed$dirpart\n";1059print"$filepart\n";1060}1061}1062elsif(not defined($state->{entries}{$filename}{modified_hash} )1063or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1064or$meta->{filehash}eq'added')1065{1066# normal update, just send the new revision (either U=Update,1067# or A=Add, or R=Remove)1068if(defined($wrev) &&$wrev<0)1069{1070$log->info("Tell the client the file is scheduled for removal");1071print"MT text R\n";1072print"MT fname$filename\n";1073print"MT newline\n";1074next;1075}1076elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) )1077{1078$log->info("Tell the client the file is scheduled for addition");1079print"MT text A\n";1080print"MT fname$filename\n";1081print"MT newline\n";1082next;10831084}1085else{1086$log->info("Updating '$filename' to ".$meta->{revision});1087print"MT +updated\n";1088print"MT text U\n";1089print"MT fname$filename\n";1090print"MT newline\n";1091print"MT -updated\n";1092}10931094my($filepart,$dirpart) = filenamesplit($filename,1);10951096# Don't want to actually _DO_ the update if -n specified1097unless($state->{globaloptions}{-n} )1098{1099if(defined($wrev) )1100{1101# instruct client we're sending a file to put in this path as a replacement1102print"Update-existing$dirpart\n";1103$log->debug("Updating existing file 'Update-existing$dirpart'");1104}else{1105# instruct client we're sending a file to put in this path as a new file1106print"Clear-static-directory$dirpart\n";1107print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1108print"Clear-sticky$dirpart\n";1109print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";11101111$log->debug("Creating new file 'Created$dirpart'");1112print"Created$dirpart\n";1113}1114print$state->{CVSROOT} ."/$state->{module}/$filename\n";11151116# this is an "entries" line1117my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1118$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1119print"/$filepart/1.$meta->{revision}//$kopts/\n";11201121# permissions1122$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1123print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";11241125# transmit file1126 transmitfile($meta->{filehash});1127}1128}else{1129$log->info("Updating '$filename'");1130my($filepart,$dirpart) = filenamesplit($meta->{name},1);11311132my$mergeDir= setupTmpDir();11331134my$file_local=$filepart.".mine";1135my$mergedFile="$mergeDir/$file_local";1136system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1137my$file_old=$filepart.".".$oldmeta->{revision};1138 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1139my$file_new=$filepart.".".$meta->{revision};1140 transmitfile($meta->{filehash}, { targetfile =>$file_new});11411142# we need to merge with the local changes ( M=successful merge, C=conflict merge )1143$log->info("Merging$file_local,$file_old,$file_new");1144print"M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into$filename\n";11451146$log->debug("Temporary directory for merge is$mergeDir");11471148my$return=system("git","merge-file",$file_local,$file_old,$file_new);1149$return>>=8;11501151 cleanupTmpDir();11521153if($return==0)1154{1155$log->info("Merged successfully");1156print"M M$filename\n";1157$log->debug("Merged$dirpart");11581159# Don't want to actually _DO_ the update if -n specified1160unless($state->{globaloptions}{-n} )1161{1162print"Merged$dirpart\n";1163$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1164print$state->{CVSROOT} ."/$state->{module}/$filename\n";1165my$kopts= kopts_from_path("$dirpart/$filepart",1166"file",$mergedFile);1167$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1168print"/$filepart/1.$meta->{revision}//$kopts/\n";1169}1170}1171elsif($return==1)1172{1173$log->info("Merged with conflicts");1174print"E cvs update: conflicts found in$filename\n";1175print"M C$filename\n";11761177# Don't want to actually _DO_ the update if -n specified1178unless($state->{globaloptions}{-n} )1179{1180print"Merged$dirpart\n";1181print$state->{CVSROOT} ."/$state->{module}/$filename\n";1182my$kopts= kopts_from_path("$dirpart/$filepart",1183"file",$mergedFile);1184print"/$filepart/1.$meta->{revision}/+/$kopts/\n";1185}1186}1187else1188{1189$log->warn("Merge failed");1190next;1191}11921193# Don't want to actually _DO_ the update if -n specified1194unless($state->{globaloptions}{-n} )1195{1196# permissions1197$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1198print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";11991200# transmit file, format is single integer on a line by itself (file1201# size) followed by the file contents1202# TODO : we should copy files in blocks1203my$data=`cat$mergedFile`;1204$log->debug("File size : " . length($data));1205 print length($data) . "\n";1206 print$data;1207 }1208 }12091210 }12111212 print "ok\n";1213}12141215sub req_ci1216{1217 my ($cmd,$data) =@_;12181219 argsplit("ci");12201221 #$log->debug("State : " . Dumper($state));12221223$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));12241225 if ($state->{method} eq 'pserver')1226 {1227 print "error 1 pserver access cannot commit\n";1228 cleanupWorkTree();1229 exit;1230 }12311232 if ( -e$state->{CVSROOT} . "/index" )1233 {1234$log->warn("file 'index' already exists in the git repository");1235 print "error 1 Index already exists in git repo\n";1236 cleanupWorkTree();1237 exit;1238 }12391240 # Grab a handle to the SQLite db and do any necessary updates1241 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1242$updater->update();12431244 # Remember where the head was at the beginning.1245 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1246 chomp$parenthash;1247 if ($parenthash!~ /^[0-9a-f]{40}$/) {1248 print "error 1 pserver cannot find the current HEAD of module";1249 cleanupWorkTree();1250 exit;1251 }12521253 setupWorkTree($parenthash);12541255$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");12561257$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");12581259 my@committedfiles= ();1260 my%oldmeta;12611262 # foreach file specified on the command line ...1263 foreach my$filename( @{$state->{args}} )1264 {1265 my$committedfile=$filename;1266$filename= filecleanup($filename);12671268 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );12691270 my$meta=$updater->getmeta($filename);1271$oldmeta{$filename} =$meta;12721273 my$wrev= revparse($filename);12741275 my ($filepart,$dirpart) = filenamesplit($filename);12761277 # do a checkout of the file if it is part of this tree1278 if ($wrev) {1279 system('git-checkout-index', '-f', '-u',$filename);1280 unless ($?== 0) {1281 die "Error running git-checkout-index -f -u$filename:$!";1282 }1283 }12841285 my$addflag= 0;1286 my$rmflag= 0;1287$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1288$addflag= 1 unless ( -e$filename);12891290 # Do up to date checking1291 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1292 {1293 # fail everything if an up to date check fails1294 print "error 1 Up to date check failed for$filename\n";1295 cleanupWorkTree();1296 exit;1297 }12981299 push@committedfiles,$committedfile;1300$log->info("Committing$filename");13011302 system("mkdir","-p",$dirpart) unless ( -d$dirpart);13031304 unless ($rmflag)1305 {1306$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1307 rename$state->{entries}{$filename}{modified_filename},$filename;13081309 # Calculate modes to remove1310 my$invmode= "";1311 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }13121313$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1314 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1315 }13161317 if ($rmflag)1318 {1319$log->info("Removing file '$filename'");1320 unlink($filename);1321 system("git-update-index", "--remove",$filename);1322 }1323 elsif ($addflag)1324 {1325$log->info("Adding file '$filename'");1326 system("git-update-index", "--add",$filename);1327 } else {1328$log->info("Updating file '$filename'");1329 system("git-update-index",$filename);1330 }1331 }13321333 unless ( scalar(@committedfiles) > 0 )1334 {1335 print "E No files to commit\n";1336 print "ok\n";1337 cleanupWorkTree();1338 return;1339 }13401341 my$treehash= `git-write-tree`;1342 chomp$treehash;13431344$log->debug("Treehash :$treehash, Parenthash :$parenthash");13451346 # write our commit message out if we have one ...1347 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1348 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1349 print$msg_fh"\n\nvia git-CVS emulator\n";1350 close$msg_fh;13511352 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;1353chomp($commithash);1354$log->info("Commit hash :$commithash");13551356unless($commithash=~/[a-zA-Z0-9]{40}/)1357{1358$log->warn("Commit failed (Invalid commit hash)");1359print"error 1 Commit failed (unknown reason)\n";1360 cleanupWorkTree();1361exit;1362}13631364### Emulate git-receive-pack by running hooks/update1365my@hook= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1366$parenthash,$commithash);1367if( -x $hook[0] ) {1368unless(system(@hook) ==0)1369{1370$log->warn("Commit failed (update hook declined to update ref)");1371print"error 1 Commit failed (update hook declined)\n";1372 cleanupWorkTree();1373exit;1374}1375}13761377### Update the ref1378if(system(qw(git update-ref -m),"cvsserver ci",1379"refs/heads/$state->{module}",$commithash,$parenthash)) {1380$log->warn("update-ref for$state->{module} failed.");1381print"error 1 Cannot commit -- update first\n";1382 cleanupWorkTree();1383exit;1384}13851386### Emulate git-receive-pack by running hooks/post-receive1387my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1388if( -x $hook) {1389open(my$pipe,"|$hook") ||die"can't fork$!";13901391local$SIG{PIPE} =sub{die'pipe broke'};13921393print$pipe"$parenthash$commithashrefs/heads/$state->{module}\n";13941395close$pipe||die"bad pipe:$!$?";1396}13971398### Then hooks/post-update1399$hook=$ENV{GIT_DIR}.'hooks/post-update';1400if(-x $hook) {1401system($hook,"refs/heads/$state->{module}");1402}14031404$updater->update();14051406# foreach file specified on the command line ...1407foreachmy$filename(@committedfiles)1408{1409$filename= filecleanup($filename);14101411my$meta=$updater->getmeta($filename);1412unless(defined$meta->{revision}) {1413$meta->{revision} =1;1414}14151416my($filepart,$dirpart) = filenamesplit($filename,1);14171418$log->debug("Checked-in$dirpart:$filename");14191420print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1421if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1422{1423print"M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";1424print"Remove-entry$dirpart\n";1425print"$filename\n";1426}else{1427if($meta->{revision} ==1) {1428print"M initial revision: 1.1\n";1429}else{1430print"M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";1431}1432print"Checked-in$dirpart\n";1433print"$filename\n";1434my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1435print"/$filepart/1.$meta->{revision}//$kopts/\n";1436}1437}14381439 cleanupWorkTree();1440print"ok\n";1441}14421443sub req_status1444{1445my($cmd,$data) =@_;14461447 argsplit("status");14481449$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1450#$log->debug("status state : " . Dumper($state));14511452# Grab a handle to the SQLite db and do any necessary updates1453my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1454$updater->update();14551456# if no files were specified, we need to work out what files we should be providing status on ...1457 argsfromdir($updater);14581459# foreach file specified on the command line ...1460foreachmy$filename( @{$state->{args}} )1461{1462$filename= filecleanup($filename);14631464next ifexists($state->{opt}{l}) &&index($filename,'/',length($state->{prependdir})) >=0;14651466my$meta=$updater->getmeta($filename);1467my$oldmeta=$meta;14681469my$wrev= revparse($filename);14701471# If the working copy is an old revision, lets get that version too for comparison.1472if(defined($wrev)and$wrev!=$meta->{revision} )1473{1474$oldmeta=$updater->getmeta($filename,$wrev);1475}14761477# TODO : All possible statuses aren't yet implemented1478my$status;1479# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1480$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1481and1482( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1483or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1484);14851486# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1487$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1488and1489($state->{entries}{$filename}{unchanged}1490or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1491);14921493# Need checkout if it exists in the repo but doesn't have a working copy1494$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );14951496# Locally modified if working copy and repo copy have the same revision but there are local changes1497$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );14981499# Needs Merge if working copy revision is less than repo copy and there are local changes1500$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );15011502$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1503$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1504$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1505$status||="File had conflicts on merge"if(0);15061507$status||="Unknown";15081509my($filepart) = filenamesplit($filename);15101511print"M ===================================================================\n";1512print"M File:$filepart\tStatus:$status\n";1513if(defined($state->{entries}{$filename}{revision}) )1514{1515print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1516}else{1517print"M Working revision:\tNo entry for$filename\n";1518}1519if(defined($meta->{revision}) )1520{1521print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1522print"M Sticky Tag:\t\t(none)\n";1523print"M Sticky Date:\t\t(none)\n";1524print"M Sticky Options:\t\t(none)\n";1525}else{1526print"M Repository revision:\tNo revision control file\n";1527}1528print"M\n";1529}15301531print"ok\n";1532}15331534sub req_diff1535{1536my($cmd,$data) =@_;15371538 argsplit("diff");15391540$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1541#$log->debug("status state : " . Dumper($state));15421543my($revision1,$revision2);1544if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1545{1546$revision1=$state->{opt}{r}[0];1547$revision2=$state->{opt}{r}[1];1548}else{1549$revision1=$state->{opt}{r};1550}15511552$revision1=~s/^1\.//if(defined($revision1) );1553$revision2=~s/^1\.//if(defined($revision2) );15541555$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );15561557# Grab a handle to the SQLite db and do any necessary updates1558my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1559$updater->update();15601561# if no files were specified, we need to work out what files we should be providing status on ...1562 argsfromdir($updater);15631564# foreach file specified on the command line ...1565foreachmy$filename( @{$state->{args}} )1566{1567$filename= filecleanup($filename);15681569my($fh,$file1,$file2,$meta1,$meta2,$filediff);15701571my$wrev= revparse($filename);15721573# We need _something_ to diff against1574next unless(defined($wrev) );15751576# if we have a -r switch, use it1577if(defined($revision1) )1578{1579(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1580$meta1=$updater->getmeta($filename,$revision1);1581unless(defined($meta1)and$meta1->{filehash}ne"deleted")1582{1583print"E File$filenameat revision 1.$revision1doesn't exist\n";1584next;1585}1586 transmitfile($meta1->{filehash}, { targetfile =>$file1});1587}1588# otherwise we just use the working copy revision1589else1590{1591(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1592$meta1=$updater->getmeta($filename,$wrev);1593 transmitfile($meta1->{filehash}, { targetfile =>$file1});1594}15951596# if we have a second -r switch, use it too1597if(defined($revision2) )1598{1599(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1600$meta2=$updater->getmeta($filename,$revision2);16011602unless(defined($meta2)and$meta2->{filehash}ne"deleted")1603{1604print"E File$filenameat revision 1.$revision2doesn't exist\n";1605next;1606}16071608 transmitfile($meta2->{filehash}, { targetfile =>$file2});1609}1610# otherwise we just use the working copy1611else1612{1613$file2=$state->{entries}{$filename}{modified_filename};1614}16151616# if we have been given -r, and we don't have a $file2 yet, lets get one1617if(defined($revision1)and not defined($file2) )1618{1619(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1620$meta2=$updater->getmeta($filename,$wrev);1621 transmitfile($meta2->{filehash}, { targetfile =>$file2});1622}16231624# We need to have retrieved something useful1625next unless(defined($meta1) );16261627# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1628next if(not defined($meta2)and$wrev==$meta1->{revision}1629and1630( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1631or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1632);16331634# Apparently we only show diffs for locally modified files1635next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );16361637print"M Index:$filename\n";1638print"M ===================================================================\n";1639print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1640print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1641print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1642print"M diff ";1643foreachmy$opt(keys%{$state->{opt}} )1644{1645if(ref$state->{opt}{$opt}eq"ARRAY")1646{1647foreachmy$value( @{$state->{opt}{$opt}} )1648{1649print"-$opt$value";1650}1651}else{1652print"-$opt";1653print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1654}1655}1656print"$filename\n";16571658$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));16591660($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);16611662if(exists$state->{opt}{u} )1663{1664system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1665}else{1666system("diff$file1$file2>$filediff");1667}16681669while( <$fh> )1670{1671print"M$_";1672}1673close$fh;1674}16751676print"ok\n";1677}16781679sub req_log1680{1681my($cmd,$data) =@_;16821683 argsplit("log");16841685$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1686#$log->debug("log state : " . Dumper($state));16871688my($minrev,$maxrev);1689if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1690{1691my$control=$2;1692$minrev=$1;1693$maxrev=$3;1694$minrev=~s/^1\.//if(defined($minrev) );1695$maxrev=~s/^1\.//if(defined($maxrev) );1696$minrev++if(defined($minrev)and$controleq"::");1697}16981699# Grab a handle to the SQLite db and do any necessary updates1700my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1701$updater->update();17021703# if no files were specified, we need to work out what files we should be providing status on ...1704 argsfromdir($updater);17051706# foreach file specified on the command line ...1707foreachmy$filename( @{$state->{args}} )1708{1709$filename= filecleanup($filename);17101711my$headmeta=$updater->getmeta($filename);17121713my$revisions=$updater->getlog($filename);1714my$totalrevisions=scalar(@$revisions);17151716if(defined($minrev) )1717{1718$log->debug("Removing revisions less than$minrev");1719while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1720{1721pop@$revisions;1722}1723}1724if(defined($maxrev) )1725{1726$log->debug("Removing revisions greater than$maxrev");1727while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1728{1729shift@$revisions;1730}1731}17321733next unless(scalar(@$revisions) );17341735print"M\n";1736print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1737print"M Working file:$filename\n";1738print"M head: 1.$headmeta->{revision}\n";1739print"M branch:\n";1740print"M locks: strict\n";1741print"M access list:\n";1742print"M symbolic names:\n";1743print"M keyword substitution: kv\n";1744print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1745print"M description:\n";17461747foreachmy$revision(@$revisions)1748{1749print"M ----------------------------\n";1750print"M revision 1.$revision->{revision}\n";1751# reformat the date for log output1752$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}) );1753$revision->{author} = cvs_author($revision->{author});1754print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1755my$commitmessage=$updater->commitmessage($revision->{commithash});1756$commitmessage=~s/^/M /mg;1757print$commitmessage."\n";1758}1759print"M =============================================================================\n";1760}17611762print"ok\n";1763}17641765sub req_annotate1766{1767my($cmd,$data) =@_;17681769 argsplit("annotate");17701771$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1772#$log->debug("status state : " . Dumper($state));17731774# Grab a handle to the SQLite db and do any necessary updates1775my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1776$updater->update();17771778# if no files were specified, we need to work out what files we should be providing annotate on ...1779 argsfromdir($updater);17801781# we'll need a temporary checkout dir1782 setupWorkTree();17831784$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");17851786# foreach file specified on the command line ...1787foreachmy$filename( @{$state->{args}} )1788{1789$filename= filecleanup($filename);17901791my$meta=$updater->getmeta($filename);17921793next unless($meta->{revision} );17941795# get all the commits that this file was in1796# in dense format -- aka skip dead revisions1797my$revisions=$updater->gethistorydense($filename);1798my$lastseenin=$revisions->[0][2];17991800# populate the temporary index based on the latest commit were we saw1801# the file -- but do it cheaply without checking out any files1802# TODO: if we got a revision from the client, use that instead1803# to look up the commithash in sqlite (still good to default to1804# the current head as we do now)1805system("git-read-tree",$lastseenin);1806unless($?==0)1807{1808print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";1809return;1810}1811$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");18121813# do a checkout of the file1814system('git-checkout-index','-f','-u',$filename);1815unless($?==0) {1816print"E error running git-checkout-index -f -u$filename:$!\n";1817return;1818}18191820$log->info("Annotate$filename");18211822# Prepare a file with the commits from the linearized1823# history that annotate should know about. This prevents1824# git-jsannotate telling us about commits we are hiding1825# from the client.18261827my$a_hints="$work->{workDir}/.annotate_hints";1828if(!open(ANNOTATEHINTS,'>',$a_hints)) {1829print"E failed to open '$a_hints' for writing:$!\n";1830return;1831}1832for(my$i=0;$i<@$revisions;$i++)1833{1834print ANNOTATEHINTS $revisions->[$i][2];1835if($i+1<@$revisions) {# have we got a parent?1836print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1837}1838print ANNOTATEHINTS "\n";1839}18401841print ANNOTATEHINTS "\n";1842close ANNOTATEHINTS1843or(print"E failed to write$a_hints:$!\n"),return;18441845my@cmd= (qw(git-annotate -l -S),$a_hints,$filename);1846if(!open(ANNOTATE,"-|",@cmd)) {1847print"E error invoking ".join(' ',@cmd) .":$!\n";1848return;1849}1850my$metadata= {};1851print"E Annotations for$filename\n";1852print"E ***************\n";1853while( <ANNOTATE> )1854{1855if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1856{1857my$commithash=$1;1858my$data=$2;1859unless(defined($metadata->{$commithash} ) )1860{1861$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1862$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});1863$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1864}1865printf("M 1.%-5d (%-8s%10s):%s\n",1866$metadata->{$commithash}{revision},1867$metadata->{$commithash}{author},1868$metadata->{$commithash}{modified},1869$data1870);1871}else{1872$log->warn("Error in annotate output! LINE:$_");1873print"E Annotate error\n";1874next;1875}1876}1877close ANNOTATE;1878}18791880# done; get out of the tempdir1881 cleanupWorkTree();18821883print"ok\n";18841885}18861887# This method takes the state->{arguments} array and produces two new arrays.1888# The first is $state->{args} which is everything before the '--' argument, and1889# the second is $state->{files} which is everything after it.1890sub argsplit1891{1892$state->{args} = [];1893$state->{files} = [];1894$state->{opt} = {};18951896return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");18971898my$type=shift;18991900if(defined($type) )1901{1902my$opt= {};1903$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");1904$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1905$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");1906$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1907$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1908$opt= { k =>1, m =>1}if($typeeq"add");1909$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1910$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");191119121913while(scalar( @{$state->{arguments}} ) >0)1914{1915my$arg=shift@{$state->{arguments}};19161917next if($argeq"--");1918next unless($arg=~/\S/);19191920# if the argument looks like a switch1921if($arg=~/^-(\w)(.*)/)1922{1923# if it's a switch that takes an argument1924if($opt->{$1} )1925{1926# If this switch has already been provided1927if($opt->{$1} >1and exists($state->{opt}{$1} ) )1928{1929$state->{opt}{$1} = [$state->{opt}{$1} ];1930if(length($2) >0)1931{1932push@{$state->{opt}{$1}},$2;1933}else{1934push@{$state->{opt}{$1}},shift@{$state->{arguments}};1935}1936}else{1937# if there's extra data in the arg, use that as the argument for the switch1938if(length($2) >0)1939{1940$state->{opt}{$1} =$2;1941}else{1942$state->{opt}{$1} =shift@{$state->{arguments}};1943}1944}1945}else{1946$state->{opt}{$1} =undef;1947}1948}1949else1950{1951push@{$state->{args}},$arg;1952}1953}1954}1955else1956{1957my$mode=0;19581959foreachmy$value( @{$state->{arguments}} )1960{1961if($valueeq"--")1962{1963$mode++;1964next;1965}1966push@{$state->{args}},$valueif($mode==0);1967push@{$state->{files}},$valueif($mode==1);1968}1969}1970}19711972# This method uses $state->{directory} to populate $state->{args} with a list of filenames1973sub argsfromdir1974{1975my$updater=shift;19761977$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");19781979return if(scalar( @{$state->{args}} ) >1);19801981my@gethead= @{$updater->gethead};19821983# push added files1984foreachmy$file(keys%{$state->{entries}}) {1985if(exists$state->{entries}{$file}{revision} &&1986$state->{entries}{$file}{revision} ==0)1987{1988push@gethead, { name =>$file, filehash =>'added'};1989}1990}19911992if(scalar(@{$state->{args}}) ==1)1993{1994my$arg=$state->{args}[0];1995$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );19961997$log->info("Only one arg specified, checking for directory expansion on '$arg'");19981999foreachmy$file(@gethead)2000{2001next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2002next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);2003push@{$state->{args}},$file->{name};2004}20052006shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);2007}else{2008$log->info("Only one arg specified, populating file list automatically");20092010$state->{args} = [];20112012foreachmy$file(@gethead)2013{2014next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2015next unless($file->{name} =~s/^$state->{prependdir}//);2016push@{$state->{args}},$file->{name};2017}2018}2019}20202021# This method cleans up the $state variable after a command that uses arguments has run2022sub statecleanup2023{2024$state->{files} = [];2025$state->{args} = [];2026$state->{arguments} = [];2027$state->{entries} = {};2028}20292030sub revparse2031{2032my$filename=shift;20332034returnundefunless(defined($state->{entries}{$filename}{revision} ) );20352036return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);2037return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);20382039returnundef;2040}20412042# This method takes a file hash and does a CVS "file transfer". Its2043# exact behaviour depends on a second, optional hash table argument:2044# - If $options->{targetfile}, dump the contents to that file;2045# - If $options->{print}, use M/MT to transmit the contents one line2046# at a time;2047# - Otherwise, transmit the size of the file, followed by the file2048# contents.2049sub transmitfile2050{2051my$filehash=shift;2052my$options=shift;20532054if(defined($filehash)and$filehasheq"deleted")2055{2056$log->warn("filehash is 'deleted'");2057return;2058}20592060die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);20612062my$type=`git-cat-file -t$filehash`;2063 chomp$type;20642065 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );20662067 my$size= `git-cat-file -s $filehash`;2068chomp$size;20692070$log->debug("transmitfile($filehash) size=$size, type=$type");20712072if(open my$fh,'-|',"git-cat-file","blob",$filehash)2073{2074if(defined($options->{targetfile} ) )2075{2076my$targetfile=$options->{targetfile};2077open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2078print NEWFILE $_while( <$fh> );2079close NEWFILE or die("Failed to write '$targetfile':$!");2080}elsif(defined($options->{print} ) &&$options->{print} ) {2081while( <$fh> ) {2082if(/\n\z/) {2083print'M ',$_;2084}else{2085print'MT text ',$_,"\n";2086}2087}2088}else{2089print"$size\n";2090printwhile( <$fh> );2091}2092close$fhor die("Couldn't close filehandle for transmitfile():$!");2093}else{2094die("Couldn't execute git-cat-file");2095}2096}20972098# This method takes a file name, and returns ( $dirpart, $filepart ) which2099# refers to the directory portion and the file portion of the filename2100# respectively2101sub filenamesplit2102{2103my$filename=shift;2104my$fixforlocaldir=shift;21052106my($filepart,$dirpart) = ($filename,".");2107($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2108$dirpart.="/";21092110if($fixforlocaldir)2111{2112$dirpart=~s/^$state->{prependdir}//;2113}21142115return($filepart,$dirpart);2116}21172118sub filecleanup2119{2120my$filename=shift;21212122returnundefunless(defined($filename));2123if($filename=~/^\// )2124{2125print"E absolute filenames '$filename' not supported by server\n";2126returnundef;2127}21282129$filename=~s/^\.\///g;2130$filename=$state->{prependdir} .$filename;2131return$filename;2132}21332134sub validateGitDir2135{2136if( !defined($state->{CVSROOT}) )2137{2138print"error 1 CVSROOT not specified\n";2139 cleanupWorkTree();2140exit;2141}2142if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2143{2144print"error 1 Internally inconsistent CVSROOT\n";2145 cleanupWorkTree();2146exit;2147}2148}21492150# Setup working directory in a work tree with the requested version2151# loaded in the index.2152sub setupWorkTree2153{2154my($ver) =@_;21552156 validateGitDir();21572158if( (defined($work->{state}) &&$work->{state} !=1) ||2159defined($work->{tmpDir}) )2160{2161$log->warn("Bad work tree state management");2162print"error 1 Internal setup multiple work trees without cleanup\n";2163 cleanupWorkTree();2164exit;2165}21662167$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);21682169if( !defined($work->{index}) )2170{2171(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2172}21732174chdir$work->{workDir}or2175die"Unable to chdir to$work->{workDir}\n";21762177$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");21782179$ENV{GIT_WORK_TREE} =".";2180$ENV{GIT_INDEX_FILE} =$work->{index};2181$work->{state} =2;21822183if($ver)2184{2185system("git","read-tree",$ver);2186unless($?==0)2187{2188$log->warn("Error running git-read-tree");2189die"Error running git-read-tree$verin$work->{workDir}$!\n";2190}2191}2192# else # req_annotate reads tree for each file2193}21942195# Ensure current directory is in some kind of working directory,2196# with a recent version loaded in the index.2197sub ensureWorkTree2198{2199if(defined($work->{tmpDir}) )2200{2201$log->warn("Bad work tree state management [ensureWorkTree()]");2202print"error 1 Internal setup multiple dirs without cleanup\n";2203 cleanupWorkTree();2204exit;2205}2206if($work->{state} )2207{2208return;2209}22102211 validateGitDir();22122213if( !defined($work->{emptyDir}) )2214{2215$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);2216}2217chdir$work->{emptyDir}or2218die"Unable to chdir to$work->{emptyDir}\n";22192220my$ver=`git show-ref -s refs/heads/$state->{module}`;2221chomp$ver;2222if($ver!~/^[0-9a-f]{40}$/)2223{2224$log->warn("Error from git show-ref -s refs/head$state->{module}");2225print"error 1 cannot find the current HEAD of module";2226 cleanupWorkTree();2227exit;2228}22292230if( !defined($work->{index}) )2231{2232(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2233}22342235$ENV{GIT_WORK_TREE} =".";2236$ENV{GIT_INDEX_FILE} =$work->{index};2237$work->{state} =1;22382239system("git","read-tree",$ver);2240unless($?==0)2241{2242die"Error running git-read-tree$ver$!\n";2243}2244}22452246# Cleanup working directory that is not needed any longer.2247sub cleanupWorkTree2248{2249if( !$work->{state} )2250{2251return;2252}22532254chdir"/"or die"Unable to chdir '/'\n";22552256if(defined($work->{workDir}) )2257{2258 rmtree($work->{workDir} );2259undef$work->{workDir};2260}2261undef$work->{state};2262}22632264# Setup a temporary directory (not a working tree), typically for2265# merging dirty state as in req_update.2266sub setupTmpDir2267{2268$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);2269chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";22702271return$work->{tmpDir};2272}22732274# Clean up a previously setupTmpDir. Restore previous work tree if2275# appropriate.2276sub cleanupTmpDir2277{2278if( !defined($work->{tmpDir}) )2279{2280$log->warn("cleanup tmpdir that has not been setup");2281die"Cleanup tmpDir that has not been setup\n";2282}2283if(defined($work->{state}) )2284{2285if($work->{state} ==1)2286{2287chdir$work->{emptyDir}or2288die"Unable to chdir to$work->{emptyDir}\n";2289}2290elsif($work->{state} ==2)2291{2292chdir$work->{workDir}or2293die"Unable to chdir to$work->{emptyDir}\n";2294}2295else2296{2297$log->warn("Inconsistent work dir state");2298die"Inconsistent work dir state\n";2299}2300}2301else2302{2303chdir"/"or die"Unable to chdir '/'\n";2304}2305}23062307# Given a path, this function returns a string containing the kopts2308# that should go into that path's Entries line. For example, a binary2309# file should get -kb.2310sub kopts_from_path2311{2312my($path,$srcType,$name) =@_;23132314if(defined($cfg->{gitcvs}{usecrlfattr} )and2315$cfg->{gitcvs}{usecrlfattr} =~/\s*(1|true|yes)\s*$/i)2316{2317my($val) = check_attr("crlf",$path);2318if($valeq"set")2319{2320return"";2321}2322elsif($valeq"unset")2323{2324return"-kb"2325}2326else2327{2328$log->info("Unrecognized check_attr crlf$path:$val");2329}2330}23312332if(defined($cfg->{gitcvs}{allbinary} ) )2333{2334if( ($cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i) )2335{2336return"-kb";2337}2338elsif( ($cfg->{gitcvs}{allbinary} =~/^\s*guess\s*$/i) )2339{2340if($srcTypeeq"sha1Or-k"&&2341!defined($name) )2342{2343my($ret)=$state->{entries}{$path}{options};2344if( !defined($ret) )2345{2346$ret=$state->{opt}{k};2347if(defined($ret))2348{2349$ret="-k$ret";2350}2351else2352{2353$ret="";2354}2355}2356if( ! ($ret=~/^(|-kb|-kkv|-kkvl|-kk|-ko|-kv)$/) )2357{2358print"E Bad -k option\n";2359$log->warn("Bad -k option:$ret");2360die"Error: Bad -k option:$ret\n";2361}23622363return$ret;2364}2365else2366{2367if( is_binary($srcType,$name) )2368{2369$log->debug("... as binary");2370return"-kb";2371}2372else2373{2374$log->debug("... as text");2375}2376}2377}2378}2379# Return "" to give no special treatment to any path2380return"";2381}23822383sub check_attr2384{2385my($attr,$path) =@_;2386 ensureWorkTree();2387if(open my$fh,'-|',"git","check-attr",$attr,"--",$path)2388{2389my$val= <$fh>;2390close$fh;2391$val=~s/.*: ([^:\r\n]*)\s*$/$1/;2392return$val;2393}2394else2395{2396returnundef;2397}2398}23992400# This should have the same heuristics as convert.c:is_binary() and related.2401# Note that the bare CR test is done by callers in convert.c.2402sub is_binary2403{2404my($srcType,$name) =@_;2405$log->debug("is_binary($srcType,$name)");24062407# Minimize amount of interpreted code run in the inner per-character2408# loop for large files, by totalling each character value and2409# then analyzing the totals.2410my@counts;2411my$i;2412for($i=0;$i<256;$i++)2413{2414$counts[$i]=0;2415}24162417my$fh= open_blob_or_die($srcType,$name);2418my$line;2419while(defined($line=<$fh>) )2420{2421# Any '\0' and bare CR are considered binary.2422if($line=~/\0|(\r[^\n])/)2423{2424close($fh);2425return1;2426}24272428# Count up each character in the line:2429my$len=length($line);2430for($i=0;$i<$len;$i++)2431{2432$counts[ord(substr($line,$i,1))]++;2433}2434}2435close$fh;24362437# Don't count CR and LF as either printable/nonprintable2438$counts[ord("\n")]=0;2439$counts[ord("\r")]=0;24402441# Categorize individual character count into printable and nonprintable:2442my$printable=0;2443my$nonprintable=0;2444for($i=0;$i<256;$i++)2445{2446if($i<32&&2447$i!=ord("\b") &&2448$i!=ord("\t") &&2449$i!=033&&# ESC2450$i!=014)# FF2451{2452$nonprintable+=$counts[$i];2453}2454elsif($i==127)# DEL2455{2456$nonprintable+=$counts[$i];2457}2458else2459{2460$printable+=$counts[$i];2461}2462}24632464return($printable>>7) <$nonprintable;2465}24662467# Returns open file handle. Possible invocations:2468# - open_blob_or_die("file",$filename);2469# - open_blob_or_die("sha1",$filehash);2470sub open_blob_or_die2471{2472my($srcType,$name) =@_;2473my($fh);2474if($srcTypeeq"file")2475{2476if( !open$fh,"<",$name)2477{2478$log->warn("Unable to open file$name:$!");2479die"Unable to open file$name:$!\n";2480}2481}2482elsif($srcTypeeq"sha1"||$srcTypeeq"sha1Or-k")2483{2484unless(defined($name)and$name=~/^[a-zA-Z0-9]{40}$/)2485{2486$log->warn("Need filehash");2487die"Need filehash\n";2488}24892490my$type=`git cat-file -t$name`;2491 chomp$type;24922493 unless ( defined ($type) and$typeeq "blob" )2494 {2495$log->warn("Invalid type '$type' for '$name'");2496 die ( "Invalid type '$type' (expected 'blob')" )2497 }24982499 my$size= `git cat-file -s $name`;2500chomp$size;25012502$log->debug("open_blob_or_die($name) size=$size, type=$type");25032504unless(open$fh,'-|',"git","cat-file","blob",$name)2505{2506$log->warn("Unable to open sha1$name");2507die"Unable to open sha1$name\n";2508}2509}2510else2511{2512$log->warn("Unknown type of blob source:$srcType");2513die"Unknown type of blob source:$srcType\n";2514}2515return$fh;2516}25172518# Generate a CVS author name from Git author information, by taking2519# the first eight characters of the user part of the email address.2520sub cvs_author2521{2522my$author_line=shift;2523(my$author) =$author_line=~/<([^>@]{1,8})/;25242525$author;2526}25272528package GITCVS::log;25292530####2531#### Copyright The Open University UK - 2006.2532####2533#### Authors: Martyn Smith <martyn@catalyst.net.nz>2534#### Martin Langhoff <martin@catalyst.net.nz>2535####2536####25372538use strict;2539use warnings;25402541=head1 NAME25422543GITCVS::log25442545=head1 DESCRIPTION25462547This module provides very crude logging with a similar interface to2548Log::Log4perl25492550=head1 METHODS25512552=cut25532554=head2 new25552556Creates a new log object, optionally you can specify a filename here to2557indicate the file to log to. If no log file is specified, you can specify one2558later with method setfile, or indicate you no longer want logging with method2559nofile.25602561Until one of these methods is called, all log calls will buffer messages ready2562to write out.25632564=cut2565sub new2566{2567my$class=shift;2568my$filename=shift;25692570my$self= {};25712572bless$self,$class;25732574if(defined($filename) )2575{2576open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2577}25782579return$self;2580}25812582=head2 setfile25832584This methods takes a filename, and attempts to open that file as the log file.2585If successful, all buffered data is written out to the file, and any further2586logging is written directly to the file.25872588=cut2589sub setfile2590{2591my$self=shift;2592my$filename=shift;25932594if(defined($filename) )2595{2596open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2597}25982599return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");26002601while(my$line=shift@{$self->{buffer}} )2602{2603print{$self->{fh}}$line;2604}2605}26062607=head2 nofile26082609This method indicates no logging is going to be used. It flushes any entries in2610the internal buffer, and sets a flag to ensure no further data is put there.26112612=cut2613sub nofile2614{2615my$self=shift;26162617$self->{nolog} =1;26182619return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");26202621$self->{buffer} = [];2622}26232624=head2 _logopen26252626Internal method. Returns true if the log file is open, false otherwise.26272628=cut2629sub _logopen2630{2631my$self=shift;26322633return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2634return0;2635}26362637=head2 debug info warn fatal26382639These four methods are wrappers to _log. They provide the actual interface for2640logging data.26412642=cut2643sub debug {my$self=shift;$self->_log("debug",@_); }2644sub info {my$self=shift;$self->_log("info",@_); }2645subwarn{my$self=shift;$self->_log("warn",@_); }2646sub fatal {my$self=shift;$self->_log("fatal",@_); }26472648=head2 _log26492650This is an internal method called by the logging functions. It generates a2651timestamp and pushes the logged line either to file, or internal buffer.26522653=cut2654sub _log2655{2656my$self=shift;2657my$level=shift;26582659return if($self->{nolog} );26602661my@time=localtime;2662my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2663$time[5] +1900,2664$time[4] +1,2665$time[3],2666$time[2],2667$time[1],2668$time[0],2669uc$level,2670);26712672if($self->_logopen)2673{2674print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2675}else{2676push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2677}2678}26792680=head2 DESTROY26812682This method simply closes the file handle if one is open26832684=cut2685sub DESTROY2686{2687my$self=shift;26882689if($self->_logopen)2690{2691close$self->{fh};2692}2693}26942695package GITCVS::updater;26962697####2698#### Copyright The Open University UK - 2006.2699####2700#### Authors: Martyn Smith <martyn@catalyst.net.nz>2701#### Martin Langhoff <martin@catalyst.net.nz>2702####2703####27042705use strict;2706use warnings;2707use DBI;27082709=head1 METHODS27102711=cut27122713=head2 new27142715=cut2716sub new2717{2718my$class=shift;2719my$config=shift;2720my$module=shift;2721my$log=shift;27222723die"Need to specify a git repository"unless(defined($config)and-d $config);2724die"Need to specify a module"unless(defined($module) );27252726$class=ref($class) ||$class;27272728my$self= {};27292730bless$self,$class;27312732$self->{valid_tables} = {'revision'=>1,2733'revision_ix1'=>1,2734'revision_ix2'=>1,2735'head'=>1,2736'head_ix1'=>1,2737'properties'=>1,2738'commitmsgs'=>1};27392740$self->{module} =$module;2741$self->{git_path} =$config."/";27422743$self->{log} =$log;27442745die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );27462747$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2748$cfg->{gitcvs}{dbdriver} ||"SQLite";2749$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2750$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2751$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2752$cfg->{gitcvs}{dbuser} ||"";2753$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2754$cfg->{gitcvs}{dbpass} ||"";2755$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||2756$cfg->{gitcvs}{dbtablenameprefix} ||"";2757my%mapping= ( m =>$module,2758 a =>$state->{method},2759 u =>getlogin||getpwuid($<) || $<,2760 G =>$self->{git_path},2761 g => mangle_dirname($self->{git_path}),2762);2763$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2764$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;2765$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;2766$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});27672768die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2769die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2770$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2771$self->{dbuser},2772$self->{dbpass});2773die"Error connecting to database\n"unlessdefined$self->{dbh};27742775$self->{tables} = {};2776foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2777{2778$self->{tables}{$table} =1;2779}27802781# Construct the revision table if required2782unless($self->{tables}{$self->tablename("revision")} )2783{2784my$tablename=$self->tablename("revision");2785my$ix1name=$self->tablename("revision_ix1");2786my$ix2name=$self->tablename("revision_ix2");2787$self->{dbh}->do("2788 CREATE TABLE$tablename(2789 name TEXT NOT NULL,2790 revision INTEGER NOT NULL,2791 filehash TEXT NOT NULL,2792 commithash TEXT NOT NULL,2793 author TEXT NOT NULL,2794 modified TEXT NOT NULL,2795 mode TEXT NOT NULL2796 )2797 ");2798$self->{dbh}->do("2799 CREATE INDEX$ix1name2800 ON$tablename(name,revision)2801 ");2802$self->{dbh}->do("2803 CREATE INDEX$ix2name2804 ON$tablename(name,commithash)2805 ");2806}28072808# Construct the head table if required2809unless($self->{tables}{$self->tablename("head")} )2810{2811my$tablename=$self->tablename("head");2812my$ix1name=$self->tablename("head_ix1");2813$self->{dbh}->do("2814 CREATE TABLE$tablename(2815 name TEXT NOT NULL,2816 revision INTEGER NOT NULL,2817 filehash TEXT NOT NULL,2818 commithash TEXT NOT NULL,2819 author TEXT NOT NULL,2820 modified TEXT NOT NULL,2821 mode TEXT NOT NULL2822 )2823 ");2824$self->{dbh}->do("2825 CREATE INDEX$ix1name2826 ON$tablename(name)2827 ");2828}28292830# Construct the properties table if required2831unless($self->{tables}{$self->tablename("properties")} )2832{2833my$tablename=$self->tablename("properties");2834$self->{dbh}->do("2835 CREATE TABLE$tablename(2836 key TEXT NOT NULL PRIMARY KEY,2837 value TEXT2838 )2839 ");2840}28412842# Construct the commitmsgs table if required2843unless($self->{tables}{$self->tablename("commitmsgs")} )2844{2845my$tablename=$self->tablename("commitmsgs");2846$self->{dbh}->do("2847 CREATE TABLE$tablename(2848 key TEXT NOT NULL PRIMARY KEY,2849 value TEXT2850 )2851 ");2852}28532854return$self;2855}28562857=head2 tablename28582859=cut2860sub tablename2861{2862my$self=shift;2863my$name=shift;28642865if(exists$self->{valid_tables}{$name}) {2866return$self->{dbtablenameprefix} .$name;2867}else{2868returnundef;2869}2870}28712872=head2 update28732874=cut2875sub update2876{2877my$self=shift;28782879# first lets get the commit list2880$ENV{GIT_DIR} =$self->{git_path};28812882my$commitsha1=`git rev-parse$self->{module}`;2883chomp$commitsha1;28842885my$commitinfo=`git cat-file commit$self->{module} 2>&1`;2886unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2887{2888die("Invalid module '$self->{module}'");2889}289028912892my$git_log;2893my$lastcommit=$self->_get_prop("last_commit");28942895if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date2896return1;2897}28982899# Start exclusive lock here...2900$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";29012902# TODO: log processing is memory bound2903# if we can parse into a 2nd file that is in reverse order2904# we can probably do something really efficient2905my@git_log_params= ('--pretty','--parents','--topo-order');29062907if(defined$lastcommit) {2908push@git_log_params,"$lastcommit..$self->{module}";2909}else{2910push@git_log_params,$self->{module};2911}2912# git-rev-list is the backend / plumbing version of git-log2913open(GITLOG,'-|','git-rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";29142915my@commits;29162917my%commit= ();29182919while( <GITLOG> )2920{2921chomp;2922if(m/^commit\s+(.*)$/) {2923# on ^commit lines put the just seen commit in the stack2924# and prime things for the next one2925if(keys%commit) {2926my%copy=%commit;2927unshift@commits, \%copy;2928%commit= ();2929}2930my@parents=split(m/\s+/,$1);2931$commit{hash} =shift@parents;2932$commit{parents} = \@parents;2933}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2934# on rfc822-like lines seen before we see any message,2935# lowercase the entry and put it in the hash as key-value2936$commit{lc($1)} =$2;2937}else{2938# message lines - skip initial empty line2939# and trim whitespace2940if(!exists($commit{message}) &&m/^\s*$/) {2941# define it to mark the end of headers2942$commit{message} ='';2943next;2944}2945s/^\s+//;s/\s+$//;# trim ws2946$commit{message} .=$_."\n";2947}2948}2949close GITLOG;29502951unshift@commits, \%commitif(keys%commit);29522953# Now all the commits are in the @commits bucket2954# ordered by time DESC. for each commit that needs processing,2955# determine whether it's following the last head we've seen or if2956# it's on its own branch, grab a file list, and add whatever's changed2957# NOTE: $lastcommit refers to the last commit from previous run2958# $lastpicked is the last commit we picked in this run2959my$lastpicked;2960my$head= {};2961if(defined$lastcommit) {2962$lastpicked=$lastcommit;2963}29642965my$committotal=scalar(@commits);2966my$commitcount=0;29672968# Load the head table into $head (for cached lookups during the update process)2969foreachmy$file( @{$self->gethead()} )2970{2971$head->{$file->{name}} =$file;2972}29732974foreachmy$commit(@commits)2975{2976$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2977if(defined$lastpicked)2978{2979if(!in_array($lastpicked, @{$commit->{parents}}))2980{2981# skip, we'll see this delta2982# as part of a merge later2983# warn "skipping off-track $commit->{hash}\n";2984next;2985}elsif(@{$commit->{parents}} >1) {2986# it is a merge commit, for each parent that is2987# not $lastpicked, see if we can get a log2988# from the merge-base to that parent to put it2989# in the message as a merge summary.2990my@parents= @{$commit->{parents}};2991foreachmy$parent(@parents) {2992# git-merge-base can potentially (but rarely) throw2993# several candidate merge bases. let's assume2994# that the first one is the best one.2995if($parenteq$lastpicked) {2996next;2997}2998my$base=eval{2999 safe_pipe_capture('git-merge-base',3000$lastpicked,$parent);3001};3002# The two branches may not be related at all,3003# in which case merge base simply fails to find3004# any, but that's Ok.3005next if($@);30063007chomp$base;3008if($base) {3009my@merged;3010# print "want to log between $base $parent \n";3011open(GITLOG,'-|','git-log','--pretty=medium',"$base..$parent")3012or die"Cannot call git-log:$!";3013my$mergedhash;3014while(<GITLOG>) {3015chomp;3016if(!defined$mergedhash) {3017if(m/^commit\s+(.+)$/) {3018$mergedhash=$1;3019}else{3020next;3021}3022}else{3023# grab the first line that looks non-rfc8223024# aka has content after leading space3025if(m/^\s+(\S.*)$/) {3026my$title=$1;3027$title=substr($title,0,100);# truncate3028unshift@merged,"$mergedhash$title";3029undef$mergedhash;3030}3031}3032}3033close GITLOG;3034if(@merged) {3035$commit->{mergemsg} =$commit->{message};3036$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3037foreachmy$summary(@merged) {3038$commit->{mergemsg} .="\t$summary\n";3039}3040$commit->{mergemsg} .="\n\n";3041# print "Message for $commit->{hash} \n$commit->{mergemsg}";3042}3043}3044}3045}3046}30473048# convert the date to CVS-happy format3049$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);30503051if(defined($lastpicked) )3052{3053my$filepipe=open(FILELIST,'-|','git-diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3054local($/) ="\0";3055while( <FILELIST> )3056{3057chomp;3058unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)3059{3060die("Couldn't process git-diff-tree line :$_");3061}3062my($mode,$hash,$change) = ($1,$2,$3);3063my$name= <FILELIST>;3064chomp($name);30653066# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");30673068my$git_perms="";3069$git_perms.="r"if($mode&4);3070$git_perms.="w"if($mode&2);3071$git_perms.="x"if($mode&1);3072$git_perms="rw"if($git_permseq"");30733074if($changeeq"D")3075{3076#$log->debug("DELETE $name");3077$head->{$name} = {3078 name =>$name,3079 revision =>$head->{$name}{revision} +1,3080 filehash =>"deleted",3081 commithash =>$commit->{hash},3082 modified =>$commit->{date},3083 author =>$commit->{author},3084 mode =>$git_perms,3085};3086$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3087}3088elsif($changeeq"M"||$changeeq"T")3089{3090#$log->debug("MODIFIED $name");3091$head->{$name} = {3092 name =>$name,3093 revision =>$head->{$name}{revision} +1,3094 filehash =>$hash,3095 commithash =>$commit->{hash},3096 modified =>$commit->{date},3097 author =>$commit->{author},3098 mode =>$git_perms,3099};3100$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3101}3102elsif($changeeq"A")3103{3104#$log->debug("ADDED $name");3105$head->{$name} = {3106 name =>$name,3107 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3108 filehash =>$hash,3109 commithash =>$commit->{hash},3110 modified =>$commit->{date},3111 author =>$commit->{author},3112 mode =>$git_perms,3113};3114$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3115}3116else3117{3118$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");3119die;3120}3121}3122close FILELIST;3123}else{3124# this is used to detect files removed from the repo3125my$seen_files= {};31263127my$filepipe=open(FILELIST,'-|','git-ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");3128local$/="\0";3129while( <FILELIST> )3130{3131chomp;3132unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)3133{3134die("Couldn't process git-ls-tree line :$_");3135}31363137my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);31383139$seen_files->{$git_filename} =1;31403141my($oldhash,$oldrevision,$oldmode) = (3142$head->{$git_filename}{filehash},3143$head->{$git_filename}{revision},3144$head->{$git_filename}{mode}3145);31463147if($git_perms=~/^\d\d\d(\d)\d\d/o)3148{3149$git_perms="";3150$git_perms.="r"if($1&4);3151$git_perms.="w"if($1&2);3152$git_perms.="x"if($1&1);3153}else{3154$git_perms="rw";3155}31563157# unless the file exists with the same hash, we need to update it ...3158unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)3159{3160my$newrevision= ($oldrevisionor0) +1;31613162$head->{$git_filename} = {3163 name =>$git_filename,3164 revision =>$newrevision,3165 filehash =>$git_hash,3166 commithash =>$commit->{hash},3167 modified =>$commit->{date},3168 author =>$commit->{author},3169 mode =>$git_perms,3170};317131723173$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3174}3175}3176close FILELIST;31773178# Detect deleted files3179foreachmy$file(keys%$head)3180{3181unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")3182{3183$head->{$file}{revision}++;3184$head->{$file}{filehash} ="deleted";3185$head->{$file}{commithash} =$commit->{hash};3186$head->{$file}{modified} =$commit->{date};3187$head->{$file}{author} =$commit->{author};31883189$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});3190}3191}3192# END : "Detect deleted files"3193}319431953196if(exists$commit->{mergemsg})3197{3198$self->insert_mergelog($commit->{hash},$commit->{mergemsg});3199}32003201$lastpicked=$commit->{hash};32023203$self->_set_prop("last_commit",$commit->{hash});3204}32053206$self->delete_head();3207foreachmy$file(keys%$head)3208{3209$self->insert_head(3210$file,3211$head->{$file}{revision},3212$head->{$file}{filehash},3213$head->{$file}{commithash},3214$head->{$file}{modified},3215$head->{$file}{author},3216$head->{$file}{mode},3217);3218}3219# invalidate the gethead cache3220$self->{gethead_cache} =undef;322132223223# Ending exclusive lock here3224$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3225}32263227sub insert_rev3228{3229my$self=shift;3230my$name=shift;3231my$revision=shift;3232my$filehash=shift;3233my$commithash=shift;3234my$modified=shift;3235my$author=shift;3236my$mode=shift;3237my$tablename=$self->tablename("revision");32383239my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3240$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3241}32423243sub insert_mergelog3244{3245my$self=shift;3246my$key=shift;3247my$value=shift;3248my$tablename=$self->tablename("commitmsgs");32493250my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3251$insert_mergelog->execute($key,$value);3252}32533254sub delete_head3255{3256my$self=shift;3257my$tablename=$self->tablename("head");32583259my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3260$delete_head->execute();3261}32623263sub insert_head3264{3265my$self=shift;3266my$name=shift;3267my$revision=shift;3268my$filehash=shift;3269my$commithash=shift;3270my$modified=shift;3271my$author=shift;3272my$mode=shift;3273my$tablename=$self->tablename("head");32743275my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3276$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3277}32783279sub _headrev3280{3281my$self=shift;3282my$filename=shift;3283my$tablename=$self->tablename("head");32843285my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM$tablenameWHERE name=?",{},1);3286$db_query->execute($filename);3287my($hash,$revision,$mode) =$db_query->fetchrow_array;32883289return($hash,$revision,$mode);3290}32913292sub _get_prop3293{3294my$self=shift;3295my$key=shift;3296my$tablename=$self->tablename("properties");32973298my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3299$db_query->execute($key);3300my($value) =$db_query->fetchrow_array;33013302return$value;3303}33043305sub _set_prop3306{3307my$self=shift;3308my$key=shift;3309my$value=shift;3310my$tablename=$self->tablename("properties");33113312my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3313$db_query->execute($value,$key);33143315unless($db_query->rows)3316{3317$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3318$db_query->execute($key,$value);3319}33203321return$value;3322}33233324=head2 gethead33253326=cut33273328sub gethead3329{3330my$self=shift;3331my$tablename=$self->tablename("head");33323333return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );33343335my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3336$db_query->execute();33373338my$tree= [];3339while(my$file=$db_query->fetchrow_hashref)3340{3341push@$tree,$file;3342}33433344$self->{gethead_cache} =$tree;33453346return$tree;3347}33483349=head2 getlog33503351=cut33523353sub getlog3354{3355my$self=shift;3356my$filename=shift;3357my$tablename=$self->tablename("revision");33583359my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3360$db_query->execute($filename);33613362my$tree= [];3363while(my$file=$db_query->fetchrow_hashref)3364{3365push@$tree,$file;3366}33673368return$tree;3369}33703371=head2 getmeta33723373This function takes a filename (with path) argument and returns a hashref of3374metadata for that file.33753376=cut33773378sub getmeta3379{3380my$self=shift;3381my$filename=shift;3382my$revision=shift;3383my$tablename_rev=$self->tablename("revision");3384my$tablename_head=$self->tablename("head");33853386my$db_query;3387if(defined($revision)and$revision=~/^\d+$/)3388{3389$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND revision=?",{},1);3390$db_query->execute($filename,$revision);3391}3392elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)3393{3394$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND commithash=?",{},1);3395$db_query->execute($filename,$revision);3396}else{3397$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_headWHERE name=?",{},1);3398$db_query->execute($filename);3399}34003401return$db_query->fetchrow_hashref;3402}34033404=head2 commitmessage34053406this function takes a commithash and returns the commit message for that commit34073408=cut3409sub commitmessage3410{3411my$self=shift;3412my$commithash=shift;3413my$tablename=$self->tablename("commitmsgs");34143415die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);34163417my$db_query;3418$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3419$db_query->execute($commithash);34203421my($message) =$db_query->fetchrow_array;34223423if(defined($message) )3424{3425$message.=" "if($message=~/\n$/);3426return$message;3427}34283429my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);3430shift@lineswhile($lines[0] =~/\S/);3431$message=join("",@lines);3432$message.=" "if($message=~/\n$/);3433return$message;3434}34353436=head2 gethistory34373438This function takes a filename (with path) argument and returns an arrayofarrays3439containing revision,filehash,commithash ordered by revision descending34403441=cut3442sub gethistory3443{3444my$self=shift;3445my$filename=shift;3446my$tablename=$self->tablename("revision");34473448my$db_query;3449$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3450$db_query->execute($filename);34513452return$db_query->fetchall_arrayref;3453}34543455=head2 gethistorydense34563457This function takes a filename (with path) argument and returns an arrayofarrays3458containing revision,filehash,commithash ordered by revision descending.34593460This version of gethistory skips deleted entries -- so it is useful for annotate.3461The 'dense' part is a reference to a '--dense' option available for git-rev-list3462and other git tools that depend on it.34633464=cut3465sub gethistorydense3466{3467my$self=shift;3468my$filename=shift;3469my$tablename=$self->tablename("revision");34703471my$db_query;3472$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);3473$db_query->execute($filename);34743475return$db_query->fetchall_arrayref;3476}34773478=head2 in_array()34793480from Array::PAT - mimics the in_array() function3481found in PHP. Yuck but works for small arrays.34823483=cut3484sub in_array3485{3486my($check,@array) =@_;3487my$retval=0;3488foreachmy$test(@array){3489if($checkeq$test){3490$retval=1;3491}3492}3493return$retval;3494}34953496=head2 safe_pipe_capture34973498an alternative to `command` that allows input to be passed as an array3499to work around shell problems with weird characters in arguments35003501=cut3502sub safe_pipe_capture {35033504my@output;35053506if(my$pid=open my$child,'-|') {3507@output= (<$child>);3508close$childor die join(' ',@_).":$!$?";3509}else{3510exec(@_)or die"$!$?";# exec() can fail the executable can't be found3511}3512returnwantarray?@output:join('',@output);3513}35143515=head2 mangle_dirname35163517create a string from a directory name that is suitable to use as3518part of a filename, mainly by converting all chars except \w.- to _35193520=cut3521sub mangle_dirname {3522my$dirname=shift;3523return unlessdefined$dirname;35243525$dirname=~s/[^\w.-]/_/g;35263527return$dirname;3528}35293530=head2 mangle_tablename35313532create a string from a that is suitable to use as part of an SQL table3533name, mainly by converting all chars except \w to _35343535=cut3536sub mangle_tablename {3537my$tablename=shift;3538return unlessdefined$tablename;35393540$tablename=~s/[^\w_]/_/g;35413542return$tablename;3543}354435451;