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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (download) (as text) (annotate)
Fri May 17 21:44:04 2002 UTC (17 years, 3 months ago) by gage
File size: 15390 byte(s)
Experimental xmlrpc WeBWorK webservices

    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 
   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