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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 386 - (download) (as text) (annotate)
Wed Jun 19 03:27:44 2002 UTC (17 years, 1 month ago) by gage
File size: 17031 byte(s)
Now the daemon server is working again.
This file needs some serious work so that it
is easier to connect up to other parts of webwork

    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 
   18 #BEGIN {
   19 # local $^W=0;
   20 # require '/usr/local/lib/perl5/5.6.1/Benchmark.pm';
   21 #}
   22 print STDERR "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 "/Users/gage/webwork/system/lib/", "/Users/gage/webwork/system/courseScripts/";
   30 
   31 my $WEBWORKDIRECTORY = '/Users/gage/webwork/';
   32 my $COURSESCRIPTSDIRECTORY = "/Users/gage/webwork/system/courseScripts/";
   33 my $PGTRANSLATOR = "PGtranslator5.pm";
   34 
   35 my $COURSETEMPDIRECTORY = '/Users/gage/Sites/rochester_problibtmp/';
   36 my $COURSETEMPURL     = '/~gage/rochester_problibtmp';
   37 
   38 
   39 
   40 my $PASSWORD = 'geometry';
   41 ###############################################################################
   42 
   43 BEGIN{
   44   my $GLOBAL_INIT = "/Users/gage/webwork/system/lib/Global.pm";
   45   print "Opening $GLOBAL_INIT\n";
   46   require "/Users/gage/webwork/system/lib/webworkConfig.pm" or croak 'webworkConfig.pm';
   47   require $GLOBAL_INIT or croak $GLOBAL_INIT;
   48   import Global;
   49 }
   50 $Global::cgiURL='foo';
   51 
   52 
   53 require $PGTRANSLATOR or die "Can't open $PGTRANSLATOR";
   54 
   55 ###############################################################################
   56 # List and address myof available problemlibraries
   57 ###############################################################################
   58 
   59 
   60 my $libraryPath         =   '${WEBWORKDIRECTORY}rochester_problib/';
   61 
   62 my %AVAILABLE_PROBLEM_LIBRARIES =   ( ww_prob_lib   =>  "${WEBWORKDIRECTORY}rochester_problib/",
   63                     indiana_prob_lib  =>  "${WEBWORKDIRECTORY}Indiana_prob_lib/",
   64                     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 my $courseScriptsDirectory    =   $COURSESCRIPTSDIRECTORY;
   75 my $macroDirectory        = "${courseScriptsDirectory}macros/";
   76 my $scriptDirectory       =   "${WEBWORKDIRECTORY}system/scripts/";
   77 my $templateDirectory     =   "${WEBWORKDIRECTORY}courseData/rochester_problib/";
   78 
   79 $Global::courseTempDirectory  =   $COURSETEMPDIRECTORY;
   80 $Global::courseTempURL      =   $COURSETEMPURL;
   81 
   82 
   83 $Global::groupID        =   "webadmin";
   84 $Global::numericalGroupID     =   1005;
   85 
   86 my $displayMode         = 'HTML_tth';
   87 
   88 my $PG_PL             =   "${courseScriptsDirectory}PG.pl";
   89 my $DANGEROUS_MACROS_PL     =   "${courseScriptsDirectory}dangerousMacros.pl";
   90 my @MODULE_LIST         = (   "Exporter", "DynaLoader", "GD", "WWPlot", "Fun",
   91                     "Circle", "Label", "PGrandom", "Units", "Hermite",
   92                     "List", "Match","Multiple", "Select", "AlgParser",
   93                     "AnswerHash", "Fraction", "VectorField", "Complex1",
   94                     "Complex", "MatrixReal1", "Matrix","Distributions",
   95                     "Regression"
   96 );
   97 my @EXTRA_PACKAGES        = (   "AlgParserWithImplicitExpand", "Expr",
   98                     "ExprWithImplicitExpand", "AnswerEvaluator",
   99 
  100 );
  101 
  102 my $INITIAL_MACRO_PACKAGES;
  103 unless (defined ($main::do_not_preload_macros) && $main::do_not_preload_macros == 1) {
  104 
  105   $INITIAL_MACRO_PACKAGES     = <<END_OF_TEXT;
  106     DOCUMENT();
  107     loadMacros(
  108       "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 
  118     );
  119 
  120     ENDDOCUMENT();
  121 
  122 END_OF_TEXT
  123 } else {
  124   $INITIAL_MACRO_PACKAGES     =  <<END_OF_TEXT;
  125     DOCUMENT();
  126     loadMacros(
  127     #     "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 
  137     );
  138 
  139     ENDDOCUMENT();
  140 
  141 END_OF_TEXT
  142 
  143 
  144 }
  145 #print $INITIAL_MACRO_PACKAGES;
  146 ###############################################################################
  147 #
  148 ###############################################################################
  149 
  150 ###############################################################################
  151 ###############################################################################
  152 
  153 print STDERR "ok so far reading file ${WEBWORKDIRECTORY}xmlrpc/daemon/Webwork.pm\n";
  154 
  155 
  156 
  157 ###############################################################################
  158 #
  159 # INITIALIZATION
  160 #
  161 # 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 print STDERR "Begin intitalization\n";
  170 my $dummy_envir = { courseScriptsDirectory  =>  $courseScriptsDirectory,
  171           displayMode       =>  $displayMode,
  172           macroDirectory      =>  $macroDirectory,
  173           cgiURL          =>  'foo_cgiURL'};
  174 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 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 $pt-> set_mask();
  191 #
  192 # 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 
  197 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/;  # change everything to unix line endings.
  198 $pt->source_string( $INITIAL_MACRO_PACKAGES   );
  199 $pt ->rf_safety_filter( \&safetyFilter);   # install blank safety filter
  200 $pt ->translate();
  201 
  202 print STDERR "New PGtranslator object inititialization completed.\n";
  203 ################################################################################
  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 
  220 #   print STDERR pretty_print_rh($rh->{envir}), "\n\n";
  221 
  222   $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     print "data  $in   end data\n";
  353     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     $out .= " (type = $type )\n";
  376   }
  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 
  391 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