1#!/usr/bin/perl 2 3#### 4#### This application is a CVS emulation layer for git. 5#### It is intended for clients to connect over SSH. 6#### See the documentation for more details. 7#### 8#### Copyright The Open University UK - 2006. 9#### 10#### Authors: Martyn Smith <martyn@catalyst.net.nz> 11#### Martin Langhoff <martin@catalyst.net.nz> 12#### 13#### 14#### Released under the GNU Public License, version 2. 15#### 16#### 17 18use strict; 19use warnings; 20use bytes; 21 22use Fcntl; 23use File::Temp qw/tempdir tempfile/; 24use File::Path qw/rmtree/; 25use File::Basename; 26use Getopt::Long qw(:config require_order no_ignore_case); 27 28my$VERSION='@@GIT_VERSION@@'; 29 30my$log= GITCVS::log->new(); 31my$cfg; 32 33my$DATE_LIST= { 34 Jan =>"01", 35 Feb =>"02", 36 Mar =>"03", 37 Apr =>"04", 38 May =>"05", 39 Jun =>"06", 40 Jul =>"07", 41 Aug =>"08", 42 Sep =>"09", 43 Oct =>"10", 44 Nov =>"11", 45 Dec =>"12", 46}; 47 48# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 49$| =1; 50 51#### Definition and mappings of functions #### 52 53my$methods= { 54'Root'=> \&req_Root, 55'Valid-responses'=> \&req_Validresponses, 56'valid-requests'=> \&req_validrequests, 57'Directory'=> \&req_Directory, 58'Entry'=> \&req_Entry, 59'Modified'=> \&req_Modified, 60'Unchanged'=> \&req_Unchanged, 61'Questionable'=> \&req_Questionable, 62'Argument'=> \&req_Argument, 63'Argumentx'=> \&req_Argument, 64'expand-modules'=> \&req_expandmodules, 65'add'=> \&req_add, 66'remove'=> \&req_remove, 67'co'=> \&req_co, 68'update'=> \&req_update, 69'ci'=> \&req_ci, 70'diff'=> \&req_diff, 71'log'=> \&req_log, 72'rlog'=> \&req_log, 73'tag'=> \&req_CATCHALL, 74'status'=> \&req_status, 75'admin'=> \&req_CATCHALL, 76'history'=> \&req_CATCHALL, 77'watchers'=> \&req_EMPTY, 78'editors'=> \&req_EMPTY, 79'noop'=> \&req_EMPTY, 80'annotate'=> \&req_annotate, 81'Global_option'=> \&req_Globaloption, 82#'annotate' => \&req_CATCHALL, 83}; 84 85############################################## 86 87 88# $state holds all the bits of information the clients sends us that could 89# potentially be useful when it comes to actually _doing_ something. 90my$state= { prependdir =>''}; 91 92# Work is for managing temporary working directory 93my$work= 94{ 95state=>undef,# undef, 1 (empty), 2 (with stuff) 96 workDir =>undef, 97index=>undef, 98 emptyDir =>undef, 99 tmpDir =>undef 100}; 101 102$log->info("--------------- STARTING -----------------"); 103 104my$usage= 105"Usage: git cvsserver [options] [pserver|server] [<directory> ...]\n". 106" --base-path <path> : Prepend to requested CVSROOT\n". 107" Can be read from GIT_CVSSERVER_BASE_PATH\n". 108" --strict-paths : Don't allow recursing into subdirectories\n". 109" --export-all : Don't check for gitcvs.enabled in config\n". 110" --version, -V : Print version information and exit\n". 111" --help, -h, -H : Print usage information and exit\n". 112"\n". 113"<directory> ... is a list of allowed directories. If no directories\n". 114"are given, all are allowed. This is an additional restriction, gitcvs\n". 115"access still needs to be enabled by the gitcvs.enabled config option.\n". 116"Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n"; 117 118my@opts= ('help|h|H','version|V', 119'base-path=s','strict-paths','export-all'); 120GetOptions($state,@opts) 121or die$usage; 122 123if($state->{version}) { 124print"git-cvsserver version$VERSION\n"; 125exit; 126} 127if($state->{help}) { 128print$usage; 129exit; 130} 131 132my$TEMP_DIR= tempdir( CLEANUP =>1); 133$log->debug("Temporary directory is '$TEMP_DIR'"); 134 135$state->{method} ='ext'; 136if(@ARGV) { 137if($ARGV[0]eq'pserver') { 138$state->{method} ='pserver'; 139shift@ARGV; 140}elsif($ARGV[0]eq'server') { 141shift@ARGV; 142} 143} 144 145# everything else is a directory 146$state->{allowed_roots} = [@ARGV]; 147 148# don't export the whole system unless the users requests it 149if($state->{'export-all'} && !@{$state->{allowed_roots}}) { 150die"--export-all can only be used together with an explicit whitelist\n"; 151} 152 153# Environment handling for running under git-shell 154if(exists$ENV{GIT_CVSSERVER_BASE_PATH}) { 155if($state->{'base-path'}) { 156die"Cannot specify base path both ways.\n"; 157} 158my$base_path=$ENV{GIT_CVSSERVER_BASE_PATH}; 159$state->{'base-path'} =$base_path; 160$log->debug("Picked up base path '$base_path' from environment.\n"); 161} 162if(exists$ENV{GIT_CVSSERVER_ROOT}) { 163if(@{$state->{allowed_roots}}) { 164die"Cannot specify roots both ways:@ARGV\n"; 165} 166my$allowed_root=$ENV{GIT_CVSSERVER_ROOT}; 167$state->{allowed_roots} = [$allowed_root]; 168$log->debug("Picked up allowed root '$allowed_root' from environment.\n"); 169} 170 171# if we are called with a pserver argument, 172# deal with the authentication cat before entering the 173# main loop 174if($state->{method}eq'pserver') { 175my$line= <STDIN>;chomp$line; 176unless($line=~/^BEGIN (AUTH|VERIFICATION) REQUEST$/) { 177die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 178} 179my$request=$1; 180$line= <STDIN>;chomp$line; 181unless(req_Root('root',$line)) {# reuse Root 182print"E Invalid root$line\n"; 183exit1; 184} 185$line= <STDIN>;chomp$line; 186unless($lineeq'anonymous') { 187print"E Only anonymous user allowed via pserver\n"; 188print"I HATE YOU\n"; 189exit1; 190} 191$line= <STDIN>;chomp$line;# validate the password? 192$line= <STDIN>;chomp$line; 193unless($lineeq"END$requestREQUEST") { 194die"E Do not understand$line-- expecting END$requestREQUEST\n"; 195} 196print"I LOVE YOU\n"; 197exit if$requesteq'VERIFICATION';# cvs login 198# and now back to our regular programme... 199} 200 201# Keep going until the client closes the connection 202while(<STDIN>) 203{ 204chomp; 205 206# Check to see if we've seen this method, and call appropriate function. 207if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 208{ 209# use the $methods hash to call the appropriate sub for this command 210#$log->info("Method : $1"); 211&{$methods->{$1}}($1,$2); 212}else{ 213# log fatal because we don't understand this function. If this happens 214# we're fairly screwed because we don't know if the client is expecting 215# a response. If it is, the client will hang, we'll hang, and the whole 216# thing will be custard. 217$log->fatal("Don't understand command$_\n"); 218die("Unknown command$_"); 219} 220} 221 222$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 223$log->info("--------------- FINISH -----------------"); 224 225chdir'/'; 226exit0; 227 228# Magic catchall method. 229# This is the method that will handle all commands we haven't yet 230# implemented. It simply sends a warning to the log file indicating a 231# command that hasn't been implemented has been invoked. 232sub req_CATCHALL 233{ 234my($cmd,$data) =@_; 235$log->warn("Unhandled command : req_$cmd:$data"); 236} 237 238# This method invariably succeeds with an empty response. 239sub req_EMPTY 240{ 241print"ok\n"; 242} 243 244# Root pathname \n 245# Response expected: no. Tell the server which CVSROOT to use. Note that 246# pathname is a local directory and not a fully qualified CVSROOT variable. 247# pathname must already exist; if creating a new root, use the init 248# request, not Root. pathname does not include the hostname of the server, 249# how to access the server, etc.; by the time the CVS protocol is in use, 250# connection, authentication, etc., are already taken care of. The Root 251# request must be sent only once, and it must be sent before any requests 252# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 253sub req_Root 254{ 255my($cmd,$data) =@_; 256$log->debug("req_Root :$data"); 257 258unless($data=~ m#^/#) { 259print"error 1 Root must be an absolute pathname\n"; 260return0; 261} 262 263my$cvsroot=$state->{'base-path'} ||''; 264$cvsroot=~ s#/+$##; 265$cvsroot.=$data; 266 267if($state->{CVSROOT} 268&& ($state->{CVSROOT}ne$cvsroot)) { 269print"error 1 Conflicting roots specified\n"; 270return0; 271} 272 273$state->{CVSROOT} =$cvsroot; 274 275$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 276 277if(@{$state->{allowed_roots}}) { 278my$allowed=0; 279foreachmy$dir(@{$state->{allowed_roots}}) { 280next unless$dir=~ m#^/#; 281$dir=~ s#/+$##; 282if($state->{'strict-paths'}) { 283if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 284$allowed=1; 285last; 286} 287}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 288$allowed=1; 289last; 290} 291} 292 293unless($allowed) { 294print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 295print"E\n"; 296print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 297return0; 298} 299} 300 301unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 302print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 303print"E\n"; 304print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 305return0; 306} 307 308my@gitvars=`git config -l`; 309if($?) { 310print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 311print"E\n"; 312print"error 1 - problem executing git-config\n"; 313return0; 314} 315foreachmy$line(@gitvars) 316{ 317next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 318unless($2) { 319$cfg->{$1}{$3} =$4; 320}else{ 321$cfg->{$1}{$2}{$3} =$4; 322} 323} 324 325my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 326||$cfg->{gitcvs}{enabled}); 327unless($state->{'export-all'} || 328($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 329print"E GITCVS emulation needs to be enabled on this repo\n"; 330print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 331print"E\n"; 332print"error 1 GITCVS emulation disabled\n"; 333return0; 334} 335 336my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 337if($logfile) 338{ 339$log->setfile($logfile); 340}else{ 341$log->nofile(); 342} 343 344return1; 345} 346 347# Global_option option \n 348# Response expected: no. Transmit one of the global options `-q', `-Q', 349# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 350# variations (such as combining of options) are allowed. For graceful 351# handling of valid-requests, it is probably better to make new global 352# options separate requests, rather than trying to add them to this 353# request. 354sub req_Globaloption 355{ 356my($cmd,$data) =@_; 357$log->debug("req_Globaloption :$data"); 358$state->{globaloptions}{$data} =1; 359} 360 361# Valid-responses request-list \n 362# Response expected: no. Tell the server what responses the client will 363# accept. request-list is a space separated list of tokens. 364sub req_Validresponses 365{ 366my($cmd,$data) =@_; 367$log->debug("req_Validresponses :$data"); 368 369# TODO : re-enable this, currently it's not particularly useful 370#$state->{validresponses} = [ split /\s+/, $data ]; 371} 372 373# valid-requests \n 374# Response expected: yes. Ask the server to send back a Valid-requests 375# response. 376sub req_validrequests 377{ 378my($cmd,$data) =@_; 379 380$log->debug("req_validrequests"); 381 382$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 383$log->debug("SEND : ok"); 384 385print"Valid-requests ".join(" ",keys%$methods) ."\n"; 386print"ok\n"; 387} 388 389# Directory local-directory \n 390# Additional data: repository \n. Response expected: no. Tell the server 391# what directory to use. The repository should be a directory name from a 392# previous server response. Note that this both gives a default for Entry 393# and Modified and also for ci and the other commands; normal usage is to 394# send Directory for each directory in which there will be an Entry or 395# Modified, and then a final Directory for the original directory, then the 396# command. The local-directory is relative to the top level at which the 397# command is occurring (i.e. the last Directory which is sent before the 398# command); to indicate that top level, `.' should be sent for 399# local-directory. 400sub req_Directory 401{ 402my($cmd,$data) =@_; 403 404my$repository= <STDIN>; 405chomp$repository; 406 407 408$state->{localdir} =$data; 409$state->{repository} =$repository; 410$state->{path} =$repository; 411$state->{path} =~s/^\Q$state->{CVSROOT}\E\///; 412$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 413$state->{path} .="/"if($state->{path} =~ /\S/ ); 414 415$state->{directory} =$state->{localdir}; 416$state->{directory} =""if($state->{directory}eq"."); 417$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 418 419if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 420{ 421$log->info("Setting prepend to '$state->{path}'"); 422$state->{prependdir} =$state->{path}; 423foreachmy$entry(keys%{$state->{entries}} ) 424{ 425$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 426delete$state->{entries}{$entry}; 427} 428} 429 430if(defined($state->{prependdir} ) ) 431{ 432$log->debug("Prepending '$state->{prependdir}' to state|directory"); 433$state->{directory} =$state->{prependdir} .$state->{directory} 434} 435$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 436} 437 438# Entry entry-line \n 439# Response expected: no. Tell the server what version of a file is on the 440# local machine. The name in entry-line is a name relative to the directory 441# most recently specified with Directory. If the user is operating on only 442# some files in a directory, Entry requests for only those files need be 443# included. If an Entry request is sent without Modified, Is-modified, or 444# Unchanged, it means the file is lost (does not exist in the working 445# directory). If both Entry and one of Modified, Is-modified, or Unchanged 446# are sent for the same file, Entry must be sent first. For a given file, 447# one can send Modified, Is-modified, or Unchanged, but not more than one 448# of these three. 449sub req_Entry 450{ 451my($cmd,$data) =@_; 452 453#$log->debug("req_Entry : $data"); 454 455my@data=split(/\//,$data); 456 457$state->{entries}{$state->{directory}.$data[1]} = { 458 revision =>$data[2], 459 conflict =>$data[3], 460 options =>$data[4], 461 tag_or_date =>$data[5], 462}; 463 464$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 465} 466 467# Questionable filename \n 468# Response expected: no. Additional data: no. Tell the server to check 469# whether filename should be ignored, and if not, next time the server 470# sends responses, send (in a M response) `?' followed by the directory and 471# filename. filename must not contain `/'; it needs to be a file in the 472# directory named by the most recent Directory request. 473sub req_Questionable 474{ 475my($cmd,$data) =@_; 476 477$log->debug("req_Questionable :$data"); 478$state->{entries}{$state->{directory}.$data}{questionable} =1; 479} 480 481# add \n 482# Response expected: yes. Add a file or directory. This uses any previous 483# Argument, Directory, Entry, or Modified requests, if they have been sent. 484# The last Directory sent specifies the working directory at the time of 485# the operation. To add a directory, send the directory to be added using 486# Directory and Argument requests. 487sub req_add 488{ 489my($cmd,$data) =@_; 490 491 argsplit("add"); 492 493my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 494$updater->update(); 495 496 argsfromdir($updater); 497 498my$addcount=0; 499 500foreachmy$filename( @{$state->{args}} ) 501{ 502$filename= filecleanup($filename); 503 504my$meta=$updater->getmeta($filename); 505my$wrev= revparse($filename); 506 507if($wrev&&$meta&& ($wrev<0)) 508{ 509# previously removed file, add back 510$log->info("added file$filenamewas previously removed, send 1.$meta->{revision}"); 511 512print"MT +updated\n"; 513print"MT text U\n"; 514print"MT fname$filename\n"; 515print"MT newline\n"; 516print"MT -updated\n"; 517 518unless($state->{globaloptions}{-n} ) 519{ 520my($filepart,$dirpart) = filenamesplit($filename,1); 521 522print"Created$dirpart\n"; 523print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 524 525# this is an "entries" line 526my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 527$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 528print"/$filepart/1.$meta->{revision}//$kopts/\n"; 529# permissions 530$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 531print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 532# transmit file 533 transmitfile($meta->{filehash}); 534} 535 536next; 537} 538 539unless(defined($state->{entries}{$filename}{modified_filename} ) ) 540{ 541print"E cvs add: nothing known about `$filename'\n"; 542next; 543} 544# TODO : check we're not squashing an already existing file 545if(defined($state->{entries}{$filename}{revision} ) ) 546{ 547print"E cvs add: `$filename' has already been entered\n"; 548next; 549} 550 551my($filepart,$dirpart) = filenamesplit($filename,1); 552 553print"E cvs add: scheduling file `$filename' for addition\n"; 554 555print"Checked-in$dirpart\n"; 556print"$filename\n"; 557my$kopts= kopts_from_path($filename,"file", 558$state->{entries}{$filename}{modified_filename}); 559print"/$filepart/0//$kopts/\n"; 560 561my$requestedKopts=$state->{opt}{k}; 562if(defined($requestedKopts)) 563{ 564$requestedKopts="-k$requestedKopts"; 565} 566else 567{ 568$requestedKopts=""; 569} 570if($koptsne$requestedKopts) 571{ 572$log->warn("Ignoring requested -k='$requestedKopts'" 573." for '$filename'; detected -k='$kopts' instead"); 574#TODO: Also have option to send warning to user? 575} 576 577$addcount++; 578} 579 580if($addcount==1) 581{ 582print"E cvs add: use `cvs commit' to add this file permanently\n"; 583} 584elsif($addcount>1) 585{ 586print"E cvs add: use `cvs commit' to add these files permanently\n"; 587} 588 589print"ok\n"; 590} 591 592# remove \n 593# Response expected: yes. Remove a file. This uses any previous Argument, 594# Directory, Entry, or Modified requests, if they have been sent. The last 595# Directory sent specifies the working directory at the time of the 596# operation. Note that this request does not actually do anything to the 597# repository; the only effect of a successful remove request is to supply 598# the client with a new entries line containing `-' to indicate a removed 599# file. In fact, the client probably could perform this operation without 600# contacting the server, although using remove may cause the server to 601# perform a few more checks. The client sends a subsequent ci request to 602# actually record the removal in the repository. 603sub req_remove 604{ 605my($cmd,$data) =@_; 606 607 argsplit("remove"); 608 609# Grab a handle to the SQLite db and do any necessary updates 610my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 611$updater->update(); 612 613#$log->debug("add state : " . Dumper($state)); 614 615my$rmcount=0; 616 617foreachmy$filename( @{$state->{args}} ) 618{ 619$filename= filecleanup($filename); 620 621if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 622{ 623print"E cvs remove: file `$filename' still in working directory\n"; 624next; 625} 626 627my$meta=$updater->getmeta($filename); 628my$wrev= revparse($filename); 629 630unless(defined($wrev) ) 631{ 632print"E cvs remove: nothing known about `$filename'\n"; 633next; 634} 635 636if(defined($wrev)and$wrev<0) 637{ 638print"E cvs remove: file `$filename' already scheduled for removal\n"; 639next; 640} 641 642unless($wrev==$meta->{revision} ) 643{ 644# TODO : not sure if the format of this message is quite correct. 645print"E cvs remove: Up to date check failed for `$filename'\n"; 646next; 647} 648 649 650my($filepart,$dirpart) = filenamesplit($filename,1); 651 652print"E cvs remove: scheduling `$filename' for removal\n"; 653 654print"Checked-in$dirpart\n"; 655print"$filename\n"; 656my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 657print"/$filepart/-1.$wrev//$kopts/\n"; 658 659$rmcount++; 660} 661 662if($rmcount==1) 663{ 664print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 665} 666elsif($rmcount>1) 667{ 668print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 669} 670 671print"ok\n"; 672} 673 674# Modified filename \n 675# Response expected: no. Additional data: mode, \n, file transmission. Send 676# the server a copy of one locally modified file. filename is a file within 677# the most recent directory sent with Directory; it must not contain `/'. 678# If the user is operating on only some files in a directory, only those 679# files need to be included. This can also be sent without Entry, if there 680# is no entry for the file. 681sub req_Modified 682{ 683my($cmd,$data) =@_; 684 685my$mode= <STDIN>; 686defined$mode 687or(print"E end of file reading mode for$data\n"),return; 688chomp$mode; 689my$size= <STDIN>; 690defined$size 691or(print"E end of file reading size of$data\n"),return; 692chomp$size; 693 694# Grab config information 695my$blocksize=8192; 696my$bytesleft=$size; 697my$tmp; 698 699# Get a filehandle/name to write it to 700my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 701 702# Loop over file data writing out to temporary file. 703while($bytesleft) 704{ 705$blocksize=$bytesleftif($bytesleft<$blocksize); 706read STDIN,$tmp,$blocksize; 707print$fh $tmp; 708$bytesleft-=$blocksize; 709} 710 711close$fh 712or(print"E failed to write temporary,$filename:$!\n"),return; 713 714# Ensure we have something sensible for the file mode 715if($mode=~/u=(\w+)/) 716{ 717$mode=$1; 718}else{ 719$mode="rw"; 720} 721 722# Save the file data in $state 723$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 724$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 725$state->{entries}{$state->{directory}.$data}{modified_hash} =`git hash-object$filename`; 726$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 727 728 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 729} 730 731# Unchanged filename\n 732# Response expected: no. Tell the server that filename has not been 733# modified in the checked out directory. The filename is a file within the 734# most recent directory sent with Directory; it must not contain `/'. 735sub req_Unchanged 736{ 737 my ($cmd,$data) =@_; 738 739$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 740 741 #$log->debug("req_Unchanged :$data"); 742} 743 744# Argument text\n 745# Response expected: no. Save argument for use in a subsequent command. 746# Arguments accumulate until an argument-using command is given, at which 747# point they are forgotten. 748# Argumentx text\n 749# Response expected: no. Append\nfollowed by text to the current argument 750# being saved. 751sub req_Argument 752{ 753 my ($cmd,$data) =@_; 754 755 # Argumentx means: append to last Argument (with a newline in front) 756 757$log->debug("$cmd:$data"); 758 759 if ($cmdeq 'Argumentx') { 760 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 761 } else { 762 push @{$state->{arguments}},$data; 763 } 764} 765 766# expand-modules\n 767# Response expected: yes. Expand the modules which are specified in the 768# arguments. Returns the data in Module-expansion responses. Note that the 769# server can assume that this is checkout or export, not rtag or rdiff; the 770# latter do not access the working directory and thus have no need to 771# expand modules on the client side. Expand may not be the best word for 772# what this request does. It does not necessarily tell you all the files 773# contained in a module, for example. Basically it is a way of telling you 774# which working directories the server needs to know about in order to 775# handle a checkout of the specified modules. For example, suppose that the 776# server has a module defined by 777# aliasmodule -a 1dir 778# That is, one can check out aliasmodule and it will take 1dir in the 779# repository and check it out to 1dir in the working directory. Now suppose 780# the client already has this module checked out and is planning on using 781# the co request to update it. Without using expand-modules, the client 782# would have two bad choices: it could either send information about all 783# working directories under the current directory, which could be 784# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 785# stands for 1dir, and neglect to send information for 1dir, which would 786# lead to incorrect operation. With expand-modules, the client would first 787# ask for the module to be expanded: 788sub req_expandmodules 789{ 790 my ($cmd,$data) =@_; 791 792 argsplit(); 793 794$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 795 796 unless ( ref$state->{arguments} eq "ARRAY" ) 797 { 798 print "ok\n"; 799 return; 800 } 801 802 foreach my$module( @{$state->{arguments}} ) 803 { 804$log->debug("SEND : Module-expansion$module"); 805 print "Module-expansion$module\n"; 806 } 807 808 print "ok\n"; 809 statecleanup(); 810} 811 812# co\n 813# Response expected: yes. Get files from the repository. This uses any 814# previous Argument, Directory, Entry, or Modified requests, if they have 815# been sent. Arguments to this command are module names; the client cannot 816# know what directories they correspond to except by (1) just sending the 817# co request, and then seeing what directory names the server sends back in 818# its responses, and (2) the expand-modules request. 819sub req_co 820{ 821 my ($cmd,$data) =@_; 822 823 argsplit("co"); 824 825 # Provide list of modules, if -c was used. 826 if (exists$state->{opt}{c}) { 827 my$showref= `git show-ref --heads`; 828 for my$line(split '\n',$showref) { 829 if ($line=~ m% refs/heads/(.*)$%) { 830 print "M$1\t$1\n"; 831 } 832 } 833 print "ok\n"; 834 return 1; 835 } 836 837 my$module=$state->{args}[0]; 838$state->{module} =$module; 839 my$checkout_path=$module; 840 841 # use the user specified directory if we're given it 842$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 843 844$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 845 846$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 847 848$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 849 850# Grab a handle to the SQLite db and do any necessary updates 851my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 852$updater->update(); 853 854$checkout_path=~ s|/$||;# get rid of trailing slashes 855 856# Eclipse seems to need the Clear-sticky command 857# to prepare the 'Entries' file for the new directory. 858print"Clear-sticky$checkout_path/\n"; 859print$state->{CVSROOT} ."/$module/\n"; 860print"Clear-static-directory$checkout_path/\n"; 861print$state->{CVSROOT} ."/$module/\n"; 862print"Clear-sticky$checkout_path/\n";# yes, twice 863print$state->{CVSROOT} ."/$module/\n"; 864print"Template$checkout_path/\n"; 865print$state->{CVSROOT} ."/$module/\n"; 866print"0\n"; 867 868# instruct the client that we're checking out to $checkout_path 869print"E cvs checkout: Updating$checkout_path\n"; 870 871my%seendirs= (); 872my$lastdir=''; 873 874# recursive 875sub prepdir { 876my($dir,$repodir,$remotedir,$seendirs) =@_; 877my$parent= dirname($dir); 878$dir=~ s|/+$||; 879$repodir=~ s|/+$||; 880$remotedir=~ s|/+$||; 881$parent=~ s|/+$||; 882$log->debug("announcedir$dir,$repodir,$remotedir"); 883 884if($parenteq'.'||$parenteq'./') { 885$parent=''; 886} 887# recurse to announce unseen parents first 888if(length($parent) && !exists($seendirs->{$parent})) { 889 prepdir($parent,$repodir,$remotedir,$seendirs); 890} 891# Announce that we are going to modify at the parent level 892if($parent) { 893print"E cvs checkout: Updating$remotedir/$parent\n"; 894}else{ 895print"E cvs checkout: Updating$remotedir\n"; 896} 897print"Clear-sticky$remotedir/$parent/\n"; 898print"$repodir/$parent/\n"; 899 900print"Clear-static-directory$remotedir/$dir/\n"; 901print"$repodir/$dir/\n"; 902print"Clear-sticky$remotedir/$parent/\n";# yes, twice 903print"$repodir/$parent/\n"; 904print"Template$remotedir/$dir/\n"; 905print"$repodir/$dir/\n"; 906print"0\n"; 907 908$seendirs->{$dir} =1; 909} 910 911foreachmy$git( @{$updater->gethead} ) 912{ 913# Don't want to check out deleted files 914next if($git->{filehash}eq"deleted"); 915 916my$fullName=$git->{name}; 917($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 918 919if(length($git->{dir}) &&$git->{dir}ne'./' 920&&$git->{dir}ne$lastdir) { 921unless(exists($seendirs{$git->{dir}})) { 922 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 923$checkout_path, \%seendirs); 924$lastdir=$git->{dir}; 925$seendirs{$git->{dir}} =1; 926} 927print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 928} 929 930# modification time of this file 931print"Mod-time$git->{modified}\n"; 932 933# print some information to the client 934if(defined($git->{dir} )and$git->{dir}ne"./") 935{ 936print"M U$checkout_path/$git->{dir}$git->{name}\n"; 937}else{ 938print"M U$checkout_path/$git->{name}\n"; 939} 940 941# instruct client we're sending a file to put in this path 942print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 943 944print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 945 946# this is an "entries" line 947my$kopts= kopts_from_path($fullName,"sha1",$git->{filehash}); 948print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 949# permissions 950print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 951 952# transmit file 953 transmitfile($git->{filehash}); 954} 955 956print"ok\n"; 957 958 statecleanup(); 959} 960 961# update \n 962# Response expected: yes. Actually do a cvs update command. This uses any 963# previous Argument, Directory, Entry, or Modified requests, if they have 964# been sent. The last Directory sent specifies the working directory at the 965# time of the operation. The -I option is not used--files which the client 966# can decide whether to ignore are not mentioned and the client sends the 967# Questionable request for others. 968sub req_update 969{ 970my($cmd,$data) =@_; 971 972$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 973 974 argsplit("update"); 975 976# 977# It may just be a client exploring the available heads/modules 978# in that case, list them as top level directories and leave it 979# at that. Eclipse uses this technique to offer you a list of 980# projects (heads in this case) to checkout. 981# 982if($state->{module}eq'') { 983my$showref=`git show-ref --heads`; 984print"E cvs update: Updating .\n"; 985formy$line(split'\n',$showref) { 986if($line=~ m% refs/heads/(.*)$%) { 987print"E cvs update: New directory `$1'\n"; 988} 989} 990print"ok\n"; 991return1; 992} 993 994 995# Grab a handle to the SQLite db and do any necessary updates 996my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 997 998$updater->update(); 9991000 argsfromdir($updater);10011002#$log->debug("update state : " . Dumper($state));10031004my$last_dirname="///";10051006# foreach file specified on the command line ...1007foreachmy$filename( @{$state->{args}} )1008{1009$filename= filecleanup($filename);10101011$log->debug("Processing file$filename");10121013unless($state->{globaloptions}{-Q} ||$state->{globaloptions}{-q} )1014{1015my$cur_dirname= dirname($filename);1016if($cur_dirnamene$last_dirname)1017{1018$last_dirname=$cur_dirname;1019if($cur_dirnameeq"")1020{1021$cur_dirname=".";1022}1023print"E cvs update: Updating$cur_dirname\n";1024}1025}10261027# if we have a -C we should pretend we never saw modified stuff1028if(exists($state->{opt}{C} ) )1029{1030delete$state->{entries}{$filename}{modified_hash};1031delete$state->{entries}{$filename}{modified_filename};1032$state->{entries}{$filename}{unchanged} =1;1033}10341035my$meta;1036if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/)1037{1038$meta=$updater->getmeta($filename,$1);1039}else{1040$meta=$updater->getmeta($filename);1041}10421043# If -p was given, "print" the contents of the requested revision.1044if(exists($state->{opt}{p} ) ) {1045if(defined($meta->{revision} ) ) {1046$log->info("Printing '$filename' revision ".$meta->{revision});10471048 transmitfile($meta->{filehash}, {print=>1});1049}10501051next;1052}10531054if( !defined$meta)1055{1056$meta= {1057 name =>$filename,1058 revision =>0,1059 filehash =>'added'1060};1061}10621063my$oldmeta=$meta;10641065my$wrev= revparse($filename);10661067# If the working copy is an old revision, lets get that version too for comparison.1068if(defined($wrev)and$wrev!=$meta->{revision} )1069{1070$oldmeta=$updater->getmeta($filename,$wrev);1071}10721073#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");10741075# Files are up to date if the working copy and repo copy have the same revision,1076# and the working copy is unmodified _and_ the user hasn't specified -C1077next if(defined($wrev)1078and defined($meta->{revision})1079and$wrev==$meta->{revision}1080and$state->{entries}{$filename}{unchanged}1081and not exists($state->{opt}{C} ) );10821083# If the working copy and repo copy have the same revision,1084# but the working copy is modified, tell the client it's modified1085if(defined($wrev)1086and defined($meta->{revision})1087and$wrev==$meta->{revision}1088and defined($state->{entries}{$filename}{modified_hash})1089and not exists($state->{opt}{C} ) )1090{1091$log->info("Tell the client the file is modified");1092print"MT text M\n";1093print"MT fname$filename\n";1094print"MT newline\n";1095next;1096}10971098if($meta->{filehash}eq"deleted")1099{1100my($filepart,$dirpart) = filenamesplit($filename,1);11011102$log->info("Removing '$filename' from working copy (no longer in the repo)");11031104print"E cvs update: `$filename' is no longer in the repository\n";1105# Don't want to actually _DO_ the update if -n specified1106unless($state->{globaloptions}{-n} ) {1107print"Removed$dirpart\n";1108print"$filepart\n";1109}1110}1111elsif(not defined($state->{entries}{$filename}{modified_hash} )1112or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1113or$meta->{filehash}eq'added')1114{1115# normal update, just send the new revision (either U=Update,1116# or A=Add, or R=Remove)1117if(defined($wrev) &&$wrev<0)1118{1119$log->info("Tell the client the file is scheduled for removal");1120print"MT text R\n";1121print"MT fname$filename\n";1122print"MT newline\n";1123next;1124}1125elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) )1126{1127$log->info("Tell the client the file is scheduled for addition");1128print"MT text A\n";1129print"MT fname$filename\n";1130print"MT newline\n";1131next;11321133}1134else{1135$log->info("Updating '$filename' to ".$meta->{revision});1136print"MT +updated\n";1137print"MT text U\n";1138print"MT fname$filename\n";1139print"MT newline\n";1140print"MT -updated\n";1141}11421143my($filepart,$dirpart) = filenamesplit($filename,1);11441145# Don't want to actually _DO_ the update if -n specified1146unless($state->{globaloptions}{-n} )1147{1148if(defined($wrev) )1149{1150# instruct client we're sending a file to put in this path as a replacement1151print"Update-existing$dirpart\n";1152$log->debug("Updating existing file 'Update-existing$dirpart'");1153}else{1154# instruct client we're sending a file to put in this path as a new file1155print"Clear-static-directory$dirpart\n";1156print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1157print"Clear-sticky$dirpart\n";1158print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";11591160$log->debug("Creating new file 'Created$dirpart'");1161print"Created$dirpart\n";1162}1163print$state->{CVSROOT} ."/$state->{module}/$filename\n";11641165# this is an "entries" line1166my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1167$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1168print"/$filepart/1.$meta->{revision}//$kopts/\n";11691170# permissions1171$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1172print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";11731174# transmit file1175 transmitfile($meta->{filehash});1176}1177}else{1178$log->info("Updating '$filename'");1179my($filepart,$dirpart) = filenamesplit($meta->{name},1);11801181my$mergeDir= setupTmpDir();11821183my$file_local=$filepart.".mine";1184my$mergedFile="$mergeDir/$file_local";1185system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1186my$file_old=$filepart.".".$oldmeta->{revision};1187 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1188my$file_new=$filepart.".".$meta->{revision};1189 transmitfile($meta->{filehash}, { targetfile =>$file_new});11901191# we need to merge with the local changes ( M=successful merge, C=conflict merge )1192$log->info("Merging$file_local,$file_old,$file_new");1193print"M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into$filename\n";11941195$log->debug("Temporary directory for merge is$mergeDir");11961197my$return=system("git","merge-file",$file_local,$file_old,$file_new);1198$return>>=8;11991200 cleanupTmpDir();12011202if($return==0)1203{1204$log->info("Merged successfully");1205print"M M$filename\n";1206$log->debug("Merged$dirpart");12071208# Don't want to actually _DO_ the update if -n specified1209unless($state->{globaloptions}{-n} )1210{1211print"Merged$dirpart\n";1212$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1213print$state->{CVSROOT} ."/$state->{module}/$filename\n";1214my$kopts= kopts_from_path("$dirpart/$filepart",1215"file",$mergedFile);1216$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1217print"/$filepart/1.$meta->{revision}//$kopts/\n";1218}1219}1220elsif($return==1)1221{1222$log->info("Merged with conflicts");1223print"E cvs update: conflicts found in$filename\n";1224print"M C$filename\n";12251226# Don't want to actually _DO_ the update if -n specified1227unless($state->{globaloptions}{-n} )1228{1229print"Merged$dirpart\n";1230print$state->{CVSROOT} ."/$state->{module}/$filename\n";1231my$kopts= kopts_from_path("$dirpart/$filepart",1232"file",$mergedFile);1233print"/$filepart/1.$meta->{revision}/+/$kopts/\n";1234}1235}1236else1237{1238$log->warn("Merge failed");1239next;1240}12411242# Don't want to actually _DO_ the update if -n specified1243unless($state->{globaloptions}{-n} )1244{1245# permissions1246$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1247print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";12481249# transmit file, format is single integer on a line by itself (file1250# size) followed by the file contents1251# TODO : we should copy files in blocks1252my$data=`cat$mergedFile`;1253$log->debug("File size : " . length($data));1254 print length($data) . "\n";1255 print$data;1256 }1257 }12581259 }12601261 print "ok\n";1262}12631264sub req_ci1265{1266 my ($cmd,$data) =@_;12671268 argsplit("ci");12691270 #$log->debug("State : " . Dumper($state));12711272$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));12731274 if ($state->{method} eq 'pserver')1275 {1276 print "error 1 pserver access cannot commit\n";1277 cleanupWorkTree();1278 exit;1279 }12801281 if ( -e$state->{CVSROOT} . "/index" )1282 {1283$log->warn("file 'index' already exists in the git repository");1284 print "error 1 Index already exists in git repo\n";1285 cleanupWorkTree();1286 exit;1287 }12881289 # Grab a handle to the SQLite db and do any necessary updates1290 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1291$updater->update();12921293 # Remember where the head was at the beginning.1294 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1295 chomp$parenthash;1296 if ($parenthash!~ /^[0-9a-f]{40}$/) {1297 print "error 1 pserver cannot find the current HEAD of module";1298 cleanupWorkTree();1299 exit;1300 }13011302 setupWorkTree($parenthash);13031304$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");13051306$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");13071308 my@committedfiles= ();1309 my%oldmeta;13101311 # foreach file specified on the command line ...1312 foreach my$filename( @{$state->{args}} )1313 {1314 my$committedfile=$filename;1315$filename= filecleanup($filename);13161317 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );13181319 my$meta=$updater->getmeta($filename);1320$oldmeta{$filename} =$meta;13211322 my$wrev= revparse($filename);13231324 my ($filepart,$dirpart) = filenamesplit($filename);13251326 # do a checkout of the file if it is part of this tree1327 if ($wrev) {1328 system('git', 'checkout-index', '-f', '-u',$filename);1329 unless ($?== 0) {1330 die "Error running git-checkout-index -f -u$filename:$!";1331 }1332 }13331334 my$addflag= 0;1335 my$rmflag= 0;1336$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1337$addflag= 1 unless ( -e$filename);13381339 # Do up to date checking1340 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1341 {1342 # fail everything if an up to date check fails1343 print "error 1 Up to date check failed for$filename\n";1344 cleanupWorkTree();1345 exit;1346 }13471348 push@committedfiles,$committedfile;1349$log->info("Committing$filename");13501351 system("mkdir","-p",$dirpart) unless ( -d$dirpart);13521353 unless ($rmflag)1354 {1355$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1356 rename$state->{entries}{$filename}{modified_filename},$filename;13571358 # Calculate modes to remove1359 my$invmode= "";1360 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }13611362$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1363 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1364 }13651366 if ($rmflag)1367 {1368$log->info("Removing file '$filename'");1369 unlink($filename);1370 system("git", "update-index", "--remove",$filename);1371 }1372 elsif ($addflag)1373 {1374$log->info("Adding file '$filename'");1375 system("git", "update-index", "--add",$filename);1376 } else {1377$log->info("Updating file '$filename'");1378 system("git", "update-index",$filename);1379 }1380 }13811382 unless ( scalar(@committedfiles) > 0 )1383 {1384 print "E No files to commit\n";1385 print "ok\n";1386 cleanupWorkTree();1387 return;1388 }13891390 my$treehash= `git write-tree`;1391 chomp$treehash;13921393$log->debug("Treehash :$treehash, Parenthash :$parenthash");13941395 # write our commit message out if we have one ...1396 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1397 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1398 if ( defined ($cfg->{gitcvs}{commitmsgannotation} ) ) {1399 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/) {1400 print$msg_fh"\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"1401 }1402 } else {1403 print$msg_fh"\n\nvia git-CVS emulator\n";1404 }1405 close$msg_fh;14061407 my$commithash= `git commit-tree $treehash-p $parenthash<$msg_filename`;1408chomp($commithash);1409$log->info("Commit hash :$commithash");14101411unless($commithash=~/[a-zA-Z0-9]{40}/)1412{1413$log->warn("Commit failed (Invalid commit hash)");1414print"error 1 Commit failed (unknown reason)\n";1415 cleanupWorkTree();1416exit;1417}14181419### Emulate git-receive-pack by running hooks/update1420my@hook= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1421$parenthash,$commithash);1422if( -x $hook[0] ) {1423unless(system(@hook) ==0)1424{1425$log->warn("Commit failed (update hook declined to update ref)");1426print"error 1 Commit failed (update hook declined)\n";1427 cleanupWorkTree();1428exit;1429}1430}14311432### Update the ref1433if(system(qw(git update-ref -m),"cvsserver ci",1434"refs/heads/$state->{module}",$commithash,$parenthash)) {1435$log->warn("update-ref for$state->{module} failed.");1436print"error 1 Cannot commit -- update first\n";1437 cleanupWorkTree();1438exit;1439}14401441### Emulate git-receive-pack by running hooks/post-receive1442my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1443if( -x $hook) {1444open(my$pipe,"|$hook") ||die"can't fork$!";14451446local$SIG{PIPE} =sub{die'pipe broke'};14471448print$pipe"$parenthash$commithashrefs/heads/$state->{module}\n";14491450close$pipe||die"bad pipe:$!$?";1451}14521453$updater->update();14541455### Then hooks/post-update1456$hook=$ENV{GIT_DIR}.'hooks/post-update';1457if(-x $hook) {1458system($hook,"refs/heads/$state->{module}");1459}14601461# foreach file specified on the command line ...1462foreachmy$filename(@committedfiles)1463{1464$filename= filecleanup($filename);14651466my$meta=$updater->getmeta($filename);1467unless(defined$meta->{revision}) {1468$meta->{revision} =1;1469}14701471my($filepart,$dirpart) = filenamesplit($filename,1);14721473$log->debug("Checked-in$dirpart:$filename");14741475print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1476if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1477{1478print"M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";1479print"Remove-entry$dirpart\n";1480print"$filename\n";1481}else{1482if($meta->{revision} ==1) {1483print"M initial revision: 1.1\n";1484}else{1485print"M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";1486}1487print"Checked-in$dirpart\n";1488print"$filename\n";1489my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1490print"/$filepart/1.$meta->{revision}//$kopts/\n";1491}1492}14931494 cleanupWorkTree();1495print"ok\n";1496}14971498sub req_status1499{1500my($cmd,$data) =@_;15011502 argsplit("status");15031504$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1505#$log->debug("status state : " . Dumper($state));15061507# Grab a handle to the SQLite db and do any necessary updates1508my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1509$updater->update();15101511# if no files were specified, we need to work out what files we should be providing status on ...1512 argsfromdir($updater);15131514# foreach file specified on the command line ...1515foreachmy$filename( @{$state->{args}} )1516{1517$filename= filecleanup($filename);15181519next ifexists($state->{opt}{l}) &&index($filename,'/',length($state->{prependdir})) >=0;15201521my$meta=$updater->getmeta($filename);1522my$oldmeta=$meta;15231524my$wrev= revparse($filename);15251526# If the working copy is an old revision, lets get that version too for comparison.1527if(defined($wrev)and$wrev!=$meta->{revision} )1528{1529$oldmeta=$updater->getmeta($filename,$wrev);1530}15311532# TODO : All possible statuses aren't yet implemented1533my$status;1534# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1535$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1536and1537( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1538or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1539);15401541# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1542$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1543and1544($state->{entries}{$filename}{unchanged}1545or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1546);15471548# Need checkout if it exists in the repo but doesn't have a working copy1549$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );15501551# Locally modified if working copy and repo copy have the same revision but there are local changes1552$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );15531554# Needs Merge if working copy revision is less than repo copy and there are local changes1555$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );15561557$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1558$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1559$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1560$status||="File had conflicts on merge"if(0);15611562$status||="Unknown";15631564my($filepart) = filenamesplit($filename);15651566print"M ===================================================================\n";1567print"M File:$filepart\tStatus:$status\n";1568if(defined($state->{entries}{$filename}{revision}) )1569{1570print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1571}else{1572print"M Working revision:\tNo entry for$filename\n";1573}1574if(defined($meta->{revision}) )1575{1576print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1577print"M Sticky Tag:\t\t(none)\n";1578print"M Sticky Date:\t\t(none)\n";1579print"M Sticky Options:\t\t(none)\n";1580}else{1581print"M Repository revision:\tNo revision control file\n";1582}1583print"M\n";1584}15851586print"ok\n";1587}15881589sub req_diff1590{1591my($cmd,$data) =@_;15921593 argsplit("diff");15941595$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1596#$log->debug("status state : " . Dumper($state));15971598my($revision1,$revision2);1599if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1600{1601$revision1=$state->{opt}{r}[0];1602$revision2=$state->{opt}{r}[1];1603}else{1604$revision1=$state->{opt}{r};1605}16061607$revision1=~s/^1\.//if(defined($revision1) );1608$revision2=~s/^1\.//if(defined($revision2) );16091610$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );16111612# Grab a handle to the SQLite db and do any necessary updates1613my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1614$updater->update();16151616# if no files were specified, we need to work out what files we should be providing status on ...1617 argsfromdir($updater);16181619# foreach file specified on the command line ...1620foreachmy$filename( @{$state->{args}} )1621{1622$filename= filecleanup($filename);16231624my($fh,$file1,$file2,$meta1,$meta2,$filediff);16251626my$wrev= revparse($filename);16271628# We need _something_ to diff against1629next unless(defined($wrev) );16301631# if we have a -r switch, use it1632if(defined($revision1) )1633{1634(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1635$meta1=$updater->getmeta($filename,$revision1);1636unless(defined($meta1)and$meta1->{filehash}ne"deleted")1637{1638print"E File$filenameat revision 1.$revision1doesn't exist\n";1639next;1640}1641 transmitfile($meta1->{filehash}, { targetfile =>$file1});1642}1643# otherwise we just use the working copy revision1644else1645{1646(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1647$meta1=$updater->getmeta($filename,$wrev);1648 transmitfile($meta1->{filehash}, { targetfile =>$file1});1649}16501651# if we have a second -r switch, use it too1652if(defined($revision2) )1653{1654(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1655$meta2=$updater->getmeta($filename,$revision2);16561657unless(defined($meta2)and$meta2->{filehash}ne"deleted")1658{1659print"E File$filenameat revision 1.$revision2doesn't exist\n";1660next;1661}16621663 transmitfile($meta2->{filehash}, { targetfile =>$file2});1664}1665# otherwise we just use the working copy1666else1667{1668$file2=$state->{entries}{$filename}{modified_filename};1669}16701671# if we have been given -r, and we don't have a $file2 yet, lets get one1672if(defined($revision1)and not defined($file2) )1673{1674(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1675$meta2=$updater->getmeta($filename,$wrev);1676 transmitfile($meta2->{filehash}, { targetfile =>$file2});1677}16781679# We need to have retrieved something useful1680next unless(defined($meta1) );16811682# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1683next if(not defined($meta2)and$wrev==$meta1->{revision}1684and1685( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1686or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1687);16881689# Apparently we only show diffs for locally modified files1690next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );16911692print"M Index:$filename\n";1693print"M ===================================================================\n";1694print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1695print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1696print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1697print"M diff ";1698foreachmy$opt(keys%{$state->{opt}} )1699{1700if(ref$state->{opt}{$opt}eq"ARRAY")1701{1702foreachmy$value( @{$state->{opt}{$opt}} )1703{1704print"-$opt$value";1705}1706}else{1707print"-$opt";1708print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1709}1710}1711print"$filename\n";17121713$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));17141715($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);17161717if(exists$state->{opt}{u} )1718{1719system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1720}else{1721system("diff$file1$file2>$filediff");1722}17231724while( <$fh> )1725{1726print"M$_";1727}1728close$fh;1729}17301731print"ok\n";1732}17331734sub req_log1735{1736my($cmd,$data) =@_;17371738 argsplit("log");17391740$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1741#$log->debug("log state : " . Dumper($state));17421743my($minrev,$maxrev);1744if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1745{1746my$control=$2;1747$minrev=$1;1748$maxrev=$3;1749$minrev=~s/^1\.//if(defined($minrev) );1750$maxrev=~s/^1\.//if(defined($maxrev) );1751$minrev++if(defined($minrev)and$controleq"::");1752}17531754# Grab a handle to the SQLite db and do any necessary updates1755my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1756$updater->update();17571758# if no files were specified, we need to work out what files we should be providing status on ...1759 argsfromdir($updater);17601761# foreach file specified on the command line ...1762foreachmy$filename( @{$state->{args}} )1763{1764$filename= filecleanup($filename);17651766my$headmeta=$updater->getmeta($filename);17671768my$revisions=$updater->getlog($filename);1769my$totalrevisions=scalar(@$revisions);17701771if(defined($minrev) )1772{1773$log->debug("Removing revisions less than$minrev");1774while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1775{1776pop@$revisions;1777}1778}1779if(defined($maxrev) )1780{1781$log->debug("Removing revisions greater than$maxrev");1782while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1783{1784shift@$revisions;1785}1786}17871788next unless(scalar(@$revisions) );17891790print"M\n";1791print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1792print"M Working file:$filename\n";1793print"M head: 1.$headmeta->{revision}\n";1794print"M branch:\n";1795print"M locks: strict\n";1796print"M access list:\n";1797print"M symbolic names:\n";1798print"M keyword substitution: kv\n";1799print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1800print"M description:\n";18011802foreachmy$revision(@$revisions)1803{1804print"M ----------------------------\n";1805print"M revision 1.$revision->{revision}\n";1806# reformat the date for log output1807$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}) );1808$revision->{author} = cvs_author($revision->{author});1809print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1810my$commitmessage=$updater->commitmessage($revision->{commithash});1811$commitmessage=~s/^/M /mg;1812print$commitmessage."\n";1813}1814print"M =============================================================================\n";1815}18161817print"ok\n";1818}18191820sub req_annotate1821{1822my($cmd,$data) =@_;18231824 argsplit("annotate");18251826$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1827#$log->debug("status state : " . Dumper($state));18281829# Grab a handle to the SQLite db and do any necessary updates1830my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1831$updater->update();18321833# if no files were specified, we need to work out what files we should be providing annotate on ...1834 argsfromdir($updater);18351836# we'll need a temporary checkout dir1837 setupWorkTree();18381839$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");18401841# foreach file specified on the command line ...1842foreachmy$filename( @{$state->{args}} )1843{1844$filename= filecleanup($filename);18451846my$meta=$updater->getmeta($filename);18471848next unless($meta->{revision} );18491850# get all the commits that this file was in1851# in dense format -- aka skip dead revisions1852my$revisions=$updater->gethistorydense($filename);1853my$lastseenin=$revisions->[0][2];18541855# populate the temporary index based on the latest commit were we saw1856# the file -- but do it cheaply without checking out any files1857# TODO: if we got a revision from the client, use that instead1858# to look up the commithash in sqlite (still good to default to1859# the current head as we do now)1860system("git","read-tree",$lastseenin);1861unless($?==0)1862{1863print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";1864return;1865}1866$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");18671868# do a checkout of the file1869system('git','checkout-index','-f','-u',$filename);1870unless($?==0) {1871print"E error running git-checkout-index -f -u$filename:$!\n";1872return;1873}18741875$log->info("Annotate$filename");18761877# Prepare a file with the commits from the linearized1878# history that annotate should know about. This prevents1879# git-jsannotate telling us about commits we are hiding1880# from the client.18811882my$a_hints="$work->{workDir}/.annotate_hints";1883if(!open(ANNOTATEHINTS,'>',$a_hints)) {1884print"E failed to open '$a_hints' for writing:$!\n";1885return;1886}1887for(my$i=0;$i<@$revisions;$i++)1888{1889print ANNOTATEHINTS $revisions->[$i][2];1890if($i+1<@$revisions) {# have we got a parent?1891print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1892}1893print ANNOTATEHINTS "\n";1894}18951896print ANNOTATEHINTS "\n";1897close ANNOTATEHINTS1898or(print"E failed to write$a_hints:$!\n"),return;18991900my@cmd= (qw(git annotate -l -S),$a_hints,$filename);1901if(!open(ANNOTATE,"-|",@cmd)) {1902print"E error invoking ".join(' ',@cmd) .":$!\n";1903return;1904}1905my$metadata= {};1906print"E Annotations for$filename\n";1907print"E ***************\n";1908while( <ANNOTATE> )1909{1910if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1911{1912my$commithash=$1;1913my$data=$2;1914unless(defined($metadata->{$commithash} ) )1915{1916$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1917$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});1918$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1919}1920printf("M 1.%-5d (%-8s%10s):%s\n",1921$metadata->{$commithash}{revision},1922$metadata->{$commithash}{author},1923$metadata->{$commithash}{modified},1924$data1925);1926}else{1927$log->warn("Error in annotate output! LINE:$_");1928print"E Annotate error\n";1929next;1930}1931}1932close ANNOTATE;1933}19341935# done; get out of the tempdir1936 cleanupWorkTree();19371938print"ok\n";19391940}19411942# This method takes the state->{arguments} array and produces two new arrays.1943# The first is $state->{args} which is everything before the '--' argument, and1944# the second is $state->{files} which is everything after it.1945sub argsplit1946{1947$state->{args} = [];1948$state->{files} = [];1949$state->{opt} = {};19501951return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");19521953my$type=shift;19541955if(defined($type) )1956{1957my$opt= {};1958$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");1959$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1960$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");1961$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1962$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1963$opt= { k =>1, m =>1}if($typeeq"add");1964$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1965$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");196619671968while(scalar( @{$state->{arguments}} ) >0)1969{1970my$arg=shift@{$state->{arguments}};19711972next if($argeq"--");1973next unless($arg=~/\S/);19741975# if the argument looks like a switch1976if($arg=~/^-(\w)(.*)/)1977{1978# if it's a switch that takes an argument1979if($opt->{$1} )1980{1981# If this switch has already been provided1982if($opt->{$1} >1and exists($state->{opt}{$1} ) )1983{1984$state->{opt}{$1} = [$state->{opt}{$1} ];1985if(length($2) >0)1986{1987push@{$state->{opt}{$1}},$2;1988}else{1989push@{$state->{opt}{$1}},shift@{$state->{arguments}};1990}1991}else{1992# if there's extra data in the arg, use that as the argument for the switch1993if(length($2) >0)1994{1995$state->{opt}{$1} =$2;1996}else{1997$state->{opt}{$1} =shift@{$state->{arguments}};1998}1999}2000}else{2001$state->{opt}{$1} =undef;2002}2003}2004else2005{2006push@{$state->{args}},$arg;2007}2008}2009}2010else2011{2012my$mode=0;20132014foreachmy$value( @{$state->{arguments}} )2015{2016if($valueeq"--")2017{2018$mode++;2019next;2020}2021push@{$state->{args}},$valueif($mode==0);2022push@{$state->{files}},$valueif($mode==1);2023}2024}2025}20262027# This method uses $state->{directory} to populate $state->{args} with a list of filenames2028sub argsfromdir2029{2030my$updater=shift;20312032$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");20332034return if(scalar( @{$state->{args}} ) >1);20352036my@gethead= @{$updater->gethead};20372038# push added files2039foreachmy$file(keys%{$state->{entries}}) {2040if(exists$state->{entries}{$file}{revision} &&2041$state->{entries}{$file}{revision} ==0)2042{2043push@gethead, { name =>$file, filehash =>'added'};2044}2045}20462047if(scalar(@{$state->{args}}) ==1)2048{2049my$arg=$state->{args}[0];2050$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );20512052$log->info("Only one arg specified, checking for directory expansion on '$arg'");20532054foreachmy$file(@gethead)2055{2056next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2057next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);2058push@{$state->{args}},$file->{name};2059}20602061shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);2062}else{2063$log->info("Only one arg specified, populating file list automatically");20642065$state->{args} = [];20662067foreachmy$file(@gethead)2068{2069next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2070next unless($file->{name} =~s/^$state->{prependdir}//);2071push@{$state->{args}},$file->{name};2072}2073}2074}20752076# This method cleans up the $state variable after a command that uses arguments has run2077sub statecleanup2078{2079$state->{files} = [];2080$state->{args} = [];2081$state->{arguments} = [];2082$state->{entries} = {};2083}20842085sub revparse2086{2087my$filename=shift;20882089returnundefunless(defined($state->{entries}{$filename}{revision} ) );20902091return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);2092return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);20932094returnundef;2095}20962097# This method takes a file hash and does a CVS "file transfer". Its2098# exact behaviour depends on a second, optional hash table argument:2099# - If $options->{targetfile}, dump the contents to that file;2100# - If $options->{print}, use M/MT to transmit the contents one line2101# at a time;2102# - Otherwise, transmit the size of the file, followed by the file2103# contents.2104sub transmitfile2105{2106my$filehash=shift;2107my$options=shift;21082109if(defined($filehash)and$filehasheq"deleted")2110{2111$log->warn("filehash is 'deleted'");2112return;2113}21142115die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);21162117my$type=`git cat-file -t$filehash`;2118 chomp$type;21192120 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );21212122 my$size= `git cat-file -s $filehash`;2123chomp$size;21242125$log->debug("transmitfile($filehash) size=$size, type=$type");21262127if(open my$fh,'-|',"git","cat-file","blob",$filehash)2128{2129if(defined($options->{targetfile} ) )2130{2131my$targetfile=$options->{targetfile};2132open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2133print NEWFILE $_while( <$fh> );2134close NEWFILE or die("Failed to write '$targetfile':$!");2135}elsif(defined($options->{print} ) &&$options->{print} ) {2136while( <$fh> ) {2137if(/\n\z/) {2138print'M ',$_;2139}else{2140print'MT text ',$_,"\n";2141}2142}2143}else{2144print"$size\n";2145printwhile( <$fh> );2146}2147close$fhor die("Couldn't close filehandle for transmitfile():$!");2148}else{2149die("Couldn't execute git-cat-file");2150}2151}21522153# This method takes a file name, and returns ( $dirpart, $filepart ) which2154# refers to the directory portion and the file portion of the filename2155# respectively2156sub filenamesplit2157{2158my$filename=shift;2159my$fixforlocaldir=shift;21602161my($filepart,$dirpart) = ($filename,".");2162($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2163$dirpart.="/";21642165if($fixforlocaldir)2166{2167$dirpart=~s/^$state->{prependdir}//;2168}21692170return($filepart,$dirpart);2171}21722173sub filecleanup2174{2175my$filename=shift;21762177returnundefunless(defined($filename));2178if($filename=~/^\// )2179{2180print"E absolute filenames '$filename' not supported by server\n";2181returnundef;2182}21832184$filename=~s/^\.\///g;2185$filename=$state->{prependdir} .$filename;2186return$filename;2187}21882189sub validateGitDir2190{2191if( !defined($state->{CVSROOT}) )2192{2193print"error 1 CVSROOT not specified\n";2194 cleanupWorkTree();2195exit;2196}2197if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2198{2199print"error 1 Internally inconsistent CVSROOT\n";2200 cleanupWorkTree();2201exit;2202}2203}22042205# Setup working directory in a work tree with the requested version2206# loaded in the index.2207sub setupWorkTree2208{2209my($ver) =@_;22102211 validateGitDir();22122213if( (defined($work->{state}) &&$work->{state} !=1) ||2214defined($work->{tmpDir}) )2215{2216$log->warn("Bad work tree state management");2217print"error 1 Internal setup multiple work trees without cleanup\n";2218 cleanupWorkTree();2219exit;2220}22212222$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);22232224if( !defined($work->{index}) )2225{2226(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2227}22282229chdir$work->{workDir}or2230die"Unable to chdir to$work->{workDir}\n";22312232$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");22332234$ENV{GIT_WORK_TREE} =".";2235$ENV{GIT_INDEX_FILE} =$work->{index};2236$work->{state} =2;22372238if($ver)2239{2240system("git","read-tree",$ver);2241unless($?==0)2242{2243$log->warn("Error running git-read-tree");2244die"Error running git-read-tree$verin$work->{workDir}$!\n";2245}2246}2247# else # req_annotate reads tree for each file2248}22492250# Ensure current directory is in some kind of working directory,2251# with a recent version loaded in the index.2252sub ensureWorkTree2253{2254if(defined($work->{tmpDir}) )2255{2256$log->warn("Bad work tree state management [ensureWorkTree()]");2257print"error 1 Internal setup multiple dirs without cleanup\n";2258 cleanupWorkTree();2259exit;2260}2261if($work->{state} )2262{2263return;2264}22652266 validateGitDir();22672268if( !defined($work->{emptyDir}) )2269{2270$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);2271}2272chdir$work->{emptyDir}or2273die"Unable to chdir to$work->{emptyDir}\n";22742275my$ver=`git show-ref -s refs/heads/$state->{module}`;2276chomp$ver;2277if($ver!~/^[0-9a-f]{40}$/)2278{2279$log->warn("Error from git show-ref -s refs/head$state->{module}");2280print"error 1 cannot find the current HEAD of module";2281 cleanupWorkTree();2282exit;2283}22842285if( !defined($work->{index}) )2286{2287(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2288}22892290$ENV{GIT_WORK_TREE} =".";2291$ENV{GIT_INDEX_FILE} =$work->{index};2292$work->{state} =1;22932294system("git","read-tree",$ver);2295unless($?==0)2296{2297die"Error running git-read-tree$ver$!\n";2298}2299}23002301# Cleanup working directory that is not needed any longer.2302sub cleanupWorkTree2303{2304if( !$work->{state} )2305{2306return;2307}23082309chdir"/"or die"Unable to chdir '/'\n";23102311if(defined($work->{workDir}) )2312{2313 rmtree($work->{workDir} );2314undef$work->{workDir};2315}2316undef$work->{state};2317}23182319# Setup a temporary directory (not a working tree), typically for2320# merging dirty state as in req_update.2321sub setupTmpDir2322{2323$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);2324chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";23252326return$work->{tmpDir};2327}23282329# Clean up a previously setupTmpDir. Restore previous work tree if2330# appropriate.2331sub cleanupTmpDir2332{2333if( !defined($work->{tmpDir}) )2334{2335$log->warn("cleanup tmpdir that has not been setup");2336die"Cleanup tmpDir that has not been setup\n";2337}2338if(defined($work->{state}) )2339{2340if($work->{state} ==1)2341{2342chdir$work->{emptyDir}or2343die"Unable to chdir to$work->{emptyDir}\n";2344}2345elsif($work->{state} ==2)2346{2347chdir$work->{workDir}or2348die"Unable to chdir to$work->{emptyDir}\n";2349}2350else2351{2352$log->warn("Inconsistent work dir state");2353die"Inconsistent work dir state\n";2354}2355}2356else2357{2358chdir"/"or die"Unable to chdir '/'\n";2359}2360}23612362# Given a path, this function returns a string containing the kopts2363# that should go into that path's Entries line. For example, a binary2364# file should get -kb.2365sub kopts_from_path2366{2367my($path,$srcType,$name) =@_;23682369if(defined($cfg->{gitcvs}{usecrlfattr} )and2370$cfg->{gitcvs}{usecrlfattr} =~/\s*(1|true|yes)\s*$/i)2371{2372my($val) = check_attr("text",$path);2373if($valeq"unspecified")2374{2375$val= check_attr("crlf",$path);2376}2377if($valeq"unset")2378{2379return"-kb"2380}2381elsif( check_attr("eol",$path)ne"unspecified"||2382$valeq"set"||$valeq"input")2383{2384return"";2385}2386else2387{2388$log->info("Unrecognized check_attr crlf$path:$val");2389}2390}23912392if(defined($cfg->{gitcvs}{allbinary} ) )2393{2394if( ($cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i) )2395{2396return"-kb";2397}2398elsif( ($cfg->{gitcvs}{allbinary} =~/^\s*guess\s*$/i) )2399{2400if($srcTypeeq"sha1Or-k"&&2401!defined($name) )2402{2403my($ret)=$state->{entries}{$path}{options};2404if( !defined($ret) )2405{2406$ret=$state->{opt}{k};2407if(defined($ret))2408{2409$ret="-k$ret";2410}2411else2412{2413$ret="";2414}2415}2416if( ! ($ret=~/^(|-kb|-kkv|-kkvl|-kk|-ko|-kv)$/) )2417{2418print"E Bad -k option\n";2419$log->warn("Bad -k option:$ret");2420die"Error: Bad -k option:$ret\n";2421}24222423return$ret;2424}2425else2426{2427if( is_binary($srcType,$name) )2428{2429$log->debug("... as binary");2430return"-kb";2431}2432else2433{2434$log->debug("... as text");2435}2436}2437}2438}2439# Return "" to give no special treatment to any path2440return"";2441}24422443sub check_attr2444{2445my($attr,$path) =@_;2446 ensureWorkTree();2447if(open my$fh,'-|',"git","check-attr",$attr,"--",$path)2448{2449my$val= <$fh>;2450close$fh;2451$val=~s/.*: ([^:\r\n]*)\s*$/$1/;2452return$val;2453}2454else2455{2456returnundef;2457}2458}24592460# This should have the same heuristics as convert.c:is_binary() and related.2461# Note that the bare CR test is done by callers in convert.c.2462sub is_binary2463{2464my($srcType,$name) =@_;2465$log->debug("is_binary($srcType,$name)");24662467# Minimize amount of interpreted code run in the inner per-character2468# loop for large files, by totalling each character value and2469# then analyzing the totals.2470my@counts;2471my$i;2472for($i=0;$i<256;$i++)2473{2474$counts[$i]=0;2475}24762477my$fh= open_blob_or_die($srcType,$name);2478my$line;2479while(defined($line=<$fh>) )2480{2481# Any '\0' and bare CR are considered binary.2482if($line=~/\0|(\r[^\n])/)2483{2484close($fh);2485return1;2486}24872488# Count up each character in the line:2489my$len=length($line);2490for($i=0;$i<$len;$i++)2491{2492$counts[ord(substr($line,$i,1))]++;2493}2494}2495close$fh;24962497# Don't count CR and LF as either printable/nonprintable2498$counts[ord("\n")]=0;2499$counts[ord("\r")]=0;25002501# Categorize individual character count into printable and nonprintable:2502my$printable=0;2503my$nonprintable=0;2504for($i=0;$i<256;$i++)2505{2506if($i<32&&2507$i!=ord("\b") &&2508$i!=ord("\t") &&2509$i!=033&&# ESC2510$i!=014)# FF2511{2512$nonprintable+=$counts[$i];2513}2514elsif($i==127)# DEL2515{2516$nonprintable+=$counts[$i];2517}2518else2519{2520$printable+=$counts[$i];2521}2522}25232524return($printable>>7) <$nonprintable;2525}25262527# Returns open file handle. Possible invocations:2528# - open_blob_or_die("file",$filename);2529# - open_blob_or_die("sha1",$filehash);2530sub open_blob_or_die2531{2532my($srcType,$name) =@_;2533my($fh);2534if($srcTypeeq"file")2535{2536if( !open$fh,"<",$name)2537{2538$log->warn("Unable to open file$name:$!");2539die"Unable to open file$name:$!\n";2540}2541}2542elsif($srcTypeeq"sha1"||$srcTypeeq"sha1Or-k")2543{2544unless(defined($name)and$name=~/^[a-zA-Z0-9]{40}$/)2545{2546$log->warn("Need filehash");2547die"Need filehash\n";2548}25492550my$type=`git cat-file -t$name`;2551 chomp$type;25522553 unless ( defined ($type) and$typeeq "blob" )2554 {2555$log->warn("Invalid type '$type' for '$name'");2556 die ( "Invalid type '$type' (expected 'blob')" )2557 }25582559 my$size= `git cat-file -s $name`;2560chomp$size;25612562$log->debug("open_blob_or_die($name) size=$size, type=$type");25632564unless(open$fh,'-|',"git","cat-file","blob",$name)2565{2566$log->warn("Unable to open sha1$name");2567die"Unable to open sha1$name\n";2568}2569}2570else2571{2572$log->warn("Unknown type of blob source:$srcType");2573die"Unknown type of blob source:$srcType\n";2574}2575return$fh;2576}25772578# Generate a CVS author name from Git author information, by taking the local2579# part of the email address and replacing characters not in the Portable2580# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS2581# Login names are Unix login names, which should be restricted to this2582# character set.2583sub cvs_author2584{2585my$author_line=shift;2586(my$author) =$author_line=~/<([^@>]*)/;25872588$author=~s/[^-a-zA-Z0-9_.]/_/g;2589$author=~s/^-/_/;25902591$author;2592}25932594package GITCVS::log;25952596####2597#### Copyright The Open University UK - 2006.2598####2599#### Authors: Martyn Smith <martyn@catalyst.net.nz>2600#### Martin Langhoff <martin@catalyst.net.nz>2601####2602####26032604use strict;2605use warnings;26062607=head1 NAME26082609GITCVS::log26102611=head1 DESCRIPTION26122613This module provides very crude logging with a similar interface to2614Log::Log4perl26152616=head1 METHODS26172618=cut26192620=head2 new26212622Creates a new log object, optionally you can specify a filename here to2623indicate the file to log to. If no log file is specified, you can specify one2624later with method setfile, or indicate you no longer want logging with method2625nofile.26262627Until one of these methods is called, all log calls will buffer messages ready2628to write out.26292630=cut2631sub new2632{2633my$class=shift;2634my$filename=shift;26352636my$self= {};26372638bless$self,$class;26392640if(defined($filename) )2641{2642open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2643}26442645return$self;2646}26472648=head2 setfile26492650This methods takes a filename, and attempts to open that file as the log file.2651If successful, all buffered data is written out to the file, and any further2652logging is written directly to the file.26532654=cut2655sub setfile2656{2657my$self=shift;2658my$filename=shift;26592660if(defined($filename) )2661{2662open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2663}26642665return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");26662667while(my$line=shift@{$self->{buffer}} )2668{2669print{$self->{fh}}$line;2670}2671}26722673=head2 nofile26742675This method indicates no logging is going to be used. It flushes any entries in2676the internal buffer, and sets a flag to ensure no further data is put there.26772678=cut2679sub nofile2680{2681my$self=shift;26822683$self->{nolog} =1;26842685return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");26862687$self->{buffer} = [];2688}26892690=head2 _logopen26912692Internal method. Returns true if the log file is open, false otherwise.26932694=cut2695sub _logopen2696{2697my$self=shift;26982699return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2700return0;2701}27022703=head2 debug info warn fatal27042705These four methods are wrappers to _log. They provide the actual interface for2706logging data.27072708=cut2709sub debug {my$self=shift;$self->_log("debug",@_); }2710sub info {my$self=shift;$self->_log("info",@_); }2711subwarn{my$self=shift;$self->_log("warn",@_); }2712sub fatal {my$self=shift;$self->_log("fatal",@_); }27132714=head2 _log27152716This is an internal method called by the logging functions. It generates a2717timestamp and pushes the logged line either to file, or internal buffer.27182719=cut2720sub _log2721{2722my$self=shift;2723my$level=shift;27242725return if($self->{nolog} );27262727my@time=localtime;2728my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2729$time[5] +1900,2730$time[4] +1,2731$time[3],2732$time[2],2733$time[1],2734$time[0],2735uc$level,2736);27372738if($self->_logopen)2739{2740print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2741}else{2742push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2743}2744}27452746=head2 DESTROY27472748This method simply closes the file handle if one is open27492750=cut2751sub DESTROY2752{2753my$self=shift;27542755if($self->_logopen)2756{2757close$self->{fh};2758}2759}27602761package GITCVS::updater;27622763####2764#### Copyright The Open University UK - 2006.2765####2766#### Authors: Martyn Smith <martyn@catalyst.net.nz>2767#### Martin Langhoff <martin@catalyst.net.nz>2768####2769####27702771use strict;2772use warnings;2773use DBI;27742775=head1 METHODS27762777=cut27782779=head2 new27802781=cut2782sub new2783{2784my$class=shift;2785my$config=shift;2786my$module=shift;2787my$log=shift;27882789die"Need to specify a git repository"unless(defined($config)and-d $config);2790die"Need to specify a module"unless(defined($module) );27912792$class=ref($class) ||$class;27932794my$self= {};27952796bless$self,$class;27972798$self->{valid_tables} = {'revision'=>1,2799'revision_ix1'=>1,2800'revision_ix2'=>1,2801'head'=>1,2802'head_ix1'=>1,2803'properties'=>1,2804'commitmsgs'=>1};28052806$self->{module} =$module;2807$self->{git_path} =$config."/";28082809$self->{log} =$log;28102811die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );28122813$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2814$cfg->{gitcvs}{dbdriver} ||"SQLite";2815$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2816$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2817$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2818$cfg->{gitcvs}{dbuser} ||"";2819$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2820$cfg->{gitcvs}{dbpass} ||"";2821$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||2822$cfg->{gitcvs}{dbtablenameprefix} ||"";2823my%mapping= ( m =>$module,2824 a =>$state->{method},2825 u =>getlogin||getpwuid($<) || $<,2826 G =>$self->{git_path},2827 g => mangle_dirname($self->{git_path}),2828);2829$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2830$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;2831$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;2832$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});28332834die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2835die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2836$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2837$self->{dbuser},2838$self->{dbpass});2839die"Error connecting to database\n"unlessdefined$self->{dbh};28402841$self->{tables} = {};2842foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2843{2844$self->{tables}{$table} =1;2845}28462847# Construct the revision table if required2848unless($self->{tables}{$self->tablename("revision")} )2849{2850my$tablename=$self->tablename("revision");2851my$ix1name=$self->tablename("revision_ix1");2852my$ix2name=$self->tablename("revision_ix2");2853$self->{dbh}->do("2854 CREATE TABLE$tablename(2855 name TEXT NOT NULL,2856 revision INTEGER NOT NULL,2857 filehash TEXT NOT NULL,2858 commithash TEXT NOT NULL,2859 author TEXT NOT NULL,2860 modified TEXT NOT NULL,2861 mode TEXT NOT NULL2862 )2863 ");2864$self->{dbh}->do("2865 CREATE INDEX$ix1name2866 ON$tablename(name,revision)2867 ");2868$self->{dbh}->do("2869 CREATE INDEX$ix2name2870 ON$tablename(name,commithash)2871 ");2872}28732874# Construct the head table if required2875unless($self->{tables}{$self->tablename("head")} )2876{2877my$tablename=$self->tablename("head");2878my$ix1name=$self->tablename("head_ix1");2879$self->{dbh}->do("2880 CREATE TABLE$tablename(2881 name TEXT NOT NULL,2882 revision INTEGER NOT NULL,2883 filehash TEXT NOT NULL,2884 commithash TEXT NOT NULL,2885 author TEXT NOT NULL,2886 modified TEXT NOT NULL,2887 mode TEXT NOT NULL2888 )2889 ");2890$self->{dbh}->do("2891 CREATE INDEX$ix1name2892 ON$tablename(name)2893 ");2894}28952896# Construct the properties table if required2897unless($self->{tables}{$self->tablename("properties")} )2898{2899my$tablename=$self->tablename("properties");2900$self->{dbh}->do("2901 CREATE TABLE$tablename(2902 key TEXT NOT NULL PRIMARY KEY,2903 value TEXT2904 )2905 ");2906}29072908# Construct the commitmsgs table if required2909unless($self->{tables}{$self->tablename("commitmsgs")} )2910{2911my$tablename=$self->tablename("commitmsgs");2912$self->{dbh}->do("2913 CREATE TABLE$tablename(2914 key TEXT NOT NULL PRIMARY KEY,2915 value TEXT2916 )2917 ");2918}29192920return$self;2921}29222923=head2 tablename29242925=cut2926sub tablename2927{2928my$self=shift;2929my$name=shift;29302931if(exists$self->{valid_tables}{$name}) {2932return$self->{dbtablenameprefix} .$name;2933}else{2934returnundef;2935}2936}29372938=head2 update29392940=cut2941sub update2942{2943my$self=shift;29442945# first lets get the commit list2946$ENV{GIT_DIR} =$self->{git_path};29472948my$commitsha1=`git rev-parse$self->{module}`;2949chomp$commitsha1;29502951my$commitinfo=`git cat-file commit$self->{module} 2>&1`;2952unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2953{2954die("Invalid module '$self->{module}'");2955}295629572958my$git_log;2959my$lastcommit=$self->_get_prop("last_commit");29602961if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date2962return1;2963}29642965# Start exclusive lock here...2966$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";29672968# TODO: log processing is memory bound2969# if we can parse into a 2nd file that is in reverse order2970# we can probably do something really efficient2971my@git_log_params= ('--pretty','--parents','--topo-order');29722973if(defined$lastcommit) {2974push@git_log_params,"$lastcommit..$self->{module}";2975}else{2976push@git_log_params,$self->{module};2977}2978# git-rev-list is the backend / plumbing version of git-log2979open(GITLOG,'-|','git','rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";29802981my@commits;29822983my%commit= ();29842985while( <GITLOG> )2986{2987chomp;2988if(m/^commit\s+(.*)$/) {2989# on ^commit lines put the just seen commit in the stack2990# and prime things for the next one2991if(keys%commit) {2992my%copy=%commit;2993unshift@commits, \%copy;2994%commit= ();2995}2996my@parents=split(m/\s+/,$1);2997$commit{hash} =shift@parents;2998$commit{parents} = \@parents;2999}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {3000# on rfc822-like lines seen before we see any message,3001# lowercase the entry and put it in the hash as key-value3002$commit{lc($1)} =$2;3003}else{3004# message lines - skip initial empty line3005# and trim whitespace3006if(!exists($commit{message}) &&m/^\s*$/) {3007# define it to mark the end of headers3008$commit{message} ='';3009next;3010}3011s/^\s+//;s/\s+$//;# trim ws3012$commit{message} .=$_."\n";3013}3014}3015close GITLOG;30163017unshift@commits, \%commitif(keys%commit);30183019# Now all the commits are in the @commits bucket3020# ordered by time DESC. for each commit that needs processing,3021# determine whether it's following the last head we've seen or if3022# it's on its own branch, grab a file list, and add whatever's changed3023# NOTE: $lastcommit refers to the last commit from previous run3024# $lastpicked is the last commit we picked in this run3025my$lastpicked;3026my$head= {};3027if(defined$lastcommit) {3028$lastpicked=$lastcommit;3029}30303031my$committotal=scalar(@commits);3032my$commitcount=0;30333034# Load the head table into $head (for cached lookups during the update process)3035foreachmy$file( @{$self->gethead()} )3036{3037$head->{$file->{name}} =$file;3038}30393040foreachmy$commit(@commits)3041{3042$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3043if(defined$lastpicked)3044{3045if(!in_array($lastpicked, @{$commit->{parents}}))3046{3047# skip, we'll see this delta3048# as part of a merge later3049# warn "skipping off-track $commit->{hash}\n";3050next;3051}elsif(@{$commit->{parents}} >1) {3052# it is a merge commit, for each parent that is3053# not $lastpicked, see if we can get a log3054# from the merge-base to that parent to put it3055# in the message as a merge summary.3056my@parents= @{$commit->{parents}};3057foreachmy$parent(@parents) {3058# git-merge-base can potentially (but rarely) throw3059# several candidate merge bases. let's assume3060# that the first one is the best one.3061if($parenteq$lastpicked) {3062next;3063}3064my$base=eval{3065 safe_pipe_capture('git','merge-base',3066$lastpicked,$parent);3067};3068# The two branches may not be related at all,3069# in which case merge base simply fails to find3070# any, but that's Ok.3071next if($@);30723073chomp$base;3074if($base) {3075my@merged;3076# print "want to log between $base $parent \n";3077open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3078or die"Cannot call git-log:$!";3079my$mergedhash;3080while(<GITLOG>) {3081chomp;3082if(!defined$mergedhash) {3083if(m/^commit\s+(.+)$/) {3084$mergedhash=$1;3085}else{3086next;3087}3088}else{3089# grab the first line that looks non-rfc8223090# aka has content after leading space3091if(m/^\s+(\S.*)$/) {3092my$title=$1;3093$title=substr($title,0,100);# truncate3094unshift@merged,"$mergedhash$title";3095undef$mergedhash;3096}3097}3098}3099close GITLOG;3100if(@merged) {3101$commit->{mergemsg} =$commit->{message};3102$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3103foreachmy$summary(@merged) {3104$commit->{mergemsg} .="\t$summary\n";3105}3106$commit->{mergemsg} .="\n\n";3107# print "Message for $commit->{hash} \n$commit->{mergemsg}";3108}3109}3110}3111}3112}31133114# convert the date to CVS-happy format3115$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);31163117if(defined($lastpicked) )3118{3119my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3120local($/) ="\0";3121while( <FILELIST> )3122{3123chomp;3124unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)3125{3126die("Couldn't process git-diff-tree line :$_");3127}3128my($mode,$hash,$change) = ($1,$2,$3);3129my$name= <FILELIST>;3130chomp($name);31313132# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");31333134my$git_perms="";3135$git_perms.="r"if($mode&4);3136$git_perms.="w"if($mode&2);3137$git_perms.="x"if($mode&1);3138$git_perms="rw"if($git_permseq"");31393140if($changeeq"D")3141{3142#$log->debug("DELETE $name");3143$head->{$name} = {3144 name =>$name,3145 revision =>$head->{$name}{revision} +1,3146 filehash =>"deleted",3147 commithash =>$commit->{hash},3148 modified =>$commit->{date},3149 author =>$commit->{author},3150 mode =>$git_perms,3151};3152$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3153}3154elsif($changeeq"M"||$changeeq"T")3155{3156#$log->debug("MODIFIED $name");3157$head->{$name} = {3158 name =>$name,3159 revision =>$head->{$name}{revision} +1,3160 filehash =>$hash,3161 commithash =>$commit->{hash},3162 modified =>$commit->{date},3163 author =>$commit->{author},3164 mode =>$git_perms,3165};3166$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3167}3168elsif($changeeq"A")3169{3170#$log->debug("ADDED $name");3171$head->{$name} = {3172 name =>$name,3173 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3174 filehash =>$hash,3175 commithash =>$commit->{hash},3176 modified =>$commit->{date},3177 author =>$commit->{author},3178 mode =>$git_perms,3179};3180$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3181}3182else3183{3184$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");3185die;3186}3187}3188close FILELIST;3189}else{3190# this is used to detect files removed from the repo3191my$seen_files= {};31923193my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");3194local$/="\0";3195while( <FILELIST> )3196{3197chomp;3198unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)3199{3200die("Couldn't process git-ls-tree line :$_");3201}32023203my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);32043205$seen_files->{$git_filename} =1;32063207my($oldhash,$oldrevision,$oldmode) = (3208$head->{$git_filename}{filehash},3209$head->{$git_filename}{revision},3210$head->{$git_filename}{mode}3211);32123213if($git_perms=~/^\d\d\d(\d)\d\d/o)3214{3215$git_perms="";3216$git_perms.="r"if($1&4);3217$git_perms.="w"if($1&2);3218$git_perms.="x"if($1&1);3219}else{3220$git_perms="rw";3221}32223223# unless the file exists with the same hash, we need to update it ...3224unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)3225{3226my$newrevision= ($oldrevisionor0) +1;32273228$head->{$git_filename} = {3229 name =>$git_filename,3230 revision =>$newrevision,3231 filehash =>$git_hash,3232 commithash =>$commit->{hash},3233 modified =>$commit->{date},3234 author =>$commit->{author},3235 mode =>$git_perms,3236};323732383239$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);3240}3241}3242close FILELIST;32433244# Detect deleted files3245foreachmy$file(keys%$head)3246{3247unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")3248{3249$head->{$file}{revision}++;3250$head->{$file}{filehash} ="deleted";3251$head->{$file}{commithash} =$commit->{hash};3252$head->{$file}{modified} =$commit->{date};3253$head->{$file}{author} =$commit->{author};32543255$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});3256}3257}3258# END : "Detect deleted files"3259}326032613262if(exists$commit->{mergemsg})3263{3264$self->insert_mergelog($commit->{hash},$commit->{mergemsg});3265}32663267$lastpicked=$commit->{hash};32683269$self->_set_prop("last_commit",$commit->{hash});3270}32713272$self->delete_head();3273foreachmy$file(keys%$head)3274{3275$self->insert_head(3276$file,3277$head->{$file}{revision},3278$head->{$file}{filehash},3279$head->{$file}{commithash},3280$head->{$file}{modified},3281$head->{$file}{author},3282$head->{$file}{mode},3283);3284}3285# invalidate the gethead cache3286$self->{gethead_cache} =undef;328732883289# Ending exclusive lock here3290$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3291}32923293sub insert_rev3294{3295my$self=shift;3296my$name=shift;3297my$revision=shift;3298my$filehash=shift;3299my$commithash=shift;3300my$modified=shift;3301my$author=shift;3302my$mode=shift;3303my$tablename=$self->tablename("revision");33043305my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3306$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3307}33083309sub insert_mergelog3310{3311my$self=shift;3312my$key=shift;3313my$value=shift;3314my$tablename=$self->tablename("commitmsgs");33153316my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3317$insert_mergelog->execute($key,$value);3318}33193320sub delete_head3321{3322my$self=shift;3323my$tablename=$self->tablename("head");33243325my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3326$delete_head->execute();3327}33283329sub insert_head3330{3331my$self=shift;3332my$name=shift;3333my$revision=shift;3334my$filehash=shift;3335my$commithash=shift;3336my$modified=shift;3337my$author=shift;3338my$mode=shift;3339my$tablename=$self->tablename("head");33403341my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3342$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3343}33443345sub _headrev3346{3347my$self=shift;3348my$filename=shift;3349my$tablename=$self->tablename("head");33503351my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM$tablenameWHERE name=?",{},1);3352$db_query->execute($filename);3353my($hash,$revision,$mode) =$db_query->fetchrow_array;33543355return($hash,$revision,$mode);3356}33573358sub _get_prop3359{3360my$self=shift;3361my$key=shift;3362my$tablename=$self->tablename("properties");33633364my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3365$db_query->execute($key);3366my($value) =$db_query->fetchrow_array;33673368return$value;3369}33703371sub _set_prop3372{3373my$self=shift;3374my$key=shift;3375my$value=shift;3376my$tablename=$self->tablename("properties");33773378my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3379$db_query->execute($value,$key);33803381unless($db_query->rows)3382{3383$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3384$db_query->execute($key,$value);3385}33863387return$value;3388}33893390=head2 gethead33913392=cut33933394sub gethead3395{3396my$self=shift;3397my$tablename=$self->tablename("head");33983399return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );34003401my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3402$db_query->execute();34033404my$tree= [];3405while(my$file=$db_query->fetchrow_hashref)3406{3407push@$tree,$file;3408}34093410$self->{gethead_cache} =$tree;34113412return$tree;3413}34143415=head2 getlog34163417=cut34183419sub getlog3420{3421my$self=shift;3422my$filename=shift;3423my$tablename=$self->tablename("revision");34243425my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3426$db_query->execute($filename);34273428my$tree= [];3429while(my$file=$db_query->fetchrow_hashref)3430{3431push@$tree,$file;3432}34333434return$tree;3435}34363437=head2 getmeta34383439This function takes a filename (with path) argument and returns a hashref of3440metadata for that file.34413442=cut34433444sub getmeta3445{3446my$self=shift;3447my$filename=shift;3448my$revision=shift;3449my$tablename_rev=$self->tablename("revision");3450my$tablename_head=$self->tablename("head");34513452my$db_query;3453if(defined($revision)and$revision=~/^\d+$/)3454{3455$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND revision=?",{},1);3456$db_query->execute($filename,$revision);3457}3458elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)3459{3460$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND commithash=?",{},1);3461$db_query->execute($filename,$revision);3462}else{3463$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_headWHERE name=?",{},1);3464$db_query->execute($filename);3465}34663467return$db_query->fetchrow_hashref;3468}34693470=head2 commitmessage34713472this function takes a commithash and returns the commit message for that commit34733474=cut3475sub commitmessage3476{3477my$self=shift;3478my$commithash=shift;3479my$tablename=$self->tablename("commitmsgs");34803481die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);34823483my$db_query;3484$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3485$db_query->execute($commithash);34863487my($message) =$db_query->fetchrow_array;34883489if(defined($message) )3490{3491$message.=" "if($message=~/\n$/);3492return$message;3493}34943495my@lines= safe_pipe_capture("git","cat-file","commit",$commithash);3496shift@lineswhile($lines[0] =~/\S/);3497$message=join("",@lines);3498$message.=" "if($message=~/\n$/);3499return$message;3500}35013502=head2 gethistory35033504This function takes a filename (with path) argument and returns an arrayofarrays3505containing revision,filehash,commithash ordered by revision descending35063507=cut3508sub gethistory3509{3510my$self=shift;3511my$filename=shift;3512my$tablename=$self->tablename("revision");35133514my$db_query;3515$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3516$db_query->execute($filename);35173518return$db_query->fetchall_arrayref;3519}35203521=head2 gethistorydense35223523This function takes a filename (with path) argument and returns an arrayofarrays3524containing revision,filehash,commithash ordered by revision descending.35253526This version of gethistory skips deleted entries -- so it is useful for annotate.3527The 'dense' part is a reference to a '--dense' option available for git-rev-list3528and other git tools that depend on it.35293530=cut3531sub gethistorydense3532{3533my$self=shift;3534my$filename=shift;3535my$tablename=$self->tablename("revision");35363537my$db_query;3538$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);3539$db_query->execute($filename);35403541return$db_query->fetchall_arrayref;3542}35433544=head2 in_array()35453546from Array::PAT - mimics the in_array() function3547found in PHP. Yuck but works for small arrays.35483549=cut3550sub in_array3551{3552my($check,@array) =@_;3553my$retval=0;3554foreachmy$test(@array){3555if($checkeq$test){3556$retval=1;3557}3558}3559return$retval;3560}35613562=head2 safe_pipe_capture35633564an alternative to `command` that allows input to be passed as an array3565to work around shell problems with weird characters in arguments35663567=cut3568sub safe_pipe_capture {35693570my@output;35713572if(my$pid=open my$child,'-|') {3573@output= (<$child>);3574close$childor die join(' ',@_).":$!$?";3575}else{3576exec(@_)or die"$!$?";# exec() can fail the executable can't be found3577}3578returnwantarray?@output:join('',@output);3579}35803581=head2 mangle_dirname35823583create a string from a directory name that is suitable to use as3584part of a filename, mainly by converting all chars except \w.- to _35853586=cut3587sub mangle_dirname {3588my$dirname=shift;3589return unlessdefined$dirname;35903591$dirname=~s/[^\w.-]/_/g;35923593return$dirname;3594}35953596=head2 mangle_tablename35973598create a string from a that is suitable to use as part of an SQL table3599name, mainly by converting all chars except \w to _36003601=cut3602sub mangle_tablename {3603my$tablename=shift;3604return unlessdefined$tablename;36053606$tablename=~s/[^\w_]/_/g;36073608return$tablename;3609}361036111;