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