Parent Directory
| 
Revision Log
merged changes from trunk
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2007 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: webwork2/lib/WeBWorK.pm,v 1.104 2010/05/15 18:44:26 gage 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.4.9"; } 38 39 use strict; 40 use warnings; 41 use Time::HiRes qw/time/; 42 43 # load WeBWorK::Constants before anything else 44 # this sets package variables in several packages 45 use WeBWorK::Constants; 46 47 use WeBWorK::Authen; 48 use WeBWorK::Authz; 49 use WeBWorK::CourseEnvironment; 50 use WeBWorK::DB; 51 use WeBWorK::Debug; 52 use WeBWorK::Request; 53 use WeBWorK::Upload; 54 use WeBWorK::URLPath; 55 use WeBWorK::Utils qw(runtime_use writeTimingLogEntry); 56 57 use mod_perl; 58 use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ); 59 60 # Apache2 needs upload class 61 BEGIN { 62 if (MP2) { 63 require Apache2::Upload; 64 Apache2::Upload->import(); 65 require Apache2::RequestUtil; 66 Apache2::RequestUtil->import(); 67 } 68 } 69 70 use constant LOGIN_MODULE => "WeBWorK::ContentGenerator::Login"; 71 use constant PROCTOR_LOGIN_MODULE => "WeBWorK::ContentGenerator::LoginProctor"; 72 73 BEGIN { 74 # pre-compile all content generators 75 # Login and LoginProctor need to be handled separately, since they don't have paths 76 map { eval "require $_"; die $@ if $@ } 77 WeBWorK::URLPath->all_modules, 78 LOGIN_MODULE, 79 PROCTOR_LOGIN_MODULE; 80 # other candidates for preloading: 81 # - DB Record, Schema, and Driver classes (esp. Driver::SQL as it loads DBI) 82 # - CourseManagement subclasses (ditto. sql_single.pm) 83 # - WeBWorK::PG::Local, which loads WeBWorK::PG::Translator 84 # - Authen subclasses 85 } 86 87 our %SeedCE; 88 89 sub dispatch($) { 90 my ($apache) = @_; 91 my $r = new WeBWorK::Request($apache); 92 93 my $method = $r->method; 94 my $location = $r->location; 95 my $uri = $r->uri; 96 my $path_info = $r->path_info | ""; 97 my $args = $r->args || ""; 98 my $dir_config = $r->dir_config; 99 my %conf_vars = map { $_ => $dir_config->{$_} } grep { /^webwork_/ } keys %$dir_config; 100 @SeedCE{keys %conf_vars} = values %conf_vars; 101 102 debug("\n\n===> Begin " . __PACKAGE__ . "::dispatch() <===\n\n"); 103 debug("Hi, I'm the new dispatcher!\n"); 104 debug(("-" x 80) . "\n"); 105 106 debug("Okay, I got some basic information:\n"); 107 debug("The apache location is $location\n"); 108 debug("The request method is $method\n"); 109 debug("The URI is $uri\n"); 110 debug("The path-info is $path_info\n"); 111 debug("The argument string is $args\n"); 112 #debug("The WeBWorK root directory is $webwork_root\n"); 113 #debug("The PG root directory is $pg_root\n"); 114 debug(("-" x 80) . "\n"); 115 116 debug("The first thing we need to do is munge the path a little:\n"); 117 118 my ($path) = $uri =~ m/$location(.*)/; 119 $path = "/" if $path eq ""; # no path at all 120 121 debug("We can't trust the path-info, so we make our own path.\n"); 122 debug("path-info claims: $path_info\n"); 123 debug("but it's really: $path\n"); 124 debug("(if it's empty, we set it to \"/\".)\n"); 125 126 $path =~ s|/+|/|g; 127 debug("...and here it is without repeated slashes: $path\n"); 128 129 # lookbehind assertion for "not a slash" 130 # matches the boundary after the last char 131 $path =~ s|(?<=[^/])$|/|; 132 debug("...and here it is with a trailing slash: $path\n"); 133 134 debug(("-" x 80) . "\n"); 135 136 debug("Now we need to look at the path a little to figure out where we are\n"); 137 138 debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); 139 my $urlPath = WeBWorK::URLPath->newFromPath($path); 140 debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); 141 142 unless ($urlPath) { 143 debug("This path is invalid... see you later!\n"); 144 die "The path '$path' is not valid.\n"; 145 } 146 147 my $displayModule = $urlPath->module; 148 my %displayArgs = $urlPath->args; 149 150 unless ($displayModule) { 151 debug("The display module is empty, so we can DECLINE here.\n"); 152 die "No display module found for path '$path'."; 153 } 154 155 debug("The display module for this path is: $displayModule\n"); 156 debug("...and here are the arguments we'll pass to it:\n"); 157 foreach my $key (keys %displayArgs) { 158 debug("\t$key => $displayArgs{$key}\n"); 159 } 160 161 my $selfPath = $urlPath->path; 162 my $parent = $urlPath->parent; 163 my $parentPath = $parent ? $parent->path : "<no parent>"; 164 165 debug("Reconstructing the original path gets us: $selfPath\n"); 166 debug("And we can generate the path to our parent, too: $parentPath\n"); 167 debug("(We could also figure out who our children are, but we'd need to supply additional arguments.)\n"); 168 debug(("-" x 80) . "\n"); 169 170 debug("The URLPath looks good, we'll add it to the request.\n"); 171 $r->urlpath($urlPath); 172 173 debug("Now we want to look at the parameters we got.\n"); 174 175 debug("The raw params:\n"); 176 foreach my $key ($r->param) { 177 my @vals = $r->param($key); 178 my $vals = join(", ", map { "'$_'" } @vals); 179 debug("\t$key => $vals\n"); 180 } 181 182 #mungeParams($r); 183 # 184 #debug("The munged params:\n"); 185 #foreach my $key ($r->param) { 186 # debug("\t$key\n"); 187 # debug("\t\t$_\n") foreach $r->param($key); 188 #} 189 190 debug(("-" x 80) . "\n"); 191 192 my $apache_hostname = $r->hostname; 193 my $apache_port = $r->get_server_port; 194 my $apache_is_ssl = ($r->subprocess_env('https') ? 1 : ""); 195 my $apache_root_url; 196 if ($apache_is_ssl) { 197 $apache_root_url = "https://$apache_hostname"; 198 $apache_root_url .= ":$apache_port" if $apache_port != 443; 199 } else { 200 $apache_root_url = "http://$apache_hostname"; 201 $apache_root_url .= ":$apache_port" if $apache_port != 80; 202 } 203 204 debug("We need to get a course environment (with or without a courseID!)\n"); 205 my $ce = eval { new WeBWorK::CourseEnvironment({ 206 %SeedCE, 207 courseName => $displayArgs{courseID}, 208 # this is kind of a hack, but it's really the only sane way to get this 209 # server information into the PG box 210 apache_hostname => $apache_hostname, 211 apache_port => $apache_port, 212 apache_is_ssl => $apache_is_ssl, 213 apache_root_url => $apache_root_url, 214 }) }; 215 $@ and die "Failed to initialize course environment: $@\n"; 216 debug("Here's the course environment: $ce\n"); 217 $r->ce($ce); 218 219 my @uploads; 220 if (MP2) { 221 my $upload_table = $r->upload; 222 @uploads = values %$upload_table if defined $upload_table; 223 } else { 224 @uploads = $r->upload; 225 } 226 foreach my $u (@uploads) { 227 # make sure it's a "real" upload 228 next unless $u->filename; 229 230 # store the upload 231 my $upload = WeBWorK::Upload->store($u, 232 dir => $ce->{webworkDirs}->{uploadCache} 233 ); 234 235 # store the upload ID and hash in the file upload field 236 my $id = $upload->id; 237 my $hash = $upload->hash; 238 $r->param($u->name => "$id $hash"); 239 } 240 241 # create these out here. they should fail if they don't have the right information 242 # this lets us not be so careful about whether these objects are defined when we use them. 243 # instead, we just create the behavior that if they don't have a valid $db they fail. 244 my $authz = new WeBWorK::Authz($r); 245 $r->authz($authz); 246 247 # figure out which authentication modules to use 248 #my $user_authen_module; 249 #my $proctor_authen_module; 250 #if (ref $ce->{authen}{user_module} eq "HASH") { 251 # if (exists $ce->{authen}{user_module}{$ce->{dbLayoutName}}) { 252 # $user_authen_module = $ce->{authen}{user_module}{$ce->{dbLayoutName}}; 253 # } else { 254 # $user_authen_module = $ce->{authen}{user_module}{"*"}; 255 # } 256 #} else { 257 # $user_authen_module = $ce->{authen}{user_module}; 258 #} 259 #if (ref $ce->{authen}{proctor_module} eq "HASH") { 260 # if (exists $ce->{authen}{proctor_module}{$ce->{dbLayoutName}}) { 261 # $proctor_authen_module = $ce->{authen}{proctor_module}{$ce->{dbLayoutName}}; 262 # } else { 263 # $proctor_authen_module = $ce->{authen}{proctor_module}{"*"}; 264 # } 265 #} else { 266 # $proctor_authen_module = $ce->{authen}{proctor_module}; 267 #} 268 269 my $user_authen_module = WeBWorK::Authen::class($ce, "user_module"); 270 271 runtime_use $user_authen_module; 272 my $authen = $user_authen_module->new($r); 273 debug("Using user_authen_module $user_authen_module: $authen\n"); 274 $r->authen($authen); 275 276 my $db; 277 278 if ($displayArgs{courseID}) { 279 debug("We got a courseID from the URLPath, now we can do some stuff:\n"); 280 281 unless (-e $ce->{courseDirs}->{root}) { 282 die "Course '$displayArgs{courseID}' not found: $!"; 283 } 284 285 debug("...we can create a database object...\n"); 286 $db = new WeBWorK::DB($ce->{dbLayout}); 287 debug("(here's the DB handle: $db)\n"); 288 $r->db($db); 289 290 my $authenOK = $authen->verify; 291 if ($authenOK) { 292 my $userID = $r->param("user"); 293 debug("Hi, $userID, glad you made it.\n"); 294 295 # tell authorizer to cache this user's permission level 296 $authz->setCachedUser($userID); 297 298 debug("Now we deal with the effective user:\n"); 299 my $eUserID = $r->param("effectiveUser") || $userID; 300 debug("userID=$userID eUserID=$eUserID\n"); 301 if ($userID ne $eUserID) { 302 debug("userID and eUserID differ... seeing if userID has 'become_student' permission.\n"); 303 my $su_authorized = $authz->hasPermissions($userID, "become_student"); 304 if ($su_authorized) { 305 debug("Ok, looks like you're allowed to become $eUserID. Whoopie!\n"); 306 } else { 307 debug("Uh oh, you're not allowed to become $eUserID. Nice try!\n"); 308 die "You are not allowed to act as another user.\n"; 309 } 310 } 311 312 # set effectiveUser in case it was changed or not set to begin with 313 $r->param("effectiveUser" => $eUserID); 314 315 # if we're doing a proctored test, after the user has been authenticated 316 # we need to also check on the proctor. note that in the gateway quiz 317 # module we double check this, to be sure that someone isn't taking a 318 # proctored quiz but calling the unproctored ContentGenerator 319 my $urlProducedPath = $urlPath->path(); 320 if ( $urlProducedPath =~ /proctored_quiz_mode/i ) { 321 my $proctor_authen_module = WeBWorK::Authen::class($ce, "proctor_module"); 322 runtime_use $proctor_authen_module; 323 my $authenProctor = $proctor_authen_module->new($r); 324 debug("Using proctor_authen_module $proctor_authen_module: $authenProctor\n"); 325 my $procAuthOK = $authenProctor->verify(); 326 327 if (not $procAuthOK) { 328 $displayModule = PROCTOR_LOGIN_MODULE; 329 } 330 } 331 } else { 332 debug("Bad news: authentication failed!\n"); 333 $displayModule = LOGIN_MODULE; 334 debug("set displayModule to $displayModule\n"); 335 } 336 } 337 338 # store the time before we invoke the content generator 339 my $cg_start = time; # this is Time::HiRes's time, which gives floating point values 340 341 debug(("-" x 80) . "\n"); 342 debug("Finally, we'll load the display module...\n"); 343 344 runtime_use($displayModule); 345 346 debug("...instantiate it...\n"); 347 348 my $instance = $displayModule->new($r); 349 350 debug("...and call it:\n"); 351 debug("-------------------- call to ${displayModule}::go\n"); 352 353 my $result = $instance->go(); 354 355 debug("-------------------- call to ${displayModule}::go\n"); 356 357 my $cg_end = time; 358 my $cg_duration = $cg_end - $cg_start; 359 writeTimingLogEntry($ce, "[".$r->uri."]", sprintf("runTime = %.3f sec", $cg_duration)." ".$ce->{dbLayoutName}, ""); 360 361 debug("returning result: " . (defined $result ? $result : "UNDEF") . "\n"); 362 #@LimitedPolynomial::BOP::ISA; #FIXME this is needed to zero out 363 #@LimitedPolynomial::UOP::ISA; 364 #\@LimitedPolynomial::BOP::ISA and prevent error messages of the form 365 #[Sat May 15 14:23:08 2010] [warn] [client 127.0.0.1] [/webwork2/gage_course/test_set/6/] 366 #Can't locate package LimitedPolynomial::BOP for @LimitedPolynomial::BOP::add::ISA at /opt/webwork/webwork2/lib/Apache/WeBWorK.pm line 115., referer: http://localhost/webwork2/gage_course/test_set/6/ no one knows why 367 return $result; 368 } 369 370 sub mungeParams { 371 my ($r) = @_; 372 373 my @paramQueue; 374 375 # remove all the params from the request, and store them in the param queue 376 foreach my $key ($r->param) { 377 push @paramQueue, [ $key => [ $r->param($key) ] ]; 378 $r->parms->unset($key) 379 } 380 381 # exhaust the param queue, decoding encoded params 382 while (@paramQueue) { 383 my ($key, $values) = @{ shift @paramQueue }; 384 385 if ($key =~ m/\,/) { 386 # we have multiple params encoded in a single param 387 # split them up and add them to the end of the queue 388 push @paramQueue, map { [ $_, $values ] } split m/\,/, $key; 389 } elsif ($key =~ m/\:/) { 390 # we have a whole param encoded in a key 391 # split it up and add it to the end of the queue 392 my ($newKey, $newValue) = split m/\:/, $key; 393 push @paramQueue, [ $newKey, [ $newValue ] ]; 394 } else { 395 # this is a "normal" param 396 # add it to the param list 397 if (defined $r->param($key)) { 398 # the param already exists -- append the values we have 399 $r->param($key => [ $r->param($key), @$values ]); 400 } else { 401 # the param doesn't exist -- create it with the values we have 402 $r->param($key => $values); 403 } 404 } 405 } 406 } 407 408 =head1 AUTHOR 409 410 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam 411 Hathaway, sh002i at math.rochester.edu. 412 413 =cut 414 415 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |