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