Parent Directory
| 
Revision Log
Revision 2000 -
(view)
(download)
(as text)
Original Path: trunk/webwork2/lib/WeBWorK/ContentGenerator/Instructor/FileXfer.pm
| 1 : | sh002i | 1615 | ################################################################################ |
| 2 : | sh002i | 1663 | # WeBWorK Online Homework Delivery System |
| 3 : | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ | ||
| 4 : | sh002i | 2000 | # $CVSHeader: webwork-modperl/lib/WeBWorK/ContentGenerator/Instructor/FileXfer.pm,v 1.3 2004/03/23 01:15:58 sh002i Exp $ |
| 5 : | sh002i | 1663 | # |
| 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 : | sh002i | 1615 | ################################################################################ |
| 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 : | sh002i | 1917 | my $r = $self->r; |
| 35 : | my $ce = $r->ce; | ||
| 36 : | my $authz = $r->authz; | ||
| 37 : | |||
| 38 : | sh002i | 1615 | my $userID = $r->param("user"); |
| 39 : | |||
| 40 : | my ($type, $action) = ("", ""); | ||
| 41 : | sh002i | 2000 | 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 : | sh002i | 1615 | |
| 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 : | sh002i | 2000 | } 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 : | sh002i | 1615 | } |
| 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 : | sh002i | 1917 | my $r = $self->r; |
| 82 : | my $ce = $r->ce; | ||
| 83 : | sh002i | 1615 | |
| 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 : | sh002i | 2000 | } 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 : | sh002i | 1615 | } |
| 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 : | sh002i | 1917 | # FIXME: FOR THE LOVE OF GOD, ADD SECURITY CHECKS!!!!!! |
| 109 : | sh002i | 2000 | # (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 : | sh002i | 1917 | |
| 113 : | sh002i | 1615 | # 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 : | sh002i | 2000 | # (at this point we know the filename isn't dangerous) |
| 120 : | |||
| 121 : | sh002i | 1615 | # delete it |
| 122 : | unlink "$dir/$fileToDelete"; | ||
| 123 : | } | ||
| 124 : | |||
| 125 : | sub handleDownload { | ||
| 126 : | my ($self, $type) = @_; | ||
| 127 : | sh002i | 1917 | my $r = $self->r; |
| 128 : | my $ce = $r->ce; | ||
| 129 : | sh002i | 1615 | |
| 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 : | sh002i | 2000 | } 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 : | sh002i | 1615 | } |
| 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 : | sh002i | 1917 | my $r = $self->r; |
| 171 : | my $ce = $r->ce; | ||
| 172 : | sh002i | 1615 | |
| 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 : | sh002i | 2000 | } elsif ($type eq "scoringFile") { |
| 187 : | @fileList = $self->getScoringFileList; | ||
| 188 : | $uploadParam = "newScoringFile"; | ||
| 189 : | $uploadNameParam = "newScoringFileName"; | ||
| 190 : | $ext = ".csv"; | ||
| 191 : | $destDir = $ce->{courseDirs}->{scoring}; | ||
| 192 : | sh002i | 1615 | } |
| 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 : | sh002i | 1917 | sub body { |
| 230 : | sh002i | 1615 | my ($self) = @_; |
| 231 : | sh002i | 1917 | my $r = $self->r; |
| 232 : | my $authz = $r->authz; | ||
| 233 : | sh002i | 1615 | |
| 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 : | sh002i | 2000 | my $classlistsRef = [ $self->getCSVList ]; |
| 244 : | my $setDefsRef = [ $self->getDefList ]; | ||
| 245 : | my $scoringFileRef = [ $self->getScoringFileList ]; | ||
| 246 : | sh002i | 1615 | |
| 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 : | sh002i | 2000 | ), |
| 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 : | sh002i | 1615 | ); |
| 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 |