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