Parent Directory
| 
Revision Log
Added some debugging print STDERR statements for checking the initialization of the PGtranslator object. they have been commented out. Except for one announcing the successful completion of intializing an object.
1 #!/usr/local/bin/perl -w 2 use Safe; 3 # Copyright (C) 2001 Michael Gage 4 5 ############################################################################### 6 # The initial code simply initializes variables, defines addresses 7 # for directories, defines some simple subroutines responders used in debugging 8 # and makes sure that the appropriate CPAN library modules 9 # are available. The main code begins below that with the initialization 10 # of the PGtranslator5 module. 11 ############################################################################### 12 package Webwork; 13 14 use strict; 15 use sigtrap; 16 use Carp; 17 18 #BEGIN { 19 # local $^W=0; 20 # require '/usr/local/lib/perl5/5.6.1/Benchmark.pm'; 21 #} 22 print "using the perl version of MIME::Base64\n"; 23 use MIME::Base64 qw( encode_base64 decode_base64); 24 25 26 # These libraries contain files which must at least be available, even though 27 # only Global.pm is actively used. 28 29 use lib "/u/gage/webwork/system/lib/", "/u/gage/webwork/system/courseScripts"; 30 31 ############################################################################### 32 33 34 BEGIN{ 35 my $GLOBAL_INIT = "/u/gage/webwork/system/lib/Global.pm"; 36 print "Opening $GLOBAL_INIT\n"; 37 require $GLOBAL_INIT or die $GLOBAL_INIT; 38 import Global; 39 } 40 41 42 my $PGTRANSLATOR = "/u/gage/xmlrpc/daemon/PGtranslator5.pm"; 43 require $PGTRANSLATOR or die "Can't open $PGTRANSLATOR"; 44 45 46 47 ############################################################################### 48 # List and address of available problemlibraries 49 ############################################################################### 50 51 52 my $libraryPath = '/u/gage/webwork/ww_prob_lib/'; 53 54 my %AVAILABLE_PROBLEM_LIBRARIES = ( ww_prob_lib => '/u/gage/webwork/ww_prob_lib/', 55 indiana_prob_lib => '/u/gage/webwork/Indiana_prob_lib/', 56 capaOK_lib => '/ww/webwork/courses1/capaOK/templates/', 57 capa_lib => '/ww/webwork/courses/capa/templates/', 58 prob_lib_cvs => '/ww/webwork/courses/WW_Prob_Lib_CVS/templates/', 59 maa_100 => '/ww/webwork/courses/maa100/templates/', 60 teitel_physics121 => '/ww/webwork/courses/teitel-phy121/templates/', 61 ); 62 63 ############################################################################### 64 # Configure daemon: 65 ############################################################################### 66 my $courseScriptsDirectory = '/u/gage/webwork/system/courseScripts/'; 67 my $macroDirectory = '/ww/webwork/courses/gage_course/templates/macros/'; 68 my $scriptDirectory = '/u/gage/webwork/system/scripts/'; 69 my $templateDirectory = '/ww/webwork/courses/gage_course/templates/'; 70 71 $Global::courseTempDirectory = '/ww/htdocs/tmp/gage_course/'; 72 $Global::courseTempURL = 'http://webwork-db.math.rochester.edu/tmp/gage_course/'; 73 74 75 $Global::groupID = "webwork"; 76 $Global::numericalGroupID = 1005; 77 78 my $displayMode = 'HTML_tth'; 79 80 my $PG_PL = "${courseScriptsDirectory}PG.pl"; 81 my $DANGEROUS_MACROS_PL = "${courseScriptsDirectory}dangerousMacros.pl"; 82 my @MODULE_LIST = ( "Exporter", "DynaLoader", "GD", "WWPlot", "Fun", 83 "Circle", "Label", "PGrandom", "Units", "Hermite", 84 "List", "Match","Multiple", "Select", "AlgParser", 85 "AnswerHash", "Fraction", "VectorField", "Complex1", 86 "Complex", "MatrixReal1", "Matrix","Distributions", 87 "Regression" 88 ); 89 my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr", 90 "ExprWithImplicitExpand", "AnswerEvaluator", 91 # "AnswerEvaluatorMaker" 92 ); 93 my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT; 94 DOCUMENT(); 95 loadMacros( 96 "PGcomplexmacros.pl", 97 "PGbasicmacro.pl", 98 "PGchoicemacros.pl", 99 "PGanswermacros.pl", 100 "PGnumericalmacros.pl", 101 "PGgraphmacros.pl", 102 "PGauxiliaryFunctions.pl", 103 "PGmatrixmacros.pl", 104 "PGstatisticsmacros.pl" 105 106 ); 107 108 ENDDOCUMENT(); 109 110 END_OF_TEXT 111 112 ############################################################################### 113 # 114 ############################################################################### 115 116 ############################################################################### 117 ############################################################################### 118 119 #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n"; 120 121 122 123 ############################################################################### 124 # The following code initializes an instantiation of PGtranslator5 in the 125 # parent process. This initialized object is then share with each of the 126 # children forked from this parent process by the daemon. 127 # 128 # As far as I can tell, the child processes don't share any variable values even 129 # though their namespaces are the same. 130 ############################################################################### 131 132 133 my $dummy_envir = { courseScriptsDirectory => $courseScriptsDirectory, 134 displayMode => $displayMode, 135 macroDirectory => $macroDirectory}; 136 my $pt = new PGtranslator5; #pt stands for problem translator; 137 $pt ->rh_directories( { courseScriptsDirectory => $courseScriptsDirectory, 138 macroDirectory => $macroDirectory, 139 scriptDirectory => $scriptDirectory , 140 templateDirectory => $templateDirectory, 141 tempDirectory => $Global::courseTempDirectory, 142 } 143 ); 144 $pt -> evaluate_modules( @MODULE_LIST); 145 #print STDERR "Completed loading of modules, now loading extra packages\n"; 146 $pt -> load_extra_packages( @EXTRA_PACKAGES ); 147 #print STDERR "Completed loading of packages, now loading environment\n"; 148 $pt -> environment($dummy_envir); 149 #print STDERR "Completed loading environment, next initialize\n"; 150 $pt->initialize(); 151 #print STDERR "Initialized. \n"; 152 $pt -> unrestricted_load($PG_PL ); 153 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 154 $pt-> set_mask(); 155 # 156 #print STDERR "Unrestricted loads completed.\n"; 157 158 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; 159 $pt->source_string( $INITIAL_MACRO_PACKAGES ); 160 #print STDERR "source strings read in\n"; 161 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter 162 $pt ->translate(); 163 164 print STDERR "New PGtranslator object inititialization completed.\n"; 165 ################################################################################ 166 ## This ends the initialization of the PGtranslator object 167 ################################################################################ 168 169 ############################################################################### 170 # This subroutine is called by the child process. It reinitializes its copy of the 171 # PGtranslator5 object. The unrestricted_load and loadMacros subroutines of PGtranslator5 172 # have been modified so that if &_PG_init is already defined then nothing 173 # is read in but the initialization subroutine is run instead. 174 ############################################################################### 175 176 sub renderProblem { 177 my $rh = shift; 178 my $beginTime = new Benchmark; 179 $Global::WARNINGS = ""; 180 $pt->environment($rh->{envir}); 181 #$pt->{safe_cache} = $safe_cmpt_cache; 182 $pt->initialize(); 183 $pt -> unrestricted_load($PG_PL); 184 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 185 $pt-> set_mask(); 186 187 my $string = decode_base64( $rh ->{source} ); 188 $string =~ tr /\r/\n/; 189 190 $pt->source_string( $string ); 191 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter 192 $pt ->translate(); 193 194 195 # Determine which problem grader to use 196 #$pt->rf_problem_grader($pt->rf_std_problem_grader); #this is the default 197 my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE}; 198 199 if ( defined($problem_grader_to_use) and $problem_grader_to_use ) { # if defined and non-empty 200 if ($problem_grader_to_use eq 'std_problem_grader') { 201 # Reset problem grader to standard problem grader. 202 $pt->rf_problem_grader($pt->rf_std_problem_grader); 203 } elsif ($problem_grader_to_use eq 'avg_problem_grader') { 204 # Reset problem grader to average problem grader. 205 $pt->rf_problem_grader($pt->rf_avg_problem_grader); 206 } elsif (ref($problem_grader_to_use) eq 'CODE') { 207 # Set problem grader to instructor defined problem grader -- use cautiously. 208 $pt->rf_problem_grader($problem_grader_to_use) 209 } else { 210 warn "Error: Could not understand problem grader flag $problem_grader_to_use"; 211 #this is the default set by the translator and used if the flag is not understood 212 #$pt->rf_problem_grader($pt->rf_std_problem_grader); 213 } 214 215 } else {#this is the default set by the translator and used if no flag is set. 216 $pt->rf_problem_grader($pt->rf_std_problem_grader); 217 } 218 219 # creates and stores a hash of answer results: $rh_answer_results 220 $pt -> process_answers($rh->{envir}->{inputs_ref}); 221 222 223 $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score}, 224 num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} , 225 num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans} 226 } ); 227 my %PG_FLAGS = $pt->h_flags; 228 my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ? 229 $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; 230 my $answers_submitted = 0; 231 $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted}; 232 233 my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted, 234 ANSWER_ENTRY_ORDER => $ra_answer_entry_order 235 ); # grades the problem. 236 # protect image data for delivery via XML-RPC. 237 # Don't send code data. 238 my %PG_flag=(); 239 # foreach my $key (keys %PG_FLAGS) { 240 # if ($key eq 'dynamic_images' ) { 241 # foreach my $ikey (keys %{$PG_FLAGS{'dynamic_images'} }) { 242 # $PG_flag{'dynamic_images'}->{$ikey} = 243 # encode_base64($PG_FLAGS{'dynamic_images'}->{$ikey}); 244 # } 245 # } elsif (ref($PG_FLAGS{$key}) eq '' or ref($PG_FLAGS{$key}) =~ /SCALAR|HASH/) { 246 # $PG_flag{$key} = $PG_FLAGS{$key} ; 247 # } 248 # } 249 250 251 my $out = { 252 text => encode_base64( ${$pt ->r_text()} ), 253 header_text => encode_base64( ${ $pt->r_header } ), 254 answers => $pt->rh_evaluated_answers, 255 errors => $pt-> errors(), 256 WARNINGS => encode_base64($Global::WARNINGS ), 257 problem_result => $rh_problem_result, 258 problem_state => $rh_problem_state, 259 PG_flag => \%PG_flag 260 }; 261 my $endTime = new Benchmark; 262 $out->{compute_time} = logTimingInfo($beginTime, $endTime); 263 $out; 264 265 } 266 267 ############################################################################### 268 # This ends the main subroutine executed by the child process in responding to 269 # a request. The other subroutines are auxiliary. 270 ############################################################################### 271 272 273 sub safetyFilter { 274 my $answer = shift; # accepts one answer and checks it 275 my $submittedAnswer = $answer; 276 $answer = '' unless defined $answer; 277 my ($errorno, $answerIsCorrectQ); 278 $answer =~ tr/\000-\037/ /; 279 #### Return if answer field is empty ######## 280 unless ($answer =~ /\S/) { 281 # $errorno = "<BR>No answer was submitted."; 282 $errorno = 0; ## don't report blank answer as error 283 284 return ($answer,$errorno); 285 } 286 ######### replace ^ with ** (for exponentiation) 287 # $answer =~ s/\^/**/g; 288 ######### Return if forbidden characters are found 289 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 290 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; 291 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; 292 293 return ($answer,$errorno); 294 } 295 296 $errorno = 0; 297 return($answer, $errorno); 298 } 299 300 301 sub logTimingInfo{ 302 my ($beginTime,$endTime,) = @_; 303 my $out = ""; 304 $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) ); 305 $out; 306 } 307 308 ############### 309 310 sub echo { 311 my $in= shift; 312 return(ref($in)); 313 } 314 sub hello { 315 print "Receiving request for hello world\n"; 316 return "Hello world"; 317 } 318 sub pretty_print_rh { 319 my $rh = shift; 320 my $out = ""; 321 my $type = ref($rh); 322 if ( ref($rh) =~/HASH/ ) { 323 foreach my $key (sort keys %{$rh}) { 324 $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n"; 325 } 326 } elsif ( ref($rh) =~ /SCALAR/ ) { 327 $out = "scalar reference ". ${$rh}; 328 } elsif ( ref($rh) =~/Base64/ ) { 329 $out .= "base64 reference " .$$rh; 330 } else { 331 $out = $rh; 332 } 333 if (defined($type) ) { 334 $out .= "type = $type \n"; 335 } 336 return $out; 337 } 338 339 #sub xmlquit { 340 # print "exiting daemon\n"; 341 # return ""; 342 #} 343 344 ############################################################################### 345 #OTHER SERVICES 346 ############################################################################### 347 348 my $PASSWORD = 'geometry'; 349 350 use File::stat; 351 sub readFile { 352 my $rh = shift; 353 local($|)=1; 354 my $out = {}; 355 my $filePath = $rh->{filePath}; 356 unless ($rh->{pw} eq $PASSWORD ) { 357 $out->{error}=404; 358 return($out); 359 } 360 if ( defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ) ) { 361 $filePath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} . $filePath; 362 } else { 363 $out->{error} = "Could not find library:".$rh->{library_name}.":"; 364 return($out); 365 } 366 367 if (-r $filePath) { 368 open IN, "<$filePath"; 369 local($/)=undef; 370 my $text = <IN>; 371 $out->{text}= encode_base64($text); 372 my $sb=stat($filePath); 373 $out->{size}=$sb->size; 374 $out->{path}=$filePath; 375 $out->{permissions}=$sb->mode&07777; 376 $out->{modTime}=scalar localtime $sb->mtime; 377 close(IN); 378 } else { 379 $out->{error} = "Could not read file at |$filePath|"; 380 } 381 return($out); 382 } 383 384 385 386 use File::Find; 387 sub listLib { 388 my $rh = shift; 389 my $out = {}; 390 my $dirPath; 391 unless ($rh->{pw} eq $PASSWORD ) { 392 $out->{error}=404; 393 return($out); 394 } 395 396 if ( defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ) ) { 397 $dirPath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ; 398 } else { 399 $out->{error} = "Could not find library:".$rh->{library_name}.":"; 400 return($out); 401 } 402 403 my @outListLib; 404 my $wanted = sub { 405 my $name = $File::Find::name; 406 my @out=(); 407 if ($name =~/\S/ ) { 408 $name =~ s|^$dirPath||o; # cut the first directory 409 push(@outListLib, "$name\n") if $name =~/\.pg/; 410 } 411 }; 412 my $command = $rh->{command}; 413 $command = 'all' unless defined($command); 414 $command eq 'all' && do {print "$dirPath\n\n"; 415 find($wanted, $dirPath); 416 @outListLib = sort @outListLib; 417 $out->{ra_out} = \@outListLib; 418 $out->{text} = join("", sort @outListLib); 419 return($out); 420 }; 421 $command eq 'setsOnly' && do { 422 if ( opendir(DIR, $dirPath) ) { 423 my @fileList=(); 424 while (defined(my $file = readdir(DIR))) { 425 push(@fileList,$file) if -d "$dirPath/$file"; 426 427 } 428 $out->{text} = join("\n",sort @fileList); 429 closedir(DIR); 430 } else { 431 $out->{error}= "Can't open directory $dirPath"; 432 } 433 return($out); 434 }; 435 $command eq 'listSet' && do { my $dirPath2 = $dirPath . $rh->{set}; 436 437 if ( opendir(DIR, $dirPath2) ) { 438 my @fileList =(); 439 while (defined(my $file = readdir(DIR))) { 440 if (-d "$dirPath2/$file") { 441 push(@fileList, "$file/${file}.pg"); 442 443 } elsif ($file =~ /.pg$/ ) { # file ends in .pg 444 push(@fileList, $file); 445 446 } 447 448 449 } 450 $out->{text} = join("\n",sort @fileList); 451 closedir(DIR); 452 } else { 453 $out->{error}= "Can't open directory $dirPath2"; 454 } 455 456 return($out); 457 }; 458 # else 459 $out->{error}="Unrecognized command $command"; 460 $out; 461 } 462
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |