Parent Directory
| 
Revision Log
Fixed incorrect method call to SaveHiidenFlags (should have been HiddenFlags).
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.10 2005/07/02 17:04:31 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->HiddenFlags; 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} -cvzf $archive "; 654 $tar .= join(" ",@files); 655 my $files = `$tar`; chomp($files); 656 if ($? == 0) { 657 my @files = split(/\n/,$files); 658 my $n = scalar(@files); my $s = ($n == 1? "": "s"); 659 $self->addgoodmessage("Archive '$archive' created successfully ($n file$s)"); 660 } else { 661 $self->addbadmessage("Can't create archive '$archive': comand returned ".systemError($?)); 662 } 663 $self->Refresh; 664 } 665 666 ################################################## 667 # 668 # Unpack a gzipped tar archive 669 # 670 sub UNGZIP { 671 my $self = shift; 672 my $archive = $self->getFile("UNGZIP"); return unless $archive; 673 if ($archive !~ m/\.tgz$/) { 674 $self->addbadmessage("You can only unpack files ending in '.tgz'"); 675 } else { 676 $self->ungzip($archive); 677 } 678 $self->Refresh; 679 } 680 681 sub ungzip { 682 my $self = shift; 683 my $archive = shift; 684 my $dir = $self->{courseRoot}.'/'.$self->{pwd}; 685 my $tar = "cd '$dir' && $self->{ce}{externalPrograms}{tar} -vxzf $archive"; 686 my $files = `$tar`; chomp($files); 687 if ($? == 0) { 688 my @files = split(/\n/,$files); 689 my $n = scalar(@files); my $s = ($n == 1? "": "s"); 690 $self->addgoodmessage("$n file$s unpacked successfully"); 691 return 1; 692 } else { 693 $self->addbadmessage("Can't unpack '$archive': command returned ".systemError($?)); 694 return 0; 695 } 696 } 697 698 ################################################## 699 # 700 # Make a new file and edit it 701 # 702 sub NewFile { 703 my $self = shift; 704 705 if ($self->r->param('confirmed')) { 706 my $name = $self->r->param('name'); 707 if (my $file = $self->verifyName($name,"file")) { 708 if (open(NEWFILE,">$file")) { 709 close(NEWFILE); 710 $self->RefreshEdit("",$name); 711 return; 712 } else {$self->addbadmessage("Can't create file: $!")} 713 } 714 } 715 716 $self->Confirm("New file name:","","New File"); 717 } 718 719 ################################################## 720 # 721 # Make a new directory 722 # 723 sub NewFolder { 724 my $self = shift; 725 726 if ($self->r->param('confirmed')) { 727 my $name = $self->r->param('name'); 728 if (my $dir = $self->verifyName($name,"directory")) { 729 if (mkdir $dir, 0750) { 730 $self->{pwd} .= '/'.$name; 731 $self->Refresh; return; 732 } else {$self->addbadmessage("Can't create directory: $!")} 733 } 734 } 735 736 $self->Confirm("New folder name:","","New Folder"); 737 } 738 739 ################################################## 740 # 741 # Download a file 742 # 743 sub Download { 744 my $self = shift; 745 my $pwd = $self->checkPWD($self->r->param('pwd') || '.'); 746 return unless $pwd; 747 my $filename = $self->getFile("download"); return unless $filename; 748 my $file = $self->{ce}{courseDirs}{root}.'/'.$pwd.'/'.$filename; 749 750 if (-d $file) {$self->addbadmessage("You can't download directories"); return} 751 unless (-f $file) {$self->addbadmessage("You can't download files of that type"); return} 752 753 $self->r->param('download',$filename); 754 } 755 756 ################################################## 757 # 758 # Upload a file to the server 759 # 760 sub Upload { 761 my $self = shift; 762 my $dir = "$self->{courseRoot}/$self->{pwd}"; 763 my $fileIDhash = $self->r->param('file'); 764 unless ($fileIDhash) { 765 $self->addbadmessage("You have not chosen a file to upload."); 766 $self->Refresh; 767 return; 768 } 769 770 my ($id,$hash) = split(/\s+/,$fileIDhash); 771 my $upload = WeBWorK::Upload->retrieve($id,$hash,dir=>$self->{ce}{webworkDirs}{uploadCache}); 772 773 my $name = checkName($upload->filename); 774 my $action = $self->r->param("formAction") || "Cancel"; 775 if ($self->r->param("confirmed")) { 776 if ($action eq "Cancel") { 777 $upload->dispose; 778 $self->Refresh; 779 return; 780 } 781 $name = checkName($self->r->param('name')) if ($action eq "Rename"); 782 } 783 784 if (-e "$dir/$name") { 785 unless ($self->r->param('overwrite') || $action eq "Overwrite") { 786 $self->Confirm("File ".CGI::b($name)." already exists. Overwrite it, or rename it as:". 787 CGI::p(),uniqueName($dir,$name),"Rename","Overwrite"); 788 print CGI::hidden({name=>"action",value=>"Upload"}); 789 print CGI::hidden({name=>"file",value=>$fileIDhash}); 790 return; 791 } 792 } 793 $self->checkFileLocation($name,$self->{pwd}); 794 795 my $file = "$dir/$name"; 796 my $type = $self->getFlag('format','Automatic'); 797 my $data; 798 799 # 800 # Check if we need to convert linebreaks 801 # 802 if ($type ne 'Binary') { 803 my $fh = $upload->fileHandle; 804 my @lines = <$fh>; $data = join('',@lines); 805 if ($type eq 'Automatic') {$type = isText($data) ? 'Text' : 'Binary'} 806 } 807 if ($type eq 'Text') { 808 $upload->dispose; 809 $data =~ s/\r\n?/\n/g; 810 open(UPLOAD,">$file") || $self->addbadmessage("Can't create file '$name'"); 811 print UPLOAD $data; close(UPLOAD); 812 } else { 813 $upload->disposeTo($file); 814 } 815 816 if (-e $file) { 817 $self->addgoodmessage("$type file '$name' uploaded successfully"); 818 if ($name =~ m/\.tgz$/ && $self->getFlag('unpack')) { 819 if ($self->ungzip($name) && $self->getFlag('autodelete')) { 820 if (unlink($file)) {$self->addgoodmessage("Archive '$name' deleted")} 821 else {$self->addbadmessage("Can't delete archive '$name': $!")} 822 } 823 } 824 } 825 826 $self->Refresh; 827 } 828 829 ################################################## 830 ################################################## 831 # 832 # Print a confirmation dialog box 833 # 834 sub Confirm { 835 my $self = shift; 836 my $message = shift; my $value = shift; 837 my $button = shift; my $button2 = shift; 838 839 print CGI::p(); 840 print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 3em"}); 841 print CGI::Tr( 842 CGI::td({align=>"CENTER"}, 843 $message, 844 CGI::input({type=>"text",name=>"name",size=>50,value=>$value}), 845 CGI::p(), CGI::center( 846 CGI::div({style=>"float:right; padding-right:3ex"}, 847 CGI::input({type=>"submit",name=>"formAction",value=>$button})), # this will be the default 848 CGI::div({style=>"float:left; padding-left:3ex"}, 849 CGI::input({type=>"submit",name=>"formAction",value=>"Cancel"})), 850 ($button2 ? CGI::input({type=>"submit",name=>"formAction",value=>$button2}): ()), 851 ), 852 ), 853 ); 854 print CGI::end_table(); 855 print CGI::hidden({name=>"confirmed", value=>1}); 856 $self->HiddenFlags; 857 print CGI::script("window.document.FileManager.name.focus()"); 858 } 859 860 ################################################## 861 ################################################## 862 # 863 # Check that there is exactly one valid file 864 # 865 sub getFile { 866 my $self = shift; my $action = shift; 867 my @files = $self->r->param("files"); 868 if (scalar(@files) > 1) { 869 $self->addbadmessage("You can only $action one file at a time."); 870 $self->Refresh unless $action eq 'download'; 871 return; 872 } 873 if (scalar(@files) == 0 || $files[0] eq "") { 874 $self->addbadmessage("You need to select a file to $action."); 875 $self->Refresh unless $action eq 'download'; 876 return; 877 } 878 my $pwd = $self->checkPWD($self->{pwd} || $self->r->param('pwd') || '.') || '.'; 879 if ($self->isSymLink($pwd.'/'.$files[0])) { 880 $self->addbadmessage("That symbolic link takes you outside your course directory"); 881 $self->Refresh unless $action eq 'download'; 882 return; 883 } 884 unless ($self->checkPWD($pwd.'/'.$files[0],1)) { 885 $self->addbadmessage("You have specified an illegal file"); 886 $self->Refresh unless $action eq 'download'; 887 return; 888 } 889 return $files[0]; 890 } 891 892 ################################################## 893 # 894 # Get the entries for the directory menu 895 # 896 sub directoryMenu { 897 my $course = shift; 898 my $dir = shift; $dir =~ s!^\.(/|$)!!; 899 my @dirs = split('/',$dir); 900 my $menu = ""; my $pwd; 901 902 my (@values,%labels); 903 while (scalar(@dirs)) { 904 $pwd = join('/',(@dirs)[0..$#dirs]); 905 $dir = pop(@dirs); 906 push(@values,$pwd); $labels{$pwd} = $dir; 907 } 908 push(@values,'.'); $labels{'.'} = $course; 909 return (\@values,\%labels); 910 } 911 912 ################################################## 913 # 914 # Get the directory listing 915 # 916 sub directoryListing { 917 my $root = shift; my $pwd = shift; my $showdates = shift; 918 my $dir = $root.'/'.$pwd; 919 my (@values,%labels,$size,$data); 920 921 return unless -d $dir; 922 my $len = 24; 923 my @names = sortByName(undef,grep(/^[^.]/,readDirectory($dir))); 924 foreach my $name (@names) { 925 unless ($name eq 'DATA') { #FIXME don't view the DATA directory 926 my $file = "$dir/$name"; 927 push(@values,$name); $labels{$name} = $name; 928 $labels{$name} .= '@' if (-l $file); 929 $labels{$name} .= '/' if (-d $file && !-l $file); 930 $len = length($labels{$name}) if length($labels{$name}) > $len; 931 } 932 } 933 if ($showdates) { 934 $len += 3; 935 foreach my $name (@values) { 936 my $file = "$dir/$name"; 937 my ($size,$date) = (lstat($file))[7,9]; 938 $labels{$name} = sprintf("%-${len}s%-16s%10s",$labels{$name}, 939 ((-d $file)? ("",""): 940 (getDate($date),getSize($size)))); 941 } 942 } 943 return (\@values,\%labels); 944 } 945 946 sub getDate { 947 my ($sec,$min,$hour,$day,$month,$year) = localtime(shift); 948 sprintf("%02d-%02d-%04d %02d:%02d",$month+1,$day,$year+1900,$hour,$min); 949 } 950 951 sub getSize { 952 my $size = shift; 953 return $size." B " if $size < 1024; 954 return sprintf("%.1f KB",$size/1024) if $size < 1024*100; 955 return sprintf("%d KB",int($size/1024)) if $size < 1024*1024; 956 return sprintf("%.1f MB",$size/1024/1024) if $size < 1024*1024*100; 957 return sprintf("%d MB",$size/1024/1024); 958 } 959 960 ################################################## 961 # 962 # Check if a file is a symbolic link that we 963 # are not allowed to follow. 964 # 965 sub isSymLink { 966 my $self = shift; my $file = shift; 967 return 0 unless -l $file; 968 969 my $courseRoot = $self->{ce}{courseDirs}{root}; 970 $courseRoot = readlink($courseRoot) if -l $courseRoot; 971 my $pwd = $self->{pwd} || $self->r->param('pwd') || '.'; 972 my $link = File::Spec->rel2abs(readlink($file),"$courseRoot/$pwd"); 973 # 974 # Remove /./ and dir/../ constructs 975 # 976 $link =~ s!(^|/)(\.(/|$))+!$1!g; 977 while ($link =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; 978 979 # 980 # Link is OK if it is in the course directory 981 # 982 return 0 if substr($link,0,length($courseRoot)) eq $courseRoot; 983 984 # 985 # Look through the list of valid paths to see if this link is OK 986 # 987 my $valid = $self->{ce}{webworkDirs}{valid_symlinks}; 988 if (defined $valid && $valid) { 989 foreach my $path (@{$valid}) { 990 return 0 if substr($link,0,length($path)) eq $path; 991 } 992 } 993 994 return 1; 995 } 996 997 ################################################## 998 # 999 # Normalize the working directory and check if it is OK. 1000 # 1001 sub checkPWD { 1002 my $self = shift; 1003 my $pwd = shift; 1004 my $renameError = shift; 1005 1006 $pwd =~ s!//+!/!g; # remove duplicate slashes 1007 $pwd =~ s!(^|/)~!$1_!g; # remove ~user references 1008 $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories 1009 1010 # remove dir/.. constructions 1011 while ($pwd =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; 1012 1013 $pwd =~ s!/$!!; # remove trailing / 1014 return if ($pwd =~ m!(^|/)\.\.(/|$)!); # Error if outside the root 1015 1016 # check for bad symbolic links 1017 my @dirs = split('/',$pwd); 1018 pop(@dirs) if $renameError; # don't check file iteself in this case 1019 my @path = ($self->{ce}{courseDirs}{root}); 1020 foreach my $dir (@dirs) { 1021 push @path,$dir; 1022 return if ($self->isSymLink(join('/',@path))); 1023 } 1024 1025 my $original = $pwd; 1026 $pwd =~ s!(^|/)\.!$1_!g; # don't enter hidden directories 1027 $pwd =~ s!^/!!; # remove leading / 1028 $pwd =~ s![^-_./A-Z0-9~ ]!_!gi; # no illegal characters 1029 return if $renameError && $original ne $pwd; 1030 1031 $pwd = '.' if $pwd eq ''; 1032 return $pwd; 1033 } 1034 1035 ################################################## 1036 # 1037 # Check that a file is uploaded to the correct directory 1038 # 1039 sub checkFileLocation { 1040 my $self = shift; 1041 my $extension = shift; $extension =~ s/.*\.//; 1042 my $dir = shift; 1043 return unless defined($uploadDir{$extension}); 1044 return if $dir =~ m/^$uploadDir{$extension}$/; 1045 $dir = $uploadDir{$extension}; $dir =~ s!/\.\*!!; 1046 $self->addbadmessage("Files with extension '.$extension' usually belong in '$dir'"); 1047 } 1048 1049 ################################################## 1050 # 1051 # Check a name for bad characters, etc. 1052 # 1053 sub checkName { 1054 my $file = shift; 1055 $file =~ s!.*[/\\]!!; # remove directory 1056 $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters 1057 $file =~ s/^\./_/; # no initial dot 1058 $file = "newfile.txt" unless $file; # no blank names 1059 return $file; 1060 } 1061 1062 ################################################## 1063 # 1064 # Get a unique name (in case it already exists) 1065 # 1066 sub uniqueName { 1067 my $dir = shift; my $name = shift; 1068 return $name unless (-e "$dir/$name"); 1069 my $type = ""; my $n = 1; 1070 $type = $1 if ($name =~ s/(\.[^.]*)$//); 1071 $n = $1 if ($name =~ s/_(\d+)$/_/); 1072 while (-e "$dir/${name}_$n$type") {$n++} 1073 return "${name}_$n$type"; 1074 } 1075 1076 ################################################## 1077 # 1078 # Verify that a name can be added tot he current 1079 # directory. 1080 # 1081 sub verifyName { 1082 my $self = shift; my $name = shift; my $object = shift; 1083 if ($name) { 1084 unless ($name =~ m!/!) { 1085 unless ($name =~ m!^\.!) { 1086 unless ($name =~ m![^-_.a-zA-Z0-9 ]!) { 1087 my $file = "$self->{courseRoot}/$self->{pwd}/$name"; 1088 return $file unless (-e $file); 1089 $self->addbadmessage("A file with that name already exists"); 1090 } else {$self->addbadmessage("Your $object name contains illegal characters")} 1091 } else {$self->addbadmessage("Your $object name may not begin with a dot")} 1092 } else {$self->addbadmessage("Your $object name may not contain a path component")} 1093 } else {$self->addbadmessage("You must specify a $object name")} 1094 return 1095 } 1096 1097 ################################################## 1098 # 1099 # Verify that a file path is valid 1100 # 1101 sub verifyPath { 1102 my $self = shift; my $path = shift; my $name = shift; 1103 1104 if ($path) { 1105 unless ($path =~ m![^-_.a-zA-Z0-9 /]!) { 1106 unless ($path =~ m!^/!) { 1107 $path = $self->checkPWD($self->{pwd}.'/'.$path,1); 1108 if ($path) { 1109 $path = $self->{courseRoot}.'/'.$path; 1110 $path .= '/'.$name if -d $path && $name; 1111 return $path unless (-e $path); 1112 $self->addbadmessage("A file with that name already exists"); 1113 } else {$self->addbadmessage("You have specified an illegal path")} 1114 } else {$self->addbadmessage("You can not specify an absolute path")} 1115 } else {$self->addbadmessage("Your file name contains illegal characters")} 1116 } else {$self->addbadmessage("You must specify a file name")} 1117 return 1118 } 1119 1120 ################################################## 1121 # 1122 # Get the value of a parameter flag 1123 # 1124 sub getFlag { 1125 my $self = shift; my $flag = shift; 1126 my $default = shift; $default = 0 unless defined $default; 1127 my $value = $self->r->param($flag); 1128 $value = $default unless defined $value; 1129 return $value; 1130 } 1131 1132 ################################################## 1133 # 1134 # Make HTML symbols printable 1135 # 1136 sub showHTML { 1137 my $string = shift; 1138 return '' unless defined $string; 1139 $string =~ s/&/\&/g; 1140 $string =~ s/</\</g; 1141 $string =~ s/>/\>/g; 1142 $string; 1143 } 1144 1145 ################################################## 1146 # 1147 # Check if a string is plain text 1148 # (i.e., doesn't contain three non-regular 1149 # characters in a row.) 1150 # 1151 sub isText { 1152 my $string = shift; 1153 return $string !~ m/[^\s\x20-\x7E]{3,}/; 1154 } 1155 1156 ################################################## 1157 # 1158 # Convert spaces to , but only REAL spaces 1159 # 1160 sub sp2nbsp { 1161 my $s = shift; 1162 $s =~ s/ /\ /g; 1163 return $s; 1164 } 1165 1166 ################################################## 1167 # 1168 # Hack to convert multiple spaces in the file 1169 # selection box into so that the columns 1170 # will allign properly in fixed-width fonts. 1171 # We have to do it agter the fact, since CGI:: 1172 # is being "helpful" by turning & in the labels 1173 # into & for us. So we have to convert 1174 # after the <SELECT> is created (ugh). 1175 # 1176 sub fixSpaces { 1177 my $s = shift; 1178 $s =~ s!(<option[^>]*>)(.*?)(</option>)!$1.sp2nbsp($2).$3!gei; 1179 return $s; 1180 } 1181 1182 ################################################## 1183 # 1184 # Interpret command return errors 1185 # 1186 sub systemError { 1187 my $status = shift; 1188 return "error: $!" if $status == 0xFF00; 1189 return "exit status ".($status >> 8) if ($status & 0xFF) == 0; 1190 return "signal ".($status &= ~0x80); 1191 } 1192 1193 ################################################## 1194 1195 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |