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 614my$meta=$updater->getmeta($filename); 615my$wrev= revparse($filename); 616 617if($wrev&&$meta&& ($wrev=~/^-/)) 618{ 619# previously removed file, add back 620$log->info("added file$filenamewas previously removed, send$meta->{revision}"); 621 622print"MT +updated\n"; 623print"MT text U\n"; 624print"MT fname$filename\n"; 625print"MT newline\n"; 626print"MT -updated\n"; 627 628unless($state->{globaloptions}{-n} ) 629{ 630my($filepart,$dirpart) = filenamesplit($filename,1); 631 632print"Created$dirpart\n"; 633print$state->{CVSROOT} ."/$state->{module}/$filename\n"; 634 635# this is an "entries" line 636my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 637$log->debug("/$filepart/$meta->{revision}//$kopts/"); 638print"/$filepart/$meta->{revision}//$kopts/\n"; 639# permissions 640$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}"); 641print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n"; 642# transmit file 643 transmitfile($meta->{filehash}); 644} 645 646next; 647} 648 649unless(defined($state->{entries}{$filename}{modified_filename} ) ) 650{ 651print"E cvs add: nothing known about `$filename'\n"; 652next; 653} 654# TODO : check we're not squashing an already existing file 655if(defined($state->{entries}{$filename}{revision} ) ) 656{ 657print"E cvs add: `$filename' has already been entered\n"; 658next; 659} 660 661my($filepart,$dirpart) = filenamesplit($filename,1); 662 663print"E cvs add: scheduling file `$filename' for addition\n"; 664 665print"Checked-in$dirpart\n"; 666print"$filename\n"; 667my$kopts= kopts_from_path($filename,"file", 668$state->{entries}{$filename}{modified_filename}); 669print"/$filepart/0//$kopts/\n"; 670 671my$requestedKopts=$state->{opt}{k}; 672if(defined($requestedKopts)) 673{ 674$requestedKopts="-k$requestedKopts"; 675} 676else 677{ 678$requestedKopts=""; 679} 680if($koptsne$requestedKopts) 681{ 682$log->warn("Ignoring requested -k='$requestedKopts'" 683." for '$filename'; detected -k='$kopts' instead"); 684#TODO: Also have option to send warning to user? 685} 686 687$addcount++; 688} 689 690if($addcount==1) 691{ 692print"E cvs add: use `cvs commit' to add this file permanently\n"; 693} 694elsif($addcount>1) 695{ 696print"E cvs add: use `cvs commit' to add these files permanently\n"; 697} 698 699print"ok\n"; 700} 701 702# remove \n 703# Response expected: yes. Remove a file. This uses any previous Argument, 704# Directory, Entry, or Modified requests, if they have been sent. The last 705# Directory sent specifies the working directory at the time of the 706# operation. Note that this request does not actually do anything to the 707# repository; the only effect of a successful remove request is to supply 708# the client with a new entries line containing `-' to indicate a removed 709# file. In fact, the client probably could perform this operation without 710# contacting the server, although using remove may cause the server to 711# perform a few more checks. The client sends a subsequent ci request to 712# actually record the removal in the repository. 713sub req_remove 714{ 715my($cmd,$data) =@_; 716 717 argsplit("remove"); 718 719# Grab a handle to the SQLite db and do any necessary updates 720my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log); 721$updater->update(); 722 723#$log->debug("add state : " . Dumper($state)); 724 725my$rmcount=0; 726 727foreachmy$filename( @{$state->{args}} ) 728{ 729$filename= filecleanup($filename); 730 731if(defined($state->{entries}{$filename}{unchanged} )or defined($state->{entries}{$filename}{modified_filename} ) ) 732{ 733print"E cvs remove: file `$filename' still in working directory\n"; 734next; 735} 736 737my$meta=$updater->getmeta($filename); 738my$wrev= revparse($filename); 739 740unless(defined($wrev) ) 741{ 742print"E cvs remove: nothing known about `$filename'\n"; 743next; 744} 745 746if(defined($wrev)and($wrev=~/^-/) ) 747{ 748print"E cvs remove: file `$filename' already scheduled for removal\n"; 749next; 750} 751 752unless($wreveq$meta->{revision} ) 753{ 754# TODO : not sure if the format of this message is quite correct. 755print"E cvs remove: Up to date check failed for `$filename'\n"; 756next; 757} 758 759 760my($filepart,$dirpart) = filenamesplit($filename,1); 761 762print"E cvs remove: scheduling `$filename' for removal\n"; 763 764print"Checked-in$dirpart\n"; 765print"$filename\n"; 766my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash}); 767print"/$filepart/-$wrev//$kopts/\n"; 768 769$rmcount++; 770} 771 772if($rmcount==1) 773{ 774print"E cvs remove: use `cvs commit' to remove this file permanently\n"; 775} 776elsif($rmcount>1) 777{ 778print"E cvs remove: use `cvs commit' to remove these files permanently\n"; 779} 780 781print"ok\n"; 782} 783 784# Modified filename \n 785# Response expected: no. Additional data: mode, \n, file transmission. Send 786# the server a copy of one locally modified file. filename is a file within 787# the most recent directory sent with Directory; it must not contain `/'. 788# If the user is operating on only some files in a directory, only those 789# files need to be included. This can also be sent without Entry, if there 790# is no entry for the file. 791sub req_Modified 792{ 793my($cmd,$data) =@_; 794 795my$mode= <STDIN>; 796defined$mode 797or(print"E end of file reading mode for$data\n"),return; 798chomp$mode; 799my$size= <STDIN>; 800defined$size 801or(print"E end of file reading size of$data\n"),return; 802chomp$size; 803 804# Grab config information 805my$blocksize=8192; 806my$bytesleft=$size; 807my$tmp; 808 809# Get a filehandle/name to write it to 810my($fh,$filename) = tempfile( DIR =>$TEMP_DIR); 811 812# Loop over file data writing out to temporary file. 813while($bytesleft) 814{ 815$blocksize=$bytesleftif($bytesleft<$blocksize); 816read STDIN,$tmp,$blocksize; 817print$fh $tmp; 818$bytesleft-=$blocksize; 819} 820 821close$fh 822or(print"E failed to write temporary,$filename:$!\n"),return; 823 824# Ensure we have something sensible for the file mode 825if($mode=~/u=(\w+)/) 826{ 827$mode=$1; 828}else{ 829$mode="rw"; 830} 831 832# Save the file data in $state 833$state->{entries}{$state->{directory}.$data}{modified_filename} =$filename; 834$state->{entries}{$state->{directory}.$data}{modified_mode} =$mode; 835$state->{entries}{$state->{directory}.$data}{modified_hash} =`git hash-object$filename`; 836$state->{entries}{$state->{directory}.$data}{modified_hash} =~ s/\s.*$//s; 837 838 #$log->debug("req_Modified : file=$datamode=$modesize=$size"); 839} 840 841# Unchanged filename\n 842# Response expected: no. Tell the server that filename has not been 843# modified in the checked out directory. The filename is a file within the 844# most recent directory sent with Directory; it must not contain `/'. 845sub req_Unchanged 846{ 847 my ($cmd,$data) =@_; 848 849$state->{entries}{$state->{directory}.$data}{unchanged} = 1; 850 851 #$log->debug("req_Unchanged :$data"); 852} 853 854# Argument text\n 855# Response expected: no. Save argument for use in a subsequent command. 856# Arguments accumulate until an argument-using command is given, at which 857# point they are forgotten. 858# Argumentx text\n 859# Response expected: no. Append\nfollowed by text to the current argument 860# being saved. 861sub req_Argument 862{ 863 my ($cmd,$data) =@_; 864 865 # Argumentx means: append to last Argument (with a newline in front) 866 867$log->debug("$cmd:$data"); 868 869 if ($cmdeq 'Argumentx') { 870 ${$state->{arguments}}[$#{$state->{arguments}}] .= "\n" .$data; 871 } else { 872 push @{$state->{arguments}},$data; 873 } 874} 875 876# expand-modules\n 877# Response expected: yes. Expand the modules which are specified in the 878# arguments. Returns the data in Module-expansion responses. Note that the 879# server can assume that this is checkout or export, not rtag or rdiff; the 880# latter do not access the working directory and thus have no need to 881# expand modules on the client side. Expand may not be the best word for 882# what this request does. It does not necessarily tell you all the files 883# contained in a module, for example. Basically it is a way of telling you 884# which working directories the server needs to know about in order to 885# handle a checkout of the specified modules. For example, suppose that the 886# server has a module defined by 887# aliasmodule -a 1dir 888# That is, one can check out aliasmodule and it will take 1dir in the 889# repository and check it out to 1dir in the working directory. Now suppose 890# the client already has this module checked out and is planning on using 891# the co request to update it. Without using expand-modules, the client 892# would have two bad choices: it could either send information about all 893# working directories under the current directory, which could be 894# unnecessarily slow, or it could be ignorant of the fact that aliasmodule 895# stands for 1dir, and neglect to send information for 1dir, which would 896# lead to incorrect operation. With expand-modules, the client would first 897# ask for the module to be expanded: 898sub req_expandmodules 899{ 900 my ($cmd,$data) =@_; 901 902 argsplit(); 903 904$log->debug("req_expandmodules : " . ( defined($data) ?$data: "[NULL]" ) ); 905 906 unless ( ref$state->{arguments} eq "ARRAY" ) 907 { 908 print "ok\n"; 909 return; 910 } 911 912 foreach my$module( @{$state->{arguments}} ) 913 { 914$log->debug("SEND : Module-expansion$module"); 915 print "Module-expansion$module\n"; 916 } 917 918 print "ok\n"; 919 statecleanup(); 920} 921 922# co\n 923# Response expected: yes. Get files from the repository. This uses any 924# previous Argument, Directory, Entry, or Modified requests, if they have 925# been sent. Arguments to this command are module names; the client cannot 926# know what directories they correspond to except by (1) just sending the 927# co request, and then seeing what directory names the server sends back in 928# its responses, and (2) the expand-modules request. 929sub req_co 930{ 931 my ($cmd,$data) =@_; 932 933 argsplit("co"); 934 935 # Provide list of modules, if -c was used. 936 if (exists$state->{opt}{c}) { 937 my$showref= `git show-ref --heads`; 938 for my$line(split '\n',$showref) { 939 if ($line=~ m% refs/heads/(.*)$%) { 940 print "M$1\t$1\n"; 941 } 942 } 943 print "ok\n"; 944 return 1; 945 } 946 947 my$module=$state->{args}[0]; 948$state->{module} =$module; 949 my$checkout_path=$module; 950 951 # use the user specified directory if we're given it 952$checkout_path=$state->{opt}{d}if(exists($state->{opt}{d} ) ); 953 954$log->debug("req_co : ". (defined($data) ?$data:"[NULL]") ); 955 956$log->info("Checking out module '$module' ($state->{CVSROOT}) to '$checkout_path'"); 957 958$ENV{GIT_DIR} =$state->{CVSROOT} ."/"; 959 960# Grab a handle to the SQLite db and do any necessary updates 961my$updater= GITCVS::updater->new($state->{CVSROOT},$module,$log); 962$updater->update(); 963 964$checkout_path=~ s|/$||;# get rid of trailing slashes 965 966# Eclipse seems to need the Clear-sticky command 967# to prepare the 'Entries' file for the new directory. 968print"Clear-sticky$checkout_path/\n"; 969print$state->{CVSROOT} ."/$module/\n"; 970print"Clear-static-directory$checkout_path/\n"; 971print$state->{CVSROOT} ."/$module/\n"; 972print"Clear-sticky$checkout_path/\n";# yes, twice 973print$state->{CVSROOT} ."/$module/\n"; 974print"Template$checkout_path/\n"; 975print$state->{CVSROOT} ."/$module/\n"; 976print"0\n"; 977 978# instruct the client that we're checking out to $checkout_path 979print"E cvs checkout: Updating$checkout_path\n"; 980 981my%seendirs= (); 982my$lastdir=''; 983 984# recursive 985sub prepdir { 986my($dir,$repodir,$remotedir,$seendirs) =@_; 987my$parent= dirname($dir); 988$dir=~ s|/+$||; 989$repodir=~ s|/+$||; 990$remotedir=~ s|/+$||; 991$parent=~ s|/+$||; 992$log->debug("announcedir$dir,$repodir,$remotedir"); 993 994if($parenteq'.'||$parenteq'./') { 995$parent=''; 996} 997# recurse to announce unseen parents first 998if(length($parent) && !exists($seendirs->{$parent})) { 999 prepdir($parent,$repodir,$remotedir,$seendirs);1000}1001# Announce that we are going to modify at the parent level1002if($parent) {1003print"E cvs checkout: Updating$remotedir/$parent\n";1004}else{1005print"E cvs checkout: Updating$remotedir\n";1006}1007print"Clear-sticky$remotedir/$parent/\n";1008print"$repodir/$parent/\n";10091010print"Clear-static-directory$remotedir/$dir/\n";1011print"$repodir/$dir/\n";1012print"Clear-sticky$remotedir/$parent/\n";# yes, twice1013print"$repodir/$parent/\n";1014print"Template$remotedir/$dir/\n";1015print"$repodir/$dir/\n";1016print"0\n";10171018$seendirs->{$dir} =1;1019}10201021foreachmy$git( @{$updater->gethead} )1022{1023# Don't want to check out deleted files1024next if($git->{filehash}eq"deleted");10251026my$fullName=$git->{name};1027($git->{name},$git->{dir} ) = filenamesplit($git->{name});10281029if(length($git->{dir}) &&$git->{dir}ne'./'1030&&$git->{dir}ne$lastdir) {1031unless(exists($seendirs{$git->{dir}})) {1032 prepdir($git->{dir},$state->{CVSROOT} ."/$module/",1033$checkout_path, \%seendirs);1034$lastdir=$git->{dir};1035$seendirs{$git->{dir}} =1;1036}1037print"E cvs checkout: Updating /$checkout_path/$git->{dir}\n";1038}10391040# modification time of this file1041print"Mod-time$git->{modified}\n";10421043# print some information to the client1044if(defined($git->{dir} )and$git->{dir}ne"./")1045{1046print"M U$checkout_path/$git->{dir}$git->{name}\n";1047}else{1048print"M U$checkout_path/$git->{name}\n";1049}10501051# instruct client we're sending a file to put in this path1052print"Created$checkout_path/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."\n";10531054print$state->{CVSROOT} ."/$module/". (defined($git->{dir} )and$git->{dir}ne"./"?$git->{dir} ."/":"") ."$git->{name}\n";10551056# this is an "entries" line1057my$kopts= kopts_from_path($fullName,"sha1",$git->{filehash});1058print"/$git->{name}/$git->{revision}//$kopts/\n";1059# permissions1060print"u=$git->{mode},g=$git->{mode},o=$git->{mode}\n";10611062# transmit file1063 transmitfile($git->{filehash});1064}10651066print"ok\n";10671068 statecleanup();1069}10701071# update \n1072# Response expected: yes. Actually do a cvs update command. This uses any1073# previous Argument, Directory, Entry, or Modified requests, if they have1074# been sent. The last Directory sent specifies the working directory at the1075# time of the operation. The -I option is not used--files which the client1076# can decide whether to ignore are not mentioned and the client sends the1077# Questionable request for others.1078sub req_update1079{1080my($cmd,$data) =@_;10811082$log->debug("req_update : ". (defined($data) ?$data:"[NULL]"));10831084 argsplit("update");10851086#1087# It may just be a client exploring the available heads/modules1088# in that case, list them as top level directories and leave it1089# at that. Eclipse uses this technique to offer you a list of1090# projects (heads in this case) to checkout.1091#1092if($state->{module}eq'') {1093my$showref=`git show-ref --heads`;1094print"E cvs update: Updating .\n";1095formy$line(split'\n',$showref) {1096if($line=~ m% refs/heads/(.*)$%) {1097print"E cvs update: New directory `$1'\n";1098}1099}1100print"ok\n";1101return1;1102}110311041105# Grab a handle to the SQLite db and do any necessary updates1106my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);11071108$updater->update();11091110 argsfromdir($updater);11111112#$log->debug("update state : " . Dumper($state));11131114my$last_dirname="///";11151116# foreach file specified on the command line ...1117foreachmy$filename( @{$state->{args}} )1118{1119$filename= filecleanup($filename);11201121$log->debug("Processing file$filename");11221123unless($state->{globaloptions}{-Q} ||$state->{globaloptions}{-q} )1124{1125my$cur_dirname= dirname($filename);1126if($cur_dirnamene$last_dirname)1127{1128$last_dirname=$cur_dirname;1129if($cur_dirnameeq"")1130{1131$cur_dirname=".";1132}1133print"E cvs update: Updating$cur_dirname\n";1134}1135}11361137# if we have a -C we should pretend we never saw modified stuff1138if(exists($state->{opt}{C} ) )1139{1140delete$state->{entries}{$filename}{modified_hash};1141delete$state->{entries}{$filename}{modified_filename};1142$state->{entries}{$filename}{unchanged} =1;1143}11441145my$meta;1146if(defined($state->{opt}{r})and$state->{opt}{r} =~/^(1\.\d+)$/)1147{1148$meta=$updater->getmeta($filename,$1);1149}else{1150$meta=$updater->getmeta($filename);1151}11521153# If -p was given, "print" the contents of the requested revision.1154if(exists($state->{opt}{p} ) ) {1155if(defined($meta->{revision} ) ) {1156$log->info("Printing '$filename' revision ".$meta->{revision});11571158 transmitfile($meta->{filehash}, {print=>1});1159}11601161next;1162}11631164if( !defined$meta)1165{1166$meta= {1167 name =>$filename,1168 revision =>'0',1169 filehash =>'added'1170};1171}11721173my$oldmeta=$meta;11741175my$wrev= revparse($filename);11761177# If the working copy is an old revision, lets get that version too for comparison.1178if(defined($wrev)and$wrevne$meta->{revision} )1179{1180$oldmeta=$updater->getmeta($filename,$wrev);1181}11821183#$log->debug("Target revision is $meta->{revision}, current working revision is $wrev");11841185# Files are up to date if the working copy and repo copy have the same revision,1186# and the working copy is unmodified _and_ the user hasn't specified -C1187next if(defined($wrev)1188and defined($meta->{revision})1189and$wreveq$meta->{revision}1190and$state->{entries}{$filename}{unchanged}1191and not exists($state->{opt}{C} ) );11921193# If the working copy and repo copy have the same revision,1194# but the working copy is modified, tell the client it's modified1195if(defined($wrev)1196and defined($meta->{revision})1197and$wreveq$meta->{revision}1198and defined($state->{entries}{$filename}{modified_hash})1199and not exists($state->{opt}{C} ) )1200{1201$log->info("Tell the client the file is modified");1202print"MT text M\n";1203print"MT fname$filename\n";1204print"MT newline\n";1205next;1206}12071208if($meta->{filehash}eq"deleted")1209{1210# TODO: If it has been modified in the sandbox, error out1211# with the appropriate message, rather than deleting a modified1212# file.12131214my($filepart,$dirpart) = filenamesplit($filename,1);12151216$log->info("Removing '$filename' from working copy (no longer in the repo)");12171218print"E cvs update: `$filename' is no longer in the repository\n";1219# Don't want to actually _DO_ the update if -n specified1220unless($state->{globaloptions}{-n} ) {1221print"Removed$dirpart\n";1222print"$filepart\n";1223}1224}1225elsif(not defined($state->{entries}{$filename}{modified_hash} )1226or$state->{entries}{$filename}{modified_hash}eq$oldmeta->{filehash}1227or$meta->{filehash}eq'added')1228{1229# normal update, just send the new revision (either U=Update,1230# or A=Add, or R=Remove)1231if(defined($wrev) && ($wrev=~/^-/) )1232{1233$log->info("Tell the client the file is scheduled for removal");1234print"MT text R\n";1235print"MT fname$filename\n";1236print"MT newline\n";1237next;1238}1239elsif( (!defined($wrev) ||$wreveq'0') &&1240(!defined($meta->{revision}) ||$meta->{revision}eq'0') )1241{1242$log->info("Tell the client the file is scheduled for addition");1243print"MT text A\n";1244print"MT fname$filename\n";1245print"MT newline\n";1246next;12471248}1249else{1250$log->info("UpdatingX3 '$filename' to ".$meta->{revision});1251print"MT +updated\n";1252print"MT text U\n";1253print"MT fname$filename\n";1254print"MT newline\n";1255print"MT -updated\n";1256}12571258my($filepart,$dirpart) = filenamesplit($filename,1);12591260# Don't want to actually _DO_ the update if -n specified1261unless($state->{globaloptions}{-n} )1262{1263if(defined($wrev) )1264{1265# instruct client we're sending a file to put in this path as a replacement1266print"Update-existing$dirpart\n";1267$log->debug("Updating existing file 'Update-existing$dirpart'");1268}else{1269# instruct client we're sending a file to put in this path as a new file1270print"Clear-static-directory$dirpart\n";1271print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";1272print"Clear-sticky$dirpart\n";1273print$state->{CVSROOT} ."/$state->{module}/$dirpart\n";12741275$log->debug("Creating new file 'Created$dirpart'");1276print"Created$dirpart\n";1277}1278print$state->{CVSROOT} ."/$state->{module}/$filename\n";12791280# this is an "entries" line1281my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1282$log->debug("/$filepart/$meta->{revision}//$kopts/");1283print"/$filepart/$meta->{revision}//$kopts/\n";12841285# permissions1286$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1287print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";12881289# transmit file1290 transmitfile($meta->{filehash});1291}1292}else{1293my($filepart,$dirpart) = filenamesplit($meta->{name},1);12941295my$mergeDir= setupTmpDir();12961297my$file_local=$filepart.".mine";1298my$mergedFile="$mergeDir/$file_local";1299system("ln","-s",$state->{entries}{$filename}{modified_filename},$file_local);1300my$file_old=$filepart.".".$oldmeta->{revision};1301 transmitfile($oldmeta->{filehash}, { targetfile =>$file_old});1302my$file_new=$filepart.".".$meta->{revision};1303 transmitfile($meta->{filehash}, { targetfile =>$file_new});13041305# we need to merge with the local changes ( M=successful merge, C=conflict merge )1306$log->info("Merging$file_local,$file_old,$file_new");1307print"M Merging differences between$oldmeta->{revision} and$meta->{revision} into$filename\n";13081309$log->debug("Temporary directory for merge is$mergeDir");13101311my$return=system("git","merge-file",$file_local,$file_old,$file_new);1312$return>>=8;13131314 cleanupTmpDir();13151316if($return==0)1317{1318$log->info("Merged successfully");1319print"M M$filename\n";1320$log->debug("Merged$dirpart");13211322# Don't want to actually _DO_ the update if -n specified1323unless($state->{globaloptions}{-n} )1324{1325print"Merged$dirpart\n";1326$log->debug($state->{CVSROOT} ."/$state->{module}/$filename");1327print$state->{CVSROOT} ."/$state->{module}/$filename\n";1328my$kopts= kopts_from_path("$dirpart/$filepart",1329"file",$mergedFile);1330$log->debug("/$filepart/$meta->{revision}//$kopts/");1331print"/$filepart/$meta->{revision}//$kopts/\n";1332}1333}1334elsif($return==1)1335{1336$log->info("Merged with conflicts");1337print"E cvs update: conflicts found in$filename\n";1338print"M C$filename\n";13391340# Don't want to actually _DO_ the update if -n specified1341unless($state->{globaloptions}{-n} )1342{1343print"Merged$dirpart\n";1344print$state->{CVSROOT} ."/$state->{module}/$filename\n";1345my$kopts= kopts_from_path("$dirpart/$filepart",1346"file",$mergedFile);1347print"/$filepart/$meta->{revision}/+/$kopts/\n";1348}1349}1350else1351{1352$log->warn("Merge failed");1353next;1354}13551356# Don't want to actually _DO_ the update if -n specified1357unless($state->{globaloptions}{-n} )1358{1359# permissions1360$log->debug("SEND : u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}");1361print"u=$meta->{mode},g=$meta->{mode},o=$meta->{mode}\n";13621363# transmit file, format is single integer on a line by itself (file1364# size) followed by the file contents1365# TODO : we should copy files in blocks1366my$data=`cat$mergedFile`;1367$log->debug("File size : " . length($data));1368 print length($data) . "\n";1369 print$data;1370 }1371 }13721373 }13741375 print "ok\n";1376}13771378sub req_ci1379{1380 my ($cmd,$data) =@_;13811382 argsplit("ci");13831384 #$log->debug("State : " . Dumper($state));13851386$log->info("req_ci : " . ( defined($data) ?$data: "[NULL]" ));13871388 if ($state->{method} eq 'pserver' and$state->{user} eq 'anonymous' )1389 {1390 print "error 1 anonymous user cannot commit via pserver\n";1391 cleanupWorkTree();1392 exit;1393 }13941395 if ( -e$state->{CVSROOT} . "/index" )1396 {1397$log->warn("file 'index' already exists in the git repository");1398 print "error 1 Index already exists in git repo\n";1399 cleanupWorkTree();1400 exit;1401 }14021403 # Grab a handle to the SQLite db and do any necessary updates1404 my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1405$updater->update();14061407 # Remember where the head was at the beginning.1408 my$parenthash= `git show-ref -s refs/heads/$state->{module}`;1409 chomp$parenthash;1410 if ($parenthash!~ /^[0-9a-f]{40}$/) {1411 print "error 1 pserver cannot find the current HEAD of module";1412 cleanupWorkTree();1413 exit;1414 }14151416 setupWorkTree($parenthash);14171418$log->info("Lockless commit start, basing commit on '$work->{workDir}', index file is '$work->{index}'");14191420$log->info("Created index '$work->{index}' for head$state->{module} - exit status$?");14211422 my@committedfiles= ();1423 my%oldmeta;14241425 # foreach file specified on the command line ...1426 foreach my$filename( @{$state->{args}} )1427 {1428 my$committedfile=$filename;1429$filename= filecleanup($filename);14301431 next unless ( exists$state->{entries}{$filename}{modified_filename} or not$state->{entries}{$filename}{unchanged} );14321433 my$meta=$updater->getmeta($filename);1434$oldmeta{$filename} =$meta;14351436 my$wrev= revparse($filename);14371438 my ($filepart,$dirpart) = filenamesplit($filename);14391440 # do a checkout of the file if it is part of this tree1441 if ($wrev) {1442 system('git', 'checkout-index', '-f', '-u',$filename);1443 unless ($?== 0) {1444 die "Error running git-checkout-index -f -u$filename:$!";1445 }1446 }14471448 my$addflag= 0;1449 my$rmflag= 0;1450$rmflag= 1 if ( defined($wrev) and ($wrev=~/^-/) );1451$addflag= 1 unless ( -e$filename);14521453 # Do up to date checking1454 unless ($addflagor$wreveq$meta->{revision} or1455 ($rmflagand$wreveq "-$meta->{revision}" ) )1456 {1457 # fail everything if an up to date check fails1458 print "error 1 Up to date check failed for$filename\n";1459 cleanupWorkTree();1460 exit;1461 }14621463 push@committedfiles,$committedfile;1464$log->info("Committing$filename");14651466 system("mkdir","-p",$dirpart) unless ( -d$dirpart);14671468 unless ($rmflag)1469 {1470$log->debug("rename$state->{entries}{$filename}{modified_filename}$filename");1471 rename$state->{entries}{$filename}{modified_filename},$filename;14721473 # Calculate modes to remove1474 my$invmode= "";1475 foreach ( qw (r w x) ) {$invmode.=$_unless ($state->{entries}{$filename}{modified_mode} =~ /$_/); }14761477$log->debug("chmod u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode. "$filename");1478 system("chmod","u+" .$state->{entries}{$filename}{modified_mode} . "-" .$invmode,$filename);1479 }14801481 if ($rmflag)1482 {1483$log->info("Removing file '$filename'");1484 unlink($filename);1485 system("git", "update-index", "--remove",$filename);1486 }1487 elsif ($addflag)1488 {1489$log->info("Adding file '$filename'");1490 system("git", "update-index", "--add",$filename);1491 } else {1492$log->info("UpdatingX2 file '$filename'");1493 system("git", "update-index",$filename);1494 }1495 }14961497 unless ( scalar(@committedfiles) > 0 )1498 {1499 print "E No files to commit\n";1500 print "ok\n";1501 cleanupWorkTree();1502 return;1503 }15041505 my$treehash= `git write-tree`;1506 chomp$treehash;15071508$log->debug("Treehash :$treehash, Parenthash :$parenthash");15091510 # write our commit message out if we have one ...1511 my ($msg_fh,$msg_filename) = tempfile( DIR =>$TEMP_DIR);1512 print$msg_fh$state->{opt}{m};# if ( exists ($state->{opt}{m} ) );1513 if ( defined ($cfg->{gitcvs}{commitmsgannotation} ) ) {1514 if ($cfg->{gitcvs}{commitmsgannotation} !~ /^\s*$/) {1515 print$msg_fh"\n\n".$cfg->{gitcvs}{commitmsgannotation}."\n"1516 }1517 } else {1518 print$msg_fh"\n\nvia git-CVS emulator\n";1519 }1520 close$msg_fh;15211522 my$commithash= `git commit-tree $treehash-p $parenthash<$msg_filename`;1523chomp($commithash);1524$log->info("Commit hash :$commithash");15251526unless($commithash=~/[a-zA-Z0-9]{40}/)1527{1528$log->warn("Commit failed (Invalid commit hash)");1529print"error 1 Commit failed (unknown reason)\n";1530 cleanupWorkTree();1531exit;1532}15331534### Emulate git-receive-pack by running hooks/update1535my@hook= ($ENV{GIT_DIR}.'hooks/update',"refs/heads/$state->{module}",1536$parenthash,$commithash);1537if( -x $hook[0] ) {1538unless(system(@hook) ==0)1539{1540$log->warn("Commit failed (update hook declined to update ref)");1541print"error 1 Commit failed (update hook declined)\n";1542 cleanupWorkTree();1543exit;1544}1545}15461547### Update the ref1548if(system(qw(git update-ref -m),"cvsserver ci",1549"refs/heads/$state->{module}",$commithash,$parenthash)) {1550$log->warn("update-ref for$state->{module} failed.");1551print"error 1 Cannot commit -- update first\n";1552 cleanupWorkTree();1553exit;1554}15551556### Emulate git-receive-pack by running hooks/post-receive1557my$hook=$ENV{GIT_DIR}.'hooks/post-receive';1558if( -x $hook) {1559open(my$pipe,"|$hook") ||die"can't fork$!";15601561local$SIG{PIPE} =sub{die'pipe broke'};15621563print$pipe"$parenthash$commithashrefs/heads/$state->{module}\n";15641565close$pipe||die"bad pipe:$!$?";1566}15671568$updater->update();15691570### Then hooks/post-update1571$hook=$ENV{GIT_DIR}.'hooks/post-update';1572if(-x $hook) {1573system($hook,"refs/heads/$state->{module}");1574}15751576# foreach file specified on the command line ...1577foreachmy$filename(@committedfiles)1578{1579$filename= filecleanup($filename);15801581my$meta=$updater->getmeta($filename);1582unless(defined$meta->{revision}) {1583$meta->{revision} ="1.1";1584}15851586my($filepart,$dirpart) = filenamesplit($filename,1);15871588$log->debug("Checked-in$dirpart:$filename");15891590print"M$state->{CVSROOT}/$state->{module}/$filename,v <--$dirpart$filepart\n";1591if(defined$meta->{filehash} &&$meta->{filehash}eq"deleted")1592{1593print"M new revision: delete; previous revision:$oldmeta{$filename}{revision}\n";1594print"Remove-entry$dirpart\n";1595print"$filename\n";1596}else{1597if($meta->{revision}eq"1.1") {1598print"M initial revision: 1.1\n";1599}else{1600print"M new revision:$meta->{revision}; previous revision:$oldmeta{$filename}{revision}\n";1601}1602print"Checked-in$dirpart\n";1603print"$filename\n";1604my$kopts= kopts_from_path($filename,"sha1",$meta->{filehash});1605print"/$filepart/$meta->{revision}//$kopts/\n";1606}1607}16081609 cleanupWorkTree();1610print"ok\n";1611}16121613sub req_status1614{1615my($cmd,$data) =@_;16161617 argsplit("status");16181619$log->info("req_status : ". (defined($data) ?$data:"[NULL]"));1620#$log->debug("status state : " . Dumper($state));16211622# Grab a handle to the SQLite db and do any necessary updates1623my$updater;1624$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1625$updater->update();16261627# if no files were specified, we need to work out what files we should1628# be providing status on ...1629 argsfromdir($updater);16301631# foreach file specified on the command line ...1632foreachmy$filename( @{$state->{args}} )1633{1634$filename= filecleanup($filename);16351636if(exists($state->{opt}{l}) &&1637index($filename,'/',length($state->{prependdir})) >=0)1638{1639next;1640}16411642my$meta=$updater->getmeta($filename);1643my$oldmeta=$meta;16441645my$wrev= revparse($filename);16461647# If the working copy is an old revision, lets get that1648# version too for comparison.1649if(defined($wrev)and$wrevne$meta->{revision} )1650{1651$oldmeta=$updater->getmeta($filename,$wrev);1652}16531654# TODO : All possible statuses aren't yet implemented1655my$status;1656# Files are up to date if the working copy and repo copy have1657# the same revision, and the working copy is unmodified1658if(defined($wrev)and defined($meta->{revision})and1659$wreveq$meta->{revision}and1660( ($state->{entries}{$filename}{unchanged}and1661(not defined($state->{entries}{$filename}{conflict} )or1662$state->{entries}{$filename}{conflict} !~/^\+=/) )or1663(defined($state->{entries}{$filename}{modified_hash})and1664$state->{entries}{$filename}{modified_hash}eq1665$meta->{filehash} ) ) )1666{1667$status="Up-to-date"1668}16691670# Need checkout if the working copy has a different (usually1671# older) revision than the repo copy, and the working copy is1672# unmodified1673if(defined($wrev)and defined($meta->{revision} )and1674$meta->{revision}ne$wrevand1675($state->{entries}{$filename}{unchanged}or1676(defined($state->{entries}{$filename}{modified_hash})and1677$state->{entries}{$filename}{modified_hash}eq1678$oldmeta->{filehash} ) ) )1679{1680$status||="Needs Checkout";1681}16821683# Need checkout if it exists in the repo but doesn't have a working1684# copy1685if(not defined($wrev)and defined($meta->{revision} ) )1686{1687$status||="Needs Checkout";1688}16891690# Locally modified if working copy and repo copy have the1691# same revision but there are local changes1692if(defined($wrev)and defined($meta->{revision})and1693$wreveq$meta->{revision}and1694$state->{entries}{$filename}{modified_filename} )1695{1696$status||="Locally Modified";1697}16981699# Needs Merge if working copy revision is different1700# (usually older) than repo copy and there are local changes1701if(defined($wrev)and defined($meta->{revision} )and1702$meta->{revision}ne$wrevand1703$state->{entries}{$filename}{modified_filename} )1704{1705$status||="Needs Merge";1706}17071708if(defined($state->{entries}{$filename}{revision} )and1709not defined($meta->{revision} ) )1710{1711$status||="Locally Added";1712}1713if(defined($wrev)and defined($meta->{revision} )and1714$wreveq"-$meta->{revision}")1715{1716$status||="Locally Removed";1717}1718if(defined($state->{entries}{$filename}{conflict} )and1719$state->{entries}{$filename}{conflict} =~/^\+=/)1720{1721$status||="Unresolved Conflict";1722}1723if(0)1724{1725$status||="File had conflicts on merge";1726}17271728$status||="Unknown";17291730my($filepart) = filenamesplit($filename);17311732print"M =======". ("=" x 60) ."\n";1733print"M File:$filepart\tStatus:$status\n";1734if(defined($state->{entries}{$filename}{revision}) )1735{1736print"M Working revision:\t".1737$state->{entries}{$filename}{revision} ."\n";1738}else{1739print"M Working revision:\tNo entry for$filename\n";1740}1741if(defined($meta->{revision}) )1742{1743print"M Repository revision:\t".1744$meta->{revision} .1745"\t$state->{CVSROOT}/$state->{module}/$filename,v\n";1746my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};1747my($tag)=($tagOrDate=~m/^T(.+)$/);1748if( !defined($tag) )1749{1750$tag="(none)";1751}1752print"M Sticky Tag:\t\t$tag\n";1753my($date)=($tagOrDate=~m/^D(.+)$/);1754if( !defined($date) )1755{1756$date="(none)";1757}1758print"M Sticky Date:\t\t$date\n";1759my($options)=$state->{entries}{$filename}{options};1760if($optionseq"")1761{1762$options="(none)";1763}1764print"M Sticky Options:\t\t$options\n";1765}else{1766print"M Repository revision:\tNo revision control file\n";1767}1768print"M\n";1769}17701771print"ok\n";1772}17731774sub req_diff1775{1776my($cmd,$data) =@_;17771778 argsplit("diff");17791780$log->debug("req_diff : ". (defined($data) ?$data:"[NULL]"));1781#$log->debug("status state : " . Dumper($state));17821783my($revision1,$revision2);1784if(defined($state->{opt}{r} )and ref$state->{opt}{r}eq"ARRAY")1785{1786$revision1=$state->{opt}{r}[0];1787$revision2=$state->{opt}{r}[1];1788}else{1789$revision1=$state->{opt}{r};1790}17911792$log->debug("Diffing revisions ".1793(defined($revision1) ?$revision1:"[NULL]") .1794" and ". (defined($revision2) ?$revision2:"[NULL]") );17951796# Grab a handle to the SQLite db and do any necessary updates1797my$updater;1798$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1799$updater->update();18001801# if no files were specified, we need to work out what files we should1802# be providing status on ...1803 argsfromdir($updater);18041805# foreach file specified on the command line ...1806foreachmy$filename( @{$state->{args}} )1807{1808$filename= filecleanup($filename);18091810my($fh,$file1,$file2,$meta1,$meta2,$filediff);18111812my$wrev= revparse($filename);18131814# We need _something_ to diff against1815next unless(defined($wrev) );18161817# if we have a -r switch, use it1818if(defined($revision1) )1819{1820(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1821$meta1=$updater->getmeta($filename,$revision1);1822unless(defined($meta1)and$meta1->{filehash}ne"deleted")1823{1824print"E File$filenameat revision$revision1doesn't exist\n";1825next;1826}1827 transmitfile($meta1->{filehash}, { targetfile =>$file1});1828}1829# otherwise we just use the working copy revision1830else1831{1832(undef,$file1) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1833$meta1=$updater->getmeta($filename,$wrev);1834 transmitfile($meta1->{filehash}, { targetfile =>$file1});1835}18361837# if we have a second -r switch, use it too1838if(defined($revision2) )1839{1840(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1841$meta2=$updater->getmeta($filename,$revision2);18421843unless(defined($meta2)and$meta2->{filehash}ne"deleted")1844{1845print"E File$filenameat revision$revision2doesn't exist\n";1846next;1847}18481849 transmitfile($meta2->{filehash}, { targetfile =>$file2});1850}1851# otherwise we just use the working copy1852else1853{1854$file2=$state->{entries}{$filename}{modified_filename};1855}18561857# if we have been given -r, and we don't have a $file2 yet, lets1858# get one1859if(defined($revision1)and not defined($file2) )1860{1861(undef,$file2) = tempfile( DIR =>$TEMP_DIR, OPEN =>0);1862$meta2=$updater->getmeta($filename,$wrev);1863 transmitfile($meta2->{filehash}, { targetfile =>$file2});1864}18651866# We need to have retrieved something useful1867next unless(defined($meta1) );18681869# Files to date if the working copy and repo copy have the same1870# revision, and the working copy is unmodified1871if(not defined($meta2)and$wreveq$meta1->{revision}and1872( ($state->{entries}{$filename}{unchanged}and1873(not defined($state->{entries}{$filename}{conflict} )or1874$state->{entries}{$filename}{conflict} !~/^\+=/) )or1875(defined($state->{entries}{$filename}{modified_hash})and1876$state->{entries}{$filename}{modified_hash}eq1877$meta1->{filehash} ) ) )1878{1879next;1880}18811882# Apparently we only show diffs for locally modified files1883unless(defined($meta2)or1884defined($state->{entries}{$filename}{modified_filename} ) )1885{1886next;1887}18881889print"M Index:$filename\n";1890print"M =======". ("=" x 60) ."\n";1891print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1892if(defined($meta1) )1893{1894print"M retrieving revision$meta1->{revision}\n"1895}1896if(defined($meta2) )1897{1898print"M retrieving revision$meta2->{revision}\n"1899}1900print"M diff ";1901foreachmy$opt(keys%{$state->{opt}} )1902{1903if(ref$state->{opt}{$opt}eq"ARRAY")1904{1905foreachmy$value( @{$state->{opt}{$opt}} )1906{1907print"-$opt$value";1908}1909}else{1910print"-$opt";1911if(defined($state->{opt}{$opt} ) )1912{1913print"$state->{opt}{$opt} "1914}1915}1916}1917print"$filename\n";19181919$log->info("Diffing$filename-r$meta1->{revision} -r ".1920($meta2->{revision}or"workingcopy"));19211922($fh,$filediff) = tempfile ( DIR =>$TEMP_DIR);19231924if(exists$state->{opt}{u} )1925{1926system("diff -u -L '$filenamerevision$meta1->{revision}'".1927" -L '$filename".1928(defined($meta2->{revision}) ?1929"revision$meta2->{revision}":1930"working copy") .1931"'$file1$file2>$filediff");1932}else{1933system("diff$file1$file2>$filediff");1934}19351936while( <$fh> )1937{1938print"M$_";1939}1940close$fh;1941}19421943print"ok\n";1944}19451946sub req_log1947{1948my($cmd,$data) =@_;19491950 argsplit("log");19511952$log->debug("req_log : ". (defined($data) ?$data:"[NULL]"));1953#$log->debug("log state : " . Dumper($state));19541955my($revFilter);1956if(defined($state->{opt}{r} ) )1957{1958$revFilter=$state->{opt}{r};1959}19601961# Grab a handle to the SQLite db and do any necessary updates1962my$updater;1963$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);1964$updater->update();19651966# if no files were specified, we need to work out what files we1967# should be providing status on ...1968 argsfromdir($updater);19691970# foreach file specified on the command line ...1971foreachmy$filename( @{$state->{args}} )1972{1973$filename= filecleanup($filename);19741975my$headmeta=$updater->getmeta($filename);19761977my($revisions,$totalrevisions) =$updater->getlog($filename,1978$revFilter);19791980next unless(scalar(@$revisions) );19811982print"M\n";1983print"M RCS file:$state->{CVSROOT}/$state->{module}/$filename,v\n";1984print"M Working file:$filename\n";1985print"M head:$headmeta->{revision}\n";1986print"M branch:\n";1987print"M locks: strict\n";1988print"M access list:\n";1989print"M symbolic names:\n";1990print"M keyword substitution: kv\n";1991print"M total revisions:$totalrevisions;\tselected revisions: ".1992scalar(@$revisions) ."\n";1993print"M description:\n";19941995foreachmy$revision(@$revisions)1996{1997print"M ----------------------------\n";1998print"M revision$revision->{revision}\n";1999# reformat the date for log output2000if($revision->{modified} =~/(\d+)\s+(\w+)\s+(\d+)\s+(\S+)/and2001defined($DATE_LIST->{$2}) )2002{2003$revision->{modified} =sprintf('%04d/%02d/%02d%s',2004$3,$DATE_LIST->{$2},$1,$4);2005}2006$revision->{author} = cvs_author($revision->{author});2007print"M date:$revision->{modified};".2008" author:$revision->{author}; state: ".2009($revision->{filehash}eq"deleted"?"dead":"Exp") .2010"; lines: +2 -3\n";2011my$commitmessage;2012$commitmessage=$updater->commitmessage($revision->{commithash});2013$commitmessage=~s/^/M /mg;2014print$commitmessage."\n";2015}2016print"M =======". ("=" x 70) ."\n";2017}20182019print"ok\n";2020}20212022sub req_annotate2023{2024my($cmd,$data) =@_;20252026 argsplit("annotate");20272028$log->info("req_annotate : ". (defined($data) ?$data:"[NULL]"));2029#$log->debug("status state : " . Dumper($state));20302031# Grab a handle to the SQLite db and do any necessary updates2032my$updater= GITCVS::updater->new($state->{CVSROOT},$state->{module},$log);2033$updater->update();20342035# if no files were specified, we need to work out what files we should be providing annotate on ...2036 argsfromdir($updater);20372038# we'll need a temporary checkout dir2039 setupWorkTree();20402041$log->info("Temp checkoutdir creation successful, basing annotate session work on '$work->{workDir}', index file is '$ENV{GIT_INDEX_FILE}'");20422043# foreach file specified on the command line ...2044foreachmy$filename( @{$state->{args}} )2045{2046$filename= filecleanup($filename);20472048my$meta=$updater->getmeta($filename);20492050next unless($meta->{revision} );20512052# get all the commits that this file was in2053# in dense format -- aka skip dead revisions2054my$revisions=$updater->gethistorydense($filename);2055my$lastseenin=$revisions->[0][2];20562057# populate the temporary index based on the latest commit were we saw2058# the file -- but do it cheaply without checking out any files2059# TODO: if we got a revision from the client, use that instead2060# to look up the commithash in sqlite (still good to default to2061# the current head as we do now)2062system("git","read-tree",$lastseenin);2063unless($?==0)2064{2065print"E error running git-read-tree$lastseenin$ENV{GIT_INDEX_FILE}$!\n";2066return;2067}2068$log->info("Created index '$ENV{GIT_INDEX_FILE}' with commit$lastseenin- exit status$?");20692070# do a checkout of the file2071system('git','checkout-index','-f','-u',$filename);2072unless($?==0) {2073print"E error running git-checkout-index -f -u$filename:$!\n";2074return;2075}20762077$log->info("Annotate$filename");20782079# Prepare a file with the commits from the linearized2080# history that annotate should know about. This prevents2081# git-jsannotate telling us about commits we are hiding2082# from the client.20832084my$a_hints="$work->{workDir}/.annotate_hints";2085if(!open(ANNOTATEHINTS,'>',$a_hints)) {2086print"E failed to open '$a_hints' for writing:$!\n";2087return;2088}2089for(my$i=0;$i<@$revisions;$i++)2090{2091print ANNOTATEHINTS $revisions->[$i][2];2092if($i+1<@$revisions) {# have we got a parent?2093print ANNOTATEHINTS ' '.$revisions->[$i+1][2];2094}2095print ANNOTATEHINTS "\n";2096}20972098print ANNOTATEHINTS "\n";2099close ANNOTATEHINTS2100or(print"E failed to write$a_hints:$!\n"),return;21012102my@cmd= (qw(git annotate -l -S),$a_hints,$filename);2103if(!open(ANNOTATE,"-|",@cmd)) {2104print"E error invoking ".join(' ',@cmd) .":$!\n";2105return;2106}2107my$metadata= {};2108print"E Annotations for$filename\n";2109print"E ***************\n";2110while( <ANNOTATE> )2111{2112if(m/^([a-zA-Z0-9]{40})\t\([^\)]*\)(.*)$/i)2113{2114my$commithash=$1;2115my$data=$2;2116unless(defined($metadata->{$commithash} ) )2117{2118$metadata->{$commithash} =$updater->getmeta($filename,$commithash);2119$metadata->{$commithash}{author} = cvs_author($metadata->{$commithash}{author});2120$metadata->{$commithash}{modified} =sprintf("%02d-%s-%02d",$1,$2,$3)if($metadata->{$commithash}{modified} =~/^(\d+)\s(\w+)\s\d\d(\d\d)/);2121}2122printf("M %-7s (%-8s%10s):%s\n",2123$metadata->{$commithash}{revision},2124$metadata->{$commithash}{author},2125$metadata->{$commithash}{modified},2126$data2127);2128}else{2129$log->warn("Error in annotate output! LINE:$_");2130print"E Annotate error\n";2131next;2132}2133}2134close ANNOTATE;2135}21362137# done; get out of the tempdir2138 cleanupWorkTree();21392140print"ok\n";21412142}21432144# This method takes the state->{arguments} array and produces two new arrays.2145# The first is $state->{args} which is everything before the '--' argument, and2146# the second is $state->{files} which is everything after it.2147sub argsplit2148{2149$state->{args} = [];2150$state->{files} = [];2151$state->{opt} = {};21522153return unless(defined($state->{arguments})and ref$state->{arguments}eq"ARRAY");21542155my$type=shift;21562157if(defined($type) )2158{2159my$opt= {};2160$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");2161$opt= { v =>0, l =>0, R =>0}if($typeeq"status");2162$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");2163$opt= { l =>0, R =>0, k =>1, D =>1, D =>1, r =>2}if($typeeq"diff");2164$opt= { c =>0, R =>0, l =>0, f =>0, F =>1, m =>1, r =>1}if($typeeq"ci");2165$opt= { k =>1, m =>1}if($typeeq"add");2166$opt= { f =>0, l =>0, R =>0}if($typeeq"remove");2167$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");216821692170while(scalar( @{$state->{arguments}} ) >0)2171{2172my$arg=shift@{$state->{arguments}};21732174next if($argeq"--");2175next unless($arg=~/\S/);21762177# if the argument looks like a switch2178if($arg=~/^-(\w)(.*)/)2179{2180# if it's a switch that takes an argument2181if($opt->{$1} )2182{2183# If this switch has already been provided2184if($opt->{$1} >1and exists($state->{opt}{$1} ) )2185{2186$state->{opt}{$1} = [$state->{opt}{$1} ];2187if(length($2) >0)2188{2189push@{$state->{opt}{$1}},$2;2190}else{2191push@{$state->{opt}{$1}},shift@{$state->{arguments}};2192}2193}else{2194# if there's extra data in the arg, use that as the argument for the switch2195if(length($2) >0)2196{2197$state->{opt}{$1} =$2;2198}else{2199$state->{opt}{$1} =shift@{$state->{arguments}};2200}2201}2202}else{2203$state->{opt}{$1} =undef;2204}2205}2206else2207{2208push@{$state->{args}},$arg;2209}2210}2211}2212else2213{2214my$mode=0;22152216foreachmy$value( @{$state->{arguments}} )2217{2218if($valueeq"--")2219{2220$mode++;2221next;2222}2223push@{$state->{args}},$valueif($mode==0);2224push@{$state->{files}},$valueif($mode==1);2225}2226}2227}22282229# Used by argsfromdir2230sub expandArg2231{2232my($updater,$outNameMap,$outDirMap,$path,$isDir) =@_;22332234my$fullPath= filecleanup($path);22352236# Is it a directory?2237if(defined($state->{dirMap}{$fullPath}) ||2238defined($state->{dirMap}{"$fullPath/"}) )2239{2240# It is a directory in the user's sandbox.2241$isDir=1;22422243if(defined($state->{entries}{$fullPath}))2244{2245$log->fatal("Inconsistent file/dir type");2246die"Inconsistent file/dir type";2247}2248}2249elsif(defined($state->{entries}{$fullPath}))2250{2251# It is a file in the user's sandbox.2252$isDir=0;2253}2254my($revDirMap,$otherRevDirMap);2255if(!defined($isDir) ||$isDir)2256{2257# Resolve version tree for sticky tag:2258# (for now we only want list of files for the version, not2259# particular versions of those files: assume it is a directory2260# for the moment; ignore Entry's stick tag)22612262# Order of precedence of sticky tags:2263# -A [head]2264# -r /tag/2265# [file entry sticky tag, but that is only relevant to files]2266# [the tag specified in dir req_Sticky]2267# [the tag specified in a parent dir req_Sticky]2268# [head]2269# Also, -r may appear twice (for diff).2270#2271# FUTURE: When/if -j (merges) are supported, we also2272# need to add relevant files from one or two2273# versions specified with -j.22742275if(exists($state->{opt}{A}))2276{2277$revDirMap=$updater->getRevisionDirMap();2278}2279elsif(defined($state->{opt}{r})and2280ref$state->{opt}{r}eq"ARRAY")2281{2282$revDirMap=$updater->getRevisionDirMap($state->{opt}{r}[0]);2283$otherRevDirMap=$updater->getRevisionDirMap($state->{opt}{r}[1]);2284}2285elsif(defined($state->{opt}{r}))2286{2287$revDirMap=$updater->getRevisionDirMap($state->{opt}{r});2288}2289else2290{2291my($sticky)=getDirStickyInfo($fullPath);2292$revDirMap=$updater->getRevisionDirMap($sticky->{tag});2293}22942295# Is it a directory?2296if(defined($revDirMap->{$fullPath}) ||2297defined($otherRevDirMap->{$fullPath}) )2298{2299$isDir=1;2300}2301}23022303# What to do with it?2304if(!$isDir)2305{2306$outNameMap->{$fullPath}=1;2307}2308else2309{2310$outDirMap->{$fullPath}=1;23112312if(defined($revDirMap->{$fullPath}))2313{2314 addDirMapFiles($updater,$outNameMap,$outDirMap,2315$revDirMap->{$fullPath});2316}2317if(defined($otherRevDirMap) &&2318defined($otherRevDirMap->{$fullPath}) )2319{2320 addDirMapFiles($updater,$outNameMap,$outDirMap,2321$otherRevDirMap->{$fullPath});2322}2323}2324}23252326# Used by argsfromdir2327# Add entries from dirMap to outNameMap. Also recurse into entries2328# that are subdirectories.2329sub addDirMapFiles2330{2331my($updater,$outNameMap,$outDirMap,$dirMap)=@_;23322333my($fullName);2334foreach$fullName(keys(%$dirMap))2335{2336my$cleanName=$fullName;2337if(defined($state->{prependdir}))2338{2339if(!($cleanName=~s/^\Q$state->{prependdir}\E//))2340{2341$log->fatal("internal error stripping prependdir");2342die"internal error stripping prependdir";2343}2344}23452346if($dirMap->{$fullName}eq"F")2347{2348$outNameMap->{$cleanName}=1;2349}2350elsif($dirMap->{$fullName}eq"D")2351{2352if(!$state->{opt}{l})2353{2354 expandArg($updater,$outNameMap,$outDirMap,$cleanName,1);2355}2356}2357else2358{2359$log->fatal("internal error in addDirMapFiles");2360die"internal error in addDirMapFiles";2361}2362}2363}23642365# This method replaces $state->{args} with a directory-expanded2366# list of all relevant filenames (recursively unless -d), based2367# on $state->{entries}, and the "current" list of files in2368# each directory. "Current" files as determined by2369# either the requested (-r/-A) or "req_Sticky" version of2370# that directory.2371# Both the input args and the new output args are relative2372# to the cvs-client's CWD, although some of the internal2373# computations are relative to the top of the project.2374sub argsfromdir2375{2376my$updater=shift;23772378# Notes about requirements for specific callers:2379# update # "standard" case (entries; a single -r/-A/default; -l)2380# # Special case: -d for create missing directories.2381# diff # 0 or 1 -r's: "standard" case.2382# # 2 -r's: We could ignore entries (just use the two -r's),2383# # but it doesn't really matter.2384# annotate # "standard" case2385# log # Punting: log -r has a more complex non-"standard"2386# # meaning, and we don't currently try to support log'ing2387# # branches at all (need a lot of work to2388# # support CVS-consistent branch relative version2389# # numbering).2390#HERE: But we still want to expand directories. Maybe we should2391# essentially force "-A".2392# status # "standard", except that -r/-A/default are not possible.2393# # Mostly only used to expand entries only)2394#2395# Don't use argsfromdir at all:2396# add # Explicit arguments required. Directory args imply add2397# # the directory itself, not the files in it.2398# co # Obtain list directly.2399# remove # HERE: TEST: MAYBE client does the recursion for us,2400# # since it only makes sense to remove stuff already in2401# # the sandobx?2402# ci # HERE: Similar to remove...2403# # Don't try to implement the confusing/weird2404# # ci -r bug er.."feature".24052406if(scalar(@{$state->{args}})==0)2407{2408$state->{args} = ["."];2409}2410my%allArgs;2411my%allDirs;2412formy$file(@{$state->{args}})2413{2414 expandArg($updater,\%allArgs,\%allDirs,$file);2415}24162417# Include any entries from sandbox. Generally client won't2418# send entries that shouldn't be used.2419foreachmy$file(keys%{$state->{entries}})2420{2421$allArgs{remove_prependdir($file)} =1;2422}24232424$state->{dirArgs} = \%allDirs;2425$state->{args} = [2426sort{2427# Sort priority: by directory depth, then actual file name:2428my@piecesA=split('/',$a);2429my@piecesB=split('/',$b);24302431my$count=scalar(@piecesA);2432my$tmp=scalar(@piecesB);2433return$count<=>$tmpif($count!=$tmp);24342435for($tmp=0;$tmp<$count;$tmp++)2436{2437if($piecesA[$tmp]ne$piecesB[$tmp])2438{2439return$piecesA[$tmp]cmp$piecesB[$tmp]2440}2441}2442return0;2443}keys(%allArgs) ];2444}24452446## look up directory sticky tag, of either fullPath or a parent:2447sub getDirStickyInfo2448{2449my($fullPath)=@_;24502451$fullPath=~s%/+$%%;2452while($fullPathne""&& !defined($state->{dirMap}{"$fullPath/"}))2453{2454$fullPath=~s%/?[^/]*$%%;2455}24562457if( !defined($state->{dirMap}{"$fullPath/"}) &&2458($fullPatheq""||2459$fullPatheq".") )2460{2461return$state->{dirMap}{""}{stickyInfo};2462}2463else2464{2465return$state->{dirMap}{"$fullPath/"}{stickyInfo};2466}2467}24682469# Resolve precedence of various ways of specifying which version of2470# a file you want. Returns undef (for default head), or a ref to a hash2471# that contains "tag" and/or "date" keys.2472sub resolveStickyInfo2473{2474my($filename,$stickyTag,$stickyDate,$reset) =@_;24752476# Order of precedence of sticky tags:2477# -A [head]2478# -r /tag/2479# [file entry sticky tag]2480# [the tag specified in dir req_Sticky]2481# [the tag specified in a parent dir req_Sticky]2482# [head]24832484my$result;2485if($reset)2486{2487# $result=undef;2488}2489elsif(defined($stickyTag) &&$stickyTagne"")2490# || ( defined($stickyDate) && $stickyDate ne "" ) # TODO2491{2492$result={'tag'=> (defined($stickyTag)?$stickyTag:undef) };24932494# TODO: Convert -D value into the form 2011.04.10.04.46.57,2495# similar to an entry line's sticky date, without the D prefix.2496# It sometimes (always?) arrives as something more like2497# '10 Apr 2011 04:46:57 -0000'...2498# $result={ 'date' => (defined($stickyDate)?$stickyDate:undef) };2499}2500elsif(defined($state->{entries}{$filename}) &&2501defined($state->{entries}{$filename}{tag_or_date}) &&2502$state->{entries}{$filename}{tag_or_date}ne"")2503{2504my($tagOrDate)=$state->{entries}{$filename}{tag_or_date};2505if($tagOrDate=~/^T([^ ]+)\s*$/)2506{2507$result= {'tag'=>$1};2508}2509elsif($tagOrDate=~/^D([0-9.]+)\s*$/)2510{2511$result= {'date'=>$1};2512}2513else2514{2515die"Unknown tag_or_date format\n";2516}2517}2518else2519{2520$result=getDirStickyInfo($filename);2521}25222523return$result;2524}25252526# Convert a stickyInfo (ref to a hash) as returned by resolveStickyInfo into2527# a form appropriate for the sticky tag field of an Entries2528# line (field index 5, 0-based).2529sub getStickyTagOrDate2530{2531my($stickyInfo)=@_;25322533my$result;2534if(defined($stickyInfo) &&defined($stickyInfo->{tag}))2535{2536$result="T$stickyInfo->{tag}";2537}2538# TODO: When/if we actually pick versions by {date} properly,2539# also handle it here:2540# "D$stickyInfo->{date}" (example: "D2011.04.13.20.37.07").2541else2542{2543$result="";2544}25452546return$result;2547}25482549# This method cleans up the $state variable after a command that uses arguments has run2550sub statecleanup2551{2552$state->{files} = [];2553$state->{dirArgs} = {};2554$state->{args} = [];2555$state->{arguments} = [];2556$state->{entries} = {};2557$state->{dirMap} = {};2558}25592560# Return working directory CVS revision "1.X" out2561# of the the working directory "entries" state, for the given filename.2562# This is prefixed with a dash if the file is scheduled for removal2563# when it is committed.2564sub revparse2565{2566my$filename=shift;25672568return$state->{entries}{$filename}{revision};2569}25702571# This method takes a file hash and does a CVS "file transfer". Its2572# exact behaviour depends on a second, optional hash table argument:2573# - If $options->{targetfile}, dump the contents to that file;2574# - If $options->{print}, use M/MT to transmit the contents one line2575# at a time;2576# - Otherwise, transmit the size of the file, followed by the file2577# contents.2578sub transmitfile2579{2580my$filehash=shift;2581my$options=shift;25822583if(defined($filehash)and$filehasheq"deleted")2584{2585$log->warn("filehash is 'deleted'");2586return;2587}25882589die"Need filehash"unless(defined($filehash)and$filehash=~/^[a-zA-Z0-9]{40}$/);25902591my$type=`git cat-file -t$filehash`;2592 chomp$type;25932594 die ( "Invalid type '$type' (expected 'blob')" ) unless ( defined ($type) and$typeeq "blob" );25952596 my$size= `git cat-file -s $filehash`;2597chomp$size;25982599$log->debug("transmitfile($filehash) size=$size, type=$type");26002601if(open my$fh,'-|',"git","cat-file","blob",$filehash)2602{2603if(defined($options->{targetfile} ) )2604{2605my$targetfile=$options->{targetfile};2606open NEWFILE,">",$targetfileor die("Couldn't open '$targetfile' for writing :$!");2607print NEWFILE $_while( <$fh> );2608close NEWFILE or die("Failed to write '$targetfile':$!");2609}elsif(defined($options->{print} ) &&$options->{print} ) {2610while( <$fh> ) {2611if(/\n\z/) {2612print'M ',$_;2613}else{2614print'MT text ',$_,"\n";2615}2616}2617}else{2618print"$size\n";2619printwhile( <$fh> );2620}2621close$fhor die("Couldn't close filehandle for transmitfile():$!");2622}else{2623die("Couldn't execute git-cat-file");2624}2625}26262627# This method takes a file name, and returns ( $dirpart, $filepart ) which2628# refers to the directory portion and the file portion of the filename2629# respectively2630sub filenamesplit2631{2632my$filename=shift;2633my$fixforlocaldir=shift;26342635my($filepart,$dirpart) = ($filename,".");2636($filepart,$dirpart) = ($2,$1)if($filename=~/(.*)\/(.*)/ );2637$dirpart.="/";26382639if($fixforlocaldir)2640{2641$dirpart=~s/^$state->{prependdir}//;2642}26432644return($filepart,$dirpart);2645}26462647# Cleanup various junk in filename (try to canonicalize it), and2648# add prependdir to accomodate running CVS client from a2649# subdirectory (so the output is relative to top directory of the project).2650sub filecleanup2651{2652my$filename=shift;26532654returnundefunless(defined($filename));2655if($filename=~/^\// )2656{2657print"E absolute filenames '$filename' not supported by server\n";2658returnundef;2659}26602661if($filenameeq".")2662{2663$filename="";2664}2665$filename=~s/^\.\///g;2666$filename=~ s%/+%/%g;2667$filename=$state->{prependdir} .$filename;2668$filename=~ s%/$%%;2669return$filename;2670}26712672# Remove prependdir from the path, so that is is relative to the directory2673# the CVS client was started from, rather than the top of the project.2674# Essentially the inverse of filecleanup().2675sub remove_prependdir2676{2677my($path) =@_;2678if(defined($state->{prependdir}) &&$state->{prependdir}ne"")2679{2680my($pre)=$state->{prependdir};2681$pre=~s%/$%%;2682if(!($path=~s%^\Q$pre\E/?%%))2683{2684$log->fatal("internal error missing prependdir");2685die("internal error missing prependdir");2686}2687}2688return$path;2689}26902691sub validateGitDir2692{2693if( !defined($state->{CVSROOT}) )2694{2695print"error 1 CVSROOT not specified\n";2696 cleanupWorkTree();2697exit;2698}2699if($ENV{GIT_DIR}ne($state->{CVSROOT} .'/') )2700{2701print"error 1 Internally inconsistent CVSROOT\n";2702 cleanupWorkTree();2703exit;2704}2705}27062707# Setup working directory in a work tree with the requested version2708# loaded in the index.2709sub setupWorkTree2710{2711my($ver) =@_;27122713 validateGitDir();27142715if( (defined($work->{state}) &&$work->{state} !=1) ||2716defined($work->{tmpDir}) )2717{2718$log->warn("Bad work tree state management");2719print"error 1 Internal setup multiple work trees without cleanup\n";2720 cleanupWorkTree();2721exit;2722}27232724$work->{workDir} = tempdir ( DIR =>$TEMP_DIR);27252726if( !defined($work->{index}) )2727{2728(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2729}27302731chdir$work->{workDir}or2732die"Unable to chdir to$work->{workDir}\n";27332734$log->info("Setting up GIT_WORK_TREE as '.' in '$work->{workDir}', index file is '$work->{index}'");27352736$ENV{GIT_WORK_TREE} =".";2737$ENV{GIT_INDEX_FILE} =$work->{index};2738$work->{state} =2;27392740if($ver)2741{2742system("git","read-tree",$ver);2743unless($?==0)2744{2745$log->warn("Error running git-read-tree");2746die"Error running git-read-tree$verin$work->{workDir}$!\n";2747}2748}2749# else # req_annotate reads tree for each file2750}27512752# Ensure current directory is in some kind of working directory,2753# with a recent version loaded in the index.2754sub ensureWorkTree2755{2756if(defined($work->{tmpDir}) )2757{2758$log->warn("Bad work tree state management [ensureWorkTree()]");2759print"error 1 Internal setup multiple dirs without cleanup\n";2760 cleanupWorkTree();2761exit;2762}2763if($work->{state} )2764{2765return;2766}27672768 validateGitDir();27692770if( !defined($work->{emptyDir}) )2771{2772$work->{emptyDir} = tempdir ( DIR =>$TEMP_DIR, OPEN =>0);2773}2774chdir$work->{emptyDir}or2775die"Unable to chdir to$work->{emptyDir}\n";27762777my$ver=`git show-ref -s refs/heads/$state->{module}`;2778chomp$ver;2779if($ver!~/^[0-9a-f]{40}$/)2780{2781$log->warn("Error from git show-ref -s refs/head$state->{module}");2782print"error 1 cannot find the current HEAD of module";2783 cleanupWorkTree();2784exit;2785}27862787if( !defined($work->{index}) )2788{2789(undef,$work->{index}) = tempfile ( DIR =>$TEMP_DIR, OPEN =>0);2790}27912792$ENV{GIT_WORK_TREE} =".";2793$ENV{GIT_INDEX_FILE} =$work->{index};2794$work->{state} =1;27952796system("git","read-tree",$ver);2797unless($?==0)2798{2799die"Error running git-read-tree$ver$!\n";2800}2801}28022803# Cleanup working directory that is not needed any longer.2804sub cleanupWorkTree2805{2806if( !$work->{state} )2807{2808return;2809}28102811chdir"/"or die"Unable to chdir '/'\n";28122813if(defined($work->{workDir}) )2814{2815 rmtree($work->{workDir} );2816undef$work->{workDir};2817}2818undef$work->{state};2819}28202821# Setup a temporary directory (not a working tree), typically for2822# merging dirty state as in req_update.2823sub setupTmpDir2824{2825$work->{tmpDir} = tempdir ( DIR =>$TEMP_DIR);2826chdir$work->{tmpDir}or die"Unable to chdir$work->{tmpDir}\n";28272828return$work->{tmpDir};2829}28302831# Clean up a previously setupTmpDir. Restore previous work tree if2832# appropriate.2833sub cleanupTmpDir2834{2835if( !defined($work->{tmpDir}) )2836{2837$log->warn("cleanup tmpdir that has not been setup");2838die"Cleanup tmpDir that has not been setup\n";2839}2840if(defined($work->{state}) )2841{2842if($work->{state} ==1)2843{2844chdir$work->{emptyDir}or2845die"Unable to chdir to$work->{emptyDir}\n";2846}2847elsif($work->{state} ==2)2848{2849chdir$work->{workDir}or2850die"Unable to chdir to$work->{emptyDir}\n";2851}2852else2853{2854$log->warn("Inconsistent work dir state");2855die"Inconsistent work dir state\n";2856}2857}2858else2859{2860chdir"/"or die"Unable to chdir '/'\n";2861}2862}28632864# Given a path, this function returns a string containing the kopts2865# that should go into that path's Entries line. For example, a binary2866# file should get -kb.2867sub kopts_from_path2868{2869my($path,$srcType,$name) =@_;28702871if(defined($cfg->{gitcvs}{usecrlfattr} )and2872$cfg->{gitcvs}{usecrlfattr} =~/\s*(1|true|yes)\s*$/i)2873{2874my($val) = check_attr("text",$path);2875if($valeq"unspecified")2876{2877$val= check_attr("crlf",$path);2878}2879if($valeq"unset")2880{2881return"-kb"2882}2883elsif( check_attr("eol",$path)ne"unspecified"||2884$valeq"set"||$valeq"input")2885{2886return"";2887}2888else2889{2890$log->info("Unrecognized check_attr crlf$path:$val");2891}2892}28932894if(defined($cfg->{gitcvs}{allbinary} ) )2895{2896if( ($cfg->{gitcvs}{allbinary} =~/^\s*(1|true|yes)\s*$/i) )2897{2898return"-kb";2899}2900elsif( ($cfg->{gitcvs}{allbinary} =~/^\s*guess\s*$/i) )2901{2902if( is_binary($srcType,$name) )2903{2904$log->debug("... as binary");2905return"-kb";2906}2907else2908{2909$log->debug("... as text");2910}2911}2912}2913# Return "" to give no special treatment to any path2914return"";2915}29162917sub check_attr2918{2919my($attr,$path) =@_;2920 ensureWorkTree();2921if(open my$fh,'-|',"git","check-attr",$attr,"--",$path)2922{2923my$val= <$fh>;2924close$fh;2925$val=~s/.*: ([^:\r\n]*)\s*$/$1/;2926return$val;2927}2928else2929{2930returnundef;2931}2932}29332934# This should have the same heuristics as convert.c:is_binary() and related.2935# Note that the bare CR test is done by callers in convert.c.2936sub is_binary2937{2938my($srcType,$name) =@_;2939$log->debug("is_binary($srcType,$name)");29402941# Minimize amount of interpreted code run in the inner per-character2942# loop for large files, by totalling each character value and2943# then analyzing the totals.2944my@counts;2945my$i;2946for($i=0;$i<256;$i++)2947{2948$counts[$i]=0;2949}29502951my$fh= open_blob_or_die($srcType,$name);2952my$line;2953while(defined($line=<$fh>) )2954{2955# Any '\0' and bare CR are considered binary.2956if($line=~/\0|(\r[^\n])/)2957{2958close($fh);2959return1;2960}29612962# Count up each character in the line:2963my$len=length($line);2964for($i=0;$i<$len;$i++)2965{2966$counts[ord(substr($line,$i,1))]++;2967}2968}2969close$fh;29702971# Don't count CR and LF as either printable/nonprintable2972$counts[ord("\n")]=0;2973$counts[ord("\r")]=0;29742975# Categorize individual character count into printable and nonprintable:2976my$printable=0;2977my$nonprintable=0;2978for($i=0;$i<256;$i++)2979{2980if($i<32&&2981$i!=ord("\b") &&2982$i!=ord("\t") &&2983$i!=033&&# ESC2984$i!=014)# FF2985{2986$nonprintable+=$counts[$i];2987}2988elsif($i==127)# DEL2989{2990$nonprintable+=$counts[$i];2991}2992else2993{2994$printable+=$counts[$i];2995}2996}29972998return($printable>>7) <$nonprintable;2999}30003001# Returns open file handle. Possible invocations:3002# - open_blob_or_die("file",$filename);3003# - open_blob_or_die("sha1",$filehash);3004sub open_blob_or_die3005{3006my($srcType,$name) =@_;3007my($fh);3008if($srcTypeeq"file")3009{3010if( !open$fh,"<",$name)3011{3012$log->warn("Unable to open file$name:$!");3013die"Unable to open file$name:$!\n";3014}3015}3016elsif($srcTypeeq"sha1")3017{3018unless(defined($name)and$name=~/^[a-zA-Z0-9]{40}$/)3019{3020$log->warn("Need filehash");3021die"Need filehash\n";3022}30233024my$type=`git cat-file -t$name`;3025 chomp$type;30263027 unless ( defined ($type) and$typeeq "blob" )3028 {3029$log->warn("Invalid type '$type' for '$name'");3030 die ( "Invalid type '$type' (expected 'blob')" )3031 }30323033 my$size= `git cat-file -s $name`;3034chomp$size;30353036$log->debug("open_blob_or_die($name) size=$size, type=$type");30373038unless(open$fh,'-|',"git","cat-file","blob",$name)3039{3040$log->warn("Unable to open sha1$name");3041die"Unable to open sha1$name\n";3042}3043}3044else3045{3046$log->warn("Unknown type of blob source:$srcType");3047die"Unknown type of blob source:$srcType\n";3048}3049return$fh;3050}30513052# Generate a CVS author name from Git author information, by taking the local3053# part of the email address and replacing characters not in the Portable3054# Filename Character Set (see IEEE Std 1003.1-2001, 3.276) by underscores. CVS3055# Login names are Unix login names, which should be restricted to this3056# character set.3057sub cvs_author3058{3059my$author_line=shift;3060(my$author) =$author_line=~/<([^@>]*)/;30613062$author=~s/[^-a-zA-Z0-9_.]/_/g;3063$author=~s/^-/_/;30643065$author;3066}306730683069sub descramble3070{3071# This table is from src/scramble.c in the CVS source3072my@SHIFTS= (30730,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,307416,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,3075114,120,53,79,96,109,72,108,70,64,76,67,116,74,68,87,3076111,52,75,119,49,34,82,81,95,65,112,86,118,110,122,105,307741,57,83,43,46,102,40,89,38,103,45,50,42,123,91,35,3078125,55,54,66,124,126,59,47,92,71,115,78,88,107,106,56,307936,121,117,104,101,100,69,73,99,63,94,93,39,37,61,48,308058,113,32,90,44,98,60,51,33,97,62,77,84,80,85,223,3081225,216,187,166,229,189,222,188,141,249,148,200,184,136,248,190,3082199,170,181,204,138,232,218,183,255,234,220,247,213,203,226,193,3083174,172,228,252,217,201,131,230,197,211,145,238,161,179,160,212,3084207,221,254,173,202,146,224,151,140,196,205,130,135,133,143,246,3085192,159,244,239,185,168,215,144,139,165,180,157,147,186,214,176,3086227,231,219,169,175,156,206,198,129,164,150,210,154,177,134,127,3087182,128,158,208,162,132,167,209,149,241,153,251,237,236,171,195,3088243,233,253,240,194,250,191,155,142,137,245,235,163,242,178,1523089);3090my($str) =@_;30913092# This should never happen, the same password format (A) has been3093# used by CVS since the beginning of time3094{3095my$fmt=substr($str,0,1);3096die"invalid password format `$fmt'"unless$fmteq'A';3097}30983099my@str=unpack"C*",substr($str,1);3100my$ret=join'',map{chr$SHIFTS[$_] }@str;3101return$ret;3102}310331043105package GITCVS::log;31063107####3108#### Copyright The Open University UK - 2006.3109####3110#### Authors: Martyn Smith <martyn@catalyst.net.nz>3111#### Martin Langhoff <martin@laptop.org>3112####3113####31143115use strict;3116use warnings;31173118=head1 NAME31193120GITCVS::log31213122=head1 DESCRIPTION31233124This module provides very crude logging with a similar interface to3125Log::Log4perl31263127=head1 METHODS31283129=cut31303131=head2 new31323133Creates a new log object, optionally you can specify a filename here to3134indicate the file to log to. If no log file is specified, you can specify one3135later with method setfile, or indicate you no longer want logging with method3136nofile.31373138Until one of these methods is called, all log calls will buffer messages ready3139to write out.31403141=cut3142sub new3143{3144my$class=shift;3145my$filename=shift;31463147my$self= {};31483149bless$self,$class;31503151if(defined($filename) )3152{3153open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");3154}31553156return$self;3157}31583159=head2 setfile31603161This methods takes a filename, and attempts to open that file as the log file.3162If successful, all buffered data is written out to the file, and any further3163logging is written directly to the file.31643165=cut3166sub setfile3167{3168my$self=shift;3169my$filename=shift;31703171if(defined($filename) )3172{3173open$self->{fh},">>",$filenameor die("Couldn't open '$filename' for writing :$!");3174}31753176return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");31773178while(my$line=shift@{$self->{buffer}} )3179{3180print{$self->{fh}}$line;3181}3182}31833184=head2 nofile31853186This method indicates no logging is going to be used. It flushes any entries in3187the internal buffer, and sets a flag to ensure no further data is put there.31883189=cut3190sub nofile3191{3192my$self=shift;31933194$self->{nolog} =1;31953196return unless(defined($self->{buffer} )and ref$self->{buffer}eq"ARRAY");31973198$self->{buffer} = [];3199}32003201=head2 _logopen32023203Internal method. Returns true if the log file is open, false otherwise.32043205=cut3206sub _logopen3207{3208my$self=shift;32093210return1if(defined($self->{fh} )and ref$self->{fh}eq"GLOB");3211return0;3212}32133214=head2 debug info warn fatal32153216These four methods are wrappers to _log. They provide the actual interface for3217logging data.32183219=cut3220sub debug {my$self=shift;$self->_log("debug",@_); }3221sub info {my$self=shift;$self->_log("info",@_); }3222subwarn{my$self=shift;$self->_log("warn",@_); }3223sub fatal {my$self=shift;$self->_log("fatal",@_); }32243225=head2 _log32263227This is an internal method called by the logging functions. It generates a3228timestamp and pushes the logged line either to file, or internal buffer.32293230=cut3231sub _log3232{3233my$self=shift;3234my$level=shift;32353236return if($self->{nolog} );32373238my@time=localtime;3239my$timestring=sprintf("%4d-%02d-%02d%02d:%02d:%02d: %-5s",3240$time[5] +1900,3241$time[4] +1,3242$time[3],3243$time[2],3244$time[1],3245$time[0],3246uc$level,3247);32483249if($self->_logopen)3250{3251print{$self->{fh}}$timestring." - ".join(" ",@_) ."\n";3252}else{3253push@{$self->{buffer}},$timestring." - ".join(" ",@_) ."\n";3254}3255}32563257=head2 DESTROY32583259This method simply closes the file handle if one is open32603261=cut3262sub DESTROY3263{3264my$self=shift;32653266if($self->_logopen)3267{3268close$self->{fh};3269}3270}32713272package GITCVS::updater;32733274####3275#### Copyright The Open University UK - 2006.3276####3277#### Authors: Martyn Smith <martyn@catalyst.net.nz>3278#### Martin Langhoff <martin@laptop.org>3279####3280####32813282use strict;3283use warnings;3284use DBI;32853286=head1 METHODS32873288=cut32893290=head2 new32913292=cut3293sub new3294{3295my$class=shift;3296my$config=shift;3297my$module=shift;3298my$log=shift;32993300die"Need to specify a git repository"unless(defined($config)and-d $config);3301die"Need to specify a module"unless(defined($module) );33023303$class=ref($class) ||$class;33043305my$self= {};33063307bless$self,$class;33083309$self->{valid_tables} = {'revision'=>1,3310'revision_ix1'=>1,3311'revision_ix2'=>1,3312'head'=>1,3313'head_ix1'=>1,3314'properties'=>1,3315'commitmsgs'=>1};33163317$self->{module} =$module;3318$self->{git_path} =$config."/";33193320$self->{log} =$log;33213322die"Git repo '$self->{git_path}' doesn't exist"unless( -d $self->{git_path} );33233324# Stores full sha1's for various branch/tag names, abbreviations, etc:3325$self->{commitRefCache} = {};33263327$self->{dbdriver} =$cfg->{gitcvs}{$state->{method}}{dbdriver} ||3328$cfg->{gitcvs}{dbdriver} ||"SQLite";3329$self->{dbname} =$cfg->{gitcvs}{$state->{method}}{dbname} ||3330$cfg->{gitcvs}{dbname} ||"%Ggitcvs.%m.sqlite";3331$self->{dbuser} =$cfg->{gitcvs}{$state->{method}}{dbuser} ||3332$cfg->{gitcvs}{dbuser} ||"";3333$self->{dbpass} =$cfg->{gitcvs}{$state->{method}}{dbpass} ||3334$cfg->{gitcvs}{dbpass} ||"";3335$self->{dbtablenameprefix} =$cfg->{gitcvs}{$state->{method}}{dbtablenameprefix} ||3336$cfg->{gitcvs}{dbtablenameprefix} ||"";3337my%mapping= ( m =>$module,3338 a =>$state->{method},3339 u =>getlogin||getpwuid($<) || $<,3340 G =>$self->{git_path},3341 g => mangle_dirname($self->{git_path}),3342);3343$self->{dbname} =~s/%([mauGg])/$mapping{$1}/eg;3344$self->{dbuser} =~s/%([mauGg])/$mapping{$1}/eg;3345$self->{dbtablenameprefix} =~s/%([mauGg])/$mapping{$1}/eg;3346$self->{dbtablenameprefix} = mangle_tablename($self->{dbtablenameprefix});33473348die"Invalid char ':' in dbdriver"if$self->{dbdriver} =~/:/;3349die"Invalid char ';' in dbname"if$self->{dbname} =~/;/;3350$self->{dbh} = DBI->connect("dbi:$self->{dbdriver}:dbname=$self->{dbname}",3351$self->{dbuser},3352$self->{dbpass});3353die"Error connecting to database\n"unlessdefined$self->{dbh};33543355$self->{tables} = {};3356foreachmy$table(keys%{$self->{dbh}->table_info(undef,undef,undef,'TABLE')->fetchall_hashref('TABLE_NAME')} )3357{3358$self->{tables}{$table} =1;3359}33603361# Construct the revision table if required3362# The revision table stores an entry for each file, each time that file3363# changes.3364# numberOfRecords = O( numCommits * averageNumChangedFilesPerCommit )3365# This is not sufficient to support "-r {commithash}" for any3366# files except files that were modified by that commit (also,3367# some places in the code ignore/effectively strip out -r in3368# some cases, before it gets passed to getmeta()).3369# The "filehash" field typically has a git blob hash, but can also3370# be set to "dead" to indicate that the given version of the file3371# should not exist in the sandbox.3372unless($self->{tables}{$self->tablename("revision")} )3373{3374my$tablename=$self->tablename("revision");3375my$ix1name=$self->tablename("revision_ix1");3376my$ix2name=$self->tablename("revision_ix2");3377$self->{dbh}->do("3378 CREATE TABLE$tablename(3379 name TEXT NOT NULL,3380 revision INTEGER NOT NULL,3381 filehash TEXT NOT NULL,3382 commithash TEXT NOT NULL,3383 author TEXT NOT NULL,3384 modified TEXT NOT NULL,3385 mode TEXT NOT NULL3386 )3387 ");3388$self->{dbh}->do("3389 CREATE INDEX$ix1name3390 ON$tablename(name,revision)3391 ");3392$self->{dbh}->do("3393 CREATE INDEX$ix2name3394 ON$tablename(name,commithash)3395 ");3396}33973398# Construct the head table if required3399# The head table (along with the "last_commit" entry in the property3400# table) is the persisted working state of the "sub update" subroutine.3401# All of it's data is read entirely first, and completely recreated3402# last, every time "sub update" runs.3403# This is also used by "sub getmeta" when it is asked for the latest3404# version of a file (as opposed to some specific version).3405# Another way of thinking about it is as a single slice out of3406# "revisions", giving just the most recent revision information for3407# each file.3408unless($self->{tables}{$self->tablename("head")} )3409{3410my$tablename=$self->tablename("head");3411my$ix1name=$self->tablename("head_ix1");3412$self->{dbh}->do("3413 CREATE TABLE$tablename(3414 name TEXT NOT NULL,3415 revision INTEGER NOT NULL,3416 filehash TEXT NOT NULL,3417 commithash TEXT NOT NULL,3418 author TEXT NOT NULL,3419 modified TEXT NOT NULL,3420 mode TEXT NOT NULL3421 )3422 ");3423$self->{dbh}->do("3424 CREATE INDEX$ix1name3425 ON$tablename(name)3426 ");3427}34283429# Construct the properties table if required3430# - "last_commit" - Used by "sub update".3431unless($self->{tables}{$self->tablename("properties")} )3432{3433my$tablename=$self->tablename("properties");3434$self->{dbh}->do("3435 CREATE TABLE$tablename(3436 key TEXT NOT NULL PRIMARY KEY,3437 value TEXT3438 )3439 ");3440}34413442# Construct the commitmsgs table if required3443# The commitmsgs table is only used for merge commits, since3444# "sub update" will only keep one branch of parents. Shortlogs3445# for ignored commits (i.e. not on the chosen branch) will be used3446# to construct a replacement "collapsed" merge commit message,3447# which will be stored in this table. See also "sub commitmessage".3448unless($self->{tables}{$self->tablename("commitmsgs")} )3449{3450my$tablename=$self->tablename("commitmsgs");3451$self->{dbh}->do("3452 CREATE TABLE$tablename(3453 key TEXT NOT NULL PRIMARY KEY,3454 value TEXT3455 )3456 ");3457}34583459return$self;3460}34613462=head2 tablename34633464=cut3465sub tablename3466{3467my$self=shift;3468my$name=shift;34693470if(exists$self->{valid_tables}{$name}) {3471return$self->{dbtablenameprefix} .$name;3472}else{3473returnundef;3474}3475}34763477=head2 update34783479Bring the database up to date with the latest changes from3480the git repository.34813482Internal working state is read out of the "head" table and the3483"last_commit" property, then it updates "revisions" based on that, and3484finally it writes the new internal state back to the "head" table3485so it can be used as a starting point the next time update is called.34863487=cut3488sub update3489{3490my$self=shift;34913492# first lets get the commit list3493$ENV{GIT_DIR} =$self->{git_path};34943495my$commitsha1=`git rev-parse$self->{module}`;3496chomp$commitsha1;34973498my$commitinfo=`git cat-file commit$self->{module} 2>&1`;3499unless($commitinfo=~/tree\s+[a-zA-Z0-9]{40}/)3500{3501die("Invalid module '$self->{module}'");3502}350335043505my$git_log;3506my$lastcommit=$self->_get_prop("last_commit");35073508if(defined$lastcommit&&$lastcommiteq$commitsha1) {# up-to-date3509return1;3510}35113512# Start exclusive lock here...3513$self->{dbh}->begin_work()or die"Cannot lock database for BEGIN";35143515# TODO: log processing is memory bound3516# if we can parse into a 2nd file that is in reverse order3517# we can probably do something really efficient3518my@git_log_params= ('--pretty','--parents','--topo-order');35193520if(defined$lastcommit) {3521push@git_log_params,"$lastcommit..$self->{module}";3522}else{3523push@git_log_params,$self->{module};3524}3525# git-rev-list is the backend / plumbing version of git-log3526open(my$gitLogPipe,'-|','git','rev-list',@git_log_params)3527or die"Cannot call git-rev-list:$!";3528my@commits=readCommits($gitLogPipe);3529close$gitLogPipe;35303531# Now all the commits are in the @commits bucket3532# ordered by time DESC. for each commit that needs processing,3533# determine whether it's following the last head we've seen or if3534# it's on its own branch, grab a file list, and add whatever's changed3535# NOTE: $lastcommit refers to the last commit from previous run3536# $lastpicked is the last commit we picked in this run3537my$lastpicked;3538my$head= {};3539if(defined$lastcommit) {3540$lastpicked=$lastcommit;3541}35423543my$committotal=scalar(@commits);3544my$commitcount=0;35453546# Load the head table into $head (for cached lookups during the update process)3547foreachmy$file( @{$self->gethead(1)} )3548{3549$head->{$file->{name}} =$file;3550}35513552foreachmy$commit(@commits)3553{3554$self->{log}->debug("GITCVS::updater - Processing commit$commit->{hash} (". (++$commitcount) ." of$committotal)");3555if(defined$lastpicked)3556{3557if(!in_array($lastpicked, @{$commit->{parents}}))3558{3559# skip, we'll see this delta3560# as part of a merge later3561# warn "skipping off-track $commit->{hash}\n";3562next;3563}elsif(@{$commit->{parents}} >1) {3564# it is a merge commit, for each parent that is3565# not $lastpicked (not given a CVS revision number),3566# see if we can get a log3567# from the merge-base to that parent to put it3568# in the message as a merge summary.3569my@parents= @{$commit->{parents}};3570foreachmy$parent(@parents) {3571if($parenteq$lastpicked) {3572next;3573}3574# git-merge-base can potentially (but rarely) throw3575# several candidate merge bases. let's assume3576# that the first one is the best one.3577my$base=eval{3578 safe_pipe_capture('git','merge-base',3579$lastpicked,$parent);3580};3581# The two branches may not be related at all,3582# in which case merge base simply fails to find3583# any, but that's Ok.3584next if($@);35853586chomp$base;3587if($base) {3588my@merged;3589# print "want to log between $base $parent \n";3590open(GITLOG,'-|','git','log','--pretty=medium',"$base..$parent")3591or die"Cannot call git-log:$!";3592my$mergedhash;3593while(<GITLOG>) {3594chomp;3595if(!defined$mergedhash) {3596if(m/^commit\s+(.+)$/) {3597$mergedhash=$1;3598}else{3599next;3600}3601}else{3602# grab the first line that looks non-rfc8223603# aka has content after leading space3604if(m/^\s+(\S.*)$/) {3605my$title=$1;3606$title=substr($title,0,100);# truncate3607unshift@merged,"$mergedhash$title";3608undef$mergedhash;3609}3610}3611}3612close GITLOG;3613if(@merged) {3614$commit->{mergemsg} =$commit->{message};3615$commit->{mergemsg} .="\nSummary of merged commits:\n\n";3616foreachmy$summary(@merged) {3617$commit->{mergemsg} .="\t$summary\n";3618}3619$commit->{mergemsg} .="\n\n";3620# print "Message for $commit->{hash} \n$commit->{mergemsg}";3621}3622}3623}3624}3625}36263627# convert the date to CVS-happy format3628my$cvsDate= convertToCvsDate($commit->{date});36293630if(defined($lastpicked) )3631{3632my$filepipe=open(FILELIST,'-|','git','diff-tree','-z','-r',$lastpicked,$commit->{hash})or die("Cannot call git-diff-tree :$!");3633local($/) ="\0";3634while( <FILELIST> )3635{3636chomp;3637unless(/^:\d{6}\s+([0-7]{6})\s+[a-f0-9]{40}\s+([a-f0-9]{40})\s+(\w)$/o)3638{3639die("Couldn't process git-diff-tree line :$_");3640}3641my($mode,$hash,$change) = ($1,$2,$3);3642my$name= <FILELIST>;3643chomp($name);36443645# $log->debug("File mode=$mode, hash=$hash, change=$change, name=$name");36463647my$dbMode= convertToDbMode($mode);36483649if($changeeq"D")3650{3651#$log->debug("DELETE $name");3652$head->{$name} = {3653 name =>$name,3654 revision =>$head->{$name}{revision} +1,3655 filehash =>"deleted",3656 commithash =>$commit->{hash},3657 modified =>$cvsDate,3658 author =>$commit->{author},3659 mode =>$dbMode,3660};3661$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3662}3663elsif($changeeq"M"||$changeeq"T")3664{3665#$log->debug("MODIFIED $name");3666$head->{$name} = {3667 name =>$name,3668 revision =>$head->{$name}{revision} +1,3669 filehash =>$hash,3670 commithash =>$commit->{hash},3671 modified =>$cvsDate,3672 author =>$commit->{author},3673 mode =>$dbMode,3674};3675$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3676}3677elsif($changeeq"A")3678{3679#$log->debug("ADDED $name");3680$head->{$name} = {3681 name =>$name,3682 revision =>$head->{$name}{revision} ?$head->{$name}{revision}+1:1,3683 filehash =>$hash,3684 commithash =>$commit->{hash},3685 modified =>$cvsDate,3686 author =>$commit->{author},3687 mode =>$dbMode,3688};3689$self->insert_rev($name,$head->{$name}{revision},$hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3690}3691else3692{3693$log->warn("UNKNOWN FILE CHANGE mode=$mode, hash=$hash, change=$change, name=$name");3694die;3695}3696}3697close FILELIST;3698}else{3699# this is used to detect files removed from the repo3700my$seen_files= {};37013702my$filepipe=open(FILELIST,'-|','git','ls-tree','-z','-r',$commit->{hash})or die("Cannot call git-ls-tree :$!");3703local$/="\0";3704while( <FILELIST> )3705{3706chomp;3707unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)3708{3709die("Couldn't process git-ls-tree line :$_");3710}37113712my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);37133714$seen_files->{$git_filename} =1;37153716my($oldhash,$oldrevision,$oldmode) = (3717$head->{$git_filename}{filehash},3718$head->{$git_filename}{revision},3719$head->{$git_filename}{mode}3720);37213722my$dbMode= convertToDbMode($mode);37233724# unless the file exists with the same hash, we need to update it ...3725unless(defined($oldhash)and$oldhasheq$git_hashand defined($oldmode)and$oldmodeeq$dbMode)3726{3727my$newrevision= ($oldrevisionor0) +1;37283729$head->{$git_filename} = {3730 name =>$git_filename,3731 revision =>$newrevision,3732 filehash =>$git_hash,3733 commithash =>$commit->{hash},3734 modified =>$cvsDate,3735 author =>$commit->{author},3736 mode =>$dbMode,3737};373837393740$self->insert_rev($git_filename,$newrevision,$git_hash,$commit->{hash},$cvsDate,$commit->{author},$dbMode);3741}3742}3743close FILELIST;37443745# Detect deleted files3746foreachmy$file(keys%$head)3747{3748unless(exists$seen_files->{$file}or$head->{$file}{filehash}eq"deleted")3749{3750$head->{$file}{revision}++;3751$head->{$file}{filehash} ="deleted";3752$head->{$file}{commithash} =$commit->{hash};3753$head->{$file}{modified} =$cvsDate;3754$head->{$file}{author} =$commit->{author};37553756$self->insert_rev($file,$head->{$file}{revision},$head->{$file}{filehash},$commit->{hash},$cvsDate,$commit->{author},$head->{$file}{mode});3757}3758}3759# END : "Detect deleted files"3760}376137623763if(exists$commit->{mergemsg})3764{3765$self->insert_mergelog($commit->{hash},$commit->{mergemsg});3766}37673768$lastpicked=$commit->{hash};37693770$self->_set_prop("last_commit",$commit->{hash});3771}37723773$self->delete_head();3774foreachmy$file(keys%$head)3775{3776$self->insert_head(3777$file,3778$head->{$file}{revision},3779$head->{$file}{filehash},3780$head->{$file}{commithash},3781$head->{$file}{modified},3782$head->{$file}{author},3783$head->{$file}{mode},3784);3785}3786# invalidate the gethead cache3787$self->clearCommitRefCaches();378837893790# Ending exclusive lock here3791$self->{dbh}->commit()or die"Failed to commit changes to SQLite";3792}37933794sub readCommits3795{3796my$pipeHandle=shift;3797my@commits;37983799my%commit= ();38003801while( <$pipeHandle> )3802{3803chomp;3804if(m/^commit\s+(.*)$/) {3805# on ^commit lines put the just seen commit in the stack3806# and prime things for the next one3807if(keys%commit) {3808my%copy=%commit;3809unshift@commits, \%copy;3810%commit= ();3811}3812my@parents=split(m/\s+/,$1);3813$commit{hash} =shift@parents;3814$commit{parents} = \@parents;3815}elsif(m/^(\w+?):\s+(.*)$/&& !exists($commit{message})) {3816# on rfc822-like lines seen before we see any message,3817# lowercase the entry and put it in the hash as key-value3818$commit{lc($1)} =$2;3819}else{3820# message lines - skip initial empty line3821# and trim whitespace3822if(!exists($commit{message}) &&m/^\s*$/) {3823# define it to mark the end of headers3824$commit{message} ='';3825next;3826}3827s/^\s+//;s/\s+$//;# trim ws3828$commit{message} .=$_."\n";3829}3830}38313832unshift@commits, \%commitif(keys%commit);38333834return@commits;3835}38363837sub convertToCvsDate3838{3839my$date=shift;3840# Convert from: "git rev-list --pretty" formatted date3841# Convert to: "the format specified by RFC822 as modified by RFC1123."3842# Example: 26 May 1997 13:01:40 -04003843if($date=~/^\w+\s+(\w+)\s+(\d+)\s+(\d+:\d+:\d+)\s+(\d+)\s+([+-]\d+)$/)3844{3845$date="$2$1$4$3$5";3846}38473848return$date;3849}38503851sub convertToDbMode3852{3853my$mode=shift;38543855# NOTE: The CVS protocol uses a string similar "u=rw,g=rw,o=rw",3856# but the database "mode" column historically (and currently)3857# only stores the "rw" (for user) part of the string.3858# FUTURE: It might make more sense to persist the raw3859# octal mode (or perhaps the final full CVS form) instead of3860# this half-converted form, but it isn't currently worth the3861# backwards compatibility headaches.38623863$mode=~/^\d\d(\d)\d{3}$/;3864my$userBits=$1;38653866my$dbMode="";3867$dbMode.="r"if($userBits&4);3868$dbMode.="w"if($userBits&2);3869$dbMode.="x"if($userBits&1);3870$dbMode="rw"if($dbModeeq"");38713872return$dbMode;3873}38743875sub insert_rev3876{3877my$self=shift;3878my$name=shift;3879my$revision=shift;3880my$filehash=shift;3881my$commithash=shift;3882my$modified=shift;3883my$author=shift;3884my$mode=shift;3885my$tablename=$self->tablename("revision");38863887my$insert_rev=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3888$insert_rev->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3889}38903891sub insert_mergelog3892{3893my$self=shift;3894my$key=shift;3895my$value=shift;3896my$tablename=$self->tablename("commitmsgs");38973898my$insert_mergelog=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3899$insert_mergelog->execute($key,$value);3900}39013902sub delete_head3903{3904my$self=shift;3905my$tablename=$self->tablename("head");39063907my$delete_head=$self->{dbh}->prepare_cached("DELETE FROM$tablename",{},1);3908$delete_head->execute();3909}39103911sub insert_head3912{3913my$self=shift;3914my$name=shift;3915my$revision=shift;3916my$filehash=shift;3917my$commithash=shift;3918my$modified=shift;3919my$author=shift;3920my$mode=shift;3921my$tablename=$self->tablename("head");39223923my$insert_head=$self->{dbh}->prepare_cached("INSERT INTO$tablename(name, revision, filehash, commithash, modified, author, mode) VALUES (?,?,?,?,?,?,?)",{},1);3924$insert_head->execute($name,$revision,$filehash,$commithash,$modified,$author,$mode);3925}39263927sub _get_prop3928{3929my$self=shift;3930my$key=shift;3931my$tablename=$self->tablename("properties");39323933my$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);3934$db_query->execute($key);3935my($value) =$db_query->fetchrow_array;39363937return$value;3938}39393940sub _set_prop3941{3942my$self=shift;3943my$key=shift;3944my$value=shift;3945my$tablename=$self->tablename("properties");39463947my$db_query=$self->{dbh}->prepare_cached("UPDATE$tablenameSET value=? WHERE key=?",{},1);3948$db_query->execute($value,$key);39493950unless($db_query->rows)3951{3952$db_query=$self->{dbh}->prepare_cached("INSERT INTO$tablename(key, value) VALUES (?,?)",{},1);3953$db_query->execute($key,$value);3954}39553956return$value;3957}39583959=head2 gethead39603961=cut39623963sub gethead3964{3965my$self=shift;3966my$intRev=shift;3967my$tablename=$self->tablename("head");39683969return$self->{gethead_cache}if(defined($self->{gethead_cache} ) );39703971my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, mode, revision, modified, commithash, author FROM$tablenameORDER BY name ASC",{},1);3972$db_query->execute();39733974my$tree= [];3975while(my$file=$db_query->fetchrow_hashref)3976{3977if(!$intRev)3978{3979$file->{revision} ="1.$file->{revision}"3980}3981push@$tree,$file;3982}39833984$self->{gethead_cache} =$tree;39853986return$tree;3987}39883989=head2 getAnyHead39903991Returns a reference to an array of getmeta structures, one3992per file in the specified tree hash.39933994=cut39953996sub getAnyHead3997{3998my($self,$hash) =@_;39994000if(!defined($hash))4001{4002return$self->gethead();4003}40044005my@files;4006{4007open(my$filePipe,'-|','git','ls-tree','-z','-r',$hash)4008or die("Cannot call git-ls-tree :$!");4009local$/="\0";4010@files=<$filePipe>;4011close$filePipe;4012}40134014my$tree=[];4015my($line);4016foreach$line(@files)4017{4018$line=~s/\0$//;4019unless($line=~/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4020{4021die("Couldn't process git-ls-tree line :$_");4022}40234024my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);4025push@$tree,$self->getMetaFromCommithash($git_filename,$hash);4026}40274028return$tree;4029}40304031=head2 getRevisionDirMap40324033A "revision dir map" contains all the plain-file filenames associated4034with a particular revision (treeish), organized by directory:40354036 $type = $out->{$dir}{$fullName}40374038The type of each is "F" (for ordinary file) or "D" (for directory,4039for which the map $out->{$fullName} will also exist).40404041=cut40424043sub getRevisionDirMap4044{4045my($self,$ver)=@_;40464047if(!defined($self->{revisionDirMapCache}))4048{4049$self->{revisionDirMapCache}={};4050}40514052# Get file list (previously cached results are dependent on HEAD,4053# but are early in each case):4054my$cacheKey;4055my(@fileList);4056if( !defined($ver) ||$vereq"")4057{4058$cacheKey="";4059if(defined($self->{revisionDirMapCache}{$cacheKey}) )4060{4061return$self->{revisionDirMapCache}{$cacheKey};4062}40634064my@head= @{$self->gethead()};4065foreachmy$file(@head)4066{4067next if($file->{filehash}eq"deleted");40684069push@fileList,$file->{name};4070}4071}4072else4073{4074my($hash)=$self->lookupCommitRef($ver);4075if( !defined($hash) )4076{4077returnundef;4078}40794080$cacheKey=$hash;4081if(defined($self->{revisionDirMapCache}{$cacheKey}) )4082{4083return$self->{revisionDirMapCache}{$cacheKey};4084}40854086open(my$filePipe,'-|','git','ls-tree','-z','-r',$hash)4087or die("Cannot call git-ls-tree :$!");4088local$/="\0";4089while( <$filePipe> )4090{4091chomp;4092unless(/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4093{4094die("Couldn't process git-ls-tree line :$_");4095}40964097my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);40984099push@fileList,$git_filename;4100}4101close$filePipe;4102}41034104# Convert to normalized form:4105my%revMap;4106my$file;4107foreach$file(@fileList)4108{4109my($dir) = ($file=~m%^(?:(.*)/)?([^/]*)$%);4110$dir=''if(!defined($dir));41114112# parent directories:4113# ... create empty dir maps for parent dirs:4114my($td)=$dir;4115while(!defined($revMap{$td}))4116{4117$revMap{$td}={};41184119my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);4120$tp=''if(!defined($tp));4121$td=$tp;4122}4123# ... add children to parent maps (now that they exist):4124$td=$dir;4125while($tdne"")4126{4127my($tp)=($td=~m%^(?:(.*)/)?([^/]*)$%);4128$tp=''if(!defined($tp));41294130if(defined($revMap{$tp}{$td}))4131{4132if($revMap{$tp}{$td}ne'D')4133{4134die"Weird file/directory inconsistency in$cacheKey";4135}4136last;# loop exit4137}4138$revMap{$tp}{$td}='D';41394140$td=$tp;4141}41424143# file4144$revMap{$dir}{$file}='F';4145}41464147# Save in cache:4148$self->{revisionDirMapCache}{$cacheKey}=\%revMap;4149return$self->{revisionDirMapCache}{$cacheKey};4150}41514152=head2 getlog41534154See also gethistorydense().41554156=cut41574158sub getlog4159{4160my$self=shift;4161my$filename=shift;4162my$revFilter=shift;41634164my$tablename=$self->tablename("revision");41654166# Filters:4167# TODO: date, state, or by specific logins filters?4168# TODO: Handle comma-separated list of revFilter items, each item4169# can be a range [only case currently handled] or individual4170# rev or branch or "branch.".4171# TODO: Adjust $db_query WHERE clause based on revFilter, instead of4172# manually filtering the results of the query?4173my($minrev,$maxrev);4174if(defined($revFilter)and4175$state->{opt}{r} =~/^(1.(\d+))?(::?)(1.(\d.+))?$/)4176{4177my$control=$3;4178$minrev=$2;4179$maxrev=$5;4180$minrev++if(defined($minrev)and$controleq"::");4181}41824183my$db_query=$self->{dbh}->prepare_cached("SELECT name, filehash, author, mode, revision, modified, commithash FROM$tablenameWHERE name=? ORDER BY revision DESC",{},1);4184$db_query->execute($filename);41854186my$totalRevs=0;4187my$tree= [];4188while(my$file=$db_query->fetchrow_hashref)4189{4190$totalRevs++;4191if(defined($minrev)and$file->{revision} <$minrev)4192{4193next;4194}4195if(defined($maxrev)and$file->{revision} >$maxrev)4196{4197next;4198}41994200$file->{revision} ="1.".$file->{revision};4201push@$tree,$file;4202}42034204return($tree,$totalRevs);4205}42064207=head2 getmeta42084209This function takes a filename (with path) argument and returns a hashref of4210metadata for that file.42114212There are several ways $revision can be specified:42134214 - A reference to hash that contains a "tag" that is the4215 actual revision (one of the below). TODO: Also allow it to4216 specify a "date" in the hash.4217 - undef, to refer to the latest version on the main branch.4218 - Full CVS client revision number (mapped to integer in DB, without the4219 "1." prefix),4220 - Complex CVS-compatible "special" revision number for4221 non-linear history (see comment below)4222 - git commit sha1 hash4223 - branch or tag name42244225=cut42264227sub getmeta4228{4229my$self=shift;4230my$filename=shift;4231my$revision=shift;4232my$tablename_rev=$self->tablename("revision");4233my$tablename_head=$self->tablename("head");42344235if(ref($revision)eq"HASH")4236{4237$revision=$revision->{tag};4238}42394240# Overview of CVS revision numbers:4241#4242# General CVS numbering scheme:4243# - Basic mainline branch numbers: "1.1", "1.2", "1.3", etc.4244# - Result of "cvs checkin -r" (possible, but not really4245# recommended): "2.1", "2.2", etc4246# - Branch tag: "1.2.0.n", where "1.2" is revision it was branched4247# from, "0" is a magic placeholder that identifies it as a4248# branch tag instead of a version tag, and n is 2 times the4249# branch number off of "1.2", starting with "2".4250# - Version on a branch: "1.2.n.x", where "1.2" is branch-from, "n"4251# is branch number off of "1.2" (like n above), and "x" is4252# the version number on the branch.4253# - Branches can branch off of branches: "1.3.2.7.4.1" (even number4254# of components).4255# - Odd "n"s are used by "vendor branches" that result4256# from "cvs import". Vendor branches have additional4257# strangeness in the sense that the main rcs "head" of the main4258# branch will (temporarily until first normal commit) point4259# to the version on the vendor branch, rather than the actual4260# main branch. (FUTURE: This may provide an opportunity4261# to use "strange" revision numbers for fast-forward-merged4262# branch tip when CVS client is asking for the main branch.)4263#4264# git-cvsserver CVS-compatible special numbering schemes:4265# - Currently git-cvsserver only tries to be identical to CVS for4266# simple "1.x" numbers on the "main" branch (as identified4267# by the module name that was originally cvs checkout'ed).4268# - The database only stores the "x" part, for historical reasons.4269# But most of the rest of the cvsserver preserves4270# and thinks using the full revision number.4271# - To handle non-linear history, it uses a version of the form4272# "2.1.1.2000.b.b.b."..., where the 2.1.1.2000 is to help uniquely4273# identify this as a special revision number, and there are4274# 20 b's that together encode the sha1 git commit from which4275# this version of this file originated. Each b is4276# the numerical value of the corresponding byte plus4277# 100.4278# - "plus 100" avoids "0"s, and also reduces the4279# likelyhood of a collision in the case that someone someday4280# writes an import tool that tries to preserve original4281# CVS revision numbers, and the original CVS data had done4282# lots of branches off of branches and other strangeness to4283# end up with a real version number that just happens to look4284# like this special revision number form. Also, if needed4285# there are several ways to extend/identify alternative encodings4286# within the "2.1.1.2000" part if necessary.4287# - Unlike real CVS revisions, you can't really reconstruct what4288# relation a revision of this form has to other revisions.4289# - FUTURE: TODO: Rework database somehow to make up and remember4290# fully-CVS-compatible branches and branch version numbers.42914292my$meta;4293if(defined($revision) )4294{4295if($revision=~/^1\.(\d+)$/)4296{4297my($intRev) =$1;4298my$db_query;4299$db_query=$self->{dbh}->prepare_cached(4300"SELECT * FROM$tablename_revWHERE name=? AND revision=?",4301{},1);4302$db_query->execute($filename,$intRev);4303$meta=$db_query->fetchrow_hashref;4304}4305elsif($revision=~/^2\.1\.1\.2000(\.[1-3][0-9][0-9]){20}$/)4306{4307my($commitHash)=($revision=~/^2\.1\.1\.2000(.*)$/);4308$commitHash=~s/\.([0-9]+)/sprintf("%02x",$1-100)/eg;4309if($commitHash=~/^[0-9a-f]{40}$/)4310{4311return$self->getMetaFromCommithash($filename,$commitHash);4312}43134314# error recovery: fall back on head version below4315print"E Failed to find$filenameversion=$revisionor commit=$commitHash\n";4316$log->warning("failed get$revisionwith commithash=$commitHash");4317undef$revision;4318}4319elsif($revision=~/^[0-9a-f]{40}$/)4320{4321# Try DB first. This is mostly only useful for req_annotate(),4322# which only calls this for stuff that should already be in4323# the DB. It is fairly likely to be a waste of time4324# in most other cases [unless the file happened to be4325# modified in $revision specifically], but4326# it is probably in the noise compared to how long4327# getMetaFromCommithash() will take.4328my$db_query;4329$db_query=$self->{dbh}->prepare_cached(4330"SELECT * FROM$tablename_revWHERE name=? AND commithash=?",4331{},1);4332$db_query->execute($filename,$revision);4333$meta=$db_query->fetchrow_hashref;43344335if(!$meta)4336{4337my($revCommit)=$self->lookupCommitRef($revision);4338if($revCommit=~/^[0-9a-f]{40}$/)4339{4340return$self->getMetaFromCommithash($filename,$revCommit);4341}43424343# error recovery: nothing found:4344print"E Failed to find$filenameversion=$revision\n";4345$log->warning("failed get$revision");4346return$meta;4347}4348}4349else4350{4351my($revCommit)=$self->lookupCommitRef($revision);4352if($revCommit=~/^[0-9a-f]{40}$/)4353{4354return$self->getMetaFromCommithash($filename,$revCommit);4355}43564357# error recovery: fall back on head version below4358print"E Failed to find$filenameversion=$revision\n";4359$log->warning("failed get$revision");4360undef$revision;# Allow fallback4361}4362}43634364if(!defined($revision))4365{4366my$db_query;4367$db_query=$self->{dbh}->prepare_cached(4368"SELECT * FROM$tablename_headWHERE name=?",{},1);4369$db_query->execute($filename);4370$meta=$db_query->fetchrow_hashref;4371}43724373if($meta)4374{4375$meta->{revision} ="1.$meta->{revision}";4376}4377return$meta;4378}43794380sub getMetaFromCommithash4381{4382my$self=shift;4383my$filename=shift;4384my$revCommit=shift;43854386# NOTE: This function doesn't scale well (lots of forks), especially4387# if you have many files that have not been modified for many commits4388# (each git-rev-parse redoes a lot of work for each file4389# that theoretically could be done in parallel by smarter4390# graph traversal).4391#4392# TODO: Possible optimization strategies:4393# - Solve the issue of assigning and remembering "real" CVS4394# revision numbers for branches, and ensure the4395# data structure can do this efficiently. Perhaps something4396# similar to "git notes", and carefully structured to take4397# advantage same-sha1-is-same-contents, to roll the same4398# unmodified subdirectory data onto multiple commits?4399# - Write and use a C tool that is like git-blame, but4400# operates on multiple files with file granularity, instead4401# of one file with line granularity. Cache4402# most-recently-modified in $self->{commitRefCache}{$revCommit}.4403# Try to be intelligent about how many files we do with4404# one fork (perhaps one directory at a time, without recursion,4405# and/or include directory as one line item, recurse from here4406# instead of in C tool?).4407# - Perhaps we could ask the DB for (filename,fileHash),4408# and just guess that it is correct (that the file hadn't4409# changed between $revCommit and the found commit, then4410# changed back, confusing anything trying to interpret4411# history). Probably need to add another index to revisions4412# DB table for this.4413# - NOTE: Trying to store all (commit,file) keys in DB [to4414# find "lastModfiedCommit] (instead of4415# just files that changed in each commit as we do now) is4416# probably not practical from a disk space perspective.44174418# Does the file exist in $revCommit?4419# TODO: Include file hash in dirmap cache.4420my($dirMap)=$self->getRevisionDirMap($revCommit);4421my($dir,$file)=($filename=~m%^(?:(.*)/)?([^/]*$)%);4422if(!defined($dir))4423{4424$dir="";4425}4426if( !defined($dirMap->{$dir}) ||4427!defined($dirMap->{$dir}{$filename}) )4428{4429my($fileHash)="deleted";44304431my($retVal)={};4432$retVal->{name}=$filename;4433$retVal->{filehash}=$fileHash;44344435# not needed and difficult to compute:4436$retVal->{revision}="0";# $revision;4437$retVal->{commithash}=$revCommit;4438#$retVal->{author}=$commit->{author};4439#$retVal->{modified}=convertToCvsDate($commit->{date});4440#$retVal->{mode}=convertToDbMode($mode);44414442return$retVal;4443}44444445my($fileHash)=safe_pipe_capture("git","rev-parse","$revCommit:$filename");4446chomp$fileHash;4447if(!($fileHash=~/^[0-9a-f]{40}$/))4448{4449die"Invalid fileHash '$fileHash' looking up"4450." '$revCommit:$filename'\n";4451}44524453# information about most recent commit to modify $filename:4454open(my$gitLogPipe,'-|','git','rev-list',4455'--max-count=1','--pretty','--parents',4456$revCommit,'--',$filename)4457or die"Cannot call git-rev-list:$!";4458my@commits=readCommits($gitLogPipe);4459close$gitLogPipe;4460if(scalar(@commits)!=1)4461{4462die"Can't find most recent commit changing$filename\n";4463}4464my($commit)=$commits[0];4465if( !defined($commit) || !defined($commit->{hash}) )4466{4467returnundef;4468}44694470# does this (commit,file) have a real assigned CVS revision number?4471my$tablename_rev=$self->tablename("revision");4472my$db_query;4473$db_query=$self->{dbh}->prepare_cached(4474"SELECT * FROM$tablename_revWHERE name=? AND commithash=?",4475{},1);4476$db_query->execute($filename,$commit->{hash});4477my($meta)=$db_query->fetchrow_hashref;4478if($meta)4479{4480$meta->{revision} ="1.$meta->{revision}";4481return$meta;4482}44834484# fall back on special revision number4485my($revision)=$commit->{hash};4486$revision=~s/(..)/'.' . (hex($1)+100)/eg;4487$revision="2.1.1.2000$revision";44884489# meta data about $filename:4490open(my$filePipe,'-|','git','ls-tree','-z',4491$commit->{hash},'--',$filename)4492or die("Cannot call git-ls-tree :$!");4493local$/="\0";4494my$line;4495$line=<$filePipe>;4496if(defined(<$filePipe>))4497{4498die"Expected only a single file for git-ls-tree$filename\n";4499}4500close$filePipe;45014502chomp$line;4503unless($line=~m/^(\d+)\s+(\w+)\s+([a-zA-Z0-9]+)\t(.*)$/o)4504{4505die("Couldn't process git-ls-tree line :$line\n");4506}4507my($mode,$git_type,$git_hash,$git_filename) = ($1,$2,$3,$4);45084509# save result:4510my($retVal)={};4511$retVal->{name}=$filename;4512$retVal->{revision}=$revision;4513$retVal->{filehash}=$fileHash;4514$retVal->{commithash}=$revCommit;4515$retVal->{author}=$commit->{author};4516$retVal->{modified}=convertToCvsDate($commit->{date});4517$retVal->{mode}=convertToDbMode($mode);45184519return$retVal;4520}45214522=head2 lookupCommitRef45234524Convert tag/branch/abbreviation/etc into a commit sha1 hash. Caches4525the result so looking it up again is fast.45264527=cut45284529sub lookupCommitRef4530{4531my$self=shift;4532my$ref=shift;45334534my$commitHash=$self->{commitRefCache}{$ref};4535if(defined($commitHash))4536{4537return$commitHash;4538}45394540$commitHash=safe_pipe_capture("git","rev-parse","--verify","--quiet",4541$self->unescapeRefName($ref));4542$commitHash=~s/\s*$//;4543if(!($commitHash=~/^[0-9a-f]{40}$/))4544{4545$commitHash=undef;4546}45474548if(defined($commitHash) )4549{4550my$type=safe_pipe_capture("git","cat-file","-t",$commitHash);4551if( ! ($type=~/^commit\s*$/) )4552{4553$commitHash=undef;4554}4555}4556if(defined($commitHash))4557{4558$self->{commitRefCache}{$ref}=$commitHash;4559}4560return$commitHash;4561}45624563=head2 clearCommitRefCaches45644565Clears cached commit cache (sha1's for various tags/abbeviations/etc),4566and related caches.45674568=cut45694570sub clearCommitRefCaches4571{4572my$self=shift;4573$self->{commitRefCache} = {};4574$self->{revisionDirMapCache} =undef;4575$self->{gethead_cache} =undef;4576}45774578=head2 commitmessage45794580this function takes a commithash and returns the commit message for that commit45814582=cut4583sub commitmessage4584{4585my$self=shift;4586my$commithash=shift;4587my$tablename=$self->tablename("commitmsgs");45884589die("Need commithash")unless(defined($commithash)and$commithash=~/^[a-zA-Z0-9]{40}$/);45904591my$db_query;4592$db_query=$self->{dbh}->prepare_cached("SELECT value FROM$tablenameWHERE key=?",{},1);4593$db_query->execute($commithash);45944595my($message) =$db_query->fetchrow_array;45964597if(defined($message) )4598{4599$message.=" "if($message=~/\n$/);4600return$message;4601}46024603my@lines= safe_pipe_capture("git","cat-file","commit",$commithash);4604shift@lineswhile($lines[0] =~/\S/);4605$message=join("",@lines);4606$message.=" "if($message=~/\n$/);4607return$message;4608}46094610=head2 gethistorydense46114612This function takes a filename (with path) argument and returns an arrayofarrays4613containing revision,filehash,commithash ordered by revision descending.46144615This version of gethistory skips deleted entries -- so it is useful for annotate.4616The 'dense' part is a reference to a '--dense' option available for git-rev-list4617and other git tools that depend on it.46184619See also getlog().46204621=cut4622sub gethistorydense4623{4624my$self=shift;4625my$filename=shift;4626my$tablename=$self->tablename("revision");46274628my$db_query;4629$db_query=$self->{dbh}->prepare_cached("SELECT revision, filehash, commithash FROM$tablenameWHERE name=? AND filehash!='deleted' ORDER BY revision DESC",{},1);4630$db_query->execute($filename);46314632my$result=$db_query->fetchall_arrayref;46334634my$i;4635for($i=0;$i<scalar(@$result) ;$i++)4636{4637$result->[$i][0]="1.".$result->[$i][0];4638}46394640return$result;4641}46424643=head2 escapeRefName46444645Apply an escape mechanism to compensate for characters that4646git ref names can have that CVS tags can not.46474648=cut4649sub escapeRefName4650{4651my($self,$refName)=@_;46524653# CVS officially only allows [-_A-Za-z0-9] in tag names (or in4654# many contexts it can also be a CVS revision number).4655#4656# Git tags commonly use '/' and '.' as well, but also handle4657# anything else just in case:4658#4659# = "_-s-" For '/'.4660# = "_-p-" For '.'.4661# = "_-u-" For underscore, in case someone wants a literal "_-" in4662# a tag name.4663# = "_-xx-" Where "xx" is the hexadecimal representation of the4664# desired ASCII character byte. (for anything else)46654666if(!$refName=~/^[1-9][0-9]*(\.[1-9][0-9]*)*$/)4667{4668$refName=~s/_-/_-u--/g;4669$refName=~s/\./_-p-/g;4670$refName=~s%/%_-s-%g;4671$refName=~s/[^-_a-zA-Z0-9]/sprintf("_-%02x-",$1)/eg;4672}4673}46744675=head2 unescapeRefName46764677Undo an escape mechanism to compensate for characters that4678git ref names can have that CVS tags can not.46794680=cut4681sub unescapeRefName4682{4683my($self,$refName)=@_;46844685# see escapeRefName() for description of escape mechanism.46864687$refName=~s/_-([spu]|[0-9a-f][0-9a-f])-/unescapeRefNameChar($1)/eg;46884689# allowed tag names4690# TODO: Perhaps use git check-ref-format, with an in-process cache of4691# validated names?4692if( !($refName=~m%^[^-][-a-zA-Z0-9_/.]*$%) ||4693($refName=~m%[/.]$%) ||4694($refName=~/\.lock$/) ||4695($refName=~m%\.\.|/\.|[[\\:?*~]|\@\{% ) )# matching }4696{4697# Error:4698$log->warn("illegal refName:$refName");4699$refName=undef;4700}4701return$refName;4702}47034704sub unescapeRefNameChar4705{4706my($char)=@_;47074708if($chareq"s")4709{4710$char="/";4711}4712elsif($chareq"p")4713{4714$char=".";4715}4716elsif($chareq"u")4717{4718$char="_";4719}4720elsif($char=~/^[0-9a-f][0-9a-f]$/)4721{4722$char=chr(hex($char));4723}4724else4725{4726# Error case: Maybe it has come straight from user, and4727# wasn't supposed to be escaped? Restore it the way we got it:4728$char="_-$char-";4729}47304731return$char;4732}47334734=head2 in_array()47354736from Array::PAT - mimics the in_array() function4737found in PHP. Yuck but works for small arrays.47384739=cut4740sub in_array4741{4742my($check,@array) =@_;4743my$retval=0;4744foreachmy$test(@array){4745if($checkeq$test){4746$retval=1;4747}4748}4749return$retval;4750}47514752=head2 safe_pipe_capture47534754an alternative to `command` that allows input to be passed as an array4755to work around shell problems with weird characters in arguments47564757=cut4758sub safe_pipe_capture {47594760my@output;47614762if(my$pid=open my$child,'-|') {4763@output= (<$child>);4764close$childor die join(' ',@_).":$!$?";4765}else{4766exec(@_)or die"$!$?";# exec() can fail the executable can't be found4767}4768returnwantarray?@output:join('',@output);4769}47704771=head2 mangle_dirname47724773create a string from a directory name that is suitable to use as4774part of a filename, mainly by converting all chars except \w.- to _47754776=cut4777sub mangle_dirname {4778my$dirname=shift;4779return unlessdefined$dirname;47804781$dirname=~s/[^\w.-]/_/g;47824783return$dirname;4784}47854786=head2 mangle_tablename47874788create a string from a that is suitable to use as part of an SQL table4789name, mainly by converting all chars except \w to _47904791=cut4792sub mangle_tablename {4793my$tablename=shift;4794return unlessdefined$tablename;47954796$tablename=~s/[^\w_]/_/g;47974798return$tablename;4799}480048011;