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=`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(" ",keys%$methods)); 434$log->debug("SEND : ok"); 435 436print"Valid-requests ".join(" ",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} =`git hash-object$filename`; 845$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 846 847 #$log->debug("req_Modified : file=$datamode=$modesize=$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{ 856 my ($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\nfollowed by text to the current argument 869# being saved. 870sub req_Argument 871{ 872 my ($cmd,$data) =@_; 873 874 # Argumentx means: append to last Argument (with a newline in front) 875 876$log->debug("$cmd:$data"); 877 878 if ($cmdeq 'Argumentx') { 879 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 880 } else { 881 push @{$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{ 909 my ($cmd,$data) =@_; 910 911 argsplit(); 912 913$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 914 915 unless ( ref$state->{arguments} eq "ARRAY" ) 916 { 917 print "ok\n"; 918 return; 919 } 920 921 foreach my$module( @{$state->{arguments}} ) 922 { 923$log->debug("SEND : Module-expansion$module"); 924 print "Module-expansion$module\n"; 925 } 926 927 print "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{ 940 my ($cmd,$data) =@_; 941 942 argsplit("co"); 943 944 # Provide list of modules, if -c was used. 945 if (exists$state->{opt}{c}) { 946 my$showref= `git show-ref --heads`; 947 for my$line(split '\n',$showref) { 948 if ($line=~ m% refs/heads/(.*)$%) { 949 print "M$1\t$1\n"; 950 } 951 } 952 print "ok\n"; 953 return 1; 954 } 955 956 my$stickyInfo= { 'tag' =>$state->{opt}{r}, 957 'date' =>$state->{opt}{D} }; 958 959 my$module=$state->{args}[0]; 960$state->{module} =$module; 961 my$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 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=`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=`cat$mergedFile`;1467$log->debug("File size : " . length($data));1468 print length($data) . "\n";1469 print$data;1470 }1471 }14721473 }14741475 # prepDirForOutput() any other existing directories unless they already1476 # have the right sticky tag:1477 unless ($state->{globaloptions}{n} )1478 {1479 my$dir;1480 foreach$dir(keys(%{$state->{dirMap}}))1481 {1482 if( !$seendirs{$dir} &&1483 exists($state->{dirArgs}{$dir}) )1484 {1485 my($oldTag);1486$oldTag=$state->{dirMap}{$dir}{tagspec};14871488 unless( ( exists($state->{opt}{A}) &&1489 defined($oldTag) ) ||1490 ( defined($state->{opt}{r}) &&1491 ( !defined($oldTag) ||1492$state->{opt}{r} ne$oldTag) ) )1493 # TODO?: OR sticky dir is different...1494 {1495 next;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 }15111512 print "ok\n";1513}15141515sub req_ci1516{1517 my ($cmd,$data) =@_;15181519 argsplit("ci");15201521 #$log->debug("State : " . Dumper($state));15221523$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));15241525 if ($state->{method} eq 'pserver' and$state->{user} eq 'anonymous' )1526 {1527 print "error 1 anonymous user cannot commit via pserver\n";1528 cleanupWorkTree();1529 exit;1530 }15311532 if ( -e$state->{CVSROOT} . "/index" )1533 {1534$log->warn("file 'index' already exists in the git repository");1535 print "error 1 Index already exists in git repo\n";1536 cleanupWorkTree();1537 exit;1538 }15391540 # Grab a handle to the SQLite db and do any necessary updates1541 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1542$updater->update();15431544 my@committedfiles= ();1545 my%oldmeta;1546 my$stickyInfo;1547 my$branchRef;1548 my$parenthash;15491550 # foreach file specified on the command line ...1551 foreach my$filename( @{$state->{args}} )1552 {1553 my$committedfile=$filename;1554$filename= filecleanup($filename);15551556 next 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:1563 my$fileStickyInfo= resolveStickyInfo($filename);1564 if( !defined($branchRef) )1565 {1566$stickyInfo=$fileStickyInfo;1567 if( defined($stickyInfo) &&1568 ( defined($stickyInfo->{date}) ||1569 !defined($stickyInfo->{tag}) ) )1570 {1571 print "error 1 cannot commit with sticky date for file `$filename'\n";1572 cleanupWorkTree();1573 exit;1574 }15751576$branchRef= "refs/heads/$state->{module}";1577 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )1578 {1579$branchRef= "refs/heads/$stickyInfo->{tag}";1580 }15811582$parenthash= `git show-ref -s$branchRef`;1583 chomp$parenthash;1584 if ($parenthash!~ /^[0-9a-f]{40}$/)1585 {1586 if ( defined($stickyInfo) && defined($stickyInfo->{tag}) )1587 {1588 print "error 1 sticky tag `$stickyInfo->{tag}'for file `$filename' is not a branch\n";1589 }1590 else1591 {1592 print "error 1 pserver cannot find the current HEAD of module";1593 }1594 cleanupWorkTree();1595 exit;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 }1604 elsif( !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.1609 print "error 1 Committing different files to different"1610 . " branches is not currently supported\n";1611 cleanupWorkTree();1612 exit;1613 }16141615 #####1616 # Process this file:16171618 my$meta=$updater->getmeta($filename,$stickyInfo);1619$oldmeta{$filename} =$meta;16201621 my$wrev= revparse($filename);16221623 my ($filepart,$dirpart) = filenamesplit($filename);16241625 # do a checkout of the file if it is part of this tree1626 if ($wrev) {1627 system('git', 'checkout-index', '-f', '-u',$filename);1628 unless ($?== 0) {1629 die "Error running git-checkout-index -f -u$filename:$!";1630 }1631 }16321633 my$addflag= 0;1634 my$rmflag= 0;1635$rmflag= 1 if ( defined($wrev) and ($wrev=~/^-/) );1636$addflag= 1 unless ( -e$filename);16371638 # Do up to date checking1639 unless ($addflagor$wreveq$meta->{revision} or1640 ($rmflagand$wreveq "-$meta->{revision}" ) )1641 {1642 # fail everything if an up to date check fails1643 print "error 1 Up to date check failed for$filename\n";1644 cleanupWorkTree();1645 exit;1646 }16471648 push@committedfiles,$committedfile;1649$log->info("Committing$filename");16501651 system("mkdir","-p",$dirpart) unless ( -d$dirpart);16521653 unless ($rmflag)1654 {1655$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1656 rename$state->{entries}{$filename}{modified_filename},$filename;16571658 # Calculate modes to remove1659 my$invmode= "";1660 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }16611662$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1663 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1664 }16651666 if ($rmflag)1667 {1668$log->info("Removing file '$filename'");1669 unlink($filename);1670 system("git", "update-index", "--remove",$filename);1671 }1672 elsif ($addflag)1673 {1674$log->info("Adding file '$filename'");1675 system("git", "update-index", "--add",$filename);1676 } else {1677$log->info("UpdatingX2 file '$filename'");1678 system("git", "update-index",$filename);1679 }1680 }16811682 unless ( scalar(@committedfiles) > 0 )1683 {1684 print "E No files to commit\n";1685 print "ok\n";1686 cleanupWorkTree();1687 return;1688 }16891690 my$treehash= `git write-tree`;1691 chomp$treehash;16921693$log->debug("Treehash :$treehash, Parenthash :$parenthash");16941695 # write our commit message out if we have one ...1696 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1697 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1698 if ( defined ($cfg->{gitcvs}{commitmsgannotation} ) ) {1699 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/) {1700 print$msg_fh"\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"1701 }1702 } else {1703 print$msg_fh"\n\nvia git-CVS emulator\n";1704 }1705 close$msg_fh;17061707 my$commithash= `git commit-tree $treehash-p $parenthash<$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(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 sandobx?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 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=`git cat-file -t$filehash`;2858 chomp$type;28592860 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );28612862 my$size= `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 accomodate 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 is 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=`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=`git cat-file -t$name`;3291 chomp$type;32923293 unless ( defined ($type) and$typeeq "blob" )3294 {3295$log->warn("Invalid type '$type' for '$name'");3296 die ( "Invalid type '$type' (expected 'blob')" )3297 }32983299 my$size= `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}340834093410package GITCVS::log;34113412####3413#### Copyright The Open University UK - 2006.3414####3415#### Authors: Martyn Smith <martyn@catalyst.net.nz>3416#### Martin Langhoff <martin@laptop.org>3417####3418####34193420use strict;3421use warnings;34223423=head1 NAME34243425GITCVS::log34263427=head1 DESCRIPTION34283429This module provides very crude logging with a similar interface to3430Log::Log4perl34313432=head1 METHODS34333434=cut34353436=head2 new34373438Creates a new log object, optionally you can specify a filename here to3439indicate the file to log to. If no log file is specified, you can specify one3440later with method setfile, or indicate you no longer want logging with method3441nofile.34423443Until one of these methods is called, all log calls will buffer messages ready3444to write out.34453446=cut3447sub new3448{3449my$class=shift;3450my$filename=shift;34513452my$self= {};34533454bless$self,$class;34553456if(defined($filename) )3457{3458open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");3459}34603461return$self;3462}34633464=head2 setfile34653466This methods takes a filename, and attempts to open that file as the log file.3467If successful, all buffered data is written out to the file, and any further3468logging is written directly to the file.34693470=cut3471sub setfile3472{3473my$self=shift;3474my$filename=shift;34753476if(defined($filename) )3477{3478open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");3479}34803481return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");34823483while(my$line=shift@{$self->{buffer}} )3484{3485print{$self->{fh}}$line;3486}3487}34883489=head2 nofile34903491This method indicates no logging is going to be used. It flushes any entries in3492the internal buffer, and sets a flag to ensure no further data is put there.34933494=cut3495sub nofile3496{3497my$self=shift;34983499$self->{nolog} =1;35003501return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");35023503$self->{buffer} = [];3504}35053506=head2 _logopen35073508Internal method. Returns true if the log file is open, false otherwise.35093510=cut3511sub _logopen3512{3513my$self=shift;35143515return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");3516return0;3517}35183519=head2 debug info warn fatal35203521These four methods are wrappers to _log. They provide the actual interface for3522logging data.35233524=cut3525sub debug {my$self=shift;$self->_log("debug",@_); }3526sub info {my$self=shift;$self->_log("info",@_); }3527subwarn{my$self=shift;$self->_log("warn",@_); }3528sub fatal {my$self=shift;$self->_log("fatal",@_); }35293530=head2 _log35313532This is an internal method called by the logging functions. It generates a3533timestamp and pushes the logged line either to file, or internal buffer.35343535=cut3536sub _log3537{3538my$self=shift;3539my$level=shift;35403541return if($self->{nolog} );35423543my@time=localtime;3544my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",3545$time[5] +1900,3546$time[4] +1,3547$time[3],3548$time[2],3549$time[1],3550$time[0],3551uc$level,3552);35533554if($self->_logopen)3555{3556print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";3557}else{3558push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";3559}3560}35613562=head2 DESTROY35633564This method simply closes the file handle if one is open35653566=cut3567sub DESTROY3568{3569my$self=shift;35703571if($self->_logopen)3572{3573close$self->{fh};3574}3575}35763577package GITCVS::updater;35783579####3580#### Copyright The Open University UK - 2006.3581####3582#### Authors: Martyn Smith <martyn@catalyst.net.nz>3583#### Martin Langhoff <martin@laptop.org>3584####3585####35863587use strict;3588use warnings;3589use DBI;35903591=head1 METHODS35923593=cut35943595=head2 new35963597=cut3598sub new3599{3600my$class=shift;3601my$config=shift;3602my$module=shift;3603my$log=shift;36043605die"Need to specify a git repository"unless(defined($config)and-d $config);3606die"Need to specify a module"unless(defined($module) );36073608$class=ref($class) ||$class;36093610my$self= {};36113612bless$self,$class;36133614$self->{valid_tables} = {'revision'=>1,3615'revision_ix1'=>1,3616'revision_ix2'=>1,3617'head'=>1,3618'head_ix1'=>1,3619'properties'=>1,3620'commitmsgs'=>1};36213622$self->{module} =$module;3623$self->{git_path} =$config."/";36243625$self->{log} =$log;36263627die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );36283629# Stores full sha1's for various branch/tag names, abbreviations, etc:3630$self->{commitRefCache} = {};36313632$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||3633$cfg->{gitcvs}{dbdriver} ||"SQLite";3634$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||3635$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";3636$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||3637$cfg->{gitcvs}{dbuser} ||"";3638$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||3639$cfg->{gitcvs}{dbpass} ||"";3640$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||3641$cfg->{gitcvs}{dbtablenameprefix} ||"";3642my%mapping= ( m =>$module,3643 a =>$state->{method},3644 u =>getlogin||getpwuid($<) || $<,3645 G =>$self->{git_path},3646 g => mangle_dirname($self->{git_path}),3647);3648$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;3649$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;3650$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;3651$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});36523653die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;3654die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;3655$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",3656$self->{dbuser},3657$self->{dbpass});3658die"Error connecting to database\n"unlessdefined$self->{dbh};36593660$self->{tables} = {};3661foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )3662{3663$self->{tables}{$table} =1;3664}36653666# Construct the revision table if required3667# The revision table stores an entry for each file, each time that file3668# changes.3669# numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )3670# This is not sufficient to support "-r {commithash}" for any3671# files except files that were modified by that commit (also,3672# some places in the code ignore/effectively strip out -r in3673# some cases, before it gets passed to getmeta()).3674# The "filehash" field typically has a git blob hash, but can also3675# be set to "dead" to indicate that the given version of the file3676# should not exist in the sandbox.3677unless($self->{tables}{$self->tablename("revision")} )3678{3679my$tablename=$self->tablename("revision");3680my$ix1name=$self->tablename("revision_ix1");3681my$ix2name=$self->tablename("revision_ix2");3682$self->{dbh}->do("3683 CREATE TABLE$tablename(3684 name TEXT NOT NULL,3685 revision INTEGER NOT NULL,3686 filehash TEXT NOT NULL,3687 commithash TEXT NOT NULL,3688 author TEXT NOT NULL,3689 modified TEXT NOT NULL,3690 mode TEXT NOT NULL3691 )3692 ");3693$self->{dbh}->do("3694 CREATE INDEX$ix1name3695 ON$tablename(name,revision)3696 ");3697$self->{dbh}->do("3698 CREATE INDEX$ix2name3699 ON$tablename(name,commithash)3700 ");3701}37023703# Construct the head table if required3704# The head table (along with the "last_commit" entry in the property3705# table) is the persisted working state of the "sub update" subroutine.3706# All of it's data is read entirely first, and completely recreated3707# last, every time "sub update" runs.3708# This is also used by "sub getmeta" when it is asked for the latest3709# version of a file (as opposed to some specific version).3710# Another way of thinking about it is as a single slice out of3711# "revisions", giving just the most recent revision information for3712# each file.3713unless($self->{tables}{$self->tablename("head")} )3714{3715my$tablename=$self->tablename("head");3716my$ix1name=$self->tablename("head_ix1");3717$self->{dbh}->do("3718 CREATE TABLE$tablename(3719 name TEXT NOT NULL,3720 revision INTEGER NOT NULL,3721 filehash TEXT NOT NULL,3722 commithash TEXT NOT NULL,3723 author TEXT NOT NULL,3724 modified TEXT NOT NULL,3725 mode TEXT NOT NULL3726 )3727 ");3728$self->{dbh}->do("3729 CREATE INDEX$ix1name3730 ON$tablename(name)3731 ");3732}37333734# Construct the properties table if required3735# - "last_commit" - Used by "sub update".3736unless($self->{tables}{$self->tablename("properties")} )3737{3738my$tablename=$self->tablename("properties");3739$self->{dbh}->do("3740 CREATE TABLE$tablename(3741 key TEXT NOT NULL PRIMARY KEY,3742 value TEXT3743 )3744 ");3745}37463747# Construct the commitmsgs table if required3748# The commitmsgs table is only used for merge commits, since3749# "sub update" will only keep one branch of parents. Shortlogs3750# for ignored commits (i.e. not on the chosen branch) will be used3751# to construct a replacement "collapsed" merge commit message,3752# which will be stored in this table. See also "sub commitmessage".3753unless($self->{tables}{$self->tablename("commitmsgs")} )3754{3755my$tablename=$self->tablename("commitmsgs");3756$self->{dbh}->do("3757 CREATE TABLE$tablename(3758 key TEXT NOT NULL PRIMARY KEY,3759 value TEXT3760 )3761 ");3762}37633764return$self;3765}37663767=head2 tablename37683769=cut3770sub tablename3771{3772my$self=shift;3773my$name=shift;37743775if(exists$self->{valid_tables}{$name}) {3776return$self->{dbtablenameprefix} .$name;3777}else{3778returnundef;3779}3780}37813782=head2 update37833784Bring the database up to date with the latest changes from3785the git repository.37863787Internal working state is read out of the "head" table and the3788"last_commit" property, then it updates "revisions" based on that, and3789finally it writes the new internal state back to the "head" table3790so it can be used as a starting point the next time update is called.37913792=cut3793sub update3794{3795my$self=shift;37963797# first lets get the commit list3798$ENV{GIT_DIR} =$self->{git_path};37993800my$commitsha1=`git rev-parse$self->{module}`;3801chomp$commitsha1;38023803my$commitinfo=`git cat-file commit$self->{module} 2>&1`;3804unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)3805{3806die("Invalid module '$self->{module}'");3807}380838093810my$git_log;3811my$lastcommit=$self->_get_prop("last_commit");38123813if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date3814# invalidate the gethead cache3815$self->clearCommitRefCaches();3816return1;3817}38183819# Start exclusive lock here...3820$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";38213822# TODO: log processing is memory bound3823# if we can parse into a 2nd file that is in reverse order3824# we can probably do something really efficient3825my@git_log_params= ('--pretty','--parents','--topo-order');38263827if(defined$lastcommit) {3828push@git_log_params,"$lastcommit..$self->{module}";3829}else{3830push@git_log_params,$self->{module};3831}3832# git-rev-list is the backend / plumbing version of git-log3833open(my$gitLogPipe,'-|','git','rev-list',@git_log_params)3834or die"Cannot call git-rev-list:$!";3835my@commits=readCommits($gitLogPipe);3836close$gitLogPipe;38373838# Now all the commits are in the @commits bucket3839# ordered by time DESC. for each commit that needs processing,3840# determine whether it's following the last head we've seen or if3841# it's on its own branch, grab a file list, and add whatever's changed3842# NOTE: $lastcommit refers to the last commit from previous run3843# $lastpicked is the last commit we picked in this run3844my$lastpicked;3845my$head= {};3846if(defined$lastcommit) {3847$lastpicked=$lastcommit;3848}38493850my$committotal=scalar(@commits);3851my$commitcount=0;38523853# Load the head table into $head (for cached lookups during the update process)3854foreachmy$file( @{$self->gethead(1)} )3855{3856$head->{$file->{name}} =$file;3857}38583859foreachmy$commit(@commits)3860{3861$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3862if(defined$lastpicked)3863{3864if(!in_array($lastpicked, @{$commit->{parents}}))3865{3866# skip, we'll see this delta3867# as part of a merge later3868# warn "skipping off-track $commit->{hash}\n";3869next;3870}elsif(@{$commit->{parents}} >1) {3871# it is a merge commit, for each parent that is3872# not $lastpicked (not given a CVS revision number),3873# see if we can get a log3874# from the merge-base to that parent to put it3875# in the message as a merge summary.3876my@parents= @{$commit->{parents}};3877foreachmy$parent(@parents) {3878if($parenteq$lastpicked) {3879next;3880}3881# git-merge-base can potentially (but rarely) throw3882# several candidate merge bases. let's assume3883# that the first one is the best one.3884my$base=eval{3885 safe_pipe_capture('git','merge-base',3886$lastpicked,$parent);3887};3888# The two branches may not be related at all,3889# in which case merge base simply fails to find3890# any, but that's Ok.3891next if($@);38923893chomp$base;3894if($base) {3895my@merged;3896# print "want to log between $base $parent \n";3897open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3898or die"Cannot call git-log:$!";3899my$mergedhash;3900while(<GITLOG>) {3901chomp;3902if(!defined$mergedhash) {3903if(m/^commit\s+(.+)$/) {3904$mergedhash=$1;3905}else{3906next;3907}3908}else{3909# grab the first line that looks non-rfc8223910# aka has content after leading space3911if(m/^\s+(\S.*)$/) {3912my$title=$1;3913$title=substr($title,0,100);# truncate3914unshift@merged,"$mergedhash$title";3915undef$mergedhash;3916}3917}3918}3919close GITLOG;3920if(@merged) {3921$commit->{mergemsg} =$commit->{message};3922$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3923foreachmy$summary(@merged) {3924$commit->{mergemsg} .="\t$summary\n";3925}3926$commit->{mergemsg} .="\n\n";3927# print "Message for $commit->{hash} \n$commit->{mergemsg}";3928}3929}3930}3931}3932}39333934# convert the date to CVS-happy format3935my$cvsDate= convertToCvsDate($commit->{date});39363937if(defined($lastpicked) )3938{3939my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3940local($/) ="\0";3941while( <FILELIST> )3942{3943chomp;3944unless(/^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/o)3945{3946die("Couldn't process git-diff-tree line :$_");3947}3948my($mode,$hash,$change) = ($1,$2,$3);3949my$name= <FILELIST>;3950chomp($name);39513952# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");39533954my$dbMode= convertToDbMode($mode);39553956if($changeeq"D")3957{3958#$log->debug("DELETE $name");3959$head->{$name} = {3960 name =>$name,3961 revision =>$head->{$name}{revision} +1,3962 filehash =>"deleted",3963 commithash =>$commit->{hash},3964 modified =>$cvsDate,3965 author =>$commit->{author},3966 mode =>$dbMode,3967};3968$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3969}3970elsif($changeeq"M"||$changeeq"T")3971{3972#$log->debug("MODIFIED $name");3973$head->{$name} = {3974 name =>$name,3975 revision =>$head->{$name}{revision} +1,3976 filehash =>$hash,3977 commithash =>$commit->{hash},3978 modified =>$cvsDate,3979 author =>$commit->{author},3980 mode =>$dbMode,3981};3982$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3983}3984elsif($changeeq"A")3985{3986#$log->debug("ADDED $name");3987$head->{$name} = {3988 name =>$name,3989 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3990 filehash =>$hash,3991 commithash =>$commit->{hash},3992 modified =>$cvsDate,3993 author =>$commit->{author},3994 mode =>$dbMode,3995};3996$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3997}3998else3999{4000$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");4001die;4002}4003}4004close FILELIST;4005}else{4006# this is used to detect files removed from the repo4007my$seen_files= {};40084009my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");4010local$/="\0";4011while( <FILELIST> )4012{4013chomp;4014unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4015{4016die("Couldn't process git-ls-tree line :$_");4017}40184019my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);40204021$seen_files->{$git_filename} =1;40224023my($oldhash,$oldrevision,$oldmode) = (4024$head->{$git_filename}{filehash},4025$head->{$git_filename}{revision},4026$head->{$git_filename}{mode}4027);40284029my$dbMode= convertToDbMode($mode);40304031# unless the file exists with the same hash, we need to update it ...4032unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$dbMode)4033{4034my$newrevision= ($oldrevisionor0) +1;40354036$head->{$git_filename} = {4037 name =>$git_filename,4038 revision =>$newrevision,4039 filehash =>$git_hash,4040 commithash =>$commit->{hash},4041 modified =>$cvsDate,4042 author =>$commit->{author},4043 mode =>$dbMode,4044};404540464047$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);4048}4049}4050close FILELIST;40514052# Detect deleted files4053foreachmy$file(keys%$head)4054{4055unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")4056{4057$head->{$file}{revision}++;4058$head->{$file}{filehash} ="deleted";4059$head->{$file}{commithash} =$commit->{hash};4060$head->{$file}{modified} =$cvsDate;4061$head->{$file}{author} =$commit->{author};40624063$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$cvsDate,$commit->{author},$head->{$file}{mode});4064}4065}4066# END : "Detect deleted files"4067}406840694070if(exists$commit->{mergemsg})4071{4072$self->insert_mergelog($commit->{hash},$commit->{mergemsg});4073}40744075$lastpicked=$commit->{hash};40764077$self->_set_prop("last_commit",$commit->{hash});4078}40794080$self->delete_head();4081foreachmy$file(keys%$head)4082{4083$self->insert_head(4084$file,4085$head->{$file}{revision},4086$head->{$file}{filehash},4087$head->{$file}{commithash},4088$head->{$file}{modified},4089$head->{$file}{author},4090$head->{$file}{mode},4091);4092}4093# invalidate the gethead cache4094$self->clearCommitRefCaches();409540964097# Ending exclusive lock here4098$self->{dbh}->commit()or die"Failed to commit changes to SQLite";4099}41004101sub readCommits4102{4103my$pipeHandle=shift;4104my@commits;41054106my%commit= ();41074108while( <$pipeHandle> )4109{4110chomp;4111if(m/^commit\s+(.*)$/) {4112# on ^commit lines put the just seen commit in the stack4113# and prime things for the next one4114if(keys%commit) {4115my%copy=%commit;4116unshift@commits, \%copy;4117%commit= ();4118}4119my@parents=split(m/\s+/,$1);4120$commit{hash} =shift@parents;4121$commit{parents} = \@parents;4122}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {4123# on rfc822-like lines seen before we see any message,4124# lowercase the entry and put it in the hash as key-value4125$commit{lc($1)} =$2;4126}else{4127# message lines - skip initial empty line4128# and trim whitespace4129if(!exists($commit{message}) &&m/^\s*$/) {4130# define it to mark the end of headers4131$commit{message} ='';4132next;4133}4134s/^\s+//;s/\s+$//;# trim ws4135$commit{message} .=$_."\n";4136}4137}41384139unshift@commits, \%commitif(keys%commit);41404141return@commits;4142}41434144sub convertToCvsDate4145{4146my$date=shift;4147# Convert from: "git rev-list --pretty" formatted date4148# Convert to: "the format specified by RFC822 as modified by RFC1123."4149# Example: 26 May 1997 13:01:40 -04004150if($date=~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/)4151{4152$date="$2$1$4$3$5";4153}41544155return$date;4156}41574158sub convertToDbMode4159{4160my$mode=shift;41614162# NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",4163# but the database "mode" column historically (and currently)4164# only stores the "rw" (for user) part of the string.4165# FUTURE: It might make more sense to persist the raw4166# octal mode (or perhaps the final full CVS form) instead of4167# this half-converted form, but it isn't currently worth the4168# backwards compatibility headaches.41694170$mode=~/^\d\d(\d)\d{3}$/;4171my$userBits=$1;41724173my$dbMode="";4174$dbMode.="r"if($userBits&4);4175$dbMode.="w"if($userBits&2);4176$dbMode.="x"if($userBits&1);4177$dbMode="rw"if($dbModeeq"");41784179return$dbMode;4180}41814182sub insert_rev4183{4184my$self=shift;4185my$name=shift;4186my$revision=shift;4187my$filehash=shift;4188my$commithash=shift;4189my$modified=shift;4190my$author=shift;4191my$mode=shift;4192my$tablename=$self->tablename("revision");41934194my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);4195$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);4196}41974198sub insert_mergelog4199{4200my$self=shift;4201my$key=shift;4202my$value=shift;4203my$tablename=$self->tablename("commitmsgs");42044205my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);4206$insert_mergelog->execute($key,$value);4207}42084209sub delete_head4210{4211my$self=shift;4212my$tablename=$self->tablename("head");42134214my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);4215$delete_head->execute();4216}42174218sub insert_head4219{4220my$self=shift;4221my$name=shift;4222my$revision=shift;4223my$filehash=shift;4224my$commithash=shift;4225my$modified=shift;4226my$author=shift;4227my$mode=shift;4228my$tablename=$self->tablename("head");42294230my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);4231$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);4232}42334234sub _get_prop4235{4236my$self=shift;4237my$key=shift;4238my$tablename=$self->tablename("properties");42394240my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);4241$db_query->execute($key);4242my($value) =$db_query->fetchrow_array;42434244return$value;4245}42464247sub _set_prop4248{4249my$self=shift;4250my$key=shift;4251my$value=shift;4252my$tablename=$self->tablename("properties");42534254my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);4255$db_query->execute($value,$key);42564257unless($db_query->rows)4258{4259$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);4260$db_query->execute($key,$value);4261}42624263return$value;4264}42654266=head2 gethead42674268=cut42694270sub gethead4271{4272my$self=shift;4273my$intRev=shift;4274my$tablename=$self->tablename("head");42754276return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );42774278my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);4279$db_query->execute();42804281my$tree= [];4282while(my$file=$db_query->fetchrow_hashref)4283{4284if(!$intRev)4285{4286$file->{revision} ="1.$file->{revision}"4287}4288push@$tree,$file;4289}42904291$self->{gethead_cache} =$tree;42924293return$tree;4294}42954296=head2 getAnyHead42974298Returns a reference to an array of getmeta structures, one4299per file in the specified tree hash.43004301=cut43024303sub getAnyHead4304{4305my($self,$hash) =@_;43064307if(!defined($hash))4308{4309return$self->gethead();4310}43114312my@files;4313{4314open(my$filePipe,'-|','git','ls-tree','-z','-r',$hash)4315or die("Cannot call git-ls-tree :$!");4316local$/="\0";4317@files=<$filePipe>;4318close$filePipe;4319}43204321my$tree=[];4322my($line);4323foreach$line(@files)4324{4325$line=~s/\0$//;4326unless($line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4327{4328die("Couldn't process git-ls-tree line :$_");4329}43304331my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);4332push@$tree,$self->getMetaFromCommithash($git_filename,$hash);4333}43344335return$tree;4336}43374338=head2 getRevisionDirMap43394340A "revision dir map" contains all the plain-file filenames associated4341with a particular revision (treeish), organized by directory:43424343 $type = $out->{$dir}{$fullName}43444345The type of each is "F" (for ordinary file) or "D" (for directory,4346for which the map $out->{$fullName} will also exist).43474348=cut43494350sub getRevisionDirMap4351{4352my($self,$ver)=@_;43534354if(!defined($self->{revisionDirMapCache}))4355{4356$self->{revisionDirMapCache}={};4357}43584359# Get file list (previously cached results are dependent on HEAD,4360# but are early in each case):4361my$cacheKey;4362my(@fileList);4363if( !defined($ver) ||$vereq"")4364{4365$cacheKey="";4366if(defined($self->{revisionDirMapCache}{$cacheKey}) )4367{4368return$self->{revisionDirMapCache}{$cacheKey};4369}43704371my@head= @{$self->gethead()};4372foreachmy$file(@head)4373{4374next if($file->{filehash}eq"deleted");43754376push@fileList,$file->{name};4377}4378}4379else4380{4381my($hash)=$self->lookupCommitRef($ver);4382if( !defined($hash) )4383{4384returnundef;4385}43864387$cacheKey=$hash;4388if(defined($self->{revisionDirMapCache}{$cacheKey}) )4389{4390return$self->{revisionDirMapCache}{$cacheKey};4391}43924393open(my$filePipe,'-|','git','ls-tree','-z','-r',$hash)4394or die("Cannot call git-ls-tree :$!");4395local$/="\0";4396while( <$filePipe> )4397{4398chomp;4399unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4400{4401die("Couldn't process git-ls-tree line :$_");4402}44034404my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);44054406push@fileList,$git_filename;4407}4408close$filePipe;4409}44104411# Convert to normalized form:4412my%revMap;4413my$file;4414foreach$file(@fileList)4415{4416my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);4417$dir=''if(!defined($dir));44184419# parent directories:4420# ... create empty dir maps for parent dirs:4421my($td)=$dir;4422while(!defined($revMap{$td}))4423{4424$revMap{$td}={};44254426my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);4427$tp=''if(!defined($tp));4428$td=$tp;4429}4430# ... add children to parent maps (now that they exist):4431$td=$dir;4432while($tdne"")4433{4434my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);4435$tp=''if(!defined($tp));44364437if(defined($revMap{$tp}{$td}))4438{4439if($revMap{$tp}{$td}ne'D')4440{4441die"Weird file/directory inconsistency in$cacheKey";4442}4443last;# loop exit4444}4445$revMap{$tp}{$td}='D';44464447$td=$tp;4448}44494450# file4451$revMap{$dir}{$file}='F';4452}44534454# Save in cache:4455$self->{revisionDirMapCache}{$cacheKey}=\%revMap;4456return$self->{revisionDirMapCache}{$cacheKey};4457}44584459=head2 getlog44604461See also gethistorydense().44624463=cut44644465sub getlog4466{4467my$self=shift;4468my$filename=shift;4469my$revFilter=shift;44704471my$tablename=$self->tablename("revision");44724473# Filters:4474# TODO: date, state, or by specific logins filters?4475# TODO: Handle comma-separated list of revFilter items, each item4476# can be a range [only case currently handled] or individual4477# rev or branch or "branch.".4478# TODO: Adjust $db_query WHERE clause based on revFilter, instead of4479# manually filtering the results of the query?4480my($minrev,$maxrev);4481if(defined($revFilter)and4482$state->{opt}{r} =~/^(1.(\d+))?(::?)(1.(\d.+))?$/)4483{4484my$control=$3;4485$minrev=$2;4486$maxrev=$5;4487$minrev++if(defined($minrev)and$controleq"::");4488}44894490my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);4491$db_query->execute($filename);44924493my$totalRevs=0;4494my$tree= [];4495while(my$file=$db_query->fetchrow_hashref)4496{4497$totalRevs++;4498if(defined($minrev)and$file->{revision} <$minrev)4499{4500next;4501}4502if(defined($maxrev)and$file->{revision} >$maxrev)4503{4504next;4505}45064507$file->{revision} ="1.".$file->{revision};4508push@$tree,$file;4509}45104511return($tree,$totalRevs);4512}45134514=head2 getmeta45154516This function takes a filename (with path) argument and returns a hashref of4517metadata for that file.45184519There are several ways $revision can be specified:45204521 - A reference to hash that contains a "tag" that is the4522 actual revision (one of the below). TODO: Also allow it to4523 specify a "date" in the hash.4524 - undef, to refer to the latest version on the main branch.4525 - Full CVS client revision number (mapped to integer in DB, without the4526 "1." prefix),4527 - Complex CVS-compatible "special" revision number for4528 non-linear history (see comment below)4529 - git commit sha1 hash4530 - branch or tag name45314532=cut45334534sub getmeta4535{4536my$self=shift;4537my$filename=shift;4538my$revision=shift;4539my$tablename_rev=$self->tablename("revision");4540my$tablename_head=$self->tablename("head");45414542if(ref($revision)eq"HASH")4543{4544$revision=$revision->{tag};4545}45464547# Overview of CVS revision numbers:4548#4549# General CVS numbering scheme:4550# - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.4551# - Result of "cvs checkin -r" (possible, but not really4552# recommended): "2.1", "2.2", etc4553# - Branch tag: "1.2.0.n", where "1.2" is revision it was branched4554# from, "0" is a magic placeholder that identifies it as a4555# branch tag instead of a version tag, and n is 2 times the4556# branch number off of "1.2", starting with "2".4557# - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"4558# is branch number off of "1.2" (like n above), and "x" is4559# the version number on the branch.4560# - Branches can branch off of branches: "1.3.2.7.4.1" (even number4561# of components).4562# - Odd "n"s are used by "vendor branches" that result4563# from "cvs import". Vendor branches have additional4564# strangeness in the sense that the main rcs "head" of the main4565# branch will (temporarily until first normal commit) point4566# to the version on the vendor branch, rather than the actual4567# main branch. (FUTURE: This may provide an opportunity4568# to use "strange" revision numbers for fast-forward-merged4569# branch tip when CVS client is asking for the main branch.)4570#4571# git-cvsserver CVS-compatible special numbering schemes:4572# - Currently git-cvsserver only tries to be identical to CVS for4573# simple "1.x" numbers on the "main" branch (as identified4574# by the module name that was originally cvs checkout'ed).4575# - The database only stores the "x" part, for historical reasons.4576# But most of the rest of the cvsserver preserves4577# and thinks using the full revision number.4578# - To handle non-linear history, it uses a version of the form4579# "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely4580# identify this as a special revision number, and there are4581# 20 b's that together encode the sha1 git commit from which4582# this version of this file originated. Each b is4583# the numerical value of the corresponding byte plus4584# 100.4585# - "plus 100" avoids "0"s, and also reduces the4586# likelyhood of a collision in the case that someone someday4587# writes an import tool that tries to preserve original4588# CVS revision numbers, and the original CVS data had done4589# lots of branches off of branches and other strangeness to4590# end up with a real version number that just happens to look4591# like this special revision number form. Also, if needed4592# there are several ways to extend/identify alternative encodings4593# within the "2.1.1.2000" part if necessary.4594# - Unlike real CVS revisions, you can't really reconstruct what4595# relation a revision of this form has to other revisions.4596# - FUTURE: TODO: Rework database somehow to make up and remember4597# fully-CVS-compatible branches and branch version numbers.45984599my$meta;4600if(defined($revision) )4601{4602if($revision=~/^1\.(\d+)$/)4603{4604my($intRev) =$1;4605my$db_query;4606$db_query=$self->{dbh}->prepare_cached(4607"SELECT * FROM$tablename_revWHERE name=? AND revision=?",4608{},1);4609$db_query->execute($filename,$intRev);4610$meta=$db_query->fetchrow_hashref;4611}4612elsif($revision=~/^2\.1\.1\.2000(\.[1-3][0-9][0-9]){20}$/)4613{4614my($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);4615$commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;4616if($commitHash=~/^[0-9a-f]{40}$/)4617{4618return$self->getMetaFromCommithash($filename,$commitHash);4619}46204621# error recovery: fall back on head version below4622print"E Failed to find$filenameversion=$revisionor commit=$commitHash\n";4623$log->warning("failed get$revisionwith commithash=$commitHash");4624undef$revision;4625}4626elsif($revision=~/^[0-9a-f]{40}$/)4627{4628# Try DB first. This is mostly only useful for req_annotate(),4629# which only calls this for stuff that should already be in4630# the DB. It is fairly likely to be a waste of time4631# in most other cases [unless the file happened to be4632# modified in $revision specifically], but4633# it is probably in the noise compared to how long4634# getMetaFromCommithash() will take.4635my$db_query;4636$db_query=$self->{dbh}->prepare_cached(4637"SELECT * FROM$tablename_revWHERE name=? AND commithash=?",4638{},1);4639$db_query->execute($filename,$revision);4640$meta=$db_query->fetchrow_hashref;46414642if(!$meta)4643{4644my($revCommit)=$self->lookupCommitRef($revision);4645if($revCommit=~/^[0-9a-f]{40}$/)4646{4647return$self->getMetaFromCommithash($filename,$revCommit);4648}46494650# error recovery: nothing found:4651print"E Failed to find$filenameversion=$revision\n";4652$log->warning("failed get$revision");4653return$meta;4654}4655}4656else4657{4658my($revCommit)=$self->lookupCommitRef($revision);4659if($revCommit=~/^[0-9a-f]{40}$/)4660{4661return$self->getMetaFromCommithash($filename,$revCommit);4662}46634664# error recovery: fall back on head version below4665print"E Failed to find$filenameversion=$revision\n";4666$log->warning("failed get$revision");4667undef$revision;# Allow fallback4668}4669}46704671if(!defined($revision))4672{4673my$db_query;4674$db_query=$self->{dbh}->prepare_cached(4675"SELECT * FROM$tablename_headWHERE name=?",{},1);4676$db_query->execute($filename);4677$meta=$db_query->fetchrow_hashref;4678}46794680if($meta)4681{4682$meta->{revision} ="1.$meta->{revision}";4683}4684return$meta;4685}46864687sub getMetaFromCommithash4688{4689my$self=shift;4690my$filename=shift;4691my$revCommit=shift;46924693# NOTE: This function doesn't scale well (lots of forks), especially4694# if you have many files that have not been modified for many commits4695# (each git-rev-parse redoes a lot of work for each file4696# that theoretically could be done in parallel by smarter4697# graph traversal).4698#4699# TODO: Possible optimization strategies:4700# - Solve the issue of assigning and remembering "real" CVS4701# revision numbers for branches, and ensure the4702# data structure can do this efficiently. Perhaps something4703# similar to "git notes", and carefully structured to take4704# advantage same-sha1-is-same-contents, to roll the same4705# unmodified subdirectory data onto multiple commits?4706# - Write and use a C tool that is like git-blame, but4707# operates on multiple files with file granularity, instead4708# of one file with line granularity. Cache4709# most-recently-modified in $self->{commitRefCache}{$revCommit}.4710# Try to be intelligent about how many files we do with4711# one fork (perhaps one directory at a time, without recursion,4712# and/or include directory as one line item, recurse from here4713# instead of in C tool?).4714# - Perhaps we could ask the DB for (filename,fileHash),4715# and just guess that it is correct (that the file hadn't4716# changed between $revCommit and the found commit, then4717# changed back, confusing anything trying to interpret4718# history). Probably need to add another index to revisions4719# DB table for this.4720# - NOTE: Trying to store all (commit,file) keys in DB [to4721# find "lastModfiedCommit] (instead of4722# just files that changed in each commit as we do now) is4723# probably not practical from a disk space perspective.47244725# Does the file exist in $revCommit?4726# TODO: Include file hash in dirmap cache.4727my($dirMap)=$self->getRevisionDirMap($revCommit);4728my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);4729if(!defined($dir))4730{4731$dir="";4732}4733if( !defined($dirMap->{$dir}) ||4734!defined($dirMap->{$dir}{$filename}) )4735{4736my($fileHash)="deleted";47374738my($retVal)={};4739$retVal->{name}=$filename;4740$retVal->{filehash}=$fileHash;47414742# not needed and difficult to compute:4743$retVal->{revision}="0";# $revision;4744$retVal->{commithash}=$revCommit;4745#$retVal->{author}=$commit->{author};4746#$retVal->{modified}=convertToCvsDate($commit->{date});4747#$retVal->{mode}=convertToDbMode($mode);47484749return$retVal;4750}47514752my($fileHash)=safe_pipe_capture("git","rev-parse","$revCommit:$filename");4753chomp$fileHash;4754if(!($fileHash=~/^[0-9a-f]{40}$/))4755{4756die"Invalid fileHash '$fileHash' looking up"4757." '$revCommit:$filename'\n";4758}47594760# information about most recent commit to modify $filename:4761open(my$gitLogPipe,'-|','git','rev-list',4762'--max-count=1','--pretty','--parents',4763$revCommit,'--',$filename)4764or die"Cannot call git-rev-list:$!";4765my@commits=readCommits($gitLogPipe);4766close$gitLogPipe;4767if(scalar(@commits)!=1)4768{4769die"Can't find most recent commit changing$filename\n";4770}4771my($commit)=$commits[0];4772if( !defined($commit) || !defined($commit->{hash}) )4773{4774returnundef;4775}47764777# does this (commit,file) have a real assigned CVS revision number?4778my$tablename_rev=$self->tablename("revision");4779my$db_query;4780$db_query=$self->{dbh}->prepare_cached(4781"SELECT * FROM$tablename_revWHERE name=? AND commithash=?",4782{},1);4783$db_query->execute($filename,$commit->{hash});4784my($meta)=$db_query->fetchrow_hashref;4785if($meta)4786{4787$meta->{revision} ="1.$meta->{revision}";4788return$meta;4789}47904791# fall back on special revision number4792my($revision)=$commit->{hash};4793$revision=~s/(..)/'.' . (hex($1)+100)/eg;4794$revision="2.1.1.2000$revision";47954796# meta data about $filename:4797open(my$filePipe,'-|','git','ls-tree','-z',4798$commit->{hash},'--',$filename)4799or die("Cannot call git-ls-tree :$!");4800local$/="\0";4801my$line;4802$line=<$filePipe>;4803if(defined(<$filePipe>))4804{4805die"Expected only a single file for git-ls-tree$filename\n";4806}4807close$filePipe;48084809chomp$line;4810unless($line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4811{4812die("Couldn't process git-ls-tree line :$line\n");4813}4814my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);48154816# save result:4817my($retVal)={};4818$retVal->{name}=$filename;4819$retVal->{revision}=$revision;4820$retVal->{filehash}=$fileHash;4821$retVal->{commithash}=$revCommit;4822$retVal->{author}=$commit->{author};4823$retVal->{modified}=convertToCvsDate($commit->{date});4824$retVal->{mode}=convertToDbMode($mode);48254826return$retVal;4827}48284829=head2 lookupCommitRef48304831Convert tag/branch/abbreviation/etc into a commit sha1 hash. Caches4832the result so looking it up again is fast.48334834=cut48354836sub lookupCommitRef4837{4838my$self=shift;4839my$ref=shift;48404841my$commitHash=$self->{commitRefCache}{$ref};4842if(defined($commitHash))4843{4844return$commitHash;4845}48464847$commitHash=safe_pipe_capture("git","rev-parse","--verify","--quiet",4848$self->unescapeRefName($ref));4849$commitHash=~s/\s*$//;4850if(!($commitHash=~/^[0-9a-f]{40}$/))4851{4852$commitHash=undef;4853}48544855if(defined($commitHash) )4856{4857my$type=safe_pipe_capture("git","cat-file","-t",$commitHash);4858if( ! ($type=~/^commit\s*$/) )4859{4860$commitHash=undef;4861}4862}4863if(defined($commitHash))4864{4865$self->{commitRefCache}{$ref}=$commitHash;4866}4867return$commitHash;4868}48694870=head2 clearCommitRefCaches48714872Clears cached commit cache (sha1's for various tags/abbeviations/etc),4873and related caches.48744875=cut48764877sub clearCommitRefCaches4878{4879my$self=shift;4880$self->{commitRefCache} = {};4881$self->{revisionDirMapCache} =undef;4882$self->{gethead_cache} =undef;4883}48844885=head2 commitmessage48864887this function takes a commithash and returns the commit message for that commit48884889=cut4890sub commitmessage4891{4892my$self=shift;4893my$commithash=shift;4894my$tablename=$self->tablename("commitmsgs");48954896die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);48974898my$db_query;4899$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);4900$db_query->execute($commithash);49014902my($message) =$db_query->fetchrow_array;49034904if(defined($message) )4905{4906$message.=" "if($message=~/\n$/);4907return$message;4908}49094910my@lines= safe_pipe_capture("git","cat-file","commit",$commithash);4911shift@lineswhile($lines[0] =~/\S/);4912$message=join("",@lines);4913$message.=" "if($message=~/\n$/);4914return$message;4915}49164917=head2 gethistorydense49184919This function takes a filename (with path) argument and returns an arrayofarrays4920containing revision,filehash,commithash ordered by revision descending.49214922This version of gethistory skips deleted entries -- so it is useful for annotate.4923The 'dense' part is a reference to a '--dense' option available for git-rev-list4924and other git tools that depend on it.49254926See also getlog().49274928=cut4929sub gethistorydense4930{4931my$self=shift;4932my$filename=shift;4933my$tablename=$self->tablename("revision");49344935my$db_query;4936$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);4937$db_query->execute($filename);49384939my$result=$db_query->fetchall_arrayref;49404941my$i;4942for($i=0;$i<scalar(@$result) ;$i++)4943{4944$result->[$i][0]="1.".$result->[$i][0];4945}49464947return$result;4948}49494950=head2 escapeRefName49514952Apply an escape mechanism to compensate for characters that4953git ref names can have that CVS tags can not.49544955=cut4956sub escapeRefName4957{4958my($self,$refName)=@_;49594960# CVS officially only allows [-_A-Za-z0-9] in tag names (or in4961# many contexts it can also be a CVS revision number).4962#4963# Git tags commonly use '/' and '.' as well, but also handle4964# anything else just in case:4965#4966# = "_-s-" For '/'.4967# = "_-p-" For '.'.4968# = "_-u-" For underscore, in case someone wants a literal "_-" in4969# a tag name.4970# = "_-xx-" Where "xx" is the hexadecimal representation of the4971# desired ASCII character byte. (for anything else)49724973if(!$refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)4974{4975$refName=~s/_-/_-u--/g;4976$refName=~s/\./_-p-/g;4977$refName=~s%/%_-s-%g;4978$refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;4979}4980}49814982=head2 unescapeRefName49834984Undo an escape mechanism to compensate for characters that4985git ref names can have that CVS tags can not.49864987=cut4988sub unescapeRefName4989{4990my($self,$refName)=@_;49914992# see escapeRefName() for description of escape mechanism.49934994$refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;49954996# allowed tag names4997# TODO: Perhaps use git check-ref-format, with an in-process cache of4998# validated names?4999if( !($refName=~m%^[^-][-a-zA-Z0-9_/.]*$%) ||5000($refName=~m%[/.]$%) ||5001($refName=~/\.lock$/) ||5002($refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) )# matching }5003{5004# Error:5005$log->warn("illegal refName:$refName");5006$refName=undef;5007}5008return$refName;5009}50105011sub unescapeRefNameChar5012{5013my($char)=@_;50145015if($chareq"s")5016{5017$char="/";5018}5019elsif($chareq"p")5020{5021$char=".";5022}5023elsif($chareq"u")5024{5025$char="_";5026}5027elsif($char=~/^[0-9a-f][0-9a-f]$/)5028{5029$char=chr(hex($char));5030}5031else5032{5033# Error case: Maybe it has come straight from user, and5034# wasn't supposed to be escaped? Restore it the way we got it:5035$char="_-$char-";5036}50375038return$char;5039}50405041=head2 in_array()50425043from Array::PAT - mimics the in_array() function5044found in PHP. Yuck but works for small arrays.50455046=cut5047sub in_array5048{5049my($check,@array) =@_;5050my$retval=0;5051foreachmy$test(@array){5052if($checkeq$test){5053$retval=1;5054}5055}5056return$retval;5057}50585059=head2 safe_pipe_capture50605061an alternative to `command` that allows input to be passed as an array5062to work around shell problems with weird characters in arguments50635064=cut5065sub safe_pipe_capture {50665067my@output;50685069if(my$pid=open my$child,'-|') {5070@output= (<$child>);5071close$childor die join(' ',@_).":$!$?";5072}else{5073exec(@_)or die"$!$?";# exec() can fail the executable can't be found5074}5075returnwantarray?@output:join('',@output);5076}50775078=head2 mangle_dirname50795080create a string from a directory name that is suitable to use as5081part of a filename, mainly by converting all chars except \w.- to _50825083=cut5084sub mangle_dirname {5085my$dirname=shift;5086return unlessdefined$dirname;50875088$dirname=~s/[^\w.-]/_/g;50895090return$dirname;5091}50925093=head2 mangle_tablename50945095create a string from a that is suitable to use as part of an SQL table5096name, mainly by converting all chars except \w to _50975098=cut5099sub mangle_tablename {5100my$tablename=shift;5101return unlessdefined$tablename;51025103$tablename=~s/[^\w_]/_/g;51045105return$tablename;5106}510751081;