[system] / trunk / webwork-modperl / lib / WeBWorK.pm Repository:
ViewVC logotype

View of /trunk/webwork-modperl/lib/WeBWorK.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 3673 - (download) (as text) (annotate)
Fri Sep 30 19:31:35 2005 UTC (7 years, 7 months ago) by sh002i
File size: 11939 byte(s)
give user an error message if they can't act as another user.
see bug #846.

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK.pm,v 1.75 2005/09/06 14:17:44 sh002i Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK;
   18 
   19 =head1 NAME
   20 
   21 WeBWorK - Dispatch requests to the appropriate content generator.
   22 
   23 =head1 SYNOPSIS
   24 
   25  my $r = Apache->request;
   26  my $result = eval { WeBWorK::dispatch($r) };
   27  die "something bad happened: $@" if $@;
   28 
   29 =head1 DESCRIPTION
   30 
   31 C<WeBWorK> is the dispatcher for the WeBWorK system. Given an Apache request
   32 object, it performs authentication and determines which subclass of
   33 C<WeBWorK::ContentGenerator> to call.
   34 
   35 =cut
   36 
   37 BEGIN { $main::VERSION = "2.1"; }
   38 
   39 use strict;
   40 use warnings;
   41 use Apache::Constants qw(:common REDIRECT DONE);
   42 use Time::HiRes qw/time/;
   43 
   44 # load WeBWorK::Constants before anything else
   45 # this sets package variables in several packages
   46 use WeBWorK::Constants;
   47 
   48 # the rest of these are modules that are acutally used by this one
   49 use WeBWorK::Authen;
   50 use WeBWorK::Authz;
   51 use WeBWorK::CourseEnvironment;
   52 use WeBWorK::DB;
   53 use WeBWorK::Debug;
   54 use WeBWorK::Request;
   55 use WeBWorK::Upload;
   56 use WeBWorK::URLPath;
   57 use WeBWorK::Utils qw(runtime_use writeTimingLogEntry);
   58 
   59 use constant AUTHEN_MODULE => "WeBWorK::ContentGenerator::Login";
   60 use constant PROCTOR_AUTHEN_MODULE => "WeBWorK::ContentGenerator::LoginProctor";
   61 use constant FIXDB_MODULE => "WeBWorK::ContentGenerator::FixDB";
   62 
   63 our %SeedCE;
   64 
   65 sub dispatch($) {
   66   my ($apache) = @_;
   67   my $r = new WeBWorK::Request $apache;
   68 
   69   my $method = $r->method;
   70   my $location = $r->location;
   71   my $uri = $r->uri;
   72   my $path_info = $r->path_info | "";
   73   my $args = $r->args || "";
   74   #my $webwork_root = $r->dir_config("webwork_root");
   75   #my $pg_root = $r->dir_config("pg_root");
   76 
   77   debug("\n\n===> Begin " . __PACKAGE__ . "::dispatch() <===\n\n");
   78   debug("Hi, I'm the new dispatcher!\n");
   79   debug(("-" x 80) . "\n");
   80 
   81   debug("Okay, I got some basic information:\n");
   82   debug("The apache location is $location\n");
   83   debug("The request method is $method\n");
   84   debug("The URI is $uri\n");
   85   debug("The path-info is $path_info\n");
   86   debug("The argument string is $args\n");
   87   #debug("The WeBWorK root directory is $webwork_root\n");
   88   #debug("The PG root directory is $pg_root\n");
   89   debug(("-" x 80) . "\n");
   90 
   91   debug("The first thing we need to do is munge the path a little:\n");
   92 
   93   my ($path) = $uri =~ m/$location(.*)/;
   94   $path = "/" if $path eq ""; # no path at all
   95 
   96   debug("We can't trust the path-info, so we make our own path.\n");
   97   debug("path-info claims: $path_info\n");
   98   debug("but it's really: $path\n");
   99   debug("(if it's empty, we set it to \"/\".)\n");
  100 
  101   $path =~ s|/+|/|g;
  102   debug("...and here it is without repeated slashes: $path\n");
  103 
  104   # lookbehind assertion for "not a slash"
  105   # matches the boundary after the last char
  106   $path =~ s|(?<=[^/])$|/|;
  107   debug("...and here it is with a trailing slash: $path\n");
  108 
  109   debug(("-" x 80) . "\n");
  110 
  111   debug("Now we need to look at the path a little to figure out where we are\n");
  112 
  113   debug("-------------------- call to WeBWorK::URLPath::newFromPath\n");
  114   my $urlPath = WeBWorK::URLPath->newFromPath($path);
  115   debug("-------------------- call to WeBWorK::URLPath::newFromPath\n");
  116 
  117   unless ($urlPath) {
  118     debug("This path is invalid... see you later!\n");
  119     die "The path '$path' is not valid.\n";
  120   }
  121 
  122   my $displayModule = $urlPath->module;
  123   my %displayArgs = $urlPath->args;
  124 
  125   unless ($displayModule) {
  126     debug("The display module is empty, so we can DECLINE here.\n");
  127     die "No display module found for path '$path'.";
  128   }
  129 
  130   debug("The display module for this path is: $displayModule\n");
  131   debug("...and here are the arguments we'll pass to it:\n");
  132   foreach my $key (keys %displayArgs) {
  133     debug("\t$key => $displayArgs{$key}\n");
  134   }
  135 
  136   my $selfPath = $urlPath->path;
  137   my $parent = $urlPath->parent;
  138   my $parentPath = $parent ? $parent->path : "<no parent>";
  139 
  140   debug("Reconstructing the original path gets us: $selfPath\n");
  141   debug("And we can generate the path to our parent, too: $parentPath\n");
  142   debug("(We could also figure out who our children are, but we'd need to supply additional arguments.)\n");
  143   debug(("-" x 80) . "\n");
  144 
  145   debug("The URLPath looks good, we'll add it to the request.\n");
  146   $r->urlpath($urlPath);
  147 
  148   debug("Now we want to look at the parameters we got.\n");
  149 
  150   debug("The raw params:\n");
  151   foreach my $key ($r->param) {
  152     debug("\t$key\n");
  153     debug("\t\t$_\n") foreach $r->param($key);
  154   }
  155 
  156   #mungeParams($r);
  157 
  158   debug("The munged params:\n");
  159   foreach my $key ($r->param) {
  160     debug("\t$key\n");
  161     debug("\t\t$_\n") foreach $r->param($key);
  162   }
  163 
  164   debug(("-" x 80) . "\n");
  165 
  166   debug("We need to get a course environment (with or without a courseID!)\n");
  167   my $ce = eval { new WeBWorK::CourseEnvironment({
  168     #webworkRoot => $r->dir_config("webwork_root"),
  169     #webworkURLRoot => $location,
  170     #pgRoot => $r->dir_config("pg_root"),
  171     %SeedCE,
  172     courseName => $displayArgs{courseID},
  173   }) };
  174   $@ and die "Failed to initialize course environment: $@\n";
  175   debug("Here's the course environment: $ce\n");
  176   $r->ce($ce);
  177 
  178   my @uploads = $r->upload;
  179   foreach my $u (@uploads) {
  180     # make sure it's a "real" upload
  181     next unless $u->filename;
  182 
  183     # store the upload
  184     my $upload = WeBWorK::Upload->store($u,
  185       dir => $ce->{webworkDirs}->{uploadCache}
  186     );
  187 
  188     # store the upload ID and hash in the file upload field
  189     my $id = $upload->id;
  190     my $hash = $upload->hash;
  191     $r->param($u->name => "$id $hash");
  192   }
  193 
  194   my ($db, $authz);
  195 
  196   if ($displayArgs{courseID}) {
  197     debug("We got a courseID from the URLPath, now we can do some stuff:\n");
  198 
  199     unless (-e $ce->{courseDirs}->{root}) {
  200       die "Course '$displayArgs{courseID}' not found: $!";
  201     }
  202 
  203     debug("...we can create a database object...\n");
  204     $db = new WeBWorK::DB($ce->{dbLayout});
  205     debug("(here's the DB handle: $db)\n");
  206     $r->db($db);
  207 
  208     debug("Now we check the database...\n");
  209     debug("(we can detect if a hash-style database from WW1 has not be converted properly.)\n");
  210     my ($dbOK, @dbMessages) = $db->hashDatabaseOK(0); # 0 == don't fix
  211     if (not $dbOK) {
  212       debug("hashDatabaseOK() returned $dbOK -- looks like trouble...\n");
  213       $displayModule = FIXDB_MODULE;
  214       debug("set displayModule to $displayModule\n");
  215     } else {
  216       debug("hashDatabaseOK() returned $dbOK -- leaving displayModule as-is\n");
  217     }
  218 
  219     debug("Create an authz object (Authen needs it to check login permission)...\n");
  220     $authz = new WeBWorK::Authz($r);
  221     debug("(here's the authz object: $authz)\n");
  222     $r->authz($authz);
  223 
  224     debug("...and now we can authenticate the remote user...\n");
  225     my $authen = new WeBWorK::Authen($r);
  226     my $authenOK = $authen->verify;
  227     if ($authenOK) {
  228       my $userID = $r->param("user");
  229       debug("Hi, $userID, glad you made it.\n");
  230 
  231       # tell authorizer to cache this user's permission level
  232       $authz->setCachedUser($userID);
  233 
  234       debug("Now we deal with the effective user:\n");
  235       my $eUserID = $r->param("effectiveUser") || $userID;
  236       debug("userID=$userID eUserID=$eUserID\n");
  237       if ($userID ne $eUserID) {
  238         debug("userID and eUserID differ... seeing if userID has 'become_student' permission.\n");
  239         my $su_authorized = $authz->hasPermissions($userID, "become_student");
  240         if ($su_authorized) {
  241           debug("Ok, looks like you're allowed to become $eUserID. Whoopie!\n");
  242         } else {
  243           debug("Uh oh, you're not allowed to become $eUserID. Nice try!\n");
  244           $eUserID = $userID;
  245           $r->notes("authen_error" => "You do not have permission to become another user.");
  246           $displayModule = AUTHEN_MODULE;
  247         }
  248       }
  249 
  250       # set effectiveUser in case it was changed or not set to begin with
  251       $r->param("effectiveUser" => $eUserID);
  252 
  253       # if we're doing a proctored test, after the user has been authenticated
  254       # we need to also check on the proctor.  note that in the gateway quiz
  255       # module we double check this, to be sure that someone isn't taking a
  256       # proctored quiz but calling the unproctored ContentGenerator
  257       my $urlProducedPath = $urlPath->path();
  258       if ( $urlProducedPath =~ /proctored_quiz_mode/i ) {
  259           my $procAuthOK = $authen->verifyProctor();
  260 
  261           if ($procAuthOK) {
  262           my $proctorUserID = $r->param("proctor_user");
  263           my $proctor_authorized = $authz->hasPermissions($proctorUserID, "proctor_quiz");
  264           unless ($proctor_authorized) {
  265             $r->notes("authen_error", "User $proctorUserID is not authorized to proctor tests in this course.");
  266               $displayModule = PROCTOR_AUTHEN_MODULE;
  267           }
  268         } else {
  269           $displayModule = PROCTOR_AUTHEN_MODULE;
  270         }
  271       }
  272     } else {
  273       debug("Bad news: authentication failed!\n");
  274       $displayModule = AUTHEN_MODULE;
  275       debug("set displayModule to $displayModule\n");
  276     }
  277   }
  278 
  279   ## if a course ID was given in the URL and resulted in an error (as stored in $!)
  280   ## it probably means that the course does not exist or was misspelled
  281   #if ($displayArgs{courseID} and $ce->{'!'}) {
  282   # debug("Something was wrong with the courseID: \n");
  283   # debug("\t\t" . $ce->{'!'} . "\n");
  284   # debug("Time to bail!\n");
  285   # die "An error occured while accessing '$displayArgs{courseID}': '", $ce->{'!'}, "'.\n";
  286   #}
  287 
  288   # store the time before we invoke the content generator
  289   my $cg_start = time; # this is Time::HiRes's time, which gives floating point values
  290 
  291   debug(("-" x 80) . "\n");
  292   debug("Finally, we'll load the display module...\n");
  293 
  294   runtime_use($displayModule);
  295 
  296   debug("...instantiate it...\n");
  297 
  298   my $instance = $displayModule->new($r);
  299 
  300   debug("...and call it:\n");
  301   debug("-------------------- call to ${displayModule}::go\n");
  302 
  303   my $result = $instance->go();
  304 
  305   debug("-------------------- call to ${displayModule}::go\n");
  306 
  307   my $cg_end = time;
  308   my $cg_duration = $cg_end - $cg_start;
  309   writeTimingLogEntry($ce, "[".$r->uri."]", sprintf("runTime = %.3f sec", $cg_duration)." ".$ce->{dbLayoutName}, "");
  310 
  311   debug("returning result: " . (defined $result ? $result : "UNDEF") . "\n");
  312 
  313   return $result;
  314 }
  315 
  316 sub mungeParams {
  317   my ($r) = @_;
  318 
  319   my @paramQueue;
  320 
  321   # remove all the params from the request, and store them in the param queue
  322   foreach my $key ($r->param) {
  323     push @paramQueue, [ $key => [ $r->param($key) ] ];
  324     $r->parms->unset($key)
  325   }
  326 
  327   # exhaust the param queue, decoding encoded params
  328   while (@paramQueue) {
  329     my ($key, $values) = @{ shift @paramQueue };
  330 
  331     if ($key =~ m/\,/) {
  332       # we have multiple params encoded in a single param
  333       # split them up and add them to the end of the queue
  334       push @paramQueue, map { [ $_, $values ] } split m/\,/, $key;
  335     } elsif ($key =~ m/\:/) {
  336       # we have a whole param encoded in a key
  337       # split it up and add it to the end of the queue
  338       my ($newKey, $newValue) = split m/\:/, $key;
  339       push @paramQueue, [ $newKey, [ $newValue ] ];
  340     } else {
  341       # this is a "normal" param
  342       # add it to the param list
  343       if (defined $r->param($key)) {
  344         # the param already exists -- append the values we have
  345         $r->param($key => [ $r->param($key), @$values ]);
  346       } else {
  347         # the param doesn't exist -- create it with the values we have
  348         $r->param($key => $values);
  349       }
  350     }
  351   }
  352 }
  353 
  354 
  355 =head1 AUTHOR
  356 
  357 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam
  358 Hathaway, sh002i at math.rochester.edu.
  359 
  360 =cut
  361 
  362 1;

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9