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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9