[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 328 - (view) (download) (as text)

1 : gage 279 #!/usr/local/bin/perl -w
2 : gage 320 use Safe;
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 :     use lib "/u/gage/webwork/system/lib/", "/u/gage/webwork/system/courseScripts";
30 :    
31 :     ###############################################################################
32 :    
33 : gage 320
34 : gage 279 BEGIN{
35 :     my $GLOBAL_INIT = "/u/gage/webwork/system/lib/Global.pm";
36 : gage 328 print STDERR "Opening $GLOBAL_INIT\n";
37 : gage 279 require $GLOBAL_INIT or die $GLOBAL_INIT;
38 :     import Global;
39 :     }
40 :    
41 :    
42 : gage 320 my $PGTRANSLATOR = "/u/gage/xmlrpc/daemon/PGtranslator5.pm";
43 : gage 279 require $PGTRANSLATOR or die "Can't open $PGTRANSLATOR";
44 :    
45 : gage 320
46 :    
47 : gage 279 ###############################################################################
48 : gage 320 # List and address of available problemlibraries
49 : gage 279 ###############################################################################
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 : gage 320 my $macroDirectory = '/ww/webwork/courses/gage_course/templates/macros/';
68 : gage 279 my $scriptDirectory = '/u/gage/webwork/system/scripts/';
69 : gage 320 my $templateDirectory = '/ww/webwork/courses/gage_course/templates/';
70 : gage 279
71 :     $Global::courseTempDirectory = '/ww/htdocs/tmp/gage_course/';
72 :     $Global::courseTempURL = 'http://webwork-db.math.rochester.edu/tmp/gage_course/';
73 :    
74 :    
75 : gage 320 $Global::groupID = "webwork";
76 : gage 279 $Global::numericalGroupID = 1005;
77 :    
78 : gage 320 my $displayMode = 'HTML_tth';
79 : gage 279
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 : gage 320 my @EXTRA_PACKAGES = ( "AlgParserWithImplicitExpand", "Expr",
90 : gage 279 "ExprWithImplicitExpand", "AnswerEvaluator",
91 : gage 320 # "AnswerEvaluatorMaker"
92 : gage 279 );
93 :     my $INITIAL_MACRO_PACKAGES = <<END_OF_TEXT;
94 :     DOCUMENT();
95 :     loadMacros(
96 : gage 328 "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 : gage 279
107 :     ENDDOCUMENT();
108 :    
109 :     END_OF_TEXT
110 :    
111 :     ###############################################################################
112 :     #
113 :     ###############################################################################
114 :    
115 :     ###############################################################################
116 :     ###############################################################################
117 :    
118 : gage 320 #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n";
119 : gage 279
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 : gage 320 #print STDERR "Completed loading of modules, now loading extra packages\n";
145 : gage 279 $pt -> load_extra_packages( @EXTRA_PACKAGES );
146 : gage 320 #print STDERR "Completed loading of packages, now loading environment\n";
147 : gage 279 $pt -> environment($dummy_envir);
148 : gage 320 #print STDERR "Completed loading environment, next initialize\n";
149 : gage 279 $pt->initialize();
150 : gage 320 #print STDERR "Initialized. \n";
151 : gage 279 $pt -> unrestricted_load($PG_PL );
152 :     $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
153 :     $pt-> set_mask();
154 :     #
155 : gage 320 #print STDERR "Unrestricted loads completed.\n";
156 : gage 279
157 :     $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/;
158 :     $pt->source_string( $INITIAL_MACRO_PACKAGES );
159 : gage 320 #print STDERR "source strings read in\n";
160 : gage 279 $pt ->rf_safety_filter( \&safetyFilter); # install blank safety filter
161 :     $pt ->translate();
162 : gage 320
163 :     print STDERR "New PGtranslator object inititialization completed.\n";
164 : gage 279 ################################################################################
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