1#!/usr/bin/perl 2 3#### 4#### This application is a CVS emulation layer for git. 5#### It is intended for clients to connect over SSH. 6#### See the documentation for more details. 7#### 8#### Copyright The Open University UK - 2006. 9#### 10#### Authors: Martyn Smith <martyn@catalyst.net.nz> 11#### Martin Langhoff <martin@catalyst.net.nz> 12#### 13#### 14#### Released under the GNU Public License, version 2. 15#### 16#### 17 18use strict; 19use warnings; 20use bytes; 21 22use Fcntl; 23use File::Temp qw/tempdir tempfile/; 24use File::Path qw/rmtree/; 25use File::Basename; 26use Getopt::Long qw(:config require_order no_ignore_case); 27 28my$VERSION='@@GIT_VERSION@@'; 29 30my$log= GITCVS::log->new(); 31my$cfg; 32 33my$DATE_LIST= { 34 Jan =>"01", 35 Feb =>"02", 36 Mar =>"03", 37 Apr =>"04", 38 May =>"05", 39 Jun =>"06", 40 Jul =>"07", 41 Aug =>"08", 42 Sep =>"09", 43 Oct =>"10", 44 Nov =>"11", 45 Dec =>"12", 46}; 47 48# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 49$| =1; 50 51#### Definition and mappings of functions #### 52 53my$methods= { 54'Root'=> \&req_Root, 55'Valid-responses'=> \&req_Validresponses, 56'valid-requests'=> \&req_validrequests, 57'Directory'=> \&req_Directory, 58'Entry'=> \&req_Entry, 59'Modified'=> \&req_Modified, 60'Unchanged'=> \&req_Unchanged, 61'Questionable'=> \&req_Questionable, 62'Argument'=> \&req_Argument, 63'Argumentx'=> \&req_Argument, 64'expand-modules'=> \&req_expandmodules, 65'add'=> \&req_add, 66'remove'=> \&req_remove, 67'co'=> \&req_co, 68'update'=> \&req_update, 69'ci'=> \&req_ci, 70'diff'=> \&req_diff, 71'log'=> \&req_log, 72'rlog'=> \&req_log, 73'tag'=> \&req_CATCHALL, 74'status'=> \&req_status, 75'admin'=> \&req_CATCHALL, 76'history'=> \&req_CATCHALL, 77'watchers'=> \&req_EMPTY, 78'editors'=> \&req_EMPTY, 79'annotate'=> \&req_annotate, 80'Global_option'=> \&req_Globaloption, 81#'annotate' => \&req_CATCHALL, 82}; 83 84############################################## 85 86 87# $state holds all the bits of information the clients sends us that could 88# potentially be useful when it comes to actually _doing_ something. 89my$state= { prependdir =>''}; 90 91# Work is for managing temporary working directory 92my$work= 93{ 94state=>undef,# undef, 1 (empty), 2 (with stuff) 95 workDir =>undef, 96index=>undef, 97 emptyDir =>undef, 98 tmpDir =>undef 99}; 100 101$log->info("--------------- STARTING -----------------"); 102 103my$usage= 104"Usage: git-cvsserver [options] [pserver|server] [<directory> ...]\n". 105" --base-path <path> : Prepend to requested CVSROOT\n". 106" --strict-paths : Don't allow recursing into subdirectories\n". 107" --export-all : Don't check for gitcvs.enabled in config\n". 108" --version, -V : Print version information and exit\n". 109" --help, -h, -H : Print usage information and exit\n". 110"\n". 111"<directory> ... is a list of allowed directories. If no directories\n". 112"are given, all are allowed. This is an additional restriction, gitcvs\n". 113"access still needs to be enabled by the gitcvs.enabled config option.\n"; 114 115my@opts= ('help|h|H','version|V', 116'base-path=s','strict-paths','export-all'); 117GetOptions($state,@opts) 118or die$usage; 119 120if($state->{version}) { 121print"git-cvsserver version$VERSION\n"; 122exit; 123} 124if($state->{help}) { 125print$usage; 126exit; 127} 128 129my$TEMP_DIR= tempdir( CLEANUP =>1); 130$log->debug("Temporary directory is '$TEMP_DIR'"); 131 132$state->{method} ='ext'; 133if(@ARGV) { 134if($ARGV[0]eq'pserver') { 135$state->{method} ='pserver'; 136shift@ARGV; 137}elsif($ARGV[0]eq'server') { 138shift@ARGV; 139} 140} 141 142# everything else is a directory 143$state->{allowed_roots} = [@ARGV]; 144 145# don't export the whole system unless the users requests it 146if($state->{'export-all'} && !@{$state->{allowed_roots}}) { 147die"--export-all can only be used together with an explicit whitelist\n"; 148} 149 150# if we are called with a pserver argument, 151# deal with the authentication cat before entering the 152# main loop 153if($state->{method}eq'pserver') { 154my$line= <STDIN>;chomp$line; 155unless($line=~/^BEGIN (AUTH|VERIFICATION) REQUEST$/) { 156die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 157} 158my$request=$1; 159$line= <STDIN>;chomp$line; 160unless(req_Root('root',$line)) {# reuse Root 161print"E Invalid root$line\n"; 162exit1; 163} 164$line= <STDIN>;chomp$line; 165unless($lineeq'anonymous') { 166print"E Only anonymous user allowed via pserver\n"; 167print"I HATE YOU\n"; 168exit1; 169} 170$line= <STDIN>;chomp$line;# validate the password? 171$line= <STDIN>;chomp$line; 172unless($lineeq"END$requestREQUEST") { 173die"E Do not understand$line-- expecting END$requestREQUEST\n"; 174} 175print"I LOVE YOU\n"; 176exit if$requesteq'VERIFICATION';# cvs login 177# and now back to our regular programme... 178} 179 180# Keep going until the client closes the connection 181while(<STDIN>) 182{ 183chomp; 184 185# Check to see if we've seen this method, and call appropriate function. 186if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 187{ 188# use the $methods hash to call the appropriate sub for this command 189#$log->info("Method : $1"); 190&{$methods->{$1}}($1,$2); 191}else{ 192# log fatal because we don't understand this function. If this happens 193# we're fairly screwed because we don't know if the client is expecting 194# a response. If it is, the client will hang, we'll hang, and the whole 195# thing will be custard. 196$log->fatal("Don't understand command$_\n"); 197die("Unknown command$_"); 198} 199} 200 201$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 202$log->info("--------------- FINISH -----------------"); 203 204chdir'/'; 205exit0; 206 207# Magic catchall method. 208# This is the method that will handle all commands we haven't yet 209# implemented. It simply sends a warning to the log file indicating a 210# command that hasn't been implemented has been invoked. 211sub req_CATCHALL 212{ 213my($cmd,$data) =@_; 214$log->warn("Unhandled command : req_$cmd:$data"); 215} 216 217# This method invariably succeeds with an empty response. 218sub req_EMPTY 219{ 220print"ok\n"; 221} 222 223# Root pathname \n 224# Response expected: no. Tell the server which CVSROOT to use. Note that 225# pathname is a local directory and not a fully qualified CVSROOT variable. 226# pathname must already exist; if creating a new root, use the init 227# request, not Root. pathname does not include the hostname of the server, 228# how to access the server, etc.; by the time the CVS protocol is in use, 229# connection, authentication, etc., are already taken care of. The Root 230# request must be sent only once, and it must be sent before any requests 231# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 232sub req_Root 233{ 234my($cmd,$data) =@_; 235$log->debug("req_Root :$data"); 236 237unless($data=~ m#^/#) { 238print"error 1 Root must be an absolute pathname\n"; 239return0; 240} 241 242my$cvsroot=$state->{'base-path'} ||''; 243$cvsroot=~ s#/+$##; 244$cvsroot.=$data; 245 246if($state->{CVSROOT} 247&& ($state->{CVSROOT}ne$cvsroot)) { 248print"error 1 Conflicting roots specified\n"; 249return0; 250} 251 252$state->{CVSROOT} =$cvsroot; 253 254$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 255 256if(@{$state->{allowed_roots}}) { 257my$allowed=0; 258foreachmy$dir(@{$state->{allowed_roots}}) { 259next unless$dir=~ m#^/#; 260$dir=~ s#/+$##; 261if($state->{'strict-paths'}) { 262if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 263$allowed=1; 264last; 265} 266}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 267$allowed=1; 268last; 269} 270} 271 272unless($allowed) { 273print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 274print"E\n"; 275print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 276return0; 277} 278} 279 280unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 281print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 282print"E\n"; 283print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 284return0; 285} 286 287my@gitvars=`git-config -l`; 288if($?) { 289print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 290print"E\n"; 291print"error 1 - problem executing git-config\n"; 292return0; 293} 294foreachmy$line(@gitvars) 295{ 296next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 297unless($2) { 298$cfg->{$1}{$3} =$4; 299}else{ 300$cfg->{$1}{$2}{$3} =$4; 301} 302} 303 304my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 305||$cfg->{gitcvs}{enabled}); 306unless($state->{'export-all'} || 307($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 308print"E GITCVS emulation needs to be enabled on this repo\n"; 309print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 310print"E\n"; 311print"error 1 GITCVS emulation disabled\n"; 312return0; 313} 314 315my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 316if($logfile) 317{ 318$log->setfile($logfile); 319}else{ 320$log->nofile(); 321} 322 323return1; 324} 325 326# Global_option option \n 327# Response expected: no. Transmit one of the global options `-q', `-Q', 328# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 329# variations (such as combining of options) are allowed. For graceful 330# handling of valid-requests, it is probably better to make new global 331# options separate requests, rather than trying to add them to this 332# request. 333sub req_Globaloption 334{ 335my($cmd,$data) =@_; 336$log->debug("req_Globaloption :$data"); 337$state->{globaloptions}{$data} =1; 338} 339 340# Valid-responses request-list \n 341# Response expected: no. Tell the server what responses the client will 342# accept. request-list is a space separated list of tokens. 343sub req_Validresponses 344{ 345my($cmd,$data) =@_; 346$log->debug("req_Validresponses :$data"); 347 348# TODO : re-enable this, currently it's not particularly useful 349#$state->{validresponses} = [ split /\s+/, $data ]; 350} 351 352# valid-requests \n 353# Response expected: yes. Ask the server to send back a Valid-requests 354# response. 355sub req_validrequests 356{ 357my($cmd,$data) =@_; 358 359$log->debug("req_validrequests"); 360 361$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 362$log->debug("SEND : ok"); 363 364print"Valid-requests ".join(" ",keys%$methods) ."\n"; 365print"ok\n"; 366} 367 368# Directory local-directory \n 369# Additional data: repository \n. Response expected: no. Tell the server 370# what directory to use. The repository should be a directory name from a 371# previous server response. Note that this both gives a default for Entry 372# and Modified and also for ci and the other commands; normal usage is to 373# send Directory for each directory in which there will be an Entry or 374# Modified, and then a final Directory for the original directory, then the 375# command. The local-directory is relative to the top level at which the 376# command is occurring (i.e. the last Directory which is sent before the 377# command); to indicate that top level, `.' should be sent for 378# local-directory. 379sub req_Directory 380{ 381my($cmd,$data) =@_; 382 383my$repository= <STDIN>; 384chomp$repository; 385 386 387$state->{localdir} =$data; 388$state->{repository} =$repository; 389$state->{path} =$repository; 390$state->{path} =~s/^$state->{CVSROOT}\///; 391$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 392$state->{path} .="/"if($state->{path} =~ /\S/ ); 393 394$state->{directory} =$state->{localdir}; 395$state->{directory} =""if($state->{directory}eq"."); 396$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 397 398if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 399{ 400$log->info("Setting prepend to '$state->{path}'"); 401$state->{prependdir} =$state->{path}; 402foreachmy$entry(keys%{$state->{entries}} ) 403{ 404$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 405delete$state->{entries}{$entry}; 406} 407} 408 409if(defined($state->{prependdir} ) ) 410{ 411$log->debug("Prepending '$state->{prependdir}' to state|directory"); 412$state->{directory} =$state->{prependdir} .$state->{directory} 413} 414$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 415} 416 417# Entry entry-line \n 418# Response expected: no. Tell the server what version of a file is on the 419# local machine. The name in entry-line is a name relative to the directory 420# most recently specified with Directory. If the user is operating on only 421# some files in a directory, Entry requests for only those files need be 422# included. If an Entry request is sent without Modified, Is-modified, or 423# Unchanged, it means the file is lost (does not exist in the working 424# directory). If both Entry and one of Modified, Is-modified, or Unchanged 425# are sent for the same file, Entry must be sent first. For a given file, 426# one can send Modified, Is-modified, or Unchanged, but not more than one 427# of these three. 428sub req_Entry 429{ 430my($cmd,$data) =@_; 431 432#$log->debug("req_Entry : $data"); 433 434my@data=split(/\//,$data); 435 436$state->{entries}{$state->{directory}.$data[1]} = { 437 revision =>$data[2], 438 conflict =>$data[3], 439 options =>$data[4], 440 tag_or_date =>$data[5], 441}; 442 443$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 444} 445 446# Questionable filename \n 447# Response expected: no. Additional data: no. Tell the server to check 448# whether filename should be ignored, and if not, next time the server 449# sends responses, send (in a M response) `?' followed by the directory and 450# filename. filename must not contain `/'; it needs to be a file in the 451# directory named by the most recent Directory request. 452sub req_Questionable 453{ 454my($cmd,$data) =@_; 455 456$log->debug("req_Questionable :$data"); 457$state->{entries}{$state->{directory}.$data}{questionable} =1; 458} 459 460# add \n 461# Response expected: yes. Add a file or directory. This uses any previous 462# Argument, Directory, Entry, or Modified requests, if they have been sent. 463# The last Directory sent specifies the working directory at the time of 464# the operation. To add a directory, send the directory to be added using 465# Directory and Argument requests. 466sub req_add 467{ 468my($cmd,$data) =@_; 469 470 argsplit("add"); 471 472my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 473$updater->update(); 474 475 argsfromdir($updater); 476 477my$addcount=0; 478 479foreachmy$filename( @{$state->{args}} ) 480{ 481$filename= filecleanup($filename); 482 483my$meta=$updater->getmeta($filename); 484my$wrev= revparse($filename); 485 486if($wrev&&$meta&& ($wrev<0)) 487{ 488# previously removed file, add back 489$log->info("added file$filenamewas previously removed, send 1.$meta->{revision}"); 490 491print"MT +updated\n"; 492print"MT text U\n"; 493print"MT fname$filename\n"; 494print"MT newline\n"; 495print"MT -updated\n"; 496 497unless($state->{globaloptions}{-n} ) 498{ 499my($filepart,$dirpart) = filenamesplit($filename,1); 500 501print"Created$dirpart\n"; 502print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 503 504# this is an "entries" line 505my$kopts= kopts_from_path($filepart); 506$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 507print"/$filepart/1.$meta->{revision}//$kopts/\n"; 508# permissions 509$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 510print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 511# transmit file 512 transmitfile($meta->{filehash}); 513} 514 515next; 516} 517 518unless(defined($state->{entries}{$filename}{modified_filename} ) ) 519{ 520print"E cvs add: nothing known about `$filename'\n"; 521next; 522} 523# TODO : check we're not squashing an already existing file 524if(defined($state->{entries}{$filename}{revision} ) ) 525{ 526print"E cvs add: `$filename' has already been entered\n"; 527next; 528} 529 530my($filepart,$dirpart) = filenamesplit($filename,1); 531 532print"E cvs add: scheduling file `$filename' for addition\n"; 533 534print"Checked-in$dirpart\n"; 535print"$filename\n"; 536my$kopts= kopts_from_path($filepart); 537print"/$filepart/0//$kopts/\n"; 538 539$addcount++; 540} 541 542if($addcount==1) 543{ 544print"E cvs add: use `cvs commit' to add this file permanently\n"; 545} 546elsif($addcount>1) 547{ 548print"E cvs add: use `cvs commit' to add these files permanently\n"; 549} 550 551print"ok\n"; 552} 553 554# remove \n 555# Response expected: yes. Remove a file. This uses any previous Argument, 556# Directory, Entry, or Modified requests, if they have been sent. The last 557# Directory sent specifies the working directory at the time of the 558# operation. Note that this request does not actually do anything to the 559# repository; the only effect of a successful remove request is to supply 560# the client with a new entries line containing `-' to indicate a removed 561# file. In fact, the client probably could perform this operation without 562# contacting the server, although using remove may cause the server to 563# perform a few more checks. The client sends a subsequent ci request to 564# actually record the removal in the repository. 565sub req_remove 566{ 567my($cmd,$data) =@_; 568 569 argsplit("remove"); 570 571# Grab a handle to the SQLite db and do any necessary updates 572my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 573$updater->update(); 574 575#$log->debug("add state : " . Dumper($state)); 576 577my$rmcount=0; 578 579foreachmy$filename( @{$state->{args}} ) 580{ 581$filename= filecleanup($filename); 582 583if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 584{ 585print"E cvs remove: file `$filename' still in working directory\n"; 586next; 587} 588 589my$meta=$updater->getmeta($filename); 590my$wrev= revparse($filename); 591 592unless(defined($wrev) ) 593{ 594print"E cvs remove: nothing known about `$filename'\n"; 595next; 596} 597 598if(defined($wrev)and$wrev<0) 599{ 600print"E cvs remove: file `$filename' already scheduled for removal\n"; 601next; 602} 603 604unless($wrev==$meta->{revision} ) 605{ 606# TODO : not sure if the format of this message is quite correct. 607print"E cvs remove: Up to date check failed for `$filename'\n"; 608next; 609} 610 611 612my($filepart,$dirpart) = filenamesplit($filename,1); 613 614print"E cvs remove: scheduling `$filename' for removal\n"; 615 616print"Checked-in$dirpart\n"; 617print"$filename\n"; 618my$kopts= kopts_from_path($filepart); 619print"/$filepart/-1.$wrev//$kopts/\n"; 620 621$rmcount++; 622} 623 624if($rmcount==1) 625{ 626print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 627} 628elsif($rmcount>1) 629{ 630print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 631} 632 633print"ok\n"; 634} 635 636# Modified filename \n 637# Response expected: no. Additional data: mode, \n, file transmission. Send 638# the server a copy of one locally modified file. filename is a file within 639# the most recent directory sent with Directory; it must not contain `/'. 640# If the user is operating on only some files in a directory, only those 641# files need to be included. This can also be sent without Entry, if there 642# is no entry for the file. 643sub req_Modified 644{ 645my($cmd,$data) =@_; 646 647my$mode= <STDIN>; 648defined$mode 649or(print"E end of file reading mode for$data\n"),return; 650chomp$mode; 651my$size= <STDIN>; 652defined$size 653or(print"E end of file reading size of$data\n"),return; 654chomp$size; 655 656# Grab config information 657my$blocksize=8192; 658my$bytesleft=$size; 659my$tmp; 660 661# Get a filehandle/name to write it to 662my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 663 664# Loop over file data writing out to temporary file. 665while($bytesleft) 666{ 667$blocksize=$bytesleftif($bytesleft<$blocksize); 668read STDIN,$tmp,$blocksize; 669print$fh $tmp; 670$bytesleft-=$blocksize; 671} 672 673close$fh 674or(print"E failed to write temporary,$filename:$!\n"),return; 675 676# Ensure we have something sensible for the file mode 677if($mode=~/u=(\w+)/) 678{ 679$mode=$1; 680}else{ 681$mode="rw"; 682} 683 684# Save the file data in $state 685$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 686$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 687$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 688$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 689 690 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 691} 692 693# Unchanged filename\n 694# Response expected: no. Tell the server that filename has not been 695# modified in the checked out directory. The filename is a file within the 696# most recent directory sent with Directory; it must not contain `/'. 697sub req_Unchanged 698{ 699 my ($cmd,$data) =@_; 700 701$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 702 703 #$log->debug("req_Unchanged :$data"); 704} 705 706# Argument text\n 707# Response expected: no. Save argument for use in a subsequent command. 708# Arguments accumulate until an argument-using command is given, at which 709# point they are forgotten. 710# Argumentx text\n 711# Response expected: no. Append\nfollowed by text to the current argument 712# being saved. 713sub req_Argument 714{ 715 my ($cmd,$data) =@_; 716 717 # Argumentx means: append to last Argument (with a newline in front) 718 719$log->debug("$cmd:$data"); 720 721 if ($cmdeq 'Argumentx') { 722 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 723 } else { 724 push @{$state->{arguments}},$data; 725 } 726} 727 728# expand-modules\n 729# Response expected: yes. Expand the modules which are specified in the 730# arguments. Returns the data in Module-expansion responses. Note that the 731# server can assume that this is checkout or export, not rtag or rdiff; the 732# latter do not access the working directory and thus have no need to 733# expand modules on the client side. Expand may not be the best word for 734# what this request does. It does not necessarily tell you all the files 735# contained in a module, for example. Basically it is a way of telling you 736# which working directories the server needs to know about in order to 737# handle a checkout of the specified modules. For example, suppose that the 738# server has a module defined by 739# aliasmodule -a 1dir 740# That is, one can check out aliasmodule and it will take 1dir in the 741# repository and check it out to 1dir in the working directory. Now suppose 742# the client already has this module checked out and is planning on using 743# the co request to update it. Without using expand-modules, the client 744# would have two bad choices: it could either send information about all 745# working directories under the current directory, which could be 746# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 747# stands for 1dir, and neglect to send information for 1dir, which would 748# lead to incorrect operation. With expand-modules, the client would first 749# ask for the module to be expanded: 750sub req_expandmodules 751{ 752 my ($cmd,$data) =@_; 753 754 argsplit(); 755 756$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 757 758 unless ( ref$state->{arguments} eq "ARRAY" ) 759 { 760 print "ok\n"; 761 return; 762 } 763 764 foreach my$module( @{$state->{arguments}} ) 765 { 766$log->debug("SEND : Module-expansion$module"); 767 print "Module-expansion$module\n"; 768 } 769 770 print "ok\n"; 771 statecleanup(); 772} 773 774# co\n 775# Response expected: yes. Get files from the repository. This uses any 776# previous Argument, Directory, Entry, or Modified requests, if they have 777# been sent. Arguments to this command are module names; the client cannot 778# know what directories they correspond to except by (1) just sending the 779# co request, and then seeing what directory names the server sends back in 780# its responses, and (2) the expand-modules request. 781sub req_co 782{ 783 my ($cmd,$data) =@_; 784 785 argsplit("co"); 786 787 my$module=$state->{args}[0]; 788 my$checkout_path=$module; 789 790 # use the user specified directory if we're given it 791$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 792 793$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 794 795$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 796 797$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 798 799# Grab a handle to the SQLite db and do any necessary updates 800my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 801$updater->update(); 802 803$checkout_path=~ s|/$||;# get rid of trailing slashes 804 805# Eclipse seems to need the Clear-sticky command 806# to prepare the 'Entries' file for the new directory. 807print"Clear-sticky$checkout_path/\n"; 808print$state->{CVSROOT} ."/$module/\n"; 809print"Clear-static-directory$checkout_path/\n"; 810print$state->{CVSROOT} ."/$module/\n"; 811print"Clear-sticky$checkout_path/\n";# yes, twice 812print$state->{CVSROOT} ."/$module/\n"; 813print"Template$checkout_path/\n"; 814print$state->{CVSROOT} ."/$module/\n"; 815print"0\n"; 816 817# instruct the client that we're checking out to $checkout_path 818print"E cvs checkout: Updating$checkout_path\n"; 819 820my%seendirs= (); 821my$lastdir=''; 822 823# recursive 824sub prepdir { 825my($dir,$repodir,$remotedir,$seendirs) =@_; 826my$parent= dirname($dir); 827$dir=~ s|/+$||; 828$repodir=~ s|/+$||; 829$remotedir=~ s|/+$||; 830$parent=~ s|/+$||; 831$log->debug("announcedir$dir,$repodir,$remotedir"); 832 833if($parenteq'.'||$parenteq'./') { 834$parent=''; 835} 836# recurse to announce unseen parents first 837if(length($parent) && !exists($seendirs->{$parent})) { 838 prepdir($parent,$repodir,$remotedir,$seendirs); 839} 840# Announce that we are going to modify at the parent level 841if($parent) { 842print"E cvs checkout: Updating$remotedir/$parent\n"; 843}else{ 844print"E cvs checkout: Updating$remotedir\n"; 845} 846print"Clear-sticky$remotedir/$parent/\n"; 847print"$repodir/$parent/\n"; 848 849print"Clear-static-directory$remotedir/$dir/\n"; 850print"$repodir/$dir/\n"; 851print"Clear-sticky$remotedir/$parent/\n";# yes, twice 852print"$repodir/$parent/\n"; 853print"Template$remotedir/$dir/\n"; 854print"$repodir/$dir/\n"; 855print"0\n"; 856 857$seendirs->{$dir} =1; 858} 859 860foreachmy$git( @{$updater->gethead} ) 861{ 862# Don't want to check out deleted files 863next if($git->{filehash}eq"deleted"); 864 865($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 866 867if(length($git->{dir}) &&$git->{dir}ne'./' 868&&$git->{dir}ne$lastdir) { 869unless(exists($seendirs{$git->{dir}})) { 870 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 871$checkout_path, \%seendirs); 872$lastdir=$git->{dir}; 873$seendirs{$git->{dir}} =1; 874} 875print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 876} 877 878# modification time of this file 879print"Mod-time$git->{modified}\n"; 880 881# print some information to the client 882if(defined($git->{dir} )and$git->{dir}ne"./") 883{ 884print"M U$checkout_path/$git->{dir}$git->{name}\n"; 885}else{ 886print"M U$checkout_path/$git->{name}\n"; 887} 888 889# instruct client we're sending a file to put in this path 890print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 891 892print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 893 894# this is an "entries" line 895my$kopts= kopts_from_path($git->{name}); 896print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 897# permissions 898print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 899 900# transmit file 901 transmitfile($git->{filehash}); 902} 903 904print"ok\n"; 905 906 statecleanup(); 907} 908 909# update \n 910# Response expected: yes. Actually do a cvs update command. This uses any 911# previous Argument, Directory, Entry, or Modified requests, if they have 912# been sent. The last Directory sent specifies the working directory at the 913# time of the operation. The -I option is not used--files which the client 914# can decide whether to ignore are not mentioned and the client sends the 915# Questionable request for others. 916sub req_update 917{ 918my($cmd,$data) =@_; 919 920$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 921 922 argsplit("update"); 923 924# 925# It may just be a client exploring the available heads/modules 926# in that case, list them as top level directories and leave it 927# at that. Eclipse uses this technique to offer you a list of 928# projects (heads in this case) to checkout. 929# 930if($state->{module}eq'') { 931my$heads_dir=$state->{CVSROOT} .'/refs/heads'; 932if(!opendir HEADS,$heads_dir) { 933print"E [server aborted]: Failed to open directory, " 934."$heads_dir:$!\nerror\n"; 935return0; 936} 937print"E cvs update: Updating .\n"; 938while(my$head=readdir(HEADS)) { 939if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 940print"E cvs update: New directory `$head'\n"; 941} 942} 943closedir HEADS; 944print"ok\n"; 945return1; 946} 947 948 949# Grab a handle to the SQLite db and do any necessary updates 950my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 951 952$updater->update(); 953 954 argsfromdir($updater); 955 956#$log->debug("update state : " . Dumper($state)); 957 958# foreach file specified on the command line ... 959foreachmy$filename( @{$state->{args}} ) 960{ 961$filename= filecleanup($filename); 962 963$log->debug("Processing file$filename"); 964 965# if we have a -C we should pretend we never saw modified stuff 966if(exists($state->{opt}{C} ) ) 967{ 968delete$state->{entries}{$filename}{modified_hash}; 969delete$state->{entries}{$filename}{modified_filename}; 970$state->{entries}{$filename}{unchanged} =1; 971} 972 973my$meta; 974if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 975{ 976$meta=$updater->getmeta($filename,$1); 977}else{ 978$meta=$updater->getmeta($filename); 979} 980 981# If -p was given, "print" the contents of the requested revision. 982if(exists($state->{opt}{p} ) ) { 983if(defined($meta->{revision} ) ) { 984$log->info("Printing '$filename' revision ".$meta->{revision}); 985 986 transmitfile($meta->{filehash}, {print=>1}); 987} 988 989next; 990} 991 992if( !defined$meta) 993{ 994$meta= { 995 name =>$filename, 996 revision =>0, 997 filehash =>'added' 998}; 999}10001001my$oldmeta=$meta;10021003my$wrev= revparse($filename);10041005# If the working copy is an old revision, lets get that version too for comparison.1006if(defined($wrev)and$wrev!=$meta->{revision} )1007{1008$oldmeta=$updater->getmeta($filename,$wrev);1009}10101011#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");10121013# Files are up to date if the working copy and repo copy have the same revision,1014# and the working copy is unmodified _and_ the user hasn't specified -C1015next if(defined($wrev)1016and defined($meta->{revision})1017and$wrev==$meta->{revision}1018and$state->{entries}{$filename}{unchanged}1019and not exists($state->{opt}{C} ) );10201021# If the working copy and repo copy have the same revision,1022# but the working copy is modified, tell the client it's modified1023if(defined($wrev)1024and defined($meta->{revision})1025and$wrev==$meta->{revision}1026and defined($state->{entries}{$filename}{modified_hash})1027and not exists($state->{opt}{C} ) )1028{1029$log->info("Tell the client the file is modified");1030print"MT text M\n";1031print"MT fname$filename\n";1032print"MT newline\n";1033next;1034}10351036if($meta->{filehash}eq"deleted")1037{1038my($filepart,$dirpart) = filenamesplit($filename,1);10391040$log->info("Removing '$filename' from working copy (no longer in the repo)");10411042print"E cvs update: `$filename' is no longer in the repository\n";1043# Don't want to actually _DO_ the update if -n specified1044unless($state->{globaloptions}{-n} ) {1045print"Removed$dirpart\n";1046print"$filepart\n";1047}1048}1049elsif(not defined($state->{entries}{$filename}{modified_hash} )1050or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1051or$meta->{filehash}eq'added')1052{1053# normal update, just send the new revision (either U=Update,1054# or A=Add, or R=Remove)1055if(defined($wrev) &&$wrev<0)1056{1057$log->info("Tell the client the file is scheduled for removal");1058print"MT text R\n";1059print"MT fname$filename\n";1060print"MT newline\n";1061next;1062}1063elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) )1064{1065$log->info("Tell the client the file is scheduled for addition");1066print"MT text A\n";1067print"MT fname$filename\n";1068print"MT newline\n";1069next;10701071}1072else{1073$log->info("Updating '$filename' to ".$meta->{revision});1074print"MT +updated\n";1075print"MT text U\n";1076print"MT fname$filename\n";1077print"MT newline\n";1078print"MT -updated\n";1079}10801081my($filepart,$dirpart) = filenamesplit($filename,1);10821083# Don't want to actually _DO_ the update if -n specified1084unless($state->{globaloptions}{-n} )1085{1086if(defined($wrev) )1087{1088# instruct client we're sending a file to put in this path as a replacement1089print"Update-existing$dirpart\n";1090$log->debug("Updating existing file 'Update-existing$dirpart'");1091}else{1092# instruct client we're sending a file to put in this path as a new file1093print"Clear-static-directory$dirpart\n";1094print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1095print"Clear-sticky$dirpart\n";1096print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";10971098$log->debug("Creating new file 'Created$dirpart'");1099print"Created$dirpart\n";1100}1101print$state->{CVSROOT} ."/$state->{module}/$filename\n";11021103# this is an "entries" line1104my$kopts= kopts_from_path($filepart);1105$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1106print"/$filepart/1.$meta->{revision}//$kopts/\n";11071108# permissions1109$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1110print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";11111112# transmit file1113 transmitfile($meta->{filehash});1114}1115}else{1116$log->info("Updating '$filename'");1117my($filepart,$dirpart) = filenamesplit($meta->{name},1);11181119my$mergeDir= setupTmpDir();11201121my$file_local=$filepart.".mine";1122my$mergedFile="$mergeDir/$file_local";1123system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1124my$file_old=$filepart.".".$oldmeta->{revision};1125 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1126my$file_new=$filepart.".".$meta->{revision};1127 transmitfile($meta->{filehash}, { targetfile =>$file_new});11281129# we need to merge with the local changes ( M=successful merge, C=conflict merge )1130$log->info("Merging$file_local,$file_old,$file_new");1131print"M Merging differences between 1.$oldmeta->{revision} and 1.$meta->{revision} into$filename\n";11321133$log->debug("Temporary directory for merge is$mergeDir");11341135my$return=system("git","merge-file",$file_local,$file_old,$file_new);1136$return>>=8;11371138 cleanupTmpDir();11391140if($return==0)1141{1142$log->info("Merged successfully");1143print"M M$filename\n";1144$log->debug("Merged$dirpart");11451146# Don't want to actually _DO_ the update if -n specified1147unless($state->{globaloptions}{-n} )1148{1149print"Merged$dirpart\n";1150$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1151print$state->{CVSROOT} ."/$state->{module}/$filename\n";1152my$kopts= kopts_from_path($filepart);1153$log->debug("/$filepart/1.$meta->{revision}//$kopts/");1154print"/$filepart/1.$meta->{revision}//$kopts/\n";1155}1156}1157elsif($return==1)1158{1159$log->info("Merged with conflicts");1160print"E cvs update: conflicts found in$filename\n";1161print"M C$filename\n";11621163# Don't want to actually _DO_ the update if -n specified1164unless($state->{globaloptions}{-n} )1165{1166print"Merged$dirpart\n";1167print$state->{CVSROOT} ."/$state->{module}/$filename\n";1168my$kopts= kopts_from_path($filepart);1169print"/$filepart/1.$meta->{revision}/+/$kopts/\n";1170}1171}1172else1173{1174$log->warn("Merge failed");1175next;1176}11771178# Don't want to actually _DO_ the update if -n specified1179unless($state->{globaloptions}{-n} )1180{1181# permissions1182$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1183print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";11841185# transmit file, format is single integer on a line by itself (file1186# size) followed by the file contents1187# TODO : we should copy files in blocks1188my$data=`cat$mergedFile`;1189$log->debug("File size : " . length($data));1190 print length($data) . "\n";1191 print$data;1192 }1193 }11941195 }11961197 print "ok\n";1198}11991200sub req_ci1201{1202 my ($cmd,$data) =@_;12031204 argsplit("ci");12051206 #$log->debug("State : " . Dumper($state));12071208$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));12091210 if ($state->{method} eq 'pserver')1211 {1212 print "error 1 pserver access cannot commit\n";1213 cleanupWorkTree();1214 exit;1215 }12161217 if ( -e$state->{CVSROOT} . "/index" )1218 {1219$log->warn("file 'index' already exists in the git repository");1220 print "error 1 Index already exists in git repo\n";1221 cleanupWorkTree();1222 exit;1223 }12241225 # Grab a handle to the SQLite db and do any necessary updates1226 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1227$updater->update();12281229 # Remember where the head was at the beginning.1230 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1231 chomp$parenthash;1232 if ($parenthash!~ /^[0-9a-f]{40}$/) {1233 print "error 1 pserver cannot find the current HEAD of module";1234 cleanupWorkTree();1235 exit;1236 }12371238 setupWorkTree($parenthash);12391240$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");12411242$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");12431244 my@committedfiles= ();1245 my%oldmeta;12461247 # foreach file specified on the command line ...1248 foreach my$filename( @{$state->{args}} )1249 {1250 my$committedfile=$filename;1251$filename= filecleanup($filename);12521253 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );12541255 my$meta=$updater->getmeta($filename);1256$oldmeta{$filename} =$meta;12571258 my$wrev= revparse($filename);12591260 my ($filepart,$dirpart) = filenamesplit($filename);12611262 # do a checkout of the file if it is part of this tree1263 if ($wrev) {1264 system('git-checkout-index', '-f', '-u',$filename);1265 unless ($?== 0) {1266 die "Error running git-checkout-index -f -u$filename:$!";1267 }1268 }12691270 my$addflag= 0;1271 my$rmflag= 0;1272$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1273$addflag= 1 unless ( -e$filename);12741275 # Do up to date checking1276 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1277 {1278 # fail everything if an up to date check fails1279 print "error 1 Up to date check failed for$filename\n";1280 cleanupWorkTree();1281 exit;1282 }12831284 push@committedfiles,$committedfile;1285$log->info("Committing$filename");12861287 system("mkdir","-p",$dirpart) unless ( -d$dirpart);12881289 unless ($rmflag)1290 {1291$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1292 rename$state->{entries}{$filename}{modified_filename},$filename;12931294 # Calculate modes to remove1295 my$invmode= "";1296 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }12971298$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1299 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1300 }13011302 if ($rmflag)1303 {1304$log->info("Removing file '$filename'");1305 unlink($filename);1306 system("git-update-index", "--remove",$filename);1307 }1308 elsif ($addflag)1309 {1310$log->info("Adding file '$filename'");1311 system("git-update-index", "--add",$filename);1312 } else {1313$log->info("Updating file '$filename'");1314 system("git-update-index",$filename);1315 }1316 }13171318 unless ( scalar(@committedfiles) > 0 )1319 {1320 print "E No files to commit\n";1321 print "ok\n";1322 cleanupWorkTree();1323 return;1324 }13251326 my$treehash= `git-write-tree`;1327 chomp$treehash;13281329$log->debug("Treehash :$treehash, Parenthash :$parenthash");13301331 # write our commit message out if we have one ...1332 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1333 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1334 print$msg_fh"\n\nvia git-CVS emulator\n";1335 close$msg_fh;13361337 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;1338chomp($commithash);1339$log->info("Commit hash :$commithash");13401341unless($commithash=~/[a-zA-Z0-9]{40}/)1342{1343$log->warn("Commit failed (Invalid commit hash)");1344print"error 1 Commit failed (unknown reason)\n";1345 cleanupWorkTree();1346exit;1347}13481349### Emulate git-receive-pack by running hooks/update1350my@hook= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1351$parenthash,$commithash);1352if( -x $hook[0] ) {1353unless(system(@hook) ==0)1354{1355$log->warn("Commit failed (update hook declined to update ref)");1356print"error 1 Commit failed (update hook declined)\n";1357 cleanupWorkTree();1358exit;1359}1360}13611362### Update the ref1363if(system(qw(git update-ref -m),"cvsserver ci",1364"refs/heads/$state->{module}",$commithash,$parenthash)) {1365$log->warn("update-ref for$state->{module} failed.");1366print"error 1 Cannot commit -- update first\n";1367 cleanupWorkTree();1368exit;1369}13701371### Emulate git-receive-pack by running hooks/post-receive1372my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1373if( -x $hook) {1374open(my$pipe,"|$hook") ||die"can't fork$!";13751376local$SIG{PIPE} =sub{die'pipe broke'};13771378print$pipe"$parenthash$commithashrefs/heads/$state->{module}\n";13791380close$pipe||die"bad pipe:$!$?";1381}13821383### Then hooks/post-update1384$hook=$ENV{GIT_DIR}.'hooks/post-update';1385if(-x $hook) {1386system($hook,"refs/heads/$state->{module}");1387}13881389$updater->update();13901391# foreach file specified on the command line ...1392foreachmy$filename(@committedfiles)1393{1394$filename= filecleanup($filename);13951396my$meta=$updater->getmeta($filename);1397unless(defined$meta->{revision}) {1398$meta->{revision} =1;1399}14001401my($filepart,$dirpart) = filenamesplit($filename,1);14021403$log->debug("Checked-in$dirpart:$filename");14041405print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1406if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1407{1408print"M new revision: delete; previous revision: 1.$oldmeta{$filename}{revision}\n";1409print"Remove-entry$dirpart\n";1410print"$filename\n";1411}else{1412if($meta->{revision} ==1) {1413print"M initial revision: 1.1\n";1414}else{1415print"M new revision: 1.$meta->{revision}; previous revision: 1.$oldmeta{$filename}{revision}\n";1416}1417print"Checked-in$dirpart\n";1418print"$filename\n";1419my$kopts= kopts_from_path($filepart);1420print"/$filepart/1.$meta->{revision}//$kopts/\n";1421}1422}14231424 cleanupWorkTree();1425print"ok\n";1426}14271428sub req_status1429{1430my($cmd,$data) =@_;14311432 argsplit("status");14331434$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1435#$log->debug("status state : " . Dumper($state));14361437# Grab a handle to the SQLite db and do any necessary updates1438my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1439$updater->update();14401441# if no files were specified, we need to work out what files we should be providing status on ...1442 argsfromdir($updater);14431444# foreach file specified on the command line ...1445foreachmy$filename( @{$state->{args}} )1446{1447$filename= filecleanup($filename);14481449next ifexists($state->{opt}{l}) &&index($filename,'/',length($state->{prependdir})) >=0;14501451my$meta=$updater->getmeta($filename);1452my$oldmeta=$meta;14531454my$wrev= revparse($filename);14551456# If the working copy is an old revision, lets get that version too for comparison.1457if(defined($wrev)and$wrev!=$meta->{revision} )1458{1459$oldmeta=$updater->getmeta($filename,$wrev);1460}14611462# TODO : All possible statuses aren't yet implemented1463my$status;1464# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1465$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1466and1467( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1468or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1469);14701471# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1472$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1473and1474($state->{entries}{$filename}{unchanged}1475or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1476);14771478# Need checkout if it exists in the repo but doesn't have a working copy1479$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );14801481# Locally modified if working copy and repo copy have the same revision but there are local changes1482$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );14831484# Needs Merge if working copy revision is less than repo copy and there are local changes1485$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );14861487$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1488$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1489$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1490$status||="File had conflicts on merge"if(0);14911492$status||="Unknown";14931494my($filepart) = filenamesplit($filename);14951496print"M ===================================================================\n";1497print"M File:$filepart\tStatus:$status\n";1498if(defined($state->{entries}{$filename}{revision}) )1499{1500print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1501}else{1502print"M Working revision:\tNo entry for$filename\n";1503}1504if(defined($meta->{revision}) )1505{1506print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1507print"M Sticky Tag:\t\t(none)\n";1508print"M Sticky Date:\t\t(none)\n";1509print"M Sticky Options:\t\t(none)\n";1510}else{1511print"M Repository revision:\tNo revision control file\n";1512}1513print"M\n";1514}15151516print"ok\n";1517}15181519sub req_diff1520{1521my($cmd,$data) =@_;15221523 argsplit("diff");15241525$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1526#$log->debug("status state : " . Dumper($state));15271528my($revision1,$revision2);1529if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1530{1531$revision1=$state->{opt}{r}[0];1532$revision2=$state->{opt}{r}[1];1533}else{1534$revision1=$state->{opt}{r};1535}15361537$revision1=~s/^1\.//if(defined($revision1) );1538$revision2=~s/^1\.//if(defined($revision2) );15391540$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );15411542# Grab a handle to the SQLite db and do any necessary updates1543my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1544$updater->update();15451546# if no files were specified, we need to work out what files we should be providing status on ...1547 argsfromdir($updater);15481549# foreach file specified on the command line ...1550foreachmy$filename( @{$state->{args}} )1551{1552$filename= filecleanup($filename);15531554my($fh,$file1,$file2,$meta1,$meta2,$filediff);15551556my$wrev= revparse($filename);15571558# We need _something_ to diff against1559next unless(defined($wrev) );15601561# if we have a -r switch, use it1562if(defined($revision1) )1563{1564(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1565$meta1=$updater->getmeta($filename,$revision1);1566unless(defined($meta1)and$meta1->{filehash}ne"deleted")1567{1568print"E File$filenameat revision 1.$revision1doesn't exist\n";1569next;1570}1571 transmitfile($meta1->{filehash}, { targetfile =>$file1});1572}1573# otherwise we just use the working copy revision1574else1575{1576(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1577$meta1=$updater->getmeta($filename,$wrev);1578 transmitfile($meta1->{filehash}, { targetfile =>$file1});1579}15801581# if we have a second -r switch, use it too1582if(defined($revision2) )1583{1584(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1585$meta2=$updater->getmeta($filename,$revision2);15861587unless(defined($meta2)and$meta2->{filehash}ne"deleted")1588{1589print"E File$filenameat revision 1.$revision2doesn't exist\n";1590next;1591}15921593 transmitfile($meta2->{filehash}, { targetfile =>$file2});1594}1595# otherwise we just use the working copy1596else1597{1598$file2=$state->{entries}{$filename}{modified_filename};1599}16001601# if we have been given -r, and we don't have a $file2 yet, lets get one1602if(defined($revision1)and not defined($file2) )1603{1604(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1605$meta2=$updater->getmeta($filename,$wrev);1606 transmitfile($meta2->{filehash}, { targetfile =>$file2});1607}16081609# We need to have retrieved something useful1610next unless(defined($meta1) );16111612# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1613next if(not defined($meta2)and$wrev==$meta1->{revision}1614and1615( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1616or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1617);16181619# Apparently we only show diffs for locally modified files1620next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );16211622print"M Index:$filename\n";1623print"M ===================================================================\n";1624print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1625print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1626print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1627print"M diff ";1628foreachmy$opt(keys%{$state->{opt}} )1629{1630if(ref$state->{opt}{$opt}eq"ARRAY")1631{1632foreachmy$value( @{$state->{opt}{$opt}} )1633{1634print"-$opt$value";1635}1636}else{1637print"-$opt";1638print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1639}1640}1641print"$filename\n";16421643$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));16441645($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);16461647if(exists$state->{opt}{u} )1648{1649system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1650}else{1651system("diff$file1$file2>$filediff");1652}16531654while( <$fh> )1655{1656print"M$_";1657}1658close$fh;1659}16601661print"ok\n";1662}16631664sub req_log1665{1666my($cmd,$data) =@_;16671668 argsplit("log");16691670$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1671#$log->debug("log state : " . Dumper($state));16721673my($minrev,$maxrev);1674if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1675{1676my$control=$2;1677$minrev=$1;1678$maxrev=$3;1679$minrev=~s/^1\.//if(defined($minrev) );1680$maxrev=~s/^1\.//if(defined($maxrev) );1681$minrev++if(defined($minrev)and$controleq"::");1682}16831684# Grab a handle to the SQLite db and do any necessary updates1685my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1686$updater->update();16871688# if no files were specified, we need to work out what files we should be providing status on ...1689 argsfromdir($updater);16901691# foreach file specified on the command line ...1692foreachmy$filename( @{$state->{args}} )1693{1694$filename= filecleanup($filename);16951696my$headmeta=$updater->getmeta($filename);16971698my$revisions=$updater->getlog($filename);1699my$totalrevisions=scalar(@$revisions);17001701if(defined($minrev) )1702{1703$log->debug("Removing revisions less than$minrev");1704while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1705{1706pop@$revisions;1707}1708}1709if(defined($maxrev) )1710{1711$log->debug("Removing revisions greater than$maxrev");1712while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1713{1714shift@$revisions;1715}1716}17171718next unless(scalar(@$revisions) );17191720print"M\n";1721print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1722print"M Working file:$filename\n";1723print"M head: 1.$headmeta->{revision}\n";1724print"M branch:\n";1725print"M locks: strict\n";1726print"M access list:\n";1727print"M symbolic names:\n";1728print"M keyword substitution: kv\n";1729print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1730print"M description:\n";17311732foreachmy$revision(@$revisions)1733{1734print"M ----------------------------\n";1735print"M revision 1.$revision->{revision}\n";1736# reformat the date for log output1737$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}) );1738$revision->{author} = cvs_author($revision->{author});1739print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1740my$commitmessage=$updater->commitmessage($revision->{commithash});1741$commitmessage=~s/^/M /mg;1742print$commitmessage."\n";1743}1744print"M =============================================================================\n";1745}17461747print"ok\n";1748}17491750sub req_annotate1751{1752my($cmd,$data) =@_;17531754 argsplit("annotate");17551756$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1757#$log->debug("status state : " . Dumper($state));17581759# Grab a handle to the SQLite db and do any necessary updates1760my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1761$updater->update();17621763# if no files were specified, we need to work out what files we should be providing annotate on ...1764 argsfromdir($updater);17651766# we'll need a temporary checkout dir1767 setupWorkTree();17681769$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");17701771# foreach file specified on the command line ...1772foreachmy$filename( @{$state->{args}} )1773{1774$filename= filecleanup($filename);17751776my$meta=$updater->getmeta($filename);17771778next unless($meta->{revision} );17791780# get all the commits that this file was in1781# in dense format -- aka skip dead revisions1782my$revisions=$updater->gethistorydense($filename);1783my$lastseenin=$revisions->[0][2];17841785# populate the temporary index based on the latest commit were we saw1786# the file -- but do it cheaply without checking out any files1787# TODO: if we got a revision from the client, use that instead1788# to look up the commithash in sqlite (still good to default to1789# the current head as we do now)1790system("git-read-tree",$lastseenin);1791unless($?==0)1792{1793print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";1794return;1795}1796$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");17971798# do a checkout of the file1799system('git-checkout-index','-f','-u',$filename);1800unless($?==0) {1801print"E error running git-checkout-index -f -u$filename:$!\n";1802return;1803}18041805$log->info("Annotate$filename");18061807# Prepare a file with the commits from the linearized1808# history that annotate should know about. This prevents1809# git-jsannotate telling us about commits we are hiding1810# from the client.18111812my$a_hints="$work->{workDir}/.annotate_hints";1813if(!open(ANNOTATEHINTS,'>',$a_hints)) {1814print"E failed to open '$a_hints' for writing:$!\n";1815return;1816}1817for(my$i=0;$i<@$revisions;$i++)1818{1819print ANNOTATEHINTS $revisions->[$i][2];1820if($i+1<@$revisions) {# have we got a parent?1821print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1822}1823print ANNOTATEHINTS "\n";1824}18251826print ANNOTATEHINTS "\n";1827close ANNOTATEHINTS1828or(print"E failed to write$a_hints:$!\n"),return;18291830my@cmd= (qw(git-annotate -l -S),$a_hints,$filename);1831if(!open(ANNOTATE,"-|",@cmd)) {1832print"E error invoking ".join(' ',@cmd) .":$!\n";1833return;1834}1835my$metadata= {};1836print"E Annotations for$filename\n";1837print"E ***************\n";1838while( <ANNOTATE> )1839{1840if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1841{1842my$commithash=$1;1843my$data=$2;1844unless(defined($metadata->{$commithash} ) )1845{1846$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1847$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});1848$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1849}1850printf("M 1.%-5d (%-8s%10s):%s\n",1851$metadata->{$commithash}{revision},1852$metadata->{$commithash}{author},1853$metadata->{$commithash}{modified},1854$data1855);1856}else{1857$log->warn("Error in annotate output! LINE:$_");1858print"E Annotate error\n";1859next;1860}1861}1862close ANNOTATE;1863}18641865# done; get out of the tempdir1866 cleanupWorkDir();18671868print"ok\n";18691870}18711872# This method takes the state->{arguments} array and produces two new arrays.1873# The first is $state->{args} which is everything before the '--' argument, and1874# the second is $state->{files} which is everything after it.1875sub argsplit1876{1877$state->{args} = [];1878$state->{files} = [];1879$state->{opt} = {};18801881return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");18821883my$type=shift;18841885if(defined($type) )1886{1887my$opt= {};1888$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");1889$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1890$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");1891$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1892$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1893$opt= { k =>1, m =>1}if($typeeq"add");1894$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1895$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");189618971898while(scalar( @{$state->{arguments}} ) >0)1899{1900my$arg=shift@{$state->{arguments}};19011902next if($argeq"--");1903next unless($arg=~/\S/);19041905# if the argument looks like a switch1906if($arg=~/^-(\w)(.*)/)1907{1908# if it's a switch that takes an argument1909if($opt->{$1} )1910{1911# If this switch has already been provided1912if($opt->{$1} >1and exists($state->{opt}{$1} ) )1913{1914$state->{opt}{$1} = [$state->{opt}{$1} ];1915if(length($2) >0)1916{1917push@{$state->{opt}{$1}},$2;1918}else{1919push@{$state->{opt}{$1}},shift@{$state->{arguments}};1920}1921}else{1922# if there's extra data in the arg, use that as the argument for the switch1923if(length($2) >0)1924{1925$state->{opt}{$1} =$2;1926}else{1927$state->{opt}{$1} =shift@{$state->{arguments}};1928}1929}1930}else{1931$state->{opt}{$1} =undef;1932}1933}1934else1935{1936push@{$state->{args}},$arg;1937}1938}1939}1940else1941{1942my$mode=0;19431944foreachmy$value( @{$state->{arguments}} )1945{1946if($valueeq"--")1947{1948$mode++;1949next;1950}1951push@{$state->{args}},$valueif($mode==0);1952push@{$state->{files}},$valueif($mode==1);1953}1954}1955}19561957# This method uses $state->{directory} to populate $state->{args} with a list of filenames1958sub argsfromdir1959{1960my$updater=shift;19611962$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");19631964return if(scalar( @{$state->{args}} ) >1);19651966my@gethead= @{$updater->gethead};19671968# push added files1969foreachmy$file(keys%{$state->{entries}}) {1970if(exists$state->{entries}{$file}{revision} &&1971$state->{entries}{$file}{revision} ==0)1972{1973push@gethead, { name =>$file, filehash =>'added'};1974}1975}19761977if(scalar(@{$state->{args}}) ==1)1978{1979my$arg=$state->{args}[0];1980$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );19811982$log->info("Only one arg specified, checking for directory expansion on '$arg'");19831984foreachmy$file(@gethead)1985{1986next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1987next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);1988push@{$state->{args}},$file->{name};1989}19901991shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);1992}else{1993$log->info("Only one arg specified, populating file list automatically");19941995$state->{args} = [];19961997foreachmy$file(@gethead)1998{1999next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );2000next unless($file->{name} =~s/^$state->{prependdir}//);2001push@{$state->{args}},$file->{name};2002}2003}2004}20052006# This method cleans up the $state variable after a command that uses arguments has run2007sub statecleanup2008{2009$state->{files} = [];2010$state->{args} = [];2011$state->{arguments} = [];2012$state->{entries} = {};2013}20142015sub revparse2016{2017my$filename=shift;20182019returnundefunless(defined($state->{entries}{$filename}{revision} ) );20202021return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);2022return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);20232024returnundef;2025}20262027# This method takes a file hash and does a CVS "file transfer". Its2028# exact behaviour depends on a second, optional hash table argument:2029# - If $options->{targetfile}, dump the contents to that file;2030# - If $options->{print}, use M/MT to transmit the contents one line2031# at a time;2032# - Otherwise, transmit the size of the file, followed by the file2033# contents.2034sub transmitfile2035{2036my$filehash=shift;2037my$options=shift;20382039if(defined($filehash)and$filehasheq"deleted")2040{2041$log->warn("filehash is 'deleted'");2042return;2043}20442045die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);20462047my$type=`git-cat-file -t$filehash`;2048 chomp$type;20492050 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );20512052 my$size= `git-cat-file -s $filehash`;2053chomp$size;20542055$log->debug("transmitfile($filehash) size=$size, type=$type");20562057if(open my$fh,'-|',"git-cat-file","blob",$filehash)2058{2059if(defined($options->{targetfile} ) )2060{2061my$targetfile=$options->{targetfile};2062open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2063print NEWFILE $_while( <$fh> );2064close NEWFILE or die("Failed to write '$targetfile':$!");2065}elsif(defined($options->{print} ) &&$options->{print} ) {2066while( <$fh> ) {2067if(/\n\z/) {2068print'M ',$_;2069}else{2070print'MT text ',$_,"\n";2071}2072}2073}else{2074print"$size\n";2075printwhile( <$fh> );2076}2077close$fhor die("Couldn't close filehandle for transmitfile():$!");2078}else{2079die("Couldn't execute git-cat-file");2080}2081}20822083# This method takes a file name, and returns ( $dirpart, $filepart ) which2084# refers to the directory portion and the file portion of the filename2085# respectively2086sub filenamesplit2087{2088my$filename=shift;2089my$fixforlocaldir=shift;20902091my($filepart,$dirpart) = ($filename,".");2092($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2093$dirpart.="/";20942095if($fixforlocaldir)2096{2097$dirpart=~s/^$state->{prependdir}//;2098}20992100return($filepart,$dirpart);2101}21022103sub filecleanup2104{2105my$filename=shift;21062107returnundefunless(defined($filename));2108if($filename=~/^\// )2109{2110print"E absolute filenames '$filename' not supported by server\n";2111returnundef;2112}21132114$filename=~s/^\.\///g;2115$filename=$state->{prependdir} .$filename;2116return$filename;2117}21182119sub validateGitDir2120{2121if( !defined($state->{CVSROOT}) )2122{2123print"error 1 CVSROOT not specified\n";2124 cleanupWorkTree();2125exit;2126}2127if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2128{2129print"error 1 Internally inconsistent CVSROOT\n";2130 cleanupWorkTree();2131exit;2132}2133}21342135# Setup working directory in a work tree with the requested version2136# loaded in the index.2137sub setupWorkTree2138{2139my($ver) =@_;21402141 validateGitDir();21422143if( (defined($work->{state}) &&$work->{state} !=1) ||2144defined($work->{tmpDir}) )2145{2146$log->warn("Bad work tree state management");2147print"error 1 Internal setup multiple work trees without cleanup\n";2148 cleanupWorkTree();2149exit;2150}21512152$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);21532154if( !defined($work->{index}) )2155{2156(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2157}21582159chdir$work->{workDir}or2160die"Unable to chdir to$work->{workDir}\n";21612162$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");21632164$ENV{GIT_WORK_TREE} =".";2165$ENV{GIT_INDEX_FILE} =$work->{index};2166$work->{state} =2;21672168if($ver)2169{2170system("git","read-tree",$ver);2171unless($?==0)2172{2173$log->warn("Error running git-read-tree");2174die"Error running git-read-tree$verin$work->{workDir}$!\n";2175}2176}2177# else # req_annotate reads tree for each file2178}21792180# Ensure current directory is in some kind of working directory,2181# with a recent version loaded in the index.2182sub ensureWorkTree2183{2184if(defined($work->{tmpDir}) )2185{2186$log->warn("Bad work tree state management [ensureWorkTree()]");2187print"error 1 Internal setup multiple dirs without cleanup\n";2188 cleanupWorkTree();2189exit;2190}2191if($work->{state} )2192{2193return;2194}21952196 validateGitDir();21972198if( !defined($work->{emptyDir}) )2199{2200$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);2201}2202chdir$work->{emptyDir}or2203die"Unable to chdir to$work->{emptyDir}\n";22042205my$ver=`git show-ref -s refs/heads/$state->{module}`;2206chomp$ver;2207if($ver!~/^[0-9a-f]{40}$/)2208{2209$log->warn("Error from git show-ref -s refs/head$state->{module}");2210print"error 1 cannot find the current HEAD of module";2211 cleanupWorkTree();2212exit;2213}22142215if( !defined($work->{index}) )2216{2217(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2218}22192220$ENV{GIT_WORK_TREE} =".";2221$ENV{GIT_INDEX_FILE} =$work->{index};2222$work->{state} =1;22232224system("git","read-tree",$ver);2225unless($?==0)2226{2227die"Error running git-read-tree$ver$!\n";2228}2229}22302231# Cleanup working directory that is not needed any longer.2232sub cleanupWorkTree2233{2234if( !$work->{state} )2235{2236return;2237}22382239chdir"/"or die"Unable to chdir '/'\n";22402241if(defined($work->{workDir}) )2242{2243 rmtree($work->{workDir} );2244undef$work->{workDir};2245}2246undef$work->{state};2247}22482249# Setup a temporary directory (not a working tree), typically for2250# merging dirty state as in req_update.2251sub setupTmpDir2252{2253$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);2254chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";22552256return$work->{tmpDir};2257}22582259# Clean up a previously setupTmpDir. Restore previous work tree if2260# appropriate.2261sub cleanupTmpDir2262{2263if( !defined($work->{tmpDir}) )2264{2265$log->warn("cleanup tmpdir that has not been setup");2266die"Cleanup tmpDir that has not been setup\n";2267}2268if(defined($work->{state}) )2269{2270if($work->{state} ==1)2271{2272chdir$work->{emptyDir}or2273die"Unable to chdir to$work->{emptyDir}\n";2274}2275elsif($work->{state} ==2)2276{2277chdir$work->{workDir}or2278die"Unable to chdir to$work->{emptyDir}\n";2279}2280else2281{2282$log->warn("Inconsistent work dir state");2283die"Inconsistent work dir state\n";2284}2285}2286else2287{2288chdir"/"or die"Unable to chdir '/'\n";2289}2290}22912292# Given a path, this function returns a string containing the kopts2293# that should go into that path's Entries line. For example, a binary2294# file should get -kb.2295sub kopts_from_path2296{2297my($path) =@_;22982299# Once it exists, the git attributes system should be used to look up2300# what attributes apply to this path.23012302# Until then, take the setting from the config file2303unless(defined($cfg->{gitcvs}{allbinary} )and$cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i)2304{2305# Return "" to give no special treatment to any path2306return"";2307}else{2308# Alternatively, to have all files treated as if they are binary (which2309# is more like git itself), always return the "-kb" option2310return"-kb";2311}2312}23132314# Generate a CVS author name from Git author information, by taking2315# the first eight characters of the user part of the email address.2316sub cvs_author2317{2318my$author_line=shift;2319(my$author) =$author_line=~/<([^>@]{1,8})/;23202321$author;2322}23232324package GITCVS::log;23252326####2327#### Copyright The Open University UK - 2006.2328####2329#### Authors: Martyn Smith <martyn@catalyst.net.nz>2330#### Martin Langhoff <martin@catalyst.net.nz>2331####2332####23332334use strict;2335use warnings;23362337=head1 NAME23382339GITCVS::log23402341=head1 DESCRIPTION23422343This module provides very crude logging with a similar interface to2344Log::Log4perl23452346=head1 METHODS23472348=cut23492350=head2 new23512352Creates a new log object, optionally you can specify a filename here to2353indicate the file to log to. If no log file is specified, you can specify one2354later with method setfile, or indicate you no longer want logging with method2355nofile.23562357Until one of these methods is called, all log calls will buffer messages ready2358to write out.23592360=cut2361sub new2362{2363my$class=shift;2364my$filename=shift;23652366my$self= {};23672368bless$self,$class;23692370if(defined($filename) )2371{2372open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2373}23742375return$self;2376}23772378=head2 setfile23792380This methods takes a filename, and attempts to open that file as the log file.2381If successful, all buffered data is written out to the file, and any further2382logging is written directly to the file.23832384=cut2385sub setfile2386{2387my$self=shift;2388my$filename=shift;23892390if(defined($filename) )2391{2392open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");2393}23942395return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");23962397while(my$line=shift@{$self->{buffer}} )2398{2399print{$self->{fh}}$line;2400}2401}24022403=head2 nofile24042405This method indicates no logging is going to be used. It flushes any entries in2406the internal buffer, and sets a flag to ensure no further data is put there.24072408=cut2409sub nofile2410{2411my$self=shift;24122413$self->{nolog} =1;24142415return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");24162417$self->{buffer} = [];2418}24192420=head2 _logopen24212422Internal method. Returns true if the log file is open, false otherwise.24232424=cut2425sub _logopen2426{2427my$self=shift;24282429return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2430return0;2431}24322433=head2 debug info warn fatal24342435These four methods are wrappers to _log. They provide the actual interface for2436logging data.24372438=cut2439sub debug {my$self=shift;$self->_log("debug",@_); }2440sub info {my$self=shift;$self->_log("info",@_); }2441subwarn{my$self=shift;$self->_log("warn",@_); }2442sub fatal {my$self=shift;$self->_log("fatal",@_); }24432444=head2 _log24452446This is an internal method called by the logging functions. It generates a2447timestamp and pushes the logged line either to file, or internal buffer.24482449=cut2450sub _log2451{2452my$self=shift;2453my$level=shift;24542455return if($self->{nolog} );24562457my@time=localtime;2458my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2459$time[5] +1900,2460$time[4] +1,2461$time[3],2462$time[2],2463$time[1],2464$time[0],2465uc$level,2466);24672468if($self->_logopen)2469{2470print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2471}else{2472push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2473}2474}24752476=head2 DESTROY24772478This method simply closes the file handle if one is open24792480=cut2481sub DESTROY2482{2483my$self=shift;24842485if($self->_logopen)2486{2487close$self->{fh};2488}2489}24902491package GITCVS::updater;24922493####2494#### Copyright The Open University UK - 2006.2495####2496#### Authors: Martyn Smith <martyn@catalyst.net.nz>2497#### Martin Langhoff <martin@catalyst.net.nz>2498####2499####25002501use strict;2502use warnings;2503use DBI;25042505=head1 METHODS25062507=cut25082509=head2 new25102511=cut2512sub new2513{2514my$class=shift;2515my$config=shift;2516my$module=shift;2517my$log=shift;25182519die"Need to specify a git repository"unless(defined($config)and-d $config);2520die"Need to specify a module"unless(defined($module) );25212522$class=ref($class) ||$class;25232524my$self= {};25252526bless$self,$class;25272528$self->{valid_tables} = {'revision'=>1,2529'revision_ix1'=>1,2530'revision_ix2'=>1,2531'head'=>1,2532'head_ix1'=>1,2533'properties'=>1,2534'commitmsgs'=>1};25352536$self->{module} =$module;2537$self->{git_path} =$config."/";25382539$self->{log} =$log;25402541die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );25422543$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||2544$cfg->{gitcvs}{dbdriver} ||"SQLite";2545$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||2546$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";2547$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||2548$cfg->{gitcvs}{dbuser} ||"";2549$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||2550$cfg->{gitcvs}{dbpass} ||"";2551$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||2552$cfg->{gitcvs}{dbtablenameprefix} ||"";2553my%mapping= ( m =>$module,2554 a =>$state->{method},2555 u =>getlogin||getpwuid($<) || $<,2556 G =>$self->{git_path},2557 g => mangle_dirname($self->{git_path}),2558);2559$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;2560$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;2561$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;2562$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});25632564die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;2565die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;2566$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",2567$self->{dbuser},2568$self->{dbpass});2569die"Error connecting to database\n"unlessdefined$self->{dbh};25702571$self->{tables} = {};2572foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )2573{2574$self->{tables}{$table} =1;2575}25762577# Construct the revision table if required2578unless($self->{tables}{$self->tablename("revision")} )2579{2580my$tablename=$self->tablename("revision");2581my$ix1name=$self->tablename("revision_ix1");2582my$ix2name=$self->tablename("revision_ix2");2583$self->{dbh}->do("2584 CREATE TABLE$tablename(2585 name TEXT NOT NULL,2586 revision INTEGER NOT NULL,2587 filehash TEXT NOT NULL,2588 commithash TEXT NOT NULL,2589 author TEXT NOT NULL,2590 modified TEXT NOT NULL,2591 mode TEXT NOT NULL2592 )2593 ");2594$self->{dbh}->do("2595 CREATE INDEX$ix1name2596 ON$tablename(name,revision)2597 ");2598$self->{dbh}->do("2599 CREATE INDEX$ix2name2600 ON$tablename(name,commithash)2601 ");2602}26032604# Construct the head table if required2605unless($self->{tables}{$self->tablename("head")} )2606{2607my$tablename=$self->tablename("head");2608my$ix1name=$self->tablename("head_ix1");2609$self->{dbh}->do("2610 CREATE TABLE$tablename(2611 name TEXT NOT NULL,2612 revision INTEGER NOT NULL,2613 filehash TEXT NOT NULL,2614 commithash TEXT NOT NULL,2615 author TEXT NOT NULL,2616 modified TEXT NOT NULL,2617 mode TEXT NOT NULL2618 )2619 ");2620$self->{dbh}->do("2621 CREATE INDEX$ix1name2622 ON$tablename(name)2623 ");2624}26252626# Construct the properties table if required2627unless($self->{tables}{$self->tablename("properties")} )2628{2629my$tablename=$self->tablename("properties");2630$self->{dbh}->do("2631 CREATE TABLE$tablename(2632 key TEXT NOT NULL PRIMARY KEY,2633 value TEXT2634 )2635 ");2636}26372638# Construct the commitmsgs table if required2639unless($self->{tables}{$self->tablename("commitmsgs")} )2640{2641my$tablename=$self->tablename("commitmsgs");2642$self->{dbh}->do("2643 CREATE TABLE$tablename(2644 key TEXT NOT NULL PRIMARY KEY,2645 value TEXT2646 )2647 ");2648}26492650return$self;2651}26522653=head2 tablename26542655=cut2656sub tablename2657{2658my$self=shift;2659my$name=shift;26602661if(exists$self->{valid_tables}{$name}) {2662return$self->{dbtablenameprefix} .$name;2663}else{2664returnundef;2665}2666}26672668=head2 update26692670=cut2671sub update2672{2673my$self=shift;26742675# first lets get the commit list2676$ENV{GIT_DIR} =$self->{git_path};26772678my$commitsha1=`git rev-parse$self->{module}`;2679chomp$commitsha1;26802681my$commitinfo=`git cat-file commit$self->{module} 2>&1`;2682unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2683{2684die("Invalid module '$self->{module}'");2685}268626872688my$git_log;2689my$lastcommit=$self->_get_prop("last_commit");26902691if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date2692return1;2693}26942695# Start exclusive lock here...2696$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";26972698# TODO: log processing is memory bound2699# if we can parse into a 2nd file that is in reverse order2700# we can probably do something really efficient2701my@git_log_params= ('--pretty','--parents','--topo-order');27022703if(defined$lastcommit) {2704push@git_log_params,"$lastcommit..$self->{module}";2705}else{2706push@git_log_params,$self->{module};2707}2708# git-rev-list is the backend / plumbing version of git-log2709open(GITLOG,'-|','git-rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";27102711my@commits;27122713my%commit= ();27142715while( <GITLOG> )2716{2717chomp;2718if(m/^commit\s+(.*)$/) {2719# on ^commit lines put the just seen commit in the stack2720# and prime things for the next one2721if(keys%commit) {2722my%copy=%commit;2723unshift@commits, \%copy;2724%commit= ();2725}2726my@parents=split(m/\s+/,$1);2727$commit{hash} =shift@parents;2728$commit{parents} = \@parents;2729}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2730# on rfc822-like lines seen before we see any message,2731# lowercase the entry and put it in the hash as key-value2732$commit{lc($1)} =$2;2733}else{2734# message lines - skip initial empty line2735# and trim whitespace2736if(!exists($commit{message}) &&m/^\s*$/) {2737# define it to mark the end of headers2738$commit{message} ='';2739next;2740}2741s/^\s+//;s/\s+$//;# trim ws2742$commit{message} .=$_."\n";2743}2744}2745close GITLOG;27462747unshift@commits, \%commitif(keys%commit);27482749# Now all the commits are in the @commits bucket2750# ordered by time DESC. for each commit that needs processing,2751# determine whether it's following the last head we've seen or if2752# it's on its own branch, grab a file list, and add whatever's changed2753# NOTE: $lastcommit refers to the last commit from previous run2754# $lastpicked is the last commit we picked in this run2755my$lastpicked;2756my$head= {};2757if(defined$lastcommit) {2758$lastpicked=$lastcommit;2759}27602761my$committotal=scalar(@commits);2762my$commitcount=0;27632764# Load the head table into $head (for cached lookups during the update process)2765foreachmy$file( @{$self->gethead()} )2766{2767$head->{$file->{name}} =$file;2768}27692770foreachmy$commit(@commits)2771{2772$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2773if(defined$lastpicked)2774{2775if(!in_array($lastpicked, @{$commit->{parents}}))2776{2777# skip, we'll see this delta2778# as part of a merge later2779# warn "skipping off-track $commit->{hash}\n";2780next;2781}elsif(@{$commit->{parents}} >1) {2782# it is a merge commit, for each parent that is2783# not $lastpicked, see if we can get a log2784# from the merge-base to that parent to put it2785# in the message as a merge summary.2786my@parents= @{$commit->{parents}};2787foreachmy$parent(@parents) {2788# git-merge-base can potentially (but rarely) throw2789# several candidate merge bases. let's assume2790# that the first one is the best one.2791if($parenteq$lastpicked) {2792next;2793}2794my$base=eval{2795 safe_pipe_capture('git-merge-base',2796$lastpicked,$parent);2797};2798# The two branches may not be related at all,2799# in which case merge base simply fails to find2800# any, but that's Ok.2801next if($@);28022803chomp$base;2804if($base) {2805my@merged;2806# print "want to log between $base $parent \n";2807open(GITLOG,'-|','git-log','--pretty=medium',"$base..$parent")2808or die"Cannot call git-log:$!";2809my$mergedhash;2810while(<GITLOG>) {2811chomp;2812if(!defined$mergedhash) {2813if(m/^commit\s+(.+)$/) {2814$mergedhash=$1;2815}else{2816next;2817}2818}else{2819# grab the first line that looks non-rfc8222820# aka has content after leading space2821if(m/^\s+(\S.*)$/) {2822my$title=$1;2823$title=substr($title,0,100);# truncate2824unshift@merged,"$mergedhash$title";2825undef$mergedhash;2826}2827}2828}2829close GITLOG;2830if(@merged) {2831$commit->{mergemsg} =$commit->{message};2832$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2833foreachmy$summary(@merged) {2834$commit->{mergemsg} .="\t$summary\n";2835}2836$commit->{mergemsg} .="\n\n";2837# print "Message for $commit->{hash} \n$commit->{mergemsg}";2838}2839}2840}2841}2842}28432844# convert the date to CVS-happy format2845$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);28462847if(defined($lastpicked) )2848{2849my$filepipe=open(FILELIST,'-|','git-diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2850local($/) ="\0";2851while( <FILELIST> )2852{2853chomp;2854unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)2855{2856die("Couldn't process git-diff-tree line :$_");2857}2858my($mode,$hash,$change) = ($1,$2,$3);2859my$name= <FILELIST>;2860chomp($name);28612862# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");28632864my$git_perms="";2865$git_perms.="r"if($mode&4);2866$git_perms.="w"if($mode&2);2867$git_perms.="x"if($mode&1);2868$git_perms="rw"if($git_permseq"");28692870if($changeeq"D")2871{2872#$log->debug("DELETE $name");2873$head->{$name} = {2874 name =>$name,2875 revision =>$head->{$name}{revision} +1,2876 filehash =>"deleted",2877 commithash =>$commit->{hash},2878 modified =>$commit->{date},2879 author =>$commit->{author},2880 mode =>$git_perms,2881};2882$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2883}2884elsif($changeeq"M"||$changeeq"T")2885{2886#$log->debug("MODIFIED $name");2887$head->{$name} = {2888 name =>$name,2889 revision =>$head->{$name}{revision} +1,2890 filehash =>$hash,2891 commithash =>$commit->{hash},2892 modified =>$commit->{date},2893 author =>$commit->{author},2894 mode =>$git_perms,2895};2896$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2897}2898elsif($changeeq"A")2899{2900#$log->debug("ADDED $name");2901$head->{$name} = {2902 name =>$name,2903 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,2904 filehash =>$hash,2905 commithash =>$commit->{hash},2906 modified =>$commit->{date},2907 author =>$commit->{author},2908 mode =>$git_perms,2909};2910$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2911}2912else2913{2914$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");2915die;2916}2917}2918close FILELIST;2919}else{2920# this is used to detect files removed from the repo2921my$seen_files= {};29222923my$filepipe=open(FILELIST,'-|','git-ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2924local$/="\0";2925while( <FILELIST> )2926{2927chomp;2928unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)2929{2930die("Couldn't process git-ls-tree line :$_");2931}29322933my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);29342935$seen_files->{$git_filename} =1;29362937my($oldhash,$oldrevision,$oldmode) = (2938$head->{$git_filename}{filehash},2939$head->{$git_filename}{revision},2940$head->{$git_filename}{mode}2941);29422943if($git_perms=~/^\d\d\d(\d)\d\d/o)2944{2945$git_perms="";2946$git_perms.="r"if($1&4);2947$git_perms.="w"if($1&2);2948$git_perms.="x"if($1&1);2949}else{2950$git_perms="rw";2951}29522953# unless the file exists with the same hash, we need to update it ...2954unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2955{2956my$newrevision= ($oldrevisionor0) +1;29572958$head->{$git_filename} = {2959 name =>$git_filename,2960 revision =>$newrevision,2961 filehash =>$git_hash,2962 commithash =>$commit->{hash},2963 modified =>$commit->{date},2964 author =>$commit->{author},2965 mode =>$git_perms,2966};296729682969$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2970}2971}2972close FILELIST;29732974# Detect deleted files2975foreachmy$file(keys%$head)2976{2977unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2978{2979$head->{$file}{revision}++;2980$head->{$file}{filehash} ="deleted";2981$head->{$file}{commithash} =$commit->{hash};2982$head->{$file}{modified} =$commit->{date};2983$head->{$file}{author} =$commit->{author};29842985$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2986}2987}2988# END : "Detect deleted files"2989}299029912992if(exists$commit->{mergemsg})2993{2994$self->insert_mergelog($commit->{hash},$commit->{mergemsg});2995}29962997$lastpicked=$commit->{hash};29982999$self->_set_prop("last_commit",$commit->{hash});3000}30013002$self->delete_head();3003foreachmy$file(keys%$head)3004{3005$self->insert_head(3006$file,3007$head->{$file}{revision},3008$head->{$file}{filehash},3009$head->{$file}{commithash},3010$head->{$file}{modified},3011$head->{$file}{author},3012$head->{$file}{mode},3013);3014}3015# invalidate the gethead cache3016$self->{gethead_cache} =undef;301730183019# Ending exclusive lock here3020$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3021}30223023sub insert_rev3024{3025my$self=shift;3026my$name=shift;3027my$revision=shift;3028my$filehash=shift;3029my$commithash=shift;3030my$modified=shift;3031my$author=shift;3032my$mode=shift;3033my$tablename=$self->tablename("revision");30343035my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3036$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3037}30383039sub insert_mergelog3040{3041my$self=shift;3042my$key=shift;3043my$value=shift;3044my$tablename=$self->tablename("commitmsgs");30453046my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3047$insert_mergelog->execute($key,$value);3048}30493050sub delete_head3051{3052my$self=shift;3053my$tablename=$self->tablename("head");30543055my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3056$delete_head->execute();3057}30583059sub insert_head3060{3061my$self=shift;3062my$name=shift;3063my$revision=shift;3064my$filehash=shift;3065my$commithash=shift;3066my$modified=shift;3067my$author=shift;3068my$mode=shift;3069my$tablename=$self->tablename("head");30703071my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3072$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3073}30743075sub _headrev3076{3077my$self=shift;3078my$filename=shift;3079my$tablename=$self->tablename("head");30803081my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM$tablenameWHERE name=?",{},1);3082$db_query->execute($filename);3083my($hash,$revision,$mode) =$db_query->fetchrow_array;30843085return($hash,$revision,$mode);3086}30873088sub _get_prop3089{3090my$self=shift;3091my$key=shift;3092my$tablename=$self->tablename("properties");30933094my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3095$db_query->execute($key);3096my($value) =$db_query->fetchrow_array;30973098return$value;3099}31003101sub _set_prop3102{3103my$self=shift;3104my$key=shift;3105my$value=shift;3106my$tablename=$self->tablename("properties");31073108my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3109$db_query->execute($value,$key);31103111unless($db_query->rows)3112{3113$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3114$db_query->execute($key,$value);3115}31163117return$value;3118}31193120=head2 gethead31213122=cut31233124sub gethead3125{3126my$self=shift;3127my$tablename=$self->tablename("head");31283129return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );31303131my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3132$db_query->execute();31333134my$tree= [];3135while(my$file=$db_query->fetchrow_hashref)3136{3137push@$tree,$file;3138}31393140$self->{gethead_cache} =$tree;31413142return$tree;3143}31443145=head2 getlog31463147=cut31483149sub getlog3150{3151my$self=shift;3152my$filename=shift;3153my$tablename=$self->tablename("revision");31543155my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3156$db_query->execute($filename);31573158my$tree= [];3159while(my$file=$db_query->fetchrow_hashref)3160{3161push@$tree,$file;3162}31633164return$tree;3165}31663167=head2 getmeta31683169This function takes a filename (with path) argument and returns a hashref of3170metadata for that file.31713172=cut31733174sub getmeta3175{3176my$self=shift;3177my$filename=shift;3178my$revision=shift;3179my$tablename_rev=$self->tablename("revision");3180my$tablename_head=$self->tablename("head");31813182my$db_query;3183if(defined($revision)and$revision=~/^\d+$/)3184{3185$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND revision=?",{},1);3186$db_query->execute($filename,$revision);3187}3188elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)3189{3190$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_revWHERE name=? AND commithash=?",{},1);3191$db_query->execute($filename,$revision);3192}else{3193$db_query=$self->{dbh}->prepare_cached("SELECT * FROM$tablename_headWHERE name=?",{},1);3194$db_query->execute($filename);3195}31963197return$db_query->fetchrow_hashref;3198}31993200=head2 commitmessage32013202this function takes a commithash and returns the commit message for that commit32033204=cut3205sub commitmessage3206{3207my$self=shift;3208my$commithash=shift;3209my$tablename=$self->tablename("commitmsgs");32103211die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);32123213my$db_query;3214$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3215$db_query->execute($commithash);32163217my($message) =$db_query->fetchrow_array;32183219if(defined($message) )3220{3221$message.=" "if($message=~/\n$/);3222return$message;3223}32243225my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);3226shift@lineswhile($lines[0] =~/\S/);3227$message=join("",@lines);3228$message.=" "if($message=~/\n$/);3229return$message;3230}32313232=head2 gethistory32333234This function takes a filename (with path) argument and returns an arrayofarrays3235containing revision,filehash,commithash ordered by revision descending32363237=cut3238sub gethistory3239{3240my$self=shift;3241my$filename=shift;3242my$tablename=$self->tablename("revision");32433244my$db_query;3245$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);3246$db_query->execute($filename);32473248return$db_query->fetchall_arrayref;3249}32503251=head2 gethistorydense32523253This function takes a filename (with path) argument and returns an arrayofarrays3254containing revision,filehash,commithash ordered by revision descending.32553256This version of gethistory skips deleted entries -- so it is useful for annotate.3257The 'dense' part is a reference to a '--dense' option available for git-rev-list3258and other git tools that depend on it.32593260=cut3261sub gethistorydense3262{3263my$self=shift;3264my$filename=shift;3265my$tablename=$self->tablename("revision");32663267my$db_query;3268$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);3269$db_query->execute($filename);32703271return$db_query->fetchall_arrayref;3272}32733274=head2 in_array()32753276from Array::PAT - mimics the in_array() function3277found in PHP. Yuck but works for small arrays.32783279=cut3280sub in_array3281{3282my($check,@array) =@_;3283my$retval=0;3284foreachmy$test(@array){3285if($checkeq$test){3286$retval=1;3287}3288}3289return$retval;3290}32913292=head2 safe_pipe_capture32933294an alternative to `command` that allows input to be passed as an array3295to work around shell problems with weird characters in arguments32963297=cut3298sub safe_pipe_capture {32993300my@output;33013302if(my$pid=open my$child,'-|') {3303@output= (<$child>);3304close$childor die join(' ',@_).":$!$?";3305}else{3306exec(@_)or die"$!$?";# exec() can fail the executable can't be found3307}3308returnwantarray?@output:join('',@output);3309}33103311=head2 mangle_dirname33123313create a string from a directory name that is suitable to use as3314part of a filename, mainly by converting all chars except \w.- to _33153316=cut3317sub mangle_dirname {3318my$dirname=shift;3319return unlessdefined$dirname;33203321$dirname=~s/[^\w.-]/_/g;33223323return$dirname;3324}33253326=head2 mangle_tablename33273328create a string from a that is suitable to use as part of an SQL table3329name, mainly by converting all chars except \w to _33303331=cut3332sub mangle_tablename {3333my$tablename=shift;3334return unlessdefined$tablename;33353336$tablename=~s/[^\w_]/_/g;33373338return$tablename;3339}334033411;