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-repo-config -l`; 176if($?) { 177print"E problems executing git-repo-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-repo-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"; 377print"/$filepart/0///\n"; 378 379$addcount++; 380} 381 382if($addcount==1) 383{ 384print"E cvs add: use `cvs commit' to add this file permanently\n"; 385} 386elsif($addcount>1) 387{ 388print"E cvs add: use `cvs commit' to add these files permanently\n"; 389} 390 391print"ok\n"; 392} 393 394# remove \n 395# Response expected: yes. Remove a file. This uses any previous Argument, 396# Directory, Entry, or Modified requests, if they have been sent. The last 397# Directory sent specifies the working directory at the time of the 398# operation. Note that this request does not actually do anything to the 399# repository; the only effect of a successful remove request is to supply 400# the client with a new entries line containing `-' to indicate a removed 401# file. In fact, the client probably could perform this operation without 402# contacting the server, although using remove may cause the server to 403# perform a few more checks. The client sends a subsequent ci request to 404# actually record the removal in the repository. 405sub req_remove 406{ 407my($cmd,$data) =@_; 408 409 argsplit("remove"); 410 411# Grab a handle to the SQLite db and do any necessary updates 412my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 413$updater->update(); 414 415#$log->debug("add state : " . Dumper($state)); 416 417my$rmcount=0; 418 419foreachmy$filename( @{$state->{args}} ) 420{ 421$filename= filecleanup($filename); 422 423if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 424{ 425print"E cvs remove: file `$filename' still in working directory\n"; 426next; 427} 428 429my$meta=$updater->getmeta($filename); 430my$wrev= revparse($filename); 431 432unless(defined($wrev) ) 433{ 434print"E cvs remove: nothing known about `$filename'\n"; 435next; 436} 437 438if(defined($wrev)and$wrev<0) 439{ 440print"E cvs remove: file `$filename' already scheduled for removal\n"; 441next; 442} 443 444unless($wrev==$meta->{revision} ) 445{ 446# TODO : not sure if the format of this message is quite correct. 447print"E cvs remove: Up to date check failed for `$filename'\n"; 448next; 449} 450 451 452my($filepart,$dirpart) = filenamesplit($filename,1); 453 454print"E cvs remove: scheduling `$filename' for removal\n"; 455 456print"Checked-in$dirpart\n"; 457print"$filename\n"; 458print"/$filepart/-1.$wrev///\n"; 459 460$rmcount++; 461} 462 463if($rmcount==1) 464{ 465print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 466} 467elsif($rmcount>1) 468{ 469print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 470} 471 472print"ok\n"; 473} 474 475# Modified filename \n 476# Response expected: no. Additional data: mode, \n, file transmission. Send 477# the server a copy of one locally modified file. filename is a file within 478# the most recent directory sent with Directory; it must not contain `/'. 479# If the user is operating on only some files in a directory, only those 480# files need to be included. This can also be sent without Entry, if there 481# is no entry for the file. 482sub req_Modified 483{ 484my($cmd,$data) =@_; 485 486my$mode= <STDIN>; 487chomp$mode; 488my$size= <STDIN>; 489chomp$size; 490 491# Grab config information 492my$blocksize=8192; 493my$bytesleft=$size; 494my$tmp; 495 496# Get a filehandle/name to write it to 497my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 498 499# Loop over file data writing out to temporary file. 500while($bytesleft) 501{ 502$blocksize=$bytesleftif($bytesleft<$blocksize); 503read STDIN,$tmp,$blocksize; 504print$fh $tmp; 505$bytesleft-=$blocksize; 506} 507 508close$fh; 509 510# Ensure we have something sensible for the file mode 511if($mode=~/u=(\w+)/) 512{ 513$mode=$1; 514}else{ 515$mode="rw"; 516} 517 518# Save the file data in $state 519$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 520$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 521$state->{entries}{$state->{directory}.$data}{modified_hash} =`git-hash-object$filename`; 522$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 523 524 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 525} 526 527# Unchanged filename\n 528# Response expected: no. Tell the server that filename has not been 529# modified in the checked out directory. The filename is a file within the 530# most recent directory sent with Directory; it must not contain `/'. 531sub req_Unchanged 532{ 533 my ($cmd,$data) =@_; 534 535$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 536 537 #$log->debug("req_Unchanged :$data"); 538} 539 540# Argument text\n 541# Response expected: no. Save argument for use in a subsequent command. 542# Arguments accumulate until an argument-using command is given, at which 543# point they are forgotten. 544# Argumentx text\n 545# Response expected: no. Append\nfollowed by text to the current argument 546# being saved. 547sub req_Argument 548{ 549 my ($cmd,$data) =@_; 550 551 # Argumentx means: append to last Argument (with a newline in front) 552 553$log->debug("$cmd:$data"); 554 555 if ($cmdeq 'Argumentx') { 556 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 557 } else { 558 push @{$state->{arguments}},$data; 559 } 560} 561 562# expand-modules\n 563# Response expected: yes. Expand the modules which are specified in the 564# arguments. Returns the data in Module-expansion responses. Note that the 565# server can assume that this is checkout or export, not rtag or rdiff; the 566# latter do not access the working directory and thus have no need to 567# expand modules on the client side. Expand may not be the best word for 568# what this request does. It does not necessarily tell you all the files 569# contained in a module, for example. Basically it is a way of telling you 570# which working directories the server needs to know about in order to 571# handle a checkout of the specified modules. For example, suppose that the 572# server has a module defined by 573# aliasmodule -a 1dir 574# That is, one can check out aliasmodule and it will take 1dir in the 575# repository and check it out to 1dir in the working directory. Now suppose 576# the client already has this module checked out and is planning on using 577# the co request to update it. Without using expand-modules, the client 578# would have two bad choices: it could either send information about all 579# working directories under the current directory, which could be 580# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 581# stands for 1dir, and neglect to send information for 1dir, which would 582# lead to incorrect operation. With expand-modules, the client would first 583# ask for the module to be expanded: 584sub req_expandmodules 585{ 586 my ($cmd,$data) =@_; 587 588 argsplit(); 589 590$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 591 592 unless ( ref$state->{arguments} eq "ARRAY" ) 593 { 594 print "ok\n"; 595 return; 596 } 597 598 foreach my$module( @{$state->{arguments}} ) 599 { 600$log->debug("SEND : Module-expansion$module"); 601 print "Module-expansion$module\n"; 602 } 603 604 print "ok\n"; 605 statecleanup(); 606} 607 608# co\n 609# Response expected: yes. Get files from the repository. This uses any 610# previous Argument, Directory, Entry, or Modified requests, if they have 611# been sent. Arguments to this command are module names; the client cannot 612# know what directories they correspond to except by (1) just sending the 613# co request, and then seeing what directory names the server sends back in 614# its responses, and (2) the expand-modules request. 615sub req_co 616{ 617 my ($cmd,$data) =@_; 618 619 argsplit("co"); 620 621 my$module=$state->{args}[0]; 622 my$checkout_path=$module; 623 624 # use the user specified directory if we're given it 625$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 626 627$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 628 629$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 630 631$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 632 633# Grab a handle to the SQLite db and do any necessary updates 634my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 635$updater->update(); 636 637$checkout_path=~ s|/$||;# get rid of trailing slashes 638 639# Eclipse seems to need the Clear-sticky command 640# to prepare the 'Entries' file for the new directory. 641print"Clear-sticky$checkout_path/\n"; 642print$state->{CVSROOT} ."/$module/\n"; 643print"Clear-static-directory$checkout_path/\n"; 644print$state->{CVSROOT} ."/$module/\n"; 645print"Clear-sticky$checkout_path/\n";# yes, twice 646print$state->{CVSROOT} ."/$module/\n"; 647print"Template$checkout_path/\n"; 648print$state->{CVSROOT} ."/$module/\n"; 649print"0\n"; 650 651# instruct the client that we're checking out to $checkout_path 652print"E cvs checkout: Updating$checkout_path\n"; 653 654my%seendirs= (); 655my$lastdir=''; 656 657# recursive 658sub prepdir { 659my($dir,$repodir,$remotedir,$seendirs) =@_; 660my$parent= dirname($dir); 661$dir=~ s|/+$||; 662$repodir=~ s|/+$||; 663$remotedir=~ s|/+$||; 664$parent=~ s|/+$||; 665$log->debug("announcedir$dir,$repodir,$remotedir"); 666 667if($parenteq'.'||$parenteq'./') { 668$parent=''; 669} 670# recurse to announce unseen parents first 671if(length($parent) && !exists($seendirs->{$parent})) { 672 prepdir($parent,$repodir,$remotedir,$seendirs); 673} 674# Announce that we are going to modify at the parent level 675if($parent) { 676print"E cvs checkout: Updating$remotedir/$parent\n"; 677}else{ 678print"E cvs checkout: Updating$remotedir\n"; 679} 680print"Clear-sticky$remotedir/$parent/\n"; 681print"$repodir/$parent/\n"; 682 683print"Clear-static-directory$remotedir/$dir/\n"; 684print"$repodir/$dir/\n"; 685print"Clear-sticky$remotedir/$parent/\n";# yes, twice 686print"$repodir/$parent/\n"; 687print"Template$remotedir/$dir/\n"; 688print"$repodir/$dir/\n"; 689print"0\n"; 690 691$seendirs->{$dir} =1; 692} 693 694foreachmy$git( @{$updater->gethead} ) 695{ 696# Don't want to check out deleted files 697next if($git->{filehash}eq"deleted"); 698 699($git->{name},$git->{dir} ) = filenamesplit($git->{name}); 700 701if(length($git->{dir}) &&$git->{dir}ne'./' 702&&$git->{dir}ne$lastdir) { 703unless(exists($seendirs{$git->{dir}})) { 704 prepdir($git->{dir},$state->{CVSROOT} ."/$module/", 705$checkout_path, \%seendirs); 706$lastdir=$git->{dir}; 707$seendirs{$git->{dir}} =1; 708} 709print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n"; 710} 711 712# modification time of this file 713print"Mod-time$git->{modified}\n"; 714 715# print some information to the client 716if(defined($git->{dir} )and$git->{dir}ne"./") 717{ 718print"M U$checkout_path/$git->{dir}$git->{name}\n"; 719}else{ 720print"M U$checkout_path/$git->{name}\n"; 721} 722 723# instruct client we're sending a file to put in this path 724print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n"; 725 726print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n"; 727 728# this is an "entries" line 729print"/$git->{name}/1.$git->{revision}///\n"; 730# permissions 731print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n"; 732 733# transmit file 734 transmitfile($git->{filehash}); 735} 736 737print"ok\n"; 738 739 statecleanup(); 740} 741 742# update \n 743# Response expected: yes. Actually do a cvs update command. This uses any 744# previous Argument, Directory, Entry, or Modified requests, if they have 745# been sent. The last Directory sent specifies the working directory at the 746# time of the operation. The -I option is not used--files which the client 747# can decide whether to ignore are not mentioned and the client sends the 748# Questionable request for others. 749sub req_update 750{ 751my($cmd,$data) =@_; 752 753$log->debug("req_update : ". (defined($data) ?$data:"[NULL]")); 754 755 argsplit("update"); 756 757# 758# It may just be a client exploring the available heads/modules 759# in that case, list them as top level directories and leave it 760# at that. Eclipse uses this technique to offer you a list of 761# projects (heads in this case) to checkout. 762# 763if($state->{module}eq'') { 764print"E cvs update: Updating .\n"; 765opendir HEADS,$state->{CVSROOT} .'/refs/heads'; 766while(my$head=readdir(HEADS)) { 767if(-f $state->{CVSROOT} .'/refs/heads/'.$head) { 768print"E cvs update: New directory `$head'\n"; 769} 770} 771closedir HEADS; 772print"ok\n"; 773return1; 774} 775 776 777# Grab a handle to the SQLite db and do any necessary updates 778my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 779 780$updater->update(); 781 782 argsfromdir($updater); 783 784#$log->debug("update state : " . Dumper($state)); 785 786# foreach file specified on the command line ... 787foreachmy$filename( @{$state->{args}} ) 788{ 789$filename= filecleanup($filename); 790 791$log->debug("Processing file$filename"); 792 793# if we have a -C we should pretend we never saw modified stuff 794if(exists($state->{opt}{C} ) ) 795{ 796delete$state->{entries}{$filename}{modified_hash}; 797delete$state->{entries}{$filename}{modified_filename}; 798$state->{entries}{$filename}{unchanged} =1; 799} 800 801my$meta; 802if(defined($state->{opt}{r})and$state->{opt}{r} =~/^1\.(\d+)/) 803{ 804$meta=$updater->getmeta($filename,$1); 805}else{ 806$meta=$updater->getmeta($filename); 807} 808 809if( !defined$meta) 810{ 811$meta= { 812 name =>$filename, 813 revision =>0, 814 filehash =>'added' 815}; 816} 817 818my$oldmeta=$meta; 819 820my$wrev= revparse($filename); 821 822# If the working copy is an old revision, lets get that version too for comparison. 823if(defined($wrev)and$wrev!=$meta->{revision} ) 824{ 825$oldmeta=$updater->getmeta($filename,$wrev); 826} 827 828#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev"); 829 830# Files are up to date if the working copy and repo copy have the same revision, 831# and the working copy is unmodified _and_ the user hasn't specified -C 832next if(defined($wrev) 833and defined($meta->{revision}) 834and$wrev==$meta->{revision} 835and$state->{entries}{$filename}{unchanged} 836and not exists($state->{opt}{C} ) ); 837 838# If the working copy and repo copy have the same revision, 839# but the working copy is modified, tell the client it's modified 840if(defined($wrev) 841and defined($meta->{revision}) 842and$wrev==$meta->{revision} 843and not exists($state->{opt}{C} ) ) 844{ 845$log->info("Tell the client the file is modified"); 846print"MT text M\n"; 847print"MT fname$filename\n"; 848print"MT newline\n"; 849next; 850} 851 852if($meta->{filehash}eq"deleted") 853{ 854my($filepart,$dirpart) = filenamesplit($filename,1); 855 856$log->info("Removing '$filename' from working copy (no longer in the repo)"); 857 858print"E cvs update: `$filename' is no longer in the repository\n"; 859# Don't want to actually _DO_ the update if -n specified 860unless($state->{globaloptions}{-n} ) { 861print"Removed$dirpart\n"; 862print"$filepart\n"; 863} 864} 865elsif(not defined($state->{entries}{$filename}{modified_hash} ) 866or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} 867or$meta->{filehash}eq'added') 868{ 869# normal update, just send the new revision (either U=Update, 870# or A=Add, or R=Remove) 871if(defined($wrev) &&$wrev<0) 872{ 873$log->info("Tell the client the file is scheduled for removal"); 874print"MT text R\n"; 875print"MT fname$filename\n"; 876print"MT newline\n"; 877next; 878} 879elsif( !defined($wrev) ||$wrev==0) 880{ 881$log->info("Tell the client the file will be added"); 882print"MT text A\n"; 883print"MT fname$filename\n"; 884print"MT newline\n"; 885next; 886 887} 888else{ 889$log->info("Updating '$filename'$wrev"); 890print"MT +updated\n"; 891print"MT text U\n"; 892print"MT fname$filename\n"; 893print"MT newline\n"; 894print"MT -updated\n"; 895} 896 897my($filepart,$dirpart) = filenamesplit($filename,1); 898 899# Don't want to actually _DO_ the update if -n specified 900unless($state->{globaloptions}{-n} ) 901{ 902if(defined($wrev) ) 903{ 904# instruct client we're sending a file to put in this path as a replacement 905print"Update-existing$dirpart\n"; 906$log->debug("Updating existing file 'Update-existing$dirpart'"); 907}else{ 908# instruct client we're sending a file to put in this path as a new file 909print"Clear-static-directory$dirpart\n"; 910print$state->{CVSROOT} ."/$state->{module}/$dirpart\n"; 911print"Clear-sticky$dirpart\n"; 912print$state->{CVSROOT} ."/$state->{module}/$dirpart\n"; 913 914$log->debug("Creating new file 'Created$dirpart'"); 915print"Created$dirpart\n"; 916} 917print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 918 919# this is an "entries" line 920$log->debug("/$filepart/1.$meta->{revision}///"); 921print"/$filepart/1.$meta->{revision}///\n"; 922 923# permissions 924$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 925print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 926 927# transmit file 928 transmitfile($meta->{filehash}); 929} 930}else{ 931$log->info("Updating '$filename'"); 932my($filepart,$dirpart) = filenamesplit($meta->{name},1); 933 934my$dir= tempdir( DIR =>$TEMP_DIR, CLEANUP =>1) ."/"; 935 936chdir$dir; 937my$file_local=$filepart.".mine"; 938system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local); 939my$file_old=$filepart.".".$oldmeta->{revision}; 940 transmitfile($oldmeta->{filehash},$file_old); 941my$file_new=$filepart.".".$meta->{revision}; 942 transmitfile($meta->{filehash},$file_new); 943 944# we need to merge with the local changes ( M=successful merge, C=conflict merge ) 945$log->info("Merging$file_local,$file_old,$file_new"); 946 947$log->debug("Temporary directory for merge is$dir"); 948 949my$return=system("git merge-file",$file_local,$file_old,$file_new); 950$return>>=8; 951 952if($return==0) 953{ 954$log->info("Merged successfully"); 955print"M M$filename\n"; 956$log->debug("Update-existing$dirpart"); 957 958# Don't want to actually _DO_ the update if -n specified 959unless($state->{globaloptions}{-n} ) 960{ 961print"Update-existing$dirpart\n"; 962$log->debug($state->{CVSROOT} ."/$state->{module}/$filename"); 963print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 964$log->debug("/$filepart/1.$meta->{revision}///"); 965print"/$filepart/1.$meta->{revision}///\n"; 966} 967} 968elsif($return==1) 969{ 970$log->info("Merged with conflicts"); 971print"M C$filename\n"; 972 973# Don't want to actually _DO_ the update if -n specified 974unless($state->{globaloptions}{-n} ) 975{ 976print"Update-existing$dirpart\n"; 977print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 978print"/$filepart/1.$meta->{revision}/+//\n"; 979} 980} 981else 982{ 983$log->warn("Merge failed"); 984next; 985} 986 987# Don't want to actually _DO_ the update if -n specified 988unless($state->{globaloptions}{-n} ) 989{ 990# permissions 991$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 992print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 993 994# transmit file, format is single integer on a line by itself (file 995# size) followed by the file contents 996# TODO : we should copy files in blocks 997my$data=`cat$file_local`; 998$log->debug("File size : " . length($data)); 999 print length($data) . "\n";1000 print$data;1001 }10021003 chdir "/";1004 }10051006 }10071008 print "ok\n";1009}10101011sub req_ci1012{1013 my ($cmd,$data) =@_;10141015 argsplit("ci");10161017 #$log->debug("State : " . Dumper($state));10181019$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));10201021 if (@ARGV&&$ARGV[0] eq 'pserver')1022 {1023 print "error 1 pserver access cannot commit\n";1024 exit;1025 }10261027 if ( -e$state->{CVSROOT} . "/index" )1028 {1029$log->warn("file 'index' already exists in the git repository");1030 print "error 1 Index already exists in git repo\n";1031 exit;1032 }10331034 my$lockfile= "$state->{CVSROOT}/refs/heads/$state->{module}.lock";1035 unless ( sysopen(LOCKFILE,$lockfile,O_EXCL|O_CREAT|O_WRONLY) )1036 {1037$log->warn("lockfile '$lockfile' already exists, please try again");1038 print "error 1 Lock file '$lockfile' already exists, please try again\n";1039 exit;1040 }10411042 # Grab a handle to the SQLite db and do any necessary updates1043 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1044$updater->update();10451046 my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1047 my ( undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN => 0 );1048$log->info("Lock successful, basing commit on '$tmpdir', index file is '$file_index'");10491050$ENV{GIT_DIR} =$state->{CVSROOT} . "/";1051$ENV{GIT_INDEX_FILE} =$file_index;10521053 chdir$tmpdir;10541055 # populate the temporary index based1056 system("git-read-tree",$state->{module});1057 unless ($?== 0)1058 {1059 die "Error running git-read-tree$state->{module}$file_index$!";1060 }1061$log->info("Created index '$file_index' with for head$state->{module} - exit status$?");106210631064 my@committedfiles= ();10651066 # foreach file specified on the command line ...1067 foreach my$filename( @{$state->{args}} )1068 {1069 my$committedfile=$filename;1070$filename= filecleanup($filename);10711072 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );10731074 my$meta=$updater->getmeta($filename);10751076 my$wrev= revparse($filename);10771078 my ($filepart,$dirpart) = filenamesplit($filename);10791080 # do a checkout of the file if it part of this tree1081 if ($wrev) {1082 system('git-checkout-index', '-f', '-u',$filename);1083 unless ($?== 0) {1084 die "Error running git-checkout-index -f -u$filename:$!";1085 }1086 }10871088 my$addflag= 0;1089 my$rmflag= 0;1090$rmflag= 1 if ( defined($wrev) and$wrev< 0 );1091$addflag= 1 unless ( -e$filename);10921093 # Do up to date checking1094 unless ($addflagor$wrev==$meta->{revision} or ($rmflagand -$wrev==$meta->{revision} ) )1095 {1096 # fail everything if an up to date check fails1097 print "error 1 Up to date check failed for$filename\n";1098 close LOCKFILE;1099 unlink($lockfile);1100 chdir "/";1101 exit;1102 }11031104 push@committedfiles,$committedfile;1105$log->info("Committing$filename");11061107 system("mkdir","-p",$dirpart) unless ( -d$dirpart);11081109 unless ($rmflag)1110 {1111$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1112 rename$state->{entries}{$filename}{modified_filename},$filename;11131114 # Calculate modes to remove1115 my$invmode= "";1116 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }11171118$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1119 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1120 }11211122 if ($rmflag)1123 {1124$log->info("Removing file '$filename'");1125 unlink($filename);1126 system("git-update-index", "--remove",$filename);1127 }1128 elsif ($addflag)1129 {1130$log->info("Adding file '$filename'");1131 system("git-update-index", "--add",$filename);1132 } else {1133$log->info("Updating file '$filename'");1134 system("git-update-index",$filename);1135 }1136 }11371138 unless ( scalar(@committedfiles) > 0 )1139 {1140 print "E No files to commit\n";1141 print "ok\n";1142 close LOCKFILE;1143 unlink($lockfile);1144 chdir "/";1145 return;1146 }11471148 my$treehash= `git-write-tree`;1149 my$parenthash= `cat $ENV{GIT_DIR}refs/heads/$state->{module}`;1150 chomp$treehash;1151 chomp$parenthash;11521153$log->debug("Treehash :$treehash, Parenthash :$parenthash");11541155 # write our commit message out if we have one ...1156 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1157 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1158 print$msg_fh"\n\nvia git-CVS emulator\n";1159 close$msg_fh;11601161 my$commithash= `git-commit-tree $treehash-p $parenthash<$msg_filename`;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";1168close LOCKFILE;1169unlink($lockfile);1170chdir"/";1171exit;1172}11731174print LOCKFILE $commithash;11751176$updater->update();11771178# foreach file specified on the command line ...1179foreachmy$filename(@committedfiles)1180{1181$filename= filecleanup($filename);11821183my$meta=$updater->getmeta($filename);11841185my($filepart,$dirpart) = filenamesplit($filename,1);11861187$log->debug("Checked-in$dirpart:$filename");11881189if($meta->{filehash}eq"deleted")1190{1191print"Remove-entry$dirpart\n";1192print"$filename\n";1193}else{1194print"Checked-in$dirpart\n";1195print"$filename\n";1196print"/$filepart/1.$meta->{revision}///\n";1197}1198}11991200close LOCKFILE;1201my$reffile="$ENV{GIT_DIR}refs/heads/$state->{module}";1202unlink($reffile);1203rename($lockfile,$reffile);1204chdir"/";12051206print"ok\n";1207}12081209sub req_status1210{1211my($cmd,$data) =@_;12121213 argsplit("status");12141215$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1216#$log->debug("status state : " . Dumper($state));12171218# Grab a handle to the SQLite db and do any necessary updates1219my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1220$updater->update();12211222# if no files were specified, we need to work out what files we should be providing status on ...1223 argsfromdir($updater);12241225# foreach file specified on the command line ...1226foreachmy$filename( @{$state->{args}} )1227{1228$filename= filecleanup($filename);12291230my$meta=$updater->getmeta($filename);1231my$oldmeta=$meta;12321233my$wrev= revparse($filename);12341235# If the working copy is an old revision, lets get that version too for comparison.1236if(defined($wrev)and$wrev!=$meta->{revision} )1237{1238$oldmeta=$updater->getmeta($filename,$wrev);1239}12401241# TODO : All possible statuses aren't yet implemented1242my$status;1243# Files are up to date if the working copy and repo copy have the same revision, and the working copy is unmodified1244$status="Up-to-date"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}1245and1246( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1247or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta->{filehash} ) )1248);12491250# Need checkout if the working copy has an older revision than the repo copy, and the working copy is unmodified1251$status||="Needs Checkout"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrev1252and1253($state->{entries}{$filename}{unchanged}1254or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash} ) )1255);12561257# Need checkout if it exists in the repo but doesn't have a working copy1258$status||="Needs Checkout"if(not defined($wrev)and defined($meta->{revision} ) );12591260# Locally modified if working copy and repo copy have the same revision but there are local changes1261$status||="Locally Modified"if(defined($wrev)and defined($meta->{revision})and$wrev==$meta->{revision}and$state->{entries}{$filename}{modified_filename} );12621263# Needs Merge if working copy revision is less than repo copy and there are local changes1264$status||="Needs Merge"if(defined($wrev)and defined($meta->{revision} )and$meta->{revision} >$wrevand$state->{entries}{$filename}{modified_filename} );12651266$status||="Locally Added"if(defined($state->{entries}{$filename}{revision} )and not defined($meta->{revision} ) );1267$status||="Locally Removed"if(defined($wrev)and defined($meta->{revision} )and-$wrev==$meta->{revision} );1268$status||="Unresolved Conflict"if(defined($state->{entries}{$filename}{conflict} )and$state->{entries}{$filename}{conflict} =~/^\+=/);1269$status||="File had conflicts on merge"if(0);12701271$status||="Unknown";12721273print"M ===================================================================\n";1274print"M File:$filename\tStatus:$status\n";1275if(defined($state->{entries}{$filename}{revision}) )1276{1277print"M Working revision:\t".$state->{entries}{$filename}{revision} ."\n";1278}else{1279print"M Working revision:\tNo entry for$filename\n";1280}1281if(defined($meta->{revision}) )1282{1283print"M Repository revision:\t1.".$meta->{revision} ."\t$state->{repository}/$filename,v\n";1284print"M Sticky Tag:\t\t(none)\n";1285print"M Sticky Date:\t\t(none)\n";1286print"M Sticky Options:\t\t(none)\n";1287}else{1288print"M Repository revision:\tNo revision control file\n";1289}1290print"M\n";1291}12921293print"ok\n";1294}12951296sub req_diff1297{1298my($cmd,$data) =@_;12991300 argsplit("diff");13011302$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1303#$log->debug("status state : " . Dumper($state));13041305my($revision1,$revision2);1306if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1307{1308$revision1=$state->{opt}{r}[0];1309$revision2=$state->{opt}{r}[1];1310}else{1311$revision1=$state->{opt}{r};1312}13131314$revision1=~s/^1\.//if(defined($revision1) );1315$revision2=~s/^1\.//if(defined($revision2) );13161317$log->debug("Diffing revisions ". (defined($revision1) ?$revision1:"[NULL]") ." and ". (defined($revision2) ?$revision2:"[NULL]") );13181319# Grab a handle to the SQLite db and do any necessary updates1320my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1321$updater->update();13221323# if no files were specified, we need to work out what files we should be providing status on ...1324 argsfromdir($updater);13251326# foreach file specified on the command line ...1327foreachmy$filename( @{$state->{args}} )1328{1329$filename= filecleanup($filename);13301331my($fh,$file1,$file2,$meta1,$meta2,$filediff);13321333my$wrev= revparse($filename);13341335# We need _something_ to diff against1336next unless(defined($wrev) );13371338# if we have a -r switch, use it1339if(defined($revision1) )1340{1341(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1342$meta1=$updater->getmeta($filename,$revision1);1343unless(defined($meta1)and$meta1->{filehash}ne"deleted")1344{1345print"E File$filenameat revision 1.$revision1doesn't exist\n";1346next;1347}1348 transmitfile($meta1->{filehash},$file1);1349}1350# otherwise we just use the working copy revision1351else1352{1353(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1354$meta1=$updater->getmeta($filename,$wrev);1355 transmitfile($meta1->{filehash},$file1);1356}13571358# if we have a second -r switch, use it too1359if(defined($revision2) )1360{1361(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1362$meta2=$updater->getmeta($filename,$revision2);13631364unless(defined($meta2)and$meta2->{filehash}ne"deleted")1365{1366print"E File$filenameat revision 1.$revision2doesn't exist\n";1367next;1368}13691370 transmitfile($meta2->{filehash},$file2);1371}1372# otherwise we just use the working copy1373else1374{1375$file2=$state->{entries}{$filename}{modified_filename};1376}13771378# if we have been given -r, and we don't have a $file2 yet, lets get one1379if(defined($revision1)and not defined($file2) )1380{1381(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1382$meta2=$updater->getmeta($filename,$wrev);1383 transmitfile($meta2->{filehash},$file2);1384}13851386# We need to have retrieved something useful1387next unless(defined($meta1) );13881389# Files to date if the working copy and repo copy have the same revision, and the working copy is unmodified1390next if(not defined($meta2)and$wrev==$meta1->{revision}1391and1392( ($state->{entries}{$filename}{unchanged}and(not defined($state->{entries}{$filename}{conflict} )or$state->{entries}{$filename}{conflict} !~/^\+=/) )1393or(defined($state->{entries}{$filename}{modified_hash})and$state->{entries}{$filename}{modified_hash}eq$meta1->{filehash} ) )1394);13951396# Apparently we only show diffs for locally modified files1397next unless(defined($meta2)or defined($state->{entries}{$filename}{modified_filename} ) );13981399print"M Index:$filename\n";1400print"M ===================================================================\n";1401print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1402print"M retrieving revision 1.$meta1->{revision}\n"if(defined($meta1) );1403print"M retrieving revision 1.$meta2->{revision}\n"if(defined($meta2) );1404print"M diff ";1405foreachmy$opt(keys%{$state->{opt}} )1406{1407if(ref$state->{opt}{$opt}eq"ARRAY")1408{1409foreachmy$value( @{$state->{opt}{$opt}} )1410{1411print"-$opt$value";1412}1413}else{1414print"-$opt";1415print"$state->{opt}{$opt} "if(defined($state->{opt}{$opt} ) );1416}1417}1418print"$filename\n";14191420$log->info("Diffing$filename-r$meta1->{revision} -r ". ($meta2->{revision}or"workingcopy"));14211422($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);14231424if(exists$state->{opt}{u} )1425{1426system("diff -u -L '$filenamerevision 1.$meta1->{revision}' -L '$filename". (defined($meta2->{revision}) ?"revision 1.$meta2->{revision}":"working copy") ."'$file1$file2>$filediff");1427}else{1428system("diff$file1$file2>$filediff");1429}14301431while( <$fh> )1432{1433print"M$_";1434}1435close$fh;1436}14371438print"ok\n";1439}14401441sub req_log1442{1443my($cmd,$data) =@_;14441445 argsplit("log");14461447$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1448#$log->debug("log state : " . Dumper($state));14491450my($minrev,$maxrev);1451if(defined($state->{opt}{r} )and$state->{opt}{r} =~/([\d.]+)?(::?)([\d.]+)?/)1452{1453my$control=$2;1454$minrev=$1;1455$maxrev=$3;1456$minrev=~s/^1\.//if(defined($minrev) );1457$maxrev=~s/^1\.//if(defined($maxrev) );1458$minrev++if(defined($minrev)and$controleq"::");1459}14601461# Grab a handle to the SQLite db and do any necessary updates1462my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1463$updater->update();14641465# if no files were specified, we need to work out what files we should be providing status on ...1466 argsfromdir($updater);14671468# foreach file specified on the command line ...1469foreachmy$filename( @{$state->{args}} )1470{1471$filename= filecleanup($filename);14721473my$headmeta=$updater->getmeta($filename);14741475my$revisions=$updater->getlog($filename);1476my$totalrevisions=scalar(@$revisions);14771478if(defined($minrev) )1479{1480$log->debug("Removing revisions less than$minrev");1481while(scalar(@$revisions) >0and$revisions->[-1]{revision} <$minrev)1482{1483pop@$revisions;1484}1485}1486if(defined($maxrev) )1487{1488$log->debug("Removing revisions greater than$maxrev");1489while(scalar(@$revisions) >0and$revisions->[0]{revision} >$maxrev)1490{1491shift@$revisions;1492}1493}14941495next unless(scalar(@$revisions) );14961497print"M\n";1498print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1499print"M Working file:$filename\n";1500print"M head: 1.$headmeta->{revision}\n";1501print"M branch:\n";1502print"M locks: strict\n";1503print"M access list:\n";1504print"M symbolic names:\n";1505print"M keyword substitution: kv\n";1506print"M total revisions:$totalrevisions;\tselected revisions: ".scalar(@$revisions) ."\n";1507print"M description:\n";15081509foreachmy$revision(@$revisions)1510{1511print"M ----------------------------\n";1512print"M revision 1.$revision->{revision}\n";1513# reformat the date for log output1514$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}) );1515$revision->{author} =~s/\s+.*//;1516$revision->{author} =~s/^(.{8}).*/$1/;1517print"M date:$revision->{modified}; author:$revision->{author}; state: ". ($revision->{filehash}eq"deleted"?"dead":"Exp") ."; lines: +2 -3\n";1518my$commitmessage=$updater->commitmessage($revision->{commithash});1519$commitmessage=~s/^/M /mg;1520print$commitmessage."\n";1521}1522print"M =============================================================================\n";1523}15241525print"ok\n";1526}15271528sub req_annotate1529{1530my($cmd,$data) =@_;15311532 argsplit("annotate");15331534$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));1535#$log->debug("status state : " . Dumper($state));15361537# Grab a handle to the SQLite db and do any necessary updates1538my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1539$updater->update();15401541# if no files were specified, we need to work out what files we should be providing annotate on ...1542 argsfromdir($updater);15431544# we'll need a temporary checkout dir1545my$tmpdir= tempdir ( DIR =>$TEMP_DIR);1546my(undef,$file_index) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);1547$log->info("Temp checkoutdir creation successful, basing annotate session work on '$tmpdir', index file is '$file_index'");15481549$ENV{GIT_DIR} =$state->{CVSROOT} ."/";1550$ENV{GIT_INDEX_FILE} =$file_index;15511552chdir$tmpdir;15531554# foreach file specified on the command line ...1555foreachmy$filename( @{$state->{args}} )1556{1557$filename= filecleanup($filename);15581559my$meta=$updater->getmeta($filename);15601561next unless($meta->{revision} );15621563# get all the commits that this file was in1564# in dense format -- aka skip dead revisions1565my$revisions=$updater->gethistorydense($filename);1566my$lastseenin=$revisions->[0][2];15671568# populate the temporary index based on the latest commit were we saw1569# the file -- but do it cheaply without checking out any files1570# TODO: if we got a revision from the client, use that instead1571# to look up the commithash in sqlite (still good to default to1572# the current head as we do now)1573system("git-read-tree",$lastseenin);1574unless($?==0)1575{1576die"Error running git-read-tree$lastseenin$file_index$!";1577}1578$log->info("Created index '$file_index' with commit$lastseenin- exit status$?");15791580# do a checkout of the file1581system('git-checkout-index','-f','-u',$filename);1582unless($?==0) {1583die"Error running git-checkout-index -f -u$filename:$!";1584}15851586$log->info("Annotate$filename");15871588# Prepare a file with the commits from the linearized1589# history that annotate should know about. This prevents1590# git-jsannotate telling us about commits we are hiding1591# from the client.15921593open(ANNOTATEHINTS,">$tmpdir/.annotate_hints")or die"Error opening >$tmpdir/.annotate_hints$!";1594for(my$i=0;$i<@$revisions;$i++)1595{1596print ANNOTATEHINTS $revisions->[$i][2];1597if($i+1<@$revisions) {# have we got a parent?1598print ANNOTATEHINTS ' '.$revisions->[$i+1][2];1599}1600print ANNOTATEHINTS "\n";1601}16021603print ANNOTATEHINTS "\n";1604close ANNOTATEHINTS;16051606my$annotatecmd='git-annotate';1607open(ANNOTATE,"-|",$annotatecmd,'-l','-S',"$tmpdir/.annotate_hints",$filename)1608or die"Error invoking$annotatecmd-l -S$tmpdir/.annotate_hints$filename:$!";1609my$metadata= {};1610print"E Annotations for$filename\n";1611print"E ***************\n";1612while( <ANNOTATE> )1613{1614if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)1615{1616my$commithash=$1;1617my$data=$2;1618unless(defined($metadata->{$commithash} ) )1619{1620$metadata->{$commithash} =$updater->getmeta($filename,$commithash);1621$metadata->{$commithash}{author} =~s/\s+.*//;1622$metadata->{$commithash}{author} =~s/^(.{8}).*/$1/;1623$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);1624}1625printf("M 1.%-5d (%-8s%10s):%s\n",1626$metadata->{$commithash}{revision},1627$metadata->{$commithash}{author},1628$metadata->{$commithash}{modified},1629$data1630);1631}else{1632$log->warn("Error in annotate output! LINE:$_");1633print"E Annotate error\n";1634next;1635}1636}1637close ANNOTATE;1638}16391640# done; get out of the tempdir1641chdir"/";16421643print"ok\n";16441645}16461647# This method takes the state->{arguments} array and produces two new arrays.1648# The first is $state->{args} which is everything before the '--' argument, and1649# the second is $state->{files} which is everything after it.1650sub argsplit1651{1652return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");16531654my$type=shift;16551656$state->{args} = [];1657$state->{files} = [];1658$state->{opt} = {};16591660if(defined($type) )1661{1662my$opt= {};1663$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");1664$opt= { v =>0, l =>0, R =>0}if($typeeq"status");1665$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");1666$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");1667$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");1668$opt= { k =>1, m =>1}if($typeeq"add");1669$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");1670$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");167116721673while(scalar( @{$state->{arguments}} ) >0)1674{1675my$arg=shift@{$state->{arguments}};16761677next if($argeq"--");1678next unless($arg=~/\S/);16791680# if the argument looks like a switch1681if($arg=~/^-(\w)(.*)/)1682{1683# if it's a switch that takes an argument1684if($opt->{$1} )1685{1686# If this switch has already been provided1687if($opt->{$1} >1and exists($state->{opt}{$1} ) )1688{1689$state->{opt}{$1} = [$state->{opt}{$1} ];1690if(length($2) >0)1691{1692push@{$state->{opt}{$1}},$2;1693}else{1694push@{$state->{opt}{$1}},shift@{$state->{arguments}};1695}1696}else{1697# if there's extra data in the arg, use that as the argument for the switch1698if(length($2) >0)1699{1700$state->{opt}{$1} =$2;1701}else{1702$state->{opt}{$1} =shift@{$state->{arguments}};1703}1704}1705}else{1706$state->{opt}{$1} =undef;1707}1708}1709else1710{1711push@{$state->{args}},$arg;1712}1713}1714}1715else1716{1717my$mode=0;17181719foreachmy$value( @{$state->{arguments}} )1720{1721if($valueeq"--")1722{1723$mode++;1724next;1725}1726push@{$state->{args}},$valueif($mode==0);1727push@{$state->{files}},$valueif($mode==1);1728}1729}1730}17311732# This method uses $state->{directory} to populate $state->{args} with a list of filenames1733sub argsfromdir1734{1735my$updater=shift;17361737$state->{args} = []if(scalar(@{$state->{args}}) ==1and$state->{args}[0]eq".");17381739return if(scalar( @{$state->{args}} ) >1);17401741my@gethead= @{$updater->gethead};17421743# push added files1744foreachmy$file(keys%{$state->{entries}}) {1745if(exists$state->{entries}{$file}{revision} &&1746$state->{entries}{$file}{revision} ==0)1747{1748push@gethead, { name =>$file, filehash =>'added'};1749}1750}17511752if(scalar(@{$state->{args}}) ==1)1753{1754my$arg=$state->{args}[0];1755$arg.=$state->{prependdir}if(defined($state->{prependdir} ) );17561757$log->info("Only one arg specified, checking for directory expansion on '$arg'");17581759foreachmy$file(@gethead)1760{1761next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1762next unless($file->{name} =~/^$arg\//or$file->{name}eq$arg);1763push@{$state->{args}},$file->{name};1764}17651766shift@{$state->{args}}if(scalar(@{$state->{args}}) >1);1767}else{1768$log->info("Only one arg specified, populating file list automatically");17691770$state->{args} = [];17711772foreachmy$file(@gethead)1773{1774next if($file->{filehash}eq"deleted"and not defined($state->{entries}{$file->{name}} ) );1775next unless($file->{name} =~s/^$state->{prependdir}//);1776push@{$state->{args}},$file->{name};1777}1778}1779}17801781# This method cleans up the $state variable after a command that uses arguments has run1782sub statecleanup1783{1784$state->{files} = [];1785$state->{args} = [];1786$state->{arguments} = [];1787$state->{entries} = {};1788}17891790sub revparse1791{1792my$filename=shift;17931794returnundefunless(defined($state->{entries}{$filename}{revision} ) );17951796return$1if($state->{entries}{$filename}{revision} =~/^1\.(\d+)/);1797return-$1if($state->{entries}{$filename}{revision} =~/^-1\.(\d+)/);17981799returnundef;1800}18011802# This method takes a file hash and does a CVS "file transfer" which transmits the1803# size of the file, and then the file contents.1804# If a second argument $targetfile is given, the file is instead written out to1805# a file by the name of $targetfile1806sub transmitfile1807{1808my$filehash=shift;1809my$targetfile=shift;18101811if(defined($filehash)and$filehasheq"deleted")1812{1813$log->warn("filehash is 'deleted'");1814return;1815}18161817die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);18181819my$type=`git-cat-file -t$filehash`;1820 chomp$type;18211822 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );18231824 my$size= `git-cat-file -s $filehash`;1825chomp$size;18261827$log->debug("transmitfile($filehash) size=$size, type=$type");18281829if(open my$fh,'-|',"git-cat-file","blob",$filehash)1830{1831if(defined($targetfile) )1832{1833open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");1834print NEWFILE $_while( <$fh> );1835close NEWFILE;1836}else{1837print"$size\n";1838printwhile( <$fh> );1839}1840close$fhor die("Couldn't close filehandle for transmitfile()");1841}else{1842die("Couldn't execute git-cat-file");1843}1844}18451846# This method takes a file name, and returns ( $dirpart, $filepart ) which1847# refers to the directory portion and the file portion of the filename1848# respectively1849sub filenamesplit1850{1851my$filename=shift;1852my$fixforlocaldir=shift;18531854my($filepart,$dirpart) = ($filename,".");1855($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );1856$dirpart.="/";18571858if($fixforlocaldir)1859{1860$dirpart=~s/^$state->{prependdir}//;1861}18621863return($filepart,$dirpart);1864}18651866sub filecleanup1867{1868my$filename=shift;18691870returnundefunless(defined($filename));1871if($filename=~/^\// )1872{1873print"E absolute filenames '$filename' not supported by server\n";1874returnundef;1875}18761877$filename=~s/^\.\///g;1878$filename=$state->{prependdir} .$filename;1879return$filename;1880}18811882package GITCVS::log;18831884####1885#### Copyright The Open University UK - 2006.1886####1887#### Authors: Martyn Smith <martyn@catalyst.net.nz>1888#### Martin Langhoff <martin@catalyst.net.nz>1889####1890####18911892use strict;1893use warnings;18941895=head1 NAME18961897GITCVS::log18981899=head1 DESCRIPTION19001901This module provides very crude logging with a similar interface to1902Log::Log4perl19031904=head1 METHODS19051906=cut19071908=head2 new19091910Creates a new log object, optionally you can specify a filename here to1911indicate the file to log to. If no log file is specified, you can specify one1912later with method setfile, or indicate you no longer want logging with method1913nofile.19141915Until one of these methods is called, all log calls will buffer messages ready1916to write out.19171918=cut1919sub new1920{1921my$class=shift;1922my$filename=shift;19231924my$self= {};19251926bless$self,$class;19271928if(defined($filename) )1929{1930open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1931}19321933return$self;1934}19351936=head2 setfile19371938This methods takes a filename, and attempts to open that file as the log file.1939If successful, all buffered data is written out to the file, and any further1940logging is written directly to the file.19411942=cut1943sub setfile1944{1945my$self=shift;1946my$filename=shift;19471948if(defined($filename) )1949{1950open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");1951}19521953return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");19541955while(my$line=shift@{$self->{buffer}} )1956{1957print{$self->{fh}}$line;1958}1959}19601961=head2 nofile19621963This method indicates no logging is going to be used. It flushes any entries in1964the internal buffer, and sets a flag to ensure no further data is put there.19651966=cut1967sub nofile1968{1969my$self=shift;19701971$self->{nolog} =1;19721973return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");19741975$self->{buffer} = [];1976}19771978=head2 _logopen19791980Internal method. Returns true if the log file is open, false otherwise.19811982=cut1983sub _logopen1984{1985my$self=shift;19861987return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");1988return0;1989}19901991=head2 debug info warn fatal19921993These four methods are wrappers to _log. They provide the actual interface for1994logging data.19951996=cut1997sub debug {my$self=shift;$self->_log("debug",@_); }1998sub info {my$self=shift;$self->_log("info",@_); }1999subwarn{my$self=shift;$self->_log("warn",@_); }2000sub fatal {my$self=shift;$self->_log("fatal",@_); }20012002=head2 _log20032004This is an internal method called by the logging functions. It generates a2005timestamp and pushes the logged line either to file, or internal buffer.20062007=cut2008sub _log2009{2010my$self=shift;2011my$level=shift;20122013return if($self->{nolog} );20142015my@time=localtime;2016my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",2017$time[5] +1900,2018$time[4] +1,2019$time[3],2020$time[2],2021$time[1],2022$time[0],2023uc$level,2024);20252026if($self->_logopen)2027{2028print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";2029}else{2030push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";2031}2032}20332034=head2 DESTROY20352036This method simply closes the file handle if one is open20372038=cut2039sub DESTROY2040{2041my$self=shift;20422043if($self->_logopen)2044{2045close$self->{fh};2046}2047}20482049package GITCVS::updater;20502051####2052#### Copyright The Open University UK - 2006.2053####2054#### Authors: Martyn Smith <martyn@catalyst.net.nz>2055#### Martin Langhoff <martin@catalyst.net.nz>2056####2057####20582059use strict;2060use warnings;2061use DBI;20622063=head1 METHODS20642065=cut20662067=head2 new20682069=cut2070sub new2071{2072my$class=shift;2073my$config=shift;2074my$module=shift;2075my$log=shift;20762077die"Need to specify a git repository"unless(defined($config)and-d $config);2078die"Need to specify a module"unless(defined($module) );20792080$class=ref($class) ||$class;20812082my$self= {};20832084bless$self,$class;20852086$self->{dbdir} =$config."/";2087die"Database dir '$self->{dbdir}' isn't a directory"unless(defined($self->{dbdir})and-d $self->{dbdir} );20882089$self->{module} =$module;2090$self->{file} =$self->{dbdir} ."/gitcvs.$module.sqlite";20912092$self->{git_path} =$config."/";20932094$self->{log} =$log;20952096die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );20972098$self->{dbh} = DBI->connect("dbi:SQLite:dbname=".$self->{file},"","");20992100$self->{tables} = {};2101foreachmy$table($self->{dbh}->tables)2102{2103$table=~s/^"//;2104$table=~s/"$//;2105$self->{tables}{$table} =1;2106}21072108# Construct the revision table if required2109unless($self->{tables}{revision} )2110{2111$self->{dbh}->do("2112 CREATE TABLE revision (2113 name TEXT NOT NULL,2114 revision INTEGER NOT NULL,2115 filehash TEXT NOT NULL,2116 commithash TEXT NOT NULL,2117 author TEXT NOT NULL,2118 modified TEXT NOT NULL,2119 mode TEXT NOT NULL2120 )2121 ");2122$self->{dbh}->do("2123 CREATE INDEX revision_ix12124 ON revision (name,revision)2125 ");2126$self->{dbh}->do("2127 CREATE INDEX revision_ix22128 ON revision (name,commithash)2129 ");2130}21312132# Construct the head table if required2133unless($self->{tables}{head} )2134{2135$self->{dbh}->do("2136 CREATE TABLE head (2137 name TEXT NOT NULL,2138 revision INTEGER NOT NULL,2139 filehash TEXT NOT NULL,2140 commithash TEXT NOT NULL,2141 author TEXT NOT NULL,2142 modified TEXT NOT NULL,2143 mode TEXT NOT NULL2144 )2145 ");2146$self->{dbh}->do("2147 CREATE INDEX head_ix12148 ON head (name)2149 ");2150}21512152# Construct the properties table if required2153unless($self->{tables}{properties} )2154{2155$self->{dbh}->do("2156 CREATE TABLE properties (2157 key TEXT NOT NULL PRIMARY KEY,2158 value TEXT2159 )2160 ");2161}21622163# Construct the commitmsgs table if required2164unless($self->{tables}{commitmsgs} )2165{2166$self->{dbh}->do("2167 CREATE TABLE commitmsgs (2168 key TEXT NOT NULL PRIMARY KEY,2169 value TEXT2170 )2171 ");2172}21732174return$self;2175}21762177=head2 update21782179=cut2180sub update2181{2182my$self=shift;21832184# first lets get the commit list2185$ENV{GIT_DIR} =$self->{git_path};21862187my$commitinfo=`git-cat-file commit$self->{module} 2>&1`;2188unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)2189{2190die("Invalid module '$self->{module}'");2191}219221932194my$git_log;2195my$lastcommit=$self->_get_prop("last_commit");21962197# Start exclusive lock here...2198$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";21992200# TODO: log processing is memory bound2201# if we can parse into a 2nd file that is in reverse order2202# we can probably do something really efficient2203my@git_log_params= ('--pretty','--parents','--topo-order');22042205if(defined$lastcommit) {2206push@git_log_params,"$lastcommit..$self->{module}";2207}else{2208push@git_log_params,$self->{module};2209}2210# git-rev-list is the backend / plumbing version of git-log2211open(GITLOG,'-|','git-rev-list',@git_log_params)or die"Cannot call git-rev-list:$!";22122213my@commits;22142215my%commit= ();22162217while( <GITLOG> )2218{2219chomp;2220if(m/^commit\s+(.*)$/) {2221# on ^commit lines put the just seen commit in the stack2222# and prime things for the next one2223if(keys%commit) {2224my%copy=%commit;2225unshift@commits, \%copy;2226%commit= ();2227}2228my@parents=split(m/\s+/,$1);2229$commit{hash} =shift@parents;2230$commit{parents} = \@parents;2231}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {2232# on rfc822-like lines seen before we see any message,2233# lowercase the entry and put it in the hash as key-value2234$commit{lc($1)} =$2;2235}else{2236# message lines - skip initial empty line2237# and trim whitespace2238if(!exists($commit{message}) &&m/^\s*$/) {2239# define it to mark the end of headers2240$commit{message} ='';2241next;2242}2243s/^\s+//;s/\s+$//;# trim ws2244$commit{message} .=$_."\n";2245}2246}2247close GITLOG;22482249unshift@commits, \%commitif(keys%commit);22502251# Now all the commits are in the @commits bucket2252# ordered by time DESC. for each commit that needs processing,2253# determine whether it's following the last head we've seen or if2254# it's on its own branch, grab a file list, and add whatever's changed2255# NOTE: $lastcommit refers to the last commit from previous run2256# $lastpicked is the last commit we picked in this run2257my$lastpicked;2258my$head= {};2259if(defined$lastcommit) {2260$lastpicked=$lastcommit;2261}22622263my$committotal=scalar(@commits);2264my$commitcount=0;22652266# Load the head table into $head (for cached lookups during the update process)2267foreachmy$file( @{$self->gethead()} )2268{2269$head->{$file->{name}} =$file;2270}22712272foreachmy$commit(@commits)2273{2274$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");2275if(defined$lastpicked)2276{2277if(!in_array($lastpicked, @{$commit->{parents}}))2278{2279# skip, we'll see this delta2280# as part of a merge later2281# warn "skipping off-track $commit->{hash}\n";2282next;2283}elsif(@{$commit->{parents}} >1) {2284# it is a merge commit, for each parent that is2285# not $lastpicked, see if we can get a log2286# from the merge-base to that parent to put it2287# in the message as a merge summary.2288my@parents= @{$commit->{parents}};2289foreachmy$parent(@parents) {2290# git-merge-base can potentially (but rarely) throw2291# several candidate merge bases. let's assume2292# that the first one is the best one.2293if($parenteq$lastpicked) {2294next;2295}2296open my$p,'git-merge-base '.$lastpicked.' '2297.$parent.'|';2298my@output= (<$p>);2299close$p;2300my$base=join('',@output);2301chomp$base;2302if($base) {2303my@merged;2304# print "want to log between $base $parent \n";2305open(GITLOG,'-|','git-log',"$base..$parent")2306or die"Cannot call git-log:$!";2307my$mergedhash;2308while(<GITLOG>) {2309chomp;2310if(!defined$mergedhash) {2311if(m/^commit\s+(.+)$/) {2312$mergedhash=$1;2313}else{2314next;2315}2316}else{2317# grab the first line that looks non-rfc8222318# aka has content after leading space2319if(m/^\s+(\S.*)$/) {2320my$title=$1;2321$title=substr($title,0,100);# truncate2322unshift@merged,"$mergedhash$title";2323undef$mergedhash;2324}2325}2326}2327close GITLOG;2328if(@merged) {2329$commit->{mergemsg} =$commit->{message};2330$commit->{mergemsg} .="\nSummary of merged commits:\n\n";2331foreachmy$summary(@merged) {2332$commit->{mergemsg} .="\t$summary\n";2333}2334$commit->{mergemsg} .="\n\n";2335# print "Message for $commit->{hash} \n$commit->{mergemsg}";2336}2337}2338}2339}2340}23412342# convert the date to CVS-happy format2343$commit->{date} ="$2$1$4$3$5"if($commit->{date} =~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/);23442345if(defined($lastpicked) )2346{2347my$filepipe=open(FILELIST,'-|','git-diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");2348local($/) ="\0";2349while( <FILELIST> )2350{2351chomp;2352unless(/^:\d{6}\s+\d{3}(\d)\d{2}\s+[a-zA-Z0-9]{40}\s+([a-zA-Z0-9]{40})\s+(\w)$/o)2353{2354die("Couldn't process git-diff-tree line :$_");2355}2356my($mode,$hash,$change) = ($1,$2,$3);2357my$name= <FILELIST>;2358chomp($name);23592360# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");23612362my$git_perms="";2363$git_perms.="r"if($mode&4);2364$git_perms.="w"if($mode&2);2365$git_perms.="x"if($mode&1);2366$git_perms="rw"if($git_permseq"");23672368if($changeeq"D")2369{2370#$log->debug("DELETE $name");2371$head->{$name} = {2372 name =>$name,2373 revision =>$head->{$name}{revision} +1,2374 filehash =>"deleted",2375 commithash =>$commit->{hash},2376 modified =>$commit->{date},2377 author =>$commit->{author},2378 mode =>$git_perms,2379};2380$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2381}2382elsif($changeeq"M")2383{2384#$log->debug("MODIFIED $name");2385$head->{$name} = {2386 name =>$name,2387 revision =>$head->{$name}{revision} +1,2388 filehash =>$hash,2389 commithash =>$commit->{hash},2390 modified =>$commit->{date},2391 author =>$commit->{author},2392 mode =>$git_perms,2393};2394$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2395}2396elsif($changeeq"A")2397{2398#$log->debug("ADDED $name");2399$head->{$name} = {2400 name =>$name,2401 revision =>1,2402 filehash =>$hash,2403 commithash =>$commit->{hash},2404 modified =>$commit->{date},2405 author =>$commit->{author},2406 mode =>$git_perms,2407};2408$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2409}2410else2411{2412$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");2413die;2414}2415}2416close FILELIST;2417}else{2418# this is used to detect files removed from the repo2419my$seen_files= {};24202421my$filepipe=open(FILELIST,'-|','git-ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");2422local$/="\0";2423while( <FILELIST> )2424{2425chomp;2426unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)2427{2428die("Couldn't process git-ls-tree line :$_");2429}24302431my($git_perms,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);24322433$seen_files->{$git_filename} =1;24342435my($oldhash,$oldrevision,$oldmode) = (2436$head->{$git_filename}{filehash},2437$head->{$git_filename}{revision},2438$head->{$git_filename}{mode}2439);24402441if($git_perms=~/^\d\d\d(\d)\d\d/o)2442{2443$git_perms="";2444$git_perms.="r"if($1&4);2445$git_perms.="w"if($1&2);2446$git_perms.="x"if($1&1);2447}else{2448$git_perms="rw";2449}24502451# unless the file exists with the same hash, we need to update it ...2452unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$git_perms)2453{2454my$newrevision= ($oldrevisionor0) +1;24552456$head->{$git_filename} = {2457 name =>$git_filename,2458 revision =>$newrevision,2459 filehash =>$git_hash,2460 commithash =>$commit->{hash},2461 modified =>$commit->{date},2462 author =>$commit->{author},2463 mode =>$git_perms,2464};246524662467$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$commit->{date},$commit->{author},$git_perms);2468}2469}2470close FILELIST;24712472# Detect deleted files2473foreachmy$file(keys%$head)2474{2475unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")2476{2477$head->{$file}{revision}++;2478$head->{$file}{filehash} ="deleted";2479$head->{$file}{commithash} =$commit->{hash};2480$head->{$file}{modified} =$commit->{date};2481$head->{$file}{author} =$commit->{author};24822483$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$commit->{date},$commit->{author},$head->{$file}{mode});2484}2485}2486# END : "Detect deleted files"2487}248824892490if(exists$commit->{mergemsg})2491{2492$self->insert_mergelog($commit->{hash},$commit->{mergemsg});2493}24942495$lastpicked=$commit->{hash};24962497$self->_set_prop("last_commit",$commit->{hash});2498}24992500$self->delete_head();2501foreachmy$file(keys%$head)2502{2503$self->insert_head(2504$file,2505$head->{$file}{revision},2506$head->{$file}{filehash},2507$head->{$file}{commithash},2508$head->{$file}{modified},2509$head->{$file}{author},2510$head->{$file}{mode},2511);2512}2513# invalidate the gethead cache2514$self->{gethead_cache} =undef;251525162517# Ending exclusive lock here2518$self->{dbh}->commit()or die"Failed to commit changes to SQLite";2519}25202521sub insert_rev2522{2523my$self=shift;2524my$name=shift;2525my$revision=shift;2526my$filehash=shift;2527my$commithash=shift;2528my$modified=shift;2529my$author=shift;2530my$mode=shift;25312532my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO revision (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2533$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);2534}25352536sub insert_mergelog2537{2538my$self=shift;2539my$key=shift;2540my$value=shift;25412542my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO commitmsgs (key, value) VALUES (?,?)",{},1);2543$insert_mergelog->execute($key,$value);2544}25452546sub delete_head2547{2548my$self=shift;25492550my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM head",{},1);2551$delete_head->execute();2552}25532554sub insert_head2555{2556my$self=shift;2557my$name=shift;2558my$revision=shift;2559my$filehash=shift;2560my$commithash=shift;2561my$modified=shift;2562my$author=shift;2563my$mode=shift;25642565my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO head (name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);2566$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);2567}25682569sub _headrev2570{2571my$self=shift;2572my$filename=shift;25732574my$db_query=$self->{dbh}->prepare_cached("SELECT filehash, revision, mode FROM head WHERE name=?",{},1);2575$db_query->execute($filename);2576my($hash,$revision,$mode) =$db_query->fetchrow_array;25772578return($hash,$revision,$mode);2579}25802581sub _get_prop2582{2583my$self=shift;2584my$key=shift;25852586my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM properties WHERE key=?",{},1);2587$db_query->execute($key);2588my($value) =$db_query->fetchrow_array;25892590return$value;2591}25922593sub _set_prop2594{2595my$self=shift;2596my$key=shift;2597my$value=shift;25982599my$db_query=$self->{dbh}->prepare_cached("UPDATE properties SET value=? WHERE key=?",{},1);2600$db_query->execute($value,$key);26012602unless($db_query->rows)2603{2604$db_query=$self->{dbh}->prepare_cached("INSERT INTO properties (key, value) VALUES (?,?)",{},1);2605$db_query->execute($key,$value);2606}26072608return$value;2609}26102611=head2 gethead26122613=cut26142615sub gethead2616{2617my$self=shift;26182619return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );26202621my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM head ORDER BY name ASC",{},1);2622$db_query->execute();26232624my$tree= [];2625while(my$file=$db_query->fetchrow_hashref)2626{2627push@$tree,$file;2628}26292630$self->{gethead_cache} =$tree;26312632return$tree;2633}26342635=head2 getlog26362637=cut26382639sub getlog2640{2641my$self=shift;2642my$filename=shift;26432644my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2645$db_query->execute($filename);26462647my$tree= [];2648while(my$file=$db_query->fetchrow_hashref)2649{2650push@$tree,$file;2651}26522653return$tree;2654}26552656=head2 getmeta26572658This function takes a filename (with path) argument and returns a hashref of2659metadata for that file.26602661=cut26622663sub getmeta2664{2665my$self=shift;2666my$filename=shift;2667my$revision=shift;26682669my$db_query;2670if(defined($revision)and$revision=~/^\d+$/)2671{2672$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND revision=?",{},1);2673$db_query->execute($filename,$revision);2674}2675elsif(defined($revision)and$revision=~/^[a-zA-Z0-9]{40}$/)2676{2677$db_query=$self->{dbh}->prepare_cached("SELECT * FROM revision WHERE name=? AND commithash=?",{},1);2678$db_query->execute($filename,$revision);2679}else{2680$db_query=$self->{dbh}->prepare_cached("SELECT * FROM head WHERE name=?",{},1);2681$db_query->execute($filename);2682}26832684return$db_query->fetchrow_hashref;2685}26862687=head2 commitmessage26882689this function takes a commithash and returns the commit message for that commit26902691=cut2692sub commitmessage2693{2694my$self=shift;2695my$commithash=shift;26962697die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);26982699my$db_query;2700$db_query=$self->{dbh}->prepare_cached("SELECT value FROM commitmsgs WHERE key=?",{},1);2701$db_query->execute($commithash);27022703my($message) =$db_query->fetchrow_array;27042705if(defined($message) )2706{2707$message.=" "if($message=~/\n$/);2708return$message;2709}27102711my@lines= safe_pipe_capture("git-cat-file","commit",$commithash);2712shift@lineswhile($lines[0] =~/\S/);2713$message=join("",@lines);2714$message.=" "if($message=~/\n$/);2715return$message;2716}27172718=head2 gethistory27192720This function takes a filename (with path) argument and returns an arrayofarrays2721containing revision,filehash,commithash ordered by revision descending27222723=cut2724sub gethistory2725{2726my$self=shift;2727my$filename=shift;27282729my$db_query;2730$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? ORDER BY revision DESC",{},1);2731$db_query->execute($filename);27322733return$db_query->fetchall_arrayref;2734}27352736=head2 gethistorydense27372738This function takes a filename (with path) argument and returns an arrayofarrays2739containing revision,filehash,commithash ordered by revision descending.27402741This version of gethistory skips deleted entries -- so it is useful for annotate.2742The 'dense' part is a reference to a '--dense' option available for git-rev-list2743and other git tools that depend on it.27442745=cut2746sub gethistorydense2747{2748my$self=shift;2749my$filename=shift;27502751my$db_query;2752$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM revision WHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);2753$db_query->execute($filename);27542755return$db_query->fetchall_arrayref;2756}27572758=head2 in_array()27592760from Array::PAT - mimics the in_array() function2761found in PHP. Yuck but works for small arrays.27622763=cut2764sub in_array2765{2766my($check,@array) =@_;2767my$retval=0;2768foreachmy$test(@array){2769if($checkeq$test){2770$retval=1;2771}2772}2773return$retval;2774}27752776=head2 safe_pipe_capture27772778an alternative to `command` that allows input to be passed as an array2779to work around shell problems with weird characters in arguments27802781=cut2782sub safe_pipe_capture {27832784my@output;27852786if(my$pid=open my$child,'-|') {2787@output= (<$child>);2788close$childor die join(' ',@_).":$!$?";2789}else{2790exec(@_)or die"$!$?";# exec() can fail the executable can't be found2791}2792returnwantarray?@output:join('',@output);2793}2794279527961;