--- trunk/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm 2004/10/11 23:13:22 2897 +++ branches/rel-2-3-dev/webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm 2006/09/10 19:54:50 4473 @@ -1,7 +1,7 @@ ################################################################################ # WeBWorK Online Homework Delivery System -# Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ -# $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/FileManager.pm,v 1.10 2004/09/05 01:03:13 dpvc Exp $ +# Copyright © 2000-2006 The WeBWorK Project, http://openwebwork.sf.net/ +# $CVSHeader$ # # This program is free software; you can redistribute it and/or modify it under # the terms of either: (a) the GNU General Public License as published by the @@ -10,7 +10,7 @@ # # This program is distributed in the hope that it will be useful, but WITHOUT # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the +# FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the # Artistic License for more details. ################################################################################ @@ -21,823 +21,1180 @@ use WeBWorK::Upload; use File::Path; use File::Copy; +use File::Spec; +use String::ShellQuote; =head1 NAME -WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manager for WW files +WeBWorK::ContentGenerator::Instructor::FileManager.pm -- simple directory manager for WW files =cut use strict; use warnings; -use CGI; +#use CGI; +use WeBWorK::CGI; + +use constant HOME => 'templates'; + +# +# The list of file extensions and the directories they usually go in. +# +my %uploadDir = ( + csv => 'scoring', + lst => 'templates', + pg => 'templates/.*', + pl => 'templates/macros', + def => 'templates', + html => 'html/.*', +); ################################################## # -# Check that the user is authorized, and then -# see if there is a download to perform. +# Check that the user is authorized, and then +# see if there is a download to perform. # sub pre_header_initialize { - my $self = shift; - my $r = $self->r; - my $authz = $r->authz; - my $user = $r->param('user'); + my $self = shift; + my $r = $self->r; + my $authz = $r->authz; + my $user = $r->param('user'); - unless ($authz->hasPermissions($user, "access_instructor_tools")) { - $self->addbadmessage("You aren't authorized to manage course files"); - return; - } - - my $action = $r->param('action'); - $self->Download if ($action && $action eq 'Download'); - my $file = $r->param('download'); - $self->downloadFile($file) if (defined $file); + # we don't need to return an error here, because body() will print an error for us :) + return unless $authz->hasPermissions($user, "manage_course_files"); + + my $action = $r->param('action'); + $self->Download if ($action && $action eq 'Download'); + my $file = $r->param('download'); + $self->downloadFile($file) if (defined $file); } ################################################## # -# Download a given file +# Download a given file # sub downloadFile { - my $self = shift; - my $file = checkName(shift); - my $pwd = checkPWD(shift || $self->r->param('pwd') || '.'); - return unless $pwd; - $pwd = $self->{ce}{courseDirs}{root} . '/' . $pwd; - unless (-e "$pwd/$file") { - $self->addbadmessage("The file you are trying to download doesn't exist"); - return; - } - unless (-f "$pwd/$file") { - $self->addbadmessage("You can only download regular files."); - return; - } - my $type = "application/octet-stream"; - $type = "text/plain" if $file =~ m/\.(pg|pl|pm|txt|def|csv|lst)/; - $type = "image/gif" if $file =~ m/\.gif/; - $type = "image/jpeg" if $file =~ m/\.(jpg|jpeg)/; - $type = "image/png" if $file =~ m/\.png/; - $self->reply_with_file($type, "$pwd/$file", $file, 0); + my $self = shift; + my $file = checkName(shift); + my $pwd = $self->checkPWD(shift || $self->r->param('pwd') || HOME); + return unless $pwd; + $pwd = $self->{ce}{courseDirs}{root} . '/' . $pwd; + unless (-e "$pwd/$file") { + $self->addbadmessage("The file you are trying to download doesn't exist"); + return; + } + unless (-f "$pwd/$file") { + $self->addbadmessage("You can only download regular files."); + return; + } + my $type = "application/octet-stream"; + $type = "text/plain" if $file =~ m/\.(pg|pl|pm|txt|def|csv|lst)/; + $type = "image/gif" if $file =~ m/\.gif/; + $type = "image/jpeg" if $file =~ m/\.(jpg|jpeg)/; + $type = "image/png" if $file =~ m/\.png/; + $self->reply_with_file($type, "$pwd/$file", $file, 0); } ################################################## # -# The main body of the page +# The main body of the page # sub body { - my $self = shift; - my $r = $self->r; - my $urlpath = $r->urlpath; - my $db = $r->db; - my $ce = $r->ce; - my $authz = $r->authz; - my $courseRoot = $ce->{courseDirs}{root}; - my $courseName = $urlpath->arg('courseID'); - my $user = $r->param('user'); - my $key = $r->param('key'); + my $self = shift; + my $r = $self->r; + my $urlpath = $r->urlpath; + my $db = $r->db; + my $ce = $r->ce; + my $authz = $r->authz; + my $courseRoot = $ce->{courseDirs}{root}; + my $courseName = $urlpath->arg('courseID'); + my $user = $r->param('user'); + my $key = $r->param('key'); - return CGI::em("You are not authorized to access the instructor tools") - unless $authz->hasPermissions($user, "access_instructor_tools"); + return CGI::em("You are not authorized to manage course files") + unless $authz->hasPermissions($user, "manage_course_files"); + + $self->{pwd} = $self->checkPWD($r->param('pwd') || HOME); + return CGI::em("You have specified an illegal working directory!") unless defined $self->{pwd}; + + my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName); + my $fileManagerURL = $self->systemLink($fileManagerPage, authen => 0); + + print CGI::start_form( + -method=>"POST", + -action=>$fileManagerURL, + -id=>"FileManager", + -enctype=> 'multipart/form-data', + -name=>"FileManager", + -style=>"margin:0", + ); + print $self->hidden_authen_fields; + + $self->{courseRoot} = $courseRoot; + $self->{courseName} = $courseName; + + my $action = $r->param('action') || $r->param('formAction') || 'Init'; + + for ($action) { + /^Refresh/i and do {$self->Refresh; last}; + /^Cancel/i and do {$self->Refresh; last}; + /^\^/i and do {$self->ParentDir; last}; + /^Directory/i and do {$self->Go; last}; + /^Go/i and do {$self->Go; last}; + /^View/i and do {$self->View; last}; + /^Edit/i and do {$self->Edit; last}; + /^Download/i and do {$self->Refresh; last}; + /^Copy/i and do {$self->Copy; last}; + /^Rename/i and do {$self->Rename; last}; + /^Delete/i and do {$self->Delete; last}; + /^Make/i and do {$self->MakeArchive; last}; + /^Unpack/i and do {$self->UnpackArchive; last}; + /^New Folder/i and do {$self->NewFolder; last}; + /^New File/i and do {$self->NewFile; last}; + /^Upload/i and do {$self->Upload; last}; + /^Revert/i and do {$self->Edit; last}; + /^Save As/i and do {$self->SaveAs; last}; + /^Save/i and do {$self->Save; last}; + /^Init/i and do {$self->Init; last}; + $self->addbadmessage("Unknown action."); + $self->Refresh; + } - $self->{pwd} = checkPWD($r->param('pwd') || '.'); - return CGI::em("You have specified an illegal working directory!") unless defined $self->{pwd}; + print CGI::hidden({name=>'pwd',value=>$self->{pwd}}); + print CGI::hidden({name=>'formAction',value=>""}); + print CGI::end_form(); - my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $courseName); - my $fileManagerURL = $self->systemLink($fileManagerPage, authen => 0); + return ""; +} - print CGI::start_multipart_form( - -method=>"POST", - -action=>$fileManagerURL, - -id=>"FileManager", - -name=>"FileManager" - ); - print $self->hidden_authen_fields; - - $self->{courseRoot} = $courseRoot; - $self->{courseName} = $courseName; - - my $action = $r->param('action') || $r->param('formAction') || 'Refresh'; - - for ($action) { - /^Refresh/i and do {$self->Refresh; last}; - /^Cancel/i and do {$self->Refresh; last}; - /^\^/i and do {$self->ParentDir; last}; - /^Directory/i and do {$self->Go; last}; - /^Go/i and do {$self->Go; last}; - /^View/i and do {$self->View; last}; - /^Edit/i and do {$self->Edit; last}; - /^Download/i and do {$self->Refresh; last}; - /^Copy/i and do {$self->Copy; last}; - /^Rename/i and do {$self->Rename; last}; - /^Delete/i and do {$self->Delete; last}; - /^New Folder/i and do {$self->NewFolder; last}; - /^New File/i and do {$self->NewFile; last}; - /^Upload/i and do {$self->Upload; last}; - /^Revert/i and do {$self->Edit; last}; - /^Save As/i and do {$self->SaveAs; last}; - /^Save/i and do {$self->Save; last}; - $self->addbadmessage("Unknown action."); - $self->Refresh; - } - - print CGI::hidden({name=>'pwd',value=>$self->{pwd}}); - print CGI::hidden({name=>'formAction'}); - print CGI::end_multipart_form(); - return ""; +################################################## +# +# First time through +# +sub Init { + my $self = shift; + $self->r->param('unpack',1); + $self->r->param('autodelete',1); + $self->r->param('format','Automatic'); + $self->Refresh; } +sub HiddenFlags { + my $self = shift; + print CGI::hidden({name=>"dates", value=>$self->getFlag('dates')}); + print CGI::hidden({name=>"overwrite", value=>$self->getFlag('overwrite')}); + print CGI::hidden({name=>"unpack", value=>$self->getFlag('unpack')}); + print CGI::hidden({name=>"autodelete",value=>$self->getFlag('autodelete')}); + print CGI::hidden({name=>"format", value=>$self->getFlag('format','Automatic')}); +} ################################################## # -# Display the directory listing and associated buttons +# Display the directory listing and associated buttons # sub Refresh { - my $self = shift; - my $pwd = shift || $self->{pwd}; - my $isTop = $pwd eq '.' || $pwd eq ''; - - my ($dirs,$dirlabels) = directoryMenu($self->{courseName},$pwd); - my ($files,$filelabels) = directoryListing($self->{courseRoot},$pwd); - - unless ($files) { - $self->addbadmessage("The directory you specified doesn't exist"); - $files = []; $filelabels = {}; - } - - # - # Some JavaScript to make things easier for the user - # - print CGI::script(<{pwd}; + my $isTop = $pwd eq '.' || $pwd eq ''; + + my ($dirs,$dirlabels) = directoryMenu($self->{courseName},$pwd); + my ($files,$filelabels) = directoryListing($self->{courseRoot},$pwd,$self->getFlag('dates')); + + unless ($files) { + $self->addbadmessage("The directory you specified doesn't exist"); + $files = []; $filelabels = {}; + } + + # + # Some JavaScript to make things easier for the user + # + print CGI::script(<0,cellpadding=>0,cellspacing=>10, style=>"margin:1em 0 0 3em"}); - - # - # Directory menu - # - print CGI::Tr( - CGI::td({colspan=>3}, - CGI::input({type=>"submit", name=>"action", value => "^", ($isTop? (disabled=>1): ())}), - CGI::popup_menu(-name => "directory", - -values => $dirs, -labels => $dirlabels, - -style => "width:25em", - -onChange => "doForm('Go')"), - CGI::noscript(CGI::input({type=>"submit",name=>"action",value=>"Go"})) - ) - ); - - # - # Directory Listing - # - my %button = (type=>"submit",name=>"action",style=>"width:10em"); - print CGI::Tr({valign=>"middle"}, - CGI::td(CGI::scrolling_list(-name => "files", id => "files", - -style => "font-family:monospace; width:30em; height:100%", - -size => 15, -multiple => 1, - -values => $files, -labels => $filelabels, - -onDblClick => "doForm('View')", - -onChange => "checkFiles()")), - CGI::td({width=>3}), - CGI::td( - CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3}), - CGI::Tr([ - CGI::td(CGI::input({%button,value=>"View",id=>"View"})), - CGI::td(CGI::input({%button,value=>"Edit",id=>"Edit"})), - CGI::td(CGI::input({%button,value=>"Download",id=>"Download"})), - CGI::td(CGI::input({%button,value=>"Rename",id=>"Rename"})), - CGI::td(CGI::input({%button,value=>"Copy",id=>"Copy"})), - CGI::td(CGI::input({%button,value=>"Delete",id=>"Delete"})), - CGI::td({height=>10}), - CGI::td(CGI::input({%button,value=>"New File"})), - CGI::td(CGI::input({%button,value=>"New Folder"})), - CGI::td(CGI::input({%button,value=>"Refresh"})), - ]), - CGI::end_table(), - ), + # + # Start the table + # + print CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3, style=>"margin:1em 0 0 3em"}); + + # + # Directory menu and date/size checkbox + # + print CGI::Tr({}, + CGI::td({colspan=>2}, + CGI::input({type=>"submit", name=>"action", value => "^", ($isTop? (disabled=>1): ())}), + CGI::popup_menu( + -name => "directory", + -values => $dirs, + -labels => $dirlabels, + -style => "width:25em", + -onChange => "doForm('Go')" + ), + CGI::noscript(CGI::input({type=>"submit",name=>"action",value=>"Go"})) + ), + CGI::td(CGI::small(CGI::checkbox( + -name => 'dates', + -checked => $self->getFlag('dates'), + -value => 1, + -label => 'Show Date & Size', + -onClick => 'doForm("Refresh")', + ))), + ); + + # + # Directory Listing and column of buttons + # + my %button = (type=>"submit",name=>"action",style=>"width:10em"); + my $width = ($self->getFlag('dates') && scalar(@{$files}) > 0) ? "": " width:30em"; + print CGI::Tr({valign=>"middle"}, + fixSpaces(CGI::td(CGI::scrolling_list( + -name => "files", id => "files", + -style => "font-family:monospace; $width", + -size => 17, + -multiple => 1, + -values => $files, + -labels => $filelabels, + -onDblClick => "doForm('View')", + -onChange => "checkFiles()" + ))), + CGI::td({width=>15}), + CGI::td({}, + CGI::start_table({border=>0,cellpadding=>0,cellspacing=>3}), + CGI::Tr([ + CGI::td(CGI::input({%button,value=>"View",id=>"View"})), + CGI::td(CGI::input({%button,value=>"Edit",id=>"Edit"})), + CGI::td(CGI::input({%button,value=>"Download",id=>"Download"})), + CGI::td(CGI::input({%button,value=>"Rename",id=>"Rename"})), + CGI::td(CGI::input({%button,value=>"Copy",id=>"Copy"})), + CGI::td(CGI::input({%button,value=>"Delete",id=>"Delete"})), + CGI::td(CGI::input({%button,value=>"Make Archive",id=>"MakeArchive"})), + CGI::td({height=>10}), + CGI::td(CGI::input({%button,value=>"New File"})), + CGI::td(CGI::input({%button,value=>"New Folder"})), + CGI::td(CGI::input({%button,value=>"Refresh"})), + ]), + CGI::end_table(), + ), ); - # - # Upload button - # - print CGI::Tr([ - CGI::td(), - CGI::td({colspan=>3}, - CGI::input({type=>"submit",name=>"action",style=>"width:7em",value=>"Upload:",id=>"Upload"}), - CGI::input({type=>"file",name=>"file",id=>"file",size=>40,onChange=>"checkFile()"}), - ), + # + # Upload button and checkboxes + # + print CGI::Tr([ + CGI::td(), + CGI::td({colspan=>3}, + CGI::input({type=>"submit",name=>"action",style=>"width:7em",value=>"Upload:",id=>"Upload"}), + CGI::input({type=>"file",name=>"file",id=>"file",size=>40,onChange=>"checkFile()"}), + CGI::br(), + CGI::small(join('   ',"Format:", + CGI::radio_group(-name=>'format', -value=>['Text','Binary','Automatic'], + -default=>$self->getFlag('format','Automatic')))), + ), + ]); + print CGI::Tr([ + CGI::td(), + CGI::td({colspan=>3}, + CGI::small(CGI::checkbox(-name=>'overwrite',-checked=>$self->getFlag('overwrite'),-value=>1, + -label=>'Overwrite existing files silently')), + CGI::br(), + CGI::small(CGI::checkbox(-name=>'unpack',-checked=>$self->getFlag('unpack'),-value=>1, + -label=>'Unpack archives automatically')), + CGI::small(CGI::checkbox(-name=>'autodelete',-checked=>$self->getFlag('autodelete'),-value=>1, + -label=>'then delete them')), + ), ]); - # - # End the table - # - print CGI::end_table(); - print CGI::script("checkFiles(); checkFile();"); + # + # End the table + # + print CGI::end_table(); + print CGI::script("checkFiles(); checkFile();"); } ################################################## # -# Move to the parent directory +# Move to the parent directory # sub ParentDir { - my $self = shift; - $self->{pwd} = '.' unless ($self->{pwd} =~ s!/[^/]*$!!); - $self->Refresh; + my $self = shift; + $self->{pwd} = '.' unless ($self->{pwd} =~ s!/[^/]*$!!); + $self->Refresh; } ################################################## # -# Move to the parent directory +# Move to the parent directory # sub Go { - my $self = shift; - $self->{pwd} = $self->r->param('directory'); - $self->Refresh; + my $self = shift; + $self->{pwd} = $self->r->param('directory'); + $self->Refresh; } ################################################## # -# Open a directory or view a file +# Open a directory or view a file # sub View { - my $self = shift; my $pwd = $self->{pwd}; - my $filename = $self->getFile("view"); return unless $filename; - my $name = "$pwd/$filename"; $name =~ s!^\./?!!; - - # - # Handle directories by making them the working directory - # - my $file = "$self->{courseRoot}/$pwd/$filename"; - if (-d $file) { - $self->{pwd} .= '/'.$filename; - $self->Refresh; return; - } - - unless (-f $file) { - $self->addbadmessage("You can't view files of that type"); - $self->Refresh; return; - } - - # - # Include a download link - # - my $urlpath = $self->r->urlpath; - my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $self->{courseName}); - my $fileManagerURL = $self->systemLink($fileManagerPage, params => {download => $filename, pwd => $pwd}); - print CGI::div({style=>"float:right"}, + my $self = shift; my $pwd = $self->{pwd}; + my $filename = $self->getFile("view"); return unless $filename; + my $name = "$pwd/$filename"; $name =~ s!^\./?!!; + my $file = "$self->{courseRoot}/$pwd/$filename"; + + # + # Don't follow symbolic links + # + if ($self->isSymLink($file)) { + $self->addbadmessage("That symbolic link takes you outside your course directory"); + $self->Refresh; return; + } + + # + # Handle directories by making them the working directory + # + if (-d $file) { + $self->{pwd} .= '/'.$filename; + $self->Refresh; return; + } + + unless (-f $file) { + $self->addbadmessage("You can't view files of that type"); + $self->Refresh; return; + } + + # + # Include a download link + # + my $urlpath = $self->r->urlpath; + my $fileManagerPage = $urlpath->newFromModule($urlpath->module, courseID => $self->{courseName}); + my $fileManagerURL = $self->systemLink($fileManagerPage, params => {download => $filename, pwd => $pwd}); + print CGI::div({style=>"float:right"}, CGI::a({href=>$fileManagerURL},"Download")); - print CGI::p(),CGI::b($name),CGI::p(); - print CGI::hr(); + print CGI::p(),CGI::b($name),CGI::p(); + print CGI::hr(); - # - # For files, display the file, if possible. - # If the file is an image, display it as an image. - # - my $data = readFile($file); - if (isText($data)) { - print CGI::pre(showHTML($data)); - } elsif ($file =~ m/\.(gif|jpg|png)/i) { - print CGI::img({src=>$fileManagerURL, border=>0}); - } else { - print CGI::div({class=>"ResultsWithError"}, - "The file does not appear to be a text file."); - } + # + # For files, display the file, if possible. + # If the file is an image, display it as an image. + # + my $data = readFile($file); + if (isText($data)) { + print CGI::pre(showHTML($data)); + } elsif ($file =~ m/\.(gif|jpg|png)/i) { + print CGI::img({src=>$fileManagerURL, border=>0}); + } else { + print CGI::div({class=>"ResultsWithError"}, + "The file does not appear to be a text file."); + } } ################################################## # -# Edit a file +# Edit a file # sub Edit { - my $self = shift; - my $filename = $self->getFile('edit'); return unless $filename; - my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; - - if (-d $file) { - $self->addbadmessage("You can't edit a directory"); - $self->Refresh; return; - } - unless (-f $file) { - $self->addbadmessage("You can only edit text files"); - $self->Refresh; return; - } - my $data = readFile($file); - if (!isText($data)) { - $self->addbadmessage("The file does not appear to be a text file"); - $self->Refresh; return; - } + my $self = shift; + my $filename = $self->getFile('edit'); return unless $filename; + my $file = "$self->{courseRoot}/$self->{pwd}/$filename"; + + if (-d $file) { + $self->addbadmessage("You can't edit a directory"); + $self->Refresh; return; + } + unless (-f $file) { + $self->addbadmessage("You can only edit text files"); + $self->Refresh; return; + } + my $data = readFile($file); + if (!isText($data)) { + $self->addbadmessage("The file does not appear to be a text file"); + $self->Refresh; return; + } - $self->RefreshEdit($data,$filename); + $self->RefreshEdit($data,$filename); } ################################################## # -# Save the edited file +# Save the edited file # sub Save { - my $self = shift; my $filename = shift; - my $pwd = $self->{pwd}; - if ($filename) { - $pwd = substr($filename,length($self->{courseRoot})+1); - $pwd =~ s!/([^/]*)$!!; $filename = $1; - } else { - $filename = $self->getFile("save"); return unless $filename; - } - my $file = "$self->{courseRoot}/$pwd/$filename"; - my $data = $self->r->param("data"); - - if (defined($data)) { - if (open(OUTFILE,">$file")) { - eval {print OUTFILE $data; close(OUTFILE)}; - if ($@) {$self->addbadmessage("Failed to save: $@")} - else {$self->addgoodmessage("File saved")} - } else {$self->addbadmessage("Can't write to file: $!")} - } else {$data = ""; $self->addbadmessage("Error: no file data was submitted!")} + my $self = shift; my $filename = shift; + my $pwd = $self->{pwd}; + if ($filename) { + $pwd = substr($filename,length($self->{courseRoot})+1); + $pwd =~ s!(/|^)([^/]*)$!!; $filename = $2; + $pwd = '.' if $pwd eq ''; + } else { + $filename = $self->getFile("save"); return unless $filename; + } + my $file = "$self->{courseRoot}/$pwd/$filename"; + my $data = $self->r->param("data"); + + if (defined($data)) { + if (open(OUTFILE,">$file")) { + eval {print OUTFILE $data; close(OUTFILE)}; + if ($@) {$self->addbadmessage("Failed to save: $@")} + else {$self->addgoodmessage("File saved")} + } else {$self->addbadmessage("Can't write to file: $!")} + } else {$data = ""; $self->addbadmessage("Error: no file data was submitted!")} - $self->{pwd} = $pwd; - $self->RefreshEdit($data,$filename); + $self->{pwd} = $pwd; + $self->RefreshEdit($data,$filename); } ################################################## # -# Save the edited file under a new name +# Save the edited file under a new name # sub SaveAs { - my $self = shift; + my $self = shift; - my $newfile = $self->r->param('name'); - my $original = $self->r->param('files'); - $newfile = $self->verifyPath($newfile,$original); - if ($newfile) {$self->Save($newfile); return} - $self->RefreshEdit($self->r->param('data'),$original); + my $newfile = $self->r->param('name'); + my $original = $self->r->param('files'); + $newfile = $self->verifyPath($newfile,$original); + if ($newfile) {$self->Save($newfile); return} + $self->RefreshEdit($self->r->param('data'),$original); } ################################################## # -# Display the Edit page +# Display the Edit page # sub RefreshEdit { - my $self = shift; my $data = shift; my $file = shift; - my $pwd = shift || $self->{pwd}; - my $name = "$pwd/$file"; $name =~ s!^\./?!!; - - my %button = (type=>"submit",name=>"action",style=>"width:6em"); - print CGI::p(); - print CGI::start_table({border=>0,cellspacing=>0,cellpadding=>2, width=>"95%", align=>"center"}); - print CGI::Tr([ - CGI::td({align=>"center",style=>"background-color:#CCCCCC"},CGI::b($name)), - CGI::td(CGI::textarea(-name=>"data",-default=>$data,-override=>1,-rows=>30,-columns=>80, + my $self = shift; my $data = shift; my $file = shift; + my $pwd = shift || $self->{pwd}; + my $name = "$pwd/$file"; $name =~ s!^\./?!!; + + my %button = (type=>"submit",name=>"action",style=>"width:6em"); + print CGI::p(); + print CGI::start_table({border=>0,cellspacing=>0,cellpadding=>2, width=>"95%", align=>"center"}); + print CGI::Tr([ + CGI::td({align=>"center",style=>"background-color:#CCCCCC"},CGI::b($name)), + CGI::td(CGI::textarea(-name=>"data",-default=>$data,-override=>1,-rows=>30,-columns=>80, -style=>"width:100%")), ## can't seem to get variable height to work - CGI::td({align=>"center", nowrap=>1}, - CGI::input({%button,value=>"Cancel"})," ", - CGI::input({%button,value=>"Revert"})," ", - CGI::input({%button,value=>"Save As:"}), - CGI::input({type=>"text",name=>"name",size=>20,style=>"width:50%"})," ", - CGI::input({%button,value=>"Save"}), - ), + CGI::td({align=>"center", nowrap=>1}, + CGI::input({%button,value=>"Cancel"})," ", + CGI::input({%button,value=>"Revert"})," ", + CGI::input({%button,value=>"Save As:"}), + CGI::input({type=>"text",name=>"name",size=>20,style=>"width:50%"})," ", + CGI::input({%button,value=>"Save"}), + ), ]); - print CGI::end_table(); - print CGI::hidden({name=>"files",value=>$file}); + print CGI::end_table(); + print CGI::hidden({name=>"files", value=>$file}); + $self->HiddenFlags; } ################################################## # -# Copy a file +# Copy a file # sub Copy { - my $self = shift; - my $oldfile = $self->getFile('copy'); return unless $oldfile; - my $original = $oldfile; - $oldfile = "$self->{courseRoot}/$self->{pwd}/$oldfile"; - - if (-d $oldfile) { - ## FIXME: need to do recursive directory copy - $self->addbadmessage("Directory copies are not yet implemented"); - $self->Refresh; - return; - } - - if ($self->r->param('confirmed')) { - my $newfile = $self->r->param('name'); - if ($newfile = $self->verifyPath($newfile,$original)) { - if (copy($oldfile, $newfile)) { - $self->addgoodmessage("File successfully copied"); - $self->Refresh; return; - } else {$self->addbadmessage("Can't copy file: $!")} - } - } + my $self = shift; + my $dir = "$self->{courseRoot}/$self->{pwd}"; + my $original = $self->getFile('copy'); return unless $original; + my $oldfile = "$dir/$original"; + + if (-d $oldfile) { + # FIXME: need to do recursive directory copy + $self->addbadmessage("Directory copies are not yet implemented"); + $self->Refresh; + return; + } + + if ($self->r->param('confirmed')) { + my $newfile = $self->r->param('name'); + if ($newfile = $self->verifyPath($newfile,$original)) { + if (copy($oldfile, $newfile)) { + $self->addgoodmessage("File successfully copied"); + $self->Refresh; return; + } else {$self->addbadmessage("Can't copy file: $!")} + } + } - Confirm("Copy file as:","Copy"); - print CGI::hidden({name=>"files",value=>$original}); + $self->Confirm("Copy file as:",$original,"Copy"); + print CGI::hidden({name=>"files",value=>$original}); } ################################################## # -# Rename a file +# Rename a file # sub Rename { - my $self = shift; - my $oldfile = $self->getFile('rename'); return unless $oldfile; - my $original = $oldfile; - $oldfile = "$self->{courseRoot}/$self->{pwd}/$oldfile"; - - if ($self->r->param('confirmed')) { - my $newfile = $self->r->param('name'); - if ($newfile = $self->verifyPath($newfile,$original)) { - if (rename $oldfile, $newfile) { - $self->addgoodmessage("File successfully renamed"); - $self->Refresh; return; - } else {$self->addbadmessage("Can't rename file: $!")} - } - } + my $self = shift; + my $dir = "$self->{courseRoot}/$self->{pwd}"; + my $original = $self->getFile('rename'); return unless $original; + my $oldfile = "$dir/$original"; + + if ($self->r->param('confirmed')) { + my $newfile = $self->r->param('name'); + if ($newfile = $self->verifyPath($newfile,$original)) { + if (rename $oldfile, $newfile) { + $self->addgoodmessage("File successfully renamed"); + $self->Refresh; return; + } else {$self->addbadmessage("Can't rename file: $!")} + } + } - Confirm("Rename file as:","Rename"); - print CGI::hidden({name=>"files",value=>$original}); + $self->Confirm("Rename file as:",uniqueName($dir,$original),"Rename"); + print CGI::hidden({name=>"files",value=>$original}); } ################################################## # -# Delete a file +# Delete a file # sub Delete { - my $self = shift; - my @files = $self->r->param('files'); - if (scalar(@files) == 0) { - $self->addbadmessage("You must select at least one file to delete"); - $self->Refresh; return; - } - - my $pwd = $self->{pwd}; - my $dir = $self->{courseRoot}.'/'.$pwd; - if ($self->r->param('confirmed')) { - - # - # If confirmed, go ahead and delete the files - # - foreach my $file (@files) { - if (defined checkPWD("$pwd/$file",1)) { - if (-d "$dir/$file") { - my $removed = eval {rmtree("$dir/$file",0,1)}; - if ($removed) {$self->addgoodmessage("Directory '$file' removed (items deleted: $removed)")} - else {$self->addbadmessage("Directory '$file' not removed: $!")} + my $self = shift; + my @files = $self->r->param('files'); + if (scalar(@files) == 0) { + $self->addbadmessage("You must select at least one file to delete"); + $self->Refresh; return; + } + + my $pwd = $self->{pwd}; + my $dir = $self->{courseRoot}.'/'.$pwd; + if ($self->r->param('confirmed')) { + + # + # If confirmed, go ahead and delete the files + # + foreach my $file (@files) { + if (defined $self->checkPWD("$pwd/$file",1)) { + if (-d "$dir/$file") { + my $removed = eval {rmtree("$dir/$file",0,1)}; + if ($removed) {$self->addgoodmessage("Directory '$file' removed (items deleted: $removed)")} + else {$self->addbadmessage("Directory '$file' not removed: $!")} + } else { + if (unlink("$dir/$file")) {$self->addgoodmessage("File '$file' successfully removed")} + else {$self->addbadmessage("File '$file' not removed: $!")} + } + } else {$self->addbadmessage("Illegal file '$file' specified"); last} + } + $self->Refresh; + } else { - if (unlink("$dir/$file")) {$self->addgoodmessage("File '$file' successfully removed")} - else {$self->addbadmessage("File '$file' not removed: $!")} + + # + # Put up the confirmation dialog box + # + print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 5em"}); + print CGI::Tr( + CGI::td( + CGI::b("Warning:")," You have requested that the following items be deleted\n", + CGI::ul(CGI::li(\@files)), + ((grep { -d "$dir/$_" } @files)? + CGI::p({style=>"width:500"},"Some of these files are directories. ", + "Only delete directories if you really know what you are doing. ", + "You can seriously damage your course if you delete the wrong thing."): ""), + CGI::p({style=>"color:red"},"There is no undo for deleting files or directories!"), + CGI::p("Really delete the items listed above?"), + CGI::div({style=>"float:left; padding-left:3ex"}, + CGI::input({type=>"submit",name=>"action",value=>"Cancel"})), + CGI::div({style=>"float:right; padding-right:3ex"}, + CGI::input({type=>"submit",name=>"action",value=>"Delete"})), + ), + ); + print CGI::end_table(); + + print CGI::hidden({name=>"confirmed",value=>1}); + foreach my $file (@files) {print CGI::hidden({name=>"files",value=>$file})} + $self->HiddenFlags; + } +} + +################################################## +# +# Make a gzipped tar archive +# +sub MakeArchive { + my $self = shift; + my @files = $self->r->param('files'); + if (scalar(@files) == 0) { + $self->addbadmessage("You must select at least one file for the archive"); + $self->Refresh; return; + } + + my $dir = $self->{courseRoot}.'/'.$self->{pwd}; + my $archive = uniqueName($dir,(scalar(@files) == 1)? + $files[0].".tgz": $self->{courseName}.".tgz"); + my $tar = "cd ".shell_quote($dir)." && $self->{ce}{externalPrograms}{tar} -cvzf ".shell_quote($archive,@files); + @files = readpipe $tar." 2>&1"; + if ($? == 0) { + my $n = scalar(@files); my $s = ($n == 1? "": "s"); + $self->addgoodmessage("Archive '$archive' created successfully ($n file$s)"); + } else { + $self->addbadmessage("Can't create archive '$archive': command returned ".systemError($?)); } - } else {$self->addbadmessage("Illegal file '$file' specified"); last} - } - $self->Refresh; - - } else { - - # - # Put up the confirmation dialog box - # - print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 5em"}); - print CGI::Tr( - CGI::td( - CGI::b("Warning:")," You have requested that the following items be deleted\n", - CGI::ul(CGI::li(\@files)), - ((grep { -d "$dir/$_" } @files)? - CGI::p({style=>"width:500"},"Some of these files are directories. ", - "Only delete directories if you really know what you are doing. ", - "You can seriously damage your course if you delete the wrong thing."): ""), - CGI::p({style=>"color:red"},"There is no undo for deleting files or directories!"), - CGI::p("Really delete the items listed above?"), - CGI::div({style=>"float:left; padding-left:3ex"}, - CGI::input({type=>"submit",name=>"action",value=>"Cancel"})), - CGI::div({style=>"float:right; padding-right:3ex"}, - CGI::input({type=>"submit",name=>"action",value=>"Delete"})), - ), - ); - print CGI::end_table(); - - print CGI::hidden({name=>"confirmed",value=>1}); - foreach my $file (@files) {print CGI::hidden({name=>"files",value=>$file})} - } + $self->Refresh; } ################################################## # -# Make a new file and edit it +# Unpack a gzipped tar archive +# +sub UnpackArchive { + my $self = shift; + my $archive = $self->getFile("unpack"); return unless $archive; + if ($archive !~ m/\.tgz$/) { + $self->addbadmessage("You can only unpack files ending in '.tgz'"); + } else { + $self->unpack($archive); + } + $self->Refresh; +} + +sub unpack { + my $self = shift; + my $archive = shift; + my $dir = $self->{courseRoot}.'/'.$self->{pwd}; + my $tar = "cd ".shell_quote($dir)." && $self->{ce}{externalPrograms}{tar} -vxzf ".shell_quote($archive); + my @files = readpipe $tar." 2>&1"; + if ($? == 0) { + my $n = scalar(@files); my $s = ($n == 1? "": "s"); + $self->addgoodmessage("$n file$s unpacked successfully"); + return 1; + } else { + $self->addbadmessage("Can't unpack '$archive': command returned ".systemError($?)); + return 0; + } +} + +################################################## +# +# Make a new file and edit it # sub NewFile { - my $self = shift; + my $self = shift; - if ($self->r->param('confirmed')) { - my $name = $self->r->param('name'); - if (my $file = $self->verifyName($name,"file")) { - if (open(NEWFILE,">$file")) { - close(NEWFILE); - $self->RefreshEdit("",$name); - return; - } else {$self->addbadmessage("Can't create file: $!")} - } - } + if ($self->r->param('confirmed')) { + my $name = $self->r->param('name'); + if (my $file = $self->verifyName($name,"file")) { + if (open(NEWFILE,">$file")) { + close(NEWFILE); + $self->RefreshEdit("",$name); + return; + } else {$self->addbadmessage("Can't create file: $!")} + } + } - Confirm("New file name:","New File"); + $self->Confirm("New file name:","","New File"); } ################################################## # -# Make a new directory +# Make a new directory # sub NewFolder { - my $self = shift; + my $self = shift; - if ($self->r->param('confirmed')) { - my $name = $self->r->param('name'); - if (my $dir = $self->verifyName($name,"directory")) { - if (mkdir $dir, 0750) { - $self->{pwd} .= '/'.$name; - $self->Refresh; return; - } else {$self->addbadmessage("Can't create directory: $!")} - } - } + if ($self->r->param('confirmed')) { + my $name = $self->r->param('name'); + if (my $dir = $self->verifyName($name,"directory")) { + if (mkdir $dir, 0750) { + $self->{pwd} .= '/'.$name; + $self->Refresh; return; + } else {$self->addbadmessage("Can't create directory: $!")} + } + } - Confirm("New folder name:","New Folder"); + $self->Confirm("New folder name:","","New Folder"); } ################################################## # -# Download a file +# Download a file # sub Download { - my $self = shift; - my $filename = $self->getFile("download"); return unless $filename; - my $pwd = checkPWD($self->r->param('pwd') || '.'); - return unless $pwd; - my $file = $self->{ce}{courseDirs}{root}.'/'.$pwd.'/'.$filename; + my $self = shift; + my $pwd = $self->checkPWD($self->r->param('pwd') || HOME); + return unless $pwd; + my $filename = $self->getFile("download"); return unless $filename; + my $file = $self->{ce}{courseDirs}{root}.'/'.$pwd.'/'.$filename; - if (-d $file) {$self->addbadmessage("You can't download directories"); return} - unless (-f $file) {$self->addbadmessage("You can't download files of that type"); return} + if (-d $file) {$self->addbadmessage("You can't download directories"); return} + unless (-f $file) {$self->addbadmessage("You can't download files of that type"); return} - $self->r->param('download',$filename); + $self->r->param('download',$filename); } ################################################## # -# Upload a file to the server +# Upload a file to the server # sub Upload { - my $self = shift; - my $dir = "$self->{courseRoot}/$self->{pwd}"; - my $fileIDhash = $self->r->param('file'); - unless ($fileIDhash) { - $self->addbadmessage("You have not chosen a file to upload."); - $self->Refresh; - return; - } + my $self = shift; + my $dir = "$self->{courseRoot}/$self->{pwd}"; + my $fileIDhash = $self->r->param('file'); + unless ($fileIDhash) { + $self->addbadmessage("You have not chosen a file to upload."); + $self->Refresh; + return; + } - my ($id,$hash) = split(/\s+/,$fileIDhash); - my $upload = WeBWorK::Upload->retrieve($id,$hash,dir=>$self->{ce}{webworkDirs}{uploadCache}); + my ($id,$hash) = split(/\s+/,$fileIDhash); + my $upload = WeBWorK::Upload->retrieve($id,$hash,dir=>$self->{ce}{webworkDirs}{uploadCache}); + + my $name = checkName($upload->filename); + my $action = $self->r->param("formAction") || "Cancel"; + if ($self->r->param("confirmed")) { + if ($action eq "Cancel") { + $upload->dispose; + $self->Refresh; + return; + } + $name = checkName($self->r->param('name')) if ($action eq "Rename"); + } + + if (-e "$dir/$name") { + unless ($self->r->param('overwrite') || $action eq "Overwrite") { + $self->Confirm("File ".CGI::b($name)." already exists. Overwrite it, or rename it as:". + CGI::p(),uniqueName($dir,$name),"Rename","Overwrite"); + print CGI::hidden({name=>"action",value=>"Upload"}); + print CGI::hidden({name=>"file",value=>$fileIDhash}); + return; + } + } + $self->checkFileLocation($name,$self->{pwd}); + + my $file = "$dir/$name"; + my $type = $self->getFlag('format','Automatic'); + my $data; + + # + # Check if we need to convert linebreaks + # + if ($type ne 'Binary') { + my $fh = $upload->fileHandle; + my @lines = <$fh>; $data = join('',@lines); + if ($type eq 'Automatic') {$type = isText($data) ? 'Text' : 'Binary'} + } + if ($type eq 'Text') { + $upload->dispose; + $data =~ s/\r\n?/\n/g; + if (open(UPLOAD,">$file")) {print UPLOAD $data; close(UPLOAD)} + else {$self->addbadmessage("Can't create file '$name': $!")} + } else { + $upload->disposeTo($file); + } - my $name = uniqueName($dir,checkName($upload->filename)); - if (-e "$dir/$name") { - $self->addbadmessage("A file with that name already exists"); - $self->Refresh; - $upload->dispose; - return; - } + if (-e $file) { + $self->addgoodmessage("$type file '$name' uploaded successfully"); + if ($name =~ m/\.tgz$/ && $self->getFlag('unpack')) { + if ($self->unpack($name) && $self->getFlag('autodelete')) { + if (unlink($file)) {$self->addgoodmessage("Archive '$name' deleted")} + else {$self->addbadmessage("Can't delete archive '$name': $!")} + } + } + } - $upload->disposeTo("$dir/$name"); - $self->addgoodmessage("File '$name' uploaded successfully"); - $self->Refresh; + $self->Refresh; } ################################################## ################################################## # -# Print a confirmation dialog box +# Print a confirmation dialog box # sub Confirm { - my $message = shift; - my $button = shift; - - print CGI::p(); - print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 3em"}); - print CGI::Tr( - CGI::td( - $message, - CGI::input({type=>"text",name=>"name",size=>50}), - CGI::p(), - CGI::div({style=>"float:right; padding-right:3ex"}, - CGI::input({type=>"submit",name=>"action",value=>$button})), # this will be the default - CGI::div({style=>"float:left; padding-left:3ex"}, - CGI::input({type=>"submit",name=>"action",value=>"Cancel"})), - ), - ); - print CGI::end_table(); - print CGI::hidden({name=>"confirmed",value=>1}); - print CGI::script("window.document.FileManager.name.focus()"); + my $self = shift; + my $message = shift; my $value = shift; + my $button = shift; my $button2 = shift; + + print CGI::p(); + print CGI::start_table({border=>1,cellspacing=>2,cellpadding=>20, style=>"margin: 1em 0 0 3em"}); + print CGI::Tr( + CGI::td({align=>"CENTER"}, + $message, + CGI::input({type=>"text",name=>"name",size=>50,value=>$value}), + CGI::p(), CGI::center( + CGI::div({style=>"float:right; padding-right:3ex"}, + CGI::input({type=>"submit",name=>"formAction",value=>$button})), # this will be the default + CGI::div({style=>"float:left; padding-left:3ex"}, + CGI::input({type=>"submit",name=>"formAction",value=>"Cancel"})), + ($button2 ? CGI::input({type=>"submit",name=>"formAction",value=>$button2}): ()), + ), + ), + ); + print CGI::end_table(); + print CGI::hidden({name=>"confirmed", value=>1}); + $self->HiddenFlags; + print CGI::script("window.document.FileManager.name.focus()"); } ################################################## +################################################## # -# Check that there is exactly one vailid file +# Check that there is exactly one valid file # sub getFile { - my $self = shift; my $action = shift; - my @files = $self->r->param("files"); - if (scalar(@files) > 1) { - $self->addbadmessage("You can only $action one file at a time."); - $self->Refresh unless $action eq 'download'; - return; - } - if (scalar(@files) == 0 || $files[0] eq "") { - $self->addbadmessage("You need to select a file to $action."); - $self->Refresh unless $action eq 'download'; - return; - } - my $pwd = checkPWD($self->{pwd} || $self->r->param('pwd') || '.') || '.'; - $self->addbadmessage("You have specified an illegal file") - unless checkPWD($pwd.'/'.$files[0],1); - return $files[0]; + my $self = shift; my $action = shift; + my @files = $self->r->param("files"); + if (scalar(@files) > 1) { + $self->addbadmessage("You can only $action one file at a time."); + $self->Refresh unless $action eq 'download'; + return; + } + if (scalar(@files) == 0 || $files[0] eq "") { + $self->addbadmessage("You need to select a file to $action."); + $self->Refresh unless $action eq 'download'; + return; + } + my $pwd = $self->checkPWD($self->{pwd} || $self->r->param('pwd') || HOME) || '.'; + if ($self->isSymLink($pwd.'/'.$files[0])) { + $self->addbadmessage("That symbolic link takes you outside your course directory"); + $self->Refresh unless $action eq 'download'; + return; + } + unless ($self->checkPWD($pwd.'/'.$files[0],1)) { + $self->addbadmessage("You have specified an illegal file"); + $self->Refresh unless $action eq 'download'; + return; + } + return $files[0]; } ################################################## # -# Get the entries for the directory menu +# Get the entries for the directory menu # sub directoryMenu { - my $course = shift; - my $dir = shift; $dir =~ s!^\.(/|$)!!; - my @dirs = split('/',$dir); - my $menu = ""; my $pwd; - - my (@values,%labels); - while (scalar(@dirs)) { - $pwd = join('/',(@dirs)[0..$#dirs]); - $dir = pop(@dirs); - push(@values,$pwd); $labels{$pwd} = $dir; - } - push(@values,'.'); $labels{'.'} = $course; - return (\@values,\%labels); + my $course = shift; + my $dir = shift; $dir =~ s!^\.(/|$)!!; + my @dirs = split('/',$dir); + my $menu = ""; my $pwd; + + my (@values,%labels); + while (scalar(@dirs)) { + $pwd = join('/',(@dirs)[0..$#dirs]); + $dir = pop(@dirs); + push(@values,$pwd); $labels{$pwd} = $dir; + } + push(@values,'.'); $labels{'.'} = $course; + return (\@values,\%labels); } ################################################## # -# Get the directory listing +# Get the directory listing # sub directoryListing { - my $root = shift; my $pwd = shift; - my $dir = $root.'/'.$pwd; - my (@values,%labels,$size,$data); + my $root = shift; my $pwd = shift; my $showdates = shift; + my $dir = $root.'/'.$pwd; + my (@values,%labels,$size,$data); + + return unless -d $dir; + my $len = 24; + my @names = sortByName(undef,grep(/^[^.]/,readDirectory($dir))); + foreach my $name (@names) { + unless ($name eq 'DATA') { #FIXME don't view the DATA directory + my $file = "$dir/$name"; + push(@values,$name); $labels{$name} = $name; + $labels{$name} .= '@' if (-l $file); + $labels{$name} .= '/' if (-d $file && !-l $file); + $len = length($labels{$name}) if length($labels{$name}) > $len; + } + } + if ($showdates) { + $len += 3; + foreach my $name (@values) { + my $file = "$dir/$name"; + my ($size,$date) = (lstat($file))[7,9]; + $labels{$name} = sprintf("%-${len}s%-16s%10s",$labels{$name}, + ((-d $file)? ("",""): + (getDate($date),getSize($size)))); + } + } + return (\@values,\%labels); +} - return unless -d $dir; - my @names = sortByName(undef,grep(/^[^.]/,readDirectory($dir))); - foreach my $name(@names) { - push(@values,$name); $labels{$name} = $name; - $labels{$name} .= '/' if (-d $dir.'/'.$name); - } - return (\@values,\%labels); +sub getDate { + my ($sec,$min,$hour,$day,$month,$year) = localtime(shift); + sprintf("%02d-%02d-%04d %02d:%02d",$month+1,$day,$year+1900,$hour,$min); +} + +sub getSize { + my $size = shift; + return $size." B " if $size < 1024; + return sprintf("%.1f KB",$size/1024) if $size < 1024*100; + return sprintf("%d KB",int($size/1024)) if $size < 1024*1024; + return sprintf("%.1f MB",$size/1024/1024) if $size < 1024*1024*100; + return sprintf("%d MB",$size/1024/1024); } ################################################## # -# Normalize the working directory and check if it is OK. +# Check if a file is a symbolic link that we +# are not allowed to follow. +# +sub isSymLink { + my $self = shift; my $file = shift; + return 0 unless -l $file; + + my $courseRoot = $self->{ce}{courseDirs}{root}; + $courseRoot = readlink($courseRoot) if -l $courseRoot; + my $pwd = $self->{pwd} || $self->r->param('pwd') || HOME; + my $link = File::Spec->rel2abs(readlink($file),"$courseRoot/$pwd"); + # + # Remove /./ and dir/../ constructs + # + $link =~ s!(^|/)(\.(/|$))+!$1!g; + while ($link =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; + + # + # Link is OK if it is in the course directory + # + return 0 if substr($link,0,length($courseRoot)) eq $courseRoot; + + # + # Look through the list of valid paths to see if this link is OK + # + my $valid = $self->{ce}{webworkDirs}{valid_symlinks}; + if (defined $valid && $valid) { + foreach my $path (@{$valid}) { + return 0 if substr($link,0,length($path)) eq $path; + } + } + + return 1; +} + +################################################## +# +# Normalize the working directory and check if it is OK. # sub checkPWD { - my $pwd = shift; - my $renameError = shift; + my $self = shift; + my $pwd = shift; + my $renameError = shift; + + $pwd =~ s!//+!/!g; # remove duplicate slashes + $pwd =~ s!(^|/)~!$1_!g; # remove ~user references + $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories + + # remove dir/.. constructions + while ($pwd =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; + + $pwd =~ s!/$!!; # remove trailing / + return if ($pwd =~ m!(^|/)\.\.(/|$)!); # Error if outside the root + + # check for bad symbolic links + my @dirs = split('/',$pwd); + pop(@dirs) if $renameError; # don't check file iteself in this case + my @path = ($self->{ce}{courseDirs}{root}); + foreach my $dir (@dirs) { + push @path,$dir; + return if ($self->isSymLink(join('/',@path))); + } - $pwd =~ s!//+!/!g; # remove duplicate slashes - $pwd =~ s!(^|/)~!$1_!g; # remove ~user references - $pwd =~ s!(^|/)(\.(/|$))+!$1!g; # remove dot directories - # remove dir/.. constructions - while ($pwd =~ s!((\.[^./]+|\.\.[^/]+|[^./][^/]*)/\.\.(/|$))!!) {}; - $pwd =~ s!/$!!; # remove trailing / - return if ($pwd =~ m!(^|/)\.\.(/|$)!); # Error if outside the root + my $original = $pwd; + $pwd =~ s!(^|/)\.!$1_!g; # don't enter hidden directories + $pwd =~ s!^/!!; # remove leading / + $pwd =~ s![^-_./A-Z0-9~ ]!_!gi; # no illegal characters + return if $renameError && $original ne $pwd; - my $original = $pwd; - $pwd =~ s!(^|/)\.!$1_!g; # don't enter hidden directories - $pwd =~ s!^/!!; # remove leading / - $pwd =~ s![^-_./a-zA-Z0-9 ]!_!g; # no illegal characters - return if $renameError && $original ne $pwd; + $pwd = '.' if $pwd eq ''; + return $pwd; +} - $pwd = '.' if $pwd eq ''; - return $pwd; +################################################## +# +# Check that a file is uploaded to the correct directory +# +sub checkFileLocation { + my $self = shift; + my $extension = shift; $extension =~ s/.*\.//; + my $dir = shift; my $location = $uploadDir{$extension}; + return unless defined($location); + return if $dir =~ m/^$location$/; + $location =~ s!/\.\*!!; + return if $dir =~ m/^$location$/; + $self->addbadmessage("Files with extension '.$extension' usually belong in '$location'"); } ################################################## # -# Check a name for bad characters, etc. +# Check a name for bad characters, etc. # sub checkName { - my $file = shift; - $file =~ s!.*[/\\]!!; # remove directory - $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters - $file = "newfile.txt" unless $file; # no blank names - $file =~ s/^\./_/; # no initial dot - return $file; + my $file = shift; + $file =~ s!.*[/\\]!!; # remove directory + $file =~ s/[^-_.a-zA-Z0-9 ]/_/g; # no illegal characters + $file =~ s/^\./_/; # no initial dot + $file = "newfile.txt" unless $file; # no blank names + return $file; } ################################################## # -# Get a unique name (in case it already exists) +# Get a unique name (in case it already exists) # sub uniqueName { - my $dir = shift; my $name = shift; - my $type = ""; my $n = -1; - $type = $1 if ($name =~ s/(\.[^.]*)$//); - $n = $1 if ($name =~ s/(\d+)$//); - while (-e "$dir/$name$n$type") {if ($n < 0) {$n--} else {$n++}} - return "$name$n$type"; + my $dir = shift; my $name = shift; + return $name unless (-e "$dir/$name"); + my $type = ""; my $n = 1; + $type = $1 if ($name =~ s/(\.[^.]*)$//); + $n = $1 if ($name =~ s/_(\d+)$/_/); + while (-e "$dir/${name}_$n$type") {$n++} + return "${name}_$n$type"; } ################################################## # -# Verify that a name can be added tot he current -# directory. +# Verify that a name can be added to the current +# directory. # sub verifyName { - my $self = shift; my $name = shift; my $object = shift; - if ($name) { - unless ($name =~ m!/!) { - unless ($name =~ m!^\.!) { - unless ($name =~ m![^-_.a-zA-Z0-9 ]!) { - my $file = "$self->{courseRoot}/$self->{pwd}/$name"; - return $file unless (-e $file); - $self->addbadmessage("A file with that name already exists"); - } else {$self->addbadmessage("Your $object name contains illegal characters")} - } else {$self->addbadmessage("Your $object name may not begin with a dot")} - } else {$self->addbadmessage("Your $object name may not contain a path component")} - } else {$self->addbadmessage("You must specify a $object name")} - return + my $self = shift; my $name = shift; my $object = shift; + if ($name) { + unless ($name =~ m!/!) { + unless ($name =~ m!^\.!) { + unless ($name =~ m![^-_.a-zA-Z0-9 ]!) { + my $file = "$self->{courseRoot}/$self->{pwd}/$name"; + return $file unless (-e $file); + $self->addbadmessage("A file with that name already exists"); + } else {$self->addbadmessage("Your $object name contains illegal characters")} + } else {$self->addbadmessage("Your $object name may not begin with a dot")} + } else {$self->addbadmessage("Your $object name may not contain a path component")} + } else {$self->addbadmessage("You must specify a $object name")} + return } ################################################## # -# Verify that a file path is valid +# Verify that a file path is valid # sub verifyPath { - my $self = shift; my $path = shift; my $name = shift; + my $self = shift; my $path = shift; my $name = shift; - if ($path) { - unless ($path =~ m![^-_.a-zA-Z0-9 /]!) { - unless ($path =~ m!^/!) { - $path = checkPWD($self->{pwd}.'/'.$path,1); if ($path) { - $path = $self->{courseRoot}.'/'.$path; - $path .= '/'.$name if -d $path && $name; - return $path unless (-e $path); - $self->addbadmessage("A file with that name already exists"); - } else {$self->addbadmessage("You have specified an illegal path")} - } else {$self->addbadmessage("You can not specify an absolute path")} - } else {$self->addbadmessage("Your file name contains illegal characters")} - } else {$self->addbadmessage("You must specify a file name")} - return + unless ($path =~ m![^-_.a-zA-Z0-9 /]!) { + unless ($path =~ m!^/!) { + $path = $self->checkPWD($self->{pwd}.'/'.$path,1); + if ($path) { + $path = $self->{courseRoot}.'/'.$path; + $path .= '/'.$name if -d $path && $name; + return $path unless (-e $path); + $self->addbadmessage("A file with that name already exists"); + } else {$self->addbadmessage("You have specified an illegal path")} + } else {$self->addbadmessage("You can not specify an absolute path")} + } else {$self->addbadmessage("Your file name contains illegal characters")} + } else {$self->addbadmessage("You must specify a file name")} + return +} + +################################################## +# +# Get the value of a parameter flag +# +sub getFlag { + my $self = shift; my $flag = shift; + my $default = shift; $default = 0 unless defined $default; + my $value = $self->r->param($flag); + $value = $default unless defined $value; + return $value; } ################################################## # -# Make HTML symbols printable +# Make HTML symbols printable # sub showHTML { - my $string = shift; - return '' unless defined $string; - $string =~ s/&/\&/g; - $string =~ s//\>/g; - $string; + my $string = shift; + return '' unless defined $string; + $string =~ s/&/\&/g; + $string =~ s//\>/g; + $string; } ################################################## # -# Check if a string is plain text -# (i.e., doesn't contain three non-regular -# characters in a row.) +# Check if a string is plain text +# (i.e., doesn't contain three non-regular +# characters in a row.) # sub isText { - my $string = shift; - return $string !~ m/[^\s\x20-\x7E]{3,}/; + my $string = shift; + return $string !~ m/[^\s\x20-\x7E]{3,}/; +} + +################################################## +# +# Convert spaces to  , but only REAL spaces +# +sub sp2nbsp { + my $s = shift; + $s =~ s/ /\ /g; + return $s; +} + +################################################## +# +# Hack to convert multiple spaces in the file +# selection box into   so that the columns +# will allign properly in fixed-width fonts. +# We have to do it agter the fact, since CGI:: +# is being "helpful" by turning & in the labels +# into & for us. So we have to convert +# after the