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::Basename; 25use Getopt::Long qw(:config require_order no_ignore_case); 26 27my$VERSION='@@GIT_VERSION@@'; 28 29my$log= GITCVS::log->new(); 30my$cfg; 31 32my$DATE_LIST= { 33 Jan =>"01", 34 Feb =>"02", 35 Mar =>"03", 36 Apr =>"04", 37 May =>"05", 38 Jun =>"06", 39 Jul =>"07", 40 Aug =>"08", 41 Sep =>"09", 42 Oct =>"10", 43 Nov =>"11", 44 Dec =>"12", 45}; 46 47# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 48$| =1; 49 50#### Definition and mappings of functions #### 51 52my$methods= { 53'Root'=> \&req_Root, 54'Valid-responses'=> \&req_Validresponses, 55'valid-requests'=> \&req_validrequests, 56'Directory'=> \&req_Directory, 57'Entry'=> \&req_Entry, 58'Modified'=> \&req_Modified, 59'Unchanged'=> \&req_Unchanged, 60'Questionable'=> \&req_Questionable, 61'Argument'=> \&req_Argument, 62'Argumentx'=> \&req_Argument, 63'expand-modules'=> \&req_expandmodules, 64'add'=> \&req_add, 65'remove'=> \&req_remove, 66'co'=> \&req_co, 67'update'=> \&req_update, 68'ci'=> \&req_ci, 69'diff'=> \&req_diff, 70'log'=> \&req_log, 71'rlog'=> \&req_log, 72'tag'=> \&req_CATCHALL, 73'status'=> \&req_status, 74'admin'=> \&req_CATCHALL, 75'history'=> \&req_CATCHALL, 76'watchers'=> \&req_CATCHALL, 77'editors'=> \&req_CATCHALL, 78'annotate'=> \&req_annotate, 79'Global_option'=> \&req_Globaloption, 80#'annotate' => \&req_CATCHALL, 81}; 82 83############################################## 84 85 86# $state holds all the bits of information the clients sends us that could 87# potentially be useful when it comes to actually _doing_ something. 88my$state= { prependdir =>''}; 89$log->info("--------------- STARTING -----------------"); 90 91my$usage= 92"Usage: git-cvsserver [options] [pserver|server] [<directory> ...]\n". 93" --base-path <path> : Prepend to requested CVSROOT\n". 94" --strict-paths : Don't allow recursing into subdirectories\n". 95" --export-all : Don't check for gitcvs.enabled in config\n". 96" --version, -V : Print version information and exit\n". 97" --help, -h, -H : Print usage information and exit\n". 98"\n". 99"<directory> ... is a list of allowed directories. If no directories\n". 100"are given, all are allowed. This is an additional restriction, gitcvs\n". 101"access still needs to be enabled by the gitcvs.enabled config option.\n"; 102 103my@opts= ('help|h|H','version|V', 104'base-path=s','strict-paths','export-all'); 105GetOptions($state,@opts) 106or die$usage; 107 108if($state->{version}) { 109print"git-cvsserver version$VERSION\n"; 110exit; 111} 112if($state->{help}) { 113print$usage; 114exit; 115} 116 117my$TEMP_DIR= tempdir( CLEANUP =>1); 118$log->debug("Temporary directory is '$TEMP_DIR'"); 119 120$state->{method} ='ext'; 121if(@ARGV) { 122if($ARGV[0]eq'pserver') { 123$state->{method} ='pserver'; 124shift@ARGV; 125}elsif($ARGV[0]eq'server') { 126shift@ARGV; 127} 128} 129 130# everything else is a directory 131$state->{allowed_roots} = [@ARGV]; 132 133# don't export the whole system unless the users requests it 134if($state->{'export-all'} && !@{$state->{allowed_roots}}) { 135die"--export-all can only be used together with an explicit whitelist\n"; 136} 137 138# if we are called with a pserver argument, 139# deal with the authentication cat before entering the 140# main loop 141if($state->{method}eq'pserver') { 142my$line= <STDIN>;chomp$line; 143unless($line=~/^BEGIN (AUTH|VERIFICATION) REQUEST$/) { 144die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 145} 146my$request=$1; 147$line= <STDIN>;chomp$line; 148 req_Root('root',$line)# reuse Root 149or die"E Invalid root$line\n"; 150$line= <STDIN>;chomp$line; 151unless($lineeq'anonymous') { 152print"E Only anonymous user allowed via pserver\n"; 153print"I HATE YOU\n"; 154exit1; 155} 156$line= <STDIN>;chomp$line;# validate the password? 157$line= <STDIN>;chomp$line; 158unless($lineeq"END$requestREQUEST") { 159die"E Do not understand$line-- expecting END$requestREQUEST\n"; 160} 161print"I LOVE YOU\n"; 162exit if$requesteq'VERIFICATION';# cvs login 163# and now back to our regular programme... 164} 165 166# Keep going until the client closes the connection 167while(<STDIN>) 168{ 169chomp; 170 171# Check to see if we've seen this method, and call appropriate function. 172if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 173{ 174# use the $methods hash to call the appropriate sub for this command 175#$log->info("Method : $1"); 176&{$methods->{$1}}($1,$2); 177}else{ 178# log fatal because we don't understand this function. If this happens 179# we're fairly screwed because we don't know if the client is expecting 180# a response. If it is, the client will hang, we'll hang, and the whole 181# thing will be custard. 182$log->fatal("Don't understand command$_\n"); 183die("Unknown command$_"); 184} 185} 186 187$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 188$log->info("--------------- FINISH -----------------"); 189 190# Magic catchall method. 191# This is the method that will handle all commands we haven't yet 192# implemented. It simply sends a warning to the log file indicating a 193# command that hasn't been implemented has been invoked. 194sub req_CATCHALL 195{ 196my($cmd,$data) =@_; 197$log->warn("Unhandled command : req_$cmd:$data"); 198} 199 200 201# Root pathname \n 202# Response expected: no. Tell the server which CVSROOT to use. Note that 203# pathname is a local directory and not a fully qualified CVSROOT variable. 204# pathname must already exist; if creating a new root, use the init 205# request, not Root. pathname does not include the hostname of the server, 206# how to access the server, etc.; by the time the CVS protocol is in use, 207# connection, authentication, etc., are already taken care of. The Root 208# request must be sent only once, and it must be sent before any requests 209# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 210sub req_Root 211{ 212my($cmd,$data) =@_; 213$log->debug("req_Root :$data"); 214 215unless($data=~ m#^/#) { 216print"error 1 Root must be an absolute pathname\n"; 217return0; 218} 219 220my$cvsroot=$state->{'base-path'} ||''; 221$cvsroot=~ s#/+$##; 222$cvsroot.=$data; 223 224if($state->{CVSROOT} 225&& ($state->{CVSROOT}ne$cvsroot)) { 226print"error 1 Conflicting roots specified\n"; 227return0; 228} 229 230$state->{CVSROOT} =$cvsroot; 231 232$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 233 234if(@{$state->{allowed_roots}}) { 235my$allowed=0; 236foreachmy$dir(@{$state->{allowed_roots}}) { 237next unless$dir=~ m#^/#; 238$dir=~ s#/+$##; 239if($state->{'strict-paths'}) { 240if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 241$allowed=1; 242last; 243} 244}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 245$allowed=1; 246last; 247} 248} 249 250unless($allowed) { 251print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 252print"E\n"; 253print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 254return0; 255} 256} 257 258unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 259print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 260print"E\n"; 261print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 262return0; 263} 264 265my@gitvars=`git-config -l`; 266if($?) { 267print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 268print"E\n"; 269print"error 1 - problem executing git-config\n"; 270return0; 271} 272foreachmy$line(@gitvars) 273{ 274next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 275unless($2) { 276$cfg->{$1}{$3} =$4; 277}else{ 278$cfg->{$1}{$2}{$3} =$4; 279} 280} 281 282my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 283||$cfg->{gitcvs}{enabled}); 284unless($state->{'export-all'} || 285($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 286print"E GITCVS emulation needs to be enabled on this repo\n"; 287print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 288print"E\n"; 289print"error 1 GITCVS emulation disabled\n"; 290return0; 291} 292 293my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 294if($logfile) 295{ 296$log->setfile($logfile); 297}else{ 298$log->nofile(); 299} 300 301return1; 302} 303 304# Global_option option \n 305# Response expected: no. Transmit one of the global options `-q', `-Q', 306# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 307# variations (such as combining of options) are allowed. For graceful 308# handling of valid-requests, it is probably better to make new global 309# options separate requests, rather than trying to add them to this 310# request. 311sub req_Globaloption 312{ 313my($cmd,$data) =@_; 314$log->debug("req_Globaloption :$data"); 315$state->{globaloptions}{$data} =1; 316} 317 318# Valid-responses request-list \n 319# Response expected: no. Tell the server what responses the client will 320# accept. request-list is a space separated list of tokens. 321sub req_Validresponses 322{ 323my($cmd,$data) =@_; 324$log->debug("req_Validresponses :$data"); 325 326# TODO : re-enable this, currently it's not particularly useful 327#$state->{validresponses} = [ split /\s+/, $data ]; 328} 329 330# valid-requests \n 331# Response expected: yes. Ask the server to send back a Valid-requests 332# response. 333sub req_validrequests 334{ 335my($cmd,$data) =@_; 336 337$log->debug("req_validrequests"); 338 339$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 340$log->debug("SEND : ok"); 341 342print"Valid-requests ".join(" ",keys%$methods) ."\n"; 343print"ok\n"; 344} 345 346# Directory local-directory \n 347# Additional data: repository \n. Response expected: no. Tell the server 348# what directory to use. The repository should be a directory name from a 349# previous server response. Note that this both gives a default for Entry 350# and Modified and also for ci and the other commands; normal usage is to 351# send Directory for each directory in which there will be an Entry or 352# Modified, and then a final Directory for the original directory, then the 353# command. The local-directory is relative to the top level at which the 354# command is occurring (i.e. the last Directory which is sent before the 355# command); to indicate that top level, `.' should be sent for 356# local-directory. 357sub req_Directory 358{ 359my($cmd,$data) =@_; 360 361my$repository= <STDIN>; 362chomp$repository; 363 364 365$state->{localdir} =$data; 366$state->{repository} =$repository; 367$state->{path} =$repository; 368$state->{path} =~s/^$state->{CVSROOT}\///; 369$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 370$state->{path} .="/"if($state->{path} =~ /\S/ ); 371 372$state->{directory} =$state->{localdir}; 373$state->{directory} =""if($state->{directory}eq"."); 374$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 375 376if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 377{ 378$log->info("Setting prepend to '$state->{path}'"); 379$state->{prependdir} =$state->{path}; 380foreachmy$entry(keys%{$state->{entries}} ) 381{ 382$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 383delete$state->{entries}{$entry}; 384} 385} 386 387if(defined($state->{prependdir} ) ) 388{ 389$log->debug("Prepending '$state->{prependdir}' to state|directory"); 390$state->{directory} =$state->{prependdir} .$state->{directory} 391} 392$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 393} 394 395# Entry entry-line \n 396# Response expected: no. Tell the server what version of a file is on the 397# local machine. The name in entry-line is a name relative to the directory 398# most recently specified with Directory. If the user is operating on only 399# some files in a directory, Entry requests for only those files need be 400# included. If an Entry request is sent without Modified, Is-modified, or 401# Unchanged, it means the file is lost (does not exist in the working 402# directory). If both Entry and one of Modified, Is-modified, or Unchanged 403# are sent for the same file, Entry must be sent first. For a given file, 404# one can send Modified, Is-modified, or Unchanged, but not more than one 405# of these three. 406sub req_Entry 407{ 408my($cmd,$data) =@_; 409 410#$log->debug("req_Entry : $data"); 411 412my@data=split(/\//,$data); 413 414$state->{entries}{$state->{directory}.$data[1]} = { 415 revision =>$data[2], 416 conflict =>$data[3], 417 options =>$data[4], 418 tag_or_date =>$data[5], 419}; 420 421$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 422} 423 424# Questionable filename \n 425# Response expected: no. Additional data: no. Tell the server to check 426# whether filename should be ignored, and if not, next time the server 427# sends responses, send (in a M response) `?' followed by the directory and 428# filename. filename must not contain `/'; it needs to be a file in the 429# directory named by the most recent Directory request. 430sub req_Questionable 431{ 432my($cmd,$data) =@_; 433 434$log->debug("req_Questionable :$data"); 435$state->{entries}{$state->{directory}.$data}{questionable} =1; 436} 437 438# add \n 439# Response expected: yes. Add a file or directory. This uses any previous 440# Argument, Directory, Entry, or Modified requests, if they have been sent. 441# The last Directory sent specifies the working directory at the time of 442# the operation. To add a directory, send the directory to be added using 443# Directory and Argument requests. 444sub req_add 445{ 446my($cmd,$data) =@_; 447 448 argsplit("add"); 449 450my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 451$updater->update(); 452 453 argsfromdir($updater); 454 455my$addcount=0; 456 457foreachmy$filename( @{$state->{args}} ) 458{ 459$filename= filecleanup($filename); 460 461my$meta=$updater->getmeta($filename); 462my$wrev= revparse($filename); 463 464if($wrev&&$meta&& ($wrev<0)) 465{ 466# previously removed file, add back 467$log->info("added file$filenamewas previously removed, send 1.$meta->{revision}"); 468 469print"MT +updated\n"; 470print"MT text U\n"; 471print"MT fname$filename\n"; 472print"MT newline\n"; 473print"MT -updated\n"; 474 475unless($state->{globaloptions}{-n} ) 476{ 477my($filepart,$dirpart) = filenamesplit($filename,1); 478 479print"Created$dirpart\n"; 480print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 481 482# this is an "entries" line 483my$kopts= kopts_from_path($filepart); 484$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 485print"/$filepart/1.$meta->{revision}//$kopts/\n"; 486# permissions 487$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 488print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 489# transmit file 490 transmitfile($meta->{filehash}); 491} 492 493next; 494} 495 496unless(defined($state->{entries}{$filename}{modified_filename} ) ) 497{ 498print"E cvs add: nothing known about `$filename'\n"; 499next; 500} 501# TODO : check we're not squashing an already existing file 502if(defined($state->{entries}{$filename}{revision} ) ) 503{ 504print"E cvs add: `$filename' has already been entered\n"; 505next; 506} 507 508my($filepart,$dirpart) = filenamesplit($filename,1); 509 510print"E cvs add: scheduling file `$filename' for addition\n"; 511 512print"Checked-in$dirpart\n"; 513print"$filename\n"; 514my$kopts= kopts_from_path($filepart); 515print"/$filepart/0//$kopts/\n"; 516 517$addcount++; 518} 519 520if($addcount==1) 521{ 522print"E cvs add: use `cvs commit' to add this file permanently\n"; 523} 524elsif($addcount>1) 525{ 526print"E cvs add: use `cvs commit' to add these files permanently\n"; 527} 528 529print"ok\n"; 530} 531 532# remove \n 533# Response expected: yes. Remove a file. This uses any previous Argument, 534# Directory, Entry, or Modified requests, if they have been sent. The last 535# Directory sent specifies the working directory at the time of the 536# operation. Note that this request does not actually do anything to the 537# repository; the only effect of a successful remove request is to supply 538# the client with a new entries line containing `-' to indicate a removed 539# file. In fact, the client probably could perform this operation without 540# contacting the server, although using remove may cause the server to 541# perform a few more checks. The client sends a subsequent ci request to 542# actually record the removal in the repository. 543sub req_remove 544{ 545my($cmd,$data) =@_; 546 547 argsplit("remove"); 548 549# Grab a handle to the SQLite db and do any necessary updates 550my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 551$updater->update(); 552 553#$log->debug("add state : " . Dumper($state)); 554 555my$rmcount=0; 556 557foreachmy$filename( @{$state->{args}} ) 558{ 559$filename= filecleanup($filename); 560 561if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 562{ 563print"E cvs remove: file `$filename' still in working directory\n"; 564next; 565} 566 567my$meta=$updater->getmeta($filename); 568my$wrev= revparse($filename); 569 570unless(defined($wrev) ) 571{ 572print"E cvs remove: nothing known about `$filename'\n"; 573next; 574} 575 576if(defined($wrev)and$wrev<0) 577{ 578print"E cvs remove: file `$filename' already scheduled for removal\n"; 579next; 580} 581 582unless($wrev==$meta->{revision} ) 583{ 584# TODO : not sure if the format of this message is quite correct. 585print"E cvs remove: Up to date check failed for `$filename'\n"; 586next; 587} 588 589 590my($filepart,$dirpart) = filenamesplit($filename,1); 591 592print"E cvs remove: scheduling `$filename' for removal\n"; 593 594print"Checked-in$dirpart\n"; 595print"$filename\n"; 596my$kopts= kopts_from_path($filepart); 597print"/$filepart/-1.$wrev//$kopts/\n"; 598 599$rmcount++; 600} 601 602if($rmcount==1) 603{ 604print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 605} 606elsif($rmcount>1) 607{ 608print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 609} 610 611print"ok\n"; 612} 613 614# Modified filename \n 615# Response expected: no. Additional data: mode, \n, file transmission. Send 616# the server a copy of one locally modified file. filename is a file within 617# the most recent directory sent with Directory; it must not contain `/'. 618# If the user is operating on only some files in a directory, only those 619# files need to be included. This can also be sent without Entry, if there 620# is no entry for the file. 621sub req_Modified 622{ 623my($cmd,$data) =@_; 624 625my$mode= <STDIN>; 626chomp$mode; 627my$size= <STDIN>; 628chomp$size; 629 630# Grab config information 631my$blocksize=8192; 632my$bytesleft=$size; 633my$tmp; 634 635# Get a filehandle/name to write it to 636my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 637 638# Loop over file data writing out to temporary file. 639while($bytesleft) 640{ 641$blocksize=$bytesleftif($bytesleft<$blocksize); 642read STDIN,$tmp,$blocksize; 643print$fh $tmp; 644$bytesleft-=$blocksize; 645} 646 647close$fh; 648 649# Ensure we have something sensible for the file mode 650if($mode=~/u=(\w+)/) 651{ 652$mode=$1; 653}else{ 654$mode="rw"; 655} 656 657# Save the file data in $state 658$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 659$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 660$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 661$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 662 663 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 664} 665 666# Unchanged filename\n 667# Response expected: no. Tell the server that filename has not been 668# modified in the checked out directory. The filename is a file within the 669# most recent directory sent with Directory; it must not contain `/'. 670sub req_Unchanged 671{ 672 my ($cmd,$data) =@_; 673 674$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 675 676 #$log->debug("req_Unchanged :$data"); 677} 678 679# Argument text\n 680# Response expected: no. Save argument for use in a subsequent command. 681# Arguments accumulate until an argument-using command is given, at which 682# point they are forgotten. 683# Argumentx text\n 684# Response expected: no. Append\nfollowed by text to the current argument 685# being saved. 686sub req_Argument 687{ 688 my ($cmd,$data) =@_; 689 690 # Argumentx means: append to last Argument (with a newline in front) 691 692$log->debug("$cmd:$data"); 693 694 if ($cmdeq 'Argumentx') { 695 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 696 } else { 697 push @{$state->{arguments}},$data; 698 } 699} 700 701# expand-modules\n 702# Response expected: yes. Expand the modules which are specified in the 703# arguments. Returns the data in Module-expansion responses. Note that the 704# server can assume that this is checkout or export, not rtag or rdiff; the 705# latter do not access the working directory and thus have no need to 706# expand modules on the client side. Expand may not be the best word for 707# what this request does. It does not necessarily tell you all the files 708# contained in a module, for example. Basically it is a way of telling you 709# which working directories the server needs to know about in order to 710# handle a checkout of the specified modules. For example, suppose that the 711# server has a module defined by 712# aliasmodule -a 1dir 713# That is, one can check out aliasmodule and it will take 1dir in the 714# repository and check it out to 1dir in the working directory. Now suppose 715# the client already has this module checked out and is planning on using 716# the co request to update it. Without using expand-modules, the client 717# would have two bad choices: it could either send information about all 718# working directories under the current directory, which could be 719# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 720# stands for 1dir, and neglect to send information for 1dir, which would 721# lead to incorrect operation. With expand-modules, the client would first 722# ask for the module to be expanded: 723sub req_expandmodules 724{ 725 my ($cmd,$data) =@_; 726 727 argsplit(); 728 729$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 730 731 unless ( ref$state->{arguments} eq "ARRAY" ) 732 { 733 print "ok\n"; 734 return; 735 } 736 737 foreach my$module( @{$state->{arguments}} ) 738 { 739$log->debug("SEND : Module-expansion$module"); 740 print "Module-expansion$module\n"; 741 } 742 743 print "ok\n"; 744 statecleanup(); 745} 746 747# co\n 748# Response expected: yes. Get files from the repository. This uses any 749# previous Argument, Directory, Entry, or Modified requests, if they have 750# been sent. Arguments to this command are module names; the client cannot 751# know what directories they correspond to except by (1) just sending the 752# co request, and then seeing what directory names the server sends back in 753# its responses, and (2) the expand-modules request. 754sub req_co 755{ 756 my ($cmd,$data) =@_; 757 758 argsplit("co"); 759 760 my$module=$state->{args}[0]; 761 my$checkout_path=$module; 762 763 # use the user specified directory if we're given it 764$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 765 766$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 767 768$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 769 770$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 771 772# Grab a handle to the SQLite db and do any necessary updates 773my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 774$updater->update(); 775 776$checkout_path=~ s|/$||;# get rid of trailing slashes 777 778# Eclipse seems to need the Clear-sticky command 779# to prepare the 'Entries' file for the new directory. 780print"Clear-sticky$checkout_path/\n"; 781print$state->{CVSROOT} ."/$module/\n"; 782print"Clear-static-directory$checkout_path/\n"; 783print$state->{CVSROOT} ."/$module/\n"; 784print"Clear-sticky$checkout_path/\n";# yes, twice 785print$state->{CVSROOT} ."/$module/\n"; 786print"Template$checkout_path/\n"; 787print$state->{CVSROOT} ."/$module/\n"; 788print"0\n"; 789 790# instruct the client that we're checking out to $checkout_path 791print"E cvs checkout: Updating$checkout_path\n"; 792 793my%seendirs= (); 794my$lastdir=''; 795 796# recursive 797sub prepdir { 798my($dir,$repodir,$remotedir,$seendirs) =@_; 799my$parent= dirname($dir); 800$dir=~ s|/+$||; 801$repodir=~ s|/+$||; 802$remotedir=~ s|/+$||; 803$parent=~ s|/+$||; 804$log->debug("announcedir$dir,$repodir,$remotedir"); 805 806if($parenteq'.'||$parenteq'./') { 807$parent=''; 808} 809# recurse to announce unseen parents first 810if(length($parent) && !exists($seendirs->{$parent})) { 811 prepdir($parent,$repodir,$remotedir,$seendirs); 812} 813# Announce that we are going to modify at the parent level 814if($parent) { 815print"E cvs checkout: Updating$remotedir/$parent\n"; 816}else{ 817print"E cvs checkout: Updating$remotedir\n"; 818} 819print"Clear-sticky$remotedir/$parent/\n"; 820print"$repodir/$parent/\n"; 821 822print"Clear-static-directory$remotedir/$dir/\n"; 823print"$repodir/$dir/\n"; 824print"Clear-sticky$remotedir/$parent/\n";# yes, twice 825print"$repodir/$parent/\n"; 826print"Template$remotedir/$dir/\n"; 827print"$repodir/$dir/\n"; 828print"0\n"; 829 830$seendirs->{$dir} =1; 831} 832 833foreachmy$git( @{$updater->gethead} ) 834{ 835# Don't want to check out deleted files 836next if($git->{filehash}eq"deleted"); 837 838($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 839 840if(length($git->{dir}) &&$git->{dir}ne'./' 841&&$git->{dir}ne$lastdir) { 842unless(exists($seendirs{$git->{dir}})) { 843 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 844$checkout_path, \%seendirs); 845$lastdir=$git->{dir}; 846$seendirs{$git->{dir}} =1; 847} 848print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 849} 850 851# modification time of this file 852print"Mod-time$git->{modified}\n"; 853 854# print some information to the client 855if(defined($git->{dir} )and$git->{dir}ne"./") 856{ 857print"M U$checkout_path/$git->{dir}$git->{name}\n"; 858}else{ 859print"M U$checkout_path/$git->{name}\n"; 860} 861 862# instruct client we're sending a file to put in this path 863print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 864 865print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 866 867# this is an "entries" line 868my$kopts= kopts_from_path($git->{name}); 869print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 870# permissions 871print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 872 873# transmit file 874 transmitfile($git->{filehash}); 875} 876 877print"ok\n"; 878 879 statecleanup(); 880} 881 882# update \n 883# Response expected: yes. Actually do a cvs update command. This uses any 884# previous Argument, Directory, Entry, or Modified requests, if they have 885# been sent. The last Directory sent specifies the working directory at the 886# time of the operation. The -I option is not used--files which the client 887# can decide whether to ignore are not mentioned and the client sends the 888# Questionable request for others. 889sub req_update 890{ 891my($cmd,$data) =@_; 892 893$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 894 895 argsplit("update"); 896 897# 898# It may just be a client exploring the available heads/modules 899# in that case, list them as top level directories and leave it 900# at that. Eclipse uses this technique to offer you a list of 901# projects (heads in this case) to checkout. 902# 903if($state->{module}eq'') { 904print"E cvs update: Updating .\n"; 905opendir HEADS,$state->{CVSROOT} .'/refs/heads'; 906while(my$head=readdir(HEADS)) { 907if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 908print"E cvs update: New directory `$head'\n"; 909} 910} 911closedir HEADS; 912print"ok\n"; 913return1; 914} 915 916 917# Grab a handle to the SQLite db and do any necessary updates 918my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 919 920$updater->update(); 921 922 argsfromdir($updater); 923 924#$log->debug("update state : " . Dumper($state)); 925 926# foreach file specified on the command line ... 927foreachmy$filename( @{$state->{args}} ) 928{ 929$filename= filecleanup($filename); 930 931$log->debug("Processing file$filename"); 932 933# if we have a -C we should pretend we never saw modified stuff 934if(exists($state->{opt}{C} ) ) 935{ 936delete$state->{entries}{$filename}{modified_hash}; 937delete$state->{entries}{$filename}{modified_filename}; 938$state->{entries}{$filename}{unchanged} =1; 939} 940 941my$meta; 942if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 943{ 944$meta=$updater->getmeta($filename,$1); 945}else{ 946$meta=$updater->getmeta($filename); 947} 948 949if( !defined$meta) 950{ 951$meta= { 952 name =>$filename, 953 revision =>0, 954 filehash =>'added' 955}; 956} 957 958my$oldmeta=$meta; 959 960my$wrev= revparse($filename); 961 962# If the working copy is an old revision, lets get that version too for comparison. 963if(defined($wrev)and$wrev!=$meta->{revision} ) 964{ 965$oldmeta=$updater->getmeta($filename,$wrev); 966} 967 968#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 969 970# Files are up to date if the working copy and repo copy have the same revision, 971# and the working copy is unmodified _and_ the user hasn't specified -C 972next if(defined($wrev) 973and defined($meta->{revision}) 974and$wrev==$meta->{revision} 975and$state->{entries}{$filename}{unchanged} 976and not exists($state->{opt}{C} ) ); 977 978# If the working copy and repo copy have the same revision, 979# but the working copy is modified, tell the client it's modified 980if(defined($wrev) 981and defined($meta->{revision}) 982and$wrev==$meta->{revision} 983and defined($state->{entries}{$filename}{modified_hash}) 984and not exists($state->{opt}{C} ) ) 985{ 986$log->info("Tell the client the file is modified"); 987print"MT text M\n"; 988print"MT fname$filename\n"; 989print"MT newline\n"; 990next; 991} 992 993if($meta->{filehash}eq"deleted") 994{ 995my($filepart,$dirpart) = filenamesplit($filename,1); 996 997$log->info("Removing '$filename' from working copy (no longer in the repo)"); 998 999print"E cvs update: `$filename' is no longer in the repository\n";1000# Don't want to actually _DO_ the update if -n specified1001unless($state->{globaloptions}{-n} ) {1002print"Removed$dirpart\n";1003print"$filepart\n";1004}1005}1006elsif(not defined($state->{entries}{$filename}{modified_hash} )1007or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1008or$meta->{filehash}eq'added')1009{1010# normal update, just send the new revision (either U=Update,1011# or A=Add, or R=Remove)1012if(defined($wrev) &&$wrev<0)1013{1014$log->info("Tell the client the file is scheduled for removal");1015print"MT text R\n";1016print"MT fname$filename\n";1017print"MT newline\n";1018next;1019}1020elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) )1021{1022$log->info("Tell the client the file is scheduled for addition");1023print"MT text A\n";1024print"MT fname$filename\n";1025print"MT newline\n";1026next;10271028}1029else{1030$log->info("Updating '$filename' to ".$meta->{revision});1031print"MT +updated\n";1032print"MT text U\n";1033print"MT fname$filename\n";1034print"MT newline\n";1035print"MT -updated\n";1036}10371038my($filepart,$dirpart) = filenamesplit($filename,1);10391040# Don't want to actually _DO_ the update if -n specified1041unless($state->{globaloptions}{-n} )1042{1043if(defined($wrev) )1044{1045# instruct client we're sending a file to put in this path as a replacement1046print"Update-existing$dirpart\n";1047$log->debug("Updating existing file 'Update-existing$dirpart'");1048}else{1049# instruct client we're sending a file to put in this path as a new file1050print"Clear-static-directory$dirpart\n";1051print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1052print"Clear-sticky$dirpart\n";1053print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";10541055$log->debug("Creating new file 'Created$dirpart'");1056print"Created$dirpart\n";1057}1058print$state->{CVSROOT} ."/$state->{module}/$filename\n";10591060# this is an "entries" line1061my$kopts= kopts_from_path($filepart);1062$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1063print"/$filepart/1.$meta->{revision}//$kopts/\n";10641065# permissions1066$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1067print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";10681069# transmit file1070 transmitfile($meta->{filehash});1071}1072}else{1073$log->info("Updating '$filename'");1074my($filepart,$dirpart) = filenamesplit($meta->{name},1);10751076my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/";10771078chdir$dir;1079my$file_local=$filepart.".mine";1080system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1081my$file_old=$filepart.".".$oldmeta->{revision};1082 transmitfile($oldmeta->{filehash},$file_old);1083my$file_new=$filepart.".".$meta->{revision};1084 transmitfile($meta->{filehash},$file_new);10851086# we need to merge with the local changes ( M=successful merge, C=conflict merge )1087$log->info("Merging$file_local,$file_old,$file_new");1088print"M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into$filename\n";10891090$log->debug("Temporary directory for merge is$dir");10911092my$return=system("git","merge-file",$file_local,$file_old,$file_new);1093$return>>=8;10941095if($return==0)1096{1097$log->info("Merged successfully");1098print"M M$filename\n";1099$log->debug("Merged$dirpart");11001101# Don't want to actually _DO_ the update if -n specified1102unless($state->{globaloptions}{-n} )1103{1104print"Merged$dirpart\n";1105$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1106print$state->{CVSROOT} ."/$state->{module}/$filename\n";1107my$kopts= kopts_from_path($filepart);1108$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1109print"/$filepart/1.$meta->{revision}//$kopts/\n";1110}1111}1112elsif($return==1)1113{1114$log->info("Merged with conflicts");1115print"E cvs update: conflicts found in$filename\n";1116print"M C$filename\n";11171118# Don't want to actually _DO_ the update if -n specified1119unless($state->{globaloptions}{-n} )1120{1121print"Merged$dirpart\n";1122print$state->{CVSROOT} ."/$state->{module}/$filename\n";1123my$kopts= kopts_from_path($filepart);1124print"/$filepart/1.$meta->{revision}/+/$kopts/\n";1125}1126}1127else1128{1129$log->warn("Merge failed");1130next;1131}11321133# Don't want to actually _DO_ the update if -n specified1134unless($state->{globaloptions}{-n} )1135{1136# permissions1137$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1138print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";11391140# transmit file, format is single integer on a line by itself (file1141# size) followed by the file contents1142# TODO : we should copy files in blocks1143my$data=`cat$file_local`;1144$log->debug("File size : " . length($data));1145 print length($data) . "\n";1146 print$data;1147 }11481149 chdir "/";1150 }11511152 }11531154 print "ok\n";1155}11561157sub req_ci1158{1159 my ($cmd,$data) =@_;11601161 argsplit("ci");11621163 #$log->debug("State : " . Dumper($state));11641165$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));11661167 if ($state->{method} eq 'pserver')1168 {1169 print "error 1 pserver access cannot commit\n";1170 exit;1171 }11721173 if ( -e$state->{CVSROOT} . "/index" )1174 {1175$log->warn("file 'index' already exists in the git repository");1176 print "error 1 Index already exists in git repo\n";1177 exit;1178 }11791180 # Grab a handle to the SQLite db and do any necessary updates1181 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1182$updater->update();11831184 my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1185 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 );1186$log->info("Lockless commit start, basing commit on '$tmpdir', index file is '$file_index'");11871188$ENV{GIT_DIR} =$state->{CVSROOT} . "/";1189$ENV{GIT_INDEX_FILE} =$file_index;11901191 # Remember where the head was at the beginning.1192 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1193 chomp$parenthash;1194 if ($parenthash!~ /^[0-9a-f]{40}$/) {1195 print "error 1 pserver cannot find the current HEAD of module";1196 exit;1197 }11981199 chdir$tmpdir;12001201 # populate the temporary index based1202 system("git-read-tree",$parenthash);1203 unless ($?== 0)1204 {1205 die "Error running git-read-tree$state->{module}$file_index$!";1206 }1207$log->info("Created index '$file_index' with for head$state->{module} - exit status$?");12081209 my@committedfiles= ();1210 my%oldmeta;12111212 # foreach file specified on the command line ...1213 foreach my$filename( @{$state->{args}} )1214 {1215 my$committedfile=$filename;1216$filename= filecleanup($filename);12171218 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );12191220 my$meta=$updater->getmeta($filename);1221$oldmeta{$filename} =$meta;12221223 my$wrev= revparse($filename);12241225 my ($filepart,$dirpart) = filenamesplit($filename);12261227 # do a checkout of the file if it part of this tree1228 if ($wrev) {1229 system('git-checkout-index', '-f', '-u',$filename);1230 unless ($?== 0) {1231 die "Error running git-checkout-index -f -u$filename:$!";1232 }1233 }12341235 my$addflag= 0;1236 my$rmflag= 0;1237$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1238$addflag= 1 unless ( -e$filename);12391240 # Do up to date checking1241 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1242 {1243 # fail everything if an up to date check fails1244 print "error 1 Up to date check failed for$filename\n";1245 chdir "/";1246 exit;1247 }12481249 push@committedfiles,$committedfile;1250$log->info("Committing$filename");12511252 system("mkdir","-p",$dirpart) unless ( -d$dirpart);12531254 unless ($rmflag)1255 {1256$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1257 rename$state->{entries}{$filename}{modified_filename},$filename;12581259 # Calculate modes to remove1260 my$invmode= "";1261 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }12621263$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1264 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1265 }12661267 if ($rmflag)1268 {1269$log->info("Removing file '$filename'");1270 unlink($filename);1271 system("git-update-index", "--remove",$filename);1272 }1273 elsif ($addflag)1274 {1275$log->info("Adding file '$filename'");1276 system("git-update-index", "--add",$filename);1277 } else {1278$log->info("Updating file '$filename'");1279 system("git-update-index",$filename);1280 }1281 }12821283 unless ( scalar(@committedfiles) > 0 )1284 {1285 print "E No files to commit\n";1286 print "ok\n";1287 chdir "/";1288 return;1289 }12901291 my$treehash= `git-write-tree`;1292 chomp$treehash;12931294$log->debug("Treehash :$treehash, Parenthash :$parenthash");12951296 # write our commit message out if we have one ...1297 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1298 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1299 print$msg_fh"\n\nvia git-CVS emulator\n";1300 close$msg_fh;13011302 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;1303chomp($commithash);1304$log->info("Commit hash :$commithash");13051306unless($commithash=~/[a-zA-Z0-9]{40}/)1307{1308$log->warn("Commit failed (Invalid commit hash)");1309print"error 1 Commit failed (unknown reason)\n";1310chdir"/";1311exit;1312}13131314# Check that this is allowed, just as we would with a receive-pack1315my@cmd= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1316$parenthash,$commithash);1317if( -x $cmd[0] ) {1318unless(system(@cmd) ==0)1319{1320$log->warn("Commit failed (update hook declined to update ref)");1321print"error 1 Commit failed (update hook declined)\n";1322chdir"/";1323exit;1324}1325}13261327if(system(qw(git update-ref -m),"cvsserver ci",1328"refs/heads/$state->{module}",$commithash,$parenthash)) {1329$log->warn("update-ref for$state->{module} failed.");1330print"error 1 Cannot commit -- update first\n";1331exit;1332}13331334$updater->update();13351336# foreach file specified on the command line ...1337foreachmy$filename(@committedfiles)1338{1339$filename= filecleanup($filename);13401341my$meta=$updater->getmeta($filename);1342unless(defined$meta->{revision}) {1343$meta->{revision} =1;1344}13451346my($filepart,$dirpart) = filenamesplit($filename,1);13471348$log->debug("Checked-in$dirpart:$filename");13491350print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1351if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1352{1353print"M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";1354print"Remove-entry$dirpart\n";1355print"$filename\n";1356}else{1357if($meta->{revision} ==1) {1358print"M initial revision: 1.1\n";1359}else{1360print"M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";1361}1362print"Checked-in$dirpart\n";1363print"$filename\n";1364my$kopts= kopts_from_path($filepart);1365print"/$filepart/1.$meta->{revision}//$kopts/\n";1366}1367}13681369chdir"/";1370print"ok\n";1371}13721373sub req_status1374{1375my($cmd,$data) =@_;13761377 argsplit("status");13781379$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1380#$log->debug("status state : " . Dumper($state));13811382# Grab a handle to the SQLite db and do any necessary updates1383my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1384$updater->update();13851386# if no files were specified, we need to work out what files we should be providing status on ...1387 argsfromdir($updater);13881389# foreach file specified on the command line ...1390foreachmy$filename( @{$state->{args}} )1391{1392$filename= filecleanup($filename);13931394my$meta=$updater->getmeta($filename);1395my$oldmeta=$meta;13961397my$wrev= revparse($filename);13981399# If the working copy is an old revision, lets get that version too for comparison.1400if(defined($wrev)and$wrev!=$meta->{revision} )1401{1402$oldmeta=$updater->getmeta($filename,$wrev);1403}14041405# TODO : All possible statuses aren't yet implemented1406my$status;1407# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1408$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1409and1410( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1411or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1412);14131414# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1415$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1416and1417($state->{entries}{$filename}{unchanged}1418or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1419);14201421# Need checkout if it exists in the repo but doesn't have a working copy1422$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );14231424# Locally modified if working copy and repo copy have the same revision but there are local changes1425$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );14261427# Needs Merge if working copy revision is less than repo copy and there are local changes1428$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );14291430$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1431$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1432$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1433$status||="File had conflicts on merge"if(0);14341435$status||="Unknown";14361437print"M ===================================================================\n";1438print"M File:$filename\tStatus:$status\n";1439if(defined($state->{entries}{$filename}{revision}) )1440{1441print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1442}else{1443print"M Working revision:\tNo entry for$filename\n";1444}1445if(defined($meta->{revision}) )1446{1447print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1448print"M Sticky Tag:\t\t(none)\n";1449print"M Sticky Date:\t\t(none)\n";1450print"M Sticky Options:\t\t(none)\n";1451}else{1452print"M Repository revision:\tNo revision control file\n";1453}1454print"M\n";1455}14561457print"ok\n";1458}14591460sub req_diff1461{1462my($cmd,$data) =@_;14631464 argsplit("diff");14651466$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1467#$log->debug("status state : " . Dumper($state));14681469my($revision1,$revision2);1470if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1471{1472$revision1=$state->{opt}{r}[0];1473$revision2=$state->{opt}{r}[1];1474}else{1475$revision1=$state->{opt}{r};1476}14771478$revision1=~s/^1\.//if(defined($revision1) );1479$revision2=~s/^1\.//if(defined($revision2) );14801481$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );14821483# Grab a handle to the SQLite db and do any necessary updates1484my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1485$updater->update();14861487# if no files were specified, we need to work out what files we should be providing status on ...1488 argsfromdir($updater);14891490# foreach file specified on the command line ...1491foreachmy$filename( @{$state->{args}} )1492{1493$filename= filecleanup($filename);14941495my($fh,$file1,$file2,$meta1,$meta2,$filediff);14961497my$wrev= revparse($filename);14981499# We need _something_ to diff against1500next unless(defined($wrev) );15011502# if we have a -r switch, use it1503if(defined($revision1) )1504{1505(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1506$meta1=$updater->getmeta($filename,$revision1);1507unless(defined($meta1)and$meta1->{filehash}ne"deleted")1508{1509print"E File$filenameat revision 1.$revision1doesn't exist\n";1510next;1511}1512 transmitfile($meta1->{filehash},$file1);1513}1514# otherwise we just use the working copy revision1515else1516{1517(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1518$meta1=$updater->getmeta($filename,$wrev);1519 transmitfile($meta1->{filehash},$file1);1520}15211522# if we have a second -r switch, use it too1523if(defined($revision2) )1524{1525(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1526$meta2=$updater->getmeta($filename,$revision2);15271528unless(defined($meta2)and$meta2->{filehash}ne"deleted")1529{1530print"E File$filenameat revision 1.$revision2doesn't exist\n";1531next;1532}15331534 transmitfile($meta2->{filehash},$file2);1535}1536# otherwise we just use the working copy1537else1538{1539$file2=$state->{entries}{$filename}{modified_filename};1540}15411542# if we have been given -r, and we don't have a $file2 yet, lets get one1543if(defined($revision1)and not defined($file2) )1544{1545(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1546$meta2=$updater->getmeta($filename,$wrev);1547 transmitfile($meta2->{filehash},$file2);1548}15491550# We need to have retrieved something useful1551next unless(defined($meta1) );15521553# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1554next if(not defined($meta2)and$wrev==$meta1->{revision}1555and1556( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1557or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1558);15591560# Apparently we only show diffs for locally modified files1561next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );15621563print"M Index:$filename\n";1564print"M ===================================================================\n";1565print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1566print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1567print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1568print"M diff ";1569foreachmy$opt(keys%{$state->{opt}} )1570{1571if(ref$state->{opt}{$opt}eq"ARRAY")1572{1573foreachmy$value( @{$state->{opt}{$opt}} )1574{1575print"-$opt$value";1576}1577}else{1578print"-$opt";1579print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1580}1581}1582print"$filename\n";15831584$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));15851586($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);15871588if(exists$state->{opt}{u} )1589{1590system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1591}else{1592system("diff$file1$file2>$filediff");1593}15941595while( <$fh> )1596{1597print"M$_";1598}1599close$fh;1600}16011602print"ok\n";1603}16041605sub req_log1606{1607my($cmd,$data) =@_;16081609 argsplit("log");16101611$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1612#$log->debug("log state : " . Dumper($state));16131614my($minrev,$maxrev);1615if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1616{1617my$control=$2;1618$minrev=$1;1619$maxrev=$3;1620$minrev=~s/^1\.//if(defined($minrev) );1621$maxrev=~s/^1\.//if(defined($maxrev) );1622$minrev++if(defined($minrev)and$controleq"::");1623}16241625# Grab a handle to the SQLite db and do any necessary updates1626my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1627$updater->update();16281629# if no files were specified, we need to work out what files we should be providing status on ...1630 argsfromdir($updater);16311632# foreach file specified on the command line ...1633foreachmy$filename( @{$state->{args}} )1634{1635$filename= filecleanup($filename);16361637my$headmeta=$updater->getmeta($filename);16381639my$revisions=$updater->getlog($filename);1640my$totalrevisions=scalar(@$revisions);16411642if(defined($minrev) )1643{1644$log->debug("Removing revisions less than$minrev");1645while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1646{1647pop@$revisions;1648}1649}1650if(defined($maxrev) )1651{1652$log->debug("Removing revisions greater than$maxrev");1653while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1654{1655shift@$revisions;1656}1657}16581659next unless(scalar(@$revisions) );16601661print"M\n";1662print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1663print"M Working file:$filename\n";1664print"M head: 1.$headmeta->{revision}\n";1665print"M branch:\n";1666print"M locks: strict\n";1667print"M access list:\n";1668print"M symbolic names:\n";1669print"M keyword substitution: kv\n";1670print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1671print"M description:\n";16721673foreachmy$revision(@$revisions)1674{1675print"M ----------------------------\n";1676print"M revision 1.$revision->{revision}\n";1677# reformat the date for log output1678$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}) );1679$revision->{author} =~s/\s+.*//;1680$revision->{author} =~s/^(.{8}).*/$1/;1681print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1682my$commitmessage=$updater->commitmessage($revision->{commithash});1683$commitmessage=~s/^/M /mg;1684print$commitmessage."\n";1685}1686print"M =============================================================================\n";1687}16881689print"ok\n";1690}16911692sub req_annotate1693{1694my($cmd,$data) =@_;16951696 argsplit("annotate");16971698$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1699#$log->debug("status state : " . Dumper($state));17001701# Grab a handle to the SQLite db and do any necessary updates1702my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1703$updater->update();17041705# if no files were specified, we need to work out what files we should be providing annotate on ...1706 argsfromdir($updater);17071708# we'll need a temporary checkout dir1709my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1710my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1711$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");17121713$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1714$ENV{GIT_INDEX_FILE} =$file_index;17151716chdir$tmpdir;17171718# foreach file specified on the command line ...1719foreachmy$filename( @{$state->{args}} )1720{1721$filename= filecleanup($filename);17221723my$meta=$updater->getmeta($filename);17241725next unless($meta->{revision} );17261727# get all the commits that this file was in1728# in dense format -- aka skip dead revisions1729my$revisions=$updater->gethistorydense($filename);1730my$lastseenin=$revisions->[0][2];17311732# populate the temporary index based on the latest commit were we saw1733# the file -- but do it cheaply without checking out any files1734# TODO: if we got a revision from the client, use that instead1735# to look up the commithash in sqlite (still good to default to1736# the current head as we do now)1737system("git-read-tree",$lastseenin);1738unless($?==0)1739{1740die"Error running git-read-tree$lastseenin$file_index$!";1741}1742$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");17431744# do a checkout of the file1745system('git-checkout-index','-f','-u',$filename);1746unless($?==0) {1747die"Error running git-checkout-index -f -u$filename:$!";1748}17491750$log->info("Annotate$filename");17511752# Prepare a file with the commits from the linearized1753# history that annotate should know about. This prevents1754# git-jsannotate telling us about commits we are hiding1755# from the client.17561757open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1758for(my$i=0;$i<@$revisions;$i++)1759{1760print ANNOTATEHINTS $revisions->[$i][2];1761if($i+1<@$revisions) {# have we got a parent?1762print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1763}1764print ANNOTATEHINTS "\n";1765}17661767print ANNOTATEHINTS "\n";1768close ANNOTATEHINTS;17691770my$annotatecmd='git-annotate';1771open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1772or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1773my$metadata= {};1774print"E Annotations for$filename\n";1775print"E ***************\n";1776while( <ANNOTATE> )1777{1778if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1779{1780my$commithash=$1;1781my$data=$2;1782unless(defined($metadata->{$commithash} ) )1783{1784$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1785$metadata->{$commithash}{author} =~s/\s+.*//;1786$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1787$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1788}1789printf("M 1.%-5d (%-8s%10s):%s\n",1790$metadata->{$commithash}{revision},1791$metadata->{$commithash}{author},1792$metadata->{$commithash}{modified},1793$data1794);1795}else{1796$log->warn("Error in annotate output! LINE:$_");1797print"E Annotate error\n";1798next;1799}1800}1801close ANNOTATE;1802}18031804# done; get out of the tempdir1805chdir"/";18061807print"ok\n";18081809}18101811# This method takes the state->{arguments} array and produces two new arrays.1812# The first is $state->{args} which is everything before the '--' argument, and1813# the second is $state->{files} which is everything after it.1814sub argsplit1815{1816return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");18171818my$type=shift;18191820$state->{args} = [];1821$state->{files} = [];1822$state->{opt} = {};18231824if(defined($type) )1825{1826my$opt= {};1827$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");1828$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1829$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");1830$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1831$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1832$opt= { k =>1, m =>1}if($typeeq"add");1833$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1834$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");183518361837while(scalar( @{$state->{arguments}} ) >0)1838{1839my$arg=shift@{$state->{arguments}};18401841next if($argeq"--");1842next unless($arg=~/\S/);18431844# if the argument looks like a switch1845if($arg=~/^-(\w)(.*)/)1846{1847# if it's a switch that takes an argument1848if($opt->{$1} )1849{1850# If this switch has already been provided1851if($opt->{$1} >1and exists($state->{opt}{$1} ) )1852{1853$state->{opt}{$1} = [$state->{opt}{$1} ];1854if(length($2) >0)1855{1856push@{$state->{opt}{$1}},$2;1857}else{1858push@{$state->{opt}{$1}},shift@{$state->{arguments}};1859}1860}else{1861# if there's extra data in the arg, use that as the argument for the switch1862if(length($2) >0)1863{1864$state->{opt}{$1} =$2;1865}else{1866$state->{opt}{$1} =shift@{$state->{arguments}};1867}1868}1869}else{1870$state->{opt}{$1} =undef;1871}1872}1873else1874{1875push@{$state->{args}},$arg;1876}1877}1878}1879else1880{1881my$mode=0;18821883foreachmy$value( @{$state->{arguments}} )1884{1885if($valueeq"--")1886{1887$mode++;1888next;1889}1890push@{$state->{args}},$valueif($mode==0);1891push@{$state->{files}},$valueif($mode==1);1892}1893}1894}18951896# This method uses $state->{directory} to populate $state->{args} with a list of filenames1897sub argsfromdir1898{1899my$updater=shift;19001901$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");19021903return if(scalar( @{$state->{args}} ) >1);19041905my@gethead= @{$updater->gethead};19061907# push added files1908foreachmy$file(keys%{$state->{entries}}) {1909if(exists$state->{entries}{$file}{revision} &&1910$state->{entries}{$file}{revision} ==0)1911{1912push@gethead, { name =>$file, filehash =>'added'};1913}1914}19151916if(scalar(@{$state->{args}}) ==1)1917{1918my$arg=$state->{args}[0];1919$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );19201921$log->info("Only one arg specified, checking for directory expansion on '$arg'");19221923foreachmy$file(@gethead)1924{1925next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1926next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);1927push@{$state->{args}},$file->{name};1928}19291930shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);1931}else{1932$log->info("Only one arg specified, populating file list automatically");19331934$state->{args} = [];19351936foreachmy$file(@gethead)1937{1938next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1939next unless($file->{name} =~s/^$state->{prependdir}//);1940push@{$state->{args}},$file->{name};1941}1942}1943}19441945# This method cleans up the $state variable after a command that uses arguments has run1946sub statecleanup1947{1948$state->{files} = [];1949$state->{args} = [];1950$state->{arguments} = [];1951$state->{entries} = {};1952}19531954sub revparse1955{1956my$filename=shift;19571958returnundefunless(defined($state->{entries}{$filename}{revision} ) );19591960return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1961return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);19621963returnundef;1964}19651966# This method takes a file hash and does a CVS "file transfer" which transmits the1967# size of the file, and then the file contents.1968# If a second argument $targetfile is given, the file is instead written out to1969# a file by the name of $targetfile1970sub transmitfile1971{1972my$filehash=shift;1973my$targetfile=shift;19741975if(defined($filehash)and$filehasheq"deleted")1976{1977$log->warn("filehash is 'deleted'");1978return;1979}19801981die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);19821983my$type=`git-cat-file -t$filehash`;1984 chomp$type;19851986 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );19871988 my$size= `git-cat-file -s $filehash`;1989chomp$size;19901991$log->debug("transmitfile($filehash) size=$size, type=$type");19921993if(open my$fh,'-|',"git-cat-file","blob",$filehash)1994{1995if(defined($targetfile) )1996{1997open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1998print NEWFILE $_while( <$fh> );1999close NEWFILE;2000}else{2001print"$size\n";2002printwhile( <$fh> );2003}2004close$fhor die("Couldn't close filehandle for transmitfile()");2005}else{2006die("Couldn't execute git-cat-file");2007}2008}20092010# This method takes a file name, and returns ( $dirpart, $filepart ) which2011# refers to the directory portion and the file portion of the filename2012# respectively2013sub filenamesplit2014{2015my$filename=shift;2016my$fixforlocaldir=shift;20172018my($filepart,$dirpart) = ($filename,".");2019($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2020$dirpart.="/";20212022if($fixforlocaldir)2023{2024$dirpart=~s/^$state->{prependdir}//;2025}20262027return($filepart,$dirpart);2028}20292030sub filecleanup2031{2032my$filename=shift;20332034returnundefunless(defined($filename));2035if($filename=~/^\// )2036{2037print"E absolute filenames '$filename' not supported by server\n";2038returnundef;2039}20402041$filename=~s/^\.\///g;2042$filename=$state->{prependdir} .$filename;2043return$filename;2044}20452046# Given a path, this function returns a string containing the kopts2047# that should go into that path's Entries line. For example, a binary2048# file should get -kb.2049sub kopts_from_path2050{2051my($path) =@_;20522053# Once it exists, the git attributes system should be used to look up2054# what attributes apply to this path.20552056# Until then, take the setting from the config file2057unless(defined($cfg->{gitcvs}{allbinary} )and$cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i)2058{2059# Return "" to give no special treatment to any path2060return"";2061}else{2062# Alternatively, to have all files treated as if they are binary (which2063# is more like git itself), always return the "-kb" option2064return"-kb";2065}2066}20672068package GITCVS::log;20692070####2071#### Copyright The Open University UK - 2006.2072####2073#### Authors: Martyn Smith <martyn@catalyst.net.nz>2074#### Martin Langhoff <martin@catalyst.net.nz>2075####2076####20772078use strict;2079use warnings;20802081=head1 NAME20822083GITCVS::log20842085=head1 DESCRIPTION20862087This module provides very crude logging with a similar interface to2088Log::Log4perl20892090=head1 METHODS20912092=cut20932094=head2 new20952096Creates a new log object, optionally you can specify a filename here to2097indicate the file to log to. If no log file is specified, you can specify one2098later with method setfile, or indicate you no longer want logging with method2099nofile.21002101Until one of these methods is called, all log calls will buffer messages ready2102to write out.21032104=cut2105sub new2106{2107my$class=shift;2108my$filename=shift;21092110my$self= {};21112112bless$self,$class;21132114if(defined($filename) )2115{2116open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2117}21182119return$self;2120}21212122=head2 setfile21232124This methods takes a filename, and attempts to open that file as the log file.2125If successful, all buffered data is written out to the file, and any further2126logging is written directly to the file.21272128=cut2129sub setfile2130{2131my$self=shift;2132my$filename=shift;21332134if(defined($filename) )2135{2136open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2137}21382139return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");21402141while(my$line=shift@{$self->{buffer}} )2142{2143print{$self->{fh}}$line;2144}2145}21462147=head2 nofile21482149This method indicates no logging is going to be used. It flushes any entries in2150the internal buffer, and sets a flag to ensure no further data is put there.21512152=cut2153sub nofile2154{2155my$self=shift;21562157$self->{nolog} =1;21582159return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");21602161$self->{buffer} = [];2162}21632164=head2 _logopen21652166Internal method. Returns true if the log file is open, false otherwise.21672168=cut2169sub _logopen2170{2171my$self=shift;21722173return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2174return0;2175}21762177=head2 debug info warn fatal21782179These four methods are wrappers to _log. They provide the actual interface for2180logging data.21812182=cut2183sub debug {my$self=shift;$self->_log("debug",@_); }2184sub info {my$self=shift;$self->_log("info",@_); }2185subwarn{my$self=shift;$self->_log("warn",@_); }2186sub fatal {my$self=shift;$self->_log("fatal",@_); }21872188=head2 _log21892190This is an internal method called by the logging functions. It generates a2191timestamp and pushes the logged line either to file, or internal buffer.21922193=cut2194sub _log2195{2196my$self=shift;2197my$level=shift;21982199return if($self->{nolog} );22002201my@time=localtime;2202my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2203$time[5] +1900,2204$time[4] +1,2205$time[3],2206$time[2],2207$time[1],2208$time[0],2209uc$level,2210);22112212if($self->_logopen)2213{2214print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2215}else{2216push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2217}2218}22192220=head2 DESTROY22212222This method simply closes the file handle if one is open22232224=cut2225sub DESTROY2226{2227my$self=shift;22282229if($self->_logopen)2230{2231close$self->{fh};2232}2233}22342235package GITCVS::updater;22362237####2238#### Copyright The Open University UK - 2006.2239####2240#### Authors: Martyn Smith <martyn@catalyst.net.nz>2241#### Martin Langhoff <martin@catalyst.net.nz>2242####2243####22442245use strict;2246use warnings;2247use DBI;22482249=head1 METHODS22502251=cut22522253=head2 new22542255=cut2256sub new2257{2258my$class=shift;2259my$config=shift;2260my$module=shift;2261my$log=shift;22622263die"Need to specify a git repository"unless(defined($config)and-d $config);2264die"Need to specify a module"unless(defined($module) );22652266$class=ref($class) ||$class;22672268my$self= {};22692270bless$self,$class;22712272$self->{module} =$module;2273$self->{git_path} =$config."/";22742275$self->{log} =$log;22762277die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );22782279$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2280$cfg->{gitcvs}{dbdriver} ||"SQLite";2281$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2282$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2283$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2284$cfg->{gitcvs}{dbuser} ||"";2285$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2286$cfg->{gitcvs}{dbpass} ||"";2287my%mapping= ( m =>$module,2288 a =>$state->{method},2289 u =>getlogin||getpwuid($<) || $<,2290 G =>$self->{git_path},2291 g => mangle_dirname($self->{git_path}),2292);2293$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2294$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;22952296die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2297die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2298$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2299$self->{dbuser},2300$self->{dbpass});2301die"Error connecting to database\n"unlessdefined$self->{dbh};23022303$self->{tables} = {};2304foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2305{2306$self->{tables}{$table} =1;2307}23082309# Construct the revision table if required2310unless($self->{tables}{revision} )2311{2312$self->{dbh}->do("2313 CREATE TABLE revision (2314 name TEXT NOT NULL,2315 revision INTEGER NOT NULL,2316 filehash TEXT NOT NULL,2317 commithash TEXT NOT NULL,2318 author TEXT NOT NULL,2319 modified TEXT NOT NULL,2320 mode TEXT NOT NULL2321 )2322 ");2323$self->{dbh}->do("2324 CREATE INDEX revision_ix12325 ON revision (name,revision)2326 ");2327$self->{dbh}->do("2328 CREATE INDEX revision_ix22329 ON revision (name,commithash)2330 ");2331}23322333# Construct the head table if required2334unless($self->{tables}{head} )2335{2336$self->{dbh}->do("2337 CREATE TABLE head (2338 name TEXT NOT NULL,2339 revision INTEGER NOT NULL,2340 filehash TEXT NOT NULL,2341 commithash TEXT NOT NULL,2342 author TEXT NOT NULL,2343 modified TEXT NOT NULL,2344 mode TEXT NOT NULL2345 )2346 ");2347$self->{dbh}->do("2348 CREATE INDEX head_ix12349 ON head (name)2350 ");2351}23522353# Construct the properties table if required2354unless($self->{tables}{properties} )2355{2356$self->{dbh}->do("2357 CREATE TABLE properties (2358 key TEXT NOT NULL PRIMARY KEY,2359 value TEXT2360 )2361 ");2362}23632364# Construct the commitmsgs table if required2365unless($self->{tables}{commitmsgs} )2366{2367$self->{dbh}->do("2368 CREATE TABLE commitmsgs (2369 key TEXT NOT NULL PRIMARY KEY,2370 value TEXT2371 )2372 ");2373}23742375return$self;2376}23772378=head2 update23792380=cut2381sub update2382{2383my$self=shift;23842385# first lets get the commit list2386$ENV{GIT_DIR} =$self->{git_path};23872388my$commitsha1=`git rev-parse$self->{module}`;2389chomp$commitsha1;23902391my$commitinfo=`git cat-file commit$self->{module} 2>&1`;2392unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2393{2394die("Invalid module '$self->{module}'");2395}239623972398my$git_log;2399my$lastcommit=$self->_get_prop("last_commit");24002401if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date2402return1;2403}24042405# Start exclusive lock here...2406$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";24072408# TODO: log processing is memory bound2409# if we can parse into a 2nd file that is in reverse order2410# we can probably do something really efficient2411my@git_log_params= ('--pretty','--parents','--topo-order');24122413if(defined$lastcommit) {2414push@git_log_params,"$lastcommit..$self->{module}";2415}else{2416push@git_log_params,$self->{module};2417}2418# git-rev-list is the backend / plumbing version of git-log2419open(GITLOG,'-|','git-rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";24202421my@commits;24222423my%commit= ();24242425while( <GITLOG> )2426{2427chomp;2428if(m/^commit\s+(.*)$/) {2429# on ^commit lines put the just seen commit in the stack2430# and prime things for the next one2431if(keys%commit) {2432my%copy=%commit;2433unshift@commits, \%copy;2434%commit= ();2435}2436my@parents=split(m/\s+/,$1);2437$commit{hash} =shift@parents;2438$commit{parents} = \@parents;2439}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2440# on rfc822-like lines seen before we see any message,2441# lowercase the entry and put it in the hash as key-value2442$commit{lc($1)} =$2;2443}else{2444# message lines - skip initial empty line2445# and trim whitespace2446if(!exists($commit{message}) &&m/^\s*$/) {2447# define it to mark the end of headers2448$commit{message} ='';2449next;2450}2451s/^\s+//;s/\s+$//;# trim ws2452$commit{message} .=$_."\n";2453}2454}2455close GITLOG;24562457unshift@commits, \%commitif(keys%commit);24582459# Now all the commits are in the @commits bucket2460# ordered by time DESC. for each commit that needs processing,2461# determine whether it's following the last head we've seen or if2462# it's on its own branch, grab a file list, and add whatever's changed2463# NOTE: $lastcommit refers to the last commit from previous run2464# $lastpicked is the last commit we picked in this run2465my$lastpicked;2466my$head= {};2467if(defined$lastcommit) {2468$lastpicked=$lastcommit;2469}24702471my$committotal=scalar(@commits);2472my$commitcount=0;24732474# Load the head table into $head (for cached lookups during the update process)2475foreachmy$file( @{$self->gethead()} )2476{2477$head->{$file->{name}} =$file;2478}24792480foreachmy$commit(@commits)2481{2482$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2483if(defined$lastpicked)2484{2485if(!in_array($lastpicked, @{$commit->{parents}}))2486{2487# skip, we'll see this delta2488# as part of a merge later2489# warn "skipping off-track $commit->{hash}\n";2490next;2491}elsif(@{$commit->{parents}} >1) {2492# it is a merge commit, for each parent that is2493# not $lastpicked, see if we can get a log2494# from the merge-base to that parent to put it2495# in the message as a merge summary.2496my@parents= @{$commit->{parents}};2497foreachmy$parent(@parents) {2498# git-merge-base can potentially (but rarely) throw2499# several candidate merge bases. let's assume2500# that the first one is the best one.2501if($parenteq$lastpicked) {2502next;2503}2504open my$p,'git-merge-base '.$lastpicked.' '2505.$parent.'|';2506my@output= (<$p>);2507close$p;2508my$base=join('',@output);2509chomp$base;2510if($base) {2511my@merged;2512# print "want to log between $base $parent \n";2513open(GITLOG,'-|','git-log',"$base..$parent")2514or die"Cannot call git-log:$!";2515my$mergedhash;2516while(<GITLOG>) {2517chomp;2518if(!defined$mergedhash) {2519if(m/^commit\s+(.+)$/) {2520$mergedhash=$1;2521}else{2522next;2523}2524}else{2525# grab the first line that looks non-rfc8222526# aka has content after leading space2527if(m/^\s+(\S.*)$/) {2528my$title=$1;2529$title=substr($title,0,100);# truncate2530unshift@merged,"$mergedhash$title";2531undef$mergedhash;2532}2533}2534}2535close GITLOG;2536if(@merged) {2537$commit->{mergemsg} =$commit->{message};2538$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2539foreachmy$summary(@merged) {2540$commit->{mergemsg} .="\t$summary\n";2541}2542$commit->{mergemsg} .="\n\n";2543# print "Message for $commit->{hash} \n$commit->{mergemsg}";2544}2545}2546}2547}2548}25492550# convert the date to CVS-happy format2551$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);25522553if(defined($lastpicked) )2554{2555my$filepipe=open(FILELIST,'-|','git-diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2556local($/) ="\0";2557while( <FILELIST> )2558{2559chomp;2560unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)2561{2562die("Couldn't process git-diff-tree line :$_");2563}2564my($mode,$hash,$change) = ($1,$2,$3);2565my$name= <FILELIST>;2566chomp($name);25672568# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");25692570my$git_perms="";2571$git_perms.="r"if($mode&4);2572$git_perms.="w"if($mode&2);2573$git_perms.="x"if($mode&1);2574$git_perms="rw"if($git_permseq"");25752576if($changeeq"D")2577{2578#$log->debug("DELETE $name");2579$head->{$name} = {2580 name =>$name,2581 revision =>$head->{$name}{revision} +1,2582 filehash =>"deleted",2583 commithash =>$commit->{hash},2584 modified =>$commit->{date},2585 author =>$commit->{author},2586 mode =>$git_perms,2587};2588$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2589}2590elsif($changeeq"M")2591{2592#$log->debug("MODIFIED $name");2593$head->{$name} = {2594 name =>$name,2595 revision =>$head->{$name}{revision} +1,2596 filehash =>$hash,2597 commithash =>$commit->{hash},2598 modified =>$commit->{date},2599 author =>$commit->{author},2600 mode =>$git_perms,2601};2602$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2603}2604elsif($changeeq"A")2605{2606#$log->debug("ADDED $name");2607$head->{$name} = {2608 name =>$name,2609 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,2610 filehash =>$hash,2611 commithash =>$commit->{hash},2612 modified =>$commit->{date},2613 author =>$commit->{author},2614 mode =>$git_perms,2615};2616$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2617}2618else2619{2620$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");2621die;2622}2623}2624close FILELIST;2625}else{2626# this is used to detect files removed from the repo2627my$seen_files= {};26282629my$filepipe=open(FILELIST,'-|','git-ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2630local$/="\0";2631while( <FILELIST> )2632{2633chomp;2634unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)2635{2636die("Couldn't process git-ls-tree line :$_");2637}26382639my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);26402641$seen_files->{$git_filename} =1;26422643my($oldhash,$oldrevision,$oldmode) = (2644$head->{$git_filename}{filehash},2645$head->{$git_filename}{revision},2646$head->{$git_filename}{mode}2647);26482649if($git_perms=~/^\d\d\d(\d)\d\d/o)2650{2651$git_perms="";2652$git_perms.="r"if($1&4);2653$git_perms.="w"if($1&2);2654$git_perms.="x"if($1&1);2655}else{2656$git_perms="rw";2657}26582659# unless the file exists with the same hash, we need to update it ...2660unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2661{2662my$newrevision= ($oldrevisionor0) +1;26632664$head->{$git_filename} = {2665 name =>$git_filename,2666 revision =>$newrevision,2667 filehash =>$git_hash,2668 commithash =>$commit->{hash},2669 modified =>$commit->{date},2670 author =>$commit->{author},2671 mode =>$git_perms,2672};267326742675$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2676}2677}2678close FILELIST;26792680# Detect deleted files2681foreachmy$file(keys%$head)2682{2683unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2684{2685$head->{$file}{revision}++;2686$head->{$file}{filehash} ="deleted";2687$head->{$file}{commithash} =$commit->{hash};2688$head->{$file}{modified} =$commit->{date};2689$head->{$file}{author} =$commit->{author};26902691$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2692}2693}2694# END : "Detect deleted files"2695}269626972698if(exists$commit->{mergemsg})2699{2700$self->insert_mergelog($commit->{hash},$commit->{mergemsg});2701}27022703$lastpicked=$commit->{hash};27042705$self->_set_prop("last_commit",$commit->{hash});2706}27072708$self->delete_head();2709foreachmy$file(keys%$head)2710{2711$self->insert_head(2712$file,2713$head->{$file}{revision},2714$head->{$file}{filehash},2715$head->{$file}{commithash},2716$head->{$file}{modified},2717$head->{$file}{author},2718$head->{$file}{mode},2719);2720}2721# invalidate the gethead cache2722$self->{gethead_cache} =undef;272327242725# Ending exclusive lock here2726$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2727}27282729sub insert_rev2730{2731my$self=shift;2732my$name=shift;2733my$revision=shift;2734my$filehash=shift;2735my$commithash=shift;2736my$modified=shift;2737my$author=shift;2738my$mode=shift;27392740my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2741$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);2742}27432744sub insert_mergelog2745{2746my$self=shift;2747my$key=shift;2748my$value=shift;27492750my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);2751$insert_mergelog->execute($key,$value);2752}27532754sub delete_head2755{2756my$self=shift;27572758my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);2759$delete_head->execute();2760}27612762sub insert_head2763{2764my$self=shift;2765my$name=shift;2766my$revision=shift;2767my$filehash=shift;2768my$commithash=shift;2769my$modified=shift;2770my$author=shift;2771my$mode=shift;27722773my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2774$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);2775}27762777sub _headrev2778{2779my$self=shift;2780my$filename=shift;27812782my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2783$db_query->execute($filename);2784my($hash,$revision,$mode) =$db_query->fetchrow_array;27852786return($hash,$revision,$mode);2787}27882789sub _get_prop2790{2791my$self=shift;2792my$key=shift;27932794my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2795$db_query->execute($key);2796my($value) =$db_query->fetchrow_array;27972798return$value;2799}28002801sub _set_prop2802{2803my$self=shift;2804my$key=shift;2805my$value=shift;28062807my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2808$db_query->execute($value,$key);28092810unless($db_query->rows)2811{2812$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2813$db_query->execute($key,$value);2814}28152816return$value;2817}28182819=head2 gethead28202821=cut28222823sub gethead2824{2825my$self=shift;28262827return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );28282829my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);2830$db_query->execute();28312832my$tree= [];2833while(my$file=$db_query->fetchrow_hashref)2834{2835push@$tree,$file;2836}28372838$self->{gethead_cache} =$tree;28392840return$tree;2841}28422843=head2 getlog28442845=cut28462847sub getlog2848{2849my$self=shift;2850my$filename=shift;28512852my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2853$db_query->execute($filename);28542855my$tree= [];2856while(my$file=$db_query->fetchrow_hashref)2857{2858push@$tree,$file;2859}28602861return$tree;2862}28632864=head2 getmeta28652866This function takes a filename (with path) argument and returns a hashref of2867metadata for that file.28682869=cut28702871sub getmeta2872{2873my$self=shift;2874my$filename=shift;2875my$revision=shift;28762877my$db_query;2878if(defined($revision)and$revision=~/^\d+$/)2879{2880$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2881$db_query->execute($filename,$revision);2882}2883elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2884{2885$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2886$db_query->execute($filename,$revision);2887}else{2888$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2889$db_query->execute($filename);2890}28912892return$db_query->fetchrow_hashref;2893}28942895=head2 commitmessage28962897this function takes a commithash and returns the commit message for that commit28982899=cut2900sub commitmessage2901{2902my$self=shift;2903my$commithash=shift;29042905die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);29062907my$db_query;2908$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2909$db_query->execute($commithash);29102911my($message) =$db_query->fetchrow_array;29122913if(defined($message) )2914{2915$message.=" "if($message=~/\n$/);2916return$message;2917}29182919my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2920shift@lineswhile($lines[0] =~/\S/);2921$message=join("",@lines);2922$message.=" "if($message=~/\n$/);2923return$message;2924}29252926=head2 gethistory29272928This function takes a filename (with path) argument and returns an arrayofarrays2929containing revision,filehash,commithash ordered by revision descending29302931=cut2932sub gethistory2933{2934my$self=shift;2935my$filename=shift;29362937my$db_query;2938$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2939$db_query->execute($filename);29402941return$db_query->fetchall_arrayref;2942}29432944=head2 gethistorydense29452946This function takes a filename (with path) argument and returns an arrayofarrays2947containing revision,filehash,commithash ordered by revision descending.29482949This version of gethistory skips deleted entries -- so it is useful for annotate.2950The 'dense' part is a reference to a '--dense' option available for git-rev-list2951and other git tools that depend on it.29522953=cut2954sub gethistorydense2955{2956my$self=shift;2957my$filename=shift;29582959my$db_query;2960$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2961$db_query->execute($filename);29622963return$db_query->fetchall_arrayref;2964}29652966=head2 in_array()29672968from Array::PAT - mimics the in_array() function2969found in PHP. Yuck but works for small arrays.29702971=cut2972sub in_array2973{2974my($check,@array) =@_;2975my$retval=0;2976foreachmy$test(@array){2977if($checkeq$test){2978$retval=1;2979}2980}2981return$retval;2982}29832984=head2 safe_pipe_capture29852986an alternative to `command` that allows input to be passed as an array2987to work around shell problems with weird characters in arguments29882989=cut2990sub safe_pipe_capture {29912992my@output;29932994if(my$pid=open my$child,'-|') {2995@output= (<$child>);2996close$childor die join(' ',@_).":$!$?";2997}else{2998exec(@_)or die"$!$?";# exec() can fail the executable can't be found2999}3000returnwantarray?@output:join('',@output);3001}30023003=head2 mangle_dirname30043005create a string from a directory name that is suitable to use as3006part of a filename, mainly by converting all chars except \w.- to _30073008=cut3009sub mangle_dirname {3010my$dirname=shift;3011return unlessdefined$dirname;30123013$dirname=~s/[^\w.-]/_/g;30143015return$dirname;3016}301730181;