Parent Directory
| 
Revision Log
Fixed a problem with reporting the directories where files with given types should be uploaded.
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm,v 1.14 2005/08/22 03:27:59 dpvc Exp $ 5 # 6 # This program is free software; you can redistribute it and/or modify it under 7 # the terms of either: (a) the GNU General Public License as published by the 8 # Free Software Foundation; either version 2, or (at your option) any later 9 # version, or (b) the "Artistic License" which comes with this package. 10 # 11 # This program is distributed in the hope that it will be useful, but WITHOUT 12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS 13 # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the 14 # Artistic License for more details. 15 ################################################################################ 16 17 package WeBWorK::ContentGenerator::Instructor::FileManager; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 use WeBWorK::Utils qw(readDirectory readFile sortByName); 21 use WeBWorK::Upload; 22 use File::Path; 23 use File::Copy; 24 use File::Spec; 25 26 =head1 NAME 27 28 WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manager for WW files 29 30 =cut 31 32 use strict; 33 use warnings; 34 use CGI; 35 36 use constant HOME => 'templates'; 37 38 # 39 # The list of file extensions and the directories they usually go in. 40 # 41 my %uploadDir = ( 42 csv => 'scoring', 43 lst => 'templates', 44 pg => 'templates/.*', 45 pl => 'templates/macros', 46 def => 'templates', 47 html => 'html/.*', 48 ); 49 50 ################################################## 51 # 52 # Check that the user is authorized, and then 53 # see if there is a download to perform. 54 # 55 sub pre_header_initialize { 56 my $self = shift; 57 my $r = $self->r; 58 my $authz = $r->authz; 59 my $user = $r->param('user'); 60 61 unless ($authz->hasPermissions($user, "access_instructor_tools")) { 62 $self->addbadmessage("You aren't authorized to manage course files"); 63 return; 64 } 65 66 my $action = $r->param('action'); 67 $self->Download if ($action && $action eq 'Download'); 68 my $file = $r->param('download'); 69 $self->downloadFile($file) if (defined $file); 70 } 71 72 ################################################## 73 # 74 # Download a given file 75 # 76 sub downloadFile { 77 my $self = shift; 78 my $file = checkName(shift); 79 my $pwd = $self->checkPWD(shift || $self->r->param('pwd') || HOME); 80 return unless $pwd; 81 $pwd = $self->{ce}{courseDirs}{root} . '/' . $pwd; 82 unless (-e "$pwd/$file") { 83 $self->addbadmessage("The file you are trying to download doesn't exist"); 84 return; 85 } 86 unless (-f "$pwd/$file") { 87 $self->addbadmessage("You can only download regular files."); 88 return; 89 } 90 my $type = "application/octet-stream"; 91 $type = "text/plain" if $file =~ m/\.(pg|pl|pm|txt|def|csv|lst)/; 92 $type = "image/gif" if $file =~ m/\.gif/; 93 $type = "image/jpeg" if $file =~ m/\.(jpg|jpeg)/; 94 $type = "image/png" if $file =~ m/\.png/; 95 $self->reply_with_file($type, "$pwd/$file", $file, 0); 96 } 97 98 ################################################## 99 # 100 # The main body of the page 101 # 102 sub body { 103 my $self = shift; 104 my $r = $self->r; 105 my $urlpath = $r->urlpath; 106 my $db = $r->db; 107 my $ce = $r->ce; 108 my $authz = $r->authz; 109 my $courseRoot = $ce->{courseDirs}{root}; 110 my $courseName = $urlpath->arg('courseID'); 111 my $user = $r->param('user'); 112 my $key = $r->param('key'); 113 114 return CGI::em("You are not authorized to access the instructor tools") 115 unless $authz->hasPermissions($user, "access_instructor_tools"); 116 117 $self->{pwd} = $self->checkPWD($r->param('pwd') || HOME); 118 return CGI::em("You have specified an illegal working directory!") unless defined $self->{pwd}; 119 120 my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName); 121 my $fileManagerURL = $self->systemLink($fileManagerPage, authen => 0); 122 123 print CGI::start_multipart_form( 124 -method=>"POST", 125 -action=>$fileManagerURL, 126 -id=>"FileManager", 127 -name=>"FileManager", 128 -style=>"margin:0", 129 ); 130 print $self->hidden_authen_fields; 131 132 $self->{courseRoot} = $courseRoot; 133 $self->{courseName} = $courseName; 134 135 my $action = $r->param('action') || $r->param('formAction') || 'Init'; 136 137 for ($action) { 138 /^Refresh/i and do {$self->Refresh; last}; 139 /^Cancel/i and do {$self->Refresh; last}; 140 /^\^/i and do {$self->ParentDir; last}; 141 /^Directory/i and do {$self->Go; last}; 142 /^Go/i and do {$self->Go; last}; 143 /^View/i and do {$self->View; last}; 144 /^Edit/i and do {$self->Edit; last}; 145 /^Download/i and do {$self->Refresh; last}; 146 /^Copy/i and do {$self->Copy; last}; 147 /^Rename/i and do {$self->Rename; last}; 148 /^Delete/i and do {$self->Delete; last}; 149 /^Make/i and do {$self->MakeArchive; last}; 150 /^Unpack/i and do {$self->UnpackArchive; last}; 151 /^New Folder/i and do {$self->NewFolder; last}; 152 /^New File/i and do {$self->NewFile; last}; 153 /^Upload/i and do {$self->Upload; last}; 154 /^Revert/i and do {$self->Edit; last}; 155 /^Save As/i and do {$self->SaveAs; last}; 156 /^Save/i and do {$self->Save; last}; 157 /^Init/i and do {$self->Init; last}; 158 $self->addbadmessage("Unknown action."); 159 $self->Refresh; 160 } 161 162 print CGI::hidden({name=>'pwd',value=>$self->{pwd}}); 163 print CGI::hidden({name=>'formAction'}); 164 print CGI::end_multipart_form(); 165 166 return ""; 167 } 168 169 170 ################################################## 171 # 172 # First time through 173 # 174 sub Init { 175 my $self = shift; 176 $self->r->param('unpack',1); 177 $self->r->param('autodelete',1); 178 $self->r->param('format','Automatic'); 179 $self->Refresh; 180 } 181 182 sub HiddenFlags { 183 my $self = shift; 184 print CGI::hidden({name=>"dates", value=>$self->getFlag('dates')}); 185 print CGI::hidden({name=>"overwrite", value=>$self->getFlag('overwrite')}); 186 print CGI::hidden({name=>"unpack", value=>$self->getFlag('unpack')}); 187 print CGI::hidden({name=>"autodelete",value=>$self->getFlag('autodelete')}); 188 print CGI::hidden({name=>"format", value=>$self->getFlag('format','Automatic')}); 189 } 190 191 ################################################## 192 # 193 # Display the directory listing and associated buttons 194 # 195 sub Refresh { 196 my $self = shift; 197 my $pwd = shift || $self->{pwd}; 198 my $isTop = $pwd eq '.' || $pwd eq ''; 199 200 my ($dirs,$dirlabels) = directoryMenu($self->{courseName},$pwd); 201 my ($files,$filelabels) = directoryListing($self->{courseRoot},$pwd,$self->getFlag('dates')); 202 203 unless ($files) { 204 $self->addbadmessage("The directory you specified doesn't exist"); 205 $files = []; $filelabels = {}; 206 } 207 208 # 209 # Some JavaScript to make things easier for the user 210 # 211 print CGI::script(<<EOF); 212 function doForm(action) { 213 var form = window.document.getElementById('FileManager'); 214 form.formAction.value = action; 215 form.submit(); 216 } 217 function disableButton(id,state) { 218 var element = window.document.getElementById(id); 219 element.disabled = state; 220 } 221 function checkFiles() { 222 var files = window.document.getElementById('files'); 223 var state = files.selectedIndex < 0; 224 disableButton('View',state); 225 disableButton('Edit',state); 226 disableButton('Download',state); 227 disableButton('Rename',state); 228 disableButton('Copy',state); 229 disableButton('Delete',state); 230 disableButton('MakeArchive',state); 231 checkArchive(files,state); 232 } 233 function checkFile() { 234 var file = window.document.getElementById('file'); 235 if (navigator.vendor && navigator.vendorSub && navigator.vendor == "Netscape") { 236 if (navigator.vendorSub.match(/(\\d+)\.(\\d+)/)) { 237 if (RegExp.\$1 < 7 || (RegExp.\$1 == 7 && RegExp.\$2 < 2)) return; 238 } 239 } 240 var state = (file.value == ""); 241 disableButton('Upload',state); 242 } 243 function checkArchive(files,disabled) { 244 var button = document.getElementById('MakeArchive'); 245 button.value = 'Make Archive'; 246 if (disabled) return; 247 if (!files.childNodes[files.selectedIndex].value.match(/\\.tgz\$/)) return; 248 for (var i = files.selectedIndex+1; i < files.length; i++) 249 {if (files.childNodes[i].selected) return} 250 button.value = 'Unpack Archive'; 251 } 252 EOF 253 254 # 255 # Start the table 256 # 257 print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3, style=>"margin:1em 0 0 3em"}); 258 259 # 260 # Directory menu and date/size checkbox 261 # 262 print CGI::Tr( 263 CGI::td({colspan=>2}, 264 CGI::input({type=>"submit", name=>"action", value => "^", ($isTop? (disabled=>1): ())}), 265 CGI::popup_menu( 266 -name => "directory", 267 -values => $dirs, 268 -labels => $dirlabels, 269 -style => "width:25em", 270 -onChange => "doForm('Go')" 271 ), 272 CGI::noscript(CGI::input({type=>"submit",name=>"action",value=>"Go"})) 273 ), 274 CGI::td(CGI::small(CGI::checkbox( 275 -name => 'dates', 276 -checked => $self->getFlag('dates'), 277 -value => 1, 278 -label => 'Show Date & Size', 279 -onClick => 'doForm("Refresh")', 280 ))), 281 ); 282 283 # 284 # Directory Listing and column of buttons 285 # 286 my %button = (type=>"submit",name=>"action",style=>"width:10em"); 287 my $width = ($self->getFlag('dates') && scalar(@{$files}) > 0) ? "": " width:30em"; 288 print CGI::Tr({valign=>"middle"}, 289 fixSpaces(CGI::td(CGI::scrolling_list( 290 -name => "files", id => "files", 291 -style => "font-family:monospace; $width", 292 -size => 17, 293 -multiple => 1, 294 -values => $files, 295 -labels => $filelabels, 296 -onDblClick => "doForm('View')", 297 -onChange => "checkFiles()" 298 ))), 299 CGI::td({width=>15}), 300 CGI::td( 301 CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3}), 302 CGI::Tr([ 303 CGI::td(CGI::input({%button,value=>"View",id=>"View"})), 304 CGI::td(CGI::input({%button,value=>"Edit",id=>"Edit"})), 305 CGI::td(CGI::input({%button,value=>"Download",id=>"Download"})), 306 CGI::td(CGI::input({%button,value=>"Rename",id=>"Rename"})), 307 CGI::td(CGI::input({%button,value=>"Copy",id=>"Copy"})), 308 CGI::td(CGI::input({%button,value=>"Delete",id=>"Delete"})), 309 CGI::td(CGI::input({%button,value=>"Make Archive",id=>"MakeArchive"})), 310 CGI::td({height=>10}), 311 CGI::td(CGI::input({%button,value=>"New File"})), 312 CGI::td(CGI::input({%button,value=>"New Folder"})), 313 CGI::td(CGI::input({%button,value=>"Refresh"})), 314 ]), 315 CGI::end_table(), 316 ), 317 ); 318 319 # 320 # Upload button and checkboxes 321 # 322 print CGI::Tr([ 323 CGI::td(), 324 CGI::td({colspan=>3}, 325 CGI::input({type=>"submit",name=>"action",style=>"width:7em",value=>"Upload:",id=>"Upload"}), 326 CGI::input({type=>"file",name=>"file",id=>"file",size=>40,onChange=>"checkFile()"}), 327 CGI::br(), 328 CGI::small(join(' ',"Format:", 329 CGI::radio_group('format',['Text','Binary','Automatic'], 330 $self->getFlag('format','Automatic')))), 331 ), 332 ]); 333 print CGI::Tr([ 334 CGI::td(), 335 CGI::td({colspan=>3}, 336 CGI::small(CGI::checkbox('overwrite',$self->getFlag('overwrite'),1, 337 'Overwrite existing files silently')), 338 CGI::br(), 339 CGI::small(CGI::checkbox('unpack',$self->getFlag('unpack'),1, 340 'Unpack archives automatically')), 341 CGI::small(CGI::checkbox('autodelete',$self->getFlag('autodelete'),1, 342 'then delete them')), 343 ), 344 ]); 345 346 # 347 # End the table 348 # 349 print CGI::end_table(); 350 print CGI::script("checkFiles(); checkFile();"); 351 } 352 353 ################################################## 354 # 355 # Move to the parent directory 356 # 357 sub ParentDir { 358 my $self = shift; 359 $self->{pwd} = '.' unless ($self->{pwd} =~ s!/[^/]*$!!); 360 $self->Refresh; 361 } 362 363 ################################################## 364 # 365 # Move to the parent directory 366 # 367 sub Go { 368 my $self = shift; 369 $self->{pwd} = $self->r->param('directory'); 370 $self->Refresh; 371 } 372 373 ################################################## 374 # 375 # Open a directory or view a file 376 # 377 sub View { 378 my $self = shift; my $pwd = $self->{pwd}; 379 my $filename = $self->getFile("view"); return unless $filename; 380 my $name = "$pwd/$filename"; $name =~ s!^\./?!!; 381 my $file = "$self->{courseRoot}/$pwd/$filename"; 382 383 # 384 # Don't follow symbolic links 385 # 386 if ($self->isSymLink($file)) { 387 $self->addbadmessage("That symbolic link takes you outside your course directory"); 388 $self->Refresh; return; 389 } 390 391 # 392 # Handle directories by making them the working directory 393 # 394 if (-d $file) { 395 $self->{pwd} .= '/'.$filename; 396 $self->Refresh; return; 397 } 398 399 unless (-f $file) { 400 $self->addbadmessage("You can't view files of that type"); 401 $self->Refresh; return; 402 } 403 404 # 405 # Include a download link 406 # 407 my $urlpath = $self->r->urlpath; 408 my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $self->{courseName}); 409 my $fileManagerURL = $self->systemLink($fileManagerPage, params => {download => $filename, pwd => $pwd}); 410 print CGI::div({style=>"float:right"}, 411 CGI::a({href=>$fileManagerURL},"Download")); 412 print CGI::p(),CGI::b($name),CGI::p(); 413 print CGI::hr(); 414 415 # 416 # For files, display the file, if possible. 417 # If the file is an image, display it as an image. 418 # 419 my $data = readFile($file); 420 if (isText($data)) { 421 print CGI::pre(showHTML($data)); 422 } elsif ($file =~ m/\.(gif|jpg|png)/i) { 423 print CGI::img({src=>$fileManagerURL, border=>0}); 424 } else { 425 print CGI::div({class=>"ResultsWithError"}, 426 "The file does not appear to be a text file."); 427 } 428 } 429 430 ################################################## 431 # 432 # Edit a file 433 # 434 sub Edit { 435 my $self = shift; 436 my $filename = $self->getFile('edit'); return unless $filename; 437 my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; 438 439 if (-d $file) { 440 $self->addbadmessage("You can't edit a directory"); 441 $self->Refresh; return; 442 } 443 unless (-f $file) { 444 $self->addbadmessage("You can only edit text files"); 445 $self->Refresh; return; 446 } 447 my $data = readFile($file); 448 if (!isText($data)) { 449 $self->addbadmessage("The file does not appear to be a text file"); 450 $self->Refresh; return; 451 } 452 453 $self->RefreshEdit($data,$filename); 454 } 455 456 ################################################## 457 # 458 # Save the edited file 459 # 460 sub Save { 461 my $self = shift; my $filename = shift; 462 my $pwd = $self->{pwd}; 463 if ($filename) { 464 $pwd = substr($filename,length($self->{courseRoot})+1); 465 $pwd =~ s!(/|^)([^/]*)$!!; $filename = $2; 466 $pwd = '.' if $pwd eq ''; 467 } else { 468 $filename = $self->getFile("save"); return unless $filename; 469 } 470 my $file = "$self->{courseRoot}/$pwd/$filename"; 471 my $data = $self->r->param("data"); 472 473 if (defined($data)) { 474 if (open(OUTFILE,">$file")) { 475 eval {print OUTFILE $data; close(OUTFILE)}; 476 if ($@) {$self->addbadmessage("Failed to save: $@")} 477 else {$self->addgoodmessage("File saved")} 478 } else {$self->addbadmessage("Can't write to file: $!")} 479 } else {$data = ""; $self->addbadmessage("Error: no file data was submitted!")} 480 481 $self->{pwd} = $pwd; 482 $self->RefreshEdit($data,$filename); 483 } 484 485 ################################################## 486 # 487 # Save the edited file under a new name 488 # 489 sub SaveAs { 490 my $self = shift; 491 492 my $newfile = $self->r->param('name'); 493 my $original = $self->r->param('files'); 494 $newfile = $self->verifyPath($newfile,$original); 495 if ($newfile) {$self->Save($newfile); return} 496 $self->RefreshEdit($self->r->param('data'),$original); 497 } 498 499 ################################################## 500 # 501 # Display the Edit page 502 # 503 sub RefreshEdit { 504 my $self = shift; my $data = shift; my $file = shift; 505 my $pwd = shift || $self->{pwd}; 506 my $name = "$pwd/$file"; $name =~ s!^\./?!!; 507 508 my %button = (type=>"submit",name=>"action",style=>"width:6em"); 509 print CGI::p(); 510 print CGI::start_table({border=>0,cellspacing=>0,cellpadding=>2, width=>"95%", align=>"center"}); 511 print CGI::Tr([ 512 CGI::td({align=>"center",style=>"background-color:#CCCCCC"},CGI::b($name)), 513 CGI::td(CGI::textarea(-name=>"data",-default=>$data,-override=>1,-rows=>30,-columns=>80, 514 -style=>"width:100%")), ## can't seem to get variable height to work 515 CGI::td({align=>"center", nowrap=>1}, 516 CGI::input({%button,value=>"Cancel"})," ", 517 CGI::input({%button,value=>"Revert"})," ", 518 CGI::input({%button,value=>"Save As:"}), 519 CGI::input({type=>"text",name=>"name",size=>20,style=>"width:50%"})," ", 520 CGI::input({%button,value=>"Save"}), 521 ), 522 ]); 523 print CGI::end_table(); 524 print CGI::hidden({name=>"files", value=>$file}); 525 $self->HiddenFlags; 526 } 527 528 ################################################## 529 # 530 # Copy a file 531 # 532 sub Copy { 533 my $self = shift; 534 my $dir = "$self->{courseRoot}/$self->{pwd}"; 535 my $original = $self->getFile('copy'); return unless $original; 536 my $oldfile = "$dir/$original"; 537 538 if (-d $oldfile) { 539 # FIXME: need to do recursive directory copy 540 $self->addbadmessage("Directory copies are not yet implemented"); 541 $self->Refresh; 542 return; 543 } 544 545 if ($self->r->param('confirmed')) { 546 my $newfile = $self->r->param('name'); 547 if ($newfile = $self->verifyPath($newfile,$original)) { 548 if (copy($oldfile, $newfile)) { 549 $self->addgoodmessage("File successfully copied"); 550 $self->Refresh; return; 551 } else {$self->addbadmessage("Can't copy file: $!")} 552 } 553 } 554 555 $self->Confirm("Copy file as:",$original,"Copy"); 556 print CGI::hidden({name=>"files",value=>$original}); 557 } 558 559 ################################################## 560 # 561 # Rename a file 562 # 563 sub Rename { 564 my $self = shift; 565 my $dir = "$self->{courseRoot}/$self->{pwd}"; 566 my $original = $self->getFile('rename'); return unless $original; 567 my $oldfile = "$dir/$original"; 568 569 if ($self->r->param('confirmed')) { 570 my $newfile = $self->r->param('name'); 571 if ($newfile = $self->verifyPath($newfile,$original)) { 572 if (rename $oldfile, $newfile) { 573 $self->addgoodmessage("File successfully renamed"); 574 $self->Refresh; return; 575 } else {$self->addbadmessage("Can't rename file: $!")} 576 } 577 } 578 579 $self->Confirm("Rename file as:",uniqueName($dir,$original),"Rename"); 580 print CGI::hidden({name=>"files",value=>$original}); 581 } 582 583 ################################################## 584 # 585 # Delete a file 586 # 587 sub Delete { 588 my $self = shift; 589 my @files = $self->r->param('files'); 590 if (scalar(@files) == 0) { 591 $self->addbadmessage("You must select at least one file to delete"); 592 $self->Refresh; return; 593 } 594 595 my $pwd = $self->{pwd}; 596 my $dir = $self->{courseRoot}.'/'.$pwd; 597 if ($self->r->param('confirmed')) { 598 599 # 600 # If confirmed, go ahead and delete the files 601 # 602 foreach my $file (@files) { 603 if (defined $self->checkPWD("$pwd/$file",1)) { 604 if (-d "$dir/$file") { 605 my $removed = eval {rmtree("$dir/$file",0,1)}; 606 if ($removed) {$self->addgoodmessage("Directory '$file' removed (items deleted: $removed)")} 607 else {$self->addbadmessage("Directory '$file' not removed: $!")} 608 } else { 609 if (unlink("$dir/$file")) {$self->addgoodmessage("File '$file' successfully removed")} 610 else {$self->addbadmessage("File '$file' not removed: $!")} 611 } 612 } else {$self->addbadmessage("Illegal file '$file' specified"); last} 613 } 614 $self->Refresh; 615 616 } else { 617 618 # 619 # Put up the confirmation dialog box 620 # 621 print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 5em"}); 622 print CGI::Tr( 623 CGI::td( 624 CGI::b("Warning:")," You have requested that the following items be deleted\n", 625 CGI::ul(CGI::li(\@files)), 626 ((grep { -d "$dir/$_" } @files)? 627 CGI::p({style=>"width:500"},"Some of these files are directories. ", 628 "Only delete directories if you really know what you are doing. ", 629 "You can seriously damage your course if you delete the wrong thing."): ""), 630 CGI::p({style=>"color:red"},"There is no undo for deleting files or directories!"), 631 CGI::p("Really delete the items listed above?"), 632 CGI::div({style=>"float:left; padding-left:3ex"}, 633 CGI::input({type=>"submit",name=>"action",value=>"Cancel"})), 634 CGI::div({style=>"float:right; padding-right:3ex"}, 635 CGI::input({type=>"submit",name=>"action",value=>"Delete"})), 636 ), 637 ); 638 print CGI::end_table(); 639 640 print CGI::hidden({name=>"confirmed",value=>1}); 641 foreach my $file (@files) {print CGI::hidden({name=>"files",value=>$file})} 642 $self->HiddenFlags; 643 } 644 } 645 646 ################################################## 647 # 648 # Make a gzipped tar archive 649 # 650 sub MakeArchive { 651 my $self = shift; 652 my @files = $self->r->param('files'); 653 if (scalar(@files) == 0) { 654 $self->addbadmessage("You must select at least one file for the archive"); 655 $self->Refresh; return; 656 } 657 658 my $dir = $self->{courseRoot}.'/'.$self->{pwd}; 659 my $archive = uniqueName($dir,(scalar(@files) == 1)? 660 $files[0].".tgz": $self->{courseName}.".tgz"); 661 my $tar = "cd '$dir' && $self->{ce}{externalPrograms}{tar} -cvzf $archive "; 662 $tar .= join(" ",@files); 663 my $files = `$tar`; chomp($files); 664 if ($? == 0) { 665 my @files = split(/\n/,$files); 666 my $n = scalar(@files); my $s = ($n == 1? "": "s"); 667 $self->addgoodmessage("Archive '$archive' created successfully ($n file$s)"); 668 } else { 669 $self->addbadmessage("Can't create archive '$archive': comand returned ".systemError($?)); 670 } 671 $self->Refresh; 672 } 673 674 ################################################## 675 # 676 # Unpack a gzipped tar archive 677 # 678 sub UnpackArchive { 679 my $self = shift; 680 my $archive = $self->getFile("unpack"); return unless $archive; 681 if ($archive !~ m/\.tgz$/) { 682 $self->addbadmessage("You can only unpack files ending in '.tgz'"); 683 } else { 684 $self->unpack($archive); 685 } 686 $self->Refresh; 687 } 688 689 sub unpack { 690 my $self = shift; 691 my $archive = shift; 692 my $dir = $self->{courseRoot}.'/'.$self->{pwd}; 693 my $tar = "cd '$dir' && $self->{ce}{externalPrograms}{tar} -vxzf $archive"; 694 my $files = `$tar`; chomp($files); 695 if ($? == 0) { 696 my @files = split(/\n/,$files); 697 my $n = scalar(@files); my $s = ($n == 1? "": "s"); 698 $self->addgoodmessage("$n file$s unpacked successfully"); 699 return 1; 700 } else { 701 $self->addbadmessage("Can't unpack '$archive': command returned ".systemError($?)); 702 return 0; 703 } 704 } 705 706 ################################################## 707 # 708 # Make a new file and edit it 709 # 710 sub NewFile { 711 my $self = shift; 712 713 if ($self->r->param('confirmed')) { 714 my $name = $self->r->param('name'); 715 if (my $file = $self->verifyName($name,"file")) { 716 if (open(NEWFILE,">$file")) { 717 close(NEWFILE); 718 $self->RefreshEdit("",$name); 719 return; 720 } else {$self->addbadmessage("Can't create file: $!")} 721 } 722 } 723 724 $self->Confirm("New file name:","","New File"); 725 } 726 727 ################################################## 728 # 729 # Make a new directory 730 # 731 sub NewFolder { 732 my $self = shift; 733 734 if ($self->r->param('confirmed')) { 735 my $name = $self->r->param('name'); 736 if (my $dir = $self->verifyName($name,"directory")) { 737 if (mkdir $dir, 0750) { 738 $self->{pwd} .= '/'.$name; 739 $self->Refresh; return; 740 } else {$self->addbadmessage("Can't create directory: $!")} 741 } 742 } 743 744 $self->Confirm("New folder name:","","New Folder"); 745 } 746 747 ################################################## 748 # 749 # Download a file 750 # 751 sub Download { 752 my $self = shift; 753 my $pwd = $self->checkPWD($self->r->param('pwd') || HOME); 754 return unless $pwd; 755 my $filename = $self->getFile("download"); return unless $filename; 756 my $file = $self->{ce}{courseDirs}{root}.'/'.$pwd.'/'.$filename; 757 758 if (-d $file) {$self->addbadmessage("You can't download directories"); return} 759 unless (-f $file) {$self->addbadmessage("You can't download files of that type"); return} 760 761 $self->r->param('download',$filename); 762 } 763 764 ################################################## 765 # 766 # Upload a file to the server 767 # 768 sub Upload { 769 my $self = shift; 770 my $dir = "$self->{courseRoot}/$self->{pwd}"; 771 my $fileIDhash = $self->r->param('file'); 772 unless ($fileIDhash) { 773 $self->addbadmessage("You have not chosen a file to upload."); 774 $self->Refresh; 775 return; 776 } 777 778 my ($id,$hash) = split(/\s+/,$fileIDhash); 779 my $upload = WeBWorK::Upload->retrieve($id,$hash,dir=>$self->{ce}{webworkDirs}{uploadCache}); 780 781 my $name = checkName($upload->filename); 782 my $action = $self->r->param("formAction") || "Cancel"; 783 if ($self->r->param("confirmed")) { 784 if ($action eq "Cancel") { 785 $upload->dispose; 786 $self->Refresh; 787 return; 788 } 789 $name = checkName($self->r->param('name')) if ($action eq "Rename"); 790 } 791 792 if (-e "$dir/$name") { 793 unless ($self->r->param('overwrite') || $action eq "Overwrite") { 794 $self->Confirm("File ".CGI::b($name)." already exists. Overwrite it, or rename it as:". 795 CGI::p(),uniqueName($dir,$name),"Rename","Overwrite"); 796 print CGI::hidden({name=>"action",value=>"Upload"}); 797 print CGI::hidden({name=>"file",value=>$fileIDhash}); 798 return; 799 } 800 } 801 $self->checkFileLocation($name,$self->{pwd}); 802 803 my $file = "$dir/$name"; 804 my $type = $self->getFlag('format','Automatic'); 805 my $data; 806 807 # 808 # Check if we need to convert linebreaks 809 # 810 if ($type ne 'Binary') { 811 my $fh = $upload->fileHandle; 812 my @lines = <$fh>; $data = join('',@lines); 813 if ($type eq 'Automatic') {$type = isText($data) ? 'Text' : 'Binary'} 814 } 815 if ($type eq 'Text') { 816 $upload->dispose; 817 $data =~ s/\r\n?/\n/g; 818 open(UPLOAD,">$file") || $self->addbadmessage("Can't create file '$name'"); 819 print UPLOAD $data; close(UPLOAD); 820 } else { 821 $upload->disposeTo($file); 822 } 823 824 if (-e $file) { 825 $self->addgoodmessage("$type file '$name' uploaded successfully"); 826 if ($name =~ m/\.tgz$/ && $self->getFlag('unpack')) { 827 if ($self->unpack($name) && $self->getFlag('autodelete')) { 828 if (unlink($file)) {$self->addgoodmessage("Archive '$name' deleted")} 829 else {$self->addbadmessage("Can't delete archive '$name': $!")} 830 } 831 } 832 } 833 834 $self->Refresh; 835 } 836 837 ################################################## 838 ################################################## 839 # 840 # Print a confirmation dialog box 841 # 842 sub Confirm { 843 my $self = shift; 844 my $message = shift; my $value = shift; 845 my $button = shift; my $button2 = shift; 846 847 print CGI::p(); 848 print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 3em"}); 849 print CGI::Tr( 850 CGI::td({align=>"CENTER"}, 851 $message, 852 CGI::input({type=>"text",name=>"name",size=>50,value=>$value}), 853 CGI::p(), CGI::center( 854 CGI::div({style=>"float:right; padding-right:3ex"}, 855 CGI::input({type=>"submit",name=>"formAction",value=>$button})), # this will be the default 856 CGI::div({style=>"float:left; padding-left:3ex"}, 857 CGI::input({type=>"submit",name=>"formAction",value=>"Cancel"})), 858 ($button2 ? CGI::input({type=>"submit",name=>"formAction",value=>$button2}): ()), 859 ), 860 ), 861 ); 862 print CGI::end_table(); 863 print CGI::hidden({name=>"confirmed", value=>1}); 864 $self->HiddenFlags; 865 print CGI::script("window.document.FileManager.name.focus()"); 866 } 867 868 ################################################## 869 ################################################## 870 # 871 # Check that there is exactly one valid file 872 # 873 sub getFile { 874 my $self = shift; my $action = shift; 875 my @files = $self->r->param("files"); 876 if (scalar(@files) > 1) { 877 $self->addbadmessage("You can only $action one file at a time."); 878 $self->Refresh unless $action eq 'download'; 879 return; 880 } 881 if (scalar(@files) == 0 || $files[0] eq "") { 882 $self->addbadmessage("You need to select a file to $action."); 883 $self->Refresh unless $action eq 'download'; 884 return; 885 } 886 my $pwd = $self->checkPWD($self->{pwd} || $self->r->param('pwd') || HOME) || '.'; 887 if ($self->isSymLink($pwd.'/'.$files[0])) { 888 $self->addbadmessage("That symbolic link takes you outside your course directory"); 889 $self->Refresh unless $action eq 'download'; 890 return; 891 } 892 unless ($self->checkPWD($pwd.'/'.$files[0],1)) { 893 $self->addbadmessage("You have specified an illegal file"); 894 $self->Refresh unless $action eq 'download'; 895 return; 896 } 897 return $files[0]; 898 } 899 900 ################################################## 901 # 902 # Get the entries for the directory menu 903 # 904 sub directoryMenu { 905 my $course = shift; 906 my $dir = shift; $dir =~ s!^\.(/|$)!!; 907 my @dirs = split('/',$dir); 908 my $menu = ""; my $pwd; 909 910 my (@values,%labels); 911 while (scalar(@dirs)) { 912 $pwd = join('/',(@dirs)[0..$#dirs]); 913 $dir = pop(@dirs); 914 push(@values,$pwd); $labels{$pwd} = $dir; 915 } 916 push(@values,'.'); $labels{'.'} = $course; 917 return (\@values,\%labels); 918 } 919 920 ################################################## 921 # 922 # Get the directory listing 923 # 924 sub directoryListing { 925 my $root = shift; my $pwd = shift; my $showdates = shift; 926 my $dir = $root.'/'.$pwd; 927 my (@values,%labels,$size,$data); 928 929 return unless -d $dir; 930 my $len = 24; 931 my @names = sortByName(undef,grep(/^[^.]/,readDirectory($dir))); 932 foreach my $name (@names) { 933 unless ($name eq 'DATA') { #FIXME don't view the DATA directory 934 my $file = "$dir/$name"; 935 push(@values,$name); $labels{$name} = $name; 936 $labels{$name} .= '@' if (-l $file); 937 $labels{$name} .= '/' if (-d $file && !-l $file); 938 $len = length($labels{$name}) if length($labels{$name}) > $len; 939 } 940 } 941 if ($showdates) { 942 $len += 3; 943 foreach my $name (@values) { 944 my $file = "$dir/$name"; 945 my ($size,$date) = (lstat($file))[7,9]; 946 $labels{$name} = sprintf("%-${len}s%-16s%10s",$labels{$name}, 947 ((-d $file)? ("",""): 948 (getDate($date),getSize($size)))); 949 } 950 } 951 return (\@values,\%labels); 952 } 953 954 sub getDate { 955 my ($sec,$min,$hour,$day,$month,$year) = localtime(shift); 956 sprintf("%02d-%02d-%04d %02d:%02d",$month+1,$day,$year+1900,$hour,$min); 957 } 958 959 sub getSize { 960 my $size = shift; 961 return $size." B " if $size < 1024; 962 return sprintf("%.1f KB",$size/1024) if $size < 1024*100; 963 return sprintf("%d KB",int($size/1024)) if $size < 1024*1024; 964 return sprintf("%.1f MB",$size/1024/1024) if $size < 1024*1024*100; 965 return sprintf("%d MB",$size/1024/1024); 966 } 967 968 ################################################## 969 # 970 # Check if a file is a symbolic link that we 971 # are not allowed to follow. 972 # 973 sub isSymLink { 974 my $self = shift; my $file = shift; 975 return 0 unless -l $file; 976 977 my $courseRoot = $self->{ce}{courseDirs}{root}; 978 $courseRoot = readlink($courseRoot) if -l $courseRoot; 979 my $pwd = $self->{pwd} || $self->r->param('pwd') || HOME; 980 my $link = File::Spec->rel2abs(readlink($file),"$courseRoot/$pwd"); 981 # 982 # Remove /./ and dir/../ constructs 983 # 984 $link =~ s!(^|/)(\.(/|$))+!$1!g; 985 while ($link =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; 986 987 # 988 # Link is OK if it is in the course directory 989 # 990 return 0 if substr($link,0,length($courseRoot)) eq $courseRoot; 991 992 # 993 # Look through the list of valid paths to see if this link is OK 994 # 995 my $valid = $self->{ce}{webworkDirs}{valid_symlinks}; 996 if (defined $valid && $valid) { 997 foreach my $path (@{$valid}) { 998 return 0 if substr($link,0,length($path)) eq $path; 999 } 1000 } 1001 1002 return 1; 1003 } 1004 1005 ################################################## 1006 # 1007 # Normalize the working directory and check if it is OK. 1008 # 1009 sub checkPWD { 1010 my $self = shift; 1011 my $pwd = shift; 1012 my $renameError = shift; 1013 1014 $pwd =~ s!//+!/!g; # remove duplicate slashes 1015 $pwd =~ s!(^|/)~!$1_!g; # remove ~user references 1016 $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories 1017 1018 # remove dir/.. constructions 1019 while ($pwd =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; 1020 1021 $pwd =~ s!/$!!; # remove trailing / 1022 return if ($pwd =~ m!(^|/)\.\.(/|$)!); # Error if outside the root 1023 1024 # check for bad symbolic links 1025 my @dirs = split('/',$pwd); 1026 pop(@dirs) if $renameError; # don't check file iteself in this case 1027 my @path = ($self->{ce}{courseDirs}{root}); 1028 foreach my $dir (@dirs) { 1029 push @path,$dir; 1030 return if ($self->isSymLink(join('/',@path))); 1031 } 1032 1033 my $original = $pwd; 1034 $pwd =~ s!(^|/)\.!$1_!g; # don't enter hidden directories 1035 $pwd =~ s!^/!!; # remove leading / 1036 $pwd =~ s![^-_./A-Z0-9~ ]!_!gi; # no illegal characters 1037 return if $renameError && $original ne $pwd; 1038 1039 $pwd = '.' if $pwd eq ''; 1040 return $pwd; 1041 } 1042 1043 ################################################## 1044 # 1045 # Check that a file is uploaded to the correct directory 1046 # 1047 sub checkFileLocation { 1048 my $self = shift; 1049 my $extension = shift; $extension =~ s/.*\.//; 1050 my $dir = shift; my $location = $uploadDir{$extension}; 1051 return unless defined($location); 1052 return if $dir =~ m/^$location$/; 1053 $location =~ s!/\.\*!!; 1054 return if $dir =~ m/^$location$/; 1055 $self->addbadmessage("Files with extension '.$extension' usually belong in '$location'"); 1056 } 1057 1058 ################################################## 1059 # 1060 # Check a name for bad characters, etc. 1061 # 1062 sub checkName { 1063 my $file = shift; 1064 $file =~ s!.*[/\\]!!; # remove directory 1065 $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters 1066 $file =~ s/^\./_/; # no initial dot 1067 $file = "newfile.txt" unless $file; # no blank names 1068 return $file; 1069 } 1070 1071 ################################################## 1072 # 1073 # Get a unique name (in case it already exists) 1074 # 1075 sub uniqueName { 1076 my $dir = shift; my $name = shift; 1077 return $name unless (-e "$dir/$name"); 1078 my $type = ""; my $n = 1; 1079 $type = $1 if ($name =~ s/(\.[^.]*)$//); 1080 $n = $1 if ($name =~ s/_(\d+)$/_/); 1081 while (-e "$dir/${name}_$n$type") {$n++} 1082 return "${name}_$n$type"; 1083 } 1084 1085 ################################################## 1086 # 1087 # Verify that a name can be added tot he current 1088 # directory. 1089 # 1090 sub verifyName { 1091 my $self = shift; my $name = shift; my $object = shift; 1092 if ($name) { 1093 unless ($name =~ m!/!) { 1094 unless ($name =~ m!^\.!) { 1095 unless ($name =~ m![^-_.a-zA-Z0-9 ]!) { 1096 my $file = "$self->{courseRoot}/$self->{pwd}/$name"; 1097 return $file unless (-e $file); 1098 $self->addbadmessage("A file with that name already exists"); 1099 } else {$self->addbadmessage("Your $object name contains illegal characters")} 1100 } else {$self->addbadmessage("Your $object name may not begin with a dot")} 1101 } else {$self->addbadmessage("Your $object name may not contain a path component")} 1102 } else {$self->addbadmessage("You must specify a $object name")} 1103 return 1104 } 1105 1106 ################################################## 1107 # 1108 # Verify that a file path is valid 1109 # 1110 sub verifyPath { 1111 my $self = shift; my $path = shift; my $name = shift; 1112 1113 if ($path) { 1114 unless ($path =~ m![^-_.a-zA-Z0-9 /]!) { 1115 unless ($path =~ m!^/!) { 1116 $path = $self->checkPWD($self->{pwd}.'/'.$path,1); 1117 if ($path) { 1118 $path = $self->{courseRoot}.'/'.$path; 1119 $path .= '/'.$name if -d $path && $name; 1120 return $path unless (-e $path); 1121 $self->addbadmessage("A file with that name already exists"); 1122 } else {$self->addbadmessage("You have specified an illegal path")} 1123 } else {$self->addbadmessage("You can not specify an absolute path")} 1124 } else {$self->addbadmessage("Your file name contains illegal characters")} 1125 } else {$self->addbadmessage("You must specify a file name")} 1126 return 1127 } 1128 1129 ################################################## 1130 # 1131 # Get the value of a parameter flag 1132 # 1133 sub getFlag { 1134 my $self = shift; my $flag = shift; 1135 my $default = shift; $default = 0 unless defined $default; 1136 my $value = $self->r->param($flag); 1137 $value = $default unless defined $value; 1138 return $value; 1139 } 1140 1141 ################################################## 1142 # 1143 # Make HTML symbols printable 1144 # 1145 sub showHTML { 1146 my $string = shift; 1147 return '' unless defined $string; 1148 $string =~ s/&/\&/g; 1149 $string =~ s/</\</g; 1150 $string =~ s/>/\>/g; 1151 $string; 1152 } 1153 1154 ################################################## 1155 # 1156 # Check if a string is plain text 1157 # (i.e., doesn't contain three non-regular 1158 # characters in a row.) 1159 # 1160 sub isText { 1161 my $string = shift; 1162 return $string !~ m/[^\s\x20-\x7E]{3,}/; 1163 } 1164 1165 ################################################## 1166 # 1167 # Convert spaces to , but only REAL spaces 1168 # 1169 sub sp2nbsp { 1170 my $s = shift; 1171 $s =~ s/ /\ /g; 1172 return $s; 1173 } 1174 1175 ################################################## 1176 # 1177 # Hack to convert multiple spaces in the file 1178 # selection box into so that the columns 1179 # will allign properly in fixed-width fonts. 1180 # We have to do it agter the fact, since CGI:: 1181 # is being "helpful" by turning & in the labels 1182 # into & for us. So we have to convert 1183 # after the <SELECT> is created (ugh). 1184 # 1185 sub fixSpaces { 1186 my $s = shift; 1187 $s =~ s!(<option[^>]*>)(.*?)(</option>)!$1.sp2nbsp($2).$3!gei; 1188 return $s; 1189 } 1190 1191 ################################################## 1192 # 1193 # Interpret command return errors 1194 # 1195 sub systemError { 1196 my $status = shift; 1197 return "error: $!" if $status == 0xFF00; 1198 return "exit status ".($status >> 8) if ($status & 0xFF) == 0; 1199 return "signal ".($status &= ~0x80); 1200 } 1201 1202 ################################################## 1203 1204 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |