1#!/usr/bin/perl 2 3#### 4#### This application is a CVS emulation layer for git. 5#### It is intended for clients to connect over SSH. 6#### See the documentation for more details. 7#### 8#### Copyright The Open University UK - 2006. 9#### 10#### Authors: Martyn Smith <martyn@catalyst.net.nz> 11#### Martin Langhoff <martin@catalyst.net.nz> 12#### 13#### 14#### Released under the GNU Public License, version 2. 15#### 16#### 17 18use strict; 19use warnings; 20use bytes; 21 22use Fcntl; 23use File::Temp qw/tempdir tempfile/; 24use File::Path qw/rmtree/; 25use File::Basename; 26use Getopt::Long qw(:config require_order no_ignore_case); 27 28my$VERSION='@@GIT_VERSION@@'; 29 30my$log= GITCVS::log->new(); 31my$cfg; 32 33my$DATE_LIST= { 34 Jan =>"01", 35 Feb =>"02", 36 Mar =>"03", 37 Apr =>"04", 38 May =>"05", 39 Jun =>"06", 40 Jul =>"07", 41 Aug =>"08", 42 Sep =>"09", 43 Oct =>"10", 44 Nov =>"11", 45 Dec =>"12", 46}; 47 48# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 49$| =1; 50 51#### Definition and mappings of functions #### 52 53my$methods= { 54'Root'=> \&req_Root, 55'Valid-responses'=> \&req_Validresponses, 56'valid-requests'=> \&req_validrequests, 57'Directory'=> \&req_Directory, 58'Entry'=> \&req_Entry, 59'Modified'=> \&req_Modified, 60'Unchanged'=> \&req_Unchanged, 61'Questionable'=> \&req_Questionable, 62'Argument'=> \&req_Argument, 63'Argumentx'=> \&req_Argument, 64'expand-modules'=> \&req_expandmodules, 65'add'=> \&req_add, 66'remove'=> \&req_remove, 67'co'=> \&req_co, 68'update'=> \&req_update, 69'ci'=> \&req_ci, 70'diff'=> \&req_diff, 71'log'=> \&req_log, 72'rlog'=> \&req_log, 73'tag'=> \&req_CATCHALL, 74'status'=> \&req_status, 75'admin'=> \&req_CATCHALL, 76'history'=> \&req_CATCHALL, 77'watchers'=> \&req_EMPTY, 78'editors'=> \&req_EMPTY, 79'noop'=> \&req_EMPTY, 80'annotate'=> \&req_annotate, 81'Global_option'=> \&req_Globaloption, 82#'annotate' => \&req_CATCHALL, 83}; 84 85############################################## 86 87 88# $state holds all the bits of information the clients sends us that could 89# potentially be useful when it comes to actually _doing_ something. 90my$state= { prependdir =>''}; 91 92# Work is for managing temporary working directory 93my$work= 94{ 95state=>undef,# undef, 1 (empty), 2 (with stuff) 96 workDir =>undef, 97index=>undef, 98 emptyDir =>undef, 99 tmpDir =>undef 100}; 101 102$log->info("--------------- STARTING -----------------"); 103 104my$usage= 105"Usage: git cvsserver [options] [pserver|server] [<directory> ...]\n". 106" --base-path <path> : Prepend to requested CVSROOT\n". 107" --strict-paths : Don't allow recursing into subdirectories\n". 108" --export-all : Don't check for gitcvs.enabled in config\n". 109" --version, -V : Print version information and exit\n". 110" --help, -h, -H : Print usage information and exit\n". 111"\n". 112"<directory> ... is a list of allowed directories. If no directories\n". 113"are given, all are allowed. This is an additional restriction, gitcvs\n". 114"access still needs to be enabled by the gitcvs.enabled config option.\n"; 115 116my@opts= ('help|h|H','version|V', 117'base-path=s','strict-paths','export-all'); 118GetOptions($state,@opts) 119or die$usage; 120 121if($state->{version}) { 122print"git-cvsserver version$VERSION\n"; 123exit; 124} 125if($state->{help}) { 126print$usage; 127exit; 128} 129 130my$TEMP_DIR= tempdir( CLEANUP =>1); 131$log->debug("Temporary directory is '$TEMP_DIR'"); 132 133$state->{method} ='ext'; 134if(@ARGV) { 135if($ARGV[0]eq'pserver') { 136$state->{method} ='pserver'; 137shift@ARGV; 138}elsif($ARGV[0]eq'server') { 139shift@ARGV; 140} 141} 142 143# everything else is a directory 144$state->{allowed_roots} = [@ARGV]; 145 146# don't export the whole system unless the users requests it 147if($state->{'export-all'} && !@{$state->{allowed_roots}}) { 148die"--export-all can only be used together with an explicit whitelist\n"; 149} 150 151# if we are called with a pserver argument, 152# deal with the authentication cat before entering the 153# main loop 154if($state->{method}eq'pserver') { 155my$line= <STDIN>;chomp$line; 156unless($line=~/^BEGIN (AUTH|VERIFICATION) REQUEST$/) { 157die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 158} 159my$request=$1; 160$line= <STDIN>;chomp$line; 161unless(req_Root('root',$line)) {# reuse Root 162print"E Invalid root$line\n"; 163exit1; 164} 165$line= <STDIN>;chomp$line; 166unless($lineeq'anonymous') { 167print"E Only anonymous user allowed via pserver\n"; 168print"I HATE YOU\n"; 169exit1; 170} 171$line= <STDIN>;chomp$line;# validate the password? 172$line= <STDIN>;chomp$line; 173unless($lineeq"END$requestREQUEST") { 174die"E Do not understand$line-- expecting END$requestREQUEST\n"; 175} 176print"I LOVE YOU\n"; 177exit if$requesteq'VERIFICATION';# cvs login 178# and now back to our regular programme... 179} 180 181# Keep going until the client closes the connection 182while(<STDIN>) 183{ 184chomp; 185 186# Check to see if we've seen this method, and call appropriate function. 187if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 188{ 189# use the $methods hash to call the appropriate sub for this command 190#$log->info("Method : $1"); 191&{$methods->{$1}}($1,$2); 192}else{ 193# log fatal because we don't understand this function. If this happens 194# we're fairly screwed because we don't know if the client is expecting 195# a response. If it is, the client will hang, we'll hang, and the whole 196# thing will be custard. 197$log->fatal("Don't understand command$_\n"); 198die("Unknown command$_"); 199} 200} 201 202$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 203$log->info("--------------- FINISH -----------------"); 204 205chdir'/'; 206exit0; 207 208# Magic catchall method. 209# This is the method that will handle all commands we haven't yet 210# implemented. It simply sends a warning to the log file indicating a 211# command that hasn't been implemented has been invoked. 212sub req_CATCHALL 213{ 214my($cmd,$data) =@_; 215$log->warn("Unhandled command : req_$cmd:$data"); 216} 217 218# This method invariably succeeds with an empty response. 219sub req_EMPTY 220{ 221print"ok\n"; 222} 223 224# Root pathname \n 225# Response expected: no. Tell the server which CVSROOT to use. Note that 226# pathname is a local directory and not a fully qualified CVSROOT variable. 227# pathname must already exist; if creating a new root, use the init 228# request, not Root. pathname does not include the hostname of the server, 229# how to access the server, etc.; by the time the CVS protocol is in use, 230# connection, authentication, etc., are already taken care of. The Root 231# request must be sent only once, and it must be sent before any requests 232# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 233sub req_Root 234{ 235my($cmd,$data) =@_; 236$log->debug("req_Root :$data"); 237 238unless($data=~ m#^/#) { 239print"error 1 Root must be an absolute pathname\n"; 240return0; 241} 242 243my$cvsroot=$state->{'base-path'} ||''; 244$cvsroot=~ s#/+$##; 245$cvsroot.=$data; 246 247if($state->{CVSROOT} 248&& ($state->{CVSROOT}ne$cvsroot)) { 249print"error 1 Conflicting roots specified\n"; 250return0; 251} 252 253$state->{CVSROOT} =$cvsroot; 254 255$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 256 257if(@{$state->{allowed_roots}}) { 258my$allowed=0; 259foreachmy$dir(@{$state->{allowed_roots}}) { 260next unless$dir=~ m#^/#; 261$dir=~ s#/+$##; 262if($state->{'strict-paths'}) { 263if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 264$allowed=1; 265last; 266} 267}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 268$allowed=1; 269last; 270} 271} 272 273unless($allowed) { 274print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 275print"E\n"; 276print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 277return0; 278} 279} 280 281unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 282print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 283print"E\n"; 284print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 285return0; 286} 287 288my@gitvars=`git config -l`; 289if($?) { 290print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 291print"E\n"; 292print"error 1 - problem executing git-config\n"; 293return0; 294} 295foreachmy$line(@gitvars) 296{ 297next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 298unless($2) { 299$cfg->{$1}{$3} =$4; 300}else{ 301$cfg->{$1}{$2}{$3} =$4; 302} 303} 304 305my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 306||$cfg->{gitcvs}{enabled}); 307unless($state->{'export-all'} || 308($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 309print"E GITCVS emulation needs to be enabled on this repo\n"; 310print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 311print"E\n"; 312print"error 1 GITCVS emulation disabled\n"; 313return0; 314} 315 316my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 317if($logfile) 318{ 319$log->setfile($logfile); 320}else{ 321$log->nofile(); 322} 323 324return1; 325} 326 327# Global_option option \n 328# Response expected: no. Transmit one of the global options `-q', `-Q', 329# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 330# variations (such as combining of options) are allowed. For graceful 331# handling of valid-requests, it is probably better to make new global 332# options separate requests, rather than trying to add them to this 333# request. 334sub req_Globaloption 335{ 336my($cmd,$data) =@_; 337$log->debug("req_Globaloption :$data"); 338$state->{globaloptions}{$data} =1; 339} 340 341# Valid-responses request-list \n 342# Response expected: no. Tell the server what responses the client will 343# accept. request-list is a space separated list of tokens. 344sub req_Validresponses 345{ 346my($cmd,$data) =@_; 347$log->debug("req_Validresponses :$data"); 348 349# TODO : re-enable this, currently it's not particularly useful 350#$state->{validresponses} = [ split /\s+/, $data ]; 351} 352 353# valid-requests \n 354# Response expected: yes. Ask the server to send back a Valid-requests 355# response. 356sub req_validrequests 357{ 358my($cmd,$data) =@_; 359 360$log->debug("req_validrequests"); 361 362$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 363$log->debug("SEND : ok"); 364 365print"Valid-requests ".join(" ",keys%$methods) ."\n"; 366print"ok\n"; 367} 368 369# Directory local-directory \n 370# Additional data: repository \n. Response expected: no. Tell the server 371# what directory to use. The repository should be a directory name from a 372# previous server response. Note that this both gives a default for Entry 373# and Modified and also for ci and the other commands; normal usage is to 374# send Directory for each directory in which there will be an Entry or 375# Modified, and then a final Directory for the original directory, then the 376# command. The local-directory is relative to the top level at which the 377# command is occurring (i.e. the last Directory which is sent before the 378# command); to indicate that top level, `.' should be sent for 379# local-directory. 380sub req_Directory 381{ 382my($cmd,$data) =@_; 383 384my$repository= <STDIN>; 385chomp$repository; 386 387 388$state->{localdir} =$data; 389$state->{repository} =$repository; 390$state->{path} =$repository; 391$state->{path} =~s/^$state->{CVSROOT}\///; 392$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 393$state->{path} .="/"if($state->{path} =~ /\S/ ); 394 395$state->{directory} =$state->{localdir}; 396$state->{directory} =""if($state->{directory}eq"."); 397$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 398 399if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 400{ 401$log->info("Setting prepend to '$state->{path}'"); 402$state->{prependdir} =$state->{path}; 403foreachmy$entry(keys%{$state->{entries}} ) 404{ 405$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 406delete$state->{entries}{$entry}; 407} 408} 409 410if(defined($state->{prependdir} ) ) 411{ 412$log->debug("Prepending '$state->{prependdir}' to state|directory"); 413$state->{directory} =$state->{prependdir} .$state->{directory} 414} 415$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 416} 417 418# Entry entry-line \n 419# Response expected: no. Tell the server what version of a file is on the 420# local machine. The name in entry-line is a name relative to the directory 421# most recently specified with Directory. If the user is operating on only 422# some files in a directory, Entry requests for only those files need be 423# included. If an Entry request is sent without Modified, Is-modified, or 424# Unchanged, it means the file is lost (does not exist in the working 425# directory). If both Entry and one of Modified, Is-modified, or Unchanged 426# are sent for the same file, Entry must be sent first. For a given file, 427# one can send Modified, Is-modified, or Unchanged, but not more than one 428# of these three. 429sub req_Entry 430{ 431my($cmd,$data) =@_; 432 433#$log->debug("req_Entry : $data"); 434 435my@data=split(/\//,$data); 436 437$state->{entries}{$state->{directory}.$data[1]} = { 438 revision =>$data[2], 439 conflict =>$data[3], 440 options =>$data[4], 441 tag_or_date =>$data[5], 442}; 443 444$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 445} 446 447# Questionable filename \n 448# Response expected: no. Additional data: no. Tell the server to check 449# whether filename should be ignored, and if not, next time the server 450# sends responses, send (in a M response) `?' followed by the directory and 451# filename. filename must not contain `/'; it needs to be a file in the 452# directory named by the most recent Directory request. 453sub req_Questionable 454{ 455my($cmd,$data) =@_; 456 457$log->debug("req_Questionable :$data"); 458$state->{entries}{$state->{directory}.$data}{questionable} =1; 459} 460 461# add \n 462# Response expected: yes. Add a file or directory. This uses any previous 463# Argument, Directory, Entry, or Modified requests, if they have been sent. 464# The last Directory sent specifies the working directory at the time of 465# the operation. To add a directory, send the directory to be added using 466# Directory and Argument requests. 467sub req_add 468{ 469my($cmd,$data) =@_; 470 471 argsplit("add"); 472 473my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 474$updater->update(); 475 476 argsfromdir($updater); 477 478my$addcount=0; 479 480foreachmy$filename( @{$state->{args}} ) 481{ 482$filename= filecleanup($filename); 483 484my$meta=$updater->getmeta($filename); 485my$wrev= revparse($filename); 486 487if($wrev&&$meta&& ($wrev<0)) 488{ 489# previously removed file, add back 490$log->info("added file$filenamewas previously removed, send 1.$meta->{revision}"); 491 492print"MT +updated\n"; 493print"MT text U\n"; 494print"MT fname$filename\n"; 495print"MT newline\n"; 496print"MT -updated\n"; 497 498unless($state->{globaloptions}{-n} ) 499{ 500my($filepart,$dirpart) = filenamesplit($filename,1); 501 502print"Created$dirpart\n"; 503print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 504 505# this is an "entries" line 506my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 507$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 508print"/$filepart/1.$meta->{revision}//$kopts/\n"; 509# permissions 510$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 511print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 512# transmit file 513 transmitfile($meta->{filehash}); 514} 515 516next; 517} 518 519unless(defined($state->{entries}{$filename}{modified_filename} ) ) 520{ 521print"E cvs add: nothing known about `$filename'\n"; 522next; 523} 524# TODO : check we're not squashing an already existing file 525if(defined($state->{entries}{$filename}{revision} ) ) 526{ 527print"E cvs add: `$filename' has already been entered\n"; 528next; 529} 530 531my($filepart,$dirpart) = filenamesplit($filename,1); 532 533print"E cvs add: scheduling file `$filename' for addition\n"; 534 535print"Checked-in$dirpart\n"; 536print"$filename\n"; 537my$kopts= kopts_from_path($filename,"file", 538$state->{entries}{$filename}{modified_filename}); 539print"/$filepart/0//$kopts/\n"; 540 541my$requestedKopts=$state->{opt}{k}; 542if(defined($requestedKopts)) 543{ 544$requestedKopts="-k$requestedKopts"; 545} 546else 547{ 548$requestedKopts=""; 549} 550if($koptsne$requestedKopts) 551{ 552$log->warn("Ignoring requested -k='$requestedKopts'" 553." for '$filename'; detected -k='$kopts' instead"); 554#TODO: Also have option to send warning to user? 555} 556 557$addcount++; 558} 559 560if($addcount==1) 561{ 562print"E cvs add: use `cvs commit' to add this file permanently\n"; 563} 564elsif($addcount>1) 565{ 566print"E cvs add: use `cvs commit' to add these files permanently\n"; 567} 568 569print"ok\n"; 570} 571 572# remove \n 573# Response expected: yes. Remove a file. This uses any previous Argument, 574# Directory, Entry, or Modified requests, if they have been sent. The last 575# Directory sent specifies the working directory at the time of the 576# operation. Note that this request does not actually do anything to the 577# repository; the only effect of a successful remove request is to supply 578# the client with a new entries line containing `-' to indicate a removed 579# file. In fact, the client probably could perform this operation without 580# contacting the server, although using remove may cause the server to 581# perform a few more checks. The client sends a subsequent ci request to 582# actually record the removal in the repository. 583sub req_remove 584{ 585my($cmd,$data) =@_; 586 587 argsplit("remove"); 588 589# Grab a handle to the SQLite db and do any necessary updates 590my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 591$updater->update(); 592 593#$log->debug("add state : " . Dumper($state)); 594 595my$rmcount=0; 596 597foreachmy$filename( @{$state->{args}} ) 598{ 599$filename= filecleanup($filename); 600 601if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 602{ 603print"E cvs remove: file `$filename' still in working directory\n"; 604next; 605} 606 607my$meta=$updater->getmeta($filename); 608my$wrev= revparse($filename); 609 610unless(defined($wrev) ) 611{ 612print"E cvs remove: nothing known about `$filename'\n"; 613next; 614} 615 616if(defined($wrev)and$wrev<0) 617{ 618print"E cvs remove: file `$filename' already scheduled for removal\n"; 619next; 620} 621 622unless($wrev==$meta->{revision} ) 623{ 624# TODO : not sure if the format of this message is quite correct. 625print"E cvs remove: Up to date check failed for `$filename'\n"; 626next; 627} 628 629 630my($filepart,$dirpart) = filenamesplit($filename,1); 631 632print"E cvs remove: scheduling `$filename' for removal\n"; 633 634print"Checked-in$dirpart\n"; 635print"$filename\n"; 636my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 637print"/$filepart/-1.$wrev//$kopts/\n"; 638 639$rmcount++; 640} 641 642if($rmcount==1) 643{ 644print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 645} 646elsif($rmcount>1) 647{ 648print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 649} 650 651print"ok\n"; 652} 653 654# Modified filename \n 655# Response expected: no. Additional data: mode, \n, file transmission. Send 656# the server a copy of one locally modified file. filename is a file within 657# the most recent directory sent with Directory; it must not contain `/'. 658# If the user is operating on only some files in a directory, only those 659# files need to be included. This can also be sent without Entry, if there 660# is no entry for the file. 661sub req_Modified 662{ 663my($cmd,$data) =@_; 664 665my$mode= <STDIN>; 666defined$mode 667or(print"E end of file reading mode for$data\n"),return; 668chomp$mode; 669my$size= <STDIN>; 670defined$size 671or(print"E end of file reading size of$data\n"),return; 672chomp$size; 673 674# Grab config information 675my$blocksize=8192; 676my$bytesleft=$size; 677my$tmp; 678 679# Get a filehandle/name to write it to 680my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 681 682# Loop over file data writing out to temporary file. 683while($bytesleft) 684{ 685$blocksize=$bytesleftif($bytesleft<$blocksize); 686read STDIN,$tmp,$blocksize; 687print$fh $tmp; 688$bytesleft-=$blocksize; 689} 690 691close$fh 692or(print"E failed to write temporary,$filename:$!\n"),return; 693 694# Ensure we have something sensible for the file mode 695if($mode=~/u=(\w+)/) 696{ 697$mode=$1; 698}else{ 699$mode="rw"; 700} 701 702# Save the file data in $state 703$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 704$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 705$state->{entries}{$state->{directory}.$data}{modified_hash} =`git hash-object$filename`; 706$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 707 708 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 709} 710 711# Unchanged filename\n 712# Response expected: no. Tell the server that filename has not been 713# modified in the checked out directory. The filename is a file within the 714# most recent directory sent with Directory; it must not contain `/'. 715sub req_Unchanged 716{ 717 my ($cmd,$data) =@_; 718 719$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 720 721 #$log->debug("req_Unchanged :$data"); 722} 723 724# Argument text\n 725# Response expected: no. Save argument for use in a subsequent command. 726# Arguments accumulate until an argument-using command is given, at which 727# point they are forgotten. 728# Argumentx text\n 729# Response expected: no. Append\nfollowed by text to the current argument 730# being saved. 731sub req_Argument 732{ 733 my ($cmd,$data) =@_; 734 735 # Argumentx means: append to last Argument (with a newline in front) 736 737$log->debug("$cmd:$data"); 738 739 if ($cmdeq 'Argumentx') { 740 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 741 } else { 742 push @{$state->{arguments}},$data; 743 } 744} 745 746# expand-modules\n 747# Response expected: yes. Expand the modules which are specified in the 748# arguments. Returns the data in Module-expansion responses. Note that the 749# server can assume that this is checkout or export, not rtag or rdiff; the 750# latter do not access the working directory and thus have no need to 751# expand modules on the client side. Expand may not be the best word for 752# what this request does. It does not necessarily tell you all the files 753# contained in a module, for example. Basically it is a way of telling you 754# which working directories the server needs to know about in order to 755# handle a checkout of the specified modules. For example, suppose that the 756# server has a module defined by 757# aliasmodule -a 1dir 758# That is, one can check out aliasmodule and it will take 1dir in the 759# repository and check it out to 1dir in the working directory. Now suppose 760# the client already has this module checked out and is planning on using 761# the co request to update it. Without using expand-modules, the client 762# would have two bad choices: it could either send information about all 763# working directories under the current directory, which could be 764# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 765# stands for 1dir, and neglect to send information for 1dir, which would 766# lead to incorrect operation. With expand-modules, the client would first 767# ask for the module to be expanded: 768sub req_expandmodules 769{ 770 my ($cmd,$data) =@_; 771 772 argsplit(); 773 774$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 775 776 unless ( ref$state->{arguments} eq "ARRAY" ) 777 { 778 print "ok\n"; 779 return; 780 } 781 782 foreach my$module( @{$state->{arguments}} ) 783 { 784$log->debug("SEND : Module-expansion$module"); 785 print "Module-expansion$module\n"; 786 } 787 788 print "ok\n"; 789 statecleanup(); 790} 791 792# co\n 793# Response expected: yes. Get files from the repository. This uses any 794# previous Argument, Directory, Entry, or Modified requests, if they have 795# been sent. Arguments to this command are module names; the client cannot 796# know what directories they correspond to except by (1) just sending the 797# co request, and then seeing what directory names the server sends back in 798# its responses, and (2) the expand-modules request. 799sub req_co 800{ 801 my ($cmd,$data) =@_; 802 803 argsplit("co"); 804 805 # Provide list of modules, if -c was used. 806 if (exists$state->{opt}{c}) { 807 my$showref= `git show-ref --heads`; 808 for my$line(split '\n',$showref) { 809 if ($line=~ m% refs/heads/(.*)$%) { 810 print "M$1\t$1\n"; 811 } 812 } 813 print "ok\n"; 814 return 1; 815 } 816 817 my$module=$state->{args}[0]; 818$state->{module} =$module; 819 my$checkout_path=$module; 820 821 # use the user specified directory if we're given it 822$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 823 824$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 825 826$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 827 828$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 829 830# Grab a handle to the SQLite db and do any necessary updates 831my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 832$updater->update(); 833 834$checkout_path=~ s|/$||;# get rid of trailing slashes 835 836# Eclipse seems to need the Clear-sticky command 837# to prepare the 'Entries' file for the new directory. 838print"Clear-sticky$checkout_path/\n"; 839print$state->{CVSROOT} ."/$module/\n"; 840print"Clear-static-directory$checkout_path/\n"; 841print$state->{CVSROOT} ."/$module/\n"; 842print"Clear-sticky$checkout_path/\n";# yes, twice 843print$state->{CVSROOT} ."/$module/\n"; 844print"Template$checkout_path/\n"; 845print$state->{CVSROOT} ."/$module/\n"; 846print"0\n"; 847 848# instruct the client that we're checking out to $checkout_path 849print"E cvs checkout: Updating$checkout_path\n"; 850 851my%seendirs= (); 852my$lastdir=''; 853 854# recursive 855sub prepdir { 856my($dir,$repodir,$remotedir,$seendirs) =@_; 857my$parent= dirname($dir); 858$dir=~ s|/+$||; 859$repodir=~ s|/+$||; 860$remotedir=~ s|/+$||; 861$parent=~ s|/+$||; 862$log->debug("announcedir$dir,$repodir,$remotedir"); 863 864if($parenteq'.'||$parenteq'./') { 865$parent=''; 866} 867# recurse to announce unseen parents first 868if(length($parent) && !exists($seendirs->{$parent})) { 869 prepdir($parent,$repodir,$remotedir,$seendirs); 870} 871# Announce that we are going to modify at the parent level 872if($parent) { 873print"E cvs checkout: Updating$remotedir/$parent\n"; 874}else{ 875print"E cvs checkout: Updating$remotedir\n"; 876} 877print"Clear-sticky$remotedir/$parent/\n"; 878print"$repodir/$parent/\n"; 879 880print"Clear-static-directory$remotedir/$dir/\n"; 881print"$repodir/$dir/\n"; 882print"Clear-sticky$remotedir/$parent/\n";# yes, twice 883print"$repodir/$parent/\n"; 884print"Template$remotedir/$dir/\n"; 885print"$repodir/$dir/\n"; 886print"0\n"; 887 888$seendirs->{$dir} =1; 889} 890 891foreachmy$git( @{$updater->gethead} ) 892{ 893# Don't want to check out deleted files 894next if($git->{filehash}eq"deleted"); 895 896my$fullName=$git->{name}; 897($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 898 899if(length($git->{dir}) &&$git->{dir}ne'./' 900&&$git->{dir}ne$lastdir) { 901unless(exists($seendirs{$git->{dir}})) { 902 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 903$checkout_path, \%seendirs); 904$lastdir=$git->{dir}; 905$seendirs{$git->{dir}} =1; 906} 907print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 908} 909 910# modification time of this file 911print"Mod-time$git->{modified}\n"; 912 913# print some information to the client 914if(defined($git->{dir} )and$git->{dir}ne"./") 915{ 916print"M U$checkout_path/$git->{dir}$git->{name}\n"; 917}else{ 918print"M U$checkout_path/$git->{name}\n"; 919} 920 921# instruct client we're sending a file to put in this path 922print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 923 924print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 925 926# this is an "entries" line 927my$kopts= kopts_from_path($fullName,"sha1",$git->{filehash}); 928print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 929# permissions 930print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 931 932# transmit file 933 transmitfile($git->{filehash}); 934} 935 936print"ok\n"; 937 938 statecleanup(); 939} 940 941# update \n 942# Response expected: yes. Actually do a cvs update command. This uses any 943# previous Argument, Directory, Entry, or Modified requests, if they have 944# been sent. The last Directory sent specifies the working directory at the 945# time of the operation. The -I option is not used--files which the client 946# can decide whether to ignore are not mentioned and the client sends the 947# Questionable request for others. 948sub req_update 949{ 950my($cmd,$data) =@_; 951 952$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 953 954 argsplit("update"); 955 956# 957# It may just be a client exploring the available heads/modules 958# in that case, list them as top level directories and leave it 959# at that. Eclipse uses this technique to offer you a list of 960# projects (heads in this case) to checkout. 961# 962if($state->{module}eq'') { 963my$showref=`git show-ref --heads`; 964print"E cvs update: Updating .\n"; 965formy$line(split'\n',$showref) { 966if($line=~ m% refs/heads/(.*)$%) { 967print"E cvs update: New directory `$1'\n"; 968} 969} 970print"ok\n"; 971return1; 972} 973 974 975# Grab a handle to the SQLite db and do any necessary updates 976my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 977 978$updater->update(); 979 980 argsfromdir($updater); 981 982#$log->debug("update state : " . Dumper($state)); 983 984my$last_dirname="///"; 985 986# foreach file specified on the command line ... 987foreachmy$filename( @{$state->{args}} ) 988{ 989$filename= filecleanup($filename); 990 991$log->debug("Processing file$filename"); 992 993unless($state->{globaloptions}{-Q} ||$state->{globaloptions}{-q} ) 994{ 995my$cur_dirname= dirname($filename); 996if($cur_dirnamene$last_dirname) 997{ 998$last_dirname=$cur_dirname; 999if($cur_dirnameeq"")1000{1001$cur_dirname=".";1002}1003print"E cvs update: Updating$cur_dirname\n";1004}1005}10061007# if we have a -C we should pretend we never saw modified stuff1008if(exists($state->{opt}{C} ) )1009{1010delete$state->{entries}{$filename}{modified_hash};1011delete$state->{entries}{$filename}{modified_filename};1012$state->{entries}{$filename}{unchanged} =1;1013}10141015my$meta;1016if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/)1017{1018$meta=$updater->getmeta($filename,$1);1019}else{1020$meta=$updater->getmeta($filename);1021}10221023# If -p was given, "print" the contents of the requested revision.1024if(exists($state->{opt}{p} ) ) {1025if(defined($meta->{revision} ) ) {1026$log->info("Printing '$filename' revision ".$meta->{revision});10271028 transmitfile($meta->{filehash}, {print=>1});1029}10301031next;1032}10331034if( !defined$meta)1035{1036$meta= {1037 name =>$filename,1038 revision =>0,1039 filehash =>'added'1040};1041}10421043my$oldmeta=$meta;10441045my$wrev= revparse($filename);10461047# If the working copy is an old revision, lets get that version too for comparison.1048if(defined($wrev)and$wrev!=$meta->{revision} )1049{1050$oldmeta=$updater->getmeta($filename,$wrev);1051}10521053#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");10541055# Files are up to date if the working copy and repo copy have the same revision,1056# and the working copy is unmodified _and_ the user hasn't specified -C1057next if(defined($wrev)1058and defined($meta->{revision})1059and$wrev==$meta->{revision}1060and$state->{entries}{$filename}{unchanged}1061and not exists($state->{opt}{C} ) );10621063# If the working copy and repo copy have the same revision,1064# but the working copy is modified, tell the client it's modified1065if(defined($wrev)1066and defined($meta->{revision})1067and$wrev==$meta->{revision}1068and defined($state->{entries}{$filename}{modified_hash})1069and not exists($state->{opt}{C} ) )1070{1071$log->info("Tell the client the file is modified");1072print"MT text M\n";1073print"MT fname$filename\n";1074print"MT newline\n";1075next;1076}10771078if($meta->{filehash}eq"deleted")1079{1080my($filepart,$dirpart) = filenamesplit($filename,1);10811082$log->info("Removing '$filename' from working copy (no longer in the repo)");10831084print"E cvs update: `$filename' is no longer in the repository\n";1085# Don't want to actually _DO_ the update if -n specified1086unless($state->{globaloptions}{-n} ) {1087print"Removed$dirpart\n";1088print"$filepart\n";1089}1090}1091elsif(not defined($state->{entries}{$filename}{modified_hash} )1092or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1093or$meta->{filehash}eq'added')1094{1095# normal update, just send the new revision (either U=Update,1096# or A=Add, or R=Remove)1097if(defined($wrev) &&$wrev<0)1098{1099$log->info("Tell the client the file is scheduled for removal");1100print"MT text R\n";1101print"MT fname$filename\n";1102print"MT newline\n";1103next;1104}1105elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) )1106{1107$log->info("Tell the client the file is scheduled for addition");1108print"MT text A\n";1109print"MT fname$filename\n";1110print"MT newline\n";1111next;11121113}1114else{1115$log->info("Updating '$filename' to ".$meta->{revision});1116print"MT +updated\n";1117print"MT text U\n";1118print"MT fname$filename\n";1119print"MT newline\n";1120print"MT -updated\n";1121}11221123my($filepart,$dirpart) = filenamesplit($filename,1);11241125# Don't want to actually _DO_ the update if -n specified1126unless($state->{globaloptions}{-n} )1127{1128if(defined($wrev) )1129{1130# instruct client we're sending a file to put in this path as a replacement1131print"Update-existing$dirpart\n";1132$log->debug("Updating existing file 'Update-existing$dirpart'");1133}else{1134# instruct client we're sending a file to put in this path as a new file1135print"Clear-static-directory$dirpart\n";1136print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1137print"Clear-sticky$dirpart\n";1138print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";11391140$log->debug("Creating new file 'Created$dirpart'");1141print"Created$dirpart\n";1142}1143print$state->{CVSROOT} ."/$state->{module}/$filename\n";11441145# this is an "entries" line1146my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1147$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1148print"/$filepart/1.$meta->{revision}//$kopts/\n";11491150# permissions1151$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1152print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";11531154# transmit file1155 transmitfile($meta->{filehash});1156}1157}else{1158$log->info("Updating '$filename'");1159my($filepart,$dirpart) = filenamesplit($meta->{name},1);11601161my$mergeDir= setupTmpDir();11621163my$file_local=$filepart.".mine";1164my$mergedFile="$mergeDir/$file_local";1165system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1166my$file_old=$filepart.".".$oldmeta->{revision};1167 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1168my$file_new=$filepart.".".$meta->{revision};1169 transmitfile($meta->{filehash}, { targetfile =>$file_new});11701171# we need to merge with the local changes ( M=successful merge, C=conflict merge )1172$log->info("Merging$file_local,$file_old,$file_new");1173print"M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into$filename\n";11741175$log->debug("Temporary directory for merge is$mergeDir");11761177my$return=system("git","merge-file",$file_local,$file_old,$file_new);1178$return>>=8;11791180 cleanupTmpDir();11811182if($return==0)1183{1184$log->info("Merged successfully");1185print"M M$filename\n";1186$log->debug("Merged$dirpart");11871188# Don't want to actually _DO_ the update if -n specified1189unless($state->{globaloptions}{-n} )1190{1191print"Merged$dirpart\n";1192$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1193print$state->{CVSROOT} ."/$state->{module}/$filename\n";1194my$kopts= kopts_from_path("$dirpart/$filepart",1195"file",$mergedFile);1196$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1197print"/$filepart/1.$meta->{revision}//$kopts/\n";1198}1199}1200elsif($return==1)1201{1202$log->info("Merged with conflicts");1203print"E cvs update: conflicts found in$filename\n";1204print"M C$filename\n";12051206# Don't want to actually _DO_ the update if -n specified1207unless($state->{globaloptions}{-n} )1208{1209print"Merged$dirpart\n";1210print$state->{CVSROOT} ."/$state->{module}/$filename\n";1211my$kopts= kopts_from_path("$dirpart/$filepart",1212"file",$mergedFile);1213print"/$filepart/1.$meta->{revision}/+/$kopts/\n";1214}1215}1216else1217{1218$log->warn("Merge failed");1219next;1220}12211222# Don't want to actually _DO_ the update if -n specified1223unless($state->{globaloptions}{-n} )1224{1225# permissions1226$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1227print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";12281229# transmit file, format is single integer on a line by itself (file1230# size) followed by the file contents1231# TODO : we should copy files in blocks1232my$data=`cat$mergedFile`;1233$log->debug("File size : " . length($data));1234 print length($data) . "\n";1235 print$data;1236 }1237 }12381239 }12401241 print "ok\n";1242}12431244sub req_ci1245{1246 my ($cmd,$data) =@_;12471248 argsplit("ci");12491250 #$log->debug("State : " . Dumper($state));12511252$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));12531254 if ($state->{method} eq 'pserver')1255 {1256 print "error 1 pserver access cannot commit\n";1257 cleanupWorkTree();1258 exit;1259 }12601261 if ( -e$state->{CVSROOT} . "/index" )1262 {1263$log->warn("file 'index' already exists in the git repository");1264 print "error 1 Index already exists in git repo\n";1265 cleanupWorkTree();1266 exit;1267 }12681269 # Grab a handle to the SQLite db and do any necessary updates1270 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1271$updater->update();12721273 # Remember where the head was at the beginning.1274 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1275 chomp$parenthash;1276 if ($parenthash!~ /^[0-9a-f]{40}$/) {1277 print "error 1 pserver cannot find the current HEAD of module";1278 cleanupWorkTree();1279 exit;1280 }12811282 setupWorkTree($parenthash);12831284$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");12851286$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");12871288 my@committedfiles= ();1289 my%oldmeta;12901291 # foreach file specified on the command line ...1292 foreach my$filename( @{$state->{args}} )1293 {1294 my$committedfile=$filename;1295$filename= filecleanup($filename);12961297 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );12981299 my$meta=$updater->getmeta($filename);1300$oldmeta{$filename} =$meta;13011302 my$wrev= revparse($filename);13031304 my ($filepart,$dirpart) = filenamesplit($filename);13051306 # do a checkout of the file if it is part of this tree1307 if ($wrev) {1308 system('git', 'checkout-index', '-f', '-u',$filename);1309 unless ($?== 0) {1310 die "Error running git-checkout-index -f -u$filename:$!";1311 }1312 }13131314 my$addflag= 0;1315 my$rmflag= 0;1316$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1317$addflag= 1 unless ( -e$filename);13181319 # Do up to date checking1320 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1321 {1322 # fail everything if an up to date check fails1323 print "error 1 Up to date check failed for$filename\n";1324 cleanupWorkTree();1325 exit;1326 }13271328 push@committedfiles,$committedfile;1329$log->info("Committing$filename");13301331 system("mkdir","-p",$dirpart) unless ( -d$dirpart);13321333 unless ($rmflag)1334 {1335$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1336 rename$state->{entries}{$filename}{modified_filename},$filename;13371338 # Calculate modes to remove1339 my$invmode= "";1340 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }13411342$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1343 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1344 }13451346 if ($rmflag)1347 {1348$log->info("Removing file '$filename'");1349 unlink($filename);1350 system("git", "update-index", "--remove",$filename);1351 }1352 elsif ($addflag)1353 {1354$log->info("Adding file '$filename'");1355 system("git", "update-index", "--add",$filename);1356 } else {1357$log->info("Updating file '$filename'");1358 system("git", "update-index",$filename);1359 }1360 }13611362 unless ( scalar(@committedfiles) > 0 )1363 {1364 print "E No files to commit\n";1365 print "ok\n";1366 cleanupWorkTree();1367 return;1368 }13691370 my$treehash= `git write-tree`;1371 chomp$treehash;13721373$log->debug("Treehash :$treehash, Parenthash :$parenthash");13741375 # write our commit message out if we have one ...1376 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1377 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1378 if ( defined ($cfg->{gitcvs}{commitmsgannotation} ) ) {1379 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/) {1380 print$msg_fh"\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"1381 }1382 } else {1383 print$msg_fh"\n\nvia git-CVS emulator\n";1384 }1385 close$msg_fh;13861387 my$commithash= `git commit-tree $treehash-p $parenthash<$msg_filename`;1388chomp($commithash);1389$log->info("Commit hash :$commithash");13901391unless($commithash=~/[a-zA-Z0-9]{40}/)1392{1393$log->warn("Commit failed (Invalid commit hash)");1394print"error 1 Commit failed (unknown reason)\n";1395 cleanupWorkTree();1396exit;1397}13981399### Emulate git-receive-pack by running hooks/update1400my@hook= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1401$parenthash,$commithash);1402if( -x $hook[0] ) {1403unless(system(@hook) ==0)1404{1405$log->warn("Commit failed (update hook declined to update ref)");1406print"error 1 Commit failed (update hook declined)\n";1407 cleanupWorkTree();1408exit;1409}1410}14111412### Update the ref1413if(system(qw(git update-ref -m),"cvsserver ci",1414"refs/heads/$state->{module}",$commithash,$parenthash)) {1415$log->warn("update-ref for$state->{module} failed.");1416print"error 1 Cannot commit -- update first\n";1417 cleanupWorkTree();1418exit;1419}14201421### Emulate git-receive-pack by running hooks/post-receive1422my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1423if( -x $hook) {1424open(my$pipe,"|$hook") ||die"can't fork$!";14251426local$SIG{PIPE} =sub{die'pipe broke'};14271428print$pipe"$parenthash$commithashrefs/heads/$state->{module}\n";14291430close$pipe||die"bad pipe:$!$?";1431}14321433$updater->update();14341435### Then hooks/post-update1436$hook=$ENV{GIT_DIR}.'hooks/post-update';1437if(-x $hook) {1438system($hook,"refs/heads/$state->{module}");1439}14401441# foreach file specified on the command line ...1442foreachmy$filename(@committedfiles)1443{1444$filename= filecleanup($filename);14451446my$meta=$updater->getmeta($filename);1447unless(defined$meta->{revision}) {1448$meta->{revision} =1;1449}14501451my($filepart,$dirpart) = filenamesplit($filename,1);14521453$log->debug("Checked-in$dirpart:$filename");14541455print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1456if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1457{1458print"M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";1459print"Remove-entry$dirpart\n";1460print"$filename\n";1461}else{1462if($meta->{revision} ==1) {1463print"M initial revision: 1.1\n";1464}else{1465print"M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";1466}1467print"Checked-in$dirpart\n";1468print"$filename\n";1469my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1470print"/$filepart/1.$meta->{revision}//$kopts/\n";1471}1472}14731474 cleanupWorkTree();1475print"ok\n";1476}14771478sub req_status1479{1480my($cmd,$data) =@_;14811482 argsplit("status");14831484$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1485#$log->debug("status state : " . Dumper($state));14861487# Grab a handle to the SQLite db and do any necessary updates1488my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1489$updater->update();14901491# if no files were specified, we need to work out what files we should be providing status on ...1492 argsfromdir($updater);14931494# foreach file specified on the command line ...1495foreachmy$filename( @{$state->{args}} )1496{1497$filename= filecleanup($filename);14981499next ifexists($state->{opt}{l}) &&index($filename,'/',length($state->{prependdir})) >=0;15001501my$meta=$updater->getmeta($filename);1502my$oldmeta=$meta;15031504my$wrev= revparse($filename);15051506# If the working copy is an old revision, lets get that version too for comparison.1507if(defined($wrev)and$wrev!=$meta->{revision} )1508{1509$oldmeta=$updater->getmeta($filename,$wrev);1510}15111512# TODO : All possible statuses aren't yet implemented1513my$status;1514# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1515$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1516and1517( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1518or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1519);15201521# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1522$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1523and1524($state->{entries}{$filename}{unchanged}1525or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1526);15271528# Need checkout if it exists in the repo but doesn't have a working copy1529$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );15301531# Locally modified if working copy and repo copy have the same revision but there are local changes1532$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );15331534# Needs Merge if working copy revision is less than repo copy and there are local changes1535$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );15361537$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1538$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1539$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1540$status||="File had conflicts on merge"if(0);15411542$status||="Unknown";15431544my($filepart) = filenamesplit($filename);15451546print"M ===================================================================\n";1547print"M File:$filepart\tStatus:$status\n";1548if(defined($state->{entries}{$filename}{revision}) )1549{1550print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1551}else{1552print"M Working revision:\tNo entry for$filename\n";1553}1554if(defined($meta->{revision}) )1555{1556print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1557print"M Sticky Tag:\t\t(none)\n";1558print"M Sticky Date:\t\t(none)\n";1559print"M Sticky Options:\t\t(none)\n";1560}else{1561print"M Repository revision:\tNo revision control file\n";1562}1563print"M\n";1564}15651566print"ok\n";1567}15681569sub req_diff1570{1571my($cmd,$data) =@_;15721573 argsplit("diff");15741575$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1576#$log->debug("status state : " . Dumper($state));15771578my($revision1,$revision2);1579if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1580{1581$revision1=$state->{opt}{r}[0];1582$revision2=$state->{opt}{r}[1];1583}else{1584$revision1=$state->{opt}{r};1585}15861587$revision1=~s/^1\.//if(defined($revision1) );1588$revision2=~s/^1\.//if(defined($revision2) );15891590$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );15911592# Grab a handle to the SQLite db and do any necessary updates1593my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1594$updater->update();15951596# if no files were specified, we need to work out what files we should be providing status on ...1597 argsfromdir($updater);15981599# foreach file specified on the command line ...1600foreachmy$filename( @{$state->{args}} )1601{1602$filename= filecleanup($filename);16031604my($fh,$file1,$file2,$meta1,$meta2,$filediff);16051606my$wrev= revparse($filename);16071608# We need _something_ to diff against1609next unless(defined($wrev) );16101611# if we have a -r switch, use it1612if(defined($revision1) )1613{1614(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1615$meta1=$updater->getmeta($filename,$revision1);1616unless(defined($meta1)and$meta1->{filehash}ne"deleted")1617{1618print"E File$filenameat revision 1.$revision1doesn't exist\n";1619next;1620}1621 transmitfile($meta1->{filehash}, { targetfile =>$file1});1622}1623# otherwise we just use the working copy revision1624else1625{1626(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1627$meta1=$updater->getmeta($filename,$wrev);1628 transmitfile($meta1->{filehash}, { targetfile =>$file1});1629}16301631# if we have a second -r switch, use it too1632if(defined($revision2) )1633{1634(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1635$meta2=$updater->getmeta($filename,$revision2);16361637unless(defined($meta2)and$meta2->{filehash}ne"deleted")1638{1639print"E File$filenameat revision 1.$revision2doesn't exist\n";1640next;1641}16421643 transmitfile($meta2->{filehash}, { targetfile =>$file2});1644}1645# otherwise we just use the working copy1646else1647{1648$file2=$state->{entries}{$filename}{modified_filename};1649}16501651# if we have been given -r, and we don't have a $file2 yet, lets get one1652if(defined($revision1)and not defined($file2) )1653{1654(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1655$meta2=$updater->getmeta($filename,$wrev);1656 transmitfile($meta2->{filehash}, { targetfile =>$file2});1657}16581659# We need to have retrieved something useful1660next unless(defined($meta1) );16611662# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1663next if(not defined($meta2)and$wrev==$meta1->{revision}1664and1665( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1666or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1667);16681669# Apparently we only show diffs for locally modified files1670next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );16711672print"M Index:$filename\n";1673print"M ===================================================================\n";1674print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1675print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1676print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1677print"M diff ";1678foreachmy$opt(keys%{$state->{opt}} )1679{1680if(ref$state->{opt}{$opt}eq"ARRAY")1681{1682foreachmy$value( @{$state->{opt}{$opt}} )1683{1684print"-$opt$value";1685}1686}else{1687print"-$opt";1688print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1689}1690}1691print"$filename\n";16921693$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));16941695($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);16961697if(exists$state->{opt}{u} )1698{1699system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1700}else{1701system("diff$file1$file2>$filediff");1702}17031704while( <$fh> )1705{1706print"M$_";1707}1708close$fh;1709}17101711print"ok\n";1712}17131714sub req_log1715{1716my($cmd,$data) =@_;17171718 argsplit("log");17191720$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1721#$log->debug("log state : " . Dumper($state));17221723my($minrev,$maxrev);1724if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1725{1726my$control=$2;1727$minrev=$1;1728$maxrev=$3;1729$minrev=~s/^1\.//if(defined($minrev) );1730$maxrev=~s/^1\.//if(defined($maxrev) );1731$minrev++if(defined($minrev)and$controleq"::");1732}17331734# Grab a handle to the SQLite db and do any necessary updates1735my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1736$updater->update();17371738# if no files were specified, we need to work out what files we should be providing status on ...1739 argsfromdir($updater);17401741# foreach file specified on the command line ...1742foreachmy$filename( @{$state->{args}} )1743{1744$filename= filecleanup($filename);17451746my$headmeta=$updater->getmeta($filename);17471748my$revisions=$updater->getlog($filename);1749my$totalrevisions=scalar(@$revisions);17501751if(defined($minrev) )1752{1753$log->debug("Removing revisions less than$minrev");1754while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1755{1756pop@$revisions;1757}1758}1759if(defined($maxrev) )1760{1761$log->debug("Removing revisions greater than$maxrev");1762while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1763{1764shift@$revisions;1765}1766}17671768next unless(scalar(@$revisions) );17691770print"M\n";1771print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1772print"M Working file:$filename\n";1773print"M head: 1.$headmeta->{revision}\n";1774print"M branch:\n";1775print"M locks: strict\n";1776print"M access list:\n";1777print"M symbolic names:\n";1778print"M keyword substitution: kv\n";1779print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1780print"M description:\n";17811782foreachmy$revision(@$revisions)1783{1784print"M ----------------------------\n";1785print"M revision 1.$revision->{revision}\n";1786# reformat the date for log output1787$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}) );1788$revision->{author} = cvs_author($revision->{author});1789print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1790my$commitmessage=$updater->commitmessage($revision->{commithash});1791$commitmessage=~s/^/M /mg;1792print$commitmessage."\n";1793}1794print"M =============================================================================\n";1795}17961797print"ok\n";1798}17991800sub req_annotate1801{1802my($cmd,$data) =@_;18031804 argsplit("annotate");18051806$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1807#$log->debug("status state : " . Dumper($state));18081809# Grab a handle to the SQLite db and do any necessary updates1810my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1811$updater->update();18121813# if no files were specified, we need to work out what files we should be providing annotate on ...1814 argsfromdir($updater);18151816# we'll need a temporary checkout dir1817 setupWorkTree();18181819$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");18201821# foreach file specified on the command line ...1822foreachmy$filename( @{$state->{args}} )1823{1824$filename= filecleanup($filename);18251826my$meta=$updater->getmeta($filename);18271828next unless($meta->{revision} );18291830# get all the commits that this file was in1831# in dense format -- aka skip dead revisions1832my$revisions=$updater->gethistorydense($filename);1833my$lastseenin=$revisions->[0][2];18341835# populate the temporary index based on the latest commit were we saw1836# the file -- but do it cheaply without checking out any files1837# TODO: if we got a revision from the client, use that instead1838# to look up the commithash in sqlite (still good to default to1839# the current head as we do now)1840system("git","read-tree",$lastseenin);1841unless($?==0)1842{1843print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";1844return;1845}1846$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");18471848# do a checkout of the file1849system('git','checkout-index','-f','-u',$filename);1850unless($?==0) {1851print"E error running git-checkout-index -f -u$filename:$!\n";1852return;1853}18541855$log->info("Annotate$filename");18561857# Prepare a file with the commits from the linearized1858# history that annotate should know about. This prevents1859# git-jsannotate telling us about commits we are hiding1860# from the client.18611862my$a_hints="$work->{workDir}/.annotate_hints";1863if(!open(ANNOTATEHINTS,'>',$a_hints)) {1864print"E failed to open '$a_hints' for writing:$!\n";1865return;1866}1867for(my$i=0;$i<@$revisions;$i++)1868{1869print ANNOTATEHINTS $revisions->[$i][2];1870if($i+1<@$revisions) {# have we got a parent?1871print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1872}1873print ANNOTATEHINTS "\n";1874}18751876print ANNOTATEHINTS "\n";1877close ANNOTATEHINTS1878or(print"E failed to write$a_hints:$!\n"),return;18791880my@cmd= (qw(git annotate -l -S),$a_hints,$filename);1881if(!open(ANNOTATE,"-|",@cmd)) {1882print"E error invoking ".join(' ',@cmd) .":$!\n";1883return;1884}1885my$metadata= {};1886print"E Annotations for$filename\n";1887print"E ***************\n";1888while( <ANNOTATE> )1889{1890if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1891{1892my$commithash=$1;1893my$data=$2;1894unless(defined($metadata->{$commithash} ) )1895{1896$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1897$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});1898$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1899}1900printf("M 1.%-5d (%-8s%10s):%s\n",1901$metadata->{$commithash}{revision},1902$metadata->{$commithash}{author},1903$metadata->{$commithash}{modified},1904$data1905);1906}else{1907$log->warn("Error in annotate output! LINE:$_");1908print"E Annotate error\n";1909next;1910}1911}1912close ANNOTATE;1913}19141915# done; get out of the tempdir1916 cleanupWorkTree();19171918print"ok\n";19191920}19211922# This method takes the state->{arguments} array and produces two new arrays.1923# The first is $state->{args} which is everything before the '--' argument, and1924# the second is $state->{files} which is everything after it.1925sub argsplit1926{1927$state->{args} = [];1928$state->{files} = [];1929$state->{opt} = {};19301931return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");19321933my$type=shift;19341935if(defined($type) )1936{1937my$opt= {};1938$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");1939$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1940$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");1941$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1942$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1943$opt= { k =>1, m =>1}if($typeeq"add");1944$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1945$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");194619471948while(scalar( @{$state->{arguments}} ) >0)1949{1950my$arg=shift@{$state->{arguments}};19511952next if($argeq"--");1953next unless($arg=~/\S/);19541955# if the argument looks like a switch1956if($arg=~/^-(\w)(.*)/)1957{1958# if it's a switch that takes an argument1959if($opt->{$1} )1960{1961# If this switch has already been provided1962if($opt->{$1} >1and exists($state->{opt}{$1} ) )1963{1964$state->{opt}{$1} = [$state->{opt}{$1} ];1965if(length($2) >0)1966{1967push@{$state->{opt}{$1}},$2;1968}else{1969push@{$state->{opt}{$1}},shift@{$state->{arguments}};1970}1971}else{1972# if there's extra data in the arg, use that as the argument for the switch1973if(length($2) >0)1974{1975$state->{opt}{$1} =$2;1976}else{1977$state->{opt}{$1} =shift@{$state->{arguments}};1978}1979}1980}else{1981$state->{opt}{$1} =undef;1982}1983}1984else1985{1986push@{$state->{args}},$arg;1987}1988}1989}1990else1991{1992my$mode=0;19931994foreachmy$value( @{$state->{arguments}} )1995{1996if($valueeq"--")1997{1998$mode++;1999next;2000}2001push@{$state->{args}},$valueif($mode==0);2002push@{$state->{files}},$valueif($mode==1);2003}2004}2005}20062007# This method uses $state->{directory} to populate $state->{args} with a list of filenames2008sub argsfromdir2009{2010my$updater=shift;20112012$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");20132014return if(scalar( @{$state->{args}} ) >1);20152016my@gethead= @{$updater->gethead};20172018# push added files2019foreachmy$file(keys%{$state->{entries}}) {2020if(exists$state->{entries}{$file}{revision} &&2021$state->{entries}{$file}{revision} ==0)2022{2023push@gethead, { name =>$file, filehash =>'added'};2024}2025}20262027if(scalar(@{$state->{args}}) ==1)2028{2029my$arg=$state->{args}[0];2030$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );20312032$log->info("Only one arg specified, checking for directory expansion on '$arg'");20332034foreachmy$file(@gethead)2035{2036next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2037next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);2038push@{$state->{args}},$file->{name};2039}20402041shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);2042}else{2043$log->info("Only one arg specified, populating file list automatically");20442045$state->{args} = [];20462047foreachmy$file(@gethead)2048{2049next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2050next unless($file->{name} =~s/^$state->{prependdir}//);2051push@{$state->{args}},$file->{name};2052}2053}2054}20552056# This method cleans up the $state variable after a command that uses arguments has run2057sub statecleanup2058{2059$state->{files} = [];2060$state->{args} = [];2061$state->{arguments} = [];2062$state->{entries} = {};2063}20642065sub revparse2066{2067my$filename=shift;20682069returnundefunless(defined($state->{entries}{$filename}{revision} ) );20702071return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);2072return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);20732074returnundef;2075}20762077# This method takes a file hash and does a CVS "file transfer". Its2078# exact behaviour depends on a second, optional hash table argument:2079# - If $options->{targetfile}, dump the contents to that file;2080# - If $options->{print}, use M/MT to transmit the contents one line2081# at a time;2082# - Otherwise, transmit the size of the file, followed by the file2083# contents.2084sub transmitfile2085{2086my$filehash=shift;2087my$options=shift;20882089if(defined($filehash)and$filehasheq"deleted")2090{2091$log->warn("filehash is 'deleted'");2092return;2093}20942095die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);20962097my$type=`git cat-file -t$filehash`;2098 chomp$type;20992100 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );21012102 my$size= `git cat-file -s $filehash`;2103chomp$size;21042105$log->debug("transmitfile($filehash) size=$size, type=$type");21062107if(open my$fh,'-|',"git","cat-file","blob",$filehash)2108{2109if(defined($options->{targetfile} ) )2110{2111my$targetfile=$options->{targetfile};2112open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2113print NEWFILE $_while( <$fh> );2114close NEWFILE or die("Failed to write '$targetfile':$!");2115}elsif(defined($options->{print} ) &&$options->{print} ) {2116while( <$fh> ) {2117if(/\n\z/) {2118print'M ',$_;2119}else{2120print'MT text ',$_,"\n";2121}2122}2123}else{2124print"$size\n";2125printwhile( <$fh> );2126}2127close$fhor die("Couldn't close filehandle for transmitfile():$!");2128}else{2129die("Couldn't execute git-cat-file");2130}2131}21322133# This method takes a file name, and returns ( $dirpart, $filepart ) which2134# refers to the directory portion and the file portion of the filename2135# respectively2136sub filenamesplit2137{2138my$filename=shift;2139my$fixforlocaldir=shift;21402141my($filepart,$dirpart) = ($filename,".");2142($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2143$dirpart.="/";21442145if($fixforlocaldir)2146{2147$dirpart=~s/^$state->{prependdir}//;2148}21492150return($filepart,$dirpart);2151}21522153sub filecleanup2154{2155my$filename=shift;21562157returnundefunless(defined($filename));2158if($filename=~/^\// )2159{2160print"E absolute filenames '$filename' not supported by server\n";2161returnundef;2162}21632164$filename=~s/^\.\///g;2165$filename=$state->{prependdir} .$filename;2166return$filename;2167}21682169sub validateGitDir2170{2171if( !defined($state->{CVSROOT}) )2172{2173print"error 1 CVSROOT not specified\n";2174 cleanupWorkTree();2175exit;2176}2177if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2178{2179print"error 1 Internally inconsistent CVSROOT\n";2180 cleanupWorkTree();2181exit;2182}2183}21842185# Setup working directory in a work tree with the requested version2186# loaded in the index.2187sub setupWorkTree2188{2189my($ver) =@_;21902191 validateGitDir();21922193if( (defined($work->{state}) &&$work->{state} !=1) ||2194defined($work->{tmpDir}) )2195{2196$log->warn("Bad work tree state management");2197print"error 1 Internal setup multiple work trees without cleanup\n";2198 cleanupWorkTree();2199exit;2200}22012202$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);22032204if( !defined($work->{index}) )2205{2206(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2207}22082209chdir$work->{workDir}or2210die"Unable to chdir to$work->{workDir}\n";22112212$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");22132214$ENV{GIT_WORK_TREE} =".";2215$ENV{GIT_INDEX_FILE} =$work->{index};2216$work->{state} =2;22172218if($ver)2219{2220system("git","read-tree",$ver);2221unless($?==0)2222{2223$log->warn("Error running git-read-tree");2224die"Error running git-read-tree$verin$work->{workDir}$!\n";2225}2226}2227# else # req_annotate reads tree for each file2228}22292230# Ensure current directory is in some kind of working directory,2231# with a recent version loaded in the index.2232sub ensureWorkTree2233{2234if(defined($work->{tmpDir}) )2235{2236$log->warn("Bad work tree state management [ensureWorkTree()]");2237print"error 1 Internal setup multiple dirs without cleanup\n";2238 cleanupWorkTree();2239exit;2240}2241if($work->{state} )2242{2243return;2244}22452246 validateGitDir();22472248if( !defined($work->{emptyDir}) )2249{2250$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);2251}2252chdir$work->{emptyDir}or2253die"Unable to chdir to$work->{emptyDir}\n";22542255my$ver=`git show-ref -s refs/heads/$state->{module}`;2256chomp$ver;2257if($ver!~/^[0-9a-f]{40}$/)2258{2259$log->warn("Error from git show-ref -s refs/head$state->{module}");2260print"error 1 cannot find the current HEAD of module";2261 cleanupWorkTree();2262exit;2263}22642265if( !defined($work->{index}) )2266{2267(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2268}22692270$ENV{GIT_WORK_TREE} =".";2271$ENV{GIT_INDEX_FILE} =$work->{index};2272$work->{state} =1;22732274system("git","read-tree",$ver);2275unless($?==0)2276{2277die"Error running git-read-tree$ver$!\n";2278}2279}22802281# Cleanup working directory that is not needed any longer.2282sub cleanupWorkTree2283{2284if( !$work->{state} )2285{2286return;2287}22882289chdir"/"or die"Unable to chdir '/'\n";22902291if(defined($work->{workDir}) )2292{2293 rmtree($work->{workDir} );2294undef$work->{workDir};2295}2296undef$work->{state};2297}22982299# Setup a temporary directory (not a working tree), typically for2300# merging dirty state as in req_update.2301sub setupTmpDir2302{2303$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);2304chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";23052306return$work->{tmpDir};2307}23082309# Clean up a previously setupTmpDir. Restore previous work tree if2310# appropriate.2311sub cleanupTmpDir2312{2313if( !defined($work->{tmpDir}) )2314{2315$log->warn("cleanup tmpdir that has not been setup");2316die"Cleanup tmpDir that has not been setup\n";2317}2318if(defined($work->{state}) )2319{2320if($work->{state} ==1)2321{2322chdir$work->{emptyDir}or2323die"Unable to chdir to$work->{emptyDir}\n";2324}2325elsif($work->{state} ==2)2326{2327chdir$work->{workDir}or2328die"Unable to chdir to$work->{emptyDir}\n";2329}2330else2331{2332$log->warn("Inconsistent work dir state");2333die"Inconsistent work dir state\n";2334}2335}2336else2337{2338chdir"/"or die"Unable to chdir '/'\n";2339}2340}23412342# Given a path, this function returns a string containing the kopts2343# that should go into that path's Entries line. For example, a binary2344# file should get -kb.2345sub kopts_from_path2346{2347my($path,$srcType,$name) =@_;23482349if(defined($cfg->{gitcvs}{usecrlfattr} )and2350$cfg->{gitcvs}{usecrlfattr} =~/\s*(1|true|yes)\s*$/i)2351{2352my($val) = check_attr("crlf",$path);2353if($valeq"set")2354{2355return"";2356}2357elsif($valeq"unset")2358{2359return"-kb"2360}2361else2362{2363$log->info("Unrecognized check_attr crlf$path:$val");2364}2365}23662367if(defined($cfg->{gitcvs}{allbinary} ) )2368{2369if( ($cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i) )2370{2371return"-kb";2372}2373elsif( ($cfg->{gitcvs}{allbinary} =~/^\s*guess\s*$/i) )2374{2375if($srcTypeeq"sha1Or-k"&&2376!defined($name) )2377{2378my($ret)=$state->{entries}{$path}{options};2379if( !defined($ret) )2380{2381$ret=$state->{opt}{k};2382if(defined($ret))2383{2384$ret="-k$ret";2385}2386else2387{2388$ret="";2389}2390}2391if( ! ($ret=~/^(|-kb|-kkv|-kkvl|-kk|-ko|-kv)$/) )2392{2393print"E Bad -k option\n";2394$log->warn("Bad -k option:$ret");2395die"Error: Bad -k option:$ret\n";2396}23972398return$ret;2399}2400else2401{2402if( is_binary($srcType,$name) )2403{2404$log->debug("... as binary");2405return"-kb";2406}2407else2408{2409$log->debug("... as text");2410}2411}2412}2413}2414# Return "" to give no special treatment to any path2415return"";2416}24172418sub check_attr2419{2420my($attr,$path) =@_;2421 ensureWorkTree();2422if(open my$fh,'-|',"git","check-attr",$attr,"--",$path)2423{2424my$val= <$fh>;2425close$fh;2426$val=~s/.*: ([^:\r\n]*)\s*$/$1/;2427return$val;2428}2429else2430{2431returnundef;2432}2433}24342435# This should have the same heuristics as convert.c:is_binary() and related.2436# Note that the bare CR test is done by callers in convert.c.2437sub is_binary2438{2439my($srcType,$name) =@_;2440$log->debug("is_binary($srcType,$name)");24412442# Minimize amount of interpreted code run in the inner per-character2443# loop for large files, by totalling each character value and2444# then analyzing the totals.2445my@counts;2446my$i;2447for($i=0;$i<256;$i++)2448{2449$counts[$i]=0;2450}24512452my$fh= open_blob_or_die($srcType,$name);2453my$line;2454while(defined($line=<$fh>) )2455{2456# Any '\0' and bare CR are considered binary.2457if($line=~/\0|(\r[^\n])/)2458{2459close($fh);2460return1;2461}24622463# Count up each character in the line:2464my$len=length($line);2465for($i=0;$i<$len;$i++)2466{2467$counts[ord(substr($line,$i,1))]++;2468}2469}2470close$fh;24712472# Don't count CR and LF as either printable/nonprintable2473$counts[ord("\n")]=0;2474$counts[ord("\r")]=0;24752476# Categorize individual character count into printable and nonprintable:2477my$printable=0;2478my$nonprintable=0;2479for($i=0;$i<256;$i++)2480{2481if($i<32&&2482$i!=ord("\b") &&2483$i!=ord("\t") &&2484$i!=033&&# ESC2485$i!=014)# FF2486{2487$nonprintable+=$counts[$i];2488}2489elsif($i==127)# DEL2490{2491$nonprintable+=$counts[$i];2492}2493else2494{2495$printable+=$counts[$i];2496}2497}24982499return($printable>>7) <$nonprintable;2500}25012502# Returns open file handle. Possible invocations:2503# - open_blob_or_die("file",$filename);2504# - open_blob_or_die("sha1",$filehash);2505sub open_blob_or_die2506{2507my($srcType,$name) =@_;2508my($fh);2509if($srcTypeeq"file")2510{2511if( !open$fh,"<",$name)2512{2513$log->warn("Unable to open file$name:$!");2514die"Unable to open file$name:$!\n";2515}2516}2517elsif($srcTypeeq"sha1"||$srcTypeeq"sha1Or-k")2518{2519unless(defined($name)and$name=~/^[a-zA-Z0-9]{40}$/)2520{2521$log->warn("Need filehash");2522die"Need filehash\n";2523}25242525my$type=`git cat-file -t$name`;2526 chomp$type;25272528 unless ( defined ($type) and$typeeq "blob" )2529 {2530$log->warn("Invalid type '$type' for '$name'");2531 die ( "Invalid type '$type' (expected 'blob')" )2532 }25332534 my$size= `git cat-file -s $name`;2535chomp$size;25362537$log->debug("open_blob_or_die($name) size=$size, type=$type");25382539unless(open$fh,'-|',"git","cat-file","blob",$name)2540{2541$log->warn("Unable to open sha1$name");2542die"Unable to open sha1$name\n";2543}2544}2545else2546{2547$log->warn("Unknown type of blob source:$srcType");2548die"Unknown type of blob source:$srcType\n";2549}2550return$fh;2551}25522553# Generate a CVS author name from Git author information, by taking the local2554# part of the email address and replacing characters not in the Portable2555# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS2556# Login names are Unix login names, which should be restricted to this2557# character set.2558sub cvs_author2559{2560my$author_line=shift;2561(my$author) =$author_line=~/<([^@>]*)/;25622563$author=~s/[^-a-zA-Z0-9_.]/_/g;2564$author=~s/^-/_/;25652566$author;2567}25682569package GITCVS::log;25702571####2572#### Copyright The Open University UK - 2006.2573####2574#### Authors: Martyn Smith <martyn@catalyst.net.nz>2575#### Martin Langhoff <martin@catalyst.net.nz>2576####2577####25782579use strict;2580use warnings;25812582=head1 NAME25832584GITCVS::log25852586=head1 DESCRIPTION25872588This module provides very crude logging with a similar interface to2589Log::Log4perl25902591=head1 METHODS25922593=cut25942595=head2 new25962597Creates a new log object, optionally you can specify a filename here to2598indicate the file to log to. If no log file is specified, you can specify one2599later with method setfile, or indicate you no longer want logging with method2600nofile.26012602Until one of these methods is called, all log calls will buffer messages ready2603to write out.26042605=cut2606sub new2607{2608my$class=shift;2609my$filename=shift;26102611my$self= {};26122613bless$self,$class;26142615if(defined($filename) )2616{2617open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2618}26192620return$self;2621}26222623=head2 setfile26242625This methods takes a filename, and attempts to open that file as the log file.2626If successful, all buffered data is written out to the file, and any further2627logging is written directly to the file.26282629=cut2630sub setfile2631{2632my$self=shift;2633my$filename=shift;26342635if(defined($filename) )2636{2637open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2638}26392640return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");26412642while(my$line=shift@{$self->{buffer}} )2643{2644print{$self->{fh}}$line;2645}2646}26472648=head2 nofile26492650This method indicates no logging is going to be used. It flushes any entries in2651the internal buffer, and sets a flag to ensure no further data is put there.26522653=cut2654sub nofile2655{2656my$self=shift;26572658$self->{nolog} =1;26592660return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");26612662$self->{buffer} = [];2663}26642665=head2 _logopen26662667Internal method. Returns true if the log file is open, false otherwise.26682669=cut2670sub _logopen2671{2672my$self=shift;26732674return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2675return0;2676}26772678=head2 debug info warn fatal26792680These four methods are wrappers to _log. They provide the actual interface for2681logging data.26822683=cut2684sub debug {my$self=shift;$self->_log("debug",@_); }2685sub info {my$self=shift;$self->_log("info",@_); }2686subwarn{my$self=shift;$self->_log("warn",@_); }2687sub fatal {my$self=shift;$self->_log("fatal",@_); }26882689=head2 _log26902691This is an internal method called by the logging functions. It generates a2692timestamp and pushes the logged line either to file, or internal buffer.26932694=cut2695sub _log2696{2697my$self=shift;2698my$level=shift;26992700return if($self->{nolog} );27012702my@time=localtime;2703my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2704$time[5] +1900,2705$time[4] +1,2706$time[3],2707$time[2],2708$time[1],2709$time[0],2710uc$level,2711);27122713if($self->_logopen)2714{2715print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2716}else{2717push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2718}2719}27202721=head2 DESTROY27222723This method simply closes the file handle if one is open27242725=cut2726sub DESTROY2727{2728my$self=shift;27292730if($self->_logopen)2731{2732close$self->{fh};2733}2734}27352736package GITCVS::updater;27372738####2739#### Copyright The Open University UK - 2006.2740####2741#### Authors: Martyn Smith <martyn@catalyst.net.nz>2742#### Martin Langhoff <martin@catalyst.net.nz>2743####2744####27452746use strict;2747use warnings;2748use DBI;27492750=head1 METHODS27512752=cut27532754=head2 new27552756=cut2757sub new2758{2759my$class=shift;2760my$config=shift;2761my$module=shift;2762my$log=shift;27632764die"Need to specify a git repository"unless(defined($config)and-d $config);2765die"Need to specify a module"unless(defined($module) );27662767$class=ref($class) ||$class;27682769my$self= {};27702771bless$self,$class;27722773$self->{valid_tables} = {'revision'=>1,2774'revision_ix1'=>1,2775'revision_ix2'=>1,2776'head'=>1,2777'head_ix1'=>1,2778'properties'=>1,2779'commitmsgs'=>1};27802781$self->{module} =$module;2782$self->{git_path} =$config."/";27832784$self->{log} =$log;27852786die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );27872788$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2789$cfg->{gitcvs}{dbdriver} ||"SQLite";2790$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2791$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2792$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2793$cfg->{gitcvs}{dbuser} ||"";2794$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2795$cfg->{gitcvs}{dbpass} ||"";2796$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||2797$cfg->{gitcvs}{dbtablenameprefix} ||"";2798my%mapping= ( m =>$module,2799 a =>$state->{method},2800 u =>getlogin||getpwuid($<) || $<,2801 G =>$self->{git_path},2802 g => mangle_dirname($self->{git_path}),2803);2804$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2805$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;2806$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;2807$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});28082809die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2810die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2811$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2812$self->{dbuser},2813$self->{dbpass});2814die"Error connecting to database\n"unlessdefined$self->{dbh};28152816$self->{tables} = {};2817foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2818{2819$self->{tables}{$table} =1;2820}28212822# Construct the revision table if required2823unless($self->{tables}{$self->tablename("revision")} )2824{2825my$tablename=$self->tablename("revision");2826my$ix1name=$self->tablename("revision_ix1");2827my$ix2name=$self->tablename("revision_ix2");2828$self->{dbh}->do("2829 CREATE TABLE$tablename(2830 name TEXT NOT NULL,2831 revision INTEGER NOT NULL,2832 filehash TEXT NOT NULL,2833 commithash TEXT NOT NULL,2834 author TEXT NOT NULL,2835 modified TEXT NOT NULL,2836 mode TEXT NOT NULL2837 )2838 ");2839$self->{dbh}->do("2840 CREATE INDEX$ix1name2841 ON$tablename(name,revision)2842 ");2843$self->{dbh}->do("2844 CREATE INDEX$ix2name2845 ON$tablename(name,commithash)2846 ");2847}28482849# Construct the head table if required2850unless($self->{tables}{$self->tablename("head")} )2851{2852my$tablename=$self->tablename("head");2853my$ix1name=$self->tablename("head_ix1");2854$self->{dbh}->do("2855 CREATE TABLE$tablename(2856 name TEXT NOT NULL,2857 revision INTEGER NOT NULL,2858 filehash TEXT NOT NULL,2859 commithash TEXT NOT NULL,2860 author TEXT NOT NULL,2861 modified TEXT NOT NULL,2862 mode TEXT NOT NULL2863 )2864 ");2865$self->{dbh}->do("2866 CREATE INDEX$ix1name2867 ON$tablename(name)2868 ");2869}28702871# Construct the properties table if required2872unless($self->{tables}{$self->tablename("properties")} )2873{2874my$tablename=$self->tablename("properties");2875$self->{dbh}->do("2876 CREATE TABLE$tablename(2877 key TEXT NOT NULL PRIMARY KEY,2878 value TEXT2879 )2880 ");2881}28822883# Construct the commitmsgs table if required2884unless($self->{tables}{$self->tablename("commitmsgs")} )2885{2886my$tablename=$self->tablename("commitmsgs");2887$self->{dbh}->do("2888 CREATE TABLE$tablename(2889 key TEXT NOT NULL PRIMARY KEY,2890 value TEXT2891 )2892 ");2893}28942895return$self;2896}28972898=head2 tablename28992900=cut2901sub tablename2902{2903my$self=shift;2904my$name=shift;29052906if(exists$self->{valid_tables}{$name}) {2907return$self->{dbtablenameprefix} .$name;2908}else{2909returnundef;2910}2911}29122913=head2 update29142915=cut2916sub update2917{2918my$self=shift;29192920# first lets get the commit list2921$ENV{GIT_DIR} =$self->{git_path};29222923my$commitsha1=`git rev-parse$self->{module}`;2924chomp$commitsha1;29252926my$commitinfo=`git cat-file commit$self->{module} 2>&1`;2927unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2928{2929die("Invalid module '$self->{module}'");2930}293129322933my$git_log;2934my$lastcommit=$self->_get_prop("last_commit");29352936if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date2937return1;2938}29392940# Start exclusive lock here...2941$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";29422943# TODO: log processing is memory bound2944# if we can parse into a 2nd file that is in reverse order2945# we can probably do something really efficient2946my@git_log_params= ('--pretty','--parents','--topo-order');29472948if(defined$lastcommit) {2949push@git_log_params,"$lastcommit..$self->{module}";2950}else{2951push@git_log_params,$self->{module};2952}2953# git-rev-list is the backend / plumbing version of git-log2954open(GITLOG,'-|','git','rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";29552956my@commits;29572958my%commit= ();29592960while( <GITLOG> )2961{2962chomp;2963if(m/^commit\s+(.*)$/) {2964# on ^commit lines put the just seen commit in the stack2965# and prime things for the next one2966if(keys%commit) {2967my%copy=%commit;2968unshift@commits, \%copy;2969%commit= ();2970}2971my@parents=split(m/\s+/,$1);2972$commit{hash} =shift@parents;2973$commit{parents} = \@parents;2974}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2975# on rfc822-like lines seen before we see any message,2976# lowercase the entry and put it in the hash as key-value2977$commit{lc($1)} =$2;2978}else{2979# message lines - skip initial empty line2980# and trim whitespace2981if(!exists($commit{message}) &&m/^\s*$/) {2982# define it to mark the end of headers2983$commit{message} ='';2984next;2985}2986s/^\s+//;s/\s+$//;# trim ws2987$commit{message} .=$_."\n";2988}2989}2990close GITLOG;29912992unshift@commits, \%commitif(keys%commit);29932994# Now all the commits are in the @commits bucket2995# ordered by time DESC. for each commit that needs processing,2996# determine whether it's following the last head we've seen or if2997# it's on its own branch, grab a file list, and add whatever's changed2998# NOTE: $lastcommit refers to the last commit from previous run2999# $lastpicked is the last commit we picked in this run3000my$lastpicked;3001my$head= {};3002if(defined$lastcommit) {3003$lastpicked=$lastcommit;3004}30053006my$committotal=scalar(@commits);3007my$commitcount=0;30083009# Load the head table into $head (for cached lookups during the update process)3010foreachmy$file( @{$self->gethead()} )3011{3012$head->{$file->{name}} =$file;3013}30143015foreachmy$commit(@commits)3016{3017$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3018if(defined$lastpicked)3019{3020if(!in_array($lastpicked, @{$commit->{parents}}))3021{3022# skip, we'll see this delta3023# as part of a merge later3024# warn "skipping off-track $commit->{hash}\n";3025next;3026}elsif(@{$commit->{parents}} >1) {3027# it is a merge commit, for each parent that is3028# not $lastpicked, see if we can get a log3029# from the merge-base to that parent to put it3030# in the message as a merge summary.3031my@parents= @{$commit->{parents}};3032foreachmy$parent(@parents) {3033# git-merge-base can potentially (but rarely) throw3034# several candidate merge bases. let's assume3035# that the first one is the best one.3036if($parenteq$lastpicked) {3037next;3038}3039my$base=eval{3040 safe_pipe_capture('git','merge-base',3041$lastpicked,$parent);3042};3043# The two branches may not be related at all,3044# in which case merge base simply fails to find3045# any, but that's Ok.3046next if($@);30473048chomp$base;3049if($base) {3050my@merged;3051# print "want to log between $base $parent \n";3052open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3053or die"Cannot call git-log:$!";3054my$mergedhash;3055while(<GITLOG>) {3056chomp;3057if(!defined$mergedhash) {3058if(m/^commit\s+(.+)$/) {3059$mergedhash=$1;3060}else{3061next;3062}3063}else{3064# grab the first line that looks non-rfc8223065# aka has content after leading space3066if(m/^\s+(\S.*)$/) {3067my$title=$1;3068$title=substr($title,0,100);# truncate3069unshift@merged,"$mergedhash$title";3070undef$mergedhash;3071}3072}3073}3074close GITLOG;3075if(@merged) {3076$commit->{mergemsg} =$commit->{message};3077$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3078foreachmy$summary(@merged) {3079$commit->{mergemsg} .="\t$summary\n";3080}3081$commit->{mergemsg} .="\n\n";3082# print "Message for $commit->{hash} \n$commit->{mergemsg}";3083}3084}3085}3086}3087}30883089# convert the date to CVS-happy format3090$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);30913092if(defined($lastpicked) )3093{3094my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3095local($/) ="\0";3096while( <FILELIST> )3097{3098chomp;3099unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)3100{3101die("Couldn't process git-diff-tree line :$_");3102}3103my($mode,$hash,$change) = ($1,$2,$3);3104my$name= <FILELIST>;3105chomp($name);31063107# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");31083109my$git_perms="";3110$git_perms.="r"if($mode&4);3111$git_perms.="w"if($mode&2);3112$git_perms.="x"if($mode&1);3113$git_perms="rw"if($git_permseq"");31143115if($changeeq"D")3116{3117#$log->debug("DELETE $name");3118$head->{$name} = {3119 name =>$name,3120 revision =>$head->{$name}{revision} +1,3121 filehash =>"deleted",3122 commithash =>$commit->{hash},3123 modified =>$commit->{date},3124 author =>$commit->{author},3125 mode =>$git_perms,3126};3127$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3128}3129elsif($changeeq"M"||$changeeq"T")3130{3131#$log->debug("MODIFIED $name");3132$head->{$name} = {3133 name =>$name,3134 revision =>$head->{$name}{revision} +1,3135 filehash =>$hash,3136 commithash =>$commit->{hash},3137 modified =>$commit->{date},3138 author =>$commit->{author},3139 mode =>$git_perms,3140};3141$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3142}3143elsif($changeeq"A")3144{3145#$log->debug("ADDED $name");3146$head->{$name} = {3147 name =>$name,3148 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3149 filehash =>$hash,3150 commithash =>$commit->{hash},3151 modified =>$commit->{date},3152 author =>$commit->{author},3153 mode =>$git_perms,3154};3155$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3156}3157else3158{3159$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");3160die;3161}3162}3163close FILELIST;3164}else{3165# this is used to detect files removed from the repo3166my$seen_files= {};31673168my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");3169local$/="\0";3170while( <FILELIST> )3171{3172chomp;3173unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)3174{3175die("Couldn't process git-ls-tree line :$_");3176}31773178my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);31793180$seen_files->{$git_filename} =1;31813182my($oldhash,$oldrevision,$oldmode) = (3183$head->{$git_filename}{filehash},3184$head->{$git_filename}{revision},3185$head->{$git_filename}{mode}3186);31873188if($git_perms=~/^\d\d\d(\d)\d\d/o)3189{3190$git_perms="";3191$git_perms.="r"if($1&4);3192$git_perms.="w"if($1&2);3193$git_perms.="x"if($1&1);3194}else{3195$git_perms="rw";3196}31973198# unless the file exists with the same hash, we need to update it ...3199unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)3200{3201my$newrevision= ($oldrevisionor0) +1;32023203$head->{$git_filename} = {3204 name =>$git_filename,3205 revision =>$newrevision,3206 filehash =>$git_hash,3207 commithash =>$commit->{hash},3208 modified =>$commit->{date},3209 author =>$commit->{author},3210 mode =>$git_perms,3211};321232133214$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3215}3216}3217close FILELIST;32183219# Detect deleted files3220foreachmy$file(keys%$head)3221{3222unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")3223{3224$head->{$file}{revision}++;3225$head->{$file}{filehash} ="deleted";3226$head->{$file}{commithash} =$commit->{hash};3227$head->{$file}{modified} =$commit->{date};3228$head->{$file}{author} =$commit->{author};32293230$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});3231}3232}3233# END : "Detect deleted files"3234}323532363237if(exists$commit->{mergemsg})3238{3239$self->insert_mergelog($commit->{hash},$commit->{mergemsg});3240}32413242$lastpicked=$commit->{hash};32433244$self->_set_prop("last_commit",$commit->{hash});3245}32463247$self->delete_head();3248foreachmy$file(keys%$head)3249{3250$self->insert_head(3251$file,3252$head->{$file}{revision},3253$head->{$file}{filehash},3254$head->{$file}{commithash},3255$head->{$file}{modified},3256$head->{$file}{author},3257$head->{$file}{mode},3258);3259}3260# invalidate the gethead cache3261$self->{gethead_cache} =undef;326232633264# Ending exclusive lock here3265$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3266}32673268sub insert_rev3269{3270my$self=shift;3271my$name=shift;3272my$revision=shift;3273my$filehash=shift;3274my$commithash=shift;3275my$modified=shift;3276my$author=shift;3277my$mode=shift;3278my$tablename=$self->tablename("revision");32793280my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3281$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3282}32833284sub insert_mergelog3285{3286my$self=shift;3287my$key=shift;3288my$value=shift;3289my$tablename=$self->tablename("commitmsgs");32903291my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3292$insert_mergelog->execute($key,$value);3293}32943295sub delete_head3296{3297my$self=shift;3298my$tablename=$self->tablename("head");32993300my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3301$delete_head->execute();3302}33033304sub insert_head3305{3306my$self=shift;3307my$name=shift;3308my$revision=shift;3309my$filehash=shift;3310my$commithash=shift;3311my$modified=shift;3312my$author=shift;3313my$mode=shift;3314my$tablename=$self->tablename("head");33153316my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3317$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3318}33193320sub _headrev3321{3322my$self=shift;3323my$filename=shift;3324my$tablename=$self->tablename("head");33253326my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM$tablenameWHERE name=?",{},1);3327$db_query->execute($filename);3328my($hash,$revision,$mode) =$db_query->fetchrow_array;33293330return($hash,$revision,$mode);3331}33323333sub _get_prop3334{3335my$self=shift;3336my$key=shift;3337my$tablename=$self->tablename("properties");33383339my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3340$db_query->execute($key);3341my($value) =$db_query->fetchrow_array;33423343return$value;3344}33453346sub _set_prop3347{3348my$self=shift;3349my$key=shift;3350my$value=shift;3351my$tablename=$self->tablename("properties");33523353my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3354$db_query->execute($value,$key);33553356unless($db_query->rows)3357{3358$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3359$db_query->execute($key,$value);3360}33613362return$value;3363}33643365=head2 gethead33663367=cut33683369sub gethead3370{3371my$self=shift;3372my$tablename=$self->tablename("head");33733374return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );33753376my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3377$db_query->execute();33783379my$tree= [];3380while(my$file=$db_query->fetchrow_hashref)3381{3382push@$tree,$file;3383}33843385$self->{gethead_cache} =$tree;33863387return$tree;3388}33893390=head2 getlog33913392=cut33933394sub getlog3395{3396my$self=shift;3397my$filename=shift;3398my$tablename=$self->tablename("revision");33993400my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3401$db_query->execute($filename);34023403my$tree= [];3404while(my$file=$db_query->fetchrow_hashref)3405{3406push@$tree,$file;3407}34083409return$tree;3410}34113412=head2 getmeta34133414This function takes a filename (with path) argument and returns a hashref of3415metadata for that file.34163417=cut34183419sub getmeta3420{3421my$self=shift;3422my$filename=shift;3423my$revision=shift;3424my$tablename_rev=$self->tablename("revision");3425my$tablename_head=$self->tablename("head");34263427my$db_query;3428if(defined($revision)and$revision=~/^\d+$/)3429{3430$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND revision=?",{},1);3431$db_query->execute($filename,$revision);3432}3433elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)3434{3435$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND commithash=?",{},1);3436$db_query->execute($filename,$revision);3437}else{3438$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_headWHERE name=?",{},1);3439$db_query->execute($filename);3440}34413442return$db_query->fetchrow_hashref;3443}34443445=head2 commitmessage34463447this function takes a commithash and returns the commit message for that commit34483449=cut3450sub commitmessage3451{3452my$self=shift;3453my$commithash=shift;3454my$tablename=$self->tablename("commitmsgs");34553456die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);34573458my$db_query;3459$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3460$db_query->execute($commithash);34613462my($message) =$db_query->fetchrow_array;34633464if(defined($message) )3465{3466$message.=" "if($message=~/\n$/);3467return$message;3468}34693470my@lines= safe_pipe_capture("git","cat-file","commit",$commithash);3471shift@lineswhile($lines[0] =~/\S/);3472$message=join("",@lines);3473$message.=" "if($message=~/\n$/);3474return$message;3475}34763477=head2 gethistory34783479This function takes a filename (with path) argument and returns an arrayofarrays3480containing revision,filehash,commithash ordered by revision descending34813482=cut3483sub gethistory3484{3485my$self=shift;3486my$filename=shift;3487my$tablename=$self->tablename("revision");34883489my$db_query;3490$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3491$db_query->execute($filename);34923493return$db_query->fetchall_arrayref;3494}34953496=head2 gethistorydense34973498This function takes a filename (with path) argument and returns an arrayofarrays3499containing revision,filehash,commithash ordered by revision descending.35003501This version of gethistory skips deleted entries -- so it is useful for annotate.3502The 'dense' part is a reference to a '--dense' option available for git-rev-list3503and other git tools that depend on it.35043505=cut3506sub gethistorydense3507{3508my$self=shift;3509my$filename=shift;3510my$tablename=$self->tablename("revision");35113512my$db_query;3513$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);3514$db_query->execute($filename);35153516return$db_query->fetchall_arrayref;3517}35183519=head2 in_array()35203521from Array::PAT - mimics the in_array() function3522found in PHP. Yuck but works for small arrays.35233524=cut3525sub in_array3526{3527my($check,@array) =@_;3528my$retval=0;3529foreachmy$test(@array){3530if($checkeq$test){3531$retval=1;3532}3533}3534return$retval;3535}35363537=head2 safe_pipe_capture35383539an alternative to `command` that allows input to be passed as an array3540to work around shell problems with weird characters in arguments35413542=cut3543sub safe_pipe_capture {35443545my@output;35463547if(my$pid=open my$child,'-|') {3548@output= (<$child>);3549close$childor die join(' ',@_).":$!$?";3550}else{3551exec(@_)or die"$!$?";# exec() can fail the executable can't be found3552}3553returnwantarray?@output:join('',@output);3554}35553556=head2 mangle_dirname35573558create a string from a directory name that is suitable to use as3559part of a filename, mainly by converting all chars except \w.- to _35603561=cut3562sub mangle_dirname {3563my$dirname=shift;3564return unlessdefined$dirname;35653566$dirname=~s/[^\w.-]/_/g;35673568return$dirname;3569}35703571=head2 mangle_tablename35723573create a string from a that is suitable to use as part of an SQL table3574name, mainly by converting all chars except \w to _35753576=cut3577sub mangle_tablename {3578my$tablename=shift;3579return unlessdefined$tablename;35803581$tablename=~s/[^\w_]/_/g;35823583return$tablename;3584}358535861;