1# Module of TWiki Enterprise Collaboration Platform, http://TWiki.org/ 2# 3# Copyright (C) 2002 John Talintyre, john.talintyre@btinternet.com 4# Copyright (C) 2002-2018 Peter Thoeny, peter[at]thoeny.org 5# and TWiki Contributors. All Rights Reserved. TWiki Contributors 6# are listed in the AUTHORS file in the root of this distribution. 7# NOTE: Please extend that file, not this notice. 8# 9# This program is free software; you can redistribute it and/or 10# modify it under the terms of the GNU General Public License 11# as published by the Free Software Foundation; either version 3 12# of the License, or (at your option) any later version. For 13# more details read LICENSE in the root of this distribution. 14# 15# This program is distributed in the hope that it will be useful, 16# but WITHOUT ANY WARRANTY; without even the implied warranty of 17# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 18# 19# As per the GPL, removal of this notice is prohibited. 20 21=pod 22 23---+ package TWiki::Store::RcsWrap 24 25This package does not publish any methods. It implements the 26virtual methods of the [[TWikiStoreRcsFileDotPm][TWiki::Store::RcsFile]] superclass. 27 28Wrapper around the RCS commands required by TWiki. 29There is one of these object for each file stored under RCS. 30 31=cut 32 33package TWiki::Store::RcsWrap; 34use base 'TWiki::Store::RcsFile'; 35 36use strict; 37use Assert; 38 39require TWiki::Store; 40require TWiki::Sandbox; 41 42# implements RcsFile 43sub new { 44 return shift->SUPER::new( @_ ); 45} 46 47=begin twiki 48 49---++ ObjectMethod finish() 50Break circular references. 51 52=cut 53 54# Note to developers; please undef *all* fields in the object explicitly, 55# whether they are references or not. That way this method is "golden 56# documentation" of the live fields in the object. 57sub finish { 58 my $this = shift; 59 $this->SUPER::finish(); 60 undef $this->{binary}; 61} 62 63# implements RcsFile 64sub initBinary { 65 my( $this ) = @_; 66 67 $this->{binary} = 1; 68 69 TWiki::Store::RcsFile::mkPathTo( $this->{file} ); 70 71 return if -e $this->{rcsFile}; 72 73 my ( $rcsOutput, $exit ) = 74 $TWiki::sandbox->sysCommand( 75 $TWiki::cfg{RCS}{initBinaryCmd}, FILENAME => $this->{file} ); 76 if( $exit ) { 77 throw Error::Simple( $TWiki::cfg{RCS}{initBinaryCmd}. 78 ' of '.$this->hidePath($this->{file}). 79 ' failed: '.$rcsOutput ); 80 } elsif( ! -e $this->{rcsFile} ) { 81 # Sometimes (on Windows?) rcs file not formed, so check for it 82 throw Error::Simple( $TWiki::cfg{RCS}{initBinaryCmd}. 83 ' of '.$this->hidePath($this->{rcsFile}). 84 ' failed to create history file'); 85 } 86} 87 88# implements RcsFile 89sub initText { 90 my( $this ) = @_; 91 92 $this->{binary} = 0; 93 94 TWiki::Store::RcsFile::mkPathTo( $this->{file} ); 95 96 return if -e $this->{rcsFile}; 97 98 my ( $rcsOutput, $exit ) = 99 $TWiki::sandbox->sysCommand 100 ( $TWiki::cfg{RCS}{initTextCmd}, 101 FILENAME => $this->{file} ); 102 if( $exit ) { 103 $rcsOutput ||= ''; 104 throw Error::Simple( $TWiki::cfg{RCS}{initTextCmd}. 105 ' of '.$this->hidePath($this->{file}). 106 ' failed: '.$rcsOutput ); 107 } elsif( ! -e $this->{rcsFile} ) { 108 # Sometimes (on Windows?) rcs file not formed, so check for it 109 throw Error::Simple( $TWiki::cfg{RCS}{initTextCmd}. 110 ' of '.$this->hidePath($this->{rcsFile}). 111 ' failed to create history file'); 112 } 113} 114 115# implements RcsFile 116sub addRevisionFromText { 117 my( $this, $text, $comment, $user, $date ) = @_; 118 $this->init(); 119 120 unless( -e $this->{rcsFile} ) { 121 _lock( $this ); 122 _ci( $this, $comment, $user, $date ); 123 } 124 TWiki::Store::RcsFile::saveFile( $this, $this->{file}, $text ); 125 _lock( $this ); 126 _ci( $this, $comment, $user, $date ); 127} 128 129# implements RcsFile 130sub addRevisionFromStream { 131 my( $this, $stream, $comment, $user, $date ) = @_; 132 $this->init(); 133 134 _lock( $this ); 135 TWiki::Store::RcsFile::saveStream( $this, $stream ); 136 _ci( $this, $comment, $user, $date ); 137} 138 139# implements RcsFile 140sub replaceRevision { 141 my( $this, $text, $comment, $user, $date ) = @_; 142 143 my $rev = $this->numRevisions(); 144 145 $comment ||= 'none'; 146 147 # update repository with same userName and date 148 if( $rev == 1 ) { 149 # initial revision, so delete repository file and start again 150 unlink $this->{rcsFile}; 151 } else { 152 _deleteRevision( $this, $rev ); 153 } 154 155 TWiki::Store::RcsFile::saveFile( $this, $this->{file}, $text ); 156 require TWiki::Time; 157 $date = TWiki::Time::formatTime( $date , '$rcs', 'gmtime'); 158 159 _lock( $this ); 160 my ($rcsOut, $exit) = 161 $TWiki::sandbox->sysCommand( 162 $TWiki::cfg{RCS}{ciDateCmd}, 163 DATE => $date, 164 USERNAME => $user, 165 FILENAME => $this->{file}, 166 COMMENT => $comment ); 167 if( $exit ) { 168 $rcsOut = $TWiki::cfg{RCS}{ciDateCmd}."\n".$rcsOut; 169 return $rcsOut; 170 } 171 chmod( $TWiki::cfg{RCS}{filePermission}, $this->{file} ); 172} 173 174# implements RcsFile 175sub deleteRevision { 176 my( $this ) = @_; 177 my $rev = $this->numRevisions(); 178 return undef if( $rev <= 1 ); 179 return _deleteRevision( $this, $rev ); 180} 181 182sub _deleteRevision { 183 my( $this, $rev ) = @_; 184 185 # delete latest revision (unlock (may not be needed), delete revision) 186 my ($rcsOut, $exit) = 187 $TWiki::sandbox->sysCommand( 188 $TWiki::cfg{RCS}{unlockCmd}, 189 FILENAME => $this->{file} ); 190 191 chmod( $TWiki::cfg{RCS}{filePermission}, $this->{file} ); 192 193 ($rcsOut, $exit) = $TWiki::sandbox->sysCommand( 194 $TWiki::cfg{RCS}{delRevCmd}, 195 REVISION => '1.'.$rev, 196 FILENAME => $this->{file} ); 197 198 if( $exit ) { 199 throw Error::Simple( $TWiki::cfg{RCS}{delRevCmd}. 200 ' of '.$this->hidePath($this->{file}). 201 ' failed: '.$rcsOut ); 202 } 203 204 # Update the checkout 205 $rev--; 206 ($rcsOut, $exit) = $TWiki::sandbox->sysCommand( 207 $TWiki::cfg{RCS}{coCmd}, 208 REVISION => '1.'.$rev, 209 FILENAME => $this->{file} ); 210 211 if( $exit ) { 212 throw Error::Simple( $TWiki::cfg{RCS}{coCmd}. 213 ' of '.$this->hidePath($this->{file}). 214 ' failed: '.$rcsOut ); 215 } 216 TWiki::Store::RcsFile::saveFile( $this, $this->{file}, $rcsOut ); 217} 218 219# implements RcsFile 220sub getRevision { 221 my( $this, $version ) = @_; 222 223 unless( $version && -e $this->{rcsFile} ) { 224 return $this->SUPER::getRevision( $version ); 225 } 226 227 my $tmpfile = ''; 228 my $tmpRevFile = ''; 229 my $coCmd = $TWiki::cfg{RCS}{coCmd}; 230 my $file = $this->{file}; 231 if( $TWiki::cfg{RCS}{coMustCopy} ) { 232 # SMELL: is this really necessary? What evidence is there? 233 # Need to take temporary copy of topic, check it out to file, 234 # then read that 235 # Need to put RCS into binary mode to avoid extra \r appearing and 236 # read from binmode file rather than stdout to avoid early file 237 # read termination 238 $tmpfile = TWiki::Store::RcsFile::mkTmpFilename( $this ); 239 $tmpRevFile = $tmpfile.',v'; 240 copy( $this->{rcsFile}, $tmpRevFile ); 241 my ($tmp, $status) = $TWiki::sandbox->sysCommand( 242 $TWiki::cfg{RCS}{tmpBinaryCmd}, 243 FILENAME => $tmpRevFile ); 244 $file = $tmpfile; 245 $coCmd =~ s/-p%REVISION/-r%REVISION/; 246 } 247 my ($text, $status) = $TWiki::sandbox->sysCommand( 248 $coCmd, 249 REVISION => '1.'.$version, 250 FILENAME => $file ); 251 252 if( $tmpfile ) { 253 $text = TWiki::Store::RcsFile::readFile( $this, $tmpfile ); 254 # SMELL: Is untainting really necessary here? 255 unlink TWiki::Sandbox::untaintUnchecked( $tmpfile ); 256 unlink TWiki::Sandbox::untaintUnchecked( $tmpRevFile ); 257 } 258 259 return $text; 260} 261 262# implements RcsFile 263sub numRevisions { 264 my( $this ) = @_; 265 266 if ( -e $this->{rcsFile} && -s $this->{rcsFile} == 0 ) { 267 $this->{session}->writeWarning('null RCS: ' . $this->{rcsFile}); 268 $this->{session}{rcsFileNull} = 1; 269 unlink $this->{rcsFile}; 270 } 271 unless( -e $this->{rcsFile}) { 272 return 1 if( -e $this->{file} ); 273 return 0; 274 } 275 276 my ($rcsOutput, $exit) = 277 $TWiki::sandbox->sysCommand 278 ( $TWiki::cfg{RCS}{histCmd}, 279 FILENAME => $this->{rcsFile} ); 280 if( $exit ) { 281 throw Error::Simple( 'RCS: '.$TWiki::cfg{RCS}{histCmd}. 282 ' of '.$this->hidePath($this->{rcsFile}). 283 ' failed: '.$rcsOutput ); 284 } 285 if( $rcsOutput =~ /head:\s+\d+\.(\d+)\n/ ) { 286 return $1; 287 } 288 if( $rcsOutput =~ /total revisions: (\d+)\n/ ) { 289 return $1; 290 } 291 return 1; 292} 293 294# implements RcsFile 295sub getRevisionInfo { 296 my( $this, $version ) = @_; 297 298 if( -e $this->{rcsFile} ) { 299 if( !$version || $version > $this->numRevisions()) { 300 $version = $this->numRevisions(); 301 } 302 my( $rcsOut, $exit ) = $TWiki::sandbox->sysCommand 303 ( $TWiki::cfg{RCS}{infoCmd}, 304 REVISION => '1.'.$version, 305 FILENAME => $this->{rcsFile} ); 306 if( ! $exit ) { 307 if( $rcsOut =~ /^.*?date: ([^;]+); author: ([^;]*);[^\n]*\n([^\n]*)\n/s ) { 308 my $user = $2; 309 my $comment = $3; 310 require TWiki::Time; 311 my $date = TWiki::Time::parseTime( $1 ); 312 my $rev = $version; 313 if( $rcsOut =~ /revision 1.([0-9]*)/ ) { 314 $rev = $1; 315 return( $rev, $date, $user, $comment ); 316 } 317 } 318 } 319 } 320 321 return $this->SUPER::getRevisionInfo( $version ); 322} 323 324# implements RcsFile 325sub revisionDiff { 326 my( $this, $rev1, $rev2, $contextLines ) = @_; 327 my $tmp = ''; 328 my $exit; 329 if ( $rev1 eq '1' && $rev2 eq '1' ) { 330 my $text = $this->getRevision(1); 331 $tmp = "1a1\n"; 332 foreach( split( /\r?\n/, $text ) ) { 333 $tmp = "$tmp> $_\n"; 334 } 335 } else { 336 $contextLines = 3 unless defined($contextLines); 337 ( $tmp, $exit ) = $TWiki::sandbox->sysCommand( 338 $TWiki::cfg{RCS}{diffCmd}, 339 REVISION1 => '1.'.$rev1, 340 REVISION2 => '1.'.$rev2, 341 FILENAME => $this->{rcsFile}, 342 CONTEXT => $contextLines ); 343 # comment out because we get a non-zero status for a good result! 344 #if( $exit ) { 345 # throw Error::Simple( 'RCS: '.$TWiki::cfg{RCS}{diffCmd}. 346 # ' failed: '.$! ); 347 #} 348 } 349 350 return parseRevisionDiff( $tmp ); 351} 352 353=pod 354 355---++ StaticMethod parseRevisionDiff( $text ) -> \@diffArray 356 357| Description: | parse the text into an array of diff cells | 358| #Description: | unlike Algorithm::Diff I concatinate lines of the same diffType that are sqential (this might be something that should be left up to the renderer) | 359| Parameter: =$text= | currently unified or rcsdiff format | 360| Return: =\@diffArray= | reference to an array of [ diffType, $right, $left ] | 361| TODO: | move into RcsFile and add indirection in Store | 362 363=cut 364 365sub parseRevisionDiff { 366 my( $text ) = @_; 367 368 my ( $diffFormat ) = 'normal'; #or rcs, unified... 369 my ( @diffArray ) = (); 370 371 $diffFormat = 'unified' if ( $text =~ /^---/s ); 372 373 $text =~ s/\r//go; # cut CR 374 375 my $lineNumber=1; 376 if ( $diffFormat eq 'unified' ) { 377 foreach( split( /\r?\n/, $text ) ) { 378 if ( $lineNumber > 2 ) { #skip the first 2 lines (filenames) 379 if ( /@@ [-+]([0-9]+)([,0-9]+)? [-+]([0-9]+)(,[0-9]+)? @@/ ) { 380 #line number 381 push @diffArray, ['l', $1, $3]; 382 } elsif( /^\-(.*)$/ ) { 383 push @diffArray, ['-', $1, '']; 384 } elsif( /^\+(.*)$/ ) { 385 push @diffArray, ['+', '', $1]; 386 } else { 387 s/^ (.*)$/$1/go; 388 push @diffArray, ['u', $_, $_]; 389 } 390 } 391 $lineNumber++; 392 } 393 } else { 394 #'normal' rcsdiff output 395 foreach( split( /\r?\n/, $text ) ) { 396 if ( /^([0-9]+)[0-9\,]*([acd])([0-9]+)/ ) { 397 #line number 398 push @diffArray, ['l', $1, $3]; 399 } elsif( /^< (.*)$/ ) { 400 push @diffArray, ['-', $1, '']; 401 } elsif( /^> (.*)$/ ) { 402 push @diffArray, ['+', '', $1]; 403 } else { 404 #push @diffArray, ['u', '', '']; 405 } 406 } 407 } 408 return \@diffArray; 409} 410 411sub _ci { 412 my( $this, $comment, $user, $date ) = @_; 413 414 $comment = 'none' unless $comment; 415 416 # Item7765 417 my $semaphoreFile = $this->{file}; 418 $semaphoreFile =~ s:^(.*/)(.*):$1,$2,:; 419 unlink $semaphoreFile; 420 421 my( $cmd, $rcsOutput, $exit ); 422 if( defined( $date )) { 423 require TWiki::Time; 424 $date = TWiki::Time::formatTime( $date , '$rcs', 'gmtime'); 425 $cmd = $TWiki::cfg{RCS}{ciDateCmd}; 426 ($rcsOutput, $exit)= $TWiki::sandbox->sysCommand( 427 $cmd, 428 USERNAME => $user, 429 FILENAME => $this->{file}, 430 COMMENT => $comment, 431 DATE => $date ); 432 } else { 433 $cmd = $TWiki::cfg{RCS}{ciCmd}; 434 ($rcsOutput, $exit)= $TWiki::sandbox->sysCommand( 435 $cmd, 436 USERNAME => $user, 437 FILENAME => $this->{file}, 438 COMMENT => $comment ); 439 } 440 $rcsOutput ||= ''; 441 442 if( $exit ) { 443 throw Error::Simple($cmd.' of '.$this->hidePath($this->{file}). 444 ' failed: '.$exit.' '.$rcsOutput ); 445 } 446 447 chmod( $TWiki::cfg{RCS}{filePermission}, $this->{file} ); 448} 449 450sub _lock { 451 my $this = shift; 452 453 return unless -e $this->{rcsFile}; 454 455 # Item7765 456 my $semaphoreFile = $this->{file}; 457 $semaphoreFile =~ s:^(.*/)(.*):$1,$2,:; 458 unlink $semaphoreFile; 459 460 # Try and get a lock on the file 461 my ($rcsOutput, $exit) = $TWiki::sandbox->sysCommand( 462 $TWiki::cfg{RCS}{lockCmd}, FILENAME => $this->{file} ); 463 464 if( $exit ) { 465 # if the lock has been set more than 24h ago, let's try to break it 466 # and then retry. Should not happen unless in Cairo upgrade 467 # scenarios - see Item2102 468 if ((time - (stat($this->{rcsFile}))[9]) > 3600) { 469 warn 'Automatic recovery: breaking lock for ' . $this->{file} ; 470 $TWiki::sandbox->sysCommand( 471 $TWiki::cfg{RCS}{breaklockCmd}, FILENAME => $this->{file} ); 472 ($rcsOutput, $exit) = $TWiki::sandbox->sysCommand( 473 $TWiki::cfg{RCS}{lockCmd}, FILENAME => $this->{file} ); 474 } 475 if ( $exit ) { 476 # still no luck - bailing out 477 $rcsOutput ||= ''; 478 throw Error::Simple( 'RCS: '.$TWiki::cfg{RCS}{lockCmd}. 479 ' failed: '.$rcsOutput ); 480 } 481 } 482 chmod( $TWiki::cfg{RCS}{filePermission}, $this->{file} ); 483} 484 485# implements RcsFile 486sub getRevisionAtTime { 487 my( $this, $date ) = @_; 488 489 if ( !-e $this->{rcsFile} ) { 490 return undef; 491 } 492 require TWiki::Time; 493 $date = TWiki::Time::formatTime( $date , '$rcs', 'gmtime'); 494 my ($rcsOutput, $exit) = $TWiki::sandbox->sysCommand( 495 $TWiki::cfg{RCS}{rlogDateCmd}, 496 DATE => $date, 497 FILENAME => $this->{file} ); 498 499 if ( $rcsOutput =~ m/revision \d+\.(\d+)/ ) { 500 return $1; 501 } 502 return 1; 503} 504 5051; 506