Parent Directory
| 
Revision Log
Changed formatting in Webwork.pm The RPC files are not being used.
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 STDERR "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 STDERR "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 "PGbasicmacros.pl", 97 "PGchoicemacros.pl", 98 "PGanswermacros.pl", 99 "PGnumericalmacros.pl", 100 "PGgraphmacros.pl", 101 "PGauxiliaryFunctions.pl", 102 "PGmatrixmacros.pl", 103 "PGstatisticsmacros.pl", 104 "PGcomplexmacros.pl", 105 ); 106 107 ENDDOCUMENT(); 108 109 END_OF_TEXT 110 111 ############################################################################### 112 # 113 ############################################################################### 114 115 ############################################################################### 116 ############################################################################### 117 118 #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n"; 119 120 121 122 ############################################################################### 123 # The following code initializes an instantiation of PGtranslator5 in the 124 # parent process. This initialized object is then share with each of the 125 # children forked from this parent process by the daemon. 126 # 127 # As far as I can tell, the child processes don't share any variable values even 128 # though their namespaces are the same. 129 ############################################################################### 130 131 132 my $dummy_envir = { courseScriptsDirectory => $courseScriptsDirectory, 133 displayMode => $displayMode, 134 macroDirectory => $macroDirectory}; 135 my $pt = new PGtranslator5; #pt stands for problem translator; 136 $pt ->rh_directories( { courseScriptsDirectory => $courseScriptsDirectory, 137 macroDirectory => $macroDirectory, 138 scriptDirectory => $scriptDirectory , 139 templateDirectory => $templateDirectory, 140 tempDirectory => $Global::courseTempDirectory, 141 } 142 ); 143 $pt -> evaluate_modules( @MODULE_LIST); 144 #print STDERR "Completed loading of modules, now loading extra packages\n"; 145 $pt -> load_extra_packages( @EXTRA_PACKAGES ); 146 #print STDERR "Completed loading of packages, now loading environment\n"; 147 $pt -> environment($dummy_envir); 148 #print STDERR "Completed loading environment, next initialize\n"; 149 $pt->initialize(); 150 #print STDERR "Initialized. \n"; 151 $pt -> unrestricted_load($PG_PL ); 152 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 153 $pt-> set_mask(); 154 # 155 #print STDERR "Unrestricted loads completed.\n"; 156 157 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/; 158 $pt->source_string( $INITIAL_MACRO_PACKAGES ); 159 #print STDERR "source strings read in\n"; 160 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter 161 $pt ->translate(); 162 163 print STDERR "New PGtranslator object inititialization completed.\n"; 164 ################################################################################ 165 ## This ends the initialization of the PGtranslator object 166 ################################################################################ 167 168 ############################################################################### 169 # This subroutine is called by the child process. It reinitializes its copy of the 170 # PGtranslator5 object. The unrestricted_load and loadMacros subroutines of PGtranslator5 171 # have been modified so that if &_PG_init is already defined then nothing 172 # is read in but the initialization subroutine is run instead. 173 ############################################################################### 174 175 sub renderProblem { 176 my $rh = shift; 177 my $beginTime = new Benchmark; 178 $Global::WARNINGS = ""; 179 $pt->environment($rh->{envir}); 180 #$pt->{safe_cache} = $safe_cmpt_cache; 181 $pt->initialize(); 182 $pt -> unrestricted_load($PG_PL); 183 $pt -> unrestricted_load($DANGEROUS_MACROS_PL); 184 $pt-> set_mask(); 185 186 my $string = decode_base64( $rh ->{source} ); 187 $string =~ tr /\r/\n/; 188 189 $pt->source_string( $string ); 190 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter 191 $pt ->translate(); 192 193 194 # Determine which problem grader to use 195 #$pt->rf_problem_grader($pt->rf_std_problem_grader); #this is the default 196 my $problem_grader_to_use = $pt->rh_flags->{PROBLEM_GRADER_TO_USE}; 197 198 if ( defined($problem_grader_to_use) and $problem_grader_to_use ) { # if defined and non-empty 199 if ($problem_grader_to_use eq 'std_problem_grader') { 200 # Reset problem grader to standard problem grader. 201 $pt->rf_problem_grader($pt->rf_std_problem_grader); 202 } elsif ($problem_grader_to_use eq 'avg_problem_grader') { 203 # Reset problem grader to average problem grader. 204 $pt->rf_problem_grader($pt->rf_avg_problem_grader); 205 } elsif (ref($problem_grader_to_use) eq 'CODE') { 206 # Set problem grader to instructor defined problem grader -- use cautiously. 207 $pt->rf_problem_grader($problem_grader_to_use) 208 } else { 209 warn "Error: Could not understand problem grader flag $problem_grader_to_use"; 210 #this is the default set by the translator and used if the flag is not understood 211 #$pt->rf_problem_grader($pt->rf_std_problem_grader); 212 } 213 214 } else {#this is the default set by the translator and used if no flag is set. 215 $pt->rf_problem_grader($pt->rf_std_problem_grader); 216 } 217 218 # creates and stores a hash of answer results: $rh_answer_results 219 $pt -> process_answers($rh->{envir}->{inputs_ref}); 220 221 222 $pt->rh_problem_state({ recorded_score => $rh->{problem_state}->{recorded_score}, 223 num_of_correct_ans => $rh->{problem_state}->{num_of_correct_ans} , 224 num_of_incorrect_ans => $rh->{problem_state}->{num_of_incorrect_ans} 225 } ); 226 my %PG_FLAGS = $pt->h_flags; 227 my $ra_answer_entry_order = ( defined($PG_FLAGS{ANSWER_ENTRY_ORDER}) ) ? 228 $PG_FLAGS{ANSWER_ENTRY_ORDER} : [ keys %{$pt->rh_evaluated_answers} ] ; 229 my $answers_submitted = 0; 230 $answers_submitted = 1 if defined( $rh->{answer_form_submitted} ) and 1 == $rh->{answer_form_submitted}; 231 232 my ($rh_problem_result,$rh_problem_state) = $pt->grade_problem( answers_submitted => $answers_submitted, 233 ANSWER_ENTRY_ORDER => $ra_answer_entry_order 234 ); # grades the problem. 235 # protect image data for delivery via XML-RPC. 236 # Don't send code data. 237 my %PG_flag=(); 238 # foreach my $key (keys %PG_FLAGS) { 239 # if ($key eq 'dynamic_images' ) { 240 # foreach my $ikey (keys %{$PG_FLAGS{'dynamic_images'} }) { 241 # $PG_flag{'dynamic_images'}->{$ikey} = 242 # encode_base64($PG_FLAGS{'dynamic_images'}->{$ikey}); 243 # } 244 # } elsif (ref($PG_FLAGS{$key}) eq '' or ref($PG_FLAGS{$key}) =~ /SCALAR|HASH/) { 245 # $PG_flag{$key} = $PG_FLAGS{$key} ; 246 # } 247 # } 248 249 250 my $out = { 251 text => encode_base64( ${$pt ->r_text()} ), 252 header_text => encode_base64( ${ $pt->r_header } ), 253 answers => $pt->rh_evaluated_answers, 254 errors => $pt-> errors(), 255 WARNINGS => encode_base64($Global::WARNINGS ), 256 problem_result => $rh_problem_result, 257 problem_state => $rh_problem_state, 258 PG_flag => \%PG_flag 259 }; 260 my $endTime = new Benchmark; 261 $out->{compute_time} = logTimingInfo($beginTime, $endTime); 262 $out; 263 264 } 265 266 ############################################################################### 267 # This ends the main subroutine executed by the child process in responding to 268 # a request. The other subroutines are auxiliary. 269 ############################################################################### 270 271 272 sub safetyFilter { 273 my $answer = shift; # accepts one answer and checks it 274 my $submittedAnswer = $answer; 275 $answer = '' unless defined $answer; 276 my ($errorno, $answerIsCorrectQ); 277 $answer =~ tr/\000-\037/ /; 278 #### Return if answer field is empty ######## 279 unless ($answer =~ /\S/) { 280 # $errorno = "<BR>No answer was submitted."; 281 $errorno = 0; ## don't report blank answer as error 282 283 return ($answer,$errorno); 284 } 285 ######### replace ^ with ** (for exponentiation) 286 # $answer =~ s/\^/**/g; 287 ######### Return if forbidden characters are found 288 unless ($answer =~ /^[a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)]+$/ ) { 289 $answer =~ tr/a-zA-Z0-9_\-\+ \t\/@%\*\.\n^\(\)/#/c; 290 $errorno = "<BR>There are forbidden characters in your answer: $submittedAnswer<BR>"; 291 292 return ($answer,$errorno); 293 } 294 295 $errorno = 0; 296 return($answer, $errorno); 297 } 298 299 300 sub logTimingInfo{ 301 my ($beginTime,$endTime,) = @_; 302 my $out = ""; 303 $out .= Benchmark::timestr( Benchmark::timediff($endTime , $beginTime) ); 304 $out; 305 } 306 307 ############### 308 309 sub echo { 310 my $in= shift; 311 return(ref($in)); 312 } 313 sub hello { 314 print "Receiving request for hello world\n"; 315 return "Hello world"; 316 } 317 sub pretty_print_rh { 318 my $rh = shift; 319 my $out = ""; 320 my $type = ref($rh); 321 if ( ref($rh) =~/HASH/ ) { 322 foreach my $key (sort keys %{$rh}) { 323 $out .= " $key => " . pretty_print_rh( $rh->{$key} ) . "\n"; 324 } 325 } elsif ( ref($rh) =~ /SCALAR/ ) { 326 $out = "scalar reference ". ${$rh}; 327 } elsif ( ref($rh) =~/Base64/ ) { 328 $out .= "base64 reference " .$$rh; 329 } else { 330 $out = $rh; 331 } 332 if (defined($type) ) { 333 $out .= "type = $type \n"; 334 } 335 return $out; 336 } 337 338 #sub xmlquit { 339 # print "exiting daemon\n"; 340 # return ""; 341 #} 342 343 ############################################################################### 344 #OTHER SERVICES 345 ############################################################################### 346 347 my $PASSWORD = 'geometry'; 348 349 use File::stat; 350 sub readFile { 351 my $rh = shift; 352 local($|)=1; 353 my $out = {}; 354 my $filePath = $rh->{filePath}; 355 unless ($rh->{pw} eq $PASSWORD ) { 356 $out->{error}=404; 357 return($out); 358 } 359 if ( defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ) ) { 360 $filePath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} . $filePath; 361 } else { 362 $out->{error} = "Could not find library:".$rh->{library_name}.":"; 363 return($out); 364 } 365 366 if (-r $filePath) { 367 open IN, "<$filePath"; 368 local($/)=undef; 369 my $text = <IN>; 370 $out->{text}= encode_base64($text); 371 my $sb=stat($filePath); 372 $out->{size}=$sb->size; 373 $out->{path}=$filePath; 374 $out->{permissions}=$sb->mode&07777; 375 $out->{modTime}=scalar localtime $sb->mtime; 376 close(IN); 377 } else { 378 $out->{error} = "Could not read file at |$filePath|"; 379 } 380 return($out); 381 } 382 383 384 385 use File::Find; 386 sub listLib { 387 my $rh = shift; 388 my $out = {}; 389 my $dirPath; 390 unless ($rh->{pw} eq $PASSWORD ) { 391 $out->{error}=404; 392 return($out); 393 } 394 395 if ( defined($AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ) ) { 396 $dirPath = $AVAILABLE_PROBLEM_LIBRARIES{$rh->{library_name}} ; 397 } else { 398 $out->{error} = "Could not find library:".$rh->{library_name}.":"; 399 return($out); 400 } 401 402 my @outListLib; 403 my $wanted = sub { 404 my $name = $File::Find::name; 405 my @out=(); 406 if ($name =~/\S/ ) { 407 $name =~ s|^$dirPath||o; # cut the first directory 408 push(@outListLib, "$name\n") if $name =~/\.pg/; 409 } 410 }; 411 my $command = $rh->{command}; 412 $command = 'all' unless defined($command); 413 $command eq 'all' && do {print "$dirPath\n\n"; 414 find($wanted, $dirPath); 415 @outListLib = sort @outListLib; 416 $out->{ra_out} = \@outListLib; 417 $out->{text} = join("", sort @outListLib); 418 return($out); 419 }; 420 $command eq 'setsOnly' && do { 421 if ( opendir(DIR, $dirPath) ) { 422 my @fileList=(); 423 while (defined(my $file = readdir(DIR))) { 424 push(@fileList,$file) if -d "$dirPath/$file"; 425 426 } 427 $out->{text} = join("\n",sort @fileList); 428 closedir(DIR); 429 } else { 430 $out->{error}= "Can't open directory $dirPath"; 431 } 432 return($out); 433 }; 434 $command eq 'listSet' && do { my $dirPath2 = $dirPath . $rh->{set}; 435 436 if ( opendir(DIR, $dirPath2) ) { 437 my @fileList =(); 438 while (defined(my $file = readdir(DIR))) { 439 if (-d "$dirPath2/$file") { 440 push(@fileList, "$file/${file}.pg"); 441 442 } elsif ($file =~ /.pg$/ ) { # file ends in .pg 443 push(@fileList, $file); 444 445 } 446 447 448 } 449 $out->{text} = join("\n",sort @fileList); 450 closedir(DIR); 451 } else { 452 $out->{error}= "Can't open directory $dirPath2"; 453 } 454 455 return($out); 456 }; 457 # else 458 $out->{error}="Unrecognized command $command"; 459 $out; 460 } 461
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |