Parent Directory
| 
Revision Log
Revision 116 - (view) (download) (as text)
| 1 : | sam | 11 | #!/usr/local/bin/webwork-perl |
| 2 : | sam | 2 | |
| 3 : | |||
| 4 : | ################################################################ | ||
| 5 : | # Copyright @1995-1999 by Michael E. Gage, Arnold K. Pizer and | ||
| 6 : | # WeBWorK at the University of Rochester. All rights reserved. | ||
| 7 : | ################################################################ | ||
| 8 : | |||
| 9 : | sh002i | 116 | my $debugON=1; ## set this to 1 to save debugging information for errors in hardcopy output |
| 10 : | sam | 2 | |
| 11 : | gage | 8 | use lib '.'; use webworkInit; # WeBWorKInitLine |
| 12 : | sam | 2 | require 5.001; |
| 13 : | |||
| 14 : | $/ ="\n"; | ||
| 15 : | |||
| 16 : | use strict; | ||
| 17 : | use Global; | ||
| 18 : | use Auth; | ||
| 19 : | use CGI qw(:standard); | ||
| 20 : | use Net::SMTP; | ||
| 21 : | use Safe; | ||
| 22 : | |||
| 23 : | |||
| 24 : | use PGtranslator; | ||
| 25 : | #use sigtrap; | ||
| 26 : | BEGIN { | ||
| 27 : | # set to 1 to enable timing_log | ||
| 28 : | # (contains information about time taken by scripts to run) | ||
| 29 : | $main::logTimingData = 0; | ||
| 30 : | |||
| 31 : | # begin Timing code | ||
| 32 : | if( $main::logTimingData == 1 ) { | ||
| 33 : | use Benchmark; | ||
| 34 : | $main::beginTime = new Benchmark; | ||
| 35 : | } | ||
| 36 : | # end Timing code | ||
| 37 : | |||
| 38 : | # ## Setting these time out comstants to zeros removes the time constraint completely. (zero = infinity :=) ) | ||
| 39 : | $main::TIME_OUT_CONSTANT = 60; # one minute wait for on screen problems | ||
| 40 : | sh002i | 115 | # $main::DOWNLOAD_TIME_OUT_CONSTANT = 300; # give it five minutes |
| 41 : | sam | 2 | $main::CLASS_DOWNLOAD_TIME_OUT_CONSTANT = 1200; #twenty minutes |
| 42 : | sh002i | 115 | # $main::DOWNLOAD_NICE = 2; |
| 43 : | sam | 2 | $main::CLASS_DOWNLOAD_NICE = 5; # higher numbers indicated lower priorities |
| 44 : | |||
| 45 : | # ## ATTENTION: The handlers PG_floating_point_exception_handler and PG_warnings_handler | ||
| 46 : | # ## have to be installed after CGI::Carp is called since it also | ||
| 47 : | # ## modifes the die and warn labels. Finding the right warning mechanism using these two | ||
| 48 : | # ## methods bears further investigation | ||
| 49 : | # ## They are defined in Global.pm | ||
| 50 : | gage | 104 | $SIG{'FPE'} = \&Global::PG_floating_point_exception_handler; |
| 51 : | $SIG{__WARN__}=\&Global::PG_warnings_handler; | ||
| 52 : | sam | 2 | $SIG{'TERM'} = sub {die '[',scalar(localtime),"] Caught a SIGTERM, Error: $! stopped at $0\n"; }; |
| 53 : | $SIG{'PIPE'} = sub {$main::SIGPIPE = 1, die '[',scalar(localtime),"] Caught a SIGPIPE, Error: $! stopped at $0\n"; }; | ||
| 54 : | $SIG{ALRM} = sub { $main::SIG_TIME_OUT = 1; exit(0) }; | ||
| 55 : | |||
| 56 : | alarm($main::TIME_OUT_CONSTANT); | ||
| 57 : | # By explicitly catching the signals and dieing one forces the execution of the END statements which clean up the files. | ||
| 58 : | # | ||
| 59 : | }; | ||
| 60 : | |||
| 61 : | use vars qw ($modules_to_evaluate $extra_packages_to_be_loaded | ||
| 62 : | ); | ||
| 63 : | |||
| 64 : | &CGI::ReadParse; | ||
| 65 : | my %inputs=%main::in; | ||
| 66 : | |||
| 67 : | my $query = $main::in{CGI}; | ||
| 68 : | |||
| 69 : | # verify that the rest of the information has been received | ||
| 70 : | my $Course = $inputs{'course'}; | ||
| 71 : | my $User = $inputs{'user'}; | ||
| 72 : | |||
| 73 : | #my $psvn = $inputs{'probSetKey'}; | ||
| 74 : | |||
| 75 : | my @local_psvns = $query -> param('local_psvns'); | ||
| 76 : | my $psvn = $local_psvns[0]; ## get the first one for doing problem sets | ||
| 77 : | $inputs{'probSetKey'} = $psvn; ## only used by htmlBOTTOM | ||
| 78 : | my $Session_key = $inputs{'key'}; | ||
| 79 : | |||
| 80 : | |||
| 81 : | &Global::getCourseEnvironment($Course); | ||
| 82 : | |||
| 83 : | my $scriptDirectory = getWebworkScriptDirectory(); #$Global::scriptDirectory; | ||
| 84 : | my $databaseDirectory = getCourseDatabaseDirectory(); #$Global::databaseDirectory; | ||
| 85 : | my $courseScriptsDirectory = getCourseScriptsDirectory(); #$Global::courseScriptsDirectory; | ||
| 86 : | my $templateDirectory = getCourseTemplateDirectory(); #$Global::templateDirectory; | ||
| 87 : | |||
| 88 : | # this is globally defined for the file, since it is needed for cleanup in END | ||
| 89 : | my $tempDirectory = getCourseTempDirectory(); | ||
| 90 : | |||
| 91 : | eval{require "${courseScriptsDirectory}$Global::displayMacros_pl";} ; | ||
| 92 : | eval{require "${scriptDirectory}$Global::DBglue_pl";}; | ||
| 93 : | gage | 6 | eval{require "${scriptDirectory}$Global::classlist_DBglue_pl";}; |
| 94 : | sam | 2 | eval{require "${scriptDirectory}$Global::HTMLglue_pl";}; |
| 95 : | eval{require "${scriptDirectory}$Global::FILE_pl";} ; | ||
| 96 : | |||
| 97 : | |||
| 98 : | |||
| 99 : | #################################################################### | ||
| 100 : | # load the modules to be used in PGtranslator | ||
| 101 : | |||
| 102 : | require "${courseScriptsDirectory}PG_module_list.pl" or | ||
| 103 : | wwerror($0, "Can't read ${courseScriptsDirectory}PG_module_list.pl"); | ||
| 104 : | #################################################################### | ||
| 105 : | |||
| 106 : | my $keyFile = &Global::getCourseKeyFile($Course); | ||
| 107 : | my $permissionsFile = &getCoursePermissionsFile($Course); | ||
| 108 : | |||
| 109 : | ## check to see if prob set has been selected ## | ||
| 110 : | verifyInput(); | ||
| 111 : | |||
| 112 : | ############################################## | ||
| 113 : | sub verifyInput { | ||
| 114 : | |||
| 115 : | if(!defined($psvn) || $psvn eq "") { | ||
| 116 : | &selectionError; # The calling script did not specify a problem set. | ||
| 117 : | #die "Content-type: text/html\n\nThe calling script did not specify a problem set."; | ||
| 118 : | exit(); | ||
| 119 : | } | ||
| 120 : | } | ||
| 121 : | |||
| 122 : | # log access | ||
| 123 : | &Global::log_info('', query_string); | ||
| 124 : | |||
| 125 : | |||
| 126 : | &verify_key($inputs{'user'}, $Session_key, $keyFile, $Course); | ||
| 127 : | |||
| 128 : | my $permissions = &get_permissions($User,$permissionsFile); | ||
| 129 : | |||
| 130 : | &attachProbSetRecord($psvn); | ||
| 131 : | gage | 6 | my $login_name_for_psvn = &getStudentLogin($psvn); |
| 132 : | attachCLRecord($login_name_for_psvn); | ||
| 133 : | sam | 2 | |
| 134 : | my $setNumber=&getSetNumber($psvn); | ||
| 135 : | $setNumber = $inputs{'setNo'} if defined $inputs{'setNo'}; ## script called from profChangeDates.pl | ||
| 136 : | |||
| 137 : | sh002i | 115 | # keep strict happy |
| 138 : | my $tempTexFileBaseName; | ||
| 139 : | sam | 2 | |
| 140 : | ###### check to see that it is after the open date | ||
| 141 : | my ($currentTime,$odts,$ddts,$remainingTime, $TimeString); | ||
| 142 : | $currentTime = time; | ||
| 143 : | $odts=&getOpenDate($psvn); | ||
| 144 : | $ddts=&getDueDate($psvn); | ||
| 145 : | $remainingTime=$ddts-$currentTime; | ||
| 146 : | |||
| 147 : | if($currentTime<$odts && $permissions !=$Global::instructor_permissions) { | ||
| 148 : | print &htmlTOP("Before open date error"); | ||
| 149 : | print "<CENTER><h2>Sorry, cannot download or do problem set $setNumber yet. | ||
| 150 : | <BR>It is before the open date.</h2></CENTER>"; | ||
| 151 : | print &htmlBOTTOM("downloadPS.pl",\%inputs); | ||
| 152 : | exit(0); | ||
| 153 : | } | ||
| 154 : | |||
| 155 : | gage | 6 | my %PSVNHashForSet = %{getPSVNHashForSet($setNumber)}; |
| 156 : | sam | 2 | my $action = $inputs{'action'}; |
| 157 : | my $downloadType= $inputs{'downloadType'}; # either pdf, ps, tex, or dvi | ||
| 158 : | |||
| 159 : | # Verify that the problem set has been created if a psvn number has been passed | ||
| 160 : | unless ($action eq 'Get_all_copies') { | ||
| 161 : | gage | 6 | unless (defined $PSVNHashForSet{$psvn} ) { |
| 162 : | sam | 2 | print &htmlTOP("Problem set version number $psvn not created"); |
| 163 : | print ( "Pin number $psvn was not created for set $setNumber"); | ||
| 164 : | print &htmlBOTTOM("downloadPS.pl", \%inputs); | ||
| 165 : | exit(0); | ||
| 166 : | } | ||
| 167 : | } | ||
| 168 : | |||
| 169 : | my $texFile = "${login_name_for_psvn}.tempTex-CGIscript"; | ||
| 170 : | my $save_errors=''; | ||
| 171 : | |||
| 172 : | gage | 6 | if ($action eq 'Do problem set' or $action eq 'Do_problem_set') {displayProbSet();} |
| 173 : | #elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') {downloadIndividualSet();} | ||
| 174 : | elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') {downloadAllSets();} | ||
| 175 : | sam | 2 | elsif ($action eq 'Get_all_copies') {downloadAllSets();} |
| 176 : | else {wwerror($0, "Unknown action: $action");} | ||
| 177 : | |||
| 178 : | |||
| 179 : | # begin Timing code | ||
| 180 : | # my $endTime = new Benchmark; | ||
| 181 : | # &Global::logTimingInfo($main::beginTime,$endTime,$0,$Course,$User); | ||
| 182 : | # end Timing code | ||
| 183 : | |||
| 184 : | exit; | ||
| 185 : | ############################################# | ||
| 186 : | |||
| 187 : | sub displayProbSet { | ||
| 188 : | gage | 6 | my $studentName=&CL_getStudentName($login_name_for_psvn); |
| 189 : | sam | 2 | my $probHeaderFileName = &getProbHeaderFileName($psvn); |
| 190 : | |||
| 191 : | my @problems=sort numerical &getAllProblemsForProbSetRecord($psvn); | ||
| 192 : | sub numerical { $a <=> $b}; | ||
| 193 : | |||
| 194 : | my $numberOfProblems=0; | ||
| 195 : | my $prob; | ||
| 196 : | foreach $prob (@problems) {$numberOfProblems++;} | ||
| 197 : | |||
| 198 : | |||
| 199 : | print &probSet_htmlTOP("Problem Set $setNumber from $inputs{'course'} for $studentName"); | ||
| 200 : | #see subroutines at the bottom of this file | ||
| 201 : | #this allows the use of a small gif for the webwork logo | ||
| 202 : | #and takes up less screen real estate. | ||
| 203 : | |||
| 204 : | print &probSet_titleBar("Problem Set $setNumber from $inputs{'course'} for $studentName"); | ||
| 205 : | |||
| 206 : | print <<"ENDOFHTML"; | ||
| 207 : | <TABLE BORDER=1> | ||
| 208 : | <TR> | ||
| 209 : | <!-- Row 1 Column 1 --> | ||
| 210 : | <TD> | ||
| 211 : | |||
| 212 : | Select one of the $numberOfProblems problems to try: | ||
| 213 : | <FORM METHOD=POST ACTION="$Global::processProblem_CGI"> | ||
| 214 : | <INPUT TYPE=HIDDEN NAME=probSetKey VALUE=$psvn> | ||
| 215 : | <P> | ||
| 216 : | <SELECT NAME=probNum SIZE=11> | ||
| 217 : | ENDOFHTML | ||
| 218 : | |||
| 219 : | my ($problem,$problemAttempted, $problemStatus,$longProblemStatus); | ||
| 220 : | foreach $problem(@problems) { | ||
| 221 : | $problemStatus = getProblemStatus($problem,$psvn); | ||
| 222 : | $problemAttempted = getProblemAttempted($problem,$psvn); | ||
| 223 : | |||
| 224 : | if (!$problemAttempted) { | ||
| 225 : | $longProblemStatus = ''; # default value | ||
| 226 : | } elsif ($problemStatus >= 0 and $problemStatus <=1 ) { | ||
| 227 : | my $percentCorr = int(100*$problemStatus+.5); | ||
| 228 : | $longProblemStatus = "${percentCorr}\% correct" | ||
| 229 : | } else { | ||
| 230 : | $longProblemStatus = 'unknown status'; # default value | ||
| 231 : | } | ||
| 232 : | print "<OPTION VALUE=$problem>Problem $problem -- $longProblemStatus </OPTION>\n"; | ||
| 233 : | } | ||
| 234 : | |||
| 235 : | ## nice note to warn if there's less than one day left to complete problem set | ||
| 236 : | if ($remainingTime<86400 && $remainingTime>0) { | ||
| 237 : | $TimeString = "<BR><RM>Note: you have less than one day left | ||
| 238 : | to complete this problem set</EM>"; | ||
| 239 : | } | ||
| 240 : | else { | ||
| 241 : | $TimeString = ""; | ||
| 242 : | } | ||
| 243 : | |||
| 244 : | print <<"ENDOFHTML"; | ||
| 245 : | </SELECT> | ||
| 246 : | <BR> | ||
| 247 : | ENDOFHTML | ||
| 248 : | |||
| 249 : | |||
| 250 : | apizer | 21 | my $practiceUser = $Global::practiceUser; |
| 251 : | if (($currentTime > $ddts) or ($User =~ /^$practiceUser/)) { | ||
| 252 : | print q!<INPUT type="checkbox" name="show_old_answers" value=1> Show my old answers<BR>!; | ||
| 253 : | } | ||
| 254 : | else { | ||
| 255 : | print q!<INPUT type="checkbox" name="show_old_answers" checked value=1> Show my old answers<BR>!; | ||
| 256 : | } | ||
| 257 : | |||
| 258 : | sam | 2 | print &sessionKeyInputs(\%inputs); |
| 259 : | my $mode = $inputs{'Mode'}; | ||
| 260 : | $mode = $Global::htmlModeDefault unless ($mode); | ||
| 261 : | &displaySelectModeLine($mode); ## displays mode select buttons | ||
| 262 : | ## the sub displaySelectModeLine is in | ||
| 263 : | ## "${courseScriptsDirectory}$Global::displayMacros_pl" | ||
| 264 : | print <<"ENDOFHTML"; | ||
| 265 : | <BR> | ||
| 266 : | <INPUT TYPE=SUBMIT VALUE="Get Problem"> | ||
| 267 : | $TimeString | ||
| 268 : | |||
| 269 : | </FORM> | ||
| 270 : | |||
| 271 : | ENDOFHTML | ||
| 272 : | |||
| 273 : | print "<FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P>"; | ||
| 274 : | print &sessionKeyInputs(\%inputs); | ||
| 275 : | |||
| 276 : | print <<"ENDOFHTML"; | ||
| 277 : | <INPUT TYPE=HIDDEN NAME="probSetKey" VALUE=$psvn> | ||
| 278 : | <INPUT TYPE=SUBMIT VALUE="Problem Sets"> | ||
| 279 : | </FORM> | ||
| 280 : | |||
| 281 : | |||
| 282 : | </TD> | ||
| 283 : | <!-- Row 1 Column 2 --> | ||
| 284 : | <TD> | ||
| 285 : | ENDOFHTML | ||
| 286 : | |||
| 287 : | |||
| 288 : | ## process problem and save @printlines | ||
| 289 : | my $probHeader = $Global::PROB_HEADER; # default value | ||
| 290 : | |||
| 291 : | if ( (defined($probHeaderFileName)) and ($probHeaderFileName =~ /\S/)) { | ||
| 292 : | $probHeader = $probHeaderFileName; | ||
| 293 : | } | ||
| 294 : | ## use $probHeader as default unless $probHeaderFileName is defined | ||
| 295 : | ## in the set definition file | ||
| 296 : | my $source; | ||
| 297 : | if (-e "${templateDirectory}$probHeader" ) { | ||
| 298 : | unless (-r "${templateDirectory}$probHeader") { | ||
| 299 : | wwerror($0, "Can't read ${templateDirectory}$probHeader"); | ||
| 300 : | } | ||
| 301 : | open(PROB,"<${templateDirectory}$probHeader"); | ||
| 302 : | $source = join("",<PROB>); | ||
| 303 : | close(PROB); | ||
| 304 : | } | ||
| 305 : | my %envir=defineProblemEnvir($mode,0,$psvn,$Course); | ||
| 306 : | my $pt = new PGtranslator; #pt stands for problem translator; | ||
| 307 : | $pt->environment(\%envir); | ||
| 308 : | $pt->initialize(); | ||
| 309 : | $pt-> set_mask(); | ||
| 310 : | $pt->source_string($source); | ||
| 311 : | $pt -> unrestricted_load("${courseScriptsDirectory}PG.pl"); | ||
| 312 : | $pt -> unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl"); | ||
| 313 : | $pt ->translate(); | ||
| 314 : | my $PG_PROBLEM_TEXT_REF = $pt->ra_text(); | ||
| 315 : | my $PG_HEADER_TEXT_REF = $pt->r_header;#\$PG_HEADER_TEXT; | ||
| 316 : | my $PG_ANSWER_HASH_REF = $pt->rh_correct_answers; | ||
| 317 : | my $PG_FLAGS_REF =$pt ->rh_flags; | ||
| 318 : | |||
| 319 : | |||
| 320 : | |||
| 321 : | my @printlines; | ||
| 322 : | if($mode eq "HTML" || $mode eq 'HTML_tth') { | ||
| 323 : | @printlines=@{$pt->ra_text()}; | ||
| 324 : | } | ||
| 325 : | elsif ($mode eq 'Latex2HTML') { | ||
| 326 : | @printlines = &createDisplayedInsert($setNumber, | ||
| 327 : | $probHeader,$psvn,$Course,$pt->ra_text()); | ||
| 328 : | } | ||
| 329 : | print @printlines; | ||
| 330 : | print <<"ENDOFHTML"; | ||
| 331 : | </TD> | ||
| 332 : | </TR> | ||
| 333 : | </TABLE> | ||
| 334 : | ENDOFHTML | ||
| 335 : | print &htmlBOTTOM('welcomeAction.pl', \%inputs,'probSetHelp.html'); | ||
| 336 : | exit; | ||
| 337 : | } ## end of problem selection form and end of sub displayProbSet | ||
| 338 : | |||
| 339 : | #################### | ||
| 340 : | ## subroutines | ||
| 341 : | #################### | ||
| 342 : | |||
| 343 : | $/ = "\n"; | ||
| 344 : | sub createTexSource { | ||
| 345 : | my $psvn = shift; | ||
| 346 : | |||
| 347 : | # check that the psvn corresponds to the user and that it is after the open | ||
| 348 : | # date. This should only fail if someone is trying to break into WeBWorK. | ||
| 349 : | gage | 6 | |
| 350 : | &attachProbSetRecord($psvn); | ||
| 351 : | $login_name_for_psvn = &getStudentLogin($psvn); | ||
| 352 : | attachCLRecord($login_name_for_psvn); | ||
| 353 : | sam | 2 | |
| 354 : | if ( ( ( $User ne &getStudentLogin($psvn)) ||($currentTime < $odts) ) | ||
| 355 : | and ($permissions != $Global::instructor_permissions) | ||
| 356 : | and ($permissions != $Global::TA_permissions) | ||
| 357 : | ) { | ||
| 358 : | &hackerError; | ||
| 359 : | exit; | ||
| 360 : | } | ||
| 361 : | |||
| 362 : | my $probSetHeader = $Global::SET_HEADER; | ||
| 363 : | |||
| 364 : | my $setHeaderFileName = &getSetHeaderFileName($psvn); | ||
| 365 : | |||
| 366 : | my $answersRequestedQ = 0; | ||
| 367 : | $answersRequestedQ= $inputs{'ShowAns'} if defined($inputs{'ShowAns'}); | ||
| 368 : | |||
| 369 : | my $adts=&getAnswerDate($psvn); | ||
| 370 : | my $displayCorrectAnswersQ = 0; #initialize | ||
| 371 : | $displayCorrectAnswersQ =1 if $answersRequestedQ && ($currentTime > $adts); | ||
| 372 : | $displayCorrectAnswersQ =1 if $answersRequestedQ && ($permissions == $Global::instructor_permissions); | ||
| 373 : | |||
| 374 : | |||
| 375 : | # chdir "$tempDirectory"; | ||
| 376 : | # umask(022); | ||
| 377 : | |||
| 378 : | my $texSource =''; | ||
| 379 : | |||
| 380 : | # open(OUTPUT, ">${tempDirectory}${texFile}${psvn}.tex") | ||
| 381 : | #|| wwerror("Can't create $tempDirectory${texFile}$psvn.tex\n"); | ||
| 382 : | |||
| 383 : | gage | 6 | |
| 384 : | |||
| 385 : | sam | 2 | print STDERR "%%Creating a tex version of set $setNumber<BR>\n" if $debugON; |
| 386 : | gage | 6 | print STDERR "%%For", &CL_getStudentName($login_name_for_psvn), "psvn=$psvn<BR>\n" if $debugON; |
| 387 : | sam | 2 | |
| 388 : | |||
| 389 : | # input TeX preamble | ||
| 390 : | # print OUTPUT &texInput($Global::TEX_SET_PREAMBLE); | ||
| 391 : | $texSource = &texInput($Global::TEX_SET_PREAMBLE); | ||
| 392 : | |||
| 393 : | # print TeX Header | ||
| 394 : | # print OUTPUT &texInput($Global::TEX_SET_HEADER); | ||
| 395 : | $texSource .= &texInput($Global::TEX_SET_HEADER); | ||
| 396 : | |||
| 397 : | # Print setheader | ||
| 398 : | my $mode = "TeX"; | ||
| 399 : | my @PG_COMPILE_ERRORS = (); | ||
| 400 : | if ( (defined($setHeaderFileName)) and $setHeaderFileName =~ /\S/) { | ||
| 401 : | $probSetHeader = $setHeaderFileName; | ||
| 402 : | } | ||
| 403 : | ## use $probSetHeader as default unless $setHeaderFileName is defined | ||
| 404 : | ## in the set definition file | ||
| 405 : | if ( open(INPUT,"${templateDirectory}$probSetHeader") ) { | ||
| 406 : | |||
| 407 : | # ##Determine language | ||
| 408 : | |||
| 409 : | $probSetHeader =~ /\.([^\.]*)$/; | ||
| 410 : | my $displayMode = $1; | ||
| 411 : | |||
| 412 : | gage | 6 | if ($displayMode eq 'pg') { |
| 413 : | sam | 2 | my %envir=defineProblemEnvir($mode,0, $psvn,$Course,undef()); |
| 414 : | my $input_string= join("",<INPUT> ); | ||
| 415 : | my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF); | ||
| 416 : | my $pt = new PGtranslator; #pt stands for problem translator; | ||
| 417 : | $pt -> evaluate_modules( @{main::modules_to_evaluate}) ; | ||
| 418 : | $pt -> load_extra_packages(@{main::extra_packages_to_be_loaded}); | ||
| 419 : | |||
| 420 : | # The variables in the two preceding lines are defined in PG_module_list.pl | ||
| 421 : | # require "${courseScriptsDirectory}PG_module_list.pl"; | ||
| 422 : | # (Modules are defined by require statement above found near the top of this file, outside the loop.) | ||
| 423 : | $pt->environment(\%envir); | ||
| 424 : | $pt->initialize(); | ||
| 425 : | $pt-> set_mask(); | ||
| 426 : | $pt->source_string($input_string); | ||
| 427 : | $pt -> unrestricted_load("${courseScriptsDirectory}PG.pl"); | ||
| 428 : | $pt -> unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl"); | ||
| 429 : | $pt ->translate(); | ||
| 430 : | $PG_PROBLEM_TEXT_REF = $pt->ra_text(); | ||
| 431 : | $PG_HEADER_TEXT_REF = $pt->r_header;#\$PG_HEADER_TEXT; | ||
| 432 : | $PG_ANSWER_HASH_REF = $pt->rh_correct_answers; | ||
| 433 : | $PG_FLAGS_REF =$pt ->rh_flags; | ||
| 434 : | # print OUTPUT @{$PG_PROBLEM_TEXT_REF}; | ||
| 435 : | $texSource .= join '', @{$PG_PROBLEM_TEXT_REF}; | ||
| 436 : | |||
| 437 : | } else { | ||
| 438 : | # print OUTPUT "Don't understand languages with extension $displayMode.<BR>\n"; | ||
| 439 : | $texSource .= "Don't understand languages with extension $displayMode.<BR>\n"; | ||
| 440 : | } | ||
| 441 : | close INPUT; | ||
| 442 : | } else { | ||
| 443 : | print STDERR ( "Can't open ${templateDirectory}${probSetHeader}\n") if $debugON; | ||
| 444 : | wwerror("$0", "\n######## Could not open the set header file: ${templateDirectory}${probSetHeader}","",""); | ||
| 445 : | } | ||
| 446 : | |||
| 447 : | |||
| 448 : | # Print problems | ||
| 449 : | my @problems = sort {$a <=> $b } &getAllProblemsForProbSetRecord($psvn); | ||
| 450 : | my @refSubmittedAnswers = (); | ||
| 451 : | # print "content-type: text/plain\n\nproblems @problems"; | ||
| 452 : | |||
| 453 : | my $probNum; | ||
| 454 : | foreach $probNum (@problems) { | ||
| 455 : | my $source; | ||
| 456 : | my $probFileName = &getProblemFileName($probNum,$psvn); | ||
| 457 : | if (-e "${templateDirectory}$probFileName" ) { | ||
| 458 : | unless (-r "${templateDirectory}$probFileName") { | ||
| 459 : | wwerror($0, "Can't read ${templateDirectory}$probFileName"); | ||
| 460 : | } | ||
| 461 : | open(PROB,"<${templateDirectory}$probFileName"); | ||
| 462 : | $source = join("",<PROB>); | ||
| 463 : | close(PROB); | ||
| 464 : | } | ||
| 465 : | local($^W) =0; ##########CHANGE THIS BACK!!!! | ||
| 466 : | my %envir=defineProblemEnvir('TeX',$probNum,$psvn,$Course,undef()); | ||
| 467 : | my ($PG_PROBLEM_TEXT_REF, $PG_HEADER_TEXT_REF, $PG_ANSWER_HASH_REF, $PG_FLAGS_REF,$PG_EVALUATED_ANSWERS_REF); | ||
| 468 : | # | ||
| 469 : | my $pt = new PGtranslator; #pt stands for problem translator; | ||
| 470 : | $pt->environment(\%envir) ; | ||
| 471 : | $pt->initialize(); | ||
| 472 : | $pt-> set_mask(); | ||
| 473 : | $pt->source_string($source); | ||
| 474 : | $pt -> unrestricted_load("${courseScriptsDirectory}PG.pl"); | ||
| 475 : | $pt -> unrestricted_load("${courseScriptsDirectory}dangerousMacros.pl"); | ||
| 476 : | $pt ->translate(); | ||
| 477 : | |||
| 478 : | $PG_PROBLEM_TEXT_REF = $pt->ra_text(); | ||
| 479 : | $PG_HEADER_TEXT_REF = $pt->r_header;#\$PG_HEADER_TEXT; | ||
| 480 : | |||
| 481 : | # $PG_ANSWER_HASH_REF = $pt->rh_correct_answers; | ||
| 482 : | $PG_EVALUATED_ANSWERS_REF = $pt->process_answers; | ||
| 483 : | $PG_FLAGS_REF = $pt ->rh_flags; | ||
| 484 : | |||
| 485 : | |||
| 486 : | sh002i | 115 | # print OUTPUT @{$PG_PROBLEM_TEXT_REF}; |
| 487 : | sam | 2 | $texSource .= join '', @{$PG_PROBLEM_TEXT_REF}; |
| 488 : | |||
| 489 : | if (defined($PG_FLAGS_REF->{'error_flag'}) and $PG_FLAGS_REF->{'error_flag'} ==1) { | ||
| 490 : | push(@PG_COMPILE_ERRORS, qq{<A HREF="#problem$probNum">$probNum</A>} ); | ||
| 491 : | } | ||
| 492 : | if ($displayCorrectAnswersQ) { | ||
| 493 : | my %correctAnswerHash = (); | ||
| 494 : | |||
| 495 : | gage | 6 | |
| 496 : | sam | 2 | my @correctAnswerList = (); |
| 497 : | |||
| 498 : | my %submittedAnswerHash = (); | ||
| 499 : | if ( ref($PG_EVALUATED_ANSWERS_REF) eq 'HASH' ) { | ||
| 500 : | %correctAnswerHash = %$PG_EVALUATED_ANSWERS_REF; | ||
| 501 : | } else { | ||
| 502 : | warn "ERROR: Please pass the PG answer list as a hash not a list."; | ||
| 503 : | } | ||
| 504 : | |||
| 505 : | # insert answers (if any) | ||
| 506 : | |||
| 507 : | if ( %correctAnswerHash ) { | ||
| 508 : | $texSource .= "Correct Answers:\\par\\begin{itemize}\n"; | ||
| 509 : | my ($correctFlag,$normalizedCorrectAnswer, | ||
| 510 : | $normalizedSubmittedAnswer, | ||
| 511 : | $answerMessage) = (); | ||
| 512 : | # determine the correct order for the answers | ||
| 513 : | my @answer_entry_order = ( defined($pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}) ) ? | ||
| 514 : | @{$pt->{PG_FLAGS_REF}->{ANSWER_ENTRY_ORDER}} : keys %{$pt->rh_evaluated_answers} ; | ||
| 515 : | |||
| 516 : | foreach my $ky (@answer_entry_order) { | ||
| 517 : | |||
| 518 : | $normalizedCorrectAnswer = $correctAnswerHash{$ky}->{correct_ans}; | ||
| 519 : | $normalizedCorrectAnswer =~ s/\^/\\\^\{\}/g; | ||
| 520 : | $normalizedCorrectAnswer =~ s/\_/\\\_/g; | ||
| 521 : | $texSource .= "\\item $normalizedCorrectAnswer\n"; | ||
| 522 : | |||
| 523 : | } | ||
| 524 : | |||
| 525 : | $texSource .= "\\end{itemize} \\par\n"; | ||
| 526 : | } | ||
| 527 : | } | ||
| 528 : | |||
| 529 : | |||
| 530 : | } | ||
| 531 : | |||
| 532 : | # print Tex postamble | ||
| 533 : | # print OUTPUT &texInput($Global::TEX_SET_FOOTER); | ||
| 534 : | $texSource .= &texInput($Global::TEX_SET_FOOTER); | ||
| 535 : | |||
| 536 : | return \$texSource, \@PG_COMPILE_ERRORS; | ||
| 537 : | } | ||
| 538 : | |||
| 539 : | ################### END main routine ################################## | ||
| 540 : | |||
| 541 : | sh002i | 115 | sub downloadAllSets { |
| 542 : | system("/usr/bin/renice +$main::CLASS_DOWNLOAD_NICE -p $$ 1>/dev/null") && warn "Could not renice process. pid $$"; | ||
| 543 : | alarm( $main::CLASS_DOWNLOAD_TIME_OUT_CONSTANT); | ||
| 544 : | |||
| 545 : | my $downloadMulti = "unknown"; | ||
| 546 : | $downloadMulti = "multistudent" if $action eq "Get_all_copies"; | ||
| 547 : | $downloadMulti = "multiset" if $action eq "Get_hard_copy"; | ||
| 548 : | |||
| 549 : | my @psvns_to_download = $query->param('local_psvns'); | ||
| 550 : | my $num_psvns_to_download = @psvns_to_download; | ||
| 551 : | my $max_psvns_to_download = $Global::max_num_of_ps_downloads_allowed; | ||
| 552 : | |||
| 553 : | if($num_psvns_to_download > 1 and $permissions != $Global::instructor_permissions) { | ||
| 554 : | wwerror("Non-professors are not permitted to download more than one problem set at a time."); | ||
| 555 : | } | ||
| 556 : | |||
| 557 : | if(@psvns_to_download > $Global::max_num_of_ps_downloads_allowed) { | ||
| 558 : | my $tooManyWhat = $downloadMulti eq "multiset" ? "problem sets" : "students"; | ||
| 559 : | wwerror("Too many $tooManyWhat are selected for download.", | ||
| 560 : | "The maximum number of $tooManyWhat which can be downloaded at one time is $Global::max_num_of_ps_downloads_allowed." | ||
| 561 : | ." You selected $num_psvns_to_download. Go back and select fewer $tooManyWhat." | ||
| 562 : | ." (This maximun is set by the variable \$max_num_of_ps_downloads_allowed in Global.pm.)"); | ||
| 563 : | } | ||
| 564 : | |||
| 565 : | my ($cumulativeTexSource, $currentTexSourceRef, $currentTexSource, $currentTexErrorRef); | ||
| 566 : | |||
| 567 : | # this could be used when eliminating pre-foreach createTexSourceHandleErrors call | ||
| 568 : | # s/\\end\{document\}.*?\\begin\{document\}/\n\\newpage\n/s; | ||
| 569 : | |||
| 570 : | sh002i | 116 | $tempTexFileBaseName = "${tempDirectory}Temp_downloadAllSets_$User"; |
| 571 : | sh002i | 115 | my $first_psvn = $psvns_to_download[0]; |
| 572 : | |||
| 573 : | my $current_psvn = shift @psvns_to_download; | ||
| 574 : | ($currentTexSourceRef, $currentTexErrorRef) = createTexSource($current_psvn); | ||
| 575 : | @psvns_to_download = () if(@$currentTexErrorRef); | ||
| 576 : | $currentTexSource = $$currentTexSourceRef; | ||
| 577 : | $currentTexSource =~ s|\\end\{document\}\s$|\n|s; | ||
| 578 : | $cumulativeTexSource .= $currentTexSource; | ||
| 579 : | |||
| 580 : | foreach $current_psvn (@psvns_to_download) { | ||
| 581 : | ($currentTexSourceRef, $currentTexErrorRef) = createTexSource($current_psvn); | ||
| 582 : | @psvns_to_download = () if(@$currentTexErrorRef); | ||
| 583 : | $currentTexSource = $$currentTexSourceRef; | ||
| 584 : | $currentTexSource =~ s|^.*?\\begin\{document\}|\n\\newpage\n|s; | ||
| 585 : | $currentTexSource =~ s|\\end\{document\}\s$|\n|s; | ||
| 586 : | $cumulativeTexSource .= $currentTexSource; | ||
| 587 : | } | ||
| 588 : | |||
| 589 : | $cumulativeTexSource .= "\n\\end{document}\n"; | ||
| 590 : | |||
| 591 : | open TEXOUTPUT, ">$tempTexFileBaseName.tex" | ||
| 592 : | or wwerror("Can't open $tempTexFileBaseName.tex for output."); | ||
| 593 : | print TEXOUTPUT $cumulativeTexSource; | ||
| 594 : | close TEXOUTPUT; | ||
| 595 : | |||
| 596 : | if(@$currentTexErrorRef) { | ||
| 597 : | PG_error_print($tempTexFileBaseName, $current_psvn, @$currentTexErrorRef); | ||
| 598 : | } else { | ||
| 599 : | $downloadType = lc $downloadType; | ||
| 600 : | my $mimeType = prepareHardcopy($tempTexFileBaseName, $downloadType); | ||
| 601 : | |||
| 602 : | my ($setName, $userName); | ||
| 603 : | &attachProbSetRecord($first_psvn); | ||
| 604 : | if($downloadMulti eq "multistudent") { | ||
| 605 : | if($num_psvns_to_download == 1) { | ||
| 606 : | $setName = getSetNumber($first_psvn); | ||
| 607 : | $userName = getStudentLogin($first_psvn); | ||
| 608 : | } else { | ||
| 609 : | $setName = getSetNumber($first_psvn); | ||
| 610 : | $userName = "multistudent"; | ||
| 611 : | } | ||
| 612 : | } elsif($downloadMulti eq "multiset") { | ||
| 613 : | if($num_psvns_to_download == 1) { | ||
| 614 : | $setName = getSetNumber($first_psvn); | ||
| 615 : | $userName = getStudentLogin($first_psvn); | ||
| 616 : | } else { | ||
| 617 : | $setName = "multiset"; | ||
| 618 : | $userName = getStudentLogin($first_psvn); | ||
| 619 : | } | ||
| 620 : | } | ||
| 621 : | my $hardCopyName = "$Course.$userName.$setName.$downloadType"; | ||
| 622 : | |||
| 623 : | open(TEXINPUT, "$tempTexFileBaseName.$downloadType") | ||
| 624 : | or wwerror($0, "Can't open $tempTexFileBaseName.$downloadType: $!\n"); | ||
| 625 : | print "Content-type: $mimeType\n"; | ||
| 626 : | print "Content-disposition: attachment; filename=\"$hardCopyName\"\n\n"; | ||
| 627 : | print while (<TEXINPUT>); | ||
| 628 : | close TEXINPUT; | ||
| 629 : | } | ||
| 630 : | } | ||
| 631 : | sam | 2 | |
| 632 : | sh002i | 115 | sub prepareHardcopy |
| 633 : | { | ||
| 634 : | my ($texFileBaseName, $targetFormat) = @_; | ||
| 635 : | my $mimeType; | ||
| 636 : | |||
| 637 : | chdir $tempDirectory; | ||
| 638 : | |||
| 639 : | sh002i | 116 | my $dviCommandLine = "$Global::externalLatexPath $texFileBaseName.tex >/dev/null 2>/dev/null"; |
| 640 : | sh002i | 115 | my $psCommandLine = "$Global::externalDvipsPath -o $texFileBaseName.ps $texFileBaseName.dvi >/dev/null 2>/dev/null"; |
| 641 : | my $pdfCommandLine = "$Global::externalPs2pdfPath $texFileBaseName.ps $texFileBaseName.pdf"; | ||
| 642 : | |||
| 643 : | if($targetFormat eq "pdf") { | ||
| 644 : | sh002i | 116 | system($dviCommandLine); -e "$texFileBaseName.dvi" or die "dvi generation failed."; |
| 645 : | system($psCommandLine); -e "$texFileBaseName.ps" or die "ps generation failed."; | ||
| 646 : | system($pdfCommandLine); -e "$texFileBaseName.pdf" or die "pdf generation failed."; | ||
| 647 : | sh002i | 115 | $mimeType = "application/pdf"; |
| 648 : | } elsif($targetFormat eq "ps") { | ||
| 649 : | sh002i | 116 | system($dviCommandLine); -e "$texFileBaseName.dvi" or die "dvi generation failed."; |
| 650 : | system($psCommandLine); -e "$texFileBaseName.ps" or die "ps generation failed."; | ||
| 651 : | sh002i | 115 | $mimeType = "application/postscript"; |
| 652 : | } elsif($targetFormat eq "dvi") { | ||
| 653 : | sh002i | 116 | system($dviCommandLine); -e "$texFileBaseName.dvi" or die "dvi generation failed."; |
| 654 : | sh002i | 115 | $mimeType = "application/x-dvi"; |
| 655 : | } elsif($targetFormat eq "tex") { | ||
| 656 : | $mimeType = "application/tex"; | ||
| 657 : | } else { | ||
| 658 : | die "unrecognized format: $targetFormat"; | ||
| 659 : | } | ||
| 660 : | |||
| 661 : | return $mimeType; | ||
| 662 : | } | ||
| 663 : | sam | 2 | |
| 664 : | sh002i | 115 | sub PG_error_print |
| 665 : | { | ||
| 666 : | my ($tempTexFileBaseName, $current_psvn, @errors) = @_; | ||
| 667 : | |||
| 668 : | # get set name and student name from psvn | ||
| 669 : | &attachProbSetRecord($current_psvn); | ||
| 670 : | my $userName = &getStudentLogin($current_psvn); | ||
| 671 : | my $setName = &getSetNumber($current_psvn); | ||
| 672 : | |||
| 673 : | # print error page header | ||
| 674 : | print &htmlTOP("PG compile error"); | ||
| 675 : | print "<H3>PG error while compiling problem number", (@errors>1) ? 's ' : ' ', | ||
| 676 : | join(', ', @errors), " in problem set $setName for $userName.</H3>"; | ||
| 677 : | print "<h3>TeX source file:</h3>"; | ||
| 678 : | |||
| 679 : | # open temp tex file | ||
| 680 : | if(open TEXINPUT, "$tempTexFileBaseName.tex") { | ||
| 681 : | print "<pre>\n"; | ||
| 682 : | my $lineNumber = 1; | ||
| 683 : | while(<TEXINPUT>) { | ||
| 684 : | if(/<A NAME/) { print $_; } | ||
| 685 : | else { print protect_HTML("$lineNumber $_"), "\n"; } | ||
| 686 : | $lineNumber++; | ||
| 687 : | } | ||
| 688 : | print "</pre>\n"; | ||
| 689 : | close TEXINPUT; | ||
| 690 : | } else { | ||
| 691 : | print "<p>Unable to open TeX source file:<br><tt>$tempTexFileBaseName.tex</tt></p>"; | ||
| 692 : | } | ||
| 693 : | |||
| 694 : | # print page footer | ||
| 695 : | print &htmlBOTTOM("welcomeAction.pl", \%inputs); | ||
| 696 : | exit; | ||
| 697 : | } | ||
| 698 : | sam | 2 | |
| 699 : | sh002i | 115 | # ----- |
| 700 : | |||
| 701 : | sam | 2 | sub logPrint { |
| 702 : | print &htmlTOP("TeX Error or error in creating PostScript file"); | ||
| 703 : | open (LOGFILE, " $tempDirectory$texFile$psvn.log") | ||
| 704 : | || print "<H3>Can't open log file:</H3> path= $tempDirectory$texFile$psvn.log<BR>$!<BR><BR>" ; | ||
| 705 : | |||
| 706 : | |||
| 707 : | print "<H3>TeX Error Log:</H3>"; | ||
| 708 : | my $print_error_switch = ($debugON) ? 1: 0; | ||
| 709 : | my $out=''; | ||
| 710 : | #warn ord $/, ord "\n", ord "\r"; | ||
| 711 : | #warn "length of separator = ", length($/); | ||
| 712 : | $/ = "\n"; | ||
| 713 : | #warn ord $/, ord "\n", ord "\r"; | ||
| 714 : | while (<LOGFILE>) { | ||
| 715 : | $out = $_; | ||
| 716 : | $print_error_switch = 1 if $out =~ /^!/; # after a fatal error start printing messages | ||
| 717 : | print protect_HTML($out)."<BR>\n" if $print_error_switch; | ||
| 718 : | } | ||
| 719 : | close(LOGFILE); | ||
| 720 : | |||
| 721 : | open (TEXFILE, "${tempDirectory}${texFile}${psvn}.tex") | ||
| 722 : | || print "<H3>Can't open tex source file:</H3> path= ${tempDirectory}${texFile}${psvn}.tex:<BR> $!<BR><BR>\n"; | ||
| 723 : | print "<BR>\n<H3>TeX Source File:</H3><BR>\n"; | ||
| 724 : | print "<PRE>"; | ||
| 725 : | |||
| 726 : | my $lineNumber = 1; | ||
| 727 : | while (<TEXFILE>) { | ||
| 728 : | print protect_HTML("$lineNumber $_")."\n"; | ||
| 729 : | $lineNumber++; | ||
| 730 : | } | ||
| 731 : | close(TEXFILE); | ||
| 732 : | print "</PRE>"; | ||
| 733 : | print &htmlBOTTOM("downloadPS.pl", \%inputs); | ||
| 734 : | } | ||
| 735 : | sub protect_HTML { | ||
| 736 : | my $line = shift; | ||
| 737 : | chomp($line); | ||
| 738 : | $line =~s/\&/&/g; | ||
| 739 : | $line =~s/</</g; | ||
| 740 : | $line =~s/>/>/g; | ||
| 741 : | $line; | ||
| 742 : | } | ||
| 743 : | sub selectionError { | ||
| 744 : | print &htmlTOP("Selection error"); | ||
| 745 : | print"<H2>Error:</H2> You must first select a problem set in order to download a hard copy!\n"; | ||
| 746 : | print "<FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P>"; | ||
| 747 : | print &sessionKeyInputs(\%inputs); | ||
| 748 : | print <<"ENDOFHTML"; | ||
| 749 : | <INPUT TYPE=SUBMIT VALUE="Return to Welcome Page"> | ||
| 750 : | </FORM> | ||
| 751 : | ENDOFHTML | ||
| 752 : | print &htmlBOTTOM("welcomeAction.pl", \%inputs); | ||
| 753 : | } | ||
| 754 : | |||
| 755 : | sub probSet_htmlTOP { | ||
| 756 : | my ($title, $bg_url) = @_; | ||
| 757 : | my $background_url = $bg_url || $Global::background_plain_url; | ||
| 758 : | |||
| 759 : | |||
| 760 : | my $out = <<ENDhtmlTOP; | ||
| 761 : | content-type: text/html | ||
| 762 : | Expires: 0 | ||
| 763 : | |||
| 764 : | <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> | ||
| 765 : | <HTML> | ||
| 766 : | <HEAD> | ||
| 767 : | <TITLE>$title</TITLE> | ||
| 768 : | </HEAD> | ||
| 769 : | <BODY BACKGROUND="$background_url"><p> | ||
| 770 : | <P> | ||
| 771 : | |||
| 772 : | ENDhtmlTOP | ||
| 773 : | $out; | ||
| 774 : | } | ||
| 775 : | |||
| 776 : | sub probSet_titleBar { | ||
| 777 : | my ($title) = @_; | ||
| 778 : | my $title_bar = ""; | ||
| 779 : | $title_bar .= qq{ | ||
| 780 : | <TABLE BORDER="0" WIDTH="100%"> | ||
| 781 : | <TR ALIGN=CENTER > | ||
| 782 : | <TD ALIGN=LEFT > | ||
| 783 : | <A HREF="$Global::webworkDocsURL"> | ||
| 784 : | <IMG SRC="$Global::squareWebworkGif" BORDER=1 ALT="WeBWorK"></A> | ||
| 785 : | </TD> | ||
| 786 : | <TD VALIGN=MIDDLE> | ||
| 787 : | <H2 ALIGN=CENTER> | ||
| 788 : | $title | ||
| 789 : | </H2> | ||
| 790 : | </TD> | ||
| 791 : | <TD ALIGN=RIGHT > | ||
| 792 : | <FORM METHOD=POST ACTION=\"${Global::cgiWebworkURL}welcome.pl\"><P> | ||
| 793 : | }; | ||
| 794 : | my $inputkeys = &sessionKeyInputs(\%inputs); | ||
| 795 : | |||
| 796 : | $title_bar .= qq{ | ||
| 797 : | $inputkeys | ||
| 798 : | <INPUT TYPE=HIDDEN NAME=\"probSetKey\" VALUE=$psvn> | ||
| 799 : | <INPUT TYPE=SUBMIT VALUE=\"Problem Sets\"> | ||
| 800 : | </FORM> | ||
| 801 : | </TD> | ||
| 802 : | </TABLE> | ||
| 803 : | }; | ||
| 804 : | $title_bar; | ||
| 805 : | } | ||
| 806 : | |||
| 807 : | sub hackerError { ## prints hacker error message | ||
| 808 : | |||
| 809 : | my $msg = "Attempt to hack into WeBWorK \n Remote Host is: ". remote_host()."\n"; | ||
| 810 : | $msg .= query_string; | ||
| 811 : | &Global::log_error('hacker error', $msg); ## log attempt | ||
| 812 : | |||
| 813 : | ## notify by email | ||
| 814 : | |||
| 815 : | my $toAdd = $Global::feedbackAddress; | ||
| 816 : | |||
| 817 : | my $emailMsg = "To: $toAdd | ||
| 818 : | Subject: Attempt to hack into WeBWorK | ||
| 819 : | |||
| 820 : | Here are the details on the attempt to hack into weBWorK:\n | ||
| 821 : | $msg | ||
| 822 : | \n"; | ||
| 823 : | |||
| 824 : | my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>20); | ||
| 825 : | $smtp->mail($Global::webmaster); | ||
| 826 : | $smtp->recipient($Global::feedbackAddress); | ||
| 827 : | $smtp->data($msg); | ||
| 828 : | $smtp->quit; | ||
| 829 : | |||
| 830 : | |||
| 831 : | # my $SENDMAIL = $Global::SENDMAIL; | ||
| 832 : | # open (MAIL,"|$SENDMAIL"); | ||
| 833 : | # print MAIL "$emailMsg"; | ||
| 834 : | # close (MAIL); | ||
| 835 : | |||
| 836 : | print &htmlTOP("Hacker Error"), | ||
| 837 : | "<H2>Error:Please do not try to hack into WeBWorK!</H2>", | ||
| 838 : | startform(-action=>"${Global::cgiWebworkURL}${Global::welcomeAction_CGI}"), | ||
| 839 : | "<p>", | ||
| 840 : | &sessionKeyInputs(\%inputs), | ||
| 841 : | hidden(-name=>'local_psvns', -value=>$psvn), | ||
| 842 : | hidden(-name=>'action', -value=>'Do_problem_set'), | ||
| 843 : | submit(-value=>"Return to Problem Set"), | ||
| 844 : | endform(), | ||
| 845 : | &htmlBOTTOM($0, \%inputs); | ||
| 846 : | } | ||
| 847 : | |||
| 848 : | sub defineProblemEnvir { | ||
| 849 : | my ($mode,$probNum,$psvn,$courseName,$refSubmittedAnswers) = @_; | ||
| 850 : | my %envir=(); | ||
| 851 : | gage | 6 | my $loginName = &getStudentLogin($psvn); |
| 852 : | sam | 2 | ##how to put an array submittedAnswers in a hash?? |
| 853 : | $envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers); | ||
| 854 : | $envir{'psvnNumber'} = $psvn; | ||
| 855 : | $envir{'psvn'} = $psvn; | ||
| 856 : | gage | 6 | $envir{'studentName'} = &CL_getStudentName($loginName); |
| 857 : | $envir{'studentLogin'} = $loginName; | ||
| 858 : | $envir{'sectionName'} = &CL_getClassSection($loginName); | ||
| 859 : | $envir{'sectionNumber'} = &CL_getClassSection($loginName); | ||
| 860 : | $envir{'recitationName'} = &CL_getClassRecitation($loginName); | ||
| 861 : | $envir{'recitationNumber'} = &CL_getClassRecitation($loginName); | ||
| 862 : | sam | 2 | $envir{'setNumber'} = &getSetNumber($psvn); |
| 863 : | $envir{'questionNumber'} = $probNum; | ||
| 864 : | $envir{'probNum'} = $probNum; | ||
| 865 : | $envir{'openDate'} = &getOpenDate($psvn); | ||
| 866 : | $envir{'formatedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn)); | ||
| 867 : | $envir{'formattedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn)); | ||
| 868 : | $envir{'dueDate'} = &getDueDate($psvn); | ||
| 869 : | $envir{'formatedDueDate'} = &formatDateAndTime(&getDueDate($psvn)); | ||
| 870 : | $envir{'formattedDueDate'} = &formatDateAndTime(&getDueDate($psvn)); | ||
| 871 : | $envir{'answerDate'} = &getAnswerDate($psvn); | ||
| 872 : | $envir{'formatedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn)); | ||
| 873 : | $envir{'formattedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn)); | ||
| 874 : | $envir{'problemValue'} = &getProblemValue($probNum,$psvn); | ||
| 875 : | $envir{'fileName'} = &getProblemFileName($probNum,$psvn); | ||
| 876 : | $envir{'probFileName'} = &getProblemFileName($probNum,$psvn); | ||
| 877 : | $envir{'languageMode'} = $mode; | ||
| 878 : | $envir{'displayMode'} = $mode; | ||
| 879 : | $envir{'outputMode'} = $mode; | ||
| 880 : | $envir{'courseName'} = $courseName; | ||
| 881 : | $envir{'sessionKey'} = ( defined($inputs{'key'}) ) ?$inputs{'key'} : " "; | ||
| 882 : | |||
| 883 : | # initialize constants for PGanswermacros.pl | ||
| 884 : | $envir{'numRelPercentTolDefault'} = getNumRelPercentTolDefault(); | ||
| 885 : | $envir{'numZeroLevelDefault'} = getNumZeroLevelDefault(); | ||
| 886 : | $envir{'numZeroLevelTolDefault'} = getNumZeroLevelTolDefault(); | ||
| 887 : | $envir{'numAbsTolDefault'} = getNumAbsTolDefault(); | ||
| 888 : | $envir{'numFormatDefault'} = getNumFormatDefault(); | ||
| 889 : | $envir{'functRelPercentTolDefault'} = getFunctRelPercentTolDefault(); | ||
| 890 : | $envir{'functZeroLevelDefault'} = getFunctZeroLevelDefault(); | ||
| 891 : | $envir{'functZeroLevelTolDefault'} = getFunctZeroLevelTolDefault(); | ||
| 892 : | $envir{'functAbsTolDefault'} = getFunctAbsTolDefault(); | ||
| 893 : | $envir{'functNumOfPoints'} = getFunctNumOfPoints(); | ||
| 894 : | $envir{'functVarDefault'} = getFunctVarDefault(); | ||
| 895 : | $envir{'functLLimitDefault'} = getFunctLLimitDefault(); | ||
| 896 : | $envir{'functULimitDefault'} = getFunctULimitDefault(); | ||
| 897 : | $envir{'functMaxConstantOfIntegration'} = getFunctMaxConstantOfIntegration(); | ||
| 898 : | $envir{'numOfAttempts'} = undef(); # this is defined only for problems | ||
| 899 : | |||
| 900 : | # defining directorys and URLs | ||
| 901 : | $envir{'templateDirectory'} = &getCourseTemplateDirectory(); | ||
| 902 : | $envir{'classDirectory'} = $Global::classDirectory; | ||
| 903 : | $envir{'cgiDirectory'} = $Global::cgiDirectory; | ||
| 904 : | $envir{'macroDirectory'} = getCourseMacroDirectory(); | ||
| 905 : | $envir{'courseScriptsDirectory'} = getCourseScriptsDirectory(); | ||
| 906 : | $envir{'htmlDirectory'} = getCourseHtmlDirectory(); | ||
| 907 : | $envir{'htmlURL'} = getCourseHtmlURL(); | ||
| 908 : | $envir{'tempDirectory'} = getCourseTempDirectory(); | ||
| 909 : | $envir{'tempURL'} = getCourseTempURL(); | ||
| 910 : | $envir{'scriptDirectory'} = $Global::scriptDirectory; | ||
| 911 : | $envir{'webworkDocsURL'} = $Global::webworkDocsURL; | ||
| 912 : | sam | 97 | $envir{'externalTTHPath'} = $Global::externalTTHPath; |
| 913 : | sam | 2 | |
| 914 : | |||
| 915 : | $envir{'inputs_ref'} = \%inputs; | ||
| 916 : | |||
| 917 : | |||
| 918 : | my $seed = &getProblemSeed($probNum, $psvn); | ||
| 919 : | $seed = 1111 unless defined($seed); | ||
| 920 : | $envir{'problemSeed'} = $seed if defined($seed); | ||
| 921 : | |||
| 922 : | # here is a way to pass environment variables defined in webworkCourse.ph | ||
| 923 : | my $k; | ||
| 924 : | foreach $k (keys %Global::PG_environment ) { | ||
| 925 : | $envir{$k} = $Global::PG_environment{$k}; | ||
| 926 : | } | ||
| 927 : | %envir; | ||
| 928 : | } | ||
| 929 : | |||
| 930 : | BEGIN { | ||
| 931 : | |||
| 932 : | |||
| 933 : | # This subroutine cleans up temporary files after the postscript copy has been created. | ||
| 934 : | # | ||
| 935 : | sub cleanup_downloadPS { | ||
| 936 : | |||
| 937 : | gage | 6 | unless (defined($action ) and ($action eq 'Do problem set' or $action eq 'Do_problem_set')) { |
| 938 : | sam | 2 | my $ERRORS = $save_errors; |
| 939 : | unless ($debugON) { #clean up the directory | ||
| 940 : | eval { | ||
| 941 : | chdir $tempDirectory; | ||
| 942 : | sh002i | 115 | unlink( |
| 943 : | "#tempTexFileBaseName.dvi", | ||
| 944 : | "$tempTexFileBaseName.ps", | ||
| 945 : | "$tempTexFileBaseName.pdf", | ||
| 946 : | "$tempTexFileBaseName.log", | ||
| 947 : | "$tempTexFileBaseName.aux", | ||
| 948 : | "$tempTexFileBaseName.tex" | ||
| 949 : | ); | ||
| 950 : | sam | 2 | unlink("${tempDirectory}eps/${login_name_for_psvn}*.eps"); |
| 951 : | }; # clean up | ||
| 952 : | $ERRORS .= $ERRORS . $@; | ||
| 953 : | } | ||
| 954 : | my $query = query_string(); | ||
| 955 : | $query = "" unless defined($query); | ||
| 956 : | wwerror("$0", "ERROR: in downloadPS subroutine of welcomeAction.pl $ERRORS","","",$query) if $ERRORS; | ||
| 957 : | } | ||
| 958 : | } | ||
| 959 : | } | ||
| 960 : | |||
| 961 : | END { | ||
| 962 : | if (defined($main::SIG_TIME_OUT) && $main::SIG_TIME_OUT == 1) { | ||
| 963 : | alarm(0); # turn off the alarm | ||
| 964 : | my $hard_copy_message = qq{Content-type: text/html\n\n | ||
| 965 : | <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> | ||
| 966 : | <HTML><BODY BGCOLOR = "FF99CC"> | ||
| 967 : | <BLOCKQUOTE><H3>WeBWorK hard copy download time out.</H3>\n | ||
| 968 : | <H4>This download was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.</H4> This may be because the | ||
| 969 : | WeBWorK server is extraordinarily busy, or because there was an error in the problem, | ||
| 970 : | or because you tried to download a set with too many problems (more than 50).<P>\n | ||
| 971 : | Use the back button to return to the previous page and try again.<BR>\n | ||
| 972 : | If the problem is repeated you can report this to your instructor using the feedback button. | ||
| 973 : | <P> | ||
| 974 : | Because the WeBWorK server at the Unversity of Rochester is experiencing heavy use we have made downloading | ||
| 975 : | hard copies a low priority during the times of very heavy useage. It will be helpful if you | ||
| 976 : | download hard copies during times when the load is not too heavy. | ||
| 977 : | <P> | ||
| 978 : | The load is usually heaviest in the evenings , particularly a few hours before assignments | ||
| 979 : | are due. The best times to download hard copies are in the morning and afternoon | ||
| 980 : | -- or an hour after the due date and time of the previous assignment -- nobody is using the system then :-) | ||
| 981 : | </BLOCKQUOTE></BODY></HTML> | ||
| 982 : | }; | ||
| 983 : | my $do_problem_message = qq{Content-type: text/html\n\n | ||
| 984 : | <!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.0//EN" "http://www.w3.org/TR/REC-html40/strict.dtd"> | ||
| 985 : | <HTML><BODY BGCOLOR = "FF99CC"> | ||
| 986 : | <BLOCKQUOTE><H3>WeBWorK heavy useage time out.</H3>\n | ||
| 987 : | <H4>Your request (action = $action) was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.</H4> | ||
| 988 : | This is probably because the | ||
| 989 : | WeBWorK server is extraordinarily busy.<P>\n | ||
| 990 : | You should be warned that WeBWorK response will be unusually slow. If possible you should try | ||
| 991 : | to use WeBWorK at another time when the load is not as high. The highest useage periods are in the | ||
| 992 : | evening, particularly in the two hours before assignments are due.<P>\n | ||
| 993 : | Use the back button to return to the previous page and try again.<P>\n | ||
| 994 : | If the high useage problem continues you can report this to your instructor using the feedback button. | ||
| 995 : | <P> | ||
| 996 : | |||
| 997 : | </BLOCKQUOTE></BODY></HTML> | ||
| 998 : | }; | ||
| 999 : | gage | 6 | if ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') { |
| 1000 : | sam | 2 | print $hard_copy_message; |
| 1001 : | } else{ | ||
| 1002 : | print $do_problem_message; | ||
| 1003 : | } | ||
| 1004 : | |||
| 1005 : | |||
| 1006 : | } | ||
| 1007 : | |||
| 1008 : | # begin Timing code | ||
| 1009 : | if( $main::logTimingData == 1 ) { | ||
| 1010 : | my $endTime = new Benchmark; | ||
| 1011 : | my $error_str=''; | ||
| 1012 : | |||
| 1013 : | if ($main::SIGPIPE) { | ||
| 1014 : | $error_str = 'broken PIPE--'; | ||
| 1015 : | } | ||
| 1016 : | elsif ($main::SIG_TIME_OUT) { | ||
| 1017 : | $error_str = "TIME_OUT after $main::TIME_OUT_CONSTANT secs --"; | ||
| 1018 : | } | ||
| 1019 : | gage | 6 | elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') { |
| 1020 : | sam | 2 | $error_str = 'successful download -- '; |
| 1021 : | } | ||
| 1022 : | |||
| 1023 : | &Global::logTimingInfo($main::beginTime,$endTime,$error_str.'welcomeAction.pl',$Course,$User); | ||
| 1024 : | } | ||
| 1025 : | # end Timing code | ||
| 1026 : | cleanup_downloadPS(); | ||
| 1027 : | } | ||
| 1028 : | |||
| 1029 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |