Parent Directory
| 
Revision Log
entabed (we like real tabs)
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 2004/09/05 01:03:13 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 25 =head1 NAME 26 27 WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manager for WW files 28 29 =cut 30 31 use strict; 32 use warnings; 33 use CGI; 34 35 ################################################## 36 # 37 # Check that the user is authorized, and then 38 # see if there is a download to perform. 39 # 40 sub pre_header_initialize { 41 my $self = shift; 42 my $r = $self->r; 43 my $authz = $r->authz; 44 my $user = $r->param('user'); 45 46 unless ($authz->hasPermissions($user, "access_instructor_tools")) { 47 $self->addbadmessage("You aren't authorized to manage course files"); 48 return; 49 } 50 51 my $action = $r->param('action'); 52 $self->Download if ($action && $action eq 'Download'); 53 my $file = $r->param('download'); 54 $self->downloadFile($file) if (defined $file); 55 } 56 57 ################################################## 58 # 59 # Download a given file 60 # 61 sub downloadFile { 62 my $self = shift; 63 my $file = checkName(shift); 64 my $pwd = checkPWD(shift || $self->r->param('pwd') || '.'); 65 return unless $pwd; 66 $pwd = $self->{ce}{courseDirs}{root} . '/' . $pwd; 67 unless (-e "$pwd/$file") { 68 $self->addbadmessage("The file you are trying to download doesn't exist"); 69 return; 70 } 71 unless (-f "$pwd/$file") { 72 $self->addbadmessage("You can only download regular files."); 73 return; 74 } 75 my $type = "application/octet-stream"; 76 $type = "text/plain" if $file =~ m/\.(pg|pl|pm|txt|def|csv|lst)/; 77 $type = "image/gif" if $file =~ m/\.gif/; 78 $type = "image/jpeg" if $file =~ m/\.(jpg|jpeg)/; 79 $type = "image/png" if $file =~ m/\.png/; 80 $self->reply_with_file($type, "$pwd/$file", $file, 0); 81 } 82 83 ################################################## 84 # 85 # The main body of the page 86 # 87 sub body { 88 my $self = shift; 89 my $r = $self->r; 90 my $urlpath = $r->urlpath; 91 my $db = $r->db; 92 my $ce = $r->ce; 93 my $authz = $r->authz; 94 my $courseRoot = $ce->{courseDirs}{root}; 95 my $courseName = $urlpath->arg('courseID'); 96 my $user = $r->param('user'); 97 my $key = $r->param('key'); 98 99 return CGI::em("You are not authorized to access the instructor tools") 100 unless $authz->hasPermissions($user, "access_instructor_tools"); 101 102 $self->{pwd} = checkPWD($r->param('pwd') || '.'); 103 return CGI::em("You have specified an illegal working directory!") unless defined $self->{pwd}; 104 105 my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName); 106 my $fileManagerURL = $self->systemLink($fileManagerPage, authen => 0); 107 108 print CGI::start_multipart_form( 109 -method=>"POST", 110 -action=>$fileManagerURL, 111 -id=>"FileManager", 112 -name=>"FileManager" 113 ); 114 print $self->hidden_authen_fields; 115 116 $self->{courseRoot} = $courseRoot; 117 $self->{courseName} = $courseName; 118 119 my $action = $r->param('action') || $r->param('formAction') || 'Refresh'; 120 121 for ($action) { 122 /^Refresh/i and do {$self->Refresh; last}; 123 /^Cancel/i and do {$self->Refresh; last}; 124 /^\^/i and do {$self->ParentDir; last}; 125 /^Directory/i and do {$self->Go; last}; 126 /^Go/i and do {$self->Go; last}; 127 /^View/i and do {$self->View; last}; 128 /^Edit/i and do {$self->Edit; last}; 129 /^Download/i and do {$self->Refresh; last}; 130 /^Copy/i and do {$self->Copy; last}; 131 /^Rename/i and do {$self->Rename; last}; 132 /^Delete/i and do {$self->Delete; last}; 133 /^New Folder/i and do {$self->NewFolder; last}; 134 /^New File/i and do {$self->NewFile; last}; 135 /^Upload/i and do {$self->Upload; last}; 136 /^Revert/i and do {$self->Edit; last}; 137 /^Save As/i and do {$self->SaveAs; last}; 138 /^Save/i and do {$self->Save; last}; 139 $self->addbadmessage("Unknown action."); 140 $self->Refresh; 141 } 142 143 print CGI::hidden({name=>'pwd',value=>$self->{pwd}}); 144 print CGI::hidden({name=>'formAction'}); 145 print CGI::end_multipart_form(); 146 147 return ""; 148 } 149 150 151 ################################################## 152 # 153 # Display the directory listing and associated buttons 154 # 155 sub Refresh { 156 my $self = shift; 157 my $pwd = shift || $self->{pwd}; 158 my $isTop = $pwd eq '.' || $pwd eq ''; 159 160 my ($dirs,$dirlabels) = directoryMenu($self->{courseName},$pwd); 161 my ($files,$filelabels) = directoryListing($self->{courseRoot},$pwd); 162 163 unless ($files) { 164 $self->addbadmessage("The directory you specified doesn't exist"); 165 $files = []; $filelabels = {}; 166 } 167 168 # 169 # Some JavaScript to make things easier for the user 170 # 171 print CGI::script(<<EOF); 172 function doForm(action) { 173 var form = window.document.getElementById('FileManager'); 174 form.formAction.value = action; 175 form.submit(); 176 } 177 function disableButton(id,state) { 178 var element = window.document.getElementById(id); 179 element.disabled = state; 180 } 181 function checkFiles() { 182 var files = window.document.getElementById('files'); 183 var state = files.selectedIndex < 0; 184 disableButton('View',state); 185 disableButton('Edit',state); 186 disableButton('Download',state); 187 disableButton('Rename',state); 188 disableButton('Copy',state); 189 disableButton('Delete',state); 190 } 191 function checkFile() { 192 var file = window.document.getElementById('file'); 193 var state = (file.value == ""); 194 disableButton('Upload',state); 195 } 196 EOF 197 198 # 199 # Start the table 200 # 201 print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>10, style=>"margin:1em 0 0 3em"}); 202 203 # 204 # Directory menu 205 # 206 print CGI::Tr( 207 CGI::td({colspan=>3}, 208 CGI::input({type=>"submit", name=>"action", value => "^", ($isTop? (disabled=>1): ())}), 209 CGI::popup_menu(-name => "directory", 210 -values => $dirs, -labels => $dirlabels, 211 -style => "width:25em", 212 -onChange => "doForm('Go')"), 213 CGI::noscript(CGI::input({type=>"submit",name=>"action",value=>"Go"})) 214 ) 215 ); 216 217 # 218 # Directory Listing 219 # 220 my %button = (type=>"submit",name=>"action",style=>"width:10em"); 221 print CGI::Tr({valign=>"middle"}, 222 CGI::td(CGI::scrolling_list(-name => "files", id => "files", 223 -style => "font-family:monospace; width:30em; height:100%", 224 -size => 15, -multiple => 1, 225 -values => $files, -labels => $filelabels, 226 -onDblClick => "doForm('View')", 227 -onChange => "checkFiles()")), 228 CGI::td({width=>3}), 229 CGI::td( 230 CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3}), 231 CGI::Tr([ 232 CGI::td(CGI::input({%button,value=>"View",id=>"View"})), 233 CGI::td(CGI::input({%button,value=>"Edit",id=>"Edit"})), 234 CGI::td(CGI::input({%button,value=>"Download",id=>"Download"})), 235 CGI::td(CGI::input({%button,value=>"Rename",id=>"Rename"})), 236 CGI::td(CGI::input({%button,value=>"Copy",id=>"Copy"})), 237 CGI::td(CGI::input({%button,value=>"Delete",id=>"Delete"})), 238 CGI::td({height=>10}), 239 CGI::td(CGI::input({%button,value=>"New File"})), 240 CGI::td(CGI::input({%button,value=>"New Folder"})), 241 CGI::td(CGI::input({%button,value=>"Refresh"})), 242 ]), 243 CGI::end_table(), 244 ), 245 ); 246 247 # 248 # Upload button 249 # 250 print CGI::Tr([ 251 CGI::td(), 252 CGI::td({colspan=>3}, 253 CGI::input({type=>"submit",name=>"action",style=>"width:7em",value=>"Upload:",id=>"Upload"}), 254 CGI::input({type=>"file",name=>"file",id=>"file",size=>40,onChange=>"checkFile()"}), 255 ), 256 ]); 257 258 # 259 # End the table 260 # 261 print CGI::end_table(); 262 print CGI::script("checkFiles(); checkFile();"); 263 } 264 265 ################################################## 266 # 267 # Move to the parent directory 268 # 269 sub ParentDir { 270 my $self = shift; 271 $self->{pwd} = '.' unless ($self->{pwd} =~ s!/[^/]*$!!); 272 $self->Refresh; 273 } 274 275 ################################################## 276 # 277 # Move to the parent directory 278 # 279 sub Go { 280 my $self = shift; 281 $self->{pwd} = $self->r->param('directory'); 282 $self->Refresh; 283 } 284 285 ################################################## 286 # 287 # Open a directory or view a file 288 # 289 sub View { 290 my $self = shift; my $pwd = $self->{pwd}; 291 my $filename = $self->getFile("view"); return unless $filename; 292 my $name = "$pwd/$filename"; $name =~ s!^\./?!!; 293 294 # 295 # Handle directories by making them the working directory 296 # 297 my $file = "$self->{courseRoot}/$pwd/$filename"; 298 if (-d $file) { 299 $self->{pwd} .= '/'.$filename; 300 $self->Refresh; return; 301 } 302 303 unless (-f $file) { 304 $self->addbadmessage("You can't view files of that type"); 305 $self->Refresh; return; 306 } 307 308 # 309 # Include a download link 310 # 311 my $urlpath = $self->r->urlpath; 312 my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $self->{courseName}); 313 my $fileManagerURL = $self->systemLink($fileManagerPage, params => {download => $filename, pwd => $pwd}); 314 print CGI::div({style=>"float:right"}, 315 CGI::a({href=>$fileManagerURL},"Download")); 316 print CGI::p(),CGI::b($name),CGI::p(); 317 print CGI::hr(); 318 319 # 320 # For files, display the file, if possible. 321 # If the file is an image, display it as an image. 322 # 323 my $data = readFile($file); 324 if (isText($data)) { 325 print CGI::pre(showHTML($data)); 326 } elsif ($file =~ m/\.(gif|jpg|png)/i) { 327 print CGI::img({src=>$fileManagerURL, border=>0}); 328 } else { 329 print CGI::div({class=>"ResultsWithError"}, 330 "The file does not appear to be a text file."); 331 } 332 } 333 334 ################################################## 335 # 336 # Edit a file 337 # 338 sub Edit { 339 my $self = shift; 340 my $filename = $self->getFile('edit'); return unless $filename; 341 my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; 342 343 if (-d $file) { 344 $self->addbadmessage("You can't edit a directory"); 345 $self->Refresh; return; 346 } 347 unless (-f $file) { 348 $self->addbadmessage("You can only edit text files"); 349 $self->Refresh; return; 350 } 351 my $data = readFile($file); 352 if (!isText($data)) { 353 $self->addbadmessage("The file does not appear to be a text file"); 354 $self->Refresh; return; 355 } 356 357 $self->RefreshEdit($data,$filename); 358 } 359 360 ################################################## 361 # 362 # Save the edited file 363 # 364 sub Save { 365 my $self = shift; my $filename = shift; 366 my $pwd = $self->{pwd}; 367 if ($filename) { 368 $pwd = substr($filename,length($self->{courseRoot})+1); 369 $pwd =~ s!/([^/]*)$!!; $filename = $1; 370 } else { 371 $filename = $self->getFile("save"); return unless $filename; 372 } 373 my $file = "$self->{courseRoot}/$pwd/$filename"; 374 my $data = $self->r->param("data"); 375 376 if (defined($data)) { 377 if (open(OUTFILE,">$file")) { 378 eval {print OUTFILE $data; close(OUTFILE)}; 379 if ($@) {$self->addbadmessage("Failed to save: $@")} 380 else {$self->addgoodmessage("File saved")} 381 } else {$self->addbadmessage("Can't write to file: $!")} 382 } else {$data = ""; $self->addbadmessage("Error: no file data was submitted!")} 383 384 $self->{pwd} = $pwd; 385 $self->RefreshEdit($data,$filename); 386 } 387 388 ################################################## 389 # 390 # Save the edited file under a new name 391 # 392 sub SaveAs { 393 my $self = shift; 394 395 my $newfile = $self->r->param('name'); 396 my $original = $self->r->param('files'); 397 $newfile = $self->verifyPath($newfile,$original); 398 if ($newfile) {$self->Save($newfile); return} 399 $self->RefreshEdit($self->r->param('data'),$original); 400 } 401 402 ################################################## 403 # 404 # Display the Edit page 405 # 406 sub RefreshEdit { 407 my $self = shift; my $data = shift; my $file = shift; 408 my $pwd = shift || $self->{pwd}; 409 my $name = "$pwd/$file"; $name =~ s!^\./?!!; 410 411 my %button = (type=>"submit",name=>"action",style=>"width:6em"); 412 print CGI::p(); 413 print CGI::start_table({border=>0,cellspacing=>0,cellpadding=>2, width=>"95%", align=>"center"}); 414 print CGI::Tr([ 415 CGI::td({align=>"center",style=>"background-color:#CCCCCC"},CGI::b($name)), 416 CGI::td(CGI::textarea(-name=>"data",-default=>$data,-override=>1,-rows=>30,-columns=>80, 417 -style=>"width:100%")), ## can't seem to get variable height to work 418 CGI::td({align=>"center", nowrap=>1}, 419 CGI::input({%button,value=>"Cancel"})," ", 420 CGI::input({%button,value=>"Revert"})," ", 421 CGI::input({%button,value=>"Save As:"}), 422 CGI::input({type=>"text",name=>"name",size=>20,style=>"width:50%"})," ", 423 CGI::input({%button,value=>"Save"}), 424 ), 425 ]); 426 print CGI::end_table(); 427 print CGI::hidden({name=>"files",value=>$file}); 428 } 429 430 ################################################## 431 # 432 # Copy a file 433 # 434 sub Copy { 435 my $self = shift; 436 my $oldfile = $self->getFile('copy'); return unless $oldfile; 437 my $original = $oldfile; 438 $oldfile = "$self->{courseRoot}/$self->{pwd}/$oldfile"; 439 440 if (-d $oldfile) { 441 ## FIXME: need to do recursive directory copy 442 $self->addbadmessage("Directory copies are not yet implemented"); 443 $self->Refresh; 444 return; 445 } 446 447 if ($self->r->param('confirmed')) { 448 my $newfile = $self->r->param('name'); 449 if ($newfile = $self->verifyPath($newfile,$original)) { 450 if (copy($oldfile, $newfile)) { 451 $self->addgoodmessage("File successfully copied"); 452 $self->Refresh; return; 453 } else {$self->addbadmessage("Can't copy file: $!")} 454 } 455 } 456 457 Confirm("Copy file as:","Copy"); 458 print CGI::hidden({name=>"files",value=>$original}); 459 } 460 461 ################################################## 462 # 463 # Rename a file 464 # 465 sub Rename { 466 my $self = shift; 467 my $oldfile = $self->getFile('rename'); return unless $oldfile; 468 my $original = $oldfile; 469 $oldfile = "$self->{courseRoot}/$self->{pwd}/$oldfile"; 470 471 if ($self->r->param('confirmed')) { 472 my $newfile = $self->r->param('name'); 473 if ($newfile = $self->verifyPath($newfile,$original)) { 474 if (rename $oldfile, $newfile) { 475 $self->addgoodmessage("File successfully renamed"); 476 $self->Refresh; return; 477 } else {$self->addbadmessage("Can't rename file: $!")} 478 } 479 } 480 481 Confirm("Rename file as:","Rename"); 482 print CGI::hidden({name=>"files",value=>$original}); 483 } 484 485 ################################################## 486 # 487 # Delete a file 488 # 489 sub Delete { 490 my $self = shift; 491 my @files = $self->r->param('files'); 492 if (scalar(@files) == 0) { 493 $self->addbadmessage("You must select at least one file to delete"); 494 $self->Refresh; return; 495 } 496 497 my $pwd = $self->{pwd}; 498 my $dir = $self->{courseRoot}.'/'.$pwd; 499 if ($self->r->param('confirmed')) { 500 501 # 502 # If confirmed, go ahead and delete the files 503 # 504 foreach my $file (@files) { 505 if (defined checkPWD("$pwd/$file",1)) { 506 if (-d "$dir/$file") { 507 my $removed = eval {rmtree("$dir/$file",0,1)}; 508 if ($removed) {$self->addgoodmessage("Directory '$file' removed (items deleted: $removed)")} 509 else {$self->addbadmessage("Directory '$file' not removed: $!")} 510 } else { 511 if (unlink("$dir/$file")) {$self->addgoodmessage("File '$file' successfully removed")} 512 else {$self->addbadmessage("File '$file' not removed: $!")} 513 } 514 } else {$self->addbadmessage("Illegal file '$file' specified"); last} 515 } 516 $self->Refresh; 517 518 } else { 519 520 # 521 # Put up the confirmation dialog box 522 # 523 print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 5em"}); 524 print CGI::Tr( 525 CGI::td( 526 CGI::b("Warning:")," You have requested that the following items be deleted\n", 527 CGI::ul(CGI::li(\@files)), 528 ((grep { -d "$dir/$_" } @files)? 529 CGI::p({style=>"width:500"},"Some of these files are directories. ", 530 "Only delete directories if you really know what you are doing. ", 531 "You can seriously damage your course if you delete the wrong thing."): ""), 532 CGI::p({style=>"color:red"},"There is no undo for deleting files or directories!"), 533 CGI::p("Really delete the items listed above?"), 534 CGI::div({style=>"float:left; padding-left:3ex"}, 535 CGI::input({type=>"submit",name=>"action",value=>"Cancel"})), 536 CGI::div({style=>"float:right; padding-right:3ex"}, 537 CGI::input({type=>"submit",name=>"action",value=>"Delete"})), 538 ), 539 ); 540 print CGI::end_table(); 541 542 print CGI::hidden({name=>"confirmed",value=>1}); 543 foreach my $file (@files) {print CGI::hidden({name=>"files",value=>$file})} 544 } 545 } 546 547 ################################################## 548 # 549 # Make a new file and edit it 550 # 551 sub NewFile { 552 my $self = shift; 553 554 if ($self->r->param('confirmed')) { 555 my $name = $self->r->param('name'); 556 if (my $file = $self->verifyName($name,"file")) { 557 if (open(NEWFILE,">$file")) { 558 close(NEWFILE); 559 $self->RefreshEdit("",$name); 560 return; 561 } else {$self->addbadmessage("Can't create file: $!")} 562 } 563 } 564 565 Confirm("New file name:","New File"); 566 } 567 568 ################################################## 569 # 570 # Make a new directory 571 # 572 sub NewFolder { 573 my $self = shift; 574 575 if ($self->r->param('confirmed')) { 576 my $name = $self->r->param('name'); 577 if (my $dir = $self->verifyName($name,"directory")) { 578 if (mkdir $dir, 0750) { 579 $self->{pwd} .= '/'.$name; 580 $self->Refresh; return; 581 } else {$self->addbadmessage("Can't create directory: $!")} 582 } 583 } 584 585 Confirm("New folder name:","New Folder"); 586 } 587 588 ################################################## 589 # 590 # Download a file 591 # 592 sub Download { 593 my $self = shift; 594 my $filename = $self->getFile("download"); return unless $filename; 595 my $pwd = checkPWD($self->r->param('pwd') || '.'); 596 return unless $pwd; 597 my $file = $self->{ce}{courseDirs}{root}.'/'.$pwd.'/'.$filename; 598 599 if (-d $file) {$self->addbadmessage("You can't download directories"); return} 600 unless (-f $file) {$self->addbadmessage("You can't download files of that type"); return} 601 602 $self->r->param('download',$filename); 603 } 604 605 ################################################## 606 # 607 # Upload a file to the server 608 # 609 sub Upload { 610 my $self = shift; 611 my $dir = "$self->{courseRoot}/$self->{pwd}"; 612 my $fileIDhash = $self->r->param('file'); 613 unless ($fileIDhash) { 614 $self->addbadmessage("You have not chosen a file to upload."); 615 $self->Refresh; 616 return; 617 } 618 619 my ($id,$hash) = split(/\s+/,$fileIDhash); 620 my $upload = WeBWorK::Upload->retrieve($id,$hash,dir=>$self->{ce}{webworkDirs}{uploadCache}); 621 622 my $name = uniqueName($dir,checkName($upload->filename)); 623 if (-e "$dir/$name") { 624 $self->addbadmessage("A file with that name already exists"); 625 $self->Refresh; 626 $upload->dispose; 627 return; 628 } 629 630 $upload->disposeTo("$dir/$name"); 631 $self->addgoodmessage("File '$name' uploaded successfully"); 632 $self->Refresh; 633 } 634 635 ################################################## 636 ################################################## 637 # 638 # Print a confirmation dialog box 639 # 640 sub Confirm { 641 my $message = shift; 642 my $button = shift; 643 644 print CGI::p(); 645 print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 3em"}); 646 print CGI::Tr( 647 CGI::td( 648 $message, 649 CGI::input({type=>"text",name=>"name",size=>50}), 650 CGI::p(), 651 CGI::div({style=>"float:right; padding-right:3ex"}, 652 CGI::input({type=>"submit",name=>"action",value=>$button})), # this will be the default 653 CGI::div({style=>"float:left; padding-left:3ex"}, 654 CGI::input({type=>"submit",name=>"action",value=>"Cancel"})), 655 ), 656 ); 657 print CGI::end_table(); 658 print CGI::hidden({name=>"confirmed",value=>1}); 659 print CGI::script("window.document.FileManager.name.focus()"); 660 } 661 662 ################################################## 663 # 664 # Check that there is exactly one vailid file 665 # 666 sub getFile { 667 my $self = shift; my $action = shift; 668 my @files = $self->r->param("files"); 669 if (scalar(@files) > 1) { 670 $self->addbadmessage("You can only $action one file at a time."); 671 $self->Refresh unless $action eq 'download'; 672 return; 673 } 674 if (scalar(@files) == 0 || $files[0] eq "") { 675 $self->addbadmessage("You need to select a file to $action."); 676 $self->Refresh unless $action eq 'download'; 677 return; 678 } 679 my $pwd = checkPWD($self->{pwd} || $self->r->param('pwd') || '.') || '.'; 680 $self->addbadmessage("You have specified an illegal file") 681 unless checkPWD($pwd.'/'.$files[0],1); 682 return $files[0]; 683 } 684 685 ################################################## 686 # 687 # Get the entries for the directory menu 688 # 689 sub directoryMenu { 690 my $course = shift; 691 my $dir = shift; $dir =~ s!^\.(/|$)!!; 692 my @dirs = split('/',$dir); 693 my $menu = ""; my $pwd; 694 695 my (@values,%labels); 696 while (scalar(@dirs)) { 697 $pwd = join('/',(@dirs)[0..$#dirs]); 698 $dir = pop(@dirs); 699 push(@values,$pwd); $labels{$pwd} = $dir; 700 } 701 push(@values,'.'); $labels{'.'} = $course; 702 return (\@values,\%labels); 703 } 704 705 ################################################## 706 # 707 # Get the directory listing 708 # 709 sub directoryListing { 710 my $root = shift; my $pwd = shift; 711 my $dir = $root.'/'.$pwd; 712 my (@values,%labels,$size,$data); 713 714 return unless -d $dir; 715 my @names = sortByName(undef,grep(/^[^.]/,readDirectory($dir))); 716 foreach my $name(@names) { 717 push(@values,$name); $labels{$name} = $name; 718 $labels{$name} .= '/' if (-d $dir.'/'.$name); 719 } 720 return (\@values,\%labels); 721 } 722 723 ################################################## 724 # 725 # Normalize the working directory and check if it is OK. 726 # 727 sub checkPWD { 728 my $pwd = shift; 729 my $renameError = shift; 730 731 $pwd =~ s!//+!/!g; # remove duplicate slashes 732 $pwd =~ s!(^|/)~!$1_!g; # remove ~user references 733 $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories 734 # remove dir/.. constructions 735 while ($pwd =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; 736 $pwd =~ s!/$!!; # remove trailing / 737 return if ($pwd =~ m!(^|/)\.\.(/|$)!); # Error if outside the root 738 739 my $original = $pwd; 740 $pwd =~ s!(^|/)\.!$1_!g; # don't enter hidden directories 741 $pwd =~ s!^/!!; # remove leading / 742 $pwd =~ s![^-_./a-zA-Z0-9 ]!_!g; # no illegal characters 743 return if $renameError && $original ne $pwd; 744 745 $pwd = '.' if $pwd eq ''; 746 return $pwd; 747 } 748 749 ################################################## 750 # 751 # Check a name for bad characters, etc. 752 # 753 sub checkName { 754 my $file = shift; 755 $file =~ s!.*[/\\]!!; # remove directory 756 $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters 757 $file = "newfile.txt" unless $file; # no blank names 758 $file =~ s/^\./_/; # no initial dot 759 return $file; 760 } 761 762 ################################################## 763 # 764 # Get a unique name (in case it already exists) 765 # 766 sub uniqueName { 767 my $dir = shift; my $name = shift; 768 my $type = ""; my $n = -1; 769 $type = $1 if ($name =~ s/(\.[^.]*)$//); 770 $n = $1 if ($name =~ s/(\d+)$//); 771 while (-e "$dir/$name$n$type") {if ($n < 0) {$n--} else {$n++}} 772 return "$name$n$type"; 773 } 774 775 ################################################## 776 # 777 # Verify that a name can be added tot he current 778 # directory. 779 # 780 sub verifyName { 781 my $self = shift; my $name = shift; my $object = shift; 782 if ($name) { 783 unless ($name =~ m!/!) { 784 unless ($name =~ m!^\.!) { 785 unless ($name =~ m![^-_.a-zA-Z0-9 ]!) { 786 my $file = "$self->{courseRoot}/$self->{pwd}/$name"; 787 return $file unless (-e $file); 788 $self->addbadmessage("A file with that name already exists"); 789 } else {$self->addbadmessage("Your $object name contains illegal characters")} 790 } else {$self->addbadmessage("Your $object name may not begin with a dot")} 791 } else {$self->addbadmessage("Your $object name may not contain a path component")} 792 } else {$self->addbadmessage("You must specify a $object name")} 793 return 794 } 795 796 ################################################## 797 # 798 # Verify that a file path is valid 799 # 800 sub verifyPath { 801 my $self = shift; my $path = shift; my $name = shift; 802 803 if ($path) { 804 unless ($path =~ m![^-_.a-zA-Z0-9 /]!) { 805 unless ($path =~ m!^/!) { 806 $path = checkPWD($self->{pwd}.'/'.$path,1); 807 if ($path) { 808 $path = $self->{courseRoot}.'/'.$path; 809 $path .= '/'.$name if -d $path && $name; 810 return $path unless (-e $path); 811 $self->addbadmessage("A file with that name already exists"); 812 } else {$self->addbadmessage("You have specified an illegal path")} 813 } else {$self->addbadmessage("You can not specify an absolute path")} 814 } else {$self->addbadmessage("Your file name contains illegal characters")} 815 } else {$self->addbadmessage("You must specify a file name")} 816 return 817 } 818 819 ################################################## 820 # 821 # Make HTML symbols printable 822 # 823 sub showHTML { 824 my $string = shift; 825 return '' unless defined $string; 826 $string =~ s/&/\&/g; 827 $string =~ s/</\</g; 828 $string =~ s/>/\>/g; 829 $string; 830 } 831 832 ################################################## 833 # 834 # Check if a string is plain text 835 # (i.e., doesn't contain three non-regular 836 # characters in a row.) 837 # 838 sub isText { 839 my $string = shift; 840 return $string !~ m/[^\s\x20-\x7E]{3,}/; 841 } 842 843 ################################################## 844 845 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |