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