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@laptop.org> 12#### 13#### 14#### Released under the GNU Public License, version 2. 15#### 16#### 17 18use5.008; 19use strict; 20use warnings; 21use bytes; 22 23use Fcntl; 24use File::Temp qw/tempdir tempfile/; 25use File::Path qw/rmtree/; 26use File::Basename; 27use Getopt::Long qw(:config require_order no_ignore_case); 28 29my$VERSION='@@GIT_VERSION@@'; 30 31my$log= GITCVS::log->new(); 32my$cfg; 33 34my$DATE_LIST= { 35 Jan =>"01", 36 Feb =>"02", 37 Mar =>"03", 38 Apr =>"04", 39 May =>"05", 40 Jun =>"06", 41 Jul =>"07", 42 Aug =>"08", 43 Sep =>"09", 44 Oct =>"10", 45 Nov =>"11", 46 Dec =>"12", 47}; 48 49# Enable autoflush for STDOUT (otherwise the whole thing falls apart) 50$| =1; 51 52#### Definition and mappings of functions #### 53 54# NOTE: Despite the existence of req_CATCHALL and req_EMPTY unimplemented 55# requests, this list is incomplete. It is missing many rarer/optional 56# requests. Perhaps some clients require a claim of support for 57# these specific requests for main functionality to work? 58my$methods= { 59'Root'=> \&req_Root, 60'Valid-responses'=> \&req_Validresponses, 61'valid-requests'=> \&req_validrequests, 62'Directory'=> \&req_Directory, 63'Sticky'=> \&req_Sticky, 64'Entry'=> \&req_Entry, 65'Modified'=> \&req_Modified, 66'Unchanged'=> \&req_Unchanged, 67'Questionable'=> \&req_Questionable, 68'Argument'=> \&req_Argument, 69'Argumentx'=> \&req_Argument, 70'expand-modules'=> \&req_expandmodules, 71'add'=> \&req_add, 72'remove'=> \&req_remove, 73'co'=> \&req_co, 74'update'=> \&req_update, 75'ci'=> \&req_ci, 76'diff'=> \&req_diff, 77'log'=> \&req_log, 78'rlog'=> \&req_log, 79'tag'=> \&req_CATCHALL, 80'status'=> \&req_status, 81'admin'=> \&req_CATCHALL, 82'history'=> \&req_CATCHALL, 83'watchers'=> \&req_EMPTY, 84'editors'=> \&req_EMPTY, 85'noop'=> \&req_EMPTY, 86'annotate'=> \&req_annotate, 87'Global_option'=> \&req_Globaloption, 88}; 89 90############################################## 91 92 93# $state holds all the bits of information the clients sends us that could 94# potentially be useful when it comes to actually _doing_ something. 95my$state= { prependdir =>''}; 96 97# Work is for managing temporary working directory 98my$work= 99{ 100state=>undef,# undef, 1 (empty), 2 (with stuff) 101 workDir =>undef, 102index=>undef, 103 emptyDir =>undef, 104 tmpDir =>undef 105}; 106 107$log->info("--------------- STARTING -----------------"); 108 109my$usage= 110"usage: git cvsserver [options] [pserver|server] [<directory> ...]\n". 111" --base-path <path> : Prepend to requested CVSROOT\n". 112" Can be read from GIT_CVSSERVER_BASE_PATH\n". 113" --strict-paths : Don't allow recursing into subdirectories\n". 114" --export-all : Don't check for gitcvs.enabled in config\n". 115" --version, -V : Print version information and exit\n". 116" -h, -H : Print usage information and exit\n". 117"\n". 118"<directory> ... is a list of allowed directories. If no directories\n". 119"are given, all are allowed. This is an additional restriction, gitcvs\n". 120"access still needs to be enabled by the gitcvs.enabled config option.\n". 121"Alternately, one directory may be specified in GIT_CVSSERVER_ROOT.\n"; 122 123my@opts= ('h|H','version|V', 124'base-path=s','strict-paths','export-all'); 125GetOptions($state,@opts) 126or die$usage; 127 128if($state->{version}) { 129print"git-cvsserver version$VERSION\n"; 130exit; 131} 132if($state->{help}) { 133print$usage; 134exit; 135} 136 137my$TEMP_DIR= tempdir( CLEANUP =>1); 138$log->debug("Temporary directory is '$TEMP_DIR'"); 139 140$state->{method} ='ext'; 141if(@ARGV) { 142if($ARGV[0]eq'pserver') { 143$state->{method} ='pserver'; 144shift@ARGV; 145}elsif($ARGV[0]eq'server') { 146shift@ARGV; 147} 148} 149 150# everything else is a directory 151$state->{allowed_roots} = [@ARGV]; 152 153# don't export the whole system unless the users requests it 154if($state->{'export-all'} && !@{$state->{allowed_roots}}) { 155die"--export-all can only be used together with an explicit whitelist\n"; 156} 157 158# Environment handling for running under git-shell 159if(exists$ENV{GIT_CVSSERVER_BASE_PATH}) { 160if($state->{'base-path'}) { 161die"Cannot specify base path both ways.\n"; 162} 163my$base_path=$ENV{GIT_CVSSERVER_BASE_PATH}; 164$state->{'base-path'} =$base_path; 165$log->debug("Picked up base path '$base_path' from environment.\n"); 166} 167if(exists$ENV{GIT_CVSSERVER_ROOT}) { 168if(@{$state->{allowed_roots}}) { 169die"Cannot specify roots both ways:@ARGV\n"; 170} 171my$allowed_root=$ENV{GIT_CVSSERVER_ROOT}; 172$state->{allowed_roots} = [$allowed_root]; 173$log->debug("Picked up allowed root '$allowed_root' from environment.\n"); 174} 175 176# if we are called with a pserver argument, 177# deal with the authentication cat before entering the 178# main loop 179if($state->{method}eq'pserver') { 180my$line= <STDIN>;chomp$line; 181unless($line=~/^BEGIN (AUTH|VERIFICATION) REQUEST$/) { 182die"E Do not understand$line- expecting BEGIN AUTH REQUEST\n"; 183} 184my$request=$1; 185$line= <STDIN>;chomp$line; 186unless(req_Root('root',$line)) {# reuse Root 187print"E Invalid root$line\n"; 188exit1; 189} 190$line= <STDIN>;chomp$line; 191my$user=$line; 192$line= <STDIN>;chomp$line; 193my$password=$line; 194 195if($usereq'anonymous') { 196# "A" will be 1 byte, use length instead in case the 197# encryption method ever changes (yeah, right!) 198if(length($password) >1) { 199print"E Don't supply a password for the `anonymous' user\n"; 200print"I HATE YOU\n"; 201exit1; 202} 203 204# Fall through to LOVE 205}else{ 206# Trying to authenticate a user 207if(not exists$cfg->{gitcvs}->{authdb}) { 208print"E the repo config file needs a [gitcvs] section with an 'authdb' parameter set to the filename of the authentication database\n"; 209print"I HATE YOU\n"; 210exit1; 211} 212 213my$authdb=$cfg->{gitcvs}->{authdb}; 214 215unless(-e $authdb) { 216print"E The authentication database specified in [gitcvs.authdb] does not exist\n"; 217print"I HATE YOU\n"; 218exit1; 219} 220 221my$auth_ok; 222open my$passwd,"<",$authdbor die$!; 223while(<$passwd>) { 224if(m{^\Q$user\E:(.*)}) { 225if(crypt($user, descramble($password))eq$1) { 226$auth_ok=1; 227} 228}; 229} 230close$passwd; 231 232unless($auth_ok) { 233print"I HATE YOU\n"; 234exit1; 235} 236 237# Fall through to LOVE 238} 239 240# For checking whether the user is anonymous on commit 241$state->{user} =$user; 242 243$line= <STDIN>;chomp$line; 244unless($lineeq"END$requestREQUEST") { 245die"E Do not understand$line-- expecting END$requestREQUEST\n"; 246} 247print"I LOVE YOU\n"; 248exit if$requesteq'VERIFICATION';# cvs login 249# and now back to our regular programme... 250} 251 252# Keep going until the client closes the connection 253while(<STDIN>) 254{ 255chomp; 256 257# Check to see if we've seen this method, and call appropriate function. 258if(/^([\w-]+)(?:\s+(.*))?$/and defined($methods->{$1}) ) 259{ 260# use the $methods hash to call the appropriate sub for this command 261#$log->info("Method : $1"); 262&{$methods->{$1}}($1,$2); 263}else{ 264# log fatal because we don't understand this function. If this happens 265# we're fairly screwed because we don't know if the client is expecting 266# a response. If it is, the client will hang, we'll hang, and the whole 267# thing will be custard. 268$log->fatal("Don't understand command$_\n"); 269die("Unknown command$_"); 270} 271} 272 273$log->debug("Processing time : user=". (times)[0] ." system=". (times)[1]); 274$log->info("--------------- FINISH -----------------"); 275 276chdir'/'; 277exit0; 278 279# Magic catchall method. 280# This is the method that will handle all commands we haven't yet 281# implemented. It simply sends a warning to the log file indicating a 282# command that hasn't been implemented has been invoked. 283sub req_CATCHALL 284{ 285my($cmd,$data) =@_; 286$log->warn("Unhandled command : req_$cmd:$data"); 287} 288 289# This method invariably succeeds with an empty response. 290sub req_EMPTY 291{ 292print"ok\n"; 293} 294 295# Root pathname \n 296# Response expected: no. Tell the server which CVSROOT to use. Note that 297# pathname is a local directory and not a fully qualified CVSROOT variable. 298# pathname must already exist; if creating a new root, use the init 299# request, not Root. pathname does not include the hostname of the server, 300# how to access the server, etc.; by the time the CVS protocol is in use, 301# connection, authentication, etc., are already taken care of. The Root 302# request must be sent only once, and it must be sent before any requests 303# other than Valid-responses, valid-requests, UseUnchanged, Set or init. 304sub req_Root 305{ 306my($cmd,$data) =@_; 307$log->debug("req_Root :$data"); 308 309unless($data=~ m#^/#) { 310print"error 1 Root must be an absolute pathname\n"; 311return0; 312} 313 314my$cvsroot=$state->{'base-path'} ||''; 315$cvsroot=~ s#/+$##; 316$cvsroot.=$data; 317 318if($state->{CVSROOT} 319&& ($state->{CVSROOT}ne$cvsroot)) { 320print"error 1 Conflicting roots specified\n"; 321return0; 322} 323 324$state->{CVSROOT} =$cvsroot; 325 326$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 327 328if(@{$state->{allowed_roots}}) { 329my$allowed=0; 330foreachmy$dir(@{$state->{allowed_roots}}) { 331next unless$dir=~ m#^/#; 332$dir=~ s#/+$##; 333if($state->{'strict-paths'}) { 334if($ENV{GIT_DIR} =~ m#^\Q$dir\E/?$#) { 335$allowed=1; 336last; 337} 338}elsif($ENV{GIT_DIR} =~ m#^\Q$dir\E(/?$|/)#) { 339$allowed=1; 340last; 341} 342} 343 344unless($allowed) { 345print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 346print"E\n"; 347print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 348return0; 349} 350} 351 352unless(-d $ENV{GIT_DIR} && -e $ENV{GIT_DIR}.'HEAD') { 353print"E$ENV{GIT_DIR} does not seem to be a valid GIT repository\n"; 354print"E\n"; 355print"error 1$ENV{GIT_DIR} is not a valid repository\n"; 356return0; 357} 358 359my@gitvars= safe_pipe_capture(qw(git config -l)); 360if($?) { 361print"E problems executing git-config on the server -- this is not a git repository or the PATH is not set correctly.\n"; 362print"E\n"; 363print"error 1 - problem executing git-config\n"; 364return0; 365} 366foreachmy$line(@gitvars) 367{ 368next unless($line=~/^(gitcvs)\.(?:(ext|pserver)\.)?([\w-]+)=(.*)$/); 369unless($2) { 370$cfg->{$1}{$3} =$4; 371}else{ 372$cfg->{$1}{$2}{$3} =$4; 373} 374} 375 376my$enabled= ($cfg->{gitcvs}{$state->{method}}{enabled} 377||$cfg->{gitcvs}{enabled}); 378unless($state->{'export-all'} || 379($enabled&&$enabled=~/^\s*(1|true|yes)\s*$/i)) { 380print"E GITCVS emulation needs to be enabled on this repo\n"; 381print"E the repo config file needs a [gitcvs] section added, and the parameter 'enabled' set to 1\n"; 382print"E\n"; 383print"error 1 GITCVS emulation disabled\n"; 384return0; 385} 386 387my$logfile=$cfg->{gitcvs}{$state->{method}}{logfile} ||$cfg->{gitcvs}{logfile}; 388if($logfile) 389{ 390$log->setfile($logfile); 391}else{ 392$log->nofile(); 393} 394 395return1; 396} 397 398# Global_option option \n 399# Response expected: no. Transmit one of the global options `-q', `-Q', 400# `-l', `-t', `-r', or `-n'. option must be one of those strings, no 401# variations (such as combining of options) are allowed. For graceful 402# handling of valid-requests, it is probably better to make new global 403# options separate requests, rather than trying to add them to this 404# request. 405sub req_Globaloption 406{ 407my($cmd,$data) =@_; 408$log->debug("req_Globaloption :$data"); 409$state->{globaloptions}{$data} =1; 410} 411 412# Valid-responses request-list \n 413# Response expected: no. Tell the server what responses the client will 414# accept. request-list is a space separated list of tokens. 415sub req_Validresponses 416{ 417my($cmd,$data) =@_; 418$log->debug("req_Validresponses :$data"); 419 420# TODO : re-enable this, currently it's not particularly useful 421#$state->{validresponses} = [ split /\s+/, $data ]; 422} 423 424# valid-requests \n 425# Response expected: yes. Ask the server to send back a Valid-requests 426# response. 427sub req_validrequests 428{ 429my($cmd,$data) =@_; 430 431$log->debug("req_validrequests"); 432 433$log->debug("SEND : Valid-requests ".join(" ",sort keys%$methods)); 434$log->debug("SEND : ok"); 435 436print"Valid-requests ".join(" ",sort keys%$methods) ."\n"; 437print"ok\n"; 438} 439 440# Directory local-directory \n 441# Additional data: repository \n. Response expected: no. Tell the server 442# what directory to use. The repository should be a directory name from a 443# previous server response. Note that this both gives a default for Entry 444# and Modified and also for ci and the other commands; normal usage is to 445# send Directory for each directory in which there will be an Entry or 446# Modified, and then a final Directory for the original directory, then the 447# command. The local-directory is relative to the top level at which the 448# command is occurring (i.e. the last Directory which is sent before the 449# command); to indicate that top level, `.' should be sent for 450# local-directory. 451sub req_Directory 452{ 453my($cmd,$data) =@_; 454 455my$repository= <STDIN>; 456chomp$repository; 457 458 459$state->{localdir} =$data; 460$state->{repository} =$repository; 461$state->{path} =$repository; 462$state->{path} =~s/^\Q$state->{CVSROOT}\E\///; 463$state->{module} =$1if($state->{path} =~s/^(.*?)(\/|$)//); 464$state->{path} .="/"if($state->{path} =~ /\S/ ); 465 466$state->{directory} =$state->{localdir}; 467$state->{directory} =""if($state->{directory}eq"."); 468$state->{directory} .="/"if($state->{directory} =~ /\S/ ); 469 470if( (not defined($state->{prependdir})or$state->{prependdir}eq'')and$state->{localdir}eq"."and$state->{path} =~/\S/) 471{ 472$log->info("Setting prepend to '$state->{path}'"); 473$state->{prependdir} =$state->{path}; 474my%entries; 475foreachmy$entry(keys%{$state->{entries}} ) 476{ 477$entries{$state->{prependdir} .$entry} =$state->{entries}{$entry}; 478} 479$state->{entries}=\%entries; 480 481my%dirMap; 482foreachmy$dir(keys%{$state->{dirMap}} ) 483{ 484$dirMap{$state->{prependdir} .$dir} =$state->{dirMap}{$dir}; 485} 486$state->{dirMap}=\%dirMap; 487} 488 489if(defined($state->{prependdir} ) ) 490{ 491$log->debug("Prepending '$state->{prependdir}' to state|directory"); 492$state->{directory} =$state->{prependdir} .$state->{directory} 493} 494 495if( !defined($state->{dirMap}{$state->{directory}}) ) 496{ 497$state->{dirMap}{$state->{directory}} = 498{ 499'names'=> {} 500#'tagspec' => undef 501}; 502} 503 504$log->debug("req_Directory : localdir=$datarepository=$repositorypath=$state->{path} directory=$state->{directory} module=$state->{module}"); 505} 506 507# Sticky tagspec \n 508# Response expected: no. Tell the server that the directory most 509# recently specified with Directory has a sticky tag or date 510# tagspec. The first character of tagspec is T for a tag, D for 511# a date, or some other character supplied by a Set-sticky 512# response from a previous request to the server. The remainder 513# of tagspec contains the actual tag or date, again as supplied 514# by Set-sticky. 515# The server should remember Static-directory and Sticky requests 516# for a particular directory; the client need not resend them each 517# time it sends a Directory request for a given directory. However, 518# the server is not obliged to remember them beyond the context 519# of a single command. 520sub req_Sticky 521{ 522my($cmd,$tagspec) =@_; 523 524my($stickyInfo); 525if($tagspeceq"") 526{ 527# nothing 528} 529elsif($tagspec=~/^T([^ ]+)\s*$/) 530{ 531$stickyInfo= {'tag'=>$1}; 532} 533elsif($tagspec=~/^D([0-9.]+)\s*$/) 534{ 535$stickyInfo= {'date'=>$1}; 536} 537else 538{ 539die"Unknown tag_or_date format\n"; 540} 541$state->{dirMap}{$state->{directory}}{stickyInfo}=$stickyInfo; 542 543$log->debug("req_Sticky : tagspec=$tagspecrepository=$state->{repository}" 544." path=$state->{path} directory=$state->{directory}" 545." module=$state->{module}"); 546} 547 548# Entry entry-line \n 549# Response expected: no. Tell the server what version of a file is on the 550# local machine. The name in entry-line is a name relative to the directory 551# most recently specified with Directory. If the user is operating on only 552# some files in a directory, Entry requests for only those files need be 553# included. If an Entry request is sent without Modified, Is-modified, or 554# Unchanged, it means the file is lost (does not exist in the working 555# directory). If both Entry and one of Modified, Is-modified, or Unchanged 556# are sent for the same file, Entry must be sent first. For a given file, 557# one can send Modified, Is-modified, or Unchanged, but not more than one 558# of these three. 559sub req_Entry 560{ 561my($cmd,$data) =@_; 562 563#$log->debug("req_Entry : $data"); 564 565my@data=split(/\//,$data, -1); 566 567$state->{entries}{$state->{directory}.$data[1]} = { 568 revision =>$data[2], 569 conflict =>$data[3], 570 options =>$data[4], 571 tag_or_date =>$data[5], 572}; 573 574$state->{dirMap}{$state->{directory}}{names}{$data[1]} ='F'; 575 576$log->info("Received entry line '$data' => '".$state->{directory} .$data[1] ."'"); 577} 578 579# Questionable filename \n 580# Response expected: no. Additional data: no. Tell the server to check 581# whether filename should be ignored, and if not, next time the server 582# sends responses, send (in a M response) `?' followed by the directory and 583# filename. filename must not contain `/'; it needs to be a file in the 584# directory named by the most recent Directory request. 585sub req_Questionable 586{ 587my($cmd,$data) =@_; 588 589$log->debug("req_Questionable :$data"); 590$state->{entries}{$state->{directory}.$data}{questionable} =1; 591} 592 593# add \n 594# Response expected: yes. Add a file or directory. This uses any previous 595# Argument, Directory, Entry, or Modified requests, if they have been sent. 596# The last Directory sent specifies the working directory at the time of 597# the operation. To add a directory, send the directory to be added using 598# Directory and Argument requests. 599sub req_add 600{ 601my($cmd,$data) =@_; 602 603 argsplit("add"); 604 605my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 606$updater->update(); 607 608my$addcount=0; 609 610foreachmy$filename( @{$state->{args}} ) 611{ 612$filename= filecleanup($filename); 613 614# no -r, -A, or -D with add 615my$stickyInfo= resolveStickyInfo($filename); 616 617my$meta=$updater->getmeta($filename,$stickyInfo); 618my$wrev= revparse($filename); 619 620if($wrev&&$meta&& ($wrev=~/^-/)) 621{ 622# previously removed file, add back 623$log->info("added file$filenamewas previously removed, send$meta->{revision}"); 624 625print"MT +updated\n"; 626print"MT text U\n"; 627print"MT fname$filename\n"; 628print"MT newline\n"; 629print"MT -updated\n"; 630 631unless($state->{globaloptions}{-n} ) 632{ 633my($filepart,$dirpart) = filenamesplit($filename,1); 634 635print"Created$dirpart\n"; 636print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 637 638# this is an "entries" line 639my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 640my$entryLine="/$filepart/$meta->{revision}//$kopts/"; 641$entryLine.= getStickyTagOrDate($stickyInfo); 642$log->debug($entryLine); 643print"$entryLine\n"; 644# permissions 645$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 646print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 647# transmit file 648 transmitfile($meta->{filehash}); 649} 650 651next; 652} 653 654unless(defined($state->{entries}{$filename}{modified_filename} ) ) 655{ 656print"E cvs add: nothing known about `$filename'\n"; 657next; 658} 659# TODO : check we're not squashing an already existing file 660if(defined($state->{entries}{$filename}{revision} ) ) 661{ 662print"E cvs add: `$filename' has already been entered\n"; 663next; 664} 665 666my($filepart,$dirpart) = filenamesplit($filename,1); 667 668print"E cvs add: scheduling file `$filename' for addition\n"; 669 670print"Checked-in$dirpart\n"; 671print"$filename\n"; 672my$kopts= kopts_from_path($filename,"file", 673$state->{entries}{$filename}{modified_filename}); 674print"/$filepart/0//$kopts/". 675 getStickyTagOrDate($stickyInfo) ."\n"; 676 677my$requestedKopts=$state->{opt}{k}; 678if(defined($requestedKopts)) 679{ 680$requestedKopts="-k$requestedKopts"; 681} 682else 683{ 684$requestedKopts=""; 685} 686if($koptsne$requestedKopts) 687{ 688$log->warn("Ignoring requested -k='$requestedKopts'" 689." for '$filename'; detected -k='$kopts' instead"); 690#TODO: Also have option to send warning to user? 691} 692 693$addcount++; 694} 695 696if($addcount==1) 697{ 698print"E cvs add: use `cvs commit' to add this file permanently\n"; 699} 700elsif($addcount>1) 701{ 702print"E cvs add: use `cvs commit' to add these files permanently\n"; 703} 704 705print"ok\n"; 706} 707 708# remove \n 709# Response expected: yes. Remove a file. This uses any previous Argument, 710# Directory, Entry, or Modified requests, if they have been sent. The last 711# Directory sent specifies the working directory at the time of the 712# operation. Note that this request does not actually do anything to the 713# repository; the only effect of a successful remove request is to supply 714# the client with a new entries line containing `-' to indicate a removed 715# file. In fact, the client probably could perform this operation without 716# contacting the server, although using remove may cause the server to 717# perform a few more checks. The client sends a subsequent ci request to 718# actually record the removal in the repository. 719sub req_remove 720{ 721my($cmd,$data) =@_; 722 723 argsplit("remove"); 724 725# Grab a handle to the SQLite db and do any necessary updates 726my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 727$updater->update(); 728 729#$log->debug("add state : " . Dumper($state)); 730 731my$rmcount=0; 732 733foreachmy$filename( @{$state->{args}} ) 734{ 735$filename= filecleanup($filename); 736 737if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 738{ 739print"E cvs remove: file `$filename' still in working directory\n"; 740next; 741} 742 743# only from entries 744my$stickyInfo= resolveStickyInfo($filename); 745 746my$meta=$updater->getmeta($filename,$stickyInfo); 747my$wrev= revparse($filename); 748 749unless(defined($wrev) ) 750{ 751print"E cvs remove: nothing known about `$filename'\n"; 752next; 753} 754 755if(defined($wrev)and($wrev=~/^-/) ) 756{ 757print"E cvs remove: file `$filename' already scheduled for removal\n"; 758next; 759} 760 761unless($wreveq$meta->{revision} ) 762{ 763# TODO : not sure if the format of this message is quite correct. 764print"E cvs remove: Up to date check failed for `$filename'\n"; 765next; 766} 767 768 769my($filepart,$dirpart) = filenamesplit($filename,1); 770 771print"E cvs remove: scheduling `$filename' for removal\n"; 772 773print"Checked-in$dirpart\n"; 774print"$filename\n"; 775my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 776print"/$filepart/-$wrev//$kopts/". getStickyTagOrDate($stickyInfo) ."\n"; 777 778$rmcount++; 779} 780 781if($rmcount==1) 782{ 783print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 784} 785elsif($rmcount>1) 786{ 787print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 788} 789 790print"ok\n"; 791} 792 793# Modified filename \n 794# Response expected: no. Additional data: mode, \n, file transmission. Send 795# the server a copy of one locally modified file. filename is a file within 796# the most recent directory sent with Directory; it must not contain `/'. 797# If the user is operating on only some files in a directory, only those 798# files need to be included. This can also be sent without Entry, if there 799# is no entry for the file. 800sub req_Modified 801{ 802my($cmd,$data) =@_; 803 804my$mode= <STDIN>; 805defined$mode 806or(print"E end of file reading mode for$data\n"),return; 807chomp$mode; 808my$size= <STDIN>; 809defined$size 810or(print"E end of file reading size of$data\n"),return; 811chomp$size; 812 813# Grab config information 814my$blocksize=8192; 815my$bytesleft=$size; 816my$tmp; 817 818# Get a filehandle/name to write it to 819my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 820 821# Loop over file data writing out to temporary file. 822while($bytesleft) 823{ 824$blocksize=$bytesleftif($bytesleft<$blocksize); 825read STDIN,$tmp,$blocksize; 826print$fh $tmp; 827$bytesleft-=$blocksize; 828} 829 830close$fh 831or(print"E failed to write temporary,$filename:$!\n"),return; 832 833# Ensure we have something sensible for the file mode 834if($mode=~/u=(\w+)/) 835{ 836$mode=$1; 837}else{ 838$mode="rw"; 839} 840 841# Save the file data in $state 842$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 843$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 844$state->{entries}{$state->{directory}.$data}{modified_hash} = safe_pipe_capture('git','hash-object',$filename); 845$state->{entries}{$state->{directory}.$data}{modified_hash} =~s/\s.*$//s; 846 847#$log->debug("req_Modified : file=$data mode=$mode size=$size"); 848} 849 850# Unchanged filename \n 851# Response expected: no. Tell the server that filename has not been 852# modified in the checked out directory. The filename is a file within the 853# most recent directory sent with Directory; it must not contain `/'. 854sub req_Unchanged 855{ 856my($cmd,$data) =@_; 857 858$state->{entries}{$state->{directory}.$data}{unchanged} =1; 859 860#$log->debug("req_Unchanged : $data"); 861} 862 863# Argument text \n 864# Response expected: no. Save argument for use in a subsequent command. 865# Arguments accumulate until an argument-using command is given, at which 866# point they are forgotten. 867# Argumentx text \n 868# Response expected: no. Append \n followed by text to the current argument 869# being saved. 870sub req_Argument 871{ 872my($cmd,$data) =@_; 873 874# Argumentx means: append to last Argument (with a newline in front) 875 876$log->debug("$cmd:$data"); 877 878if($cmdeq'Argumentx') { 879${$state->{arguments}}[$#{$state->{arguments}}] .="\n".$data; 880}else{ 881push@{$state->{arguments}},$data; 882} 883} 884 885# expand-modules \n 886# Response expected: yes. Expand the modules which are specified in the 887# arguments. Returns the data in Module-expansion responses. Note that the 888# server can assume that this is checkout or export, not rtag or rdiff; the 889# latter do not access the working directory and thus have no need to 890# expand modules on the client side. Expand may not be the best word for 891# what this request does. It does not necessarily tell you all the files 892# contained in a module, for example. Basically it is a way of telling you 893# which working directories the server needs to know about in order to 894# handle a checkout of the specified modules. For example, suppose that the 895# server has a module defined by 896# aliasmodule -a 1dir 897# That is, one can check out aliasmodule and it will take 1dir in the 898# repository and check it out to 1dir in the working directory. Now suppose 899# the client already has this module checked out and is planning on using 900# the co request to update it. Without using expand-modules, the client 901# would have two bad choices: it could either send information about all 902# working directories under the current directory, which could be 903# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 904# stands for 1dir, and neglect to send information for 1dir, which would 905# lead to incorrect operation. With expand-modules, the client would first 906# ask for the module to be expanded: 907sub req_expandmodules 908{ 909my($cmd,$data) =@_; 910 911 argsplit(); 912 913$log->debug("req_expandmodules : ". (defined($data) ?$data:"[NULL]") ); 914 915unless(ref$state->{arguments}eq"ARRAY") 916{ 917print"ok\n"; 918return; 919} 920 921foreachmy$module( @{$state->{arguments}} ) 922{ 923$log->debug("SEND : Module-expansion$module"); 924print"Module-expansion$module\n"; 925} 926 927print"ok\n"; 928 statecleanup(); 929} 930 931# co \n 932# Response expected: yes. Get files from the repository. This uses any 933# previous Argument, Directory, Entry, or Modified requests, if they have 934# been sent. Arguments to this command are module names; the client cannot 935# know what directories they correspond to except by (1) just sending the 936# co request, and then seeing what directory names the server sends back in 937# its responses, and (2) the expand-modules request. 938sub req_co 939{ 940my($cmd,$data) =@_; 941 942 argsplit("co"); 943 944# Provide list of modules, if -c was used. 945if(exists$state->{opt}{c}) { 946my$showref= safe_pipe_capture(qw(git show-ref --heads)); 947formy$line(split'\n',$showref) { 948if($line=~ m% refs/heads/(.*)$%) { 949print"M$1\t$1\n"; 950} 951} 952print"ok\n"; 953return1; 954} 955 956my$stickyInfo= {'tag'=>$state->{opt}{r}, 957'date'=>$state->{opt}{D} }; 958 959my$module=$state->{args}[0]; 960$state->{module} =$module; 961my$checkout_path=$module; 962 963# use the user specified directory if we're given it 964$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 965 966$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 967 968$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 969 970$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 971 972# Grab a handle to the SQLite db and do any necessary updates 973my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 974$updater->update(); 975 976my$headHash; 977if(defined($stickyInfo) &&defined($stickyInfo->{tag}) ) 978{ 979$headHash=$updater->lookupCommitRef($stickyInfo->{tag}); 980if( !defined($headHash) ) 981{ 982print"error 1 no such tag `$stickyInfo->{tag}'\n"; 983 cleanupWorkTree(); 984exit; 985} 986} 987 988$checkout_path=~ s|/$||;# get rid of trailing slashes 989 990my%seendirs= (); 991my$lastdir=''; 992 993 prepDirForOutput( 994".", 995$state->{CVSROOT} ."/$module", 996$checkout_path, 997 \%seendirs, 998'checkout', 999$state->{dirArgs} );10001001foreachmy$git( @{$updater->getAnyHead($headHash)} )1002{1003# Don't want to check out deleted files1004next if($git->{filehash}eq"deleted");10051006my$fullName=$git->{name};1007($git->{name},$git->{dir} ) = filenamesplit($git->{name});10081009unless(exists($seendirs{$git->{dir}})) {1010 prepDirForOutput($git->{dir},$state->{CVSROOT} ."/$module/",1011$checkout_path, \%seendirs,'checkout',1012$state->{dirArgs} );1013$lastdir=$git->{dir};1014$seendirs{$git->{dir}} =1;1015}10161017# modification time of this file1018print"Mod-time$git->{modified}\n";10191020# print some information to the client1021if(defined($git->{dir} )and$git->{dir}ne"./")1022{1023print"M U$checkout_path/$git->{dir}$git->{name}\n";1024}else{1025print"M U$checkout_path/$git->{name}\n";1026}10271028# instruct client we're sending a file to put in this path1029print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n";10301031print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n";10321033# this is an "entries" line1034my$kopts= kopts_from_path($fullName,"sha1",$git->{filehash});1035print"/$git->{name}/$git->{revision}//$kopts/".1036 getStickyTagOrDate($stickyInfo) ."\n";1037# permissions1038print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";10391040# transmit file1041 transmitfile($git->{filehash});1042}10431044print"ok\n";10451046 statecleanup();1047}10481049# used by req_co and req_update to set up directories for files1050# recursively handles parents1051sub prepDirForOutput1052{1053my($dir,$repodir,$remotedir,$seendirs,$request,$dirArgs) =@_;10541055my$parent= dirname($dir);1056$dir=~ s|/+$||;1057$repodir=~ s|/+$||;1058$remotedir=~ s|/+$||;1059$parent=~ s|/+$||;10601061if($parenteq'.'||$parenteq'./')1062{1063$parent='';1064}1065# recurse to announce unseen parents first1066if(length($parent) &&1067!exists($seendirs->{$parent}) &&1068($requesteq"checkout"||1069exists($dirArgs->{$parent}) ) )1070{1071 prepDirForOutput($parent,$repodir,$remotedir,1072$seendirs,$request,$dirArgs);1073}1074# Announce that we are going to modify at the parent level1075if($direq'.'||$direq'./')1076{1077$dir='';1078}1079if(exists($seendirs->{$dir}))1080{1081return;1082}1083$log->debug("announcedir$dir,$repodir,$remotedir");1084my($thisRemoteDir,$thisRepoDir);1085if($dirne"")1086{1087$thisRepoDir="$repodir/$dir";1088if($remotedireq".")1089{1090$thisRemoteDir=$dir;1091}1092else1093{1094$thisRemoteDir="$remotedir/$dir";1095}1096}1097else1098{1099$thisRepoDir=$repodir;1100$thisRemoteDir=$remotedir;1101}1102unless($state->{globaloptions}{-Q} ||$state->{globaloptions}{-q} )1103{1104print"E cvs$request: Updating$thisRemoteDir\n";1105}11061107my($opt_r)=$state->{opt}{r};1108my$stickyInfo;1109if(exists($state->{opt}{A}))1110{1111# $stickyInfo=undef;1112}1113elsif(defined($opt_r) &&$opt_rne"")1114# || ( defined($state->{opt}{D}) && $state->{opt}{D} ne "" ) # TODO1115{1116$stickyInfo={'tag'=> (defined($opt_r)?$opt_r:undef) };11171118# TODO: Convert -D value into the form 2011.04.10.04.46.57,1119# similar to an entry line's sticky date, without the D prefix.1120# It sometimes (always?) arrives as something more like1121# '10 Apr 2011 04:46:57 -0000'...1122# $stickyInfo={ 'date' => (defined($stickyDate)?$stickyDate:undef) };1123}1124else1125{1126$stickyInfo=getDirStickyInfo($state->{prependdir} .$dir);1127}11281129my$stickyResponse;1130if(defined($stickyInfo))1131{1132$stickyResponse="Set-sticky$thisRemoteDir/\n".1133"$thisRepoDir/\n".1134 getStickyTagOrDate($stickyInfo) ."\n";1135}1136else1137{1138$stickyResponse="Clear-sticky$thisRemoteDir/\n".1139"$thisRepoDir/\n";1140}11411142unless($state->{globaloptions}{-n} )1143{1144print$stickyResponse;11451146print"Clear-static-directory$thisRemoteDir/\n";1147print"$thisRepoDir/\n";1148print$stickyResponse;# yes, twice1149print"Template$thisRemoteDir/\n";1150print"$thisRepoDir/\n";1151print"0\n";1152}11531154$seendirs->{$dir} =1;11551156# FUTURE: This would more accurately emulate CVS by sending1157# another copy of sticky after processing the files in that1158# directory. Or intermediate: perhaps send all sticky's for1159# $seendirs after processing all files.1160}11611162# update \n1163# Response expected: yes. Actually do a cvs update command. This uses any1164# previous Argument, Directory, Entry, or Modified requests, if they have1165# been sent. The last Directory sent specifies the working directory at the1166# time of the operation. The -I option is not used--files which the client1167# can decide whether to ignore are not mentioned and the client sends the1168# Questionable request for others.1169sub req_update1170{1171my($cmd,$data) =@_;11721173$log->debug("req_update : ". (defined($data) ?$data:"[NULL]"));11741175 argsplit("update");11761177#1178# It may just be a client exploring the available heads/modules1179# in that case, list them as top level directories and leave it1180# at that. Eclipse uses this technique to offer you a list of1181# projects (heads in this case) to checkout.1182#1183if($state->{module}eq'') {1184my$showref= safe_pipe_capture(qw(git show-ref --heads));1185print"E cvs update: Updating .\n";1186formy$line(split'\n',$showref) {1187if($line=~ m% refs/heads/(.*)$%) {1188print"E cvs update: New directory `$1'\n";1189}1190}1191print"ok\n";1192return1;1193}119411951196# Grab a handle to the SQLite db and do any necessary updates1197my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);11981199$updater->update();12001201 argsfromdir($updater);12021203#$log->debug("update state : " . Dumper($state));12041205my($repoDir);1206$repoDir=$state->{CVSROOT} ."/$state->{module}/$state->{prependdir}";12071208my%seendirs= ();12091210# foreach file specified on the command line ...1211foreachmy$argsFilename( @{$state->{args}} )1212{1213my$filename;1214$filename= filecleanup($argsFilename);12151216$log->debug("Processing file$filename");12171218# if we have a -C we should pretend we never saw modified stuff1219if(exists($state->{opt}{C} ) )1220{1221delete$state->{entries}{$filename}{modified_hash};1222delete$state->{entries}{$filename}{modified_filename};1223$state->{entries}{$filename}{unchanged} =1;1224}12251226my$stickyInfo= resolveStickyInfo($filename,1227$state->{opt}{r},1228$state->{opt}{D},1229exists($state->{opt}{A}));1230my$meta=$updater->getmeta($filename,$stickyInfo);12311232# If -p was given, "print" the contents of the requested revision.1233if(exists($state->{opt}{p} ) ) {1234if(defined($meta->{revision} ) ) {1235$log->info("Printing '$filename' revision ".$meta->{revision});12361237 transmitfile($meta->{filehash}, {print=>1});1238}12391240next;1241}12421243# Directories:1244 prepDirForOutput(1245 dirname($argsFilename),1246$repoDir,1247".",1248 \%seendirs,1249"update",1250$state->{dirArgs} );12511252my$wrev= revparse($filename);12531254if( !defined$meta)1255{1256$meta= {1257 name =>$filename,1258 revision =>'0',1259 filehash =>'added'1260};1261if($wrevne"0")1262{1263$meta->{filehash}='deleted';1264}1265}12661267my$oldmeta=$meta;12681269# If the working copy is an old revision, lets get that version too for comparison.1270my$oldWrev=$wrev;1271if(defined($oldWrev))1272{1273$oldWrev=~s/^-//;1274if($oldWrevne$meta->{revision})1275{1276$oldmeta=$updater->getmeta($filename,$oldWrev);1277}1278}12791280#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");12811282# Files are up to date if the working copy and repo copy have the same revision,1283# and the working copy is unmodified _and_ the user hasn't specified -C1284next if(defined($wrev)1285and defined($meta->{revision})1286and$wreveq$meta->{revision}1287and$state->{entries}{$filename}{unchanged}1288and not exists($state->{opt}{C} ) );12891290# If the working copy and repo copy have the same revision,1291# but the working copy is modified, tell the client it's modified1292if(defined($wrev)1293and defined($meta->{revision})1294and$wreveq$meta->{revision}1295and$wrevne"0"1296and defined($state->{entries}{$filename}{modified_hash})1297and not exists($state->{opt}{C} ) )1298{1299$log->info("Tell the client the file is modified");1300print"MT text M\n";1301print"MT fname$filename\n";1302print"MT newline\n";1303next;1304}13051306if($meta->{filehash}eq"deleted"&&$wrevne"0")1307{1308# TODO: If it has been modified in the sandbox, error out1309# with the appropriate message, rather than deleting a modified1310# file.13111312my($filepart,$dirpart) = filenamesplit($filename,1);13131314$log->info("Removing '$filename' from working copy (no longer in the repo)");13151316print"E cvs update: `$filename' is no longer in the repository\n";1317# Don't want to actually _DO_ the update if -n specified1318unless($state->{globaloptions}{-n} ) {1319print"Removed$dirpart\n";1320print"$filepart\n";1321}1322}1323elsif(not defined($state->{entries}{$filename}{modified_hash} )1324or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1325or$meta->{filehash}eq'added')1326{1327# normal update, just send the new revision (either U=Update,1328# or A=Add, or R=Remove)1329if(defined($wrev) && ($wrev=~/^-/) )1330{1331$log->info("Tell the client the file is scheduled for removal");1332print"MT text R\n";1333print"MT fname$filename\n";1334print"MT newline\n";1335next;1336}1337elsif( (!defined($wrev) ||$wreveq'0') &&1338(!defined($meta->{revision}) ||$meta->{revision}eq'0') )1339{1340$log->info("Tell the client the file is scheduled for addition");1341print"MT text A\n";1342print"MT fname$filename\n";1343print"MT newline\n";1344next;13451346}1347else{1348$log->info("UpdatingX3 '$filename' to ".$meta->{revision});1349print"MT +updated\n";1350print"MT text U\n";1351print"MT fname$filename\n";1352print"MT newline\n";1353print"MT -updated\n";1354}13551356my($filepart,$dirpart) = filenamesplit($filename,1);13571358# Don't want to actually _DO_ the update if -n specified1359unless($state->{globaloptions}{-n} )1360{1361if(defined($wrev) )1362{1363# instruct client we're sending a file to put in this path as a replacement1364print"Update-existing$dirpart\n";1365$log->debug("Updating existing file 'Update-existing$dirpart'");1366}else{1367# instruct client we're sending a file to put in this path as a new file13681369$log->debug("Creating new file 'Created$dirpart'");1370print"Created$dirpart\n";1371}1372print$state->{CVSROOT} ."/$state->{module}/$filename\n";13731374# this is an "entries" line1375my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1376my$entriesLine="/$filepart/$meta->{revision}//$kopts/";1377$entriesLine.= getStickyTagOrDate($stickyInfo);1378$log->debug($entriesLine);1379print"$entriesLine\n";13801381# permissions1382$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1383print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";13841385# transmit file1386 transmitfile($meta->{filehash});1387}1388}else{1389my($filepart,$dirpart) = filenamesplit($meta->{name},1);13901391my$mergeDir= setupTmpDir();13921393my$file_local=$filepart.".mine";1394my$mergedFile="$mergeDir/$file_local";1395system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1396my$file_old=$filepart.".".$oldmeta->{revision};1397 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1398my$file_new=$filepart.".".$meta->{revision};1399 transmitfile($meta->{filehash}, { targetfile =>$file_new});14001401# we need to merge with the local changes ( M=successful merge, C=conflict merge )1402$log->info("Merging$file_local,$file_old,$file_new");1403print"M Merging differences between$oldmeta->{revision} and$meta->{revision} into$filename\n";14041405$log->debug("Temporary directory for merge is$mergeDir");14061407my$return=system("git","merge-file",$file_local,$file_old,$file_new);1408$return>>=8;14091410 cleanupTmpDir();14111412if($return==0)1413{1414$log->info("Merged successfully");1415print"M M$filename\n";1416$log->debug("Merged$dirpart");14171418# Don't want to actually _DO_ the update if -n specified1419unless($state->{globaloptions}{-n} )1420{1421print"Merged$dirpart\n";1422$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1423print$state->{CVSROOT} ."/$state->{module}/$filename\n";1424my$kopts= kopts_from_path("$dirpart/$filepart",1425"file",$mergedFile);1426$log->debug("/$filepart/$meta->{revision}//$kopts/");1427my$entriesLine="/$filepart/$meta->{revision}//$kopts/";1428$entriesLine.= getStickyTagOrDate($stickyInfo);1429print"$entriesLine\n";1430}1431}1432elsif($return==1)1433{1434$log->info("Merged with conflicts");1435print"E cvs update: conflicts found in$filename\n";1436print"M C$filename\n";14371438# Don't want to actually _DO_ the update if -n specified1439unless($state->{globaloptions}{-n} )1440{1441print"Merged$dirpart\n";1442print$state->{CVSROOT} ."/$state->{module}/$filename\n";1443my$kopts= kopts_from_path("$dirpart/$filepart",1444"file",$mergedFile);1445my$entriesLine="/$filepart/$meta->{revision}/+/$kopts/";1446$entriesLine.= getStickyTagOrDate($stickyInfo);1447print"$entriesLine\n";1448}1449}1450else1451{1452$log->warn("Merge failed");1453next;1454}14551456# Don't want to actually _DO_ the update if -n specified1457unless($state->{globaloptions}{-n} )1458{1459# permissions1460$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1461print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";14621463# transmit file, format is single integer on a line by itself (file1464# size) followed by the file contents1465# TODO : we should copy files in blocks1466my$data= safe_pipe_capture('cat',$mergedFile);1467$log->debug("File size : ".length($data));1468print length($data) ."\n";1469print$data;1470}1471}14721473}14741475# prepDirForOutput() any other existing directories unless they already1476# have the right sticky tag:1477unless($state->{globaloptions}{n} )1478{1479my$dir;1480foreach$dir(keys(%{$state->{dirMap}}))1481{1482if( !$seendirs{$dir} &&1483exists($state->{dirArgs}{$dir}) )1484{1485my($oldTag);1486$oldTag=$state->{dirMap}{$dir}{tagspec};14871488unless( (exists($state->{opt}{A}) &&1489defined($oldTag) ) ||1490(defined($state->{opt}{r}) &&1491( !defined($oldTag) ||1492$state->{opt}{r}ne$oldTag) ) )1493# TODO?: OR sticky dir is different...1494{1495next;1496}14971498 prepDirForOutput(1499$dir,1500$repoDir,1501".",1502 \%seendirs,1503'update',1504$state->{dirArgs} );1505}15061507# TODO?: Consider sending a final duplicate Sticky response1508# to more closely mimic real CVS.1509}1510}15111512print"ok\n";1513}15141515sub req_ci1516{1517my($cmd,$data) =@_;15181519 argsplit("ci");15201521#$log->debug("State : " . Dumper($state));15221523$log->info("req_ci : ". (defined($data) ?$data:"[NULL]"));15241525if($state->{method}eq'pserver'and$state->{user}eq'anonymous')1526{1527print"error 1 anonymous user cannot commit via pserver\n";1528 cleanupWorkTree();1529exit;1530}15311532if( -e $state->{CVSROOT} ."/index")1533{1534$log->warn("file 'index' already exists in the git repository");1535print"error 1 Index already exists in git repo\n";1536 cleanupWorkTree();1537exit;1538}15391540# Grab a handle to the SQLite db and do any necessary updates1541my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1542$updater->update();15431544my@committedfiles= ();1545my%oldmeta;1546my$stickyInfo;1547my$branchRef;1548my$parenthash;15491550# foreach file specified on the command line ...1551foreachmy$filename( @{$state->{args}} )1552{1553my$committedfile=$filename;1554$filename= filecleanup($filename);15551556next unless(exists$state->{entries}{$filename}{modified_filename}or not$state->{entries}{$filename}{unchanged} );15571558#####1559# Figure out which branch and parenthash we are committing1560# to, and setup worktree:15611562# should always come from entries:1563my$fileStickyInfo= resolveStickyInfo($filename);1564if( !defined($branchRef) )1565{1566$stickyInfo=$fileStickyInfo;1567if(defined($stickyInfo) &&1568(defined($stickyInfo->{date}) ||1569!defined($stickyInfo->{tag}) ) )1570{1571print"error 1 cannot commit with sticky date for file `$filename'\n";1572 cleanupWorkTree();1573exit;1574}15751576$branchRef="refs/heads/$state->{module}";1577if(defined($stickyInfo) &&defined($stickyInfo->{tag}) )1578{1579$branchRef="refs/heads/$stickyInfo->{tag}";1580}15811582$parenthash= safe_pipe_capture('git','show-ref','-s',$branchRef);1583chomp$parenthash;1584if($parenthash!~/^[0-9a-f]{40}$/)1585{1586if(defined($stickyInfo) &&defined($stickyInfo->{tag}) )1587{1588print"error 1 sticky tag `$stickyInfo->{tag}' for file `$filename' is not a branch\n";1589}1590else1591{1592print"error 1 pserver cannot find the current HEAD of module";1593}1594 cleanupWorkTree();1595exit;1596}15971598 setupWorkTree($parenthash);15991600$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");16011602$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");1603}1604elsif( !refHashEqual($stickyInfo,$fileStickyInfo) )1605{1606#TODO: We could split the cvs commit into multiple1607# git commits by distinct stickyTag values, but that1608# is lowish priority.1609print"error 1 Committing different files to different"1610." branches is not currently supported\n";1611 cleanupWorkTree();1612exit;1613}16141615#####1616# Process this file:16171618my$meta=$updater->getmeta($filename,$stickyInfo);1619$oldmeta{$filename} =$meta;16201621my$wrev= revparse($filename);16221623my($filepart,$dirpart) = filenamesplit($filename);16241625# do a checkout of the file if it is part of this tree1626if($wrev) {1627system('git','checkout-index','-f','-u',$filename);1628unless($?==0) {1629die"Error running git-checkout-index -f -u$filename:$!";1630}1631}16321633my$addflag=0;1634my$rmflag=0;1635$rmflag=1if(defined($wrev)and($wrev=~/^-/) );1636$addflag=1unless( -e $filename);16371638# Do up to date checking1639unless($addflagor$wreveq$meta->{revision}or1640($rmflagand$wreveq"-$meta->{revision}") )1641{1642# fail everything if an up to date check fails1643print"error 1 Up to date check failed for$filename\n";1644 cleanupWorkTree();1645exit;1646}16471648push@committedfiles,$committedfile;1649$log->info("Committing$filename");16501651system("mkdir","-p",$dirpart)unless( -d $dirpart);16521653unless($rmflag)1654{1655$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1656rename$state->{entries}{$filename}{modified_filename},$filename;16571658# Calculate modes to remove1659my$invmode="";1660foreach( qw (r w x) ) {$invmode.=$_unless($state->{entries}{$filename}{modified_mode} =~/$_/); }16611662$log->debug("chmod u+".$state->{entries}{$filename}{modified_mode} ."-".$invmode."$filename");1663system("chmod","u+".$state->{entries}{$filename}{modified_mode} ."-".$invmode,$filename);1664}16651666if($rmflag)1667{1668$log->info("Removing file '$filename'");1669unlink($filename);1670system("git","update-index","--remove",$filename);1671}1672elsif($addflag)1673{1674$log->info("Adding file '$filename'");1675system("git","update-index","--add",$filename);1676}else{1677$log->info("UpdatingX2 file '$filename'");1678system("git","update-index",$filename);1679}1680}16811682unless(scalar(@committedfiles) >0)1683{1684print"E No files to commit\n";1685print"ok\n";1686 cleanupWorkTree();1687return;1688}16891690my$treehash= safe_pipe_capture(qw(git write-tree));1691chomp$treehash;16921693$log->debug("Treehash :$treehash, Parenthash :$parenthash");16941695# write our commit message out if we have one ...1696my($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1697print$msg_fh $state->{opt}{m};# if ( exists ( $state->{opt}{m} ) );1698if(defined($cfg->{gitcvs}{commitmsgannotation} ) ) {1699if($cfg->{gitcvs}{commitmsgannotation} !~/^\s*$/) {1700print$msg_fh"\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"1701}1702}else{1703print$msg_fh"\n\nvia git-CVS emulator\n";1704}1705close$msg_fh;17061707my$commithash= safe_pipe_capture('git','commit-tree',$treehash,'-p',$parenthash,'-F',$msg_filename);1708chomp($commithash);1709$log->info("Commit hash :$commithash");17101711unless($commithash=~/[a-zA-Z0-9]{40}/)1712{1713$log->warn("Commit failed (Invalid commit hash)");1714print"error 1 Commit failed (unknown reason)\n";1715 cleanupWorkTree();1716exit;1717}17181719### Emulate git-receive-pack by running hooks/update1720my@hook= ($ENV{GIT_DIR}.'hooks/update',$branchRef,1721$parenthash,$commithash);1722if( -x $hook[0] ) {1723unless(system(@hook) ==0)1724{1725$log->warn("Commit failed (update hook declined to update ref)");1726print"error 1 Commit failed (update hook declined)\n";1727 cleanupWorkTree();1728exit;1729}1730}17311732### Update the ref1733if(system(qw(git update-ref -m),"cvsserver ci",1734$branchRef,$commithash,$parenthash)) {1735$log->warn("update-ref for$state->{module} failed.");1736print"error 1 Cannot commit -- update first\n";1737 cleanupWorkTree();1738exit;1739}17401741### Emulate git-receive-pack by running hooks/post-receive1742my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1743if( -x $hook) {1744open(my$pipe,"|$hook") ||die"can't fork$!";17451746local$SIG{PIPE} =sub{die'pipe broke'};17471748print$pipe"$parenthash$commithash$branchRef\n";17491750close$pipe||die"bad pipe:$!$?";1751}17521753$updater->update();17541755### Then hooks/post-update1756$hook=$ENV{GIT_DIR}.'hooks/post-update';1757if(-x $hook) {1758system($hook,$branchRef);1759}17601761# foreach file specified on the command line ...1762foreachmy$filename(@committedfiles)1763{1764$filename= filecleanup($filename);17651766my$meta=$updater->getmeta($filename,$stickyInfo);1767unless(defined$meta->{revision}) {1768$meta->{revision} ="1.1";1769}17701771my($filepart,$dirpart) = filenamesplit($filename,1);17721773$log->debug("Checked-in$dirpart:$filename");17741775print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1776if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1777{1778print"M new revision: delete; previous revision:$oldmeta{$filename}{revision}\n";1779print"Remove-entry$dirpart\n";1780print"$filename\n";1781}else{1782if($meta->{revision}eq"1.1") {1783print"M initial revision: 1.1\n";1784}else{1785print"M new revision:$meta->{revision}; previous revision:$oldmeta{$filename}{revision}\n";1786}1787print"Checked-in$dirpart\n";1788print"$filename\n";1789my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1790print"/$filepart/$meta->{revision}//$kopts/".1791 getStickyTagOrDate($stickyInfo) ."\n";1792}1793}17941795 cleanupWorkTree();1796print"ok\n";1797}17981799sub req_status1800{1801my($cmd,$data) =@_;18021803 argsplit("status");18041805$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1806#$log->debug("status state : " . Dumper($state));18071808# Grab a handle to the SQLite db and do any necessary updates1809my$updater;1810$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1811$updater->update();18121813# if no files were specified, we need to work out what files we should1814# be providing status on ...1815 argsfromdir($updater);18161817# foreach file specified on the command line ...1818foreachmy$filename( @{$state->{args}} )1819{1820$filename= filecleanup($filename);18211822if(exists($state->{opt}{l}) &&1823index($filename,'/',length($state->{prependdir})) >=0)1824{1825next;1826}18271828my$wrev= revparse($filename);18291830my$stickyInfo= resolveStickyInfo($filename);1831my$meta=$updater->getmeta($filename,$stickyInfo);1832my$oldmeta=$meta;18331834# If the working copy is an old revision, lets get that1835# version too for comparison.1836if(defined($wrev)and$wrevne$meta->{revision} )1837{1838my($rmRev)=$wrev;1839$rmRev=~s/^-//;1840$oldmeta=$updater->getmeta($filename,$rmRev);1841}18421843# TODO : All possible statuses aren't yet implemented1844my$status;1845# Files are up to date if the working copy and repo copy have1846# the same revision, and the working copy is unmodified1847if(defined($wrev)and defined($meta->{revision})and1848$wreveq$meta->{revision}and1849( ($state->{entries}{$filename}{unchanged}and1850(not defined($state->{entries}{$filename}{conflict} )or1851$state->{entries}{$filename}{conflict} !~/^\+=/) )or1852(defined($state->{entries}{$filename}{modified_hash})and1853$state->{entries}{$filename}{modified_hash}eq1854$meta->{filehash} ) ) )1855{1856$status="Up-to-date"1857}18581859# Need checkout if the working copy has a different (usually1860# older) revision than the repo copy, and the working copy is1861# unmodified1862if(defined($wrev)and defined($meta->{revision} )and1863$meta->{revision}ne$wrevand1864($state->{entries}{$filename}{unchanged}or1865(defined($state->{entries}{$filename}{modified_hash})and1866$state->{entries}{$filename}{modified_hash}eq1867$oldmeta->{filehash} ) ) )1868{1869$status||="Needs Checkout";1870}18711872# Need checkout if it exists in the repo but doesn't have a working1873# copy1874if(not defined($wrev)and defined($meta->{revision} ) )1875{1876$status||="Needs Checkout";1877}18781879# Locally modified if working copy and repo copy have the1880# same revision but there are local changes1881if(defined($wrev)and defined($meta->{revision})and1882$wreveq$meta->{revision}and1883$wrevne"0"and1884$state->{entries}{$filename}{modified_filename} )1885{1886$status||="Locally Modified";1887}18881889# Needs Merge if working copy revision is different1890# (usually older) than repo copy and there are local changes1891if(defined($wrev)and defined($meta->{revision} )and1892$meta->{revision}ne$wrevand1893$state->{entries}{$filename}{modified_filename} )1894{1895$status||="Needs Merge";1896}18971898if(defined($state->{entries}{$filename}{revision} )and1899( !defined($meta->{revision}) ||1900$meta->{revision}eq"0") )1901{1902$status||="Locally Added";1903}1904if(defined($wrev)and defined($meta->{revision} )and1905$wreveq"-$meta->{revision}")1906{1907$status||="Locally Removed";1908}1909if(defined($state->{entries}{$filename}{conflict} )and1910$state->{entries}{$filename}{conflict} =~/^\+=/)1911{1912$status||="Unresolved Conflict";1913}1914if(0)1915{1916$status||="File had conflicts on merge";1917}19181919$status||="Unknown";19201921my($filepart) = filenamesplit($filename);19221923print"M =======". ("=" x 60) ."\n";1924print"M File:$filepart\tStatus:$status\n";1925if(defined($state->{entries}{$filename}{revision}) )1926{1927print"M Working revision:\t".1928$state->{entries}{$filename}{revision} ."\n";1929}else{1930print"M Working revision:\tNo entry for$filename\n";1931}1932if(defined($meta->{revision}) )1933{1934print"M Repository revision:\t".1935$meta->{revision} .1936"\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1937my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};1938my($tag)=($tagOrDate=~m/^T(.+)$/);1939if( !defined($tag) )1940{1941$tag="(none)";1942}1943print"M Sticky Tag:\t\t$tag\n";1944my($date)=($tagOrDate=~m/^D(.+)$/);1945if( !defined($date) )1946{1947$date="(none)";1948}1949print"M Sticky Date:\t\t$date\n";1950my($options)=$state->{entries}{$filename}{options};1951if($optionseq"")1952{1953$options="(none)";1954}1955print"M Sticky Options:\t\t$options\n";1956}else{1957print"M Repository revision:\tNo revision control file\n";1958}1959print"M\n";1960}19611962print"ok\n";1963}19641965sub req_diff1966{1967my($cmd,$data) =@_;19681969 argsplit("diff");19701971$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1972#$log->debug("status state : " . Dumper($state));19731974my($revision1,$revision2);1975if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1976{1977$revision1=$state->{opt}{r}[0];1978$revision2=$state->{opt}{r}[1];1979}else{1980$revision1=$state->{opt}{r};1981}19821983$log->debug("Diffing revisions ".1984(defined($revision1) ?$revision1:"[NULL]") .1985" and ". (defined($revision2) ?$revision2:"[NULL]") );19861987# Grab a handle to the SQLite db and do any necessary updates1988my$updater;1989$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1990$updater->update();19911992# if no files were specified, we need to work out what files we should1993# be providing status on ...1994 argsfromdir($updater);19951996my($foundDiff);19971998# foreach file specified on the command line ...1999foreachmy$argFilename( @{$state->{args}} )2000{2001my($filename) = filecleanup($argFilename);20022003my($fh,$file1,$file2,$meta1,$meta2,$filediff);20042005my$wrev= revparse($filename);20062007# Priority for revision1:2008# 1. First -r (missing file: check -N)2009# 2. wrev from client's Entry line2010# - missing line/file: check -N2011# - "0": added file not committed (empty contents for rev1)2012# - Prefixed with dash (to be removed): check -N20132014if(defined($revision1) )2015{2016$meta1=$updater->getmeta($filename,$revision1);2017}2018elsif(defined($wrev) &&$wrevne"0")2019{2020my($rmRev)=$wrev;2021$rmRev=~s/^-//;2022$meta1=$updater->getmeta($filename,$rmRev);2023}2024if( !defined($meta1) ||2025$meta1->{filehash}eq"deleted")2026{2027if( !exists($state->{opt}{N}) )2028{2029if(!defined($revision1))2030{2031print"E File$filenameat revision$revision1doesn't exist\n";2032}2033next;2034}2035elsif( !defined($meta1) )2036{2037$meta1= {2038 name =>$filename,2039 revision =>'0',2040 filehash =>'deleted'2041};2042}2043}20442045# Priority for revision2:2046# 1. Second -r (missing file: check -N)2047# 2. Modified file contents from client2048# 3. wrev from client's Entry line2049# - missing line/file: check -N2050# - Prefixed with dash (to be removed): check -N20512052# if we have a second -r switch, use it too2053if(defined($revision2) )2054{2055$meta2=$updater->getmeta($filename,$revision2);2056}2057elsif(defined($state->{entries}{$filename}{modified_filename}))2058{2059$file2=$state->{entries}{$filename}{modified_filename};2060$meta2= {2061 name =>$filename,2062 revision =>'0',2063 filehash =>'modified'2064};2065}2066elsif(defined($wrev) && ($wrev!~/^-/) )2067{2068if(!defined($revision1))# no revision and no modifications:2069{2070next;2071}2072$meta2=$updater->getmeta($filename,$wrev);2073}2074if(!defined($file2))2075{2076if( !defined($meta2) ||2077$meta2->{filehash}eq"deleted")2078{2079if( !exists($state->{opt}{N}) )2080{2081if(!defined($revision2))2082{2083print"E File$filenameat revision$revision2doesn't exist\n";2084}2085next;2086}2087elsif( !defined($meta2) )2088{2089$meta2= {2090 name =>$filename,2091 revision =>'0',2092 filehash =>'deleted'2093};2094}2095}2096}20972098if($meta1->{filehash}eq$meta2->{filehash} )2099{2100$log->info("unchanged$filename");2101next;2102}21032104# Retrieve revision contents:2105(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);2106 transmitfile($meta1->{filehash}, { targetfile =>$file1});21072108if(!defined($file2))2109{2110(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);2111 transmitfile($meta2->{filehash}, { targetfile =>$file2});2112}21132114# Generate the actual diff:2115print"M Index:$argFilename\n";2116print"M =======". ("=" x 60) ."\n";2117print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";2118if(defined($meta1) &&$meta1->{revision}ne"0")2119{2120print"M retrieving revision$meta1->{revision}\n"2121}2122if(defined($meta2) &&$meta2->{revision}ne"0")2123{2124print"M retrieving revision$meta2->{revision}\n"2125}2126print"M diff ";2127foreachmy$opt(sort keys%{$state->{opt}} )2128{2129if(ref$state->{opt}{$opt}eq"ARRAY")2130{2131foreachmy$value( @{$state->{opt}{$opt}} )2132{2133print"-$opt$value";2134}2135}else{2136print"-$opt";2137if(defined($state->{opt}{$opt} ) )2138{2139print"$state->{opt}{$opt} "2140}2141}2142}2143print"$argFilename\n";21442145$log->info("Diffing$filename-r$meta1->{revision} -r ".2146($meta2->{revision}or"workingcopy"));21472148# TODO: Use --label instead of -L because -L is no longer2149# documented and may go away someday. Not sure if there there are2150# versions that only support -L, which would make this change risky?2151# http://osdir.com/ml/bug-gnu-utils-gnu/2010-12/msg00060.html2152# ("man diff" should actually document the best migration strategy,2153# [current behavior, future changes, old compatibility issues2154# or lack thereof, etc], not just stop mentioning the option...)2155# TODO: Real CVS seems to include a date in the label, before2156# the revision part, without the keyword "revision". The following2157# has minimal changes compared to original versions of2158# git-cvsserver.perl. (Mostly tab vs space after filename.)21592160my(@diffCmd) = ('diff');2161if(exists($state->{opt}{N}) )2162{2163push@diffCmd,"-N";2164}2165if(exists$state->{opt}{u} )2166{2167push@diffCmd,("-u","-L");2168if($meta1->{filehash}eq"deleted")2169{2170push@diffCmd,"/dev/null";2171}else{2172push@diffCmd,("$argFilename\trevision$meta1->{revision}");2173}21742175if(defined($meta2->{filehash}) )2176{2177if($meta2->{filehash}eq"deleted")2178{2179push@diffCmd,("-L","/dev/null");2180}else{2181push@diffCmd,("-L",2182"$argFilename\trevision$meta2->{revision}");2183}2184}else{2185push@diffCmd,("-L","$argFilename\tworking copy");2186}2187}2188push@diffCmd,($file1,$file2);2189if(!open(DIFF,"-|",@diffCmd))2190{2191$log->warn("Unable to run diff:$!");2192}2193my($diffLine);2194while(defined($diffLine=<DIFF>))2195{2196print"M$diffLine";2197$foundDiff=1;2198}2199close(DIFF);2200}22012202if($foundDiff)2203{2204print"error\n";2205}2206else2207{2208print"ok\n";2209}2210}22112212sub req_log2213{2214my($cmd,$data) =@_;22152216 argsplit("log");22172218$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));2219#$log->debug("log state : " . Dumper($state));22202221my($revFilter);2222if(defined($state->{opt}{r} ) )2223{2224$revFilter=$state->{opt}{r};2225}22262227# Grab a handle to the SQLite db and do any necessary updates2228my$updater;2229$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);2230$updater->update();22312232# if no files were specified, we need to work out what files we2233# should be providing status on ...2234 argsfromdir($updater);22352236# foreach file specified on the command line ...2237foreachmy$filename( @{$state->{args}} )2238{2239$filename= filecleanup($filename);22402241my$headmeta=$updater->getmeta($filename);22422243my($revisions,$totalrevisions) =$updater->getlog($filename,2244$revFilter);22452246next unless(scalar(@$revisions) );22472248print"M\n";2249print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";2250print"M Working file:$filename\n";2251print"M head:$headmeta->{revision}\n";2252print"M branch:\n";2253print"M locks: strict\n";2254print"M access list:\n";2255print"M symbolic names:\n";2256print"M keyword substitution: kv\n";2257print"M total revisions:$totalrevisions;\tselected revisions: ".2258scalar(@$revisions) ."\n";2259print"M description:\n";22602261foreachmy$revision(@$revisions)2262{2263print"M ----------------------------\n";2264print"M revision$revision->{revision}\n";2265# reformat the date for log output2266if($revision->{modified} =~/(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/and2267defined($DATE_LIST->{$2}) )2268{2269$revision->{modified} =sprintf('%04d/%02d/%02d%s',2270$3,$DATE_LIST->{$2},$1,$4);2271}2272$revision->{author} = cvs_author($revision->{author});2273print"M date:$revision->{modified};".2274" author:$revision->{author}; state: ".2275($revision->{filehash}eq"deleted"?"dead":"Exp") .2276"; lines: +2 -3\n";2277my$commitmessage;2278$commitmessage=$updater->commitmessage($revision->{commithash});2279$commitmessage=~s/^/M /mg;2280print$commitmessage."\n";2281}2282print"M =======". ("=" x 70) ."\n";2283}22842285print"ok\n";2286}22872288sub req_annotate2289{2290my($cmd,$data) =@_;22912292 argsplit("annotate");22932294$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));2295#$log->debug("status state : " . Dumper($state));22962297# Grab a handle to the SQLite db and do any necessary updates2298my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);2299$updater->update();23002301# if no files were specified, we need to work out what files we should be providing annotate on ...2302 argsfromdir($updater);23032304# we'll need a temporary checkout dir2305 setupWorkTree();23062307$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");23082309# foreach file specified on the command line ...2310foreachmy$filename( @{$state->{args}} )2311{2312$filename= filecleanup($filename);23132314my$meta=$updater->getmeta($filename);23152316next unless($meta->{revision} );23172318# get all the commits that this file was in2319# in dense format -- aka skip dead revisions2320my$revisions=$updater->gethistorydense($filename);2321my$lastseenin=$revisions->[0][2];23222323# populate the temporary index based on the latest commit were we saw2324# the file -- but do it cheaply without checking out any files2325# TODO: if we got a revision from the client, use that instead2326# to look up the commithash in sqlite (still good to default to2327# the current head as we do now)2328system("git","read-tree",$lastseenin);2329unless($?==0)2330{2331print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";2332return;2333}2334$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");23352336# do a checkout of the file2337system('git','checkout-index','-f','-u',$filename);2338unless($?==0) {2339print"E error running git-checkout-index -f -u$filename:$!\n";2340return;2341}23422343$log->info("Annotate$filename");23442345# Prepare a file with the commits from the linearized2346# history that annotate should know about. This prevents2347# git-jsannotate telling us about commits we are hiding2348# from the client.23492350my$a_hints="$work->{workDir}/.annotate_hints";2351if(!open(ANNOTATEHINTS,'>',$a_hints)) {2352print"E failed to open '$a_hints' for writing:$!\n";2353return;2354}2355for(my$i=0;$i<@$revisions;$i++)2356{2357print ANNOTATEHINTS $revisions->[$i][2];2358if($i+1<@$revisions) {# have we got a parent?2359print ANNOTATEHINTS ' '.$revisions->[$i+1][2];2360}2361print ANNOTATEHINTS "\n";2362}23632364print ANNOTATEHINTS "\n";2365close ANNOTATEHINTS2366or(print"E failed to write$a_hints:$!\n"),return;23672368my@cmd= (qw(git annotate -l -S),$a_hints,$filename);2369if(!open(ANNOTATE,"-|",@cmd)) {2370print"E error invoking ".join(' ',@cmd) .":$!\n";2371return;2372}2373my$metadata= {};2374print"E Annotations for$filename\n";2375print"E ***************\n";2376while( <ANNOTATE> )2377{2378if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)2379{2380my$commithash=$1;2381my$data=$2;2382unless(defined($metadata->{$commithash} ) )2383{2384$metadata->{$commithash} =$updater->getmeta($filename,$commithash);2385$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});2386$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);2387}2388printf("M %-7s (%-8s%10s):%s\n",2389$metadata->{$commithash}{revision},2390$metadata->{$commithash}{author},2391$metadata->{$commithash}{modified},2392$data2393);2394}else{2395$log->warn("Error in annotate output! LINE:$_");2396print"E Annotate error\n";2397next;2398}2399}2400close ANNOTATE;2401}24022403# done; get out of the tempdir2404 cleanupWorkTree();24052406print"ok\n";24072408}24092410# This method takes the state->{arguments} array and produces two new arrays.2411# The first is $state->{args} which is everything before the '--' argument, and2412# the second is $state->{files} which is everything after it.2413sub argsplit2414{2415$state->{args} = [];2416$state->{files} = [];2417$state->{opt} = {};24182419return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");24202421my$type=shift;24222423if(defined($type) )2424{2425my$opt= {};2426$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");2427$opt= { v =>0, l =>0, R =>0}if($typeeq"status");2428$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");2429$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2, N =>0}if($typeeq"diff");2430$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");2431$opt= { k =>1, m =>1}if($typeeq"add");2432$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");2433$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");243424352436while(scalar( @{$state->{arguments}} ) >0)2437{2438my$arg=shift@{$state->{arguments}};24392440next if($argeq"--");2441next unless($arg=~/\S/);24422443# if the argument looks like a switch2444if($arg=~/^-(\w)(.*)/)2445{2446# if it's a switch that takes an argument2447if($opt->{$1} )2448{2449# If this switch has already been provided2450if($opt->{$1} >1and exists($state->{opt}{$1} ) )2451{2452$state->{opt}{$1} = [$state->{opt}{$1} ];2453if(length($2) >0)2454{2455push@{$state->{opt}{$1}},$2;2456}else{2457push@{$state->{opt}{$1}},shift@{$state->{arguments}};2458}2459}else{2460# if there's extra data in the arg, use that as the argument for the switch2461if(length($2) >0)2462{2463$state->{opt}{$1} =$2;2464}else{2465$state->{opt}{$1} =shift@{$state->{arguments}};2466}2467}2468}else{2469$state->{opt}{$1} =undef;2470}2471}2472else2473{2474push@{$state->{args}},$arg;2475}2476}2477}2478else2479{2480my$mode=0;24812482foreachmy$value( @{$state->{arguments}} )2483{2484if($valueeq"--")2485{2486$mode++;2487next;2488}2489push@{$state->{args}},$valueif($mode==0);2490push@{$state->{files}},$valueif($mode==1);2491}2492}2493}24942495# Used by argsfromdir2496sub expandArg2497{2498my($updater,$outNameMap,$outDirMap,$path,$isDir) =@_;24992500my$fullPath= filecleanup($path);25012502# Is it a directory?2503if(defined($state->{dirMap}{$fullPath}) ||2504defined($state->{dirMap}{"$fullPath/"}) )2505{2506# It is a directory in the user's sandbox.2507$isDir=1;25082509if(defined($state->{entries}{$fullPath}))2510{2511$log->fatal("Inconsistent file/dir type");2512die"Inconsistent file/dir type";2513}2514}2515elsif(defined($state->{entries}{$fullPath}))2516{2517# It is a file in the user's sandbox.2518$isDir=0;2519}2520my($revDirMap,$otherRevDirMap);2521if(!defined($isDir) ||$isDir)2522{2523# Resolve version tree for sticky tag:2524# (for now we only want list of files for the version, not2525# particular versions of those files: assume it is a directory2526# for the moment; ignore Entry's stick tag)25272528# Order of precedence of sticky tags:2529# -A [head]2530# -r /tag/2531# [file entry sticky tag, but that is only relevant to files]2532# [the tag specified in dir req_Sticky]2533# [the tag specified in a parent dir req_Sticky]2534# [head]2535# Also, -r may appear twice (for diff).2536#2537# FUTURE: When/if -j (merges) are supported, we also2538# need to add relevant files from one or two2539# versions specified with -j.25402541if(exists($state->{opt}{A}))2542{2543$revDirMap=$updater->getRevisionDirMap();2544}2545elsif(defined($state->{opt}{r})and2546ref$state->{opt}{r}eq"ARRAY")2547{2548$revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);2549$otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);2550}2551elsif(defined($state->{opt}{r}))2552{2553$revDirMap=$updater->getRevisionDirMap($state->{opt}{r});2554}2555else2556{2557my($sticky)=getDirStickyInfo($fullPath);2558$revDirMap=$updater->getRevisionDirMap($sticky->{tag});2559}25602561# Is it a directory?2562if(defined($revDirMap->{$fullPath}) ||2563defined($otherRevDirMap->{$fullPath}) )2564{2565$isDir=1;2566}2567}25682569# What to do with it?2570if(!$isDir)2571{2572$outNameMap->{$fullPath}=1;2573}2574else2575{2576$outDirMap->{$fullPath}=1;25772578if(defined($revDirMap->{$fullPath}))2579{2580 addDirMapFiles($updater,$outNameMap,$outDirMap,2581$revDirMap->{$fullPath});2582}2583if(defined($otherRevDirMap) &&2584defined($otherRevDirMap->{$fullPath}) )2585{2586 addDirMapFiles($updater,$outNameMap,$outDirMap,2587$otherRevDirMap->{$fullPath});2588}2589}2590}25912592# Used by argsfromdir2593# Add entries from dirMap to outNameMap. Also recurse into entries2594# that are subdirectories.2595sub addDirMapFiles2596{2597my($updater,$outNameMap,$outDirMap,$dirMap)=@_;25982599my($fullName);2600foreach$fullName(keys(%$dirMap))2601{2602my$cleanName=$fullName;2603if(defined($state->{prependdir}))2604{2605if(!($cleanName=~s/^\Q$state->{prependdir}\E//))2606{2607$log->fatal("internal error stripping prependdir");2608die"internal error stripping prependdir";2609}2610}26112612if($dirMap->{$fullName}eq"F")2613{2614$outNameMap->{$cleanName}=1;2615}2616elsif($dirMap->{$fullName}eq"D")2617{2618if(!$state->{opt}{l})2619{2620 expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);2621}2622}2623else2624{2625$log->fatal("internal error in addDirMapFiles");2626die"internal error in addDirMapFiles";2627}2628}2629}26302631# This method replaces $state->{args} with a directory-expanded2632# list of all relevant filenames (recursively unless -d), based2633# on $state->{entries}, and the "current" list of files in2634# each directory. "Current" files as determined by2635# either the requested (-r/-A) or "req_Sticky" version of2636# that directory.2637# Both the input args and the new output args are relative2638# to the cvs-client's CWD, although some of the internal2639# computations are relative to the top of the project.2640sub argsfromdir2641{2642my$updater=shift;26432644# Notes about requirements for specific callers:2645# update # "standard" case (entries; a single -r/-A/default; -l)2646# # Special case: -d for create missing directories.2647# diff # 0 or 1 -r's: "standard" case.2648# # 2 -r's: We could ignore entries (just use the two -r's),2649# # but it doesn't really matter.2650# annotate # "standard" case2651# log # Punting: log -r has a more complex non-"standard"2652# # meaning, and we don't currently try to support log'ing2653# # branches at all (need a lot of work to2654# # support CVS-consistent branch relative version2655# # numbering).2656#HERE: But we still want to expand directories. Maybe we should2657# essentially force "-A".2658# status # "standard", except that -r/-A/default are not possible.2659# # Mostly only used to expand entries only)2660#2661# Don't use argsfromdir at all:2662# add # Explicit arguments required. Directory args imply add2663# # the directory itself, not the files in it.2664# co # Obtain list directly.2665# remove # HERE: TEST: MAYBE client does the recursion for us,2666# # since it only makes sense to remove stuff already in2667# # the sandbox?2668# ci # HERE: Similar to remove...2669# # Don't try to implement the confusing/weird2670# # ci -r bug er.."feature".26712672if(scalar(@{$state->{args}})==0)2673{2674$state->{args} = ["."];2675}2676my%allArgs;2677my%allDirs;2678formy$file(@{$state->{args}})2679{2680 expandArg($updater,\%allArgs,\%allDirs,$file);2681}26822683# Include any entries from sandbox. Generally client won't2684# send entries that shouldn't be used.2685foreachmy$file(keys%{$state->{entries}})2686{2687$allArgs{remove_prependdir($file)} =1;2688}26892690$state->{dirArgs} = \%allDirs;2691$state->{args} = [2692sort{2693# Sort priority: by directory depth, then actual file name:2694my@piecesA=split('/',$a);2695my@piecesB=split('/',$b);26962697my$count=scalar(@piecesA);2698my$tmp=scalar(@piecesB);2699return$count<=>$tmpif($count!=$tmp);27002701for($tmp=0;$tmp<$count;$tmp++)2702{2703if($piecesA[$tmp]ne$piecesB[$tmp])2704{2705return$piecesA[$tmp]cmp$piecesB[$tmp]2706}2707}2708return0;2709}keys(%allArgs) ];2710}27112712## look up directory sticky tag, of either fullPath or a parent:2713sub getDirStickyInfo2714{2715my($fullPath)=@_;27162717$fullPath=~s%/+$%%;2718while($fullPathne""&& !defined($state->{dirMap}{"$fullPath/"}))2719{2720$fullPath=~s%/?[^/]*$%%;2721}27222723if( !defined($state->{dirMap}{"$fullPath/"}) &&2724($fullPatheq""||2725$fullPatheq".") )2726{2727return$state->{dirMap}{""}{stickyInfo};2728}2729else2730{2731return$state->{dirMap}{"$fullPath/"}{stickyInfo};2732}2733}27342735# Resolve precedence of various ways of specifying which version of2736# a file you want. Returns undef (for default head), or a ref to a hash2737# that contains "tag" and/or "date" keys.2738sub resolveStickyInfo2739{2740my($filename,$stickyTag,$stickyDate,$reset) =@_;27412742# Order of precedence of sticky tags:2743# -A [head]2744# -r /tag/2745# [file entry sticky tag]2746# [the tag specified in dir req_Sticky]2747# [the tag specified in a parent dir req_Sticky]2748# [head]27492750my$result;2751if($reset)2752{2753# $result=undef;2754}2755elsif(defined($stickyTag) &&$stickyTagne"")2756# || ( defined($stickyDate) && $stickyDate ne "" ) # TODO2757{2758$result={'tag'=> (defined($stickyTag)?$stickyTag:undef) };27592760# TODO: Convert -D value into the form 2011.04.10.04.46.57,2761# similar to an entry line's sticky date, without the D prefix.2762# It sometimes (always?) arrives as something more like2763# '10 Apr 2011 04:46:57 -0000'...2764# $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };2765}2766elsif(defined($state->{entries}{$filename}) &&2767defined($state->{entries}{$filename}{tag_or_date}) &&2768$state->{entries}{$filename}{tag_or_date}ne"")2769{2770my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};2771if($tagOrDate=~/^T([^ ]+)\s*$/)2772{2773$result= {'tag'=>$1};2774}2775elsif($tagOrDate=~/^D([0-9.]+)\s*$/)2776{2777$result= {'date'=>$1};2778}2779else2780{2781die"Unknown tag_or_date format\n";2782}2783}2784else2785{2786$result=getDirStickyInfo($filename);2787}27882789return$result;2790}27912792# Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into2793# a form appropriate for the sticky tag field of an Entries2794# line (field index 5, 0-based).2795sub getStickyTagOrDate2796{2797my($stickyInfo)=@_;27982799my$result;2800if(defined($stickyInfo) &&defined($stickyInfo->{tag}))2801{2802$result="T$stickyInfo->{tag}";2803}2804# TODO: When/if we actually pick versions by {date} properly,2805# also handle it here:2806# "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").2807else2808{2809$result="";2810}28112812return$result;2813}28142815# This method cleans up the $state variable after a command that uses arguments has run2816sub statecleanup2817{2818$state->{files} = [];2819$state->{dirArgs} = {};2820$state->{args} = [];2821$state->{arguments} = [];2822$state->{entries} = {};2823$state->{dirMap} = {};2824}28252826# Return working directory CVS revision "1.X" out2827# of the working directory "entries" state, for the given filename.2828# This is prefixed with a dash if the file is scheduled for removal2829# when it is committed.2830sub revparse2831{2832my$filename=shift;28332834return$state->{entries}{$filename}{revision};2835}28362837# This method takes a file hash and does a CVS "file transfer". Its2838# exact behaviour depends on a second, optional hash table argument:2839# - If $options->{targetfile}, dump the contents to that file;2840# - If $options->{print}, use M/MT to transmit the contents one line2841# at a time;2842# - Otherwise, transmit the size of the file, followed by the file2843# contents.2844sub transmitfile2845{2846my$filehash=shift;2847my$options=shift;28482849if(defined($filehash)and$filehasheq"deleted")2850{2851$log->warn("filehash is 'deleted'");2852return;2853}28542855die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);28562857my$type= safe_pipe_capture('git','cat-file','-t',$filehash);2858chomp$type;28592860die("Invalid type '$type' (expected 'blob')")unless(defined($type)and$typeeq"blob");28612862my$size= safe_pipe_capture('git','cat-file','-s',$filehash);2863chomp$size;28642865$log->debug("transmitfile($filehash) size=$size, type=$type");28662867if(open my$fh,'-|',"git","cat-file","blob",$filehash)2868{2869if(defined($options->{targetfile} ) )2870{2871my$targetfile=$options->{targetfile};2872open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2873print NEWFILE $_while( <$fh> );2874close NEWFILE or die("Failed to write '$targetfile':$!");2875}elsif(defined($options->{print} ) &&$options->{print} ) {2876while( <$fh> ) {2877if(/\n\z/) {2878print'M ',$_;2879}else{2880print'MT text ',$_,"\n";2881}2882}2883}else{2884print"$size\n";2885printwhile( <$fh> );2886}2887close$fhor die("Couldn't close filehandle for transmitfile():$!");2888}else{2889die("Couldn't execute git-cat-file");2890}2891}28922893# This method takes a file name, and returns ( $dirpart, $filepart ) which2894# refers to the directory portion and the file portion of the filename2895# respectively2896sub filenamesplit2897{2898my$filename=shift;2899my$fixforlocaldir=shift;29002901my($filepart,$dirpart) = ($filename,".");2902($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2903$dirpart.="/";29042905if($fixforlocaldir)2906{2907$dirpart=~s/^$state->{prependdir}//;2908}29092910return($filepart,$dirpart);2911}29122913# Cleanup various junk in filename (try to canonicalize it), and2914# add prependdir to accommodate running CVS client from a2915# subdirectory (so the output is relative to top directory of the project).2916sub filecleanup2917{2918my$filename=shift;29192920returnundefunless(defined($filename));2921if($filename=~/^\// )2922{2923print"E absolute filenames '$filename' not supported by server\n";2924returnundef;2925}29262927if($filenameeq".")2928{2929$filename="";2930}2931$filename=~s/^\.\///g;2932$filename=~ s%/+%/%g;2933$filename=$state->{prependdir} .$filename;2934$filename=~ s%/$%%;2935return$filename;2936}29372938# Remove prependdir from the path, so that it is relative to the directory2939# the CVS client was started from, rather than the top of the project.2940# Essentially the inverse of filecleanup().2941sub remove_prependdir2942{2943my($path) =@_;2944if(defined($state->{prependdir}) &&$state->{prependdir}ne"")2945{2946my($pre)=$state->{prependdir};2947$pre=~s%/$%%;2948if(!($path=~s%^\Q$pre\E/?%%))2949{2950$log->fatal("internal error missing prependdir");2951die("internal error missing prependdir");2952}2953}2954return$path;2955}29562957sub validateGitDir2958{2959if( !defined($state->{CVSROOT}) )2960{2961print"error 1 CVSROOT not specified\n";2962 cleanupWorkTree();2963exit;2964}2965if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2966{2967print"error 1 Internally inconsistent CVSROOT\n";2968 cleanupWorkTree();2969exit;2970}2971}29722973# Setup working directory in a work tree with the requested version2974# loaded in the index.2975sub setupWorkTree2976{2977my($ver) =@_;29782979 validateGitDir();29802981if( (defined($work->{state}) &&$work->{state} !=1) ||2982defined($work->{tmpDir}) )2983{2984$log->warn("Bad work tree state management");2985print"error 1 Internal setup multiple work trees without cleanup\n";2986 cleanupWorkTree();2987exit;2988}29892990$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);29912992if( !defined($work->{index}) )2993{2994(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2995}29962997chdir$work->{workDir}or2998die"Unable to chdir to$work->{workDir}\n";29993000$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");30013002$ENV{GIT_WORK_TREE} =".";3003$ENV{GIT_INDEX_FILE} =$work->{index};3004$work->{state} =2;30053006if($ver)3007{3008system("git","read-tree",$ver);3009unless($?==0)3010{3011$log->warn("Error running git-read-tree");3012die"Error running git-read-tree$verin$work->{workDir}$!\n";3013}3014}3015# else # req_annotate reads tree for each file3016}30173018# Ensure current directory is in some kind of working directory,3019# with a recent version loaded in the index.3020sub ensureWorkTree3021{3022if(defined($work->{tmpDir}) )3023{3024$log->warn("Bad work tree state management [ensureWorkTree()]");3025print"error 1 Internal setup multiple dirs without cleanup\n";3026 cleanupWorkTree();3027exit;3028}3029if($work->{state} )3030{3031return;3032}30333034 validateGitDir();30353036if( !defined($work->{emptyDir}) )3037{3038$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);3039}3040chdir$work->{emptyDir}or3041die"Unable to chdir to$work->{emptyDir}\n";30423043my$ver= safe_pipe_capture('git','show-ref','-s',"refs/heads/$state->{module}");3044chomp$ver;3045if($ver!~/^[0-9a-f]{40}$/)3046{3047$log->warn("Error from git show-ref -s refs/head$state->{module}");3048print"error 1 cannot find the current HEAD of module";3049 cleanupWorkTree();3050exit;3051}30523053if( !defined($work->{index}) )3054{3055(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);3056}30573058$ENV{GIT_WORK_TREE} =".";3059$ENV{GIT_INDEX_FILE} =$work->{index};3060$work->{state} =1;30613062system("git","read-tree",$ver);3063unless($?==0)3064{3065die"Error running git-read-tree$ver$!\n";3066}3067}30683069# Cleanup working directory that is not needed any longer.3070sub cleanupWorkTree3071{3072if( !$work->{state} )3073{3074return;3075}30763077chdir"/"or die"Unable to chdir '/'\n";30783079if(defined($work->{workDir}) )3080{3081 rmtree($work->{workDir} );3082undef$work->{workDir};3083}3084undef$work->{state};3085}30863087# Setup a temporary directory (not a working tree), typically for3088# merging dirty state as in req_update.3089sub setupTmpDir3090{3091$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);3092chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";30933094return$work->{tmpDir};3095}30963097# Clean up a previously setupTmpDir. Restore previous work tree if3098# appropriate.3099sub cleanupTmpDir3100{3101if( !defined($work->{tmpDir}) )3102{3103$log->warn("cleanup tmpdir that has not been setup");3104die"Cleanup tmpDir that has not been setup\n";3105}3106if(defined($work->{state}) )3107{3108if($work->{state} ==1)3109{3110chdir$work->{emptyDir}or3111die"Unable to chdir to$work->{emptyDir}\n";3112}3113elsif($work->{state} ==2)3114{3115chdir$work->{workDir}or3116die"Unable to chdir to$work->{emptyDir}\n";3117}3118else3119{3120$log->warn("Inconsistent work dir state");3121die"Inconsistent work dir state\n";3122}3123}3124else3125{3126chdir"/"or die"Unable to chdir '/'\n";3127}3128}31293130# Given a path, this function returns a string containing the kopts3131# that should go into that path's Entries line. For example, a binary3132# file should get -kb.3133sub kopts_from_path3134{3135my($path,$srcType,$name) =@_;31363137if(defined($cfg->{gitcvs}{usecrlfattr} )and3138$cfg->{gitcvs}{usecrlfattr} =~/\s*(1|true|yes)\s*$/i)3139{3140my($val) = check_attr("text",$path);3141if($valeq"unspecified")3142{3143$val= check_attr("crlf",$path);3144}3145if($valeq"unset")3146{3147return"-kb"3148}3149elsif( check_attr("eol",$path)ne"unspecified"||3150$valeq"set"||$valeq"input")3151{3152return"";3153}3154else3155{3156$log->info("Unrecognized check_attr crlf$path:$val");3157}3158}31593160if(defined($cfg->{gitcvs}{allbinary} ) )3161{3162if( ($cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i) )3163{3164return"-kb";3165}3166elsif( ($cfg->{gitcvs}{allbinary} =~/^\s*guess\s*$/i) )3167{3168if( is_binary($srcType,$name) )3169{3170$log->debug("... as binary");3171return"-kb";3172}3173else3174{3175$log->debug("... as text");3176}3177}3178}3179# Return "" to give no special treatment to any path3180return"";3181}31823183sub check_attr3184{3185my($attr,$path) =@_;3186 ensureWorkTree();3187if(open my$fh,'-|',"git","check-attr",$attr,"--",$path)3188{3189my$val= <$fh>;3190close$fh;3191$val=~s/.*: ([^:\r\n]*)\s*$/$1/;3192return$val;3193}3194else3195{3196returnundef;3197}3198}31993200# This should have the same heuristics as convert.c:is_binary() and related.3201# Note that the bare CR test is done by callers in convert.c.3202sub is_binary3203{3204my($srcType,$name) =@_;3205$log->debug("is_binary($srcType,$name)");32063207# Minimize amount of interpreted code run in the inner per-character3208# loop for large files, by totalling each character value and3209# then analyzing the totals.3210my@counts;3211my$i;3212for($i=0;$i<256;$i++)3213{3214$counts[$i]=0;3215}32163217my$fh= open_blob_or_die($srcType,$name);3218my$line;3219while(defined($line=<$fh>) )3220{3221# Any '\0' and bare CR are considered binary.3222if($line=~/\0|(\r[^\n])/)3223{3224close($fh);3225return1;3226}32273228# Count up each character in the line:3229my$len=length($line);3230for($i=0;$i<$len;$i++)3231{3232$counts[ord(substr($line,$i,1))]++;3233}3234}3235close$fh;32363237# Don't count CR and LF as either printable/nonprintable3238$counts[ord("\n")]=0;3239$counts[ord("\r")]=0;32403241# Categorize individual character count into printable and nonprintable:3242my$printable=0;3243my$nonprintable=0;3244for($i=0;$i<256;$i++)3245{3246if($i<32&&3247$i!=ord("\b") &&3248$i!=ord("\t") &&3249$i!=033&&# ESC3250$i!=014)# FF3251{3252$nonprintable+=$counts[$i];3253}3254elsif($i==127)# DEL3255{3256$nonprintable+=$counts[$i];3257}3258else3259{3260$printable+=$counts[$i];3261}3262}32633264return($printable>>7) <$nonprintable;3265}32663267# Returns open file handle. Possible invocations:3268# - open_blob_or_die("file",$filename);3269# - open_blob_or_die("sha1",$filehash);3270sub open_blob_or_die3271{3272my($srcType,$name) =@_;3273my($fh);3274if($srcTypeeq"file")3275{3276if( !open$fh,"<",$name)3277{3278$log->warn("Unable to open file$name:$!");3279die"Unable to open file$name:$!\n";3280}3281}3282elsif($srcTypeeq"sha1")3283{3284unless(defined($name)and$name=~/^[a-zA-Z0-9]{40}$/)3285{3286$log->warn("Need filehash");3287die"Need filehash\n";3288}32893290my$type= safe_pipe_capture('git','cat-file','-t',$name);3291chomp$type;32923293unless(defined($type)and$typeeq"blob")3294{3295$log->warn("Invalid type '$type' for '$name'");3296die("Invalid type '$type' (expected 'blob')")3297}32983299my$size= safe_pipe_capture('git','cat-file','-s',$name);3300chomp$size;33013302$log->debug("open_blob_or_die($name) size=$size, type=$type");33033304unless(open$fh,'-|',"git","cat-file","blob",$name)3305{3306$log->warn("Unable to open sha1$name");3307die"Unable to open sha1$name\n";3308}3309}3310else3311{3312$log->warn("Unknown type of blob source:$srcType");3313die"Unknown type of blob source:$srcType\n";3314}3315return$fh;3316}33173318# Generate a CVS author name from Git author information, by taking the local3319# part of the email address and replacing characters not in the Portable3320# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS3321# Login names are Unix login names, which should be restricted to this3322# character set.3323sub cvs_author3324{3325my$author_line=shift;3326(my$author) =$author_line=~/<([^@>]*)/;33273328$author=~s/[^-a-zA-Z0-9_.]/_/g;3329$author=~s/^-/_/;33303331$author;3332}333333343335sub descramble3336{3337# This table is from src/scramble.c in the CVS source3338my@SHIFTS= (33390,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,334016,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,3341114,120,53,79,96,109,72,108,70,64,76,67,116,74,68,87,3342111,52,75,119,49,34,82,81,95,65,112,86,118,110,122,105,334341,57,83,43,46,102,40,89,38,103,45,50,42,123,91,35,3344125,55,54,66,124,126,59,47,92,71,115,78,88,107,106,56,334536,121,117,104,101,100,69,73,99,63,94,93,39,37,61,48,334658,113,32,90,44,98,60,51,33,97,62,77,84,80,85,223,3347225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,3348199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,3349174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,3350207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,3351192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,3352227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,3353182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,3354243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,1523355);3356my($str) =@_;33573358# This should never happen, the same password format (A) has been3359# used by CVS since the beginning of time3360{3361my$fmt=substr($str,0,1);3362die"invalid password format `$fmt'"unless$fmteq'A';3363}33643365my@str=unpack"C*",substr($str,1);3366my$ret=join'',map{chr$SHIFTS[$_] }@str;3367return$ret;3368}33693370# Test if the (deep) values of two references to a hash are the same.3371sub refHashEqual3372{3373my($v1,$v2) =@_;33743375my$out;3376if(!defined($v1))3377{3378if(!defined($v2))3379{3380$out=1;3381}3382}3383elsif( !defined($v2) ||3384scalar(keys(%{$v1})) !=scalar(keys(%{$v2})) )3385{3386# $out=undef;3387}3388else3389{3390$out=1;33913392my$key;3393foreach$key(keys(%{$v1}))3394{3395if( !exists($v2->{$key}) ||3396defined($v1->{$key})ne defined($v2->{$key}) ||3397(defined($v1->{$key}) &&3398$v1->{$key}ne$v2->{$key} ) )3399{3400$out=undef;3401last;3402}3403}3404}34053406return$out;3407}34083409# an alternative to `command` that allows input to be passed as an array3410# to work around shell problems with weird characters in arguments34113412sub safe_pipe_capture {34133414my@output;34153416if(my$pid=open my$child,'-|') {3417@output= (<$child>);3418close$childor die join(' ',@_).":$!$?";3419}else{3420exec(@_)or die"$!$?";# exec() can fail the executable can't be found3421}3422returnwantarray?@output:join('',@output);3423}342434253426package GITCVS::log;34273428####3429#### Copyright The Open University UK - 2006.3430####3431#### Authors: Martyn Smith <martyn@catalyst.net.nz>3432#### Martin Langhoff <martin@laptop.org>3433####3434####34353436use strict;3437use warnings;34383439=head1 NAME34403441GITCVS::log34423443=head1 DESCRIPTION34443445This module provides very crude logging with a similar interface to3446Log::Log4perl34473448=head1 METHODS34493450=cut34513452=head2 new34533454Creates a new log object, optionally you can specify a filename here to3455indicate the file to log to. If no log file is specified, you can specify one3456later with method setfile, or indicate you no longer want logging with method3457nofile.34583459Until one of these methods is called, all log calls will buffer messages ready3460to write out.34613462=cut3463sub new3464{3465my$class=shift;3466my$filename=shift;34673468my$self= {};34693470bless$self,$class;34713472if(defined($filename) )3473{3474open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");3475}34763477return$self;3478}34793480=head2 setfile34813482This methods takes a filename, and attempts to open that file as the log file.3483If successful, all buffered data is written out to the file, and any further3484logging is written directly to the file.34853486=cut3487sub setfile3488{3489my$self=shift;3490my$filename=shift;34913492if(defined($filename) )3493{3494open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");3495}34963497return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");34983499while(my$line=shift@{$self->{buffer}} )3500{3501print{$self->{fh}}$line;3502}3503}35043505=head2 nofile35063507This method indicates no logging is going to be used. It flushes any entries in3508the internal buffer, and sets a flag to ensure no further data is put there.35093510=cut3511sub nofile3512{3513my$self=shift;35143515$self->{nolog} =1;35163517return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");35183519$self->{buffer} = [];3520}35213522=head2 _logopen35233524Internal method. Returns true if the log file is open, false otherwise.35253526=cut3527sub _logopen3528{3529my$self=shift;35303531return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");3532return0;3533}35343535=head2 debug info warn fatal35363537These four methods are wrappers to _log. They provide the actual interface for3538logging data.35393540=cut3541sub debug {my$self=shift;$self->_log("debug",@_); }3542sub info {my$self=shift;$self->_log("info",@_); }3543subwarn{my$self=shift;$self->_log("warn",@_); }3544sub fatal {my$self=shift;$self->_log("fatal",@_); }35453546=head2 _log35473548This is an internal method called by the logging functions. It generates a3549timestamp and pushes the logged line either to file, or internal buffer.35503551=cut3552sub _log3553{3554my$self=shift;3555my$level=shift;35563557return if($self->{nolog} );35583559my@time=localtime;3560my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",3561$time[5] +1900,3562$time[4] +1,3563$time[3],3564$time[2],3565$time[1],3566$time[0],3567uc$level,3568);35693570if($self->_logopen)3571{3572print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";3573}else{3574push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";3575}3576}35773578=head2 DESTROY35793580This method simply closes the file handle if one is open35813582=cut3583sub DESTROY3584{3585my$self=shift;35863587if($self->_logopen)3588{3589close$self->{fh};3590}3591}35923593package GITCVS::updater;35943595####3596#### Copyright The Open University UK - 2006.3597####3598#### Authors: Martyn Smith <martyn@catalyst.net.nz>3599#### Martin Langhoff <martin@laptop.org>3600####3601####36023603use strict;3604use warnings;3605use DBI;36063607=head1 METHODS36083609=cut36103611=head2 new36123613=cut3614sub new3615{3616my$class=shift;3617my$config=shift;3618my$module=shift;3619my$log=shift;36203621die"Need to specify a git repository"unless(defined($config)and-d $config);3622die"Need to specify a module"unless(defined($module) );36233624$class=ref($class) ||$class;36253626my$self= {};36273628bless$self,$class;36293630$self->{valid_tables} = {'revision'=>1,3631'revision_ix1'=>1,3632'revision_ix2'=>1,3633'head'=>1,3634'head_ix1'=>1,3635'properties'=>1,3636'commitmsgs'=>1};36373638$self->{module} =$module;3639$self->{git_path} =$config."/";36403641$self->{log} =$log;36423643die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );36443645# Stores full sha1's for various branch/tag names, abbreviations, etc:3646$self->{commitRefCache} = {};36473648$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||3649$cfg->{gitcvs}{dbdriver} ||"SQLite";3650$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||3651$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";3652$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||3653$cfg->{gitcvs}{dbuser} ||"";3654$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||3655$cfg->{gitcvs}{dbpass} ||"";3656$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||3657$cfg->{gitcvs}{dbtablenameprefix} ||"";3658my%mapping= ( m =>$module,3659 a =>$state->{method},3660 u =>getlogin||getpwuid($<) || $<,3661 G =>$self->{git_path},3662 g => mangle_dirname($self->{git_path}),3663);3664$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;3665$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;3666$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;3667$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});36683669die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;3670die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;3671$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",3672$self->{dbuser},3673$self->{dbpass});3674die"Error connecting to database\n"unlessdefined$self->{dbh};36753676$self->{tables} = {};3677foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )3678{3679$self->{tables}{$table} =1;3680}36813682# Construct the revision table if required3683# The revision table stores an entry for each file, each time that file3684# changes.3685# numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )3686# This is not sufficient to support "-r {commithash}" for any3687# files except files that were modified by that commit (also,3688# some places in the code ignore/effectively strip out -r in3689# some cases, before it gets passed to getmeta()).3690# The "filehash" field typically has a git blob hash, but can also3691# be set to "dead" to indicate that the given version of the file3692# should not exist in the sandbox.3693unless($self->{tables}{$self->tablename("revision")} )3694{3695my$tablename=$self->tablename("revision");3696my$ix1name=$self->tablename("revision_ix1");3697my$ix2name=$self->tablename("revision_ix2");3698$self->{dbh}->do("3699 CREATE TABLE$tablename(3700 name TEXT NOT NULL,3701 revision INTEGER NOT NULL,3702 filehash TEXT NOT NULL,3703 commithash TEXT NOT NULL,3704 author TEXT NOT NULL,3705 modified TEXT NOT NULL,3706 mode TEXT NOT NULL3707 )3708 ");3709$self->{dbh}->do("3710 CREATE INDEX$ix1name3711 ON$tablename(name,revision)3712 ");3713$self->{dbh}->do("3714 CREATE INDEX$ix2name3715 ON$tablename(name,commithash)3716 ");3717}37183719# Construct the head table if required3720# The head table (along with the "last_commit" entry in the property3721# table) is the persisted working state of the "sub update" subroutine.3722# All of it's data is read entirely first, and completely recreated3723# last, every time "sub update" runs.3724# This is also used by "sub getmeta" when it is asked for the latest3725# version of a file (as opposed to some specific version).3726# Another way of thinking about it is as a single slice out of3727# "revisions", giving just the most recent revision information for3728# each file.3729unless($self->{tables}{$self->tablename("head")} )3730{3731my$tablename=$self->tablename("head");3732my$ix1name=$self->tablename("head_ix1");3733$self->{dbh}->do("3734 CREATE TABLE$tablename(3735 name TEXT NOT NULL,3736 revision INTEGER NOT NULL,3737 filehash TEXT NOT NULL,3738 commithash TEXT NOT NULL,3739 author TEXT NOT NULL,3740 modified TEXT NOT NULL,3741 mode TEXT NOT NULL3742 )3743 ");3744$self->{dbh}->do("3745 CREATE INDEX$ix1name3746 ON$tablename(name)3747 ");3748}37493750# Construct the properties table if required3751# - "last_commit" - Used by "sub update".3752unless($self->{tables}{$self->tablename("properties")} )3753{3754my$tablename=$self->tablename("properties");3755$self->{dbh}->do("3756 CREATE TABLE$tablename(3757 key TEXT NOT NULL PRIMARY KEY,3758 value TEXT3759 )3760 ");3761}37623763# Construct the commitmsgs table if required3764# The commitmsgs table is only used for merge commits, since3765# "sub update" will only keep one branch of parents. Shortlogs3766# for ignored commits (i.e. not on the chosen branch) will be used3767# to construct a replacement "collapsed" merge commit message,3768# which will be stored in this table. See also "sub commitmessage".3769unless($self->{tables}{$self->tablename("commitmsgs")} )3770{3771my$tablename=$self->tablename("commitmsgs");3772$self->{dbh}->do("3773 CREATE TABLE$tablename(3774 key TEXT NOT NULL PRIMARY KEY,3775 value TEXT3776 )3777 ");3778}37793780return$self;3781}37823783=head2 tablename37843785=cut3786sub tablename3787{3788my$self=shift;3789my$name=shift;37903791if(exists$self->{valid_tables}{$name}) {3792return$self->{dbtablenameprefix} .$name;3793}else{3794returnundef;3795}3796}37973798=head2 update37993800Bring the database up to date with the latest changes from3801the git repository.38023803Internal working state is read out of the "head" table and the3804"last_commit" property, then it updates "revisions" based on that, and3805finally it writes the new internal state back to the "head" table3806so it can be used as a starting point the next time update is called.38073808=cut3809sub update3810{3811my$self=shift;38123813# first lets get the commit list3814$ENV{GIT_DIR} =$self->{git_path};38153816my$commitsha1= ::safe_pipe_capture('git','rev-parse',$self->{module});3817chomp$commitsha1;38183819my$commitinfo= ::safe_pipe_capture('git','cat-file','commit',$self->{module});3820unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)3821{3822die("Invalid module '$self->{module}'");3823}382438253826my$git_log;3827my$lastcommit=$self->_get_prop("last_commit");38283829if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date3830# invalidate the gethead cache3831$self->clearCommitRefCaches();3832return1;3833}38343835# Start exclusive lock here...3836$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";38373838# TODO: log processing is memory bound3839# if we can parse into a 2nd file that is in reverse order3840# we can probably do something really efficient3841my@git_log_params= ('--pretty','--parents','--topo-order');38423843if(defined$lastcommit) {3844push@git_log_params,"$lastcommit..$self->{module}";3845}else{3846push@git_log_params,$self->{module};3847}3848# git-rev-list is the backend / plumbing version of git-log3849open(my$gitLogPipe,'-|','git','rev-list',@git_log_params)3850or die"Cannot call git-rev-list:$!";3851my@commits=readCommits($gitLogPipe);3852close$gitLogPipe;38533854# Now all the commits are in the @commits bucket3855# ordered by time DESC. for each commit that needs processing,3856# determine whether it's following the last head we've seen or if3857# it's on its own branch, grab a file list, and add whatever's changed3858# NOTE: $lastcommit refers to the last commit from previous run3859# $lastpicked is the last commit we picked in this run3860my$lastpicked;3861my$head= {};3862if(defined$lastcommit) {3863$lastpicked=$lastcommit;3864}38653866my$committotal=scalar(@commits);3867my$commitcount=0;38683869# Load the head table into $head (for cached lookups during the update process)3870foreachmy$file( @{$self->gethead(1)} )3871{3872$head->{$file->{name}} =$file;3873}38743875foreachmy$commit(@commits)3876{3877$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3878if(defined$lastpicked)3879{3880if(!in_array($lastpicked, @{$commit->{parents}}))3881{3882# skip, we'll see this delta3883# as part of a merge later3884# warn "skipping off-track $commit->{hash}\n";3885next;3886}elsif(@{$commit->{parents}} >1) {3887# it is a merge commit, for each parent that is3888# not $lastpicked (not given a CVS revision number),3889# see if we can get a log3890# from the merge-base to that parent to put it3891# in the message as a merge summary.3892my@parents= @{$commit->{parents}};3893foreachmy$parent(@parents) {3894if($parenteq$lastpicked) {3895next;3896}3897# git-merge-base can potentially (but rarely) throw3898# several candidate merge bases. let's assume3899# that the first one is the best one.3900my$base=eval{3901::safe_pipe_capture('git','merge-base',3902$lastpicked,$parent);3903};3904# The two branches may not be related at all,3905# in which case merge base simply fails to find3906# any, but that's Ok.3907next if($@);39083909chomp$base;3910if($base) {3911my@merged;3912# print "want to log between $base $parent \n";3913open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3914or die"Cannot call git-log:$!";3915my$mergedhash;3916while(<GITLOG>) {3917chomp;3918if(!defined$mergedhash) {3919if(m/^commit\s+(.+)$/) {3920$mergedhash=$1;3921}else{3922next;3923}3924}else{3925# grab the first line that looks non-rfc8223926# aka has content after leading space3927if(m/^\s+(\S.*)$/) {3928my$title=$1;3929$title=substr($title,0,100);# truncate3930unshift@merged,"$mergedhash$title";3931undef$mergedhash;3932}3933}3934}3935close GITLOG;3936if(@merged) {3937$commit->{mergemsg} =$commit->{message};3938$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3939foreachmy$summary(@merged) {3940$commit->{mergemsg} .="\t$summary\n";3941}3942$commit->{mergemsg} .="\n\n";3943# print "Message for $commit->{hash} \n$commit->{mergemsg}";3944}3945}3946}3947}3948}39493950# convert the date to CVS-happy format3951my$cvsDate= convertToCvsDate($commit->{date});39523953if(defined($lastpicked) )3954{3955my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3956local($/) ="\0";3957while( <FILELIST> )3958{3959chomp;3960unless(/^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/o)3961{3962die("Couldn't process git-diff-tree line :$_");3963}3964my($mode,$hash,$change) = ($1,$2,$3);3965my$name= <FILELIST>;3966chomp($name);39673968# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");39693970my$dbMode= convertToDbMode($mode);39713972if($changeeq"D")3973{3974#$log->debug("DELETE $name");3975$head->{$name} = {3976 name =>$name,3977 revision =>$head->{$name}{revision} +1,3978 filehash =>"deleted",3979 commithash =>$commit->{hash},3980 modified =>$cvsDate,3981 author =>$commit->{author},3982 mode =>$dbMode,3983};3984$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3985}3986elsif($changeeq"M"||$changeeq"T")3987{3988#$log->debug("MODIFIED $name");3989$head->{$name} = {3990 name =>$name,3991 revision =>$head->{$name}{revision} +1,3992 filehash =>$hash,3993 commithash =>$commit->{hash},3994 modified =>$cvsDate,3995 author =>$commit->{author},3996 mode =>$dbMode,3997};3998$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3999}4000elsif($changeeq"A")4001{4002#$log->debug("ADDED $name");4003$head->{$name} = {4004 name =>$name,4005 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,4006 filehash =>$hash,4007 commithash =>$commit->{hash},4008 modified =>$cvsDate,4009 author =>$commit->{author},4010 mode =>$dbMode,4011};4012$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);4013}4014else4015{4016$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");4017die;4018}4019}4020close FILELIST;4021}else{4022# this is used to detect files removed from the repo4023my$seen_files= {};40244025my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");4026local$/="\0";4027while( <FILELIST> )4028{4029chomp;4030unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4031{4032die("Couldn't process git-ls-tree line :$_");4033}40344035my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);40364037$seen_files->{$git_filename} =1;40384039my($oldhash,$oldrevision,$oldmode) = (4040$head->{$git_filename}{filehash},4041$head->{$git_filename}{revision},4042$head->{$git_filename}{mode}4043);40444045my$dbMode= convertToDbMode($mode);40464047# unless the file exists with the same hash, we need to update it ...4048unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$dbMode)4049{4050my$newrevision= ($oldrevisionor0) +1;40514052$head->{$git_filename} = {4053 name =>$git_filename,4054 revision =>$newrevision,4055 filehash =>$git_hash,4056 commithash =>$commit->{hash},4057 modified =>$cvsDate,4058 author =>$commit->{author},4059 mode =>$dbMode,4060};406140624063$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);4064}4065}4066close FILELIST;40674068# Detect deleted files4069foreachmy$file(sort keys%$head)4070{4071unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")4072{4073$head->{$file}{revision}++;4074$head->{$file}{filehash} ="deleted";4075$head->{$file}{commithash} =$commit->{hash};4076$head->{$file}{modified} =$cvsDate;4077$head->{$file}{author} =$commit->{author};40784079$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$cvsDate,$commit->{author},$head->{$file}{mode});4080}4081}4082# END : "Detect deleted files"4083}408440854086if(exists$commit->{mergemsg})4087{4088$self->insert_mergelog($commit->{hash},$commit->{mergemsg});4089}40904091$lastpicked=$commit->{hash};40924093$self->_set_prop("last_commit",$commit->{hash});4094}40954096$self->delete_head();4097foreachmy$file(sort keys%$head)4098{4099$self->insert_head(4100$file,4101$head->{$file}{revision},4102$head->{$file}{filehash},4103$head->{$file}{commithash},4104$head->{$file}{modified},4105$head->{$file}{author},4106$head->{$file}{mode},4107);4108}4109# invalidate the gethead cache4110$self->clearCommitRefCaches();411141124113# Ending exclusive lock here4114$self->{dbh}->commit()or die"Failed to commit changes to SQLite";4115}41164117sub readCommits4118{4119my$pipeHandle=shift;4120my@commits;41214122my%commit= ();41234124while( <$pipeHandle> )4125{4126chomp;4127if(m/^commit\s+(.*)$/) {4128# on ^commit lines put the just seen commit in the stack4129# and prime things for the next one4130if(keys%commit) {4131my%copy=%commit;4132unshift@commits, \%copy;4133%commit= ();4134}4135my@parents=split(m/\s+/,$1);4136$commit{hash} =shift@parents;4137$commit{parents} = \@parents;4138}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {4139# on rfc822-like lines seen before we see any message,4140# lowercase the entry and put it in the hash as key-value4141$commit{lc($1)} =$2;4142}else{4143# message lines - skip initial empty line4144# and trim whitespace4145if(!exists($commit{message}) &&m/^\s*$/) {4146# define it to mark the end of headers4147$commit{message} ='';4148next;4149}4150s/^\s+//;s/\s+$//;# trim ws4151$commit{message} .=$_."\n";4152}4153}41544155unshift@commits, \%commitif(keys%commit);41564157return@commits;4158}41594160sub convertToCvsDate4161{4162my$date=shift;4163# Convert from: "git rev-list --pretty" formatted date4164# Convert to: "the format specified by RFC822 as modified by RFC1123."4165# Example: 26 May 1997 13:01:40 -04004166if($date=~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/)4167{4168$date="$2$1$4$3$5";4169}41704171return$date;4172}41734174sub convertToDbMode4175{4176my$mode=shift;41774178# NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",4179# but the database "mode" column historically (and currently)4180# only stores the "rw" (for user) part of the string.4181# FUTURE: It might make more sense to persist the raw4182# octal mode (or perhaps the final full CVS form) instead of4183# this half-converted form, but it isn't currently worth the4184# backwards compatibility headaches.41854186$mode=~/^\d{3}(\d)\d\d$/;4187my$userBits=$1;41884189my$dbMode="";4190$dbMode.="r"if($userBits&4);4191$dbMode.="w"if($userBits&2);4192$dbMode.="x"if($userBits&1);4193$dbMode="rw"if($dbModeeq"");41944195return$dbMode;4196}41974198sub insert_rev4199{4200my$self=shift;4201my$name=shift;4202my$revision=shift;4203my$filehash=shift;4204my$commithash=shift;4205my$modified=shift;4206my$author=shift;4207my$mode=shift;4208my$tablename=$self->tablename("revision");42094210my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);4211$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);4212}42134214sub insert_mergelog4215{4216my$self=shift;4217my$key=shift;4218my$value=shift;4219my$tablename=$self->tablename("commitmsgs");42204221my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);4222$insert_mergelog->execute($key,$value);4223}42244225sub delete_head4226{4227my$self=shift;4228my$tablename=$self->tablename("head");42294230my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);4231$delete_head->execute();4232}42334234sub insert_head4235{4236my$self=shift;4237my$name=shift;4238my$revision=shift;4239my$filehash=shift;4240my$commithash=shift;4241my$modified=shift;4242my$author=shift;4243my$mode=shift;4244my$tablename=$self->tablename("head");42454246my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);4247$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);4248}42494250sub _get_prop4251{4252my$self=shift;4253my$key=shift;4254my$tablename=$self->tablename("properties");42554256my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);4257$db_query->execute($key);4258my($value) =$db_query->fetchrow_array;42594260return$value;4261}42624263sub _set_prop4264{4265my$self=shift;4266my$key=shift;4267my$value=shift;4268my$tablename=$self->tablename("properties");42694270my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);4271$db_query->execute($value,$key);42724273unless($db_query->rows)4274{4275$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);4276$db_query->execute($key,$value);4277}42784279return$value;4280}42814282=head2 gethead42834284=cut42854286sub gethead4287{4288my$self=shift;4289my$intRev=shift;4290my$tablename=$self->tablename("head");42914292return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );42934294my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);4295$db_query->execute();42964297my$tree= [];4298while(my$file=$db_query->fetchrow_hashref)4299{4300if(!$intRev)4301{4302$file->{revision} ="1.$file->{revision}"4303}4304push@$tree,$file;4305}43064307$self->{gethead_cache} =$tree;43084309return$tree;4310}43114312=head2 getAnyHead43134314Returns a reference to an array of getmeta structures, one4315per file in the specified tree hash.43164317=cut43184319sub getAnyHead4320{4321my($self,$hash) =@_;43224323if(!defined($hash))4324{4325return$self->gethead();4326}43274328my@files;4329{4330open(my$filePipe,'-|','git','ls-tree','-z','-r',$hash)4331or die("Cannot call git-ls-tree :$!");4332local$/="\0";4333@files=<$filePipe>;4334close$filePipe;4335}43364337my$tree=[];4338my($line);4339foreach$line(@files)4340{4341$line=~s/\0$//;4342unless($line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4343{4344die("Couldn't process git-ls-tree line :$_");4345}43464347my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);4348push@$tree,$self->getMetaFromCommithash($git_filename,$hash);4349}43504351return$tree;4352}43534354=head2 getRevisionDirMap43554356A "revision dir map" contains all the plain-file filenames associated4357with a particular revision (tree-ish), organized by directory:43584359 $type = $out->{$dir}{$fullName}43604361The type of each is "F" (for ordinary file) or "D" (for directory,4362for which the map $out->{$fullName} will also exist).43634364=cut43654366sub getRevisionDirMap4367{4368my($self,$ver)=@_;43694370if(!defined($self->{revisionDirMapCache}))4371{4372$self->{revisionDirMapCache}={};4373}43744375# Get file list (previously cached results are dependent on HEAD,4376# but are early in each case):4377my$cacheKey;4378my(@fileList);4379if( !defined($ver) ||$vereq"")4380{4381$cacheKey="";4382if(defined($self->{revisionDirMapCache}{$cacheKey}) )4383{4384return$self->{revisionDirMapCache}{$cacheKey};4385}43864387my@head= @{$self->gethead()};4388foreachmy$file(@head)4389{4390next if($file->{filehash}eq"deleted");43914392push@fileList,$file->{name};4393}4394}4395else4396{4397my($hash)=$self->lookupCommitRef($ver);4398if( !defined($hash) )4399{4400returnundef;4401}44024403$cacheKey=$hash;4404if(defined($self->{revisionDirMapCache}{$cacheKey}) )4405{4406return$self->{revisionDirMapCache}{$cacheKey};4407}44084409open(my$filePipe,'-|','git','ls-tree','-z','-r',$hash)4410or die("Cannot call git-ls-tree :$!");4411local$/="\0";4412while( <$filePipe> )4413{4414chomp;4415unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4416{4417die("Couldn't process git-ls-tree line :$_");4418}44194420my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);44214422push@fileList,$git_filename;4423}4424close$filePipe;4425}44264427# Convert to normalized form:4428my%revMap;4429my$file;4430foreach$file(@fileList)4431{4432my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);4433$dir=''if(!defined($dir));44344435# parent directories:4436# ... create empty dir maps for parent dirs:4437my($td)=$dir;4438while(!defined($revMap{$td}))4439{4440$revMap{$td}={};44414442my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);4443$tp=''if(!defined($tp));4444$td=$tp;4445}4446# ... add children to parent maps (now that they exist):4447$td=$dir;4448while($tdne"")4449{4450my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);4451$tp=''if(!defined($tp));44524453if(defined($revMap{$tp}{$td}))4454{4455if($revMap{$tp}{$td}ne'D')4456{4457die"Weird file/directory inconsistency in$cacheKey";4458}4459last;# loop exit4460}4461$revMap{$tp}{$td}='D';44624463$td=$tp;4464}44654466# file4467$revMap{$dir}{$file}='F';4468}44694470# Save in cache:4471$self->{revisionDirMapCache}{$cacheKey}=\%revMap;4472return$self->{revisionDirMapCache}{$cacheKey};4473}44744475=head2 getlog44764477See also gethistorydense().44784479=cut44804481sub getlog4482{4483my$self=shift;4484my$filename=shift;4485my$revFilter=shift;44864487my$tablename=$self->tablename("revision");44884489# Filters:4490# TODO: date, state, or by specific logins filters?4491# TODO: Handle comma-separated list of revFilter items, each item4492# can be a range [only case currently handled] or individual4493# rev or branch or "branch.".4494# TODO: Adjust $db_query WHERE clause based on revFilter, instead of4495# manually filtering the results of the query?4496my($minrev,$maxrev);4497if(defined($revFilter)and4498$state->{opt}{r} =~/^(1.(\d+))?(::?)(1.(\d.+))?$/)4499{4500my$control=$3;4501$minrev=$2;4502$maxrev=$5;4503$minrev++if(defined($minrev)and$controleq"::");4504}45054506my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);4507$db_query->execute($filename);45084509my$totalRevs=0;4510my$tree= [];4511while(my$file=$db_query->fetchrow_hashref)4512{4513$totalRevs++;4514if(defined($minrev)and$file->{revision} <$minrev)4515{4516next;4517}4518if(defined($maxrev)and$file->{revision} >$maxrev)4519{4520next;4521}45224523$file->{revision} ="1.".$file->{revision};4524push@$tree,$file;4525}45264527return($tree,$totalRevs);4528}45294530=head2 getmeta45314532This function takes a filename (with path) argument and returns a hashref of4533metadata for that file.45344535There are several ways $revision can be specified:45364537 - A reference to hash that contains a "tag" that is the4538 actual revision (one of the below). TODO: Also allow it to4539 specify a "date" in the hash.4540 - undef, to refer to the latest version on the main branch.4541 - Full CVS client revision number (mapped to integer in DB, without the4542 "1." prefix),4543 - Complex CVS-compatible "special" revision number for4544 non-linear history (see comment below)4545 - git commit sha1 hash4546 - branch or tag name45474548=cut45494550sub getmeta4551{4552my$self=shift;4553my$filename=shift;4554my$revision=shift;4555my$tablename_rev=$self->tablename("revision");4556my$tablename_head=$self->tablename("head");45574558if(ref($revision)eq"HASH")4559{4560$revision=$revision->{tag};4561}45624563# Overview of CVS revision numbers:4564#4565# General CVS numbering scheme:4566# - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.4567# - Result of "cvs checkin -r" (possible, but not really4568# recommended): "2.1", "2.2", etc4569# - Branch tag: "1.2.0.n", where "1.2" is revision it was branched4570# from, "0" is a magic placeholder that identifies it as a4571# branch tag instead of a version tag, and n is 2 times the4572# branch number off of "1.2", starting with "2".4573# - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"4574# is branch number off of "1.2" (like n above), and "x" is4575# the version number on the branch.4576# - Branches can branch off of branches: "1.3.2.7.4.1" (even number4577# of components).4578# - Odd "n"s are used by "vendor branches" that result4579# from "cvs import". Vendor branches have additional4580# strangeness in the sense that the main rcs "head" of the main4581# branch will (temporarily until first normal commit) point4582# to the version on the vendor branch, rather than the actual4583# main branch. (FUTURE: This may provide an opportunity4584# to use "strange" revision numbers for fast-forward-merged4585# branch tip when CVS client is asking for the main branch.)4586#4587# git-cvsserver CVS-compatible special numbering schemes:4588# - Currently git-cvsserver only tries to be identical to CVS for4589# simple "1.x" numbers on the "main" branch (as identified4590# by the module name that was originally cvs checkout'ed).4591# - The database only stores the "x" part, for historical reasons.4592# But most of the rest of the cvsserver preserves4593# and thinks using the full revision number.4594# - To handle non-linear history, it uses a version of the form4595# "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely4596# identify this as a special revision number, and there are4597# 20 b's that together encode the sha1 git commit from which4598# this version of this file originated. Each b is4599# the numerical value of the corresponding byte plus4600# 100.4601# - "plus 100" avoids "0"s, and also reduces the4602# likelihood of a collision in the case that someone someday4603# writes an import tool that tries to preserve original4604# CVS revision numbers, and the original CVS data had done4605# lots of branches off of branches and other strangeness to4606# end up with a real version number that just happens to look4607# like this special revision number form. Also, if needed4608# there are several ways to extend/identify alternative encodings4609# within the "2.1.1.2000" part if necessary.4610# - Unlike real CVS revisions, you can't really reconstruct what4611# relation a revision of this form has to other revisions.4612# - FUTURE: TODO: Rework database somehow to make up and remember4613# fully-CVS-compatible branches and branch version numbers.46144615my$meta;4616if(defined($revision) )4617{4618if($revision=~/^1\.(\d+)$/)4619{4620my($intRev) =$1;4621my$db_query;4622$db_query=$self->{dbh}->prepare_cached(4623"SELECT * FROM$tablename_revWHERE name=? AND revision=?",4624{},1);4625$db_query->execute($filename,$intRev);4626$meta=$db_query->fetchrow_hashref;4627}4628elsif($revision=~/^2\.1\.1\.2000(\.[1-3][0-9][0-9]){20}$/)4629{4630my($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);4631$commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;4632if($commitHash=~/^[0-9a-f]{40}$/)4633{4634return$self->getMetaFromCommithash($filename,$commitHash);4635}46364637# error recovery: fall back on head version below4638print"E Failed to find$filenameversion=$revisionor commit=$commitHash\n";4639$log->warning("failed get$revisionwith commithash=$commitHash");4640undef$revision;4641}4642elsif($revision=~/^[0-9a-f]{40}$/)4643{4644# Try DB first. This is mostly only useful for req_annotate(),4645# which only calls this for stuff that should already be in4646# the DB. It is fairly likely to be a waste of time4647# in most other cases [unless the file happened to be4648# modified in $revision specifically], but4649# it is probably in the noise compared to how long4650# getMetaFromCommithash() will take.4651my$db_query;4652$db_query=$self->{dbh}->prepare_cached(4653"SELECT * FROM$tablename_revWHERE name=? AND commithash=?",4654{},1);4655$db_query->execute($filename,$revision);4656$meta=$db_query->fetchrow_hashref;46574658if(!$meta)4659{4660my($revCommit)=$self->lookupCommitRef($revision);4661if($revCommit=~/^[0-9a-f]{40}$/)4662{4663return$self->getMetaFromCommithash($filename,$revCommit);4664}46654666# error recovery: nothing found:4667print"E Failed to find$filenameversion=$revision\n";4668$log->warning("failed get$revision");4669return$meta;4670}4671}4672else4673{4674my($revCommit)=$self->lookupCommitRef($revision);4675if($revCommit=~/^[0-9a-f]{40}$/)4676{4677return$self->getMetaFromCommithash($filename,$revCommit);4678}46794680# error recovery: fall back on head version below4681print"E Failed to find$filenameversion=$revision\n";4682$log->warning("failed get$revision");4683undef$revision;# Allow fallback4684}4685}46864687if(!defined($revision))4688{4689my$db_query;4690$db_query=$self->{dbh}->prepare_cached(4691"SELECT * FROM$tablename_headWHERE name=?",{},1);4692$db_query->execute($filename);4693$meta=$db_query->fetchrow_hashref;4694}46954696if($meta)4697{4698$meta->{revision} ="1.$meta->{revision}";4699}4700return$meta;4701}47024703sub getMetaFromCommithash4704{4705my$self=shift;4706my$filename=shift;4707my$revCommit=shift;47084709# NOTE: This function doesn't scale well (lots of forks), especially4710# if you have many files that have not been modified for many commits4711# (each git-rev-parse redoes a lot of work for each file4712# that theoretically could be done in parallel by smarter4713# graph traversal).4714#4715# TODO: Possible optimization strategies:4716# - Solve the issue of assigning and remembering "real" CVS4717# revision numbers for branches, and ensure the4718# data structure can do this efficiently. Perhaps something4719# similar to "git notes", and carefully structured to take4720# advantage same-sha1-is-same-contents, to roll the same4721# unmodified subdirectory data onto multiple commits?4722# - Write and use a C tool that is like git-blame, but4723# operates on multiple files with file granularity, instead4724# of one file with line granularity. Cache4725# most-recently-modified in $self->{commitRefCache}{$revCommit}.4726# Try to be intelligent about how many files we do with4727# one fork (perhaps one directory at a time, without recursion,4728# and/or include directory as one line item, recurse from here4729# instead of in C tool?).4730# - Perhaps we could ask the DB for (filename,fileHash),4731# and just guess that it is correct (that the file hadn't4732# changed between $revCommit and the found commit, then4733# changed back, confusing anything trying to interpret4734# history). Probably need to add another index to revisions4735# DB table for this.4736# - NOTE: Trying to store all (commit,file) keys in DB [to4737# find "lastModfiedCommit] (instead of4738# just files that changed in each commit as we do now) is4739# probably not practical from a disk space perspective.47404741# Does the file exist in $revCommit?4742# TODO: Include file hash in dirmap cache.4743my($dirMap)=$self->getRevisionDirMap($revCommit);4744my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);4745if(!defined($dir))4746{4747$dir="";4748}4749if( !defined($dirMap->{$dir}) ||4750!defined($dirMap->{$dir}{$filename}) )4751{4752my($fileHash)="deleted";47534754my($retVal)={};4755$retVal->{name}=$filename;4756$retVal->{filehash}=$fileHash;47574758# not needed and difficult to compute:4759$retVal->{revision}="0";# $revision;4760$retVal->{commithash}=$revCommit;4761#$retVal->{author}=$commit->{author};4762#$retVal->{modified}=convertToCvsDate($commit->{date});4763#$retVal->{mode}=convertToDbMode($mode);47644765return$retVal;4766}47674768my($fileHash) = ::safe_pipe_capture("git","rev-parse","$revCommit:$filename");4769chomp$fileHash;4770if(!($fileHash=~/^[0-9a-f]{40}$/))4771{4772die"Invalid fileHash '$fileHash' looking up"4773." '$revCommit:$filename'\n";4774}47754776# information about most recent commit to modify $filename:4777open(my$gitLogPipe,'-|','git','rev-list',4778'--max-count=1','--pretty','--parents',4779$revCommit,'--',$filename)4780or die"Cannot call git-rev-list:$!";4781my@commits=readCommits($gitLogPipe);4782close$gitLogPipe;4783if(scalar(@commits)!=1)4784{4785die"Can't find most recent commit changing$filename\n";4786}4787my($commit)=$commits[0];4788if( !defined($commit) || !defined($commit->{hash}) )4789{4790returnundef;4791}47924793# does this (commit,file) have a real assigned CVS revision number?4794my$tablename_rev=$self->tablename("revision");4795my$db_query;4796$db_query=$self->{dbh}->prepare_cached(4797"SELECT * FROM$tablename_revWHERE name=? AND commithash=?",4798{},1);4799$db_query->execute($filename,$commit->{hash});4800my($meta)=$db_query->fetchrow_hashref;4801if($meta)4802{4803$meta->{revision} ="1.$meta->{revision}";4804return$meta;4805}48064807# fall back on special revision number4808my($revision)=$commit->{hash};4809$revision=~s/(..)/'.' . (hex($1)+100)/eg;4810$revision="2.1.1.2000$revision";48114812# meta data about $filename:4813open(my$filePipe,'-|','git','ls-tree','-z',4814$commit->{hash},'--',$filename)4815or die("Cannot call git-ls-tree :$!");4816local$/="\0";4817my$line;4818$line=<$filePipe>;4819if(defined(<$filePipe>))4820{4821die"Expected only a single file for git-ls-tree$filename\n";4822}4823close$filePipe;48244825chomp$line;4826unless($line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4827{4828die("Couldn't process git-ls-tree line :$line\n");4829}4830my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);48314832# save result:4833my($retVal)={};4834$retVal->{name}=$filename;4835$retVal->{revision}=$revision;4836$retVal->{filehash}=$fileHash;4837$retVal->{commithash}=$revCommit;4838$retVal->{author}=$commit->{author};4839$retVal->{modified}=convertToCvsDate($commit->{date});4840$retVal->{mode}=convertToDbMode($mode);48414842return$retVal;4843}48444845=head2 lookupCommitRef48464847Convert tag/branch/abbreviation/etc into a commit sha1 hash. Caches4848the result so looking it up again is fast.48494850=cut48514852sub lookupCommitRef4853{4854my$self=shift;4855my$ref=shift;48564857my$commitHash=$self->{commitRefCache}{$ref};4858if(defined($commitHash))4859{4860return$commitHash;4861}48624863$commitHash= ::safe_pipe_capture("git","rev-parse","--verify","--quiet",4864$self->unescapeRefName($ref));4865$commitHash=~s/\s*$//;4866if(!($commitHash=~/^[0-9a-f]{40}$/))4867{4868$commitHash=undef;4869}48704871if(defined($commitHash) )4872{4873my$type= ::safe_pipe_capture("git","cat-file","-t",$commitHash);4874if( ! ($type=~/^commit\s*$/) )4875{4876$commitHash=undef;4877}4878}4879if(defined($commitHash))4880{4881$self->{commitRefCache}{$ref}=$commitHash;4882}4883return$commitHash;4884}48854886=head2 clearCommitRefCaches48874888Clears cached commit cache (sha1's for various tags/abbeviations/etc),4889and related caches.48904891=cut48924893sub clearCommitRefCaches4894{4895my$self=shift;4896$self->{commitRefCache} = {};4897$self->{revisionDirMapCache} =undef;4898$self->{gethead_cache} =undef;4899}49004901=head2 commitmessage49024903this function takes a commithash and returns the commit message for that commit49044905=cut4906sub commitmessage4907{4908my$self=shift;4909my$commithash=shift;4910my$tablename=$self->tablename("commitmsgs");49114912die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);49134914my$db_query;4915$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);4916$db_query->execute($commithash);49174918my($message) =$db_query->fetchrow_array;49194920if(defined($message) )4921{4922$message.=" "if($message=~/\n$/);4923return$message;4924}49254926my@lines= ::safe_pipe_capture("git","cat-file","commit",$commithash);4927shift@lineswhile($lines[0] =~/\S/);4928$message=join("",@lines);4929$message.=" "if($message=~/\n$/);4930return$message;4931}49324933=head2 gethistorydense49344935This function takes a filename (with path) argument and returns an arrayofarrays4936containing revision,filehash,commithash ordered by revision descending.49374938This version of gethistory skips deleted entries -- so it is useful for annotate.4939The 'dense' part is a reference to a '--dense' option available for git-rev-list4940and other git tools that depend on it.49414942See also getlog().49434944=cut4945sub gethistorydense4946{4947my$self=shift;4948my$filename=shift;4949my$tablename=$self->tablename("revision");49504951my$db_query;4952$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);4953$db_query->execute($filename);49544955my$result=$db_query->fetchall_arrayref;49564957my$i;4958for($i=0;$i<scalar(@$result) ;$i++)4959{4960$result->[$i][0]="1.".$result->[$i][0];4961}49624963return$result;4964}49654966=head2 escapeRefName49674968Apply an escape mechanism to compensate for characters that4969git ref names can have that CVS tags can not.49704971=cut4972sub escapeRefName4973{4974my($self,$refName)=@_;49754976# CVS officially only allows [-_A-Za-z0-9] in tag names (or in4977# many contexts it can also be a CVS revision number).4978#4979# Git tags commonly use '/' and '.' as well, but also handle4980# anything else just in case:4981#4982# = "_-s-" For '/'.4983# = "_-p-" For '.'.4984# = "_-u-" For underscore, in case someone wants a literal "_-" in4985# a tag name.4986# = "_-xx-" Where "xx" is the hexadecimal representation of the4987# desired ASCII character byte. (for anything else)49884989if(!$refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)4990{4991$refName=~s/_-/_-u--/g;4992$refName=~s/\./_-p-/g;4993$refName=~s%/%_-s-%g;4994$refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;4995}4996}49974998=head2 unescapeRefName49995000Undo an escape mechanism to compensate for characters that5001git ref names can have that CVS tags can not.50025003=cut5004sub unescapeRefName5005{5006my($self,$refName)=@_;50075008# see escapeRefName() for description of escape mechanism.50095010$refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;50115012# allowed tag names5013# TODO: Perhaps use git check-ref-format, with an in-process cache of5014# validated names?5015if( !($refName=~m%^[^-][-a-zA-Z0-9_/.]*$%) ||5016($refName=~m%[/.]$%) ||5017($refName=~/\.lock$/) ||5018($refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) )# matching }5019{5020# Error:5021$log->warn("illegal refName:$refName");5022$refName=undef;5023}5024return$refName;5025}50265027sub unescapeRefNameChar5028{5029my($char)=@_;50305031if($chareq"s")5032{5033$char="/";5034}5035elsif($chareq"p")5036{5037$char=".";5038}5039elsif($chareq"u")5040{5041$char="_";5042}5043elsif($char=~/^[0-9a-f][0-9a-f]$/)5044{5045$char=chr(hex($char));5046}5047else5048{5049# Error case: Maybe it has come straight from user, and5050# wasn't supposed to be escaped? Restore it the way we got it:5051$char="_-$char-";5052}50535054return$char;5055}50565057=head2 in_array()50585059from Array::PAT - mimics the in_array() function5060found in PHP. Yuck but works for small arrays.50615062=cut5063sub in_array5064{5065my($check,@array) =@_;5066my$retval=0;5067foreachmy$test(@array){5068if($checkeq$test){5069$retval=1;5070}5071}5072return$retval;5073}50745075=head2 mangle_dirname50765077create a string from a directory name that is suitable to use as5078part of a filename, mainly by converting all chars except \w.- to _50795080=cut5081sub mangle_dirname {5082my$dirname=shift;5083return unlessdefined$dirname;50845085$dirname=~s/[^\w.-]/_/g;50865087return$dirname;5088}50895090=head2 mangle_tablename50915092create a string from a that is suitable to use as part of an SQL table5093name, mainly by converting all chars except \w to _50945095=cut5096sub mangle_tablename {5097my$tablename=shift;5098return unlessdefined$tablename;50995100$tablename=~s/[^\w_]/_/g;51015102return$tablename;5103}510451051;