[system] / trunk / xmlrpc / daemon / Webwork.pm Repository:
ViewVC logotype

Annotation of /trunk/xmlrpc/daemon/Webwork.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 386 - (view) (download) (as text)

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9