1#!/usr/bin/perl 2 3#### 4#### This application is a CVS emulation layer for git. 5#### It is intended for clients to connect over SSH. 6#### See the documentation for more details. 7#### 8#### Copyright The Open University UK - 2006. 9#### 10#### Authors: Martyn Smith <martyn@catalyst.net.nz> 11#### Martin Langhoff <martin@catalyst.net.nz> 12#### 13#### 14#### Released under the GNU Public License, version 2. 15#### 16#### 17 18use strict; 19use warnings; 20use bytes; 21 22use Fcntl; 23use File::Temp qw/tempdir tempfile/; 24use File::Basename; 25 26my$log= GITCVS::log->new(); 27my$cfg; 28 29my$DATE_LIST= { 30 Jan =>"01", 31 Feb =>"02", 32 Mar =>"03", 33 Apr =>"04", 34 May =>"05", 35 Jun =>"06", 36 Jul =>"07", 37 Aug =>"08", 38 Sep =>"09", 39 Oct =>"10", 40 Nov =>"11", 41 Dec =>"12", 42}; 43 44# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 45$| =1; 46 47#### Definition and mappings of functions #### 48 49my$methods= { 50'Root'=> \&req_Root, 51'Valid-responses'=> \&req_Validresponses, 52'valid-requests'=> \&req_validrequests, 53'Directory'=> \&req_Directory, 54'Entry'=> \&req_Entry, 55'Modified'=> \&req_Modified, 56'Unchanged'=> \&req_Unchanged, 57'Questionable'=> \&req_Questionable, 58'Argument'=> \&req_Argument, 59'Argumentx'=> \&req_Argument, 60'expand-modules'=> \&req_expandmodules, 61'add'=> \&req_add, 62'remove'=> \&req_remove, 63'co'=> \&req_co, 64'update'=> \&req_update, 65'ci'=> \&req_ci, 66'diff'=> \&req_diff, 67'log'=> \&req_log, 68'rlog'=> \&req_log, 69'tag'=> \&req_CATCHALL, 70'status'=> \&req_status, 71'admin'=> \&req_CATCHALL, 72'history'=> \&req_CATCHALL, 73'watchers'=> \&req_CATCHALL, 74'editors'=> \&req_CATCHALL, 75'annotate'=> \&req_annotate, 76'Global_option'=> \&req_Globaloption, 77#'annotate' => \&req_CATCHALL, 78}; 79 80############################################## 81 82 83# $state holds all the bits of information the clients sends us that could 84# potentially be useful when it comes to actually _doing_ something. 85my$state= { prependdir =>''}; 86$log->info("--------------- STARTING -----------------"); 87 88my$TEMP_DIR= tempdir( CLEANUP =>1); 89$log->debug("Temporary directory is '$TEMP_DIR'"); 90 91# if we are called with a pserver argument, 92# deal with the authentication cat before entering the 93# main loop 94if(@ARGV&&$ARGV[0]eq'pserver') { 95my$line= <STDIN>;chomp$line; 96unless($lineeq'BEGIN AUTH REQUEST') { 97die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 98} 99$line= <STDIN>;chomp$line; 100 req_Root('root',$line)# reuse Root 101or die"E Invalid root$line\n"; 102$line= <STDIN>;chomp$line; 103unless($lineeq'anonymous') { 104print"E Only anonymous user allowed via pserver\n"; 105print"I HATE YOU\n"; 106} 107$line= <STDIN>;chomp$line;# validate the password? 108$line= <STDIN>;chomp$line; 109unless($lineeq'END AUTH REQUEST') { 110die"E Do not understand$line-- expecting END AUTH REQUEST\n"; 111} 112print"I LOVE YOU\n"; 113# and now back to our regular programme... 114} 115 116# Keep going until the client closes the connection 117while(<STDIN>) 118{ 119chomp; 120 121# Check to see if we've seen this method, and call appropriate function. 122if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 123{ 124# use the $methods hash to call the appropriate sub for this command 125#$log->info("Method : $1"); 126&{$methods->{$1}}($1,$2); 127}else{ 128# log fatal because we don't understand this function. If this happens 129# we're fairly screwed because we don't know if the client is expecting 130# a response. If it is, the client will hang, we'll hang, and the whole 131# thing will be custard. 132$log->fatal("Don't understand command$_\n"); 133die("Unknown command$_"); 134} 135} 136 137$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 138$log->info("--------------- FINISH -----------------"); 139 140# Magic catchall method. 141# This is the method that will handle all commands we haven't yet 142# implemented. It simply sends a warning to the log file indicating a 143# command that hasn't been implemented has been invoked. 144sub req_CATCHALL 145{ 146my($cmd,$data) =@_; 147$log->warn("Unhandled command : req_$cmd:$data"); 148} 149 150 151# Root pathname \n 152# Response expected: no. Tell the server which CVSROOT to use. Note that 153# pathname is a local directory and not a fully qualified CVSROOT variable. 154# pathname must already exist; if creating a new root, use the init 155# request, not Root. pathname does not include the hostname of the server, 156# how to access the server, etc.; by the time the CVS protocol is in use, 157# connection, authentication, etc., are already taken care of. The Root 158# request must be sent only once, and it must be sent before any requests 159# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 160sub req_Root 161{ 162my($cmd,$data) =@_; 163$log->debug("req_Root :$data"); 164 165$state->{CVSROOT} =$data; 166 167$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 168unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 169print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 170print"E\n"; 171print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 172return0; 173} 174 175my@gitvars=`git-config -l`; 176if($?) { 177print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 178print"E\n"; 179print"error 1 - problem executing git-config\n"; 180return0; 181} 182foreachmy$line(@gitvars) 183{ 184next unless($line=~/^(.*?)\.(.*?)=(.*)$/); 185$cfg->{$1}{$2} =$3; 186} 187 188unless(defined($cfg->{gitcvs}{enabled} )and$cfg->{gitcvs}{enabled} =~/^\s*(1|true|yes)\s*$/i) 189{ 190print"E GITCVS emulation needs to be enabled on this repo\n"; 191print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 192print"E\n"; 193print"error 1 GITCVS emulation disabled\n"; 194return0; 195} 196 197if(defined($cfg->{gitcvs}{logfile} ) ) 198{ 199$log->setfile($cfg->{gitcvs}{logfile}); 200}else{ 201$log->nofile(); 202} 203 204return1; 205} 206 207# Global_option option \n 208# Response expected: no. Transmit one of the global options `-q', `-Q', 209# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 210# variations (such as combining of options) are allowed. For graceful 211# handling of valid-requests, it is probably better to make new global 212# options separate requests, rather than trying to add them to this 213# request. 214sub req_Globaloption 215{ 216my($cmd,$data) =@_; 217$log->debug("req_Globaloption :$data"); 218$state->{globaloptions}{$data} =1; 219} 220 221# Valid-responses request-list \n 222# Response expected: no. Tell the server what responses the client will 223# accept. request-list is a space separated list of tokens. 224sub req_Validresponses 225{ 226my($cmd,$data) =@_; 227$log->debug("req_Validresponses :$data"); 228 229# TODO : re-enable this, currently it's not particularly useful 230#$state->{validresponses} = [ split /\s+/, $data ]; 231} 232 233# valid-requests \n 234# Response expected: yes. Ask the server to send back a Valid-requests 235# response. 236sub req_validrequests 237{ 238my($cmd,$data) =@_; 239 240$log->debug("req_validrequests"); 241 242$log->debug("SEND : Valid-requests ".join(" ",keys%$methods)); 243$log->debug("SEND : ok"); 244 245print"Valid-requests ".join(" ",keys%$methods) ."\n"; 246print"ok\n"; 247} 248 249# Directory local-directory \n 250# Additional data: repository \n. Response expected: no. Tell the server 251# what directory to use. The repository should be a directory name from a 252# previous server response. Note that this both gives a default for Entry 253# and Modified and also for ci and the other commands; normal usage is to 254# send Directory for each directory in which there will be an Entry or 255# Modified, and then a final Directory for the original directory, then the 256# command. The local-directory is relative to the top level at which the 257# command is occurring (i.e. the last Directory which is sent before the 258# command); to indicate that top level, `.' should be sent for 259# local-directory. 260sub req_Directory 261{ 262my($cmd,$data) =@_; 263 264my$repository= <STDIN>; 265chomp$repository; 266 267 268$state->{localdir} =$data; 269$state->{repository} =$repository; 270$state->{path} =$repository; 271$state->{path} =~s/^$state->{CVSROOT}\///; 272$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 273$state->{path} .="/"if($state->{path} =~ /\S/ ); 274 275$state->{directory} =$state->{localdir}; 276$state->{directory} =""if($state->{directory}eq"."); 277$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 278 279if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 280{ 281$log->info("Setting prepend to '$state->{path}'"); 282$state->{prependdir} =$state->{path}; 283foreachmy$entry(keys%{$state->{entries}} ) 284{ 285$state->{entries}{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 286delete$state->{entries}{$entry}; 287} 288} 289 290if(defined($state->{prependdir} ) ) 291{ 292$log->debug("Prepending '$state->{prependdir}' to state|directory"); 293$state->{directory} =$state->{prependdir} .$state->{directory} 294} 295$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 296} 297 298# Entry entry-line \n 299# Response expected: no. Tell the server what version of a file is on the 300# local machine. The name in entry-line is a name relative to the directory 301# most recently specified with Directory. If the user is operating on only 302# some files in a directory, Entry requests for only those files need be 303# included. If an Entry request is sent without Modified, Is-modified, or 304# Unchanged, it means the file is lost (does not exist in the working 305# directory). If both Entry and one of Modified, Is-modified, or Unchanged 306# are sent for the same file, Entry must be sent first. For a given file, 307# one can send Modified, Is-modified, or Unchanged, but not more than one 308# of these three. 309sub req_Entry 310{ 311my($cmd,$data) =@_; 312 313#$log->debug("req_Entry : $data"); 314 315my@data=split(/\//,$data); 316 317$state->{entries}{$state->{directory}.$data[1]} = { 318 revision =>$data[2], 319 conflict =>$data[3], 320 options =>$data[4], 321 tag_or_date =>$data[5], 322}; 323 324$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 325} 326 327# Questionable filename \n 328# Response expected: no. Additional data: no. Tell the server to check 329# whether filename should be ignored, and if not, next time the server 330# sends responses, send (in a M response) `?' followed by the directory and 331# filename. filename must not contain `/'; it needs to be a file in the 332# directory named by the most recent Directory request. 333sub req_Questionable 334{ 335my($cmd,$data) =@_; 336 337$log->debug("req_Questionable :$data"); 338$state->{entries}{$state->{directory}.$data}{questionable} =1; 339} 340 341# add \n 342# Response expected: yes. Add a file or directory. This uses any previous 343# Argument, Directory, Entry, or Modified requests, if they have been sent. 344# The last Directory sent specifies the working directory at the time of 345# the operation. To add a directory, send the directory to be added using 346# Directory and Argument requests. 347sub req_add 348{ 349my($cmd,$data) =@_; 350 351 argsplit("add"); 352 353my$addcount=0; 354 355foreachmy$filename( @{$state->{args}} ) 356{ 357$filename= filecleanup($filename); 358 359unless(defined($state->{entries}{$filename}{modified_filename} ) ) 360{ 361print"E cvs add: nothing known about `$filename'\n"; 362next; 363} 364# TODO : check we're not squashing an already existing file 365if(defined($state->{entries}{$filename}{revision} ) ) 366{ 367print"E cvs add: `$filename' has already been entered\n"; 368next; 369} 370 371my($filepart,$dirpart) = filenamesplit($filename,1); 372 373print"E cvs add: scheduling file `$filename' for addition\n"; 374 375print"Checked-in$dirpart\n"; 376print"$filename\n"; 377my$kopts= kopts_from_path($filepart); 378print"/$filepart/0//$kopts/\n"; 379 380$addcount++; 381} 382 383if($addcount==1) 384{ 385print"E cvs add: use `cvs commit' to add this file permanently\n"; 386} 387elsif($addcount>1) 388{ 389print"E cvs add: use `cvs commit' to add these files permanently\n"; 390} 391 392print"ok\n"; 393} 394 395# remove \n 396# Response expected: yes. Remove a file. This uses any previous Argument, 397# Directory, Entry, or Modified requests, if they have been sent. The last 398# Directory sent specifies the working directory at the time of the 399# operation. Note that this request does not actually do anything to the 400# repository; the only effect of a successful remove request is to supply 401# the client with a new entries line containing `-' to indicate a removed 402# file. In fact, the client probably could perform this operation without 403# contacting the server, although using remove may cause the server to 404# perform a few more checks. The client sends a subsequent ci request to 405# actually record the removal in the repository. 406sub req_remove 407{ 408my($cmd,$data) =@_; 409 410 argsplit("remove"); 411 412# Grab a handle to the SQLite db and do any necessary updates 413my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 414$updater->update(); 415 416#$log->debug("add state : " . Dumper($state)); 417 418my$rmcount=0; 419 420foreachmy$filename( @{$state->{args}} ) 421{ 422$filename= filecleanup($filename); 423 424if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 425{ 426print"E cvs remove: file `$filename' still in working directory\n"; 427next; 428} 429 430my$meta=$updater->getmeta($filename); 431my$wrev= revparse($filename); 432 433unless(defined($wrev) ) 434{ 435print"E cvs remove: nothing known about `$filename'\n"; 436next; 437} 438 439if(defined($wrev)and$wrev<0) 440{ 441print"E cvs remove: file `$filename' already scheduled for removal\n"; 442next; 443} 444 445unless($wrev==$meta->{revision} ) 446{ 447# TODO : not sure if the format of this message is quite correct. 448print"E cvs remove: Up to date check failed for `$filename'\n"; 449next; 450} 451 452 453my($filepart,$dirpart) = filenamesplit($filename,1); 454 455print"E cvs remove: scheduling `$filename' for removal\n"; 456 457print"Checked-in$dirpart\n"; 458print"$filename\n"; 459my$kopts= kopts_from_path($filepart); 460print"/$filepart/-1.$wrev//$kopts/\n"; 461 462$rmcount++; 463} 464 465if($rmcount==1) 466{ 467print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 468} 469elsif($rmcount>1) 470{ 471print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 472} 473 474print"ok\n"; 475} 476 477# Modified filename \n 478# Response expected: no. Additional data: mode, \n, file transmission. Send 479# the server a copy of one locally modified file. filename is a file within 480# the most recent directory sent with Directory; it must not contain `/'. 481# If the user is operating on only some files in a directory, only those 482# files need to be included. This can also be sent without Entry, if there 483# is no entry for the file. 484sub req_Modified 485{ 486my($cmd,$data) =@_; 487 488my$mode= <STDIN>; 489chomp$mode; 490my$size= <STDIN>; 491chomp$size; 492 493# Grab config information 494my$blocksize=8192; 495my$bytesleft=$size; 496my$tmp; 497 498# Get a filehandle/name to write it to 499my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 500 501# Loop over file data writing out to temporary file. 502while($bytesleft) 503{ 504$blocksize=$bytesleftif($bytesleft<$blocksize); 505read STDIN,$tmp,$blocksize; 506print$fh $tmp; 507$bytesleft-=$blocksize; 508} 509 510close$fh; 511 512# Ensure we have something sensible for the file mode 513if($mode=~/u=(\w+)/) 514{ 515$mode=$1; 516}else{ 517$mode="rw"; 518} 519 520# Save the file data in $state 521$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 522$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 523$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 524$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 525 526 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 527} 528 529# Unchanged filename\n 530# Response expected: no. Tell the server that filename has not been 531# modified in the checked out directory. The filename is a file within the 532# most recent directory sent with Directory; it must not contain `/'. 533sub req_Unchanged 534{ 535 my ($cmd,$data) =@_; 536 537$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 538 539 #$log->debug("req_Unchanged :$data"); 540} 541 542# Argument text\n 543# Response expected: no. Save argument for use in a subsequent command. 544# Arguments accumulate until an argument-using command is given, at which 545# point they are forgotten. 546# Argumentx text\n 547# Response expected: no. Append\nfollowed by text to the current argument 548# being saved. 549sub req_Argument 550{ 551 my ($cmd,$data) =@_; 552 553 # Argumentx means: append to last Argument (with a newline in front) 554 555$log->debug("$cmd:$data"); 556 557 if ($cmdeq 'Argumentx') { 558 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 559 } else { 560 push @{$state->{arguments}},$data; 561 } 562} 563 564# expand-modules\n 565# Response expected: yes. Expand the modules which are specified in the 566# arguments. Returns the data in Module-expansion responses. Note that the 567# server can assume that this is checkout or export, not rtag or rdiff; the 568# latter do not access the working directory and thus have no need to 569# expand modules on the client side. Expand may not be the best word for 570# what this request does. It does not necessarily tell you all the files 571# contained in a module, for example. Basically it is a way of telling you 572# which working directories the server needs to know about in order to 573# handle a checkout of the specified modules. For example, suppose that the 574# server has a module defined by 575# aliasmodule -a 1dir 576# That is, one can check out aliasmodule and it will take 1dir in the 577# repository and check it out to 1dir in the working directory. Now suppose 578# the client already has this module checked out and is planning on using 579# the co request to update it. Without using expand-modules, the client 580# would have two bad choices: it could either send information about all 581# working directories under the current directory, which could be 582# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 583# stands for 1dir, and neglect to send information for 1dir, which would 584# lead to incorrect operation. With expand-modules, the client would first 585# ask for the module to be expanded: 586sub req_expandmodules 587{ 588 my ($cmd,$data) =@_; 589 590 argsplit(); 591 592$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 593 594 unless ( ref$state->{arguments} eq "ARRAY" ) 595 { 596 print "ok\n"; 597 return; 598 } 599 600 foreach my$module( @{$state->{arguments}} ) 601 { 602$log->debug("SEND : Module-expansion$module"); 603 print "Module-expansion$module\n"; 604 } 605 606 print "ok\n"; 607 statecleanup(); 608} 609 610# co\n 611# Response expected: yes. Get files from the repository. This uses any 612# previous Argument, Directory, Entry, or Modified requests, if they have 613# been sent. Arguments to this command are module names; the client cannot 614# know what directories they correspond to except by (1) just sending the 615# co request, and then seeing what directory names the server sends back in 616# its responses, and (2) the expand-modules request. 617sub req_co 618{ 619 my ($cmd,$data) =@_; 620 621 argsplit("co"); 622 623 my$module=$state->{args}[0]; 624 my$checkout_path=$module; 625 626 # use the user specified directory if we're given it 627$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 628 629$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 630 631$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 632 633$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 634 635# Grab a handle to the SQLite db and do any necessary updates 636my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 637$updater->update(); 638 639$checkout_path=~ s|/$||;# get rid of trailing slashes 640 641# Eclipse seems to need the Clear-sticky command 642# to prepare the 'Entries' file for the new directory. 643print"Clear-sticky$checkout_path/\n"; 644print$state->{CVSROOT} ."/$module/\n"; 645print"Clear-static-directory$checkout_path/\n"; 646print$state->{CVSROOT} ."/$module/\n"; 647print"Clear-sticky$checkout_path/\n";# yes, twice 648print$state->{CVSROOT} ."/$module/\n"; 649print"Template$checkout_path/\n"; 650print$state->{CVSROOT} ."/$module/\n"; 651print"0\n"; 652 653# instruct the client that we're checking out to $checkout_path 654print"E cvs checkout: Updating$checkout_path\n"; 655 656my%seendirs= (); 657my$lastdir=''; 658 659# recursive 660sub prepdir { 661my($dir,$repodir,$remotedir,$seendirs) =@_; 662my$parent= dirname($dir); 663$dir=~ s|/+$||; 664$repodir=~ s|/+$||; 665$remotedir=~ s|/+$||; 666$parent=~ s|/+$||; 667$log->debug("announcedir$dir,$repodir,$remotedir"); 668 669if($parenteq'.'||$parenteq'./') { 670$parent=''; 671} 672# recurse to announce unseen parents first 673if(length($parent) && !exists($seendirs->{$parent})) { 674 prepdir($parent,$repodir,$remotedir,$seendirs); 675} 676# Announce that we are going to modify at the parent level 677if($parent) { 678print"E cvs checkout: Updating$remotedir/$parent\n"; 679}else{ 680print"E cvs checkout: Updating$remotedir\n"; 681} 682print"Clear-sticky$remotedir/$parent/\n"; 683print"$repodir/$parent/\n"; 684 685print"Clear-static-directory$remotedir/$dir/\n"; 686print"$repodir/$dir/\n"; 687print"Clear-sticky$remotedir/$parent/\n";# yes, twice 688print"$repodir/$parent/\n"; 689print"Template$remotedir/$dir/\n"; 690print"$repodir/$dir/\n"; 691print"0\n"; 692 693$seendirs->{$dir} =1; 694} 695 696foreachmy$git( @{$updater->gethead} ) 697{ 698# Don't want to check out deleted files 699next if($git->{filehash}eq"deleted"); 700 701($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 702 703if(length($git->{dir}) &&$git->{dir}ne'./' 704&&$git->{dir}ne$lastdir) { 705unless(exists($seendirs{$git->{dir}})) { 706 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 707$checkout_path, \%seendirs); 708$lastdir=$git->{dir}; 709$seendirs{$git->{dir}} =1; 710} 711print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 712} 713 714# modification time of this file 715print"Mod-time$git->{modified}\n"; 716 717# print some information to the client 718if(defined($git->{dir} )and$git->{dir}ne"./") 719{ 720print"M U$checkout_path/$git->{dir}$git->{name}\n"; 721}else{ 722print"M U$checkout_path/$git->{name}\n"; 723} 724 725# instruct client we're sending a file to put in this path 726print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 727 728print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 729 730# this is an "entries" line 731my$kopts= kopts_from_path($git->{name}); 732print"/$git->{name}/1.$git->{revision}//$kopts/\n"; 733# permissions 734print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 735 736# transmit file 737 transmitfile($git->{filehash}); 738} 739 740print"ok\n"; 741 742 statecleanup(); 743} 744 745# update \n 746# Response expected: yes. Actually do a cvs update command. This uses any 747# previous Argument, Directory, Entry, or Modified requests, if they have 748# been sent. The last Directory sent specifies the working directory at the 749# time of the operation. The -I option is not used--files which the client 750# can decide whether to ignore are not mentioned and the client sends the 751# Questionable request for others. 752sub req_update 753{ 754my($cmd,$data) =@_; 755 756$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 757 758 argsplit("update"); 759 760# 761# It may just be a client exploring the available heads/modules 762# in that case, list them as top level directories and leave it 763# at that. Eclipse uses this technique to offer you a list of 764# projects (heads in this case) to checkout. 765# 766if($state->{module}eq'') { 767print"E cvs update: Updating .\n"; 768opendir HEADS,$state->{CVSROOT} .'/refs/heads'; 769while(my$head=readdir(HEADS)) { 770if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 771print"E cvs update: New directory `$head'\n"; 772} 773} 774closedir HEADS; 775print"ok\n"; 776return1; 777} 778 779 780# Grab a handle to the SQLite db and do any necessary updates 781my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 782 783$updater->update(); 784 785 argsfromdir($updater); 786 787#$log->debug("update state : " . Dumper($state)); 788 789# foreach file specified on the command line ... 790foreachmy$filename( @{$state->{args}} ) 791{ 792$filename= filecleanup($filename); 793 794$log->debug("Processing file$filename"); 795 796# if we have a -C we should pretend we never saw modified stuff 797if(exists($state->{opt}{C} ) ) 798{ 799delete$state->{entries}{$filename}{modified_hash}; 800delete$state->{entries}{$filename}{modified_filename}; 801$state->{entries}{$filename}{unchanged} =1; 802} 803 804my$meta; 805if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 806{ 807$meta=$updater->getmeta($filename,$1); 808}else{ 809$meta=$updater->getmeta($filename); 810} 811 812if( !defined$meta) 813{ 814$meta= { 815 name =>$filename, 816 revision =>0, 817 filehash =>'added' 818}; 819} 820 821my$oldmeta=$meta; 822 823my$wrev= revparse($filename); 824 825# If the working copy is an old revision, lets get that version too for comparison. 826if(defined($wrev)and$wrev!=$meta->{revision} ) 827{ 828$oldmeta=$updater->getmeta($filename,$wrev); 829} 830 831#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 832 833# Files are up to date if the working copy and repo copy have the same revision, 834# and the working copy is unmodified _and_ the user hasn't specified -C 835next if(defined($wrev) 836and defined($meta->{revision}) 837and$wrev==$meta->{revision} 838and$state->{entries}{$filename}{unchanged} 839and not exists($state->{opt}{C} ) ); 840 841# If the working copy and repo copy have the same revision, 842# but the working copy is modified, tell the client it's modified 843if(defined($wrev) 844and defined($meta->{revision}) 845and$wrev==$meta->{revision} 846and not exists($state->{opt}{C} ) ) 847{ 848$log->info("Tell the client the file is modified"); 849print"MT text M\n"; 850print"MT fname$filename\n"; 851print"MT newline\n"; 852next; 853} 854 855if($meta->{filehash}eq"deleted") 856{ 857my($filepart,$dirpart) = filenamesplit($filename,1); 858 859$log->info("Removing '$filename' from working copy (no longer in the repo)"); 860 861print"E cvs update: `$filename' is no longer in the repository\n"; 862# Don't want to actually _DO_ the update if -n specified 863unless($state->{globaloptions}{-n} ) { 864print"Removed$dirpart\n"; 865print"$filepart\n"; 866} 867} 868elsif(not defined($state->{entries}{$filename}{modified_hash} ) 869or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} 870or$meta->{filehash}eq'added') 871{ 872# normal update, just send the new revision (either U=Update, 873# or A=Add, or R=Remove) 874if(defined($wrev) &&$wrev<0) 875{ 876$log->info("Tell the client the file is scheduled for removal"); 877print"MT text R\n"; 878print"MT fname$filename\n"; 879print"MT newline\n"; 880next; 881} 882elsif( (!defined($wrev) ||$wrev==0) && (!defined($meta->{revision}) ||$meta->{revision} ==0) ) 883{ 884$log->info("Tell the client the file is scheduled for addition"); 885print"MT text A\n"; 886print"MT fname$filename\n"; 887print"MT newline\n"; 888next; 889 890} 891else{ 892$log->info("Updating '$filename' to ".$meta->{revision}); 893print"MT +updated\n"; 894print"MT text U\n"; 895print"MT fname$filename\n"; 896print"MT newline\n"; 897print"MT -updated\n"; 898} 899 900my($filepart,$dirpart) = filenamesplit($filename,1); 901 902# Don't want to actually _DO_ the update if -n specified 903unless($state->{globaloptions}{-n} ) 904{ 905if(defined($wrev) ) 906{ 907# instruct client we're sending a file to put in this path as a replacement 908print"Update-existing$dirpart\n"; 909$log->debug("Updating existing file 'Update-existing$dirpart'"); 910}else{ 911# instruct client we're sending a file to put in this path as a new file 912print"Clear-static-directory$dirpart\n"; 913print$state->{CVSROOT} ."/$state->{module}/$dirpart\n"; 914print"Clear-sticky$dirpart\n"; 915print$state->{CVSROOT} ."/$state->{module}/$dirpart\n"; 916 917$log->debug("Creating new file 'Created$dirpart'"); 918print"Created$dirpart\n"; 919} 920print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 921 922# this is an "entries" line 923my$kopts= kopts_from_path($filepart); 924$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 925print"/$filepart/1.$meta->{revision}//$kopts/\n"; 926 927# permissions 928$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 929print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 930 931# transmit file 932 transmitfile($meta->{filehash}); 933} 934}else{ 935$log->info("Updating '$filename'"); 936my($filepart,$dirpart) = filenamesplit($meta->{name},1); 937 938my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 939 940chdir$dir; 941my$file_local=$filepart.".mine"; 942system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 943my$file_old=$filepart.".".$oldmeta->{revision}; 944 transmitfile($oldmeta->{filehash},$file_old); 945my$file_new=$filepart.".".$meta->{revision}; 946 transmitfile($meta->{filehash},$file_new); 947 948# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 949$log->info("Merging$file_local,$file_old,$file_new"); 950 951$log->debug("Temporary directory for merge is$dir"); 952 953my$return=system("git","merge-file",$file_local,$file_old,$file_new); 954$return>>=8; 955 956if($return==0) 957{ 958$log->info("Merged successfully"); 959print"M M$filename\n"; 960$log->debug("Merged$dirpart"); 961 962# Don't want to actually _DO_ the update if -n specified 963unless($state->{globaloptions}{-n} ) 964{ 965print"Merged$dirpart\n"; 966$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 967print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 968my$kopts= kopts_from_path($filepart); 969$log->debug("/$filepart/1.$meta->{revision}//$kopts/"); 970print"/$filepart/1.$meta->{revision}//$kopts/\n"; 971} 972} 973elsif($return==1) 974{ 975$log->info("Merged with conflicts"); 976print"M C$filename\n"; 977 978# Don't want to actually _DO_ the update if -n specified 979unless($state->{globaloptions}{-n} ) 980{ 981print"Merged$dirpart\n"; 982print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 983my$kopts= kopts_from_path($filepart); 984print"/$filepart/1.$meta->{revision}/+/$kopts/\n"; 985} 986} 987else 988{ 989$log->warn("Merge failed"); 990next; 991} 992 993# Don't want to actually _DO_ the update if -n specified 994unless($state->{globaloptions}{-n} ) 995{ 996# permissions 997$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 998print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 9991000# transmit file, format is single integer on a line by itself (file1001# size) followed by the file contents1002# TODO : we should copy files in blocks1003my$data=`cat$file_local`;1004$log->debug("File size : " . length($data));1005 print length($data) . "\n";1006 print$data;1007 }10081009 chdir "/";1010 }10111012 }10131014 print "ok\n";1015}10161017sub req_ci1018{1019 my ($cmd,$data) =@_;10201021 argsplit("ci");10221023 #$log->debug("State : " . Dumper($state));10241025$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));10261027 if (@ARGV&&$ARGV[0] eq 'pserver')1028 {1029 print "error 1 pserver access cannot commit\n";1030 exit;1031 }10321033 if ( -e$state->{CVSROOT} . "/index" )1034 {1035$log->warn("file 'index' already exists in the git repository");1036 print "error 1 Index already exists in git repo\n";1037 exit;1038 }10391040 # Grab a handle to the SQLite db and do any necessary updates1041 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1042$updater->update();10431044 my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1045 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 );1046$log->info("Lockless commit start, basing commit on '$tmpdir', index file is '$file_index'");10471048$ENV{GIT_DIR} =$state->{CVSROOT} . "/";1049$ENV{GIT_INDEX_FILE} =$file_index;10501051 # Remember where the head was at the beginning.1052 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1053 chomp$parenthash;1054 if ($parenthash!~ /^[0-9a-f]{40}$/) {1055 print "error 1 pserver cannot find the current HEAD of module";1056 exit;1057 }10581059 chdir$tmpdir;10601061 # populate the temporary index based1062 system("git-read-tree",$parenthash);1063 unless ($?== 0)1064 {1065 die "Error running git-read-tree$state->{module}$file_index$!";1066 }1067$log->info("Created index '$file_index' with for head$state->{module} - exit status$?");10681069 my@committedfiles= ();10701071 # foreach file specified on the command line ...1072 foreach my$filename( @{$state->{args}} )1073 {1074 my$committedfile=$filename;1075$filename= filecleanup($filename);10761077 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );10781079 my$meta=$updater->getmeta($filename);10801081 my$wrev= revparse($filename);10821083 my ($filepart,$dirpart) = filenamesplit($filename);10841085 # do a checkout of the file if it part of this tree1086 if ($wrev) {1087 system('git-checkout-index', '-f', '-u',$filename);1088 unless ($?== 0) {1089 die "Error running git-checkout-index -f -u$filename:$!";1090 }1091 }10921093 my$addflag= 0;1094 my$rmflag= 0;1095$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1096$addflag= 1 unless ( -e$filename);10971098 # Do up to date checking1099 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1100 {1101 # fail everything if an up to date check fails1102 print "error 1 Up to date check failed for$filename\n";1103 chdir "/";1104 exit;1105 }11061107 push@committedfiles,$committedfile;1108$log->info("Committing$filename");11091110 system("mkdir","-p",$dirpart) unless ( -d$dirpart);11111112 unless ($rmflag)1113 {1114$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1115 rename$state->{entries}{$filename}{modified_filename},$filename;11161117 # Calculate modes to remove1118 my$invmode= "";1119 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }11201121$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1122 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1123 }11241125 if ($rmflag)1126 {1127$log->info("Removing file '$filename'");1128 unlink($filename);1129 system("git-update-index", "--remove",$filename);1130 }1131 elsif ($addflag)1132 {1133$log->info("Adding file '$filename'");1134 system("git-update-index", "--add",$filename);1135 } else {1136$log->info("Updating file '$filename'");1137 system("git-update-index",$filename);1138 }1139 }11401141 unless ( scalar(@committedfiles) > 0 )1142 {1143 print "E No files to commit\n";1144 print "ok\n";1145 chdir "/";1146 return;1147 }11481149 my$treehash= `git-write-tree`;1150 chomp$treehash;11511152$log->debug("Treehash :$treehash, Parenthash :$parenthash");11531154 # write our commit message out if we have one ...1155 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1156 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1157 print$msg_fh"\n\nvia git-CVS emulator\n";1158 close$msg_fh;11591160 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;1161chomp($commithash);1162$log->info("Commit hash :$commithash");11631164unless($commithash=~/[a-zA-Z0-9]{40}/)1165{1166$log->warn("Commit failed (Invalid commit hash)");1167print"error 1 Commit failed (unknown reason)\n";1168chdir"/";1169exit;1170}11711172# Check that this is allowed, just as we would with a receive-pack1173my@cmd= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1174$parenthash,$commithash);1175if( -x $cmd[0] ) {1176unless(system(@cmd) ==0)1177{1178$log->warn("Commit failed (update hook declined to update ref)");1179print"error 1 Commit failed (update hook declined)\n";1180chdir"/";1181exit;1182}1183}11841185if(system(qw(git update-ref -m),"cvsserver ci",1186"refs/heads/$state->{module}",$commithash,$parenthash)) {1187$log->warn("update-ref for$state->{module} failed.");1188print"error 1 Cannot commit -- update first\n";1189exit;1190}11911192$updater->update();11931194# foreach file specified on the command line ...1195foreachmy$filename(@committedfiles)1196{1197$filename= filecleanup($filename);11981199my$meta=$updater->getmeta($filename);1200unless(defined$meta->{revision}) {1201$meta->{revision} =1;1202}12031204my($filepart,$dirpart) = filenamesplit($filename,1);12051206$log->debug("Checked-in$dirpart:$filename");12071208if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1209{1210print"Remove-entry$dirpart\n";1211print"$filename\n";1212}else{1213print"Checked-in$dirpart\n";1214print"$filename\n";1215my$kopts= kopts_from_path($filepart);1216print"/$filepart/1.$meta->{revision}//$kopts/\n";1217}1218}12191220chdir"/";1221print"ok\n";1222}12231224sub req_status1225{1226my($cmd,$data) =@_;12271228 argsplit("status");12291230$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1231#$log->debug("status state : " . Dumper($state));12321233# Grab a handle to the SQLite db and do any necessary updates1234my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1235$updater->update();12361237# if no files were specified, we need to work out what files we should be providing status on ...1238 argsfromdir($updater);12391240# foreach file specified on the command line ...1241foreachmy$filename( @{$state->{args}} )1242{1243$filename= filecleanup($filename);12441245my$meta=$updater->getmeta($filename);1246my$oldmeta=$meta;12471248my$wrev= revparse($filename);12491250# If the working copy is an old revision, lets get that version too for comparison.1251if(defined($wrev)and$wrev!=$meta->{revision} )1252{1253$oldmeta=$updater->getmeta($filename,$wrev);1254}12551256# TODO : All possible statuses aren't yet implemented1257my$status;1258# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1259$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1260and1261( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1262or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1263);12641265# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1266$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1267and1268($state->{entries}{$filename}{unchanged}1269or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1270);12711272# Need checkout if it exists in the repo but doesn't have a working copy1273$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );12741275# Locally modified if working copy and repo copy have the same revision but there are local changes1276$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );12771278# Needs Merge if working copy revision is less than repo copy and there are local changes1279$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );12801281$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1282$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1283$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1284$status||="File had conflicts on merge"if(0);12851286$status||="Unknown";12871288print"M ===================================================================\n";1289print"M File:$filename\tStatus:$status\n";1290if(defined($state->{entries}{$filename}{revision}) )1291{1292print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1293}else{1294print"M Working revision:\tNo entry for$filename\n";1295}1296if(defined($meta->{revision}) )1297{1298print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1299print"M Sticky Tag:\t\t(none)\n";1300print"M Sticky Date:\t\t(none)\n";1301print"M Sticky Options:\t\t(none)\n";1302}else{1303print"M Repository revision:\tNo revision control file\n";1304}1305print"M\n";1306}13071308print"ok\n";1309}13101311sub req_diff1312{1313my($cmd,$data) =@_;13141315 argsplit("diff");13161317$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1318#$log->debug("status state : " . Dumper($state));13191320my($revision1,$revision2);1321if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1322{1323$revision1=$state->{opt}{r}[0];1324$revision2=$state->{opt}{r}[1];1325}else{1326$revision1=$state->{opt}{r};1327}13281329$revision1=~s/^1\.//if(defined($revision1) );1330$revision2=~s/^1\.//if(defined($revision2) );13311332$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );13331334# Grab a handle to the SQLite db and do any necessary updates1335my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1336$updater->update();13371338# if no files were specified, we need to work out what files we should be providing status on ...1339 argsfromdir($updater);13401341# foreach file specified on the command line ...1342foreachmy$filename( @{$state->{args}} )1343{1344$filename= filecleanup($filename);13451346my($fh,$file1,$file2,$meta1,$meta2,$filediff);13471348my$wrev= revparse($filename);13491350# We need _something_ to diff against1351next unless(defined($wrev) );13521353# if we have a -r switch, use it1354if(defined($revision1) )1355{1356(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1357$meta1=$updater->getmeta($filename,$revision1);1358unless(defined($meta1)and$meta1->{filehash}ne"deleted")1359{1360print"E File$filenameat revision 1.$revision1doesn't exist\n";1361next;1362}1363 transmitfile($meta1->{filehash},$file1);1364}1365# otherwise we just use the working copy revision1366else1367{1368(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1369$meta1=$updater->getmeta($filename,$wrev);1370 transmitfile($meta1->{filehash},$file1);1371}13721373# if we have a second -r switch, use it too1374if(defined($revision2) )1375{1376(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1377$meta2=$updater->getmeta($filename,$revision2);13781379unless(defined($meta2)and$meta2->{filehash}ne"deleted")1380{1381print"E File$filenameat revision 1.$revision2doesn't exist\n";1382next;1383}13841385 transmitfile($meta2->{filehash},$file2);1386}1387# otherwise we just use the working copy1388else1389{1390$file2=$state->{entries}{$filename}{modified_filename};1391}13921393# if we have been given -r, and we don't have a $file2 yet, lets get one1394if(defined($revision1)and not defined($file2) )1395{1396(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1397$meta2=$updater->getmeta($filename,$wrev);1398 transmitfile($meta2->{filehash},$file2);1399}14001401# We need to have retrieved something useful1402next unless(defined($meta1) );14031404# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1405next if(not defined($meta2)and$wrev==$meta1->{revision}1406and1407( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1408or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1409);14101411# Apparently we only show diffs for locally modified files1412next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );14131414print"M Index:$filename\n";1415print"M ===================================================================\n";1416print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1417print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1418print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1419print"M diff ";1420foreachmy$opt(keys%{$state->{opt}} )1421{1422if(ref$state->{opt}{$opt}eq"ARRAY")1423{1424foreachmy$value( @{$state->{opt}{$opt}} )1425{1426print"-$opt$value";1427}1428}else{1429print"-$opt";1430print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1431}1432}1433print"$filename\n";14341435$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));14361437($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);14381439if(exists$state->{opt}{u} )1440{1441system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1442}else{1443system("diff$file1$file2>$filediff");1444}14451446while( <$fh> )1447{1448print"M$_";1449}1450close$fh;1451}14521453print"ok\n";1454}14551456sub req_log1457{1458my($cmd,$data) =@_;14591460 argsplit("log");14611462$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1463#$log->debug("log state : " . Dumper($state));14641465my($minrev,$maxrev);1466if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1467{1468my$control=$2;1469$minrev=$1;1470$maxrev=$3;1471$minrev=~s/^1\.//if(defined($minrev) );1472$maxrev=~s/^1\.//if(defined($maxrev) );1473$minrev++if(defined($minrev)and$controleq"::");1474}14751476# Grab a handle to the SQLite db and do any necessary updates1477my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1478$updater->update();14791480# if no files were specified, we need to work out what files we should be providing status on ...1481 argsfromdir($updater);14821483# foreach file specified on the command line ...1484foreachmy$filename( @{$state->{args}} )1485{1486$filename= filecleanup($filename);14871488my$headmeta=$updater->getmeta($filename);14891490my$revisions=$updater->getlog($filename);1491my$totalrevisions=scalar(@$revisions);14921493if(defined($minrev) )1494{1495$log->debug("Removing revisions less than$minrev");1496while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1497{1498pop@$revisions;1499}1500}1501if(defined($maxrev) )1502{1503$log->debug("Removing revisions greater than$maxrev");1504while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1505{1506shift@$revisions;1507}1508}15091510next unless(scalar(@$revisions) );15111512print"M\n";1513print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1514print"M Working file:$filename\n";1515print"M head: 1.$headmeta->{revision}\n";1516print"M branch:\n";1517print"M locks: strict\n";1518print"M access list:\n";1519print"M symbolic names:\n";1520print"M keyword substitution: kv\n";1521print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1522print"M description:\n";15231524foreachmy$revision(@$revisions)1525{1526print"M ----------------------------\n";1527print"M revision 1.$revision->{revision}\n";1528# reformat the date for log output1529$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}) );1530$revision->{author} =~s/\s+.*//;1531$revision->{author} =~s/^(.{8}).*/$1/;1532print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1533my$commitmessage=$updater->commitmessage($revision->{commithash});1534$commitmessage=~s/^/M /mg;1535print$commitmessage."\n";1536}1537print"M =============================================================================\n";1538}15391540print"ok\n";1541}15421543sub req_annotate1544{1545my($cmd,$data) =@_;15461547 argsplit("annotate");15481549$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1550#$log->debug("status state : " . Dumper($state));15511552# Grab a handle to the SQLite db and do any necessary updates1553my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1554$updater->update();15551556# if no files were specified, we need to work out what files we should be providing annotate on ...1557 argsfromdir($updater);15581559# we'll need a temporary checkout dir1560my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1561my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1562$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");15631564$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1565$ENV{GIT_INDEX_FILE} =$file_index;15661567chdir$tmpdir;15681569# foreach file specified on the command line ...1570foreachmy$filename( @{$state->{args}} )1571{1572$filename= filecleanup($filename);15731574my$meta=$updater->getmeta($filename);15751576next unless($meta->{revision} );15771578# get all the commits that this file was in1579# in dense format -- aka skip dead revisions1580my$revisions=$updater->gethistorydense($filename);1581my$lastseenin=$revisions->[0][2];15821583# populate the temporary index based on the latest commit were we saw1584# the file -- but do it cheaply without checking out any files1585# TODO: if we got a revision from the client, use that instead1586# to look up the commithash in sqlite (still good to default to1587# the current head as we do now)1588system("git-read-tree",$lastseenin);1589unless($?==0)1590{1591die"Error running git-read-tree$lastseenin$file_index$!";1592}1593$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");15941595# do a checkout of the file1596system('git-checkout-index','-f','-u',$filename);1597unless($?==0) {1598die"Error running git-checkout-index -f -u$filename:$!";1599}16001601$log->info("Annotate$filename");16021603# Prepare a file with the commits from the linearized1604# history that annotate should know about. This prevents1605# git-jsannotate telling us about commits we are hiding1606# from the client.16071608open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1609for(my$i=0;$i<@$revisions;$i++)1610{1611print ANNOTATEHINTS $revisions->[$i][2];1612if($i+1<@$revisions) {# have we got a parent?1613print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1614}1615print ANNOTATEHINTS "\n";1616}16171618print ANNOTATEHINTS "\n";1619close ANNOTATEHINTS;16201621my$annotatecmd='git-annotate';1622open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1623or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1624my$metadata= {};1625print"E Annotations for$filename\n";1626print"E ***************\n";1627while( <ANNOTATE> )1628{1629if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1630{1631my$commithash=$1;1632my$data=$2;1633unless(defined($metadata->{$commithash} ) )1634{1635$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1636$metadata->{$commithash}{author} =~s/\s+.*//;1637$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1638$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1639}1640printf("M 1.%-5d (%-8s%10s):%s\n",1641$metadata->{$commithash}{revision},1642$metadata->{$commithash}{author},1643$metadata->{$commithash}{modified},1644$data1645);1646}else{1647$log->warn("Error in annotate output! LINE:$_");1648print"E Annotate error\n";1649next;1650}1651}1652close ANNOTATE;1653}16541655# done; get out of the tempdir1656chdir"/";16571658print"ok\n";16591660}16611662# This method takes the state->{arguments} array and produces two new arrays.1663# The first is $state->{args} which is everything before the '--' argument, and1664# the second is $state->{files} which is everything after it.1665sub argsplit1666{1667return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");16681669my$type=shift;16701671$state->{args} = [];1672$state->{files} = [];1673$state->{opt} = {};16741675if(defined($type) )1676{1677my$opt= {};1678$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");1679$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1680$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");1681$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1682$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1683$opt= { k =>1, m =>1}if($typeeq"add");1684$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1685$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");168616871688while(scalar( @{$state->{arguments}} ) >0)1689{1690my$arg=shift@{$state->{arguments}};16911692next if($argeq"--");1693next unless($arg=~/\S/);16941695# if the argument looks like a switch1696if($arg=~/^-(\w)(.*)/)1697{1698# if it's a switch that takes an argument1699if($opt->{$1} )1700{1701# If this switch has already been provided1702if($opt->{$1} >1and exists($state->{opt}{$1} ) )1703{1704$state->{opt}{$1} = [$state->{opt}{$1} ];1705if(length($2) >0)1706{1707push@{$state->{opt}{$1}},$2;1708}else{1709push@{$state->{opt}{$1}},shift@{$state->{arguments}};1710}1711}else{1712# if there's extra data in the arg, use that as the argument for the switch1713if(length($2) >0)1714{1715$state->{opt}{$1} =$2;1716}else{1717$state->{opt}{$1} =shift@{$state->{arguments}};1718}1719}1720}else{1721$state->{opt}{$1} =undef;1722}1723}1724else1725{1726push@{$state->{args}},$arg;1727}1728}1729}1730else1731{1732my$mode=0;17331734foreachmy$value( @{$state->{arguments}} )1735{1736if($valueeq"--")1737{1738$mode++;1739next;1740}1741push@{$state->{args}},$valueif($mode==0);1742push@{$state->{files}},$valueif($mode==1);1743}1744}1745}17461747# This method uses $state->{directory} to populate $state->{args} with a list of filenames1748sub argsfromdir1749{1750my$updater=shift;17511752$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");17531754return if(scalar( @{$state->{args}} ) >1);17551756my@gethead= @{$updater->gethead};17571758# push added files1759foreachmy$file(keys%{$state->{entries}}) {1760if(exists$state->{entries}{$file}{revision} &&1761$state->{entries}{$file}{revision} ==0)1762{1763push@gethead, { name =>$file, filehash =>'added'};1764}1765}17661767if(scalar(@{$state->{args}}) ==1)1768{1769my$arg=$state->{args}[0];1770$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );17711772$log->info("Only one arg specified, checking for directory expansion on '$arg'");17731774foreachmy$file(@gethead)1775{1776next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1777next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);1778push@{$state->{args}},$file->{name};1779}17801781shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);1782}else{1783$log->info("Only one arg specified, populating file list automatically");17841785$state->{args} = [];17861787foreachmy$file(@gethead)1788{1789next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1790next unless($file->{name} =~s/^$state->{prependdir}//);1791push@{$state->{args}},$file->{name};1792}1793}1794}17951796# This method cleans up the $state variable after a command that uses arguments has run1797sub statecleanup1798{1799$state->{files} = [];1800$state->{args} = [];1801$state->{arguments} = [];1802$state->{entries} = {};1803}18041805sub revparse1806{1807my$filename=shift;18081809returnundefunless(defined($state->{entries}{$filename}{revision} ) );18101811return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1812return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);18131814returnundef;1815}18161817# This method takes a file hash and does a CVS "file transfer" which transmits the1818# size of the file, and then the file contents.1819# If a second argument $targetfile is given, the file is instead written out to1820# a file by the name of $targetfile1821sub transmitfile1822{1823my$filehash=shift;1824my$targetfile=shift;18251826if(defined($filehash)and$filehasheq"deleted")1827{1828$log->warn("filehash is 'deleted'");1829return;1830}18311832die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);18331834my$type=`git-cat-file -t$filehash`;1835 chomp$type;18361837 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );18381839 my$size= `git-cat-file -s $filehash`;1840chomp$size;18411842$log->debug("transmitfile($filehash) size=$size, type=$type");18431844if(open my$fh,'-|',"git-cat-file","blob",$filehash)1845{1846if(defined($targetfile) )1847{1848open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1849print NEWFILE $_while( <$fh> );1850close NEWFILE;1851}else{1852print"$size\n";1853printwhile( <$fh> );1854}1855close$fhor die("Couldn't close filehandle for transmitfile()");1856}else{1857die("Couldn't execute git-cat-file");1858}1859}18601861# This method takes a file name, and returns ( $dirpart, $filepart ) which1862# refers to the directory portion and the file portion of the filename1863# respectively1864sub filenamesplit1865{1866my$filename=shift;1867my$fixforlocaldir=shift;18681869my($filepart,$dirpart) = ($filename,".");1870($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1871$dirpart.="/";18721873if($fixforlocaldir)1874{1875$dirpart=~s/^$state->{prependdir}//;1876}18771878return($filepart,$dirpart);1879}18801881sub filecleanup1882{1883my$filename=shift;18841885returnundefunless(defined($filename));1886if($filename=~/^\// )1887{1888print"E absolute filenames '$filename' not supported by server\n";1889returnundef;1890}18911892$filename=~s/^\.\///g;1893$filename=$state->{prependdir} .$filename;1894return$filename;1895}18961897# Given a path, this function returns a string containing the kopts1898# that should go into that path's Entries line. For example, a binary1899# file should get -kb.1900sub kopts_from_path1901{1902my($path) =@_;19031904# Once it exists, the git attributes system should be used to look up1905# what attributes apply to this path.19061907# Until then, take the setting from the config file1908unless(defined($cfg->{gitcvs}{allbinary} )and$cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i)1909{1910# Return "" to give no special treatment to any path1911return"";1912}else{1913# Alternatively, to have all files treated as if they are binary (which1914# is more like git itself), always return the "-kb" option1915return"-kb";1916}1917}19181919package GITCVS::log;19201921####1922#### Copyright The Open University UK - 2006.1923####1924#### Authors: Martyn Smith <martyn@catalyst.net.nz>1925#### Martin Langhoff <martin@catalyst.net.nz>1926####1927####19281929use strict;1930use warnings;19311932=head1 NAME19331934GITCVS::log19351936=head1 DESCRIPTION19371938This module provides very crude logging with a similar interface to1939Log::Log4perl19401941=head1 METHODS19421943=cut19441945=head2 new19461947Creates a new log object, optionally you can specify a filename here to1948indicate the file to log to. If no log file is specified, you can specify one1949later with method setfile, or indicate you no longer want logging with method1950nofile.19511952Until one of these methods is called, all log calls will buffer messages ready1953to write out.19541955=cut1956sub new1957{1958my$class=shift;1959my$filename=shift;19601961my$self= {};19621963bless$self,$class;19641965if(defined($filename) )1966{1967open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1968}19691970return$self;1971}19721973=head2 setfile19741975This methods takes a filename, and attempts to open that file as the log file.1976If successful, all buffered data is written out to the file, and any further1977logging is written directly to the file.19781979=cut1980sub setfile1981{1982my$self=shift;1983my$filename=shift;19841985if(defined($filename) )1986{1987open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1988}19891990return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");19911992while(my$line=shift@{$self->{buffer}} )1993{1994print{$self->{fh}}$line;1995}1996}19971998=head2 nofile19992000This method indicates no logging is going to be used. It flushes any entries in2001the internal buffer, and sets a flag to ensure no further data is put there.20022003=cut2004sub nofile2005{2006my$self=shift;20072008$self->{nolog} =1;20092010return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");20112012$self->{buffer} = [];2013}20142015=head2 _logopen20162017Internal method. Returns true if the log file is open, false otherwise.20182019=cut2020sub _logopen2021{2022my$self=shift;20232024return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");2025return0;2026}20272028=head2 debug info warn fatal20292030These four methods are wrappers to _log. They provide the actual interface for2031logging data.20322033=cut2034sub debug {my$self=shift;$self->_log("debug",@_); }2035sub info {my$self=shift;$self->_log("info",@_); }2036subwarn{my$self=shift;$self->_log("warn",@_); }2037sub fatal {my$self=shift;$self->_log("fatal",@_); }20382039=head2 _log20402041This is an internal method called by the logging functions. It generates a2042timestamp and pushes the logged line either to file, or internal buffer.20432044=cut2045sub _log2046{2047my$self=shift;2048my$level=shift;20492050return if($self->{nolog} );20512052my@time=localtime;2053my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2054$time[5] +1900,2055$time[4] +1,2056$time[3],2057$time[2],2058$time[1],2059$time[0],2060uc$level,2061);20622063if($self->_logopen)2064{2065print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2066}else{2067push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2068}2069}20702071=head2 DESTROY20722073This method simply closes the file handle if one is open20742075=cut2076sub DESTROY2077{2078my$self=shift;20792080if($self->_logopen)2081{2082close$self->{fh};2083}2084}20852086package GITCVS::updater;20872088####2089#### Copyright The Open University UK - 2006.2090####2091#### Authors: Martyn Smith <martyn@catalyst.net.nz>2092#### Martin Langhoff <martin@catalyst.net.nz>2093####2094####20952096use strict;2097use warnings;2098use DBI;20992100=head1 METHODS21012102=cut21032104=head2 new21052106=cut2107sub new2108{2109my$class=shift;2110my$config=shift;2111my$module=shift;2112my$log=shift;21132114die"Need to specify a git repository"unless(defined($config)and-d $config);2115die"Need to specify a module"unless(defined($module) );21162117$class=ref($class) ||$class;21182119my$self= {};21202121bless$self,$class;21222123$self->{dbdir} =$config."/";2124die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );21252126$self->{module} =$module;2127$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";21282129$self->{git_path} =$config."/";21302131$self->{log} =$log;21322133die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );21342135$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");21362137$self->{tables} = {};2138foreachmy$table($self->{dbh}->tables)2139{2140$table=~s/^"//;2141$table=~s/"$//;2142$self->{tables}{$table} =1;2143}21442145# Construct the revision table if required2146unless($self->{tables}{revision} )2147{2148$self->{dbh}->do("2149 CREATE TABLE revision (2150 name TEXT NOT NULL,2151 revision INTEGER NOT NULL,2152 filehash TEXT NOT NULL,2153 commithash TEXT NOT NULL,2154 author TEXT NOT NULL,2155 modified TEXT NOT NULL,2156 mode TEXT NOT NULL2157 )2158 ");2159$self->{dbh}->do("2160 CREATE INDEX revision_ix12161 ON revision (name,revision)2162 ");2163$self->{dbh}->do("2164 CREATE INDEX revision_ix22165 ON revision (name,commithash)2166 ");2167}21682169# Construct the head table if required2170unless($self->{tables}{head} )2171{2172$self->{dbh}->do("2173 CREATE TABLE head (2174 name TEXT NOT NULL,2175 revision INTEGER NOT NULL,2176 filehash TEXT NOT NULL,2177 commithash TEXT NOT NULL,2178 author TEXT NOT NULL,2179 modified TEXT NOT NULL,2180 mode TEXT NOT NULL2181 )2182 ");2183$self->{dbh}->do("2184 CREATE INDEX head_ix12185 ON head (name)2186 ");2187}21882189# Construct the properties table if required2190unless($self->{tables}{properties} )2191{2192$self->{dbh}->do("2193 CREATE TABLE properties (2194 key TEXT NOT NULL PRIMARY KEY,2195 value TEXT2196 )2197 ");2198}21992200# Construct the commitmsgs table if required2201unless($self->{tables}{commitmsgs} )2202{2203$self->{dbh}->do("2204 CREATE TABLE commitmsgs (2205 key TEXT NOT NULL PRIMARY KEY,2206 value TEXT2207 )2208 ");2209}22102211return$self;2212}22132214=head2 update22152216=cut2217sub update2218{2219my$self=shift;22202221# first lets get the commit list2222$ENV{GIT_DIR} =$self->{git_path};22232224my$commitsha1=`git rev-parse$self->{module}`;2225chomp$commitsha1;22262227my$commitinfo=`git cat-file commit$self->{module} 2>&1`;2228unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2229{2230die("Invalid module '$self->{module}'");2231}223222332234my$git_log;2235my$lastcommit=$self->_get_prop("last_commit");22362237if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date2238return1;2239}22402241# Start exclusive lock here...2242$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";22432244# TODO: log processing is memory bound2245# if we can parse into a 2nd file that is in reverse order2246# we can probably do something really efficient2247my@git_log_params= ('--pretty','--parents','--topo-order');22482249if(defined$lastcommit) {2250push@git_log_params,"$lastcommit..$self->{module}";2251}else{2252push@git_log_params,$self->{module};2253}2254# git-rev-list is the backend / plumbing version of git-log2255open(GITLOG,'-|','git-rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";22562257my@commits;22582259my%commit= ();22602261while( <GITLOG> )2262{2263chomp;2264if(m/^commit\s+(.*)$/) {2265# on ^commit lines put the just seen commit in the stack2266# and prime things for the next one2267if(keys%commit) {2268my%copy=%commit;2269unshift@commits, \%copy;2270%commit= ();2271}2272my@parents=split(m/\s+/,$1);2273$commit{hash} =shift@parents;2274$commit{parents} = \@parents;2275}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2276# on rfc822-like lines seen before we see any message,2277# lowercase the entry and put it in the hash as key-value2278$commit{lc($1)} =$2;2279}else{2280# message lines - skip initial empty line2281# and trim whitespace2282if(!exists($commit{message}) &&m/^\s*$/) {2283# define it to mark the end of headers2284$commit{message} ='';2285next;2286}2287s/^\s+//;s/\s+$//;# trim ws2288$commit{message} .=$_."\n";2289}2290}2291close GITLOG;22922293unshift@commits, \%commitif(keys%commit);22942295# Now all the commits are in the @commits bucket2296# ordered by time DESC. for each commit that needs processing,2297# determine whether it's following the last head we've seen or if2298# it's on its own branch, grab a file list, and add whatever's changed2299# NOTE: $lastcommit refers to the last commit from previous run2300# $lastpicked is the last commit we picked in this run2301my$lastpicked;2302my$head= {};2303if(defined$lastcommit) {2304$lastpicked=$lastcommit;2305}23062307my$committotal=scalar(@commits);2308my$commitcount=0;23092310# Load the head table into $head (for cached lookups during the update process)2311foreachmy$file( @{$self->gethead()} )2312{2313$head->{$file->{name}} =$file;2314}23152316foreachmy$commit(@commits)2317{2318$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2319if(defined$lastpicked)2320{2321if(!in_array($lastpicked, @{$commit->{parents}}))2322{2323# skip, we'll see this delta2324# as part of a merge later2325# warn "skipping off-track $commit->{hash}\n";2326next;2327}elsif(@{$commit->{parents}} >1) {2328# it is a merge commit, for each parent that is2329# not $lastpicked, see if we can get a log2330# from the merge-base to that parent to put it2331# in the message as a merge summary.2332my@parents= @{$commit->{parents}};2333foreachmy$parent(@parents) {2334# git-merge-base can potentially (but rarely) throw2335# several candidate merge bases. let's assume2336# that the first one is the best one.2337if($parenteq$lastpicked) {2338next;2339}2340open my$p,'git-merge-base '.$lastpicked.' '2341.$parent.'|';2342my@output= (<$p>);2343close$p;2344my$base=join('',@output);2345chomp$base;2346if($base) {2347my@merged;2348# print "want to log between $base $parent \n";2349open(GITLOG,'-|','git-log',"$base..$parent")2350or die"Cannot call git-log:$!";2351my$mergedhash;2352while(<GITLOG>) {2353chomp;2354if(!defined$mergedhash) {2355if(m/^commit\s+(.+)$/) {2356$mergedhash=$1;2357}else{2358next;2359}2360}else{2361# grab the first line that looks non-rfc8222362# aka has content after leading space2363if(m/^\s+(\S.*)$/) {2364my$title=$1;2365$title=substr($title,0,100);# truncate2366unshift@merged,"$mergedhash$title";2367undef$mergedhash;2368}2369}2370}2371close GITLOG;2372if(@merged) {2373$commit->{mergemsg} =$commit->{message};2374$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2375foreachmy$summary(@merged) {2376$commit->{mergemsg} .="\t$summary\n";2377}2378$commit->{mergemsg} .="\n\n";2379# print "Message for $commit->{hash} \n$commit->{mergemsg}";2380}2381}2382}2383}2384}23852386# convert the date to CVS-happy format2387$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);23882389if(defined($lastpicked) )2390{2391my$filepipe=open(FILELIST,'-|','git-diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2392local($/) ="\0";2393while( <FILELIST> )2394{2395chomp;2396unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)2397{2398die("Couldn't process git-diff-tree line :$_");2399}2400my($mode,$hash,$change) = ($1,$2,$3);2401my$name= <FILELIST>;2402chomp($name);24032404# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");24052406my$git_perms="";2407$git_perms.="r"if($mode&4);2408$git_perms.="w"if($mode&2);2409$git_perms.="x"if($mode&1);2410$git_perms="rw"if($git_permseq"");24112412if($changeeq"D")2413{2414#$log->debug("DELETE $name");2415$head->{$name} = {2416 name =>$name,2417 revision =>$head->{$name}{revision} +1,2418 filehash =>"deleted",2419 commithash =>$commit->{hash},2420 modified =>$commit->{date},2421 author =>$commit->{author},2422 mode =>$git_perms,2423};2424$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2425}2426elsif($changeeq"M")2427{2428#$log->debug("MODIFIED $name");2429$head->{$name} = {2430 name =>$name,2431 revision =>$head->{$name}{revision} +1,2432 filehash =>$hash,2433 commithash =>$commit->{hash},2434 modified =>$commit->{date},2435 author =>$commit->{author},2436 mode =>$git_perms,2437};2438$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2439}2440elsif($changeeq"A")2441{2442#$log->debug("ADDED $name");2443$head->{$name} = {2444 name =>$name,2445 revision =>1,2446 filehash =>$hash,2447 commithash =>$commit->{hash},2448 modified =>$commit->{date},2449 author =>$commit->{author},2450 mode =>$git_perms,2451};2452$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2453}2454else2455{2456$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");2457die;2458}2459}2460close FILELIST;2461}else{2462# this is used to detect files removed from the repo2463my$seen_files= {};24642465my$filepipe=open(FILELIST,'-|','git-ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2466local$/="\0";2467while( <FILELIST> )2468{2469chomp;2470unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)2471{2472die("Couldn't process git-ls-tree line :$_");2473}24742475my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);24762477$seen_files->{$git_filename} =1;24782479my($oldhash,$oldrevision,$oldmode) = (2480$head->{$git_filename}{filehash},2481$head->{$git_filename}{revision},2482$head->{$git_filename}{mode}2483);24842485if($git_perms=~/^\d\d\d(\d)\d\d/o)2486{2487$git_perms="";2488$git_perms.="r"if($1&4);2489$git_perms.="w"if($1&2);2490$git_perms.="x"if($1&1);2491}else{2492$git_perms="rw";2493}24942495# unless the file exists with the same hash, we need to update it ...2496unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2497{2498my$newrevision= ($oldrevisionor0) +1;24992500$head->{$git_filename} = {2501 name =>$git_filename,2502 revision =>$newrevision,2503 filehash =>$git_hash,2504 commithash =>$commit->{hash},2505 modified =>$commit->{date},2506 author =>$commit->{author},2507 mode =>$git_perms,2508};250925102511$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2512}2513}2514close FILELIST;25152516# Detect deleted files2517foreachmy$file(keys%$head)2518{2519unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2520{2521$head->{$file}{revision}++;2522$head->{$file}{filehash} ="deleted";2523$head->{$file}{commithash} =$commit->{hash};2524$head->{$file}{modified} =$commit->{date};2525$head->{$file}{author} =$commit->{author};25262527$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2528}2529}2530# END : "Detect deleted files"2531}253225332534if(exists$commit->{mergemsg})2535{2536$self->insert_mergelog($commit->{hash},$commit->{mergemsg});2537}25382539$lastpicked=$commit->{hash};25402541$self->_set_prop("last_commit",$commit->{hash});2542}25432544$self->delete_head();2545foreachmy$file(keys%$head)2546{2547$self->insert_head(2548$file,2549$head->{$file}{revision},2550$head->{$file}{filehash},2551$head->{$file}{commithash},2552$head->{$file}{modified},2553$head->{$file}{author},2554$head->{$file}{mode},2555);2556}2557# invalidate the gethead cache2558$self->{gethead_cache} =undef;255925602561# Ending exclusive lock here2562$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2563}25642565sub insert_rev2566{2567my$self=shift;2568my$name=shift;2569my$revision=shift;2570my$filehash=shift;2571my$commithash=shift;2572my$modified=shift;2573my$author=shift;2574my$mode=shift;25752576my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2577$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);2578}25792580sub insert_mergelog2581{2582my$self=shift;2583my$key=shift;2584my$value=shift;25852586my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);2587$insert_mergelog->execute($key,$value);2588}25892590sub delete_head2591{2592my$self=shift;25932594my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);2595$delete_head->execute();2596}25972598sub insert_head2599{2600my$self=shift;2601my$name=shift;2602my$revision=shift;2603my$filehash=shift;2604my$commithash=shift;2605my$modified=shift;2606my$author=shift;2607my$mode=shift;26082609my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2610$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);2611}26122613sub _headrev2614{2615my$self=shift;2616my$filename=shift;26172618my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2619$db_query->execute($filename);2620my($hash,$revision,$mode) =$db_query->fetchrow_array;26212622return($hash,$revision,$mode);2623}26242625sub _get_prop2626{2627my$self=shift;2628my$key=shift;26292630my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2631$db_query->execute($key);2632my($value) =$db_query->fetchrow_array;26332634return$value;2635}26362637sub _set_prop2638{2639my$self=shift;2640my$key=shift;2641my$value=shift;26422643my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2644$db_query->execute($value,$key);26452646unless($db_query->rows)2647{2648$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2649$db_query->execute($key,$value);2650}26512652return$value;2653}26542655=head2 gethead26562657=cut26582659sub gethead2660{2661my$self=shift;26622663return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );26642665my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);2666$db_query->execute();26672668my$tree= [];2669while(my$file=$db_query->fetchrow_hashref)2670{2671push@$tree,$file;2672}26732674$self->{gethead_cache} =$tree;26752676return$tree;2677}26782679=head2 getlog26802681=cut26822683sub getlog2684{2685my$self=shift;2686my$filename=shift;26872688my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2689$db_query->execute($filename);26902691my$tree= [];2692while(my$file=$db_query->fetchrow_hashref)2693{2694push@$tree,$file;2695}26962697return$tree;2698}26992700=head2 getmeta27012702This function takes a filename (with path) argument and returns a hashref of2703metadata for that file.27042705=cut27062707sub getmeta2708{2709my$self=shift;2710my$filename=shift;2711my$revision=shift;27122713my$db_query;2714if(defined($revision)and$revision=~/^\d+$/)2715{2716$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2717$db_query->execute($filename,$revision);2718}2719elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2720{2721$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2722$db_query->execute($filename,$revision);2723}else{2724$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2725$db_query->execute($filename);2726}27272728return$db_query->fetchrow_hashref;2729}27302731=head2 commitmessage27322733this function takes a commithash and returns the commit message for that commit27342735=cut2736sub commitmessage2737{2738my$self=shift;2739my$commithash=shift;27402741die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);27422743my$db_query;2744$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2745$db_query->execute($commithash);27462747my($message) =$db_query->fetchrow_array;27482749if(defined($message) )2750{2751$message.=" "if($message=~/\n$/);2752return$message;2753}27542755my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2756shift@lineswhile($lines[0] =~/\S/);2757$message=join("",@lines);2758$message.=" "if($message=~/\n$/);2759return$message;2760}27612762=head2 gethistory27632764This function takes a filename (with path) argument and returns an arrayofarrays2765containing revision,filehash,commithash ordered by revision descending27662767=cut2768sub gethistory2769{2770my$self=shift;2771my$filename=shift;27722773my$db_query;2774$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2775$db_query->execute($filename);27762777return$db_query->fetchall_arrayref;2778}27792780=head2 gethistorydense27812782This function takes a filename (with path) argument and returns an arrayofarrays2783containing revision,filehash,commithash ordered by revision descending.27842785This version of gethistory skips deleted entries -- so it is useful for annotate.2786The 'dense' part is a reference to a '--dense' option available for git-rev-list2787and other git tools that depend on it.27882789=cut2790sub gethistorydense2791{2792my$self=shift;2793my$filename=shift;27942795my$db_query;2796$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2797$db_query->execute($filename);27982799return$db_query->fetchall_arrayref;2800}28012802=head2 in_array()28032804from Array::PAT - mimics the in_array() function2805found in PHP. Yuck but works for small arrays.28062807=cut2808sub in_array2809{2810my($check,@array) =@_;2811my$retval=0;2812foreachmy$test(@array){2813if($checkeq$test){2814$retval=1;2815}2816}2817return$retval;2818}28192820=head2 safe_pipe_capture28212822an alternative to `command` that allows input to be passed as an array2823to work around shell problems with weird characters in arguments28242825=cut2826sub safe_pipe_capture {28272828my@output;28292830if(my$pid=open my$child,'-|') {2831@output= (<$child>);2832close$childor die join(' ',@_).":$!$?";2833}else{2834exec(@_)or die"$!$?";# exec() can fail the executable can't be found2835}2836returnwantarray?@output:join('',@output);2837}2838283928401;