1#################################################################################################### 2# 3# This file is part of 'Bitflu' - (C) 2006-2011 Adrian Ulrich 4# 5# Released under the terms of The "Artistic License 2.0". 6# http://www.opensource.org/licenses/artistic-license-2.0.php 7# 8# 9 10package Bitflu::StorageVFS; 11use strict; 12use POSIX; 13use IO::Handle; 14use Storable; 15 16use constant _BITFLU_APIVERSION => 20120529; 17use constant BITFLU_METADIR => '.bitflu-meta-do-not-touch'; 18use constant SAVE_DELAY => 180; 19use constant ALLOC_BUFSIZE => 4096; 20use constant MAX_FHCACHE => 8; # Max number of cached filehandles 21 22use constant CB_VFS_DIRTY => 'vfs_dirty'; # Clipboard name for MultipleLaunch protection 23use constant VFS_DIRTY_RUN => 58; # How often should the heartbeat sxtask run? 24 25use constant VFS_FNAME_MAX => 255; # do not create filenames longer than 255 chars (maximum of most filesystems) 26use constant VFS_PATH_MAX => 1024; # never-ever create a path longer than X chars 27 28sub BEGIN { 29 # Autoload Storable before going into chroot-jail 30 Storable::thaw(Storable::nfreeze({})); 31} 32 33########################################################################## 34# Register this plugin 35sub register { 36 my($class, $mainclass) = @_; 37 my $self = { super => $mainclass, conf => {}, so => {}, fhcache=>{}, cbcache=>{} }; 38 bless($self,$class); 39 40 my $cproto = { incomplete_downloads => $mainclass->Configuration->GetValue('workdir')."/unfinished", 41 completed_downloads => $mainclass->Configuration->GetValue('workdir')."/seeding", 42 unshared_downloads => $mainclass->Configuration->GetValue('workdir')."/removed", 43 vfs_use_fallocate => 0, 44 vfs_datafsync => 1, 45 }; 46 47 foreach my $this_key (keys(%$cproto)) { 48 my $this_value = $mainclass->Configuration->GetValue($this_key); 49 if(!defined($this_value) or length($this_value) == 0) { 50 $mainclass->Configuration->SetValue($this_key, $cproto->{$this_key}); 51 } 52 $mainclass->Configuration->RuntimeLockValue($this_key); 53 } 54 55 # Shortcuts 56 $self->{conf}->{dir_work} = $mainclass->Configuration->GetValue('incomplete_downloads'); 57 $self->{conf}->{dir_done} = $mainclass->Configuration->GetValue('completed_downloads'); 58 $self->{conf}->{dir_ushr} = $mainclass->Configuration->GetValue('unshared_downloads'); 59 $self->{conf}->{dir_meta} = $self->{conf}->{dir_work}."/".BITFLU_METADIR; 60 61 my $mode = ( $mainclass->Configuration->GetValue('vfs_use_fallocate') ? "with fallocate (if supported)" : "sparsefiles" ); 62 63 $self->info("Using VFS storage plugin ($mode)"); 64 return $self; 65} 66 67########################################################################## 68# Init 'workdir' 69sub init { 70 my($self) = @_; 71 $self->{super}->AddStorage($self); 72 73 foreach my $this_dname (qw(dir_work dir_done dir_ushr dir_meta)) { 74 my $this_dir = $self->{conf}->{$this_dname}; 75 next if -d $this_dir; 76 $self->debug("mkdir $this_dir"); 77 mkdir($this_dir) or $self->panic("Unable to create directory '$this_dir' : $!"); 78 } 79 80 unless(-f $self->__GetClipboardFile) { 81 $self->debug("Creating an empty clipboard"); 82 $self->__ClipboardStore; 83 } 84 85 $self->__ClipboardCacheInit; 86 87 $self->{super}->AddRunner($self); 88 $self->{super}->Admin->RegisterCommand('commit' ,$self, '_Command_Commit' , 'Start to assemble given hash', [[undef,'Usage: "commit queue_id [queue_id2 ... | --all]"']]); 89 $self->{super}->Admin->RegisterCommand('files' ,$self, '_Command_Files' , 'Manages files of given queueid', 90 [[0,'Usage: "files queue_id [list | commit fileId | exclude fileId | include fileId | priority fileId | clear fileId]"'], [0,''], 91 [0,'files queue_id list : List all files'], 92 [0,'files queue_id list-included : List only included files'], 93 [0,'files queue_id list-excluded : List only excluded files'], 94 [0,'files queue_id exclude 1-3 8 : Do not download file 1,2,3 and 8'], 95 [0,'files queue_id include 1-3 8 : Download file 1,2,3 and 8 (= remove "exclude" flag)'], 96 [0,'files queue_id priority 1 5 : Raise Priority of file 1 and 5'], 97 [0,'files queue_id clear 1 5 : Removes the "priority" flag from file 1 and 5'], 98 ]); 99 $self->{super}->Admin->RegisterCommand('rating' ,$self, '_Command_Rating' , 'Display and modify rating', 100 [[0,'Usage: rating queue_id [get | reset | set {value between 1-5}]'], [0,''], 101 [0,'rating queue_id get : Display local and remote rating'], 102 [0,'rating queue_id reset : Remove local/own rating'], 103 [0,'rating queue_id set 3 : Rate "queue_id" 3 stars'], 104 ]); 105=head 106# COMMENTSCODE 107 $self->{super}->Admin->RegisterCommand('comment' ,$self, '_Command_Comment' , 'Display and modify comments', 108 [[0,'Usage: comment queue_id [get | set [@rating] text]'], [0,''], 109 [0,'comment queue_id get : Display comments of download'], 110 [0,'comment queue_id set foobar : Add \'foobar\' comment'], 111 [0,'comment queue_id set @4 foobar : Add \'foobar\' comment and rank with 4 stars (ranking goes from 1-5)'], 112 ]); 113=cut 114 115 $self->{super}->Admin->RegisterCommand('fhcache' ,$self, '_CommandFhCache' , 'Display filehandle cache'); 116 117 $self->{super}->CreateSxTask(Superclass=>$self,Callback=>'_SxCheckCrashstate', Args=>[]); 118 119 return 1; 120} 121 122########################################################################## 123# Save metadata each X seconds 124sub run { 125 my($self) = @_; 126 127 foreach my $sid (@{$self->GetStorageItems}) { 128 $self->debug("Saving metadata of $sid"); 129 my $so = $self->OpenStorage($sid) or $self->panic("Unable to open $sid: $!"); 130 $so->_SaveMetadata; 131 } 132 133 return SAVE_DELAY; 134} 135 136########################################################################## 137# Save Bitfields 138sub terminate { 139 my($self) = @_; 140 # Simulate a metasave event: 141 $self->info("saving metadata..."); 142 $self->run(); 143 $self->_FlushFileHandles; 144 145 $self->info("removing storage-lock..."); 146 $self->ClipboardSet('vfs_dirty', 0); # no need to care about sxtasks: we are the last call before shutdown 147} 148 149########################################################################## 150# Check if last shutdown was ok 151# note: this can not be run directly from init() or run(): it should be 152# triggered via SxTask() 153sub _SxCheckCrashstate { 154 my($self) = @_; 155 156 157 my $vfs_dirty = ( $self->ClipboardGet(CB_VFS_DIRTY) || 0 ); 158 my $vfs_skew = ($vfs_dirty+VFS_DIRTY_RUN+5 - $self->{super}->Network->GetTime); 159 160 if($vfs_skew > 0 && !$ENV{BITFLU_FORCE_START}) { 161 $self->warn("bitflu is still running or has crashed recently. Try again in $vfs_skew seconds."); 162 die; 163 } 164 elsif($vfs_dirty) { 165 $self->warn("bitflu did not shutdown correctly: running background verify"); 166 my $queue = $self->{super}->Queue->GetQueueList; 167 foreach my $proto (keys(%$queue)) { 168 foreach my $sid (keys(%{$queue->{$proto}})) { 169 $self->{super}->Admin->ExecuteCommand('verify', $sid); 170 } 171 } 172 } 173 174 # create 'heartbeat' process 175 $self->{super}->CreateSxTask(Superclass=>$self,Callback=>'_SxMarkAlive', Interval=>VFS_DIRTY_RUN, Args=>[]); 176 177 return 0; 178} 179 180########################################################################## 181# mark process as 'alive' 182sub _SxMarkAlive { 183 my($self) = @_; 184 $self->ClipboardSet(CB_VFS_DIRTY, $self->{super}->Network->GetTime); 185 $self->debug("Setting alive flag"); 186 return 1; 187} 188 189 190########################################################################## 191# Implements the 'commit' command 192sub _Command_Commit { 193 my($self, @args) = @_; 194 my @A = (); 195 my $NOEXEC = ''; 196 $self->{super}->Tools->GetOpts(\@args); 197 198 foreach my $sid (@args) { 199 my $so = $self->OpenStorage($sid); 200 if($so) { 201 my $stats = $self->{super}->Queue->GetStats($sid); 202 if($so->CommitFullyDone) { 203 push(@A, [2, "$sid: has been committed"]); 204 } 205 elsif($stats->{total_chunks} == $stats->{done_chunks}) { 206 my $newdir = $self->{super}->Tools->GetExclusiveDirectory($self->_GetDonedir, $self->_FsSaveDirent($so->GetSetting('name'))); 207 rename($so->_GetDataroot, $newdir) or $self->panic("Cannot rename ".$so->_GetDataroot." into $newdir: $!"); 208 $so->_SetDataroot($newdir); 209 $so->SetSetting('committed', 1); 210 push(@A, [1, "$sid: moved to $newdir"]); 211 } 212 else { 213 push(@A, [2, "$sid: download not finished, refusing to commit"]); 214 } 215 } 216 else { 217 push(@A, [2, "$sid: does not exist in queue"]); 218 } 219 } 220 221 unless(int(@args)) { 222 $NOEXEC .= "Usage: commit queue_id [queue_id2 ...]"; 223 } 224 225 return({MSG=>\@A, SCRAP=>[], NOEXEC=>$NOEXEC}); 226} 227 228########################################################################## 229# Implements the 'files' command 230sub _Command_Files { 231 my($self, @args) = @_; 232 233 my $sha1 = shift(@args) || ''; 234 my $command = shift(@args) || ''; 235 my $fid = 0; 236 my @A = (); 237 my $NOEXEC = ''; 238 my $so = undef; 239 240 if(!($so = $self->OpenStorage($sha1))) { 241 push(@A, [2, "Hash '$sha1' does not exist in queue"]); 242 } 243 elsif($command =~ /^list(-included|-excluded|)$/) { 244 my $lopt = $1; 245 my $csize = $so->GetSetting('size') or $self->panic("$so : can't open 'size' object"); 246 my $pflag = $so->GetPriorityHash; 247 push(@A,[3, [{vrow=>1, rsep=>'|'}, '#Id','Path', 'Size (MB)', '% Done']]); 248 249 for(my $i=0; $i < $so->GetFileCount; $i++) { 250 my $fp_info = $so->GetFileProgress($i); 251 my $this_file = $so->GetFileInfo($i); 252 my $done_chunks = $fp_info->{done}; 253 my $excl_chunks = $fp_info->{excluded}; 254 my $num_chunks = $fp_info->{chunks}; 255 256 # Gui-Crop-Down path 257 my $path = $this_file->{path}; 258 my $pcdone = sprintf("%5.1f", ($done_chunks/$num_chunks*100) ); 259 my $prchar = ( $pflag->{$i} ? '^' : ' ' ); 260 if($pcdone >= 100 && $done_chunks != $num_chunks) { 261 $pcdone = 99.99; 262 } 263 264 next if $excl_chunks && $lopt eq '-included'; 265 next if !$excl_chunks && $lopt eq '-excluded'; 266 267 my $msg = [undef, sprintf("%3d%s",1+$i, $prchar), " $path ", sprintf("%8.2f",($this_file->{size}/1024/1024)), sprintf("%5.1f%%",$pcdone)]; 268 push(@A,[($excl_chunks == 0 ? 0 : 5 ),$msg]); 269 } 270 271 } 272 elsif($command eq 'exclude' && defined $args[0]) { 273 my $to_exclude = $self->{super}->Tools->ExpandRange(@args); 274 my $is_excluded = $so->GetExcludeHash; 275 map { $is_excluded->{$_-1} = 1; } keys(%$to_exclude); 276 $so->_SetExcludeHash($is_excluded); 277 return $self->_Command_Files($sha1, "list"); 278 } 279 elsif($command eq 'include' && defined $args[0]) { 280 my $to_include = $self->{super}->Tools->ExpandRange(@args); 281 my $is_excluded = $so->GetExcludeHash; 282 map { delete($is_excluded->{$_-1}) } keys(%$to_include); 283 $so->_SetExcludeHash($is_excluded); 284 return $self->_Command_Files($sha1, "list"); 285 } 286 elsif($command eq 'priority' && defined $args[0]) { 287 my $priorange = $self->{super}->Tools->ExpandRange(@args); 288 my $priohash = $so->GetPriorityHash; 289 map { $priohash->{$_-1} = 1; } keys(%$priorange); 290 $so->_SetPriorityHash($priohash); 291 return $self->_Command_Files($sha1, "list"); 292 } 293 elsif($command eq 'clear' && defined $args[0]) { 294 my $to_clear = $self->{super}->Tools->ExpandRange(@args); 295 my $priohash = $so->GetPriorityHash; 296 map { delete($priohash->{$_-1}) } keys(%$to_clear); 297 $so->_SetPriorityHash($priohash); 298 return $self->_Command_Files($sha1, "list"); 299 } 300 else { 301 $NOEXEC .= "Usage: files queue_id [list | list-included | list-excluded | exclude fileId | include fileId | priority fileId | clear fileId] type 'help files' for more information"; 302 } 303 return({MSG=>\@A, SCRAP=>[], NOEXEC=>$NOEXEC}); 304} 305 306 307sub _Command_Rating { 308 my($self, @args) = @_; 309 310 my $sha1 = shift(@args) || ''; 311 my $command = shift(@args) || ''; 312 my ($value) = (shift(@args)|| '') =~ /(\d+)/; 313 my @A = (); 314 my $NOEXEC = ''; 315 my $so = undef; 316 317 if(!($so = $self->OpenStorage($sha1))) { 318 push(@A, [2, "Hash '$sha1' does not exist in queue"]); 319 } 320 elsif($command eq 'get' or $command eq '') { 321 my $own = ($so->GetLocalRating || 'unset'); 322 my $rem = ($so->GetRemoteRating || 'unknown'); 323 push(@A, [undef, "own_rating=$own, remote=$rem"]); 324 } 325 elsif($command eq 'reset') { 326 $so->SetLocalRating(0); 327 push(@A, [undef, "rating of $sha1 has been reset"]); 328 } 329 elsif($command eq 'set' && $value && $value >= 1 && $value <= 5) { 330 $so->SetLocalRating($value); 331 push(@A, [undef, "rating of $sha1 set to $value"]); 332 } 333 else { 334 $NOEXEC .= "Usage: rating queue_id [get | reset | set {value between 1-5}]"; 335 } 336 return({MSG=>\@A, SCRAP=>[], NOEXEC=>$NOEXEC}); 337} 338 339=head 340# COMMENTSCODE 341########################################################################## 342# Manages comments for given queue id 343sub _Command_Comment { 344 my($self, @args) = @_; 345 my $sha1 = shift(@args) || ''; 346 my $command = shift(@args) || ''; 347 my $text = join(" ",@args) || ''; 348 my @A = (); 349 my $NOEXEC = ''; 350 my $so = undef; 351 352 if(!($so = $self->OpenStorage($sha1))) { 353 push(@A, [2, "Hash '$sha1' does not exist in queue"]); 354 } 355 elsif($command eq 'get' or $command eq '') { 356 my $comments = $so->GetComments; 357 my $count = 0; 358 my $sorter = {}; 359 foreach my $xref (@$comments) { 360 $sorter->{$xref->{ts}.$count} = "rating=$xref->{rating}, at=".localtime($xref->{ts}).", comment=$xref->{text}"; 361 $count++; 362 } 363 if($count) { 364 push(@A, [1, "$sha1: displaying $count comment(s)"]); 365 map( { push(@A, [0, $sorter->{$_}]) } sort({$b<=>$a} keys(%$sorter)) ); 366 } 367 else { 368 push(@A, [2, "$sha1: no comments received (yet)"]); 369 } 370 } 371 elsif($command eq 'set' && length($text)) { 372 my $own_ranking = 0; 373 if($text =~ /^@(\d)\s+(.+)$/) { 374 $own_ranking = $1 if $1 >= 1 && $1 <= 5; 375 $text = $2; 376 } 377 $so->SetOwnComment($own_ranking, $text); 378 push(@A, [1, "$sha1: comment '$text' saved."]); 379 } 380 else { 381 $NOEXEC .= "Usage: comment queue_id [get | set [\@ranking] text]"; 382 } 383 return({MSG=>\@A, SCRAP=>[], NOEXEC=>$NOEXEC}); 384} 385=cut 386 387########################################################################## 388# Create a new storage subdirectory 389sub CreateStorage { 390 my($self, %args) = @_; 391 392 my $sid = $args{StorageId}; 393 my $metadir = $self->_GetMetadir($sid); 394 my $workdir = $self->{super}->Tools->GetExclusiveDirectory($self->_GetWorkdir, $self->_FsSaveDirent($sid)); 395 396 if($sid ne $self->_FsSaveStorageId($sid)) { 397 $self->panic("$sid is not a valid storage id"); 398 } 399 elsif(-d $metadir) { 400 $self->panic("$metadir exists!"); 401 } 402 elsif(!defined($workdir)) { 403 $self->panic("Failed to find an exclusive directory for $sid"); 404 } 405 else { 406 mkdir($workdir) or $self->panic("Unable to mkdir($workdir) : $!"); # Create StoreRoot 407 mkdir($metadir) or $self->panic("Unable to mkdir($metadir) : $!"); # Create metaroot 408 409 # hack to write a setting before the storage is actually created 410 Bitflu::StorageVFS::SubStore::_WriteFile(undef, "$metadir/dirty", 1); 411 412 my $flo = delete($args{FileLayout}); 413 my $flb = ''; 414 my $ddup = {}; 415 foreach my $iref (@$flo) { 416 my @a_path = map($self->_FsSaveDirent($_), @{$iref->{path}}); # should be save now 417 my $path = join('/', @a_path ); 418 419 # check for too-long filenames or paths: 420 if(length($path) > VFS_PATH_MAX) { 421 my $new_path = "\@LongPath_".$self->{super}->Tools->sha1_hex($path); 422 $self->warn("$sid path '$path' too long: converted into '$new_path'"); 423 $path = $new_path; 424 } 425 426 if($ddup->{$path}) { 427 $self->warn("$sid duplicate path: '$path'"); 428 for(my $i=0;; $i++) { 429 $path = sprintf("dedup.%X",$i); 430 last if !$ddup->{$path}; 431 } 432 } 433 434 $ddup->{$path} = 1; 435 $flb .= "$path\0$iref->{start}\0$iref->{end}\n"; 436 } 437 438 if(int($args{Size}/$args{Chunks}) > 0xFFFFFFFF) { 439 # FIXME: Better check ## XAU 440 $self->stop("Chunksize too big, storage plugin can't handle such big values"); 441 } 442 443 # unset it before we go into SubStore 'mode' (sets it again) 444 Bitflu::StorageVFS::SubStore::_WriteFile(undef, "$metadir/dirty", 0); 445 446 my $xobject = Bitflu::StorageVFS::SubStore->new(_super => $self, sid => $sid ); 447 448 # Prepare empty progress and done bitfields: 449 for(1..$args{Chunks}) { $xobject->{bf}->{progress} .= pack("N",0); } 450 $xobject->_InitBitfield($xobject->{bf}->{done}, ($args{Chunks}||0)-1); 451 452 $xobject->SetSetting('name', "Unnamed storage created by <$self>"); 453 $xobject->SetSetting('chunks', $args{Chunks}); 454 $xobject->SetSetting('size', $args{Size}); 455 $xobject->SetSetting('overshoot', $args{Overshoot}); 456 $xobject->SetSetting('filelayout', $flb); 457 $xobject->SetSetting('path', $workdir); 458 $xobject->SetSetting('committed', 0); 459 $xobject->SetSetting('wipedata' , 0); # remove data on ->Remove call (even if commited) 460 $xobject->SetSetting('fallocate', 0); # true if ALL files were allocated with fallocate call 461 $xobject->SetSetting('dirty', 0); # Unset dirty flag (set by SubStore->new) 462 $xobject->_SaveMetadata; 463 return $self->OpenStorage($sid); 464 } 465} 466 467########################################################################## 468# Open an existing storage 469sub OpenStorage { 470 my($self, $sid) = @_; 471 472 if(exists($self->{so}->{$sid})) { 473 return $self->{so}->{$sid}; 474 } 475 if( ($sid eq $self->_FsSaveStorageId($sid)) && (-d $self->_GetMetadir($sid)) ) { 476 $self->{so}->{$sid} = Bitflu::StorageVFS::SubStore->new(_super => $self, sid => $sid ); 477 my $so = $self->OpenStorage($sid); 478 $so->_UpdateExcludeList; # Cannot be done in new() because it needs a complete storage 479 $so->_SetDataroot($so->GetSetting('path')); # Same here 480 $so->_CreateDummyFiles; # Assemble dummy files 481 $so->SetSetting('dirty',0); # Mark metadir as clean 482 return $so; 483 } 484 else { 485 return 0; 486 } 487} 488 489 490########################################################################## 491# Kill existing storage directory 492sub RemoveStorage { 493 my($self, $sid) = @_; 494 495 my $basedir = $self->{super}->Configuration->GetValue('workdir'); 496 my $metatmp = $self->{super}->Tools->GetExclusiveTempdir($sid); 497 my $ushrdir = $self->_GetUnsharedDir; 498 my $so = $self->OpenStorage($sid) or $self->panic("Cannot remove non-existing storage with sid '$sid'"); 499 my $sname = $self->_FsSaveDirent($so->GetSetting('name')); # FS-Save name entry 500 my $committed = $so->CommitFullyDone; 501 my $dataroot = $so->_GetDataroot; 502 my @slist = $so->_ListSettings; 503 $sid = $so->_GetSid or $self->panic; # Makes SID save to use 504 505 # -> Now we ditch all metadata 506 rename($self->_GetMetadir($sid), $metatmp) or $self->panic("Cannot rename metadir to $metatmp: $!"); 507 foreach my $mkey (@slist) { 508 unlink($metatmp."/".$mkey) or $self->panic("Cannot remove $mkey: $!"); 509 } 510 rmdir($metatmp) or $self->panic("rmdir($metatmp) failed: $!"); # Remove Tempdir 511 delete($self->{so}->{$sid}) or $self->panic("Cannot remove socache entry"); # ..and cleanup the cache 512 513 if($committed && !$so->GetSetting('wipedata')) { 514 # Download committed (= finished) ? -> Move it to unshared-dir 515 my $ushrdst = join("/",$ushrdir,$sname); 516 517 # check if source and destination are not the same 518 # they will be the same if completed_downloads == unshared_downloads and in this 519 # case we will just skip the rename() call 520 if( join(";",stat($ushrdst)) ne join(";",stat($dataroot)) ) { 521 $ushrdst = $self->{super}->Tools->GetExclusiveDirectory($ushrdir, $sname) or $self->panic("Cannot get exclusive dirname"); 522 rename($dataroot, $ushrdst) or $self->panic("Cannot move $dataroot to $ushrdst: $!"); 523 } 524 525 $self->{super}->Admin->SendNotify("$sid: Moved completed download into $ushrdst"); 526 } 527 else { 528 # Download was not finsihed (or wipe requested), we have to remove all data 529 530 # We'll just re-use the $metatmp dir while working: 531 rename($dataroot, $metatmp) or $self->panic("Could not move $dataroot to $metatmp: $!"); 532 533 for(my $i=0;$i<$so->GetFileCount;$i++) { 534 my $finf = $so->GetFileInfo($i); # File info 535 my $to_unlink = $metatmp."/".$finf->{path}; # Full path of file 536 my @to_rmdir = split('/',$finf->{path}); # Directory Arrow 537 unlink($to_unlink); # Unlinking the file CAN fail (someone might have tampered with it) 538 539 for(2..int(@to_rmdir)) { # 2 because we pop'em at the beginning 540 pop(@to_rmdir); 541 my $this_dirent = $metatmp."/".join('/',@to_rmdir); 542 my $has_data = -2; 543 544 # Count number of dirents (if it still exists...) 545 opendir(DIRENT, $this_dirent) or next; 546 while(my $x = readdir(DIRENT)) { $has_data++; } 547 close(DIRENT); 548 549 unless($has_data) { 550 # Empty? -> Remove it 551 rmdir($this_dirent) or $self->panic("Cannot rmdir($this_dirent): $!"); 552 } 553 554 } 555 } 556 rmdir($metatmp) or $self->warn("Could not remove $metatmp: directory not empty?"); 557 $self->info("$sid: Removed download from local filesystem"); 558 } 559 560 $self->_FlushFileHandles; 561 return 1; 562} 563 564sub ClipboardGet { 565 my($self,$key) = @_; 566 return $self->{cbcache}->{$key}; 567} 568 569sub ClipboardSet { 570 my($self,$key,$value) = @_; 571 $self->{cbcache}->{$key} = $value; 572 return $self->__ClipboardStore; 573} 574 575sub ClipboardRemove { 576 my($self,$key) = @_; 577 delete($self->{cbcache}->{$key}) or $self->panic("Cannot remove non-existing key '$key' from CB"); 578 return $self->__ClipboardStore; 579} 580sub ClipboardList { 581 my($self) = @_; 582 return(keys(%{$self->{cbcache}})); 583} 584 585sub __ClipboardCacheInit { 586 my ($self) = @_; 587 my ($cb, undef) = Bitflu::StorageVFS::SubStore::_ReadFile(undef,$self->__GetClipboardFile); 588 $self->{cbcache} = Storable::thaw($cb); 589 590 if(ref($self->{cbcache}) ne 'HASH') { 591 $self->stop("ClipboardFile '".$self->__GetClipboardFile."' is corrupted! (try to remove the file)"); 592 } 593} 594 595sub __ClipboardStore { 596 my($self) = @_; 597 return Bitflu::StorageVFS::SubStore::_WriteFile(undef, $self->__GetClipboardFile, Storable::nfreeze($self->{cbcache})); 598} 599 600sub __GetClipboardFile { 601 my($self) = @_; 602 return $self->_GetMetabasedir."/clipboard"; 603} 604 605########################################################################## 606# Returns path to metas directory 607sub _GetMetabasedir { 608 my($self) = @_; 609 return $self->{conf}->{dir_meta}; 610} 611 612########################################################################## 613# Returns direcotry of given sid 614sub _GetMetadir { 615 my($self,$sid) = @_; 616 return $self->_GetMetabasedir."/".$self->_FsSaveStorageId($sid); 617} 618 619########################################################################## 620# Return basedir of incomplete downloads 621sub _GetWorkdir { 622 my($self) = @_; 623 return $self->{conf}->{dir_work}; 624} 625 626########################################################################## 627# Return basedir of completed downloads 628sub _GetDonedir { 629 my($self) = @_; 630 return $self->{conf}->{dir_done}; 631} 632 633########################################################################## 634# Return basedir of unshared downloads 635sub _GetUnsharedDir { 636 my($self) = @_; 637 return $self->{conf}->{dir_ushr}; 638} 639 640########################################################################## 641# Returns an array of all existing storage directories 642sub GetStorageItems { 643 my($self) = @_; 644 my $metaroot = $self->_GetMetabasedir; 645 my @Q = (); 646 opendir(XDIR, $metaroot) or return $self->panic("Unable to open $metaroot : $!"); 647 foreach my $item (readdir(XDIR)) { 648 next if !(-d $metaroot."/".$item); 649 next if $item eq "."; 650 next if $item eq ".."; 651 push(@Q, $item); 652 } 653 closedir(XDIR); 654 return \@Q; 655} 656 657########################################################################## 658# Removes evil chars from StorageId 659sub _FsSaveStorageId { 660 my($self,$val) = @_; 661 $val = lc($val); 662 $val =~ tr/a-z0-9//cd; 663 $val .= "0" x 40; 664 return(substr($val,0,40)); 665} 666 667########################################################################## 668sub _FsSaveDirent { 669 my($self, $val) = @_; 670 $val =~ tr/\/\0\n\r/_/; 671 $val =~ s/^\.\.?/_/; 672 $val ||= "NULL"; 673 $val = "\@LongName_".$self->{super}->Tools->sha1_hex($val) if length($val) > VFS_FNAME_MAX; 674 return $val; 675} 676 677 678########################################################################## 679# Returns a filehandle and tries to cache it 680sub _FetchFileHandle { 681 my($self, $path) = @_; 682 683 my $NOW = $self->{super}->Network->GetTime; 684 my $fhc = $self->{fhcache}; 685 686 687 if(exists($fhc->{$path})) { 688 $fhc->{$path}->{lastuse} = $NOW 689 } 690 else { 691 692 # Fixme: This scales VERY bad. 693 # Maybe we could stop the search after we hit something with age >= 20 or so.. 694 my @keys = keys(%$fhc); 695 if(int(@keys) >= MAX_FHCACHE) { 696 my $oldest_time = $NOW; 697 my $oldest_path = undef; 698 foreach my $key (@keys) { 699 if($fhc->{$key}->{lastuse} <= $oldest_time) { 700 $oldest_time = $fhc->{$key}->{lastuse}; 701 $oldest_path = $key; 702 } 703 } 704 $self->_CloseFileHandle($oldest_path); 705 } 706 707 open(my($ofh), "+<", $path) or $self->panic("Cannot open file $path : $!"); 708 binmode($ofh); 709 710 $fhc->{$path} = { fh=>$ofh, lastuse=>$NOW}; 711 712 } 713 714 return $fhc->{$path}->{fh}; 715} 716 717sub _FlushFileHandles { 718 my($self) = @_; 719 720 $self->debug("Flushing all cached filehandles:"); 721 722 foreach my $k (keys(%{$self->{fhcache}})) { 723 $self->debug("_FlushFileHandles: $k"); 724 $self->_CloseFileHandle($k); 725 } 726} 727 728sub _CloseFileHandle { 729 my($self, $path) = @_; 730 my $fhc = $self->{fhcache}; 731 close($fhc->{$path}->{fh}) or $self->panic("Cannot close $path : $!"); 732 delete($fhc->{$path}) or $self->panic; 733} 734 735sub _CommandFhCache { 736 my($self) = @_; 737 738 my @MSG = (); 739 my $fhc = $self->{fhcache}; 740 my $NOW = $self->{super}->Network->GetTime; 741 742 push(@MSG, [1, "Cached Filehandles:"]); 743 foreach my $k (keys(%$fhc)) { 744 push(@MSG, [3, sprintf(" > %-64s -> Unused since %d sec [$fhc->{$k}->{fh}]", substr($k,-64), ($NOW-($fhc->{$k}->{lastuse})))]); 745 } 746 747 return({MSG=>\@MSG, SCRAP=>[], NOEXEC=>''}); 748} 749 750sub debug { my($self, $msg) = @_; $self->{super}->debug("Storage : ".$msg); } 751sub info { my($self, $msg) = @_; $self->{super}->info("Storage : ".$msg); } 752sub panic { my($self, $msg) = @_; $self->{super}->panic("Storage : ".$msg); } 753sub stop { my($self, $msg) = @_; $self->{super}->stop("Storage : ".$msg); } 754sub warn { my($self, $msg) = @_; $self->{super}->warn("Storage : ".$msg); } 755 756 7571; 758 759package Bitflu::StorageVFS::SubStore; 760use strict; 761use constant MAXCACHE => 256; # Do not cache data above 256 bytes 762use constant CHUNKSIZE => 1024*512; # Must NOT be > than Network::MAXONWIRE; 763 764use fields qw( _super sid scache bf fomap fo _datafsync ); 765 766sub new { 767 my($class, %args) = @_; 768 my $ssid = $args{_super}->_FsSaveStorageId($args{sid}); 769 770 my $ptype = { _super => $args{_super}, 771 sid => $ssid, 772 scache => {}, 773 bf => { free => [], done => [], exclude => [], progress=>'' }, 774 fomap => [], 775 fo => [], 776 _datafsync => 0, 777 }; 778 779 my $self = fields::new($class); 780 map( $self->{$_} = delete($ptype->{$_}), keys(%$ptype) ); 781 782 $self->_KillCorruptedStorage($ssid) if $self->GetSetting('dirty'); # die if this was a dirty metadir 783 $self->SetSetting('dirty', 1); # still here? mark it as dirty 784 785 # Set DataFsync flag 786 $self->{_datafsync} = 1 if $self->{_super}->{super}->Configuration->GetValue('vfs_datafsync'); 787 788 # Cache file-layout 789 my @fo = split(/\n/, ( $self->GetSetting('filelayout') || '' ) ); # May not yet exist 790 $self->{fo} = \@fo; 791 792 # Build bitmasks: 793 my $num_chunks = ($self->GetSetting('chunks') || 0)-1; # Can be -1 794 my $c_size = ($self->GetSetting('size')); 795 796 # Init some internal stuff: 797 $self->_InitBitfield($self->{bf}->{free}, $num_chunks); # everything is done 798 $self->_SetBitfield($self->{bf}->{done}, $self->GetSetting('bf_done') || ''); # read from bitfield 799 $self->{bf}->{progress} = $self->GetSetting('bf_progress'); 800 801 $self->_KillCorruptedStorage($ssid) if( $num_chunks+1 && $c_size < 1 ); 802 $self->_KillCorruptedStorage($ssid) if( $num_chunks+1 && ($num_chunks+1)*4 != length($self->{bf}->{progress}) ); 803 804 # Build freelist from done information 805 for(0..$num_chunks) { 806 if(! $self->_GetBit($self->{bf}->{done}, $_)) { 807 $self->_SetBit($self->{bf}->{free}, $_); 808 } 809 } 810 811 # We are almost done: build the fomap (index=first_piece, value=file_index) 812 my $fo_i = 0; 813 foreach my $this_fo (@fo) { 814 my($fo_path, $fo_start, $fo_end) = split(/\0/, $this_fo); # fixme: this is only really needed for debugging - how about removing it? 815 my ($piece_start, $piece_end) = $self->GetPieceRange($fo_i); 816 817 $self->debug("FoMap: Start=$piece_start, End=$piece_end, StreamStart=$fo_start, StreamEnd=$fo_end-1, Psize=$c_size, Index=$fo_i"); 818 819 for($piece_start..$piece_end) { 820 push(@{$self->{fomap}->[$_]}, $fo_i); 821 } 822 $fo_i++; 823 } 824 825 826 return $self; 827} 828 829sub _KillCorruptedStorage { 830 my($self,$ssid) = @_; 831 832 $self->warn("$ssid: corrupted metadata detected!"); 833 834 my $cx_metadir = $self->_GetMetadir($ssid); 835 my $cx_dataroot = $self->_GetDataroot; 836 my $cx_dumpdir = $self->{_super}->{super}->Tools->GetExclusiveTempdir("$ssid.corrupted"); 837 838 $self->warn("$ssid: moving corrupted data into $cx_dumpdir"); 839 840 mkdir($cx_dumpdir) or $self->panic("failed to create directory $cx_dumpdir : $!"); 841 rename($cx_dataroot, "$cx_dumpdir/data") or $self->panic("failed to move $cx_dataroot : $!"); 842 rename($cx_metadir, "$cx_dumpdir/meta") or $self->panic("failed to move $cx_metadir : $!"); 843 844 $self->stop("Stopping due to corrupted metadata. Please restart bitflu!"); 845 die "NOTREACHED"; 846} 847 848sub _GetDataroot { 849 my($self) = @_; 850 return ( $self->GetSetting('path') or $self->panic("No dataroot?!") ); 851} 852 853sub _SetDataroot { 854 my($self, $path) = @_; 855 $self->{_super}->_FlushFileHandles; 856 $self->SetSetting('path', $path); 857} 858 859########################################################################## 860# Return SID 861sub _GetSid { 862 my($self) = @_; 863 return $self->{sid}; 864} 865 866########################################################################## 867# Return metadir 868sub _GetMetadir { 869 my($self) = @_; 870 return ( $self->{_super}->_GetMetadir($self->{sid}) or $self->panic("No metadir?!") ); 871} 872 873########################################################################## 874# Store metadata for this SO 875sub _SaveMetadata { 876 my($self) = @_; 877 $self->SetSetting('bf_done', $self->_DumpBitfield($self->{bf}->{done})); 878 $self->SetSetting('bf_progress', $self->{bf}->{progress}); 879} 880 881########################################################################## 882# Returns '1' if given SID is currently commiting 883sub CommitIsRunning { 884 my($self) = @_; 885 # Commit is never running 886 return 0; 887} 888 889########################################################################## 890# Returns '1' if this file has been assembled without any errors 891sub CommitFullyDone { 892 my($self) = @_; 893 return $self->GetSetting('committed'); 894} 895 896########################################################################## 897# Returns '1' if this download uses sparsefiles 898sub UsesSparsefile { 899 my($self) = @_; 900 return ( $self->GetSetting('fallocate') ? 0 : 1 ); 901} 902 903########################################################################## 904# Save a setting but only save it sometimes (for unimportant data) 905sub SetSloppySetting { 906 my($self,$key,$val) = @_; 907 908 $self->panic("Invalid key: $key") if $key ne $self->_CleanString($key); 909 my $oldval = $self->GetSetting($key); 910 911 if(!defined($oldval) || int(rand(0xFF)) == 3) { 912 return $self->SetSetting($key,$val); 913 } 914 # else: mem-update only 915 $self->{scache}->{$key} = $val; 916 return 1; 917} 918 919########################################################################## 920# Save substorage settings (.settings) 921sub SetSetting { 922 my($self,$key,$val) = @_; 923 924 $self->panic("Invalid key: $key") if $key ne $self->_CleanString($key); 925 926 my $oldval = $self->GetSetting($key); 927 928 if(defined($oldval) && $oldval eq $val) { 929 return 1; 930 } 931 else { 932 $self->{scache}->{$key} = $val; 933 return $self->_WriteFile($self->_GetMetadir."/$key",$val); # update on-disk copy 934 } 935} 936 937########################################################################## 938# Get substorage settings (.settings) 939sub GetSetting { 940 my($self,$key) = @_; 941 942 return $self->{scache}->{$key} if exists($self->{scache}->{$key}); 943 944 # -> cache miss 945 $self->panic("Invalid key: $key") if $key ne $self->_CleanString($key); 946 947 my ($xval,$size) = $self->_ReadFile($self->_GetMetadir."/$key"); 948 $self->{scache}->{$key} = $xval if $size <= MAXCACHE; 949 950 return $xval; 951} 952 953########################################################################## 954# Removes an item from .settings 955sub _RemoveSetting { 956 my($self,$key) = @_; 957 958 $key = $self->_CleanString($key); 959 if(defined($self->GetSetting($key))) { 960 unlink($self->_GetMetadir."/$key") or $self->panic("Unable to unlink $key: $!"); 961 delete($self->{scache}->{$key}); 962 } 963 else { 964 $self->panic("Cannot remove non-existing key '$key' from $self"); 965 } 966} 967 968########################################################################## 969# Retuns a list of all settings 970sub _ListSettings { 971 my($self) = @_; 972 my $mdir = $self->_GetMetadir; 973 opendir(SDIR, $mdir) or $self->panic("Cannot open metadir of $self"); 974 my @list = grep { -f $mdir."/".$_ } readdir(SDIR); 975 closedir(SDIR); 976 return @list; 977} 978 979 980########################################################################## 981# Bumps $value into $file 982sub _WriteFile { 983 my($self,$file,$value) = @_; 984 Carp::cluck("OUCH! UNDEF WRITE\n") if !defined($value); 985 986 my $tmpfile = $file.".\$tmp\$"; 987 open(XFILE, ">", $tmpfile) or $self->panic("Unable to write $tmpfile : $!"); 988 binmode(XFILE) or $self->panic("Cannot set binmode in $tmpfile : $!"); 989 print XFILE $value or $self->panic("Cannot write to $tmpfile : $!"); 990 991 if(!$self or $self->{_datafsync}) { 992 # only call fsync during setup (!$self) or if it was 993 # enabled in this reference 994 XFILE->flush or $self->panic("Could not flush filehandle: $!"); 995 XFILE->sync or $self->panic("Could not fsync filehandle: $!"); 996 } 997 998 close(XFILE) or $self->panic("Cannot close $tmpfile : $!"); 999 rename($tmpfile, $file) or $self->panic("Unable to rename $tmpfile into $file : $!"); 1000 return 1; 1001} 1002 1003########################################################################## 1004# Reads WHOLE $file and returns string or undef on error 1005sub _ReadFile { 1006 my($self,$file) = @_; 1007 open(XFILE, "<", $file) or return (undef,0); 1008 binmode(XFILE) or $self->panic("Cannot set binmode on $file : $!"); 1009 my $size = (stat(*XFILE))[7]; 1010 my $buff = join('', <XFILE>); 1011 close(XFILE); 1012 return ($buff,$size); 1013} 1014 1015########################################################################## 1016# Removes evil chars 1017sub _CleanString { 1018 my($self,$string) = @_; 1019 $string =~ tr/0-9a-zA-Z\._ //cd; 1020 return $string; 1021} 1022 1023########################################################################## 1024# Store given data inside a chunk, returns current offset, dies on error 1025sub WriteData { 1026 my($self, %args) = @_; 1027 my $offset = $args{Offset}; 1028 my $length = $args{Length}; 1029 my $dataref = $args{Data}; 1030 my $chunk = int($args{Chunk}); 1031 my $nogrow = $args{NoGrow}; 1032 my $foitems = $self->{fomap}->[$chunk]; 1033 my $strm_start = $offset+($self->GetSetting('size')*$chunk); 1034 my $strm_end = $strm_start+$length; 1035 my $chunk_border = ($self->GetSetting('size')*($chunk+1)); 1036 my $didwrite = 0; 1037 my $expct_offset= $offset+$length; 1038 1039 $self->panic("Crossed pieceborder! ($strm_end > $chunk_border)") if $strm_end > $chunk_border; 1040 1041 my $fox = {}; 1042 foreach my $folink (@$foitems) { 1043 my $finf = $self->GetFileInfo($folink); 1044 push(@{$fox->{$finf->{start}}}, $finf); 1045 } 1046 1047 foreach my $akey (sort({$a <=> $b} keys(%$fox))) { 1048 foreach my $finf (@{$fox->{$akey}}) { 1049 my $file_seek = 0; # Seek to this position in file 1050 my $canwrite = $length; # How much data we'll write 1051 my $fp = $self->_GetDataroot."/$finf->{path}"; # Full Path 1052 1053 if($strm_start > $finf->{start}) { 1054 # Requested data does not start at offset 0 -> Seek in file 1055 $file_seek = $strm_start - $finf->{start}; 1056 } 1057 1058 if($file_seek > $finf->{size}) { 1059 # File does not include this data 1060 next; 1061 } 1062 elsif($canwrite > ($finf->{size}-$file_seek)) { 1063 $canwrite = ($finf->{size}-$file_seek); # Cannot read so much data.. 1064 } 1065 1066 my $xfh = $self->{_super}->_FetchFileHandle($fp); 1067 sysseek($xfh, $file_seek, 0) or $self->panic("Cannot seek to position $file_seek in $fp : $!"); 1068 (syswrite($xfh, ${$dataref}, $canwrite) == $canwrite) or $self->panic("Short write in $fp: $!"); 1069 1070 ${$dataref} = substr(${$dataref}, $canwrite); 1071 $length -= $canwrite; 1072 $self->panic() if $length < 0; 1073 } 1074 } 1075 1076 if($length) { 1077 $self->panic("Did not write requested data: length is set to $length (should be 0 bytes), sid:".$self->_GetSid); 1078 } 1079 1080 substr($self->{bf}->{progress},$chunk*4,4,pack("N",$expct_offset)) unless $nogrow; 1081 1082 return $expct_offset; 1083} 1084 1085sub ReadDoneData { 1086 my($self, %args) = @_; 1087 $self->IsSetAsDone($args{Chunk}) or $self->panic("$args{Chunk} is NOT set as done!"); 1088 return $self->_ReadData(%args); 1089} 1090 1091sub ReadInworkData { 1092 my($self, %args) = @_; 1093 $self->IsSetAsInwork($args{Chunk}) or $self->panic("$args{Chunk} is NOT set as done!"); 1094 return $self->_ReadData(%args); 1095} 1096 1097sub _ReadData { 1098 my($self, %args) = @_; 1099 my $offset = $args{Offset}; 1100 my $length = $args{Length}; 1101 my $chunk = int($args{Chunk}); 1102 my $foitems = $self->{fomap}->[$chunk]; 1103 my $strm_start = $offset+($self->GetSetting('size')*$chunk); 1104 my $strm_end = $strm_start+$length; 1105 my $chunk_border = ($self->GetSetting('size')*($chunk+1)); 1106 my $didread = 0; 1107 my $buff = ''; 1108 1109 $self->panic("Crossed pieceborder! ($strm_end > $chunk_border)") if $strm_end > $chunk_border; 1110 1111 my $fox = {}; 1112 foreach my $folink (@$foitems) { 1113 my $finf = $self->GetFileInfo($folink); 1114 push(@{$fox->{$finf->{start}}}, $finf); 1115 } 1116 1117 foreach my $akey (sort({$a <=> $b} keys(%$fox))) { 1118 foreach my $finf (@{$fox->{$akey}}) { 1119 my $file_seek = 0; # Seek to this position in file 1120 my $canread = $length; # How much data we'll read 1121 my $fp = $self->_GetDataroot."/$finf->{path}"; # Full Path 1122 my $xb = ''; # Buffer for sysread output 1123 if($strm_start > $finf->{start}) { 1124 # Requested data does not start at offset 0 -> Seek in file 1125 $file_seek = $strm_start - $finf->{start}; 1126 } 1127 1128 if($file_seek > $finf->{size}) { 1129 # File does not include this data 1130 next; 1131 } 1132 elsif($canread > ($finf->{size}-$file_seek)) { 1133 $canread = ($finf->{size}-$file_seek); # Cannot read so much data.. 1134 } 1135 1136 my $xfh = $self->{_super}->_FetchFileHandle($fp); 1137 sysseek($xfh, $file_seek, 0) or $self->panic("Cannot seek to position $file_seek in $fp : $!"); 1138 (Bitflu::Tools::Sysread(undef,$xfh, \$xb, $canread) == $canread) or $self->panic("Short read in $fp (wanted $canread bytes at offset $file_seek): $!"); 1139 1140 $buff .= $xb; 1141 $length -= $canread; 1142 $self->panic() if $length < 0; 1143 } 1144 } 1145 1146 if($length) { 1147 $self->panic("Did not write requested data: length is set to $length (should be 0 bytes), sid:".$self->_GetSid); 1148 } 1149 1150 1151 return $buff; 1152} 1153 1154 1155 1156#################################################################################################################################################### 1157# Misc stuff 1158#################################################################################################################################################### 1159 1160sub Truncate { 1161 my($self, $chunknum, $newsize) = @_; 1162 $newsize = 0 unless $newsize; 1163 $self->IsSetAsInwork($chunknum) or $self->panic; 1164 substr($self->{bf}->{progress},$chunknum*4,4,pack("N",$newsize)); 1165} 1166 1167 1168#################################################################################################################################################### 1169# SetAs 1170#################################################################################################################################################### 1171 1172sub SetAsInworkFromDone { 1173 my($self, $chunknum) = @_; 1174 1175 if($self->IsSetAsDone($chunknum)) { 1176 $self->_UnsetBit($self->{bf}->{done}, $chunknum); 1177 } 1178 else { 1179 $self->panic("Cannot call SetAsInworkFromDone($chunknum) on non-done piece"); 1180 } 1181} 1182 1183sub SetAsInwork { 1184 my($self, $chunknum) = @_; 1185 if($self->IsSetAsFree($chunknum)) { 1186 $self->_UnsetBit($self->{bf}->{free}, $chunknum); 1187 } 1188 else { 1189 $self->panic("Cannot call SetAsInwork($chunknum) on invalid piece"); 1190 } 1191} 1192 1193sub SetAsDone { 1194 my($self, $chunknum) = @_; 1195 if($self->IsSetAsInwork($chunknum)) { 1196 $self->_SetBit($self->{bf}->{done}, $chunknum); 1197 } 1198 else { 1199 $self->panic("Cannot call SetAsDone($chunknum) on invalid piece"); 1200 } 1201} 1202 1203sub SetAsFree { 1204 my($self, $chunknum) = @_; 1205 if($self->IsSetAsInwork($chunknum)) { 1206 $self->_SetBit($self->{bf}->{free}, $chunknum); 1207 } 1208 else { 1209 $self->panic("Cannot call SetAsFree($chunknum) on invalid piece"); 1210 } 1211} 1212 1213#################################################################################################################################################### 1214# IsSetAs 1215#################################################################################################################################################### 1216sub IsSetAsFree { 1217 my($self, $chunknum) = @_; 1218 return $self->_GetBit($self->{bf}->{free}, $chunknum); 1219} 1220 1221sub IsSetAsInwork { 1222 my($self, $chunknum) = @_; 1223 if( !($self->_GetBit($self->{bf}->{free}, $chunknum)) && !($self->_GetBit($self->{bf}->{done}, $chunknum)) ) { 1224 return 1; 1225 } 1226 else { 1227 return 0; 1228 } 1229} 1230 1231sub IsSetAsDone { 1232 my($self, $chunknum) = @_; 1233 return $self->_GetBit($self->{bf}->{done}, $chunknum); 1234} 1235 1236sub IsSetAsExcluded { 1237 my($self, $chunknum) = @_; 1238 return $self->_GetBit($self->{bf}->{exclude}, $chunknum); 1239} 1240 1241 1242sub _SetBit { 1243 my $bitref = $_[1]; 1244 my $bitnum = $_[2]; 1245 my $bfIndex = int($bitnum / 8); 1246 $bitnum -= 8*$bfIndex; 1247 vec($bitref->[$bfIndex],(7-$bitnum),1) = 1; 1248} 1249 1250sub _UnsetBit { 1251 my $bitref = $_[1]; 1252 my $bitnum = $_[2]; 1253 my $bfIndex = int($bitnum / 8); 1254 $bitnum -= 8*$bfIndex; 1255 vec($bitref->[$bfIndex],(7-$bitnum),1) = 0; 1256} 1257 1258sub _GetBit { 1259 my $bitref = $_[1]; 1260 my $bitnum = $_[2]; 1261 die "Ouch\n" unless defined $bitnum; 1262 my $bfIndex = int($bitnum / 8); 1263 $bitnum -= 8*$bfIndex; 1264 return vec($bitref->[$bfIndex], (7-$bitnum), 1); 1265} 1266 1267sub _InitBitfield { 1268 my $bitref = $_[1]; 1269 my $count = $_[2]; 1270 my $bfLast = int($count / 8); 1271 for(0..$bfLast) { 1272 $bitref->[$_] = chr(0); 1273 } 1274} 1275 1276sub _SetBitfield { 1277 my $bitref = $_[1]; 1278 my $string = $_[2]; 1279 for(my $i=0; $i<length($string);$i++) { 1280 $bitref->[$i] = substr($string,$i,1); 1281 } 1282} 1283 1284sub _DumpBitfield { 1285 my($self, $bitref) = @_; 1286 return join('', @{$bitref}); 1287} 1288 1289#################################################################################################################################################### 1290# Exclude and priority stuff 1291#################################################################################################################################################### 1292 1293## -> EXCLUDE 1294sub _UpdateExcludeList { 1295 my($self) = @_; 1296 1297 my $num_chunks = ($self->GetSetting('chunks')||0)-1; 1298 my $unq_exclude = $self->GetExcludeHash; 1299 my $ref_exclude = $self->{bf}->{exclude}; 1300 1301 # Pseudo-Exclude all pieces 1302 $self->_InitBitfield($ref_exclude,$num_chunks); 1303 for(0..$num_chunks) { 1304 $self->_SetBit($ref_exclude,$_); 1305 } 1306 1307 # Now we are going to re-exclude all non-excluded files: 1308 for(my $i=0; $i < $self->GetFileCount; $i++) { 1309 unless($unq_exclude->{$i}) { # -> Not excluded -> Zero-Out all used bytes 1310 my ($first, $last) = $self->GetPieceRange($i); 1311 for($first..$last) { $self->_UnsetBit($ref_exclude,$_); } 1312 } 1313 } 1314} 1315 1316sub GetExcludeHash { 1317 my($self) = @_; 1318 return $self->_GetGenericHashfile('exclude'); 1319} 1320 1321sub GetExcludeCount { 1322 my($self) = @_; 1323 my $eh = $self->GetExcludeHash; 1324 return int(keys(%$eh)); 1325} 1326 1327sub _SetExcludeHash { 1328 my($self, $ref) = @_; 1329 $self->SetSetting('exclude',join(',', keys(%$ref))); 1330 $self->_UpdateExcludeList; 1331} 1332 1333## -> RATING 1334 1335# Returns the 'local' rating, 0 if not set 1336sub GetLocalRating { 1337 my($self) = @_; 1338 return int( $self->GetSetting('rating_local') || 0 ); 1339} 1340 1341# updates the 'local' rating.. value==0 to unset it 1342sub SetLocalRating { 1343 my($self, $value) = @_; 1344 $self->SetSetting('rating_local', int($value)); 1345} 1346 1347# returns the avg. remote rating 1348sub GetRemoteRating { 1349 my($self) = @_; 1350 my $val = ( $self->GetSetting('rating_remote') || "0 0" ); 1351 my $rating = 0; 1352 1353 if($val =~ /^([0-9\.]+) ([0-9\.]+)$/) { 1354 $rating = ($1 + $2) / 2; 1355 } 1356 1357 return $rating; 1358} 1359 1360# updates the remote rating. 1361sub UpdateRemoteRating { 1362 my($self,$value) = @_; 1363 my $old_rating = ($self->GetRemoteRating || $value || 0); 1364 $self->SetSetting('rating_remote', "$old_rating $value"); 1365} 1366 1367=head 1368## -> COMMENTSCODE 1369 1370########################################################################## 1371# Updates the list of cached comments 1372sub UpdateComments { 1373 my($self, $carray) = @_; 1374 my $dedupe = {}; 1375 my $limit = 50; # never save more than 50 comments 1376 my $cached = $self->GetComments; 1377 foreach my $this_comment (@$carray, @$cached) { 1378 my $txt = unpack("H*", $this_comment->{text}); 1379 next if length($txt) == 0; # wont save empty comments 1380 next if exists($dedupe->{$txt}); # already exists 1381 next if $this_comment->{rating} < 0; # rating is always >= 0 1382 next if $this_comment->{rating} > 5; # 5 stars are the max 1383 $dedupe->{$txt} = join(" ", $txt, abs(int($this_comment->{rating})), abs(int($this_comment->{ts}))); 1384 last if --$limit < 0; 1385 } 1386 my @alist = map({ $_ } values(%$dedupe)); 1387 $self->SetSloppySetting('comments_cache', join("\n", @alist)); 1388} 1389 1390########################################################################## 1391# Returns all cached comments (including our own comment) 1392sub GetComments { 1393 my($self) = @_; 1394 my @l = (); # returned list 1395 my $own = $self->GetOwnComment; # reference to own comment, may be undef 1396 my $skip = ''; # skip comments with this text 1397 1398 if($own) { 1399 push(@l, $own); # add own comment 1400 $skip = $own->{text}; # and ditch our own from the cached copy 1401 } 1402 1403 foreach my $item (split("\n", ($self->GetSetting('comments_cache') || ''))) { 1404 my @parts = split(" ", $item); 1405 my $text = pack("H*", $parts[0]); 1406 push(@l, { text=>$text, rating=>$parts[1], ts=>$parts[2] }) if $text ne $skip; 1407 } 1408 1409 return \@l; 1410} 1411 1412########################################################################## 1413# Updates user-set comment 1414sub SetOwnComment { 1415 my($self, $rating, $text) = @_; 1416 $self->panic("invalid rating!") if $rating < 0 or $rating > 5; 1417 $self->SetSetting('comments_local', join(" ", unpack("H*",$text), abs(int($rating)), time())); 1418} 1419 1420########################################################################## 1421# Returns user-set comment, undef if there is none 1422sub GetOwnComment { 1423 my($self) = @_; 1424 my $str = $self->GetSetting('comments_local') || ''; 1425 return undef if length($str) == 0; 1426 my @parts = split(" ",$str); 1427 return { text=>pack("H*", $parts[0]), rating=>$parts[1], ts=>$parts[2] }; 1428} 1429=cut 1430 1431## -> PRIORITY 1432sub GetPriorityHash { 1433 my($self) = @_; 1434 return $self->_GetGenericHashfile('priority'); 1435} 1436 1437sub _SetPriorityHash { 1438 my($self,$ref) = @_; 1439 $self->SetSetting('priority', join(',',keys(%$ref))); 1440} 1441 1442sub _GetGenericHashfile { 1443 my($self,$name) = @_; 1444 my $x = {}; 1445 my $fc = $self->GetFileCount; 1446 my $str = $self->GetSetting($name); 1447 $str = '' unless defined($str); # cannot use || because this would match '0' 1448 foreach my $item (split(/,/,$str)) { 1449 next if $item < 0 or $item >= $fc; 1450 $x->{$item}=1; 1451 } 1452 return $x; 1453} 1454 1455 1456 1457 1458sub GetSizeOfInworkPiece { 1459 my($self,$chunknum) = @_; 1460 $self->IsSetAsInwork($chunknum) or $self->panic; 1461 return unpack("N", substr($self->{bf}->{progress},$chunknum*4,4)); 1462} 1463sub GetSizeOfFreePiece { 1464 my($self,$chunknum) = @_; 1465 $self->IsSetAsFree($chunknum) or $self->panic; 1466 return unpack("N", substr($self->{bf}->{progress},$chunknum*4,4)); 1467} 1468sub GetSizeOfDonePiece { 1469 my($self,$chunknum) = @_; 1470 $self->IsSetAsDone($chunknum) or $self->panic; 1471 return unpack("N", substr($self->{bf}->{progress},$chunknum*4,4)); 1472} 1473 1474 1475########################################################################## 1476# Gets a single file chunk 1477sub GetFileChunk { 1478 my($self,$file,$chunk) = @_; 1479 1480 $file = int($file); 1481 $chunk = int($chunk); 1482 my $fi = $self->GetFileInfo($file); # FileInfo reference 1483 my $fp = $self->_GetDataroot."/".$fi->{path}; # Full Path 1484 my $psize = $self->GetSetting('size'); # Piece Size 1485 my $offset = CHUNKSIZE*$chunk; # File offset 1486 1487 if($offset >= $fi->{size}) { 1488 return undef; 1489 } 1490 else { 1491 my $canread = $fi->{size} - $offset; 1492 $canread = ($canread > CHUNKSIZE ? CHUNKSIZE : $canread); 1493 my $thisp_start = int($fi->{start}/$psize); 1494 my $thisp_end = int(($fi->{start}+$canread)/$psize); 1495 my $xb = ''; 1496 my $xfh = $self->{_super}->_FetchFileHandle($fp); 1497 sysseek($xfh, $offset, 0) or $self->panic("Cannot seek to offset $offset in $fp: $!"); 1498 (Bitflu::Tools::Sysread(undef, $xfh, \$xb, $canread) == $canread) or $self->panic("Failed to read $canread bytes from $fp: $!"); 1499 1500 return $xb; 1501 } 1502 $self->panic("Not reached"); 1503} 1504 1505########################################################################## 1506# Return FileLayout 1507sub __GetFileLayout { 1508 my($self) = @_; 1509 return $self->{fo}; 1510} 1511 1512 1513########################################################################## 1514# 'Stat' a virtual file 1515sub GetFileInfo { 1516 my($self,$file) = @_; 1517 $file = int($file); 1518 my $x_entry = $self->__GetFileLayout->[$file] or $self->panic("No such file: $file"); 1519 my ($path,$start,$end) = split(/\0/,$x_entry); 1520 return({path=>$path, start=>$start, end=>$end, size=>$end-$start}); 1521} 1522 1523########################################################################## 1524# Returns chunk information of given file id 1525sub GetFileProgress { 1526 my($self,$fid) = @_; 1527 1528 my($p_first, $p_last) = $self->GetPieceRange($fid); 1529 my $done_chunks = 0; # number of completed pieces/chunks 1530 my $excl_chunks = 0; # nubmer of excluded pieces 1531 my $total_chunks = 0; # total number of chunks used by this fid 1532 1533 for(my $i=$p_first; $i<=$p_last; $i++) { 1534 $done_chunks++ if $self->IsSetAsDone($i); 1535 $excl_chunks++ if $self->IsSetAsExcluded($i); 1536 $total_chunks++; 1537 } 1538 1539 return( { done=>$done_chunks, excluded=>$excl_chunks, chunks=>$total_chunks } ); 1540} 1541 1542########################################################################## 1543# Returns number of files 1544sub GetFileCount { 1545 my($self) = @_; 1546 my $fo = $self->__GetFileLayout; 1547 return int(@$fo); 1548} 1549 1550 1551########################################################################## 1552# Returns the first and last piece/chunk used by this file-index 1553sub GetPieceRange { 1554 my($self,$file) = @_; 1555 my $finfo = $self->GetFileInfo($file); 1556 my $csize = $self->GetSetting('size'); 1557 my $chunks= $self->GetSetting('chunks'); 1558 my $piece_start = int($finfo->{start}/$csize); 1559 my $piece_end = $piece_start; 1560 1561 if($finfo->{end} > $finfo->{start}) { 1562 $piece_end = int(( $finfo->{end}-1 )/$csize); 1563 } 1564 1565 # ugly fixup for zero-sized piece at end 1566 $piece_start = $chunks-1 if $piece_start >= $chunks; 1567 $piece_end = $chunks-1 if $piece_end >= $chunks; 1568 1569## print ">> csize=$csize, start=$finfo->{start}, end=$finfo->{end}, start=$piece_start, end=$piece_end\n"; 1570 1571 return($piece_start,$piece_end); 1572} 1573 1574########################################################################## 1575# Returns max size of given piece 1576sub GetTotalPieceSize { 1577 my($self, $piece) = @_; 1578 my $pieces = $self->GetSetting('chunks'); 1579 my $size = $self->GetSetting('size'); 1580 if($pieces == (1+$piece)) { 1581 # -> LAST piece 1582 $size -= $self->GetSetting('overshoot'); 1583 } 1584 return $size; 1585} 1586 1587########################################################################## 1588# Creates/Fixes storage directory 1589sub _CreateDummyFiles { 1590 my($self) = @_; 1591 1592 unless(-d $self->_GetDataroot) { 1593 $self->warn("Directory '".$self->_GetDataroot."' vanished! (queue-id: ".$self->_GetSid.")"); 1594 $self->warn(" -> I'll try to recreate it (this download will start from zero again...)"); 1595 $self->warn(" -> Please do *not* rename/delete or remove directories of active downloads!"); 1596 mkdir($self->_GetDataroot) or $self->warn("mkdir() failed, going to panic soon.... : $!"); 1597 } 1598 1599 my $use_falloc = $self->{_super}->{super}->Configuration->GetValue('vfs_use_fallocate'); 1600 my $statfs = $self->{_super}->{super}->Syscall->statworkdir; 1601 my $dload_size = $self->GetSetting('size')*$self->GetSetting('chunks'); 1602 my $falloc_ok = 0; 1603 my $falloc_err = 0; 1604 1605 1606 if($use_falloc && ( !$statfs || $statfs->{bytes_free} <= $dload_size )) { 1607 $self->info($self->_GetSid.": disabling fallocate()"); 1608 $use_falloc = 0; 1609 } 1610 1611 for(my $i=0; $i<$self->GetFileCount;$i++) { 1612 my $finf = $self->GetFileInfo($i); # FileInfo 1613 my $d_path = $finf->{path}; # Path of this file 1614 my @a_path = split('/', $d_path); # Array version 1615 my $d_file = pop(@a_path); # Get filename 1616 my $d_base = $self->_GetDataroot; # Dataroot prefix 1617 1618 foreach my $dirent (@a_path) { 1619 $d_base .= "/".$dirent; 1620 next if -d $d_base; 1621 $self->debug("mkdir($d_base)"); 1622 mkdir($d_base) or $self->panic("Failed to mkdir($d_base): $!"); 1623 } 1624 1625 my $filepath = $d_base."/".$d_file; 1626 1627 if( !(-f $filepath) or ((-s $filepath) != $finf->{size}) ) { 1628 $self->debug("Creating/Fixing $filepath"); 1629 open(XF, ">", $filepath) or $self->panic("Failed to create sparsefile $filepath : $!"); 1630 binmode(XF) or $self->panic("Cannot set binmode on $filepath : $!"); 1631 sysseek(XF, $finf->{size},0) or $self->panic("Failed to seek to $finf->{size}: $!"); 1632 1633 if($use_falloc) { 1634 ($self->{_super}->{super}->Syscall->fallocate(*XF, $finf->{size}) ? $falloc_err++ : $falloc_ok++); 1635 } 1636 1637 truncate(XF, $finf->{size}) or $self->panic("Failed to truncate file to $finf->{size}: $!"); 1638 close(XF) or $self->panic("Failed to close FH of $filepath : $!"); 1639 1640 my ($damage_start, $damage_end) = $self->GetPieceRange($i); 1641 1642 for(my $d=$damage_start; $d <= $damage_end; $d++) { 1643 ($self->IsSetAsDone($d) ? $self->SetAsInworkFromDone($d) : $self->SetAsInwork($d)); 1644 $self->Truncate($d); # Mark it as zero-size 1645 $self->SetAsFree($d); # ..and as free 1646 } 1647 } 1648 } 1649 1650 if($falloc_err or $falloc_ok) { 1651 # tried to do some falloc: did it work? 1652 $self->warn("fallocate failed for ".$self->_GetSid." (disk full or unsupported filesystem?)") if $falloc_err; 1653 $self->SetSetting('fallocate', ($falloc_err ? 0 : 1 ) ); 1654 } 1655 1656} 1657 1658 1659sub debug { my($self, $msg) = @_; $self->{_super}->debug("XStorage: ".$msg); } 1660sub info { my($self, $msg) = @_; $self->{_super}->info("XStorage: ".$msg); } 1661sub warn { my($self, $msg) = @_; $self->{_super}->warn("XStorage: ".$msg); } 1662sub stop { my($self, $msg) = @_; $self->{_super}->stop("XStorage : ".$msg); } 1663sub panic { my($self, $msg) = @_; $self->{_super}->panic("XStorage: ".$msg); } 1664 1665 16661; 1667 1668 1669 1670__END__ 1671 1672