[system] / trunk / xmlrpc / daemon / webwork-daemon5a.pl Repository:
ViewVC logotype

Annotation of /trunk/xmlrpc/daemon/webwork-daemon5a.pl

Parent Directory Parent Directory | Revision Log Revision Log


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

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9