[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 320 - (download) (as text) (annotate)
Thu May 30 19:17:36 2002 UTC (17 years, 2 months ago) by gage
File size: 16035 byte(s)
Added some debugging print STDERR statements for checking the
initialization of the PGtranslator object.

they have been commented out. Except for one announcing the
successful completion of intializing an object.

    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 "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 "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   "PGcomplexmacros.pl",
   97   "PGbasicmacro.pl",
   98   "PGchoicemacros.pl",
   99   "PGanswermacros.pl",
  100   "PGnumericalmacros.pl",
  101   "PGgraphmacros.pl",
  102   "PGauxiliaryFunctions.pl",
  103   "PGmatrixmacros.pl",
  104   "PGstatisticsmacros.pl"
  105 
  106   );
  107 
  108   ENDDOCUMENT();
  109 
  110 END_OF_TEXT
  111 
  112 ###############################################################################
  113 #
  114 ###############################################################################
  115 
  116 ###############################################################################
  117 ###############################################################################
  118 
  119 #print STDERR "ok so far reading file /u/gage/xmlrpc/daemon/Webwork.pm\n";
  120 
  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 #print STDERR "Completed loading of modules, now loading extra packages\n";
  146 $pt -> load_extra_packages( @EXTRA_PACKAGES );
  147 #print STDERR "Completed loading of packages, now loading environment\n";
  148 $pt -> environment($dummy_envir);
  149 #print STDERR "Completed loading environment, next initialize\n";
  150 $pt->initialize();
  151 #print STDERR "Initialized.  \n";
  152 $pt -> unrestricted_load($PG_PL );
  153 $pt -> unrestricted_load($DANGEROUS_MACROS_PL);
  154 $pt-> set_mask();
  155 #
  156 #print STDERR "Unrestricted loads completed.\n";
  157 
  158 $INITIAL_MACRO_PACKAGES =~ tr /\r/\n/;
  159 $pt->source_string( $INITIAL_MACRO_PACKAGES   );
  160 #print STDERR "source strings read in\n";
  161 $pt ->rf_safety_filter( \&safetyFilter);   # install blank safety filter
  162 $pt ->translate();
  163 
  164 print STDERR "New PGtranslator object inititialization completed.\n";
  165 ################################################################################
  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