Parent Directory
| 
Revision Log
added support for upload/download/delete of scoring files
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/FileXfer.pm,v 1.3 2004/03/23 01:15:58 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::FileXfer; 18 use base qw(WeBWorK::ContentGenerator::Instructor); 19 20 =head1 NAME 21 22 WeBWorK::ContentGenerator::Instructor::FileXfer - transfer course files from/to 23 client 24 25 =cut 26 27 use strict; 28 use warnings; 29 use Apache::Constants qw(:common REDIRECT DONE); 30 use CGI qw(); 31 32 sub pre_header_initialize { 33 my ($self) = @_; 34 my $r = $self->r; 35 my $ce = $r->ce; 36 my $authz = $r->authz; 37 38 my $userID = $r->param("user"); 39 40 my ($type, $action) = ("", ""); 41 if (defined $r->param("deleteDef")) { $type = "def"; $action = "delete"; } 42 if (defined $r->param("downloadDef")) { $type = "def"; $action = "download"; } 43 if (defined $r->param("uploadDef")) { $type = "def"; $action = "upload"; } 44 if (defined $r->param("deleteClasslist")) { $type = "classlist"; $action = "delete"; } 45 if (defined $r->param("downloadClasslist")) { $type = "classlist"; $action = "download"; } 46 if (defined $r->param("uploadClasslist")) { $type = "classlist"; $action = "upload"; } 47 if (defined $r->param("deleteScoringFile")) { $type = "scoringFile"; $action = "delete"; } 48 if (defined $r->param("downloadScoringFile")) { $type = "scoringFile"; $action = "download"; } 49 if (defined $r->param("uploadScoringFile")) { $type = "scoringFile"; $action = "upload"; } 50 51 # make sure we have permission to do what we want to do 52 if ($type eq "def") { 53 unless ($authz->hasPermissions($userID, "modify_set_def_files")) { 54 $self->{submitError} = "You are not authorized to modify the list of set definition files."; 55 return; 56 } 57 } elsif ($type eq "classlist") { 58 unless ($authz->hasPermissions($userID, "modify_classlist_files")) { 59 $self->{submitError} = "You are not authorized to modify the list of classlist files."; 60 return; 61 } 62 } elsif ($type eq "scoringFile") { 63 unless ($authz->hasPermissions($userID, "modify_scoring_files")) { 64 $self->{submitError} = "You are not authorized to modify the list of scoring files."; 65 return; 66 } 67 } 68 69 # call handler for the action we want to perform 70 if ($action eq "delete") { 71 $self->handleDelete($type); 72 } elsif ($action eq "download") { 73 $self->handleDownload($type); 74 } elsif ($action eq "upload") { 75 $self->handleUpload($type); 76 } 77 } 78 79 sub handleDelete { 80 my ($self, $type) = @_; 81 my $r = $self->r; 82 my $ce = $r->ce; 83 84 my (@fileList, $selectParam, $dir); 85 if ($type eq "classlist") { 86 @fileList = $self->getCSVList; 87 $selectParam = "classlist"; 88 $dir = $ce->{courseDirs}->{templates}; 89 } elsif ($type eq "def") { 90 @fileList = $self->getDefList; 91 $selectParam = "def"; 92 $dir = $ce->{courseDirs}->{templates}; 93 } elsif ($type eq "scoringFile") { 94 @fileList = $self->getScoringFileList; 95 $selectParam = "scoringFile"; 96 $dir = $ce->{courseDirs}->{scoring}; 97 } else { 98 die "handleDelete() doesn't know what to do with file type $type!"; 99 } 100 101 # get file name 102 my $fileToDelete = $r->param($selectParam); 103 unless ($fileToDelete) { 104 $self->{submitError} = "No file selected for deletion."; 105 return; 106 } 107 108 # FIXME: FOR THE LOVE OF GOD, ADD SECURITY CHECKS!!!!!! 109 # (actually I think it's not such a big deal, since we're checking the 110 # tainted input against a finite set of files that we know are okay to 111 # delete) 112 113 # make sure it's in the file list 114 unless (grep { $_ eq $fileToDelete } @fileList) { 115 $self->{submitError} = "File \"$fileToDelete\" not found in file list."; 116 return; 117 } 118 119 # (at this point we know the filename isn't dangerous) 120 121 # delete it 122 unlink "$dir/$fileToDelete"; 123 } 124 125 sub handleDownload { 126 my ($self, $type) = @_; 127 my $r = $self->r; 128 my $ce = $r->ce; 129 130 my (@fileList, $selectParam, $dir); 131 if ($type eq "classlist") { 132 @fileList = $self->getCSVList; 133 $selectParam = "classlist"; 134 $dir = $ce->{courseDirs}->{templates}; 135 } elsif ($type eq "def") { 136 @fileList = $self->getDefList; 137 $selectParam = "def"; 138 $dir = $ce->{courseDirs}->{templates}; 139 } elsif ($type eq "scoringFile") { 140 @fileList = $self->getScoringFileList; 141 $selectParam = "scoringFile"; 142 $dir = $ce->{courseDirs}->{scoring}; 143 } else { 144 die "handleDownload() doesn't know what to do with file type $type!"; 145 } 146 147 # get file name 148 my $fileToDownload = $r->param($selectParam); 149 unless ($fileToDownload) { 150 $self->{submitError} = "No file selected for download."; 151 return; 152 } 153 154 # make sure it's in the file list 155 unless (grep { $_ eq $fileToDownload } @fileList) { 156 $self->{submitError} = "File \"$fileToDownload\" not found in file list."; 157 return; 158 } 159 160 # set the file to sent: 161 $self->{sendFile} = { 162 source => "$dir/$fileToDownload", 163 type => "text/plain", 164 name => $fileToDownload, 165 }; 166 } 167 168 sub handleUpload { 169 my ($self, $type) = @_; 170 my $r = $self->r; 171 my $ce = $r->ce; 172 173 my (@fileList, $uploadParam, $uploadNameParam, $ext, $destDir); 174 if ($type eq "classlist") { 175 @fileList = $self->getCSVList; 176 $uploadParam = "newClasslist"; 177 $uploadNameParam = "newClasslistName"; 178 $ext = ".lst"; 179 $destDir = $ce->{courseDirs}->{templates}; 180 } elsif ($type eq "def") { 181 @fileList = $self->getDefList; 182 $uploadParam = "newDef"; 183 $uploadNameParam = "newDefName"; 184 $ext = ".def"; 185 $destDir = $ce->{courseDirs}->{templates}; 186 } elsif ($type eq "scoringFile") { 187 @fileList = $self->getScoringFileList; 188 $uploadParam = "newScoringFile"; 189 $uploadNameParam = "newScoringFileName"; 190 $ext = ".csv"; 191 $destDir = $ce->{courseDirs}->{scoring}; 192 } 193 194 # get upload ID and hash 195 my $uploadIDHash = $r->param($uploadParam); 196 unless ($uploadIDHash) { 197 $self->{submitError} = "No file selected for upload."; 198 return; 199 } 200 my ($id, $hash) = split /\s+/, $uploadIDHash; 201 202 #warn "upload param contains $uploadIDHash\n"; 203 #warn "upload ID is $id\n"; 204 #warn "upload hash is $hash\n"; 205 206 # retrieve upload from upload cache 207 my $upload = WeBWorK::Upload->retrieve($id, $hash, 208 dir => $ce->{webworkDirs}->{uploadCache} 209 ); 210 211 # determine what to call the resulting file 212 my $fileName = $r->param($uploadNameParam) || $upload->filename; 213 214 # tack on the file extension if it's not already there 215 $fileName .= $ext unless $fileName =~ m/$ext$/; 216 217 # does the file name have the path separator in it? 218 die "illegal character in upload name: \"/\". (no hacking!)" if $fileName =~ m|/|; 219 220 # does a file already exist with that name? 221 if (grep { $_ eq $fileName } @fileList) { 222 $self->{submitError} = "A file named \"$fileName\" exists. Either remove it, or chose a different name for your upload."; 223 return; 224 } 225 226 $upload->disposeTo("$destDir/$fileName"); 227 } 228 229 sub body { 230 my ($self) = @_; 231 my $r = $self->r; 232 my $authz = $r->authz; 233 234 my $userID = $r->param("user"); 235 236 return CGI::em("You are not authorized to access the Instructor tools.") 237 unless $authz->hasPermissions($userID, "access_instructor_tools"); 238 239 # if we needed to get either of these lists earlier, use the cached copy 240 # otherwise, get them from the filesystem 241 #my $classlistsRef = $self->{classlists} || [ $self->getCSVList ]; 242 #my $setDefsRef = $self->{setDefs} || [ $self->getDefList ]; 243 my $classlistsRef = [ $self->getCSVList ]; 244 my $setDefsRef = [ $self->getDefList ]; 245 my $scoringFileRef = [ $self->getScoringFileList ]; 246 247 print CGI::p(<<EOT); 248 Use the tools below to modify course files. Set definition files and classlist 249 files are only used for importing and exporting set and user data. 250 EOT 251 252 print CGI::table({-border=>1}, 253 CGI::Tr({-valign=>"top"}, 254 CGI::td({}, 255 CGI::p("Set Definition Files"), 256 CGI::startform("POST", $r->uri, "multipart/form-data"), 257 $self->hidden_authen_fields, 258 CGI::scrolling_list( 259 -name => "def", 260 -values => $setDefsRef, 261 -size => 8, 262 -multiple => 0, 263 ), CGI::br(), 264 CGI::submit("deleteDef", "Delete"), 265 CGI::font({-color=>"red"}, CGI::em("Delete is not undoable!")), 266 CGI::br(), 267 CGI::submit("downloadDef", "Download"), 268 CGI::br(), 269 CGI::p("Upload New Set Definition File:"), 270 CGI::filefield( 271 -name => "newDef", 272 -size => 30, 273 ), CGI::br(), 274 "Use name:", CGI::textfield("newDefName", "", 30), CGI::br(), 275 CGI::submit("uploadDef", "Upload Set Definition File"), 276 CGI::endform(), 277 ), 278 CGI::td({}, 279 CGI::p("Classlist Files"), 280 CGI::startform("POST", $r->uri, "multipart/form-data"), 281 $self->hidden_authen_fields, 282 CGI::scrolling_list( 283 -name => "classlist", 284 -values => $classlistsRef, 285 -size => 8, 286 -multiple => 0, 287 ), CGI::br(), 288 CGI::submit("deleteClasslist", "Delete"), 289 CGI::font({-color=>"red"}, CGI::em("Delete is not undoable!")), 290 CGI::br(), 291 CGI::submit("downloadClasslist", "Download"), CGI::br(), 292 CGI::p("Upload New Classlist File:"), 293 CGI::filefield( 294 -name => "newClasslist", 295 -size => 30, 296 ), CGI::br(), 297 "Use name:", CGI::textfield("newClasslistName", "", 30), CGI::br(), 298 CGI::submit("uploadClasslist", "Upload Classlist File"), 299 CGI::endform(), 300 ), 301 ), 302 CGI::Tr({-valign=>"top"}, 303 CGI::td({}, 304 CGI::p("Scoring Files"), 305 CGI::startform("POST", $r->uri, "multipart/form-data"), 306 $self->hidden_authen_fields, 307 CGI::scrolling_list( 308 -name => "scoringFile", 309 -values => $scoringFileRef, 310 -size => 8, 311 -multiple => 0, 312 ), CGI::br(), 313 CGI::submit("deleteScoringFile", "Delete"), 314 CGI::font({-color=>"red"}, CGI::em("Delete is not undoable!")), 315 CGI::br(), 316 CGI::submit("downloadScoringFile", "Download"), 317 CGI::br(), 318 CGI::p("Upload New Scoring File:"), 319 CGI::filefield( 320 -name => "newScoringFile", 321 -size => 30, 322 ), CGI::br(), 323 "Use name:", CGI::textfield("newScoringFileName", "", 30), CGI::br(), 324 CGI::submit("uploadScoringFile", "Upload Scoring File"), 325 CGI::endform(), 326 ), 327 ), 328 ); 329 330 return ""; 331 } 332 333 1; 334 335 __END__ 336 337 =head1 AUTHOR 338 339 Written by Sam Hathaway, sh002i (at) math.rochester.edu 340 341 =cut
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |