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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9