[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 328 - (download) (as text) (annotate)
Thu May 30 21:56:44 2002 UTC (17 years, 6 months ago) by gage
File size: 16060 byte(s)
Changed formatting in Webwork.pm
The RPC files are not being used.

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