#!/usr/local/bin/perl ################################################################ # Copyright @1995-1999 by Michael E. Gage, Arnold K. Pizer and # WeBWorK at the University of Rochester. All rights reserved. ################################################################ my $debugON=0; ## set this to 1 to save debugging information for errors in hardcopy output use lib '.'; use webworkInit; # WeBWorKInitLine require 5.001; $/ ="\n"; use strict; use Global; use Auth; use CGI qw(:standard); use Net::SMTP; use Safe; use PGtranslator; #use sigtrap; BEGIN { # set to 1 to enable timing_log # (contains information about time taken by scripts to run) $main::logTimingData = 0; # begin Timing code if( $main::logTimingData == 1 ) { use Benchmark; $main::beginTime = new Benchmark; } # end Timing code # ## Setting these time out comstants to zeros removes the time constraint completely. (zero = infinity :=) ) $main::TIME_OUT_CONSTANT = 60; # one minute wait for on screen problems $main::DOWNLOAD_TIME_OUT_CONSTANT = 300; # give it five minutes $main::CLASS_DOWNLOAD_TIME_OUT_CONSTANT = 1200; #twenty minutes $main::DOWNLOAD_NICE = 2; $main::CLASS_DOWNLOAD_NICE = 5; # higher numbers indicated lower priorities # ## ATTENTION: The handlers PG_floating_point_exception_handler and PG_warnings_handler # ## have to be installed after CGI::Carp is called since it also # ## modifes the die and warn labels. Finding the right warning mechanism using these two # ## methods bears further investigation # ## They are defined in Global.pm $SIG{'FPE'} = \&PG_floating_point_exception_handler; $SIG{__WARN__}=\&PG_warnings_handler; $SIG{'TERM'} = sub {die '[',scalar(localtime),"] Caught a SIGTERM, Error: $! stopped at $0\n"; }; $SIG{'PIPE'} = sub {$main::SIGPIPE = 1, die '[',scalar(localtime),"] Caught a SIGPIPE, Error: $! stopped at $0\n"; }; $SIG{ALRM} = sub { $main::SIG_TIME_OUT = 1; exit(0) }; alarm($main::TIME_OUT_CONSTANT); # By explicitly catching the signals and dieing one forces the execution of the END statements which clean up the files. # }; use vars qw ($modules_to_evaluate $extra_packages_to_be_loaded ); &CGI::ReadParse; my %inputs=%main::in; my $query = $main::in{CGI}; # verify that the rest of the information has been received my $Course = $inputs{'course'}; my $User = $inputs{'user'}; #my $psvn = $inputs{'probSetKey'}; my @local_psvns = $query -> param('local_psvns'); my $psvn = $local_psvns[0]; ## get the first one for doing problem sets $inputs{'probSetKey'} = $psvn; ## only used by htmlBOTTOM my $Session_key = $inputs{'key'}; &Global::getCourseEnvironment($Course); my $scriptDirectory = getWebworkScriptDirectory(); #$Global::scriptDirectory; my $databaseDirectory = getCourseDatabaseDirectory(); #$Global::databaseDirectory; my $courseScriptsDirectory = getCourseScriptsDirectory(); #$Global::courseScriptsDirectory; my $templateDirectory = getCourseTemplateDirectory(); #$Global::templateDirectory; # this is globally defined for the file, since it is needed for cleanup in END my $tempDirectory = getCourseTempDirectory(); eval{require "${courseScriptsDirectory}$Global::displayMacros_pl";} ; eval{require "${scriptDirectory}$Global::DBglue_pl";}; eval{require "${scriptDirectory}$Global::classlist_DBglue_pl";}; eval{require "${scriptDirectory}$Global::HTMLglue_pl";}; eval{require "${scriptDirectory}$Global::FILE_pl";} ; #################################################################### # load the modules to be used in PGtranslator require "${courseScriptsDirectory}PG_module_list.pl" or wwerror($0, "Can't read ${courseScriptsDirectory}PG_module_list.pl"); #################################################################### my $keyFile = &Global::getCourseKeyFile($Course); my $permissionsFile = &getCoursePermissionsFile($Course); ## check to see if prob set has been selected ## verifyInput(); ############################################## sub verifyInput { if(!defined($psvn) || $psvn eq "") { &selectionError; # The calling script did not specify a problem set. #die "Content-type: text/html\n\nThe calling script did not specify a problem set."; exit(); } } # log access &Global::log_info('', query_string); &verify_key($inputs{'user'}, $Session_key, $keyFile, $Course); my $permissions = &get_permissions($User,$permissionsFile); &attachProbSetRecord($psvn); my $login_name_for_psvn = &getStudentLogin($psvn); attachCLRecord($login_name_for_psvn); my $setNumber=&getSetNumber($psvn); $setNumber = $inputs{'setNo'} if defined $inputs{'setNo'}; ## script called from profChangeDates.pl ###### check to see that it is after the open date my ($currentTime,$odts,$ddts,$remainingTime, $TimeString); $currentTime = time; $odts=&getOpenDate($psvn); $ddts=&getDueDate($psvn); $remainingTime=$ddts-$currentTime; if($currentTime<$odts && $permissions !=$Global::instructor_permissions) { print &htmlTOP("Before open date error"); print "
| Select one of the $numberOfProblems problems to try: ENDOFHTML print " |
ENDOFHTML
## process problem and save @printlines
my $probHeader = $Global::PROB_HEADER; # default value
if ( (defined($probHeaderFileName)) and ($probHeaderFileName =~ /\S/)) {
$probHeader = $probHeaderFileName;
}
## use $probHeader as default unless $probHeaderFileName is defined
## in the set definition file
my $source;
if (-e "${templateDirectory}$probHeader" ) {
unless (-r "${templateDirectory}$probHeader") {
wwerror($0, "Can't read ${templateDirectory}$probHeader");
}
open(PROB,"<${templateDirectory}$probHeader");
$source = join("", |
";
my $lineNumber = 1;
while () {
print protect_HTML("$lineNumber $_")."\n";
$lineNumber++;
}
close(TEXFILE);
print " ";
print &htmlBOTTOM("downloadPS.pl", \%inputs);
}
sub protect_HTML {
my $line = shift;
chomp($line);
$line =~s/\&/&/g;
$line =~s/</g;
$line =~s/>/>/g;
$line;
}
sub PG_error_print {
my @probNums = @_;
open (TEXFILE, "${tempDirectory}${texFile}${psvn}.tex")
|| ! $debugON || print STDERR "Can't open $tempDirectory$texFile$psvn.tex" ;
print &htmlTOP("PG compile error");
print "";
my $lineNumber = 1;
local($/) = "\n";
while () {
if ( $_ =~/^Error: You must first select a problem set in order to download a hard copy!\n";
print "
ENDOFHTML
print &htmlBOTTOM("welcomeAction.pl", \%inputs);
}
sub probSet_htmlTOP {
my ($title, $bg_url) = @_;
my $background_url = $bg_url || $Global::background_plain_url;
my $out = <
$title
ENDhtmlTOP
$out;
}
sub probSet_titleBar {
my ($title) = @_;
my $title_bar = "";
$title_bar .= qq{
$title
};
$title_bar;
}
sub downloadIndividualSet {
system("/usr/bin/renice +$main::DOWNLOAD_NICE -p $$ 1>/dev/null") && warn "Could not renice process. pid $$";
alarm( $main::DOWNLOAD_TIME_OUT_CONSTANT);
my $return_status='';
eval {$return_status = downloadPS($psvn,$texFile)}; ## trap any errors
$save_errors=$@; ## errors will be printed out by END
if ($return_status eq 'errors') {exit;}
elsif ($return_status eq 'no_errors') {
if ($downloadType eq "TeX" ) {
&texPrint;
}
elsif (system( "${scriptDirectory}makePS $tempDirectory $texFile$psvn 1>&2" )) {
&logPrint;
# wwerror("$0", "downloadPS: Error in creating postscript file.
# System command ${scriptDirectory}makePS $tempDirectory $texFile$psvn 1>&2", "", "");
}
else { # tex file has been processed successfully
if ($downloadType eq 'pdf') {&pdfPrint;}
elsif ($downloadType eq 'dvi') {&dviPrint;}
else {&psPrint;}
}
}
else {wwerror($0, "The subroutine downloadPS returned an unknown status");}
}
sub downloadAllSets {
system("/usr/bin/renice +$main::CLASS_DOWNLOAD_NICE -p $$ 1>/dev/null") && warn "Could not renice process. pid $$";
alarm( $main::CLASS_DOWNLOAD_TIME_OUT_CONSTANT);
my $localpsvn; ## psvn numbers for individual students
my $return_status='';
my $texSource ='';
my $individualTexSource ='';
my ($texSourceRef, $errorRef);
my @local_psvns = $query -> param('local_psvns');
my $max = $Global::max_num_of_ps_downloads_allowed;
## make sure non professors can not download more than one set by submitting an altered form
@local_psvns = ($local_psvns[0]) unless $permissions == $Global::instructor_permissions;
my $length = @local_psvns;
if ($length > $max) {
wwerror ("Too many students selected", "The maximun number of sets which can be downloaded at one time is $max. You selected $length.
Go back and select fewer students. This maximun is set by the variable
\$max_num_of_ps_downloads_allowed in Global.pm.");
}
$localpsvn = shift @local_psvns; ## get first set which will contain TeX header info
# attachProbSetRecord($localpsvn);
($texSourceRef, $errorRef) = &createTexSource($localpsvn);
## don't do anything with $errorRef at this time
## only contains prob numbers of bad problems
$texSource = $$texSourceRef; ## contains initial header info
$texSource =~ s|\\end\{document\}\s$|\n|s; ## remove end{document} statement
foreach $localpsvn (@local_psvns) { ## get the rest of the sets and strip TeX header info
# attachProbSetRecord($localpsvn);
($texSourceRef, $errorRef) = &createTexSource($localpsvn);
## don't do anything with $errorRef at this time
## only contains prob numbers of bad problems
$individualTexSource = $$texSourceRef;
$individualTexSource =~ s|^.*?\\begin\{document\}|\n\\newpage\n|s; ## remove header material and start new page
$individualTexSource =~ s|\\end\{document\}\s$|\n|s; ## remove end{document} statement
$texSource .= $individualTexSource;
}
$texSource .= "\n\\end{document}\n"; ## append end{document} statement
$psvn = -1;
$texFile = "set${setNumber}.tempTex-CGIscript";
$login_name_for_psvn = 'all_students';
open(OUTPUT, ">${tempDirectory}${texFile}${psvn}.tex")
|| wwerror("Can't create $tempDirectory${texFile}$psvn.tex\n");
print OUTPUT $texSource;
close OUTPUT;
if ($downloadType eq "TeX" ) {
&texPrint;
}
elsif (system( "${scriptDirectory}makePS $tempDirectory $texFile$psvn 1>&2" )) {
&logPrint;
}
else { # tex file has been processed successfully
if ($downloadType eq 'pdf') {&pdfPrint;}
elsif ($downloadType eq 'dvi') {&dviPrint;}
else {&psPrint;}
}
}
sub hackerError { ## prints hacker error message
my $msg = "Attempt to hack into WeBWorK \n Remote Host is: ". remote_host()."\n";
$msg .= query_string;
&Global::log_error('hacker error', $msg); ## log attempt
## notify by email
my $toAdd = $Global::feedbackAddress;
my $emailMsg = "To: $toAdd
Subject: Attempt to hack into WeBWorK
Here are the details on the attempt to hack into weBWorK:\n
$msg
\n";
my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>20);
$smtp->mail($Global::webmaster);
$smtp->recipient($Global::feedbackAddress);
$smtp->data($msg);
$smtp->quit;
# my $SENDMAIL = $Global::SENDMAIL;
# open (MAIL,"|$SENDMAIL");
# print MAIL "$emailMsg";
# close (MAIL);
print &htmlTOP("Hacker Error"),
"Error:Please do not try to hack into WeBWorK!
",
startform(-action=>"${Global::cgiWebworkURL}${Global::welcomeAction_CGI}"),
"",
&sessionKeyInputs(\%inputs),
hidden(-name=>'local_psvns', -value=>$psvn),
hidden(-name=>'action', -value=>'Do_problem_set'),
submit(-value=>"Return to Problem Set"),
endform(),
&htmlBOTTOM($0, \%inputs);
}
sub defineProblemEnvir {
my ($mode,$probNum,$psvn,$courseName,$refSubmittedAnswers) = @_;
my %envir=();
my $loginName = &getStudentLogin($psvn);
##how to put an array submittedAnswers in a hash??
$envir{'refSubmittedAnswers'} = $refSubmittedAnswers if defined($refSubmittedAnswers);
$envir{'psvnNumber'} = $psvn;
$envir{'psvn'} = $psvn;
$envir{'studentName'} = &CL_getStudentName($loginName);
$envir{'studentLogin'} = $loginName;
$envir{'sectionName'} = &CL_getClassSection($loginName);
$envir{'sectionNumber'} = &CL_getClassSection($loginName);
$envir{'recitationName'} = &CL_getClassRecitation($loginName);
$envir{'recitationNumber'} = &CL_getClassRecitation($loginName);
$envir{'setNumber'} = &getSetNumber($psvn);
$envir{'questionNumber'} = $probNum;
$envir{'probNum'} = $probNum;
$envir{'openDate'} = &getOpenDate($psvn);
$envir{'formatedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn));
$envir{'formattedOpenDate'} = &formatDateAndTime(&getOpenDate($psvn));
$envir{'dueDate'} = &getDueDate($psvn);
$envir{'formatedDueDate'} = &formatDateAndTime(&getDueDate($psvn));
$envir{'formattedDueDate'} = &formatDateAndTime(&getDueDate($psvn));
$envir{'answerDate'} = &getAnswerDate($psvn);
$envir{'formatedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn));
$envir{'formattedAnswerDate'} = &formatDateAndTime(&getAnswerDate($psvn));
$envir{'problemValue'} = &getProblemValue($probNum,$psvn);
$envir{'fileName'} = &getProblemFileName($probNum,$psvn);
$envir{'probFileName'} = &getProblemFileName($probNum,$psvn);
$envir{'languageMode'} = $mode;
$envir{'displayMode'} = $mode;
$envir{'outputMode'} = $mode;
$envir{'courseName'} = $courseName;
$envir{'sessionKey'} = ( defined($inputs{'key'}) ) ?$inputs{'key'} : " ";
# initialize constants for PGanswermacros.pl
$envir{'numRelPercentTolDefault'} = getNumRelPercentTolDefault();
$envir{'numZeroLevelDefault'} = getNumZeroLevelDefault();
$envir{'numZeroLevelTolDefault'} = getNumZeroLevelTolDefault();
$envir{'numAbsTolDefault'} = getNumAbsTolDefault();
$envir{'numFormatDefault'} = getNumFormatDefault();
$envir{'functRelPercentTolDefault'} = getFunctRelPercentTolDefault();
$envir{'functZeroLevelDefault'} = getFunctZeroLevelDefault();
$envir{'functZeroLevelTolDefault'} = getFunctZeroLevelTolDefault();
$envir{'functAbsTolDefault'} = getFunctAbsTolDefault();
$envir{'functNumOfPoints'} = getFunctNumOfPoints();
$envir{'functVarDefault'} = getFunctVarDefault();
$envir{'functLLimitDefault'} = getFunctLLimitDefault();
$envir{'functULimitDefault'} = getFunctULimitDefault();
$envir{'functMaxConstantOfIntegration'} = getFunctMaxConstantOfIntegration();
$envir{'numOfAttempts'} = undef(); # this is defined only for problems
# defining directorys and URLs
$envir{'templateDirectory'} = &getCourseTemplateDirectory();
$envir{'classDirectory'} = $Global::classDirectory;
$envir{'cgiDirectory'} = $Global::cgiDirectory;
$envir{'macroDirectory'} = getCourseMacroDirectory();
$envir{'courseScriptsDirectory'} = getCourseScriptsDirectory();
$envir{'htmlDirectory'} = getCourseHtmlDirectory();
$envir{'htmlURL'} = getCourseHtmlURL();
$envir{'tempDirectory'} = getCourseTempDirectory();
$envir{'tempURL'} = getCourseTempURL();
$envir{'scriptDirectory'} = $Global::scriptDirectory;
$envir{'webworkDocsURL'} = $Global::webworkDocsURL;
$envir{'inputs_ref'} = \%inputs;
my $seed = &getProblemSeed($probNum, $psvn);
$seed = 1111 unless defined($seed);
$envir{'problemSeed'} = $seed if defined($seed);
# here is a way to pass environment variables defined in webworkCourse.ph
my $k;
foreach $k (keys %Global::PG_environment ) {
$envir{$k} = $Global::PG_environment{$k};
}
%envir;
}
BEGIN {
# This subroutine cleans up temporary files after the postscript copy has been created.
#
sub cleanup_downloadPS {
unless (defined($action ) and ($action eq 'Do problem set' or $action eq 'Do_problem_set')) {
my $ERRORS = $save_errors;
unless ($debugON) { #clean up the directory
eval {
chdir $tempDirectory;
unlink("$texFile$psvn.dvi", "$texFile$psvn.ps","$texFile$psvn.pdf",
"$texFile$psvn.log", "$texFile$psvn.aux",
"$texFile$psvn.tex",);
unlink("${tempDirectory}eps/${login_name_for_psvn}*.eps");
}; # clean up
$ERRORS .= $ERRORS . $@;
}
my $query = query_string();
$query = "" unless defined($query);
wwerror("$0", "ERROR: in downloadPS subroutine of welcomeAction.pl $ERRORS","","",$query) if $ERRORS;
}
}
}
END {
if (defined($main::SIG_TIME_OUT) && $main::SIG_TIME_OUT == 1) {
alarm(0); # turn off the alarm
my $hard_copy_message = qq{Content-type: text/html\n\n
WeBWorK hard copy download time out.
\n
This download was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.
This may be because the
WeBWorK server is extraordinarily busy, or because there was an error in the problem,
or because you tried to download a set with too many problems (more than 50).\n
Use the back button to return to the previous page and try again.
\n
If the problem is repeated you can report this to your instructor using the feedback button.
Because the WeBWorK server at the Unversity of Rochester is experiencing heavy use we have made downloading
hard copies a low priority during the times of very heavy useage. It will be helpful if you
download hard copies during times when the load is not too heavy.
The load is usually heaviest in the evenings , particularly a few hours before assignments
are due. The best times to download hard copies are in the morning and afternoon
-- or an hour after the due date and time of the previous assignment -- nobody is using the system then :-)
};
my $do_problem_message = qq{Content-type: text/html\n\n
WeBWorK heavy useage time out.
\n
Your request (action = $action) was cancelled because it took more than $main::TIME_OUT_CONSTANT seconds.
This is probably because the
WeBWorK server is extraordinarily busy.\n
You should be warned that WeBWorK response will be unusually slow. If possible you should try
to use WeBWorK at another time when the load is not as high. The highest useage periods are in the
evening, particularly in the two hours before assignments are due.
\n
Use the back button to return to the previous page and try again.
\n
If the high useage problem continues you can report this to your instructor using the feedback button.
};
if ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') {
print $hard_copy_message;
} else{
print $do_problem_message;
}
}
# begin Timing code
if( $main::logTimingData == 1 ) {
my $endTime = new Benchmark;
my $error_str='';
if ($main::SIGPIPE) {
$error_str = 'broken PIPE--';
}
elsif ($main::SIG_TIME_OUT) {
$error_str = "TIME_OUT after $main::TIME_OUT_CONSTANT secs --";
}
elsif ($action eq 'Get hard copy' or $action eq 'Get_hard_copy') {
$error_str = 'successful download -- ';
}
&Global::logTimingInfo($main::beginTime,$endTime,$error_str.'welcomeAction.pl',$Course,$User);
}
# end Timing code
cleanup_downloadPS();
}
######## DEBUGGING TOOLS
# sub downloadPS_dumpvar {
# my ($packageName) = @_;
#
# local(*alias);
#
#
# *stash = *{"${packageName}::"};
# $, = " ";
#
# print OUTPUT "Content-type: text/html\n\n\n";
#
#
# while ( ($varName, $globValue) = each %stash) {
# print OUTPUT "$varName =================================\n";
#
# *alias = $globValue;
# next if $varName=~/main/;
# next unless $varName =~/::/;
#
# if (defined($alias) ) {
# print OUTPUT "\t \$$varName $alias \n";
# }
#
# if ( defined(@alias) ) {
# print OUTPUT "\t \@$varName @alias \n";
# }
# if (defined(%alias) ) {
# print OUTPUT "\t \%$varName \n";
# foreach $key (keys %alias) {
# print OUTPUT "\t\t $key => $alias{$key}\n";
# }
#
#
# }
# }
#
#
#
# }
1;