Parent Directory
|
Revision Log
changed #! lines to /usr/bin/env perl THIS SHOULD BE THE LAST TIME #! LINES ARE CHANGED!!!!!!!
1 #!/usr/bin/env perl 2 3 ## This file is profEditSetDef.pl 4 ## It provides a utility for professors to edit set definition files 5 ## and their course's webworkCourse.ph 6 7 use lib '.'; use webworkInit; # WeBWorKInitLine 8 9 use Global; 10 use CGI qw(:standard); 11 use Auth; 12 use Net::SMTP; 13 use HTML::Entities; 14 use strict; 15 16 my $cgi = new CGI; 17 my %inputs = $cgi->Vars(); 18 19 #for use in strings where $cgi->param is not interpolated correctly or at all 20 my $course = $cgi->param('course'); 21 my $user = $cgi->param('user'); 22 my $session_key = $cgi->param('key'); 23 24 my $currentFile = $cgi->param('filename'); 25 my $currentDir = $cgi->param('dir'); # relative to extDir below 26 $currentDir ='' unless defined $currentDir; 27 my $currentExt = $cgi->param('ext'); # this is the expected extension 28 29 # edit these to add functionality for other file types 30 my %validExt = ('def' => 1, 31 'ph' => 1, 32 'pg' => 1, 33 'html' => 1, 34 'txt' => 1 ); 35 36 my %extName = ( 'def' => "Set Definition", 37 'ph' => "Course Environment", 38 'pg' => "Set Header", 39 'html' => "Course index.html", 40 'txt' => "Course motd.txt" ); 41 42 my %extDir = ( 'def' => "/templates/", 43 'ph' => "/", 44 'pg' => "/templates/", 45 'html' => "/html/", 46 'txt' => "/templates/" ); 47 48 &Global::getCourseEnvironment($course); 49 50 my $scriptDirectory = $Global::scriptDirectory; 51 my $databaseDirectory = $Global::databaseDirectory; 52 my $htmlURL = $Global::htmlURL; 53 my $cgiURL = $Global::cgiWebworkURL; 54 my $courseDirectory = $Global::coursesDirectory . $course; 55 my $courseScriptsDirectory = $Global::courseScriptsDirectory; 56 my $templateDirectory = getCourseTemplateDirectory; 57 my $feedbackAddress = $Global::feedbackAddress; 58 59 require "${scriptDirectory}$Global::FILE_pl"; 60 require "${scriptDirectory}$Global::classlist_DBglue_pl"; 61 require "${scriptDirectory}$Global::HTMLglue_pl"; 62 require "${scriptDirectory}$Global::FILE_pl"; 63 64 # log access 65 &Global::log_info('', query_string); 66 67 my $permissionsFile = &Global::getCoursePermissionsFile($course); 68 my $permissions = &get_permissions($user, $permissionsFile); 69 my $keyFile = &Global::getCourseKeyFile($course); 70 71 72 #verify session key 73 &verify_key($user, $session_key, "$keyFile", $course); 74 75 #verify permissions are correct 76 if (($permissions != $Global::instructor_permissions) and ($permissions != $Global::TA_permissions) ) { 77 print "permissions = $permissions instructor_permissions = $Global::instructor_permissions\n"; 78 print &html_NO_PERMISSION; 79 exit(0); 80 } 81 82 # verify that the file type is valid 83 if (!($currentFile =~ /.*\.(.*)/) || ($1 ne $currentExt) ) { 84 &user_error("The file $currentFile is not valid because it does not contain the expected ending: $currentExt"); 85 } 86 87 # consolidate relative directory paths into one hard path 88 $currentDir = $courseDirectory . $extDir{$currentExt} . $currentDir; 89 90 #wwerror("current Dir: $currentDir<P>current File:$currentFile <P>current Ext: $currentExt"); 91 # make sure requested file exists and is a valid file 92 if (defined($currentFile) && -e "$currentDir$currentFile") { 93 unless ( -R "$currentDir$currentFile") { 94 wwerror ('File is not readable', "The file $currentFile is not readable by the webserver. Check that it's permissions are set correctly."); 95 } 96 } else { 97 wwerror('File does not exist', "The file $currentDir$currentFile does appear to exist, please check the filename and try again."); 98 } 99 100 # If editing the Course Environment File, make sure this is allowed. 101 if (defined($currentFile) && ($currentFile eq $Global::courseEnvironmentFile)) { 102 unless ($Global::allowEditCourseEnvironmentFile){ 103 wwerror ('Editing from the web is not allowed', 'If you want to allow editing from the web, edit the webworkCourse.ph file setting 104 $allowEditCourseEnvironmentFile = 1;'); 105 } 106 } 107 # get row and column info if submitted 108 my $rows = (defined($cgi->param('rows'))) ? $cgi->param('rows') : $Global::editor_window_rows; 109 my $columns = (defined($cgi->param('columns'))) ? $cgi->param('columns') : $Global::editor_window_columns; 110 111 # Deal with filled out forms and various actions resulting from different buttons 112 if ( defined($cgi->param('action')) ) { 113 if (defined($cgi->param('savefilename'))) { 114 &user_error("For security reasons, you cannot save a file in any directory higher than the current directory. Please specify a file name to save under.") if ($cgi->param('savefilename') =~ /^[~.]/ || $cgi->param('savefilename') =~ /\.\./); 115 } 116 117 #if Save button was clicked 118 if (( $cgi->param('action') eq 'Save') && defined($cgi->param('body')) && defined($cgi->param('savefilename'))) { 119 120 my $temp_body = $cgi->param('body'); 121 $temp_body =~ s/\r\n/\n/g; #html textareas tend to leave \r 122 123 # saveProblem($temp_body, $currentDir . $cgi->param('savefilename')); 124 saveProblem($temp_body, $cgi->param('savefilename')); 125 $currentFile = $cgi->param('savefilename'); 126 127 #if Save As button was clicked 128 } elsif (( $cgi->param('action') eq 'Save as') && defined($cgi->param('body')) && defined($cgi->param('savefilename'))) { 129 130 $currentFile = $cgi->param('savefilename'); 131 132 # if ($currentFile =~ /^[~.]/ || $currentFile =~ /\.\./) { 133 # &user_error("For security reasons, you cannot specify a merge file from a directory higher than the email directory (you can't use ../blah/blah). Please specify a different file or move the needed file to the email directory"); 134 # } 135 136 137 my $temp_body = $cgi->param('body'); 138 $temp_body =~ s/\r\n/\n/g; 139 140 saveNewProblem($temp_body, $currentFile); 141 142 } 143 } 144 145 146 147 #Begin Page 148 print &htmlTOP("Edit $extName{$currentExt} File(s) for $course"), 149 $cgi->a( { -href=>"${cgiURL}login.pl?user=$user&key=$session_key&course=$course" }, 150 151 $cgi->img({ -name=>'upImg', 152 -src=>"${Global::upImgUrl}", 153 -align=>'right', 154 -border=>'1', 155 -alt=>'[Up]' 156 }) 157 ), 158 $cgi->p; 159 160 print "\n", 161 $cgi->hr, $cgi->br, 162 "\n\n", $cgi->h3({ -align=>'left' }, "WeBWorK $extName{$currentExt} File(s) Editor for $course"), "\n", 163 $cgi->p, 164 "From this page, you can edit your $extName{$currentExt} file(s). You can both save over 165 old files and create new ones. You can even open one file, make changes and then save those 166 changes under a different file name.", 167 $cgi->hr, "\n"; 168 169 170 # start form with hidden entries to pass info back to profEditCourseFiles.pl 171 # the last two are very circular but are necessary to make sure the script 172 # continues to know which kind of file it is dealing with 173 # They should be set by the original call (most likely in profLogin.pl 174 print $cgi->startform(-action=>"${cgiURL}profEditCourseFiles.pl"), "\n", 175 $cgi->hidden(-name=>"user", -value=>$user), "\n", 176 $cgi->hidden(-name=>"key", -value=>$session_key), "\n", 177 $cgi->hidden(-name=>"course", -value=>$course), "\n", 178 179 $cgi->hidden(-name=>"dir", -value=>$cgi->param("dir")), "\n", 180 $cgi->hidden(-name=>"ext", -value=>$cgi->param("ext")), "\n"; 181 182 #get current file 183 my ($text, @text); 184 if (-e "$currentDir$currentFile") { 185 open FILE, "$currentDir$currentFile"; 186 @text = <FILE>; 187 $text = join "", @text; 188 } else { 189 # wwerror($0, "Message File $currentDir$currentFile does not exist!"); 190 } 191 192 #print actual body of message 193 print "\n", $cgi->br, $cgi->textarea(-name=>'body', -default=>$text, -rows=>$rows, -columns=>$columns, -override=>1); 194 195 196 #get all message files and create a list 197 # 198 # @filenames = sort @filenames; 199 200 my @filenames; 201 202 if($currentExt eq "pg") { 203 @filenames = grep /\.*header\.*.pg$/i, recursiveFindFiles($currentDir); 204 map s|$templateDirectory/?||, @filenames; 205 } else { 206 opendir CURDIR, $currentDir; # or wwerror($0, "Can't open directory $currentDir","",""); 207 @filenames = grep /\.$currentExt$/, readdir CURDIR; 208 closedir CURDIR; 209 } 210 @filenames = sort @filenames; 211 212 print $cgi->p, $cgi->popup_menu(-name=>'filename', -values=>\@filenames, -default=>$currentFile); 213 214 215 #create all necessary action buttons 216 print $cgi->submit(-name=>'action', -value=>'Open'), "\n", $cgi->br, 217 $cgi->textfield(-name=>'savefilename', -size => 20, -value=> "$currentFile", -override=>1), ' ', 218 $cgi->submit(-name=>'action', -value=>'Save'), " \n", 219 $cgi->submit(-name=>'action', -value=>'Save as'), " \n", 220 'For "Save As" choose a new filename.', $cgi->br, $cgi->br, 221 $cgi->p, $cgi->submit(-name=>'action', -value=>'Revert to original and Resize message window'), 222 " Rows: ", $cgi->textfield(-name=>'rows', -size=>3, -value=>$rows), 223 " Columns: ", $cgi->textfield(-name=>'columns', -size=>3, -value=>$columns), 224 $cgi->br, "If you resize the message window, you will lose all unsaved changes.", 225 $cgi->end_form, 226 &htmlBOTTOM("profEditCourseFiles", \%inputs); 227 228 # End of HTML 229 230 231 ###### SUBROUTINES ###### 232 sub saveProblem { 233 my ($body, $probFileName)= @_; 234 235 open (PROBLEM, ">$currentDir$probFileName") || 236 wwerror($0, "Could not open $currentDir$probFileName for writing. 237 Check that the permissions for this problem are 660 (-rw-rw----)"); 238 print PROBLEM $body; 239 close PROBLEM; 240 chmod 0660, "$currentDir$probFileName" || 241 print "Content-type: text/html\n\n 242 CAN'T CHANGE PERMISSIONS ON FILE $currentDir$probFileName"; 243 244 } 245 246 sub saveNewProblem { 247 my ($body, $new_file_name)= @_; 248 #######check that the new file name doesn't exist 249 if (-e "$currentDir$new_file_name" ) { 250 wwerror("Can not use this file name", "The file\n". 251 "$new_file_name\n". 252 "already exists.\n" . 253 "<b>The new version was not saved.</b>\n" . 254 "Go back and choose a different file name or\, if you really want to edit\n". 255 "$new_file_name\,\n". 256 "go back and hit the \"Save updated version\" button."); 257 } 258 259 wwerror ("Invalid file name", "The file name \"$new_file_name\" does not have a \".$currentExt\" extension. 260 <b>The file was not saved.</b> 261 Go back and choose a file name with a \".$currentExt\" extension.") unless 262 $new_file_name =~ m|\.$currentExt$|; 263 #######copy new version to the file new_file_name 264 open (PROBLEM, ">$currentDir$new_file_name") || 265 wwerror($0, "Could not open $currentDir$new_file_name for writing. 266 Check that the permissions for the directory $currentDir are 770 (drwxrwx---)"); 267 print PROBLEM $body; 268 close PROBLEM; 269 chmod 0660, "$currentDir$new_file_name" || 270 print "Content-type: text/html\n\n 271 CAN'T CHANGE PERMISSIONS ON FILE $currentDir$new_file_name"; 272 273 } 274 275 sub user_error { 276 my $msg = join " ", @_; 277 print $cgi->header, 278 $cgi->start_html('-title' => 'User error'), 279 $cgi->h1('User error'), 280 $cgi->p, 281 $cgi->b(HTML::Entities::encode($msg)), 282 $cgi->p, 283 "Please hit the "<B>Back</B>" button on your browser to ", 284 "try again, or notify ", $cgi->br, 285 "<", $cgi->a({href=>"mailto:$Global::webmaster"}, $Global::webmaster), "> ", 286 "if you believe this message is in error.", 287 $cgi->end_html; 288 exit(1); 289 } 290 291 292 sub recursiveFindFiles 293 { 294 my $dir = shift; 295 $dir .= '/' unless $dir =~ m|/$|; 296 opendir DIR, $dir; 297 my @items = readdir DIR; 298 closedir DIR; 299 my @result; 300 foreach (@items) { 301 /^\./ and next; 302 -f "$dir$_" and push @result, "$dir$_"; 303 -d "$dir$_" and push @result, recursiveFindFiles("$dir$_"); 304 } 305 return @result; 306 }
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |