Parent Directory
| 
Revision Log
Making a non-essential change
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.55 2004/05/13 18:28:32 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 # just testing 17 18 package WeBWorK; 19 20 =head1 NAME 21 22 WeBWorK - Dispatch requests to the appropriate content generator. 23 24 =head1 SYNOPSIS 25 26 my $r = Apache->request; 27 my $result = eval { WeBWorK::dispatch($r) }; 28 die "something bad happened: $@" if $@; 29 30 =head1 DESCRIPTION 31 32 C<WeBWorK> is the dispatcher for the WeBWorK system. Given an Apache request 33 object, it performs authentication and determines which subclass of 34 C<WeBWorK::ContentGenerator> to call. 35 36 =cut 37 38 BEGIN { $main::VERSION = "2.0"; } 39 40 41 my $timingON = 0; 42 43 use strict; 44 use warnings; 45 use Apache::Constants qw(:common REDIRECT DONE); 46 use WeBWorK::Authen; 47 use WeBWorK::Authz; 48 use WeBWorK::CourseEnvironment; 49 use WeBWorK::DB; 50 use WeBWorK::Timing; 51 use WeBWorK::Upload; 52 use WeBWorK::Utils qw(runtime_use); 53 use WeBWorK::Request; 54 use WeBWorK::URLPath; 55 56 use constant AUTHEN_MODULE => "WeBWorK::ContentGenerator::Login"; 57 58 #sub debug(@) { print STDERR "dispatch_new: ", join("", @_) }; 59 sub debug(@) { }; 60 61 sub dispatch($) { 62 my ($apache) = @_; 63 my $r = new WeBWorK::Request $apache; 64 65 my $method = $r->method; 66 my $location = $r->location; 67 my $uri = $r->uri; 68 my $path_info = $r->path_info | ""; 69 my $args = $r->args || ""; 70 my $webwork_root = $r->dir_config("webwork_root"); 71 my $pg_root = $r->dir_config("pg_root"); 72 73 #$r->send_http_header("text/html"); 74 75 #print CGI::start_pre(); 76 77 debug("Hi, I'm the new dispatcher!\n"); 78 debug(("-" x 80) . "\n"); 79 80 debug("Okay, I got some basic information:\n"); 81 debug("The apache location is $location\n"); 82 debug("The request method is $method\n"); 83 debug("The URI is $uri\n"); 84 debug("The path-info is $path_info\n"); 85 debug("The argument string is $args\n"); 86 debug("The WeBWorK root directory is $webwork_root\n"); 87 debug("The PG root directory is $pg_root\n"); 88 debug(("-" x 80) . "\n"); 89 90 debug("The first thing we need to do is munge the path a little:\n"); 91 92 my ($path) = $uri =~ m/$location(.*)/; 93 $path = "/" if $path eq ""; # no path at all 94 95 debug("We can't trust the path-info, so we make our own path.\n"); 96 debug("path-info claims: $path_info\n"); 97 debug("but it's really: $path\n"); 98 debug("(if it's empty, we set it to \"/\".)\n"); 99 100 $path =~ s|/+|/|g; 101 debug("...and here it is without repeated slashes: $path\n"); 102 103 # lookbehind assertion for "not a slash" 104 # matches the boundary after the last char 105 $path =~ s|(?<=[^/])$|/|; 106 debug("...and here it is with a trailing slash: $path\n"); 107 108 debug(("-" x 80) . "\n"); 109 110 debug("Now we need to look at the path a little to figure out where we are\n"); 111 112 debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); 113 my $urlPath = WeBWorK::URLPath->newFromPath($path); 114 debug("-------------------- call to WeBWorK::URLPath::newFromPath\n"); 115 116 unless ($urlPath) { 117 debug("This path is invalid... see you later!\n"); 118 return DECLINED; 119 } 120 121 my $displayModule = $urlPath->module; 122 my %displayArgs = $urlPath->args; 123 124 debug("The display module for this path is: $displayModule\n"); 125 debug("...and here are the arguments we'll pass to it:\n"); 126 foreach my $key (keys %displayArgs) { 127 debug("\t$key => $displayArgs{$key}\n"); 128 } 129 130 unless ($displayModule) { 131 debug("The display module is empty, so we can DECLINE here.\n"); 132 return DECLINED; 133 } 134 135 my $selfPath = $urlPath->path; 136 my $parent = $urlPath->parent; 137 my $parentPath = $parent ? $parent->path : "<no parent>"; 138 139 debug("Reconstructing the original path gets us: $selfPath\n"); 140 debug("And we can generate the path to our parent, too: $parentPath\n"); 141 debug("(We could also figure out who our children are, but we'd need to supply additional arguments.)\n"); 142 debug(("-" x 80) . "\n"); 143 144 debug("The URLPath looks good, we'll add it to the request.\n"); 145 $r->urlpath($urlPath); 146 147 debug("Now we want to look at the parameters we got.\n"); 148 149 debug("The raw params:\n"); 150 foreach my $key ($r->param) { 151 debug("\t$key\n"); 152 debug("\t\t$_\n") foreach $r->param($key); 153 } 154 155 #mungeParams($r); 156 157 debug("The munged params:\n"); 158 foreach my $key ($r->param) { 159 debug("\t$key\n"); 160 debug("\t\t$_\n") foreach $r->param($key); 161 } 162 163 debug(("-" x 80) . "\n"); 164 165 debug("We need to get a course environment (with or without a courseID!)\n"); 166 my $ce = new WeBWorK::CourseEnvironment($webwork_root, $location, $pg_root, $displayArgs{courseID}); 167 debug("Here's the course environment: $ce\n"); 168 $r->ce($ce); 169 170 my @uploads = $r->upload; 171 foreach my $u (@uploads) { 172 # make sure it's a "real" upload 173 next unless $u->filename; 174 175 # store the upload 176 my $upload = WeBWorK::Upload->store($u, 177 dir => $ce->{webworkDirs}->{uploadCache} 178 ); 179 180 # store the upload ID and hash in the file upload field 181 my $id = $upload->id; 182 my $hash = $upload->hash; 183 $r->param($u->name => "$id $hash"); 184 } 185 186 my ($db, $authz); 187 188 if ($displayArgs{courseID}) { 189 debug("We got a courseID from the URLPath, now we can do some stuff:\n"); 190 debug("...we can create a database object...\n"); 191 $db = new WeBWorK::DB($ce->{dbLayout}); 192 debug("(here's the DB handle: $db)\n"); 193 $r->db($db); 194 195 debug("...and we can authenticate the remote user...\n"); 196 my $authen = new WeBWorK::Authen($r); 197 my $authenOK = $authen->verify; 198 if ($authenOK) { 199 debug("Hi, ", $r->param("user"), ", glad you made it.\n"); 200 201 debug("Authentication succeeded, so it makes sense to create an authz object...\n"); 202 $authz = new WeBWorK::Authz($r, $ce, $db); 203 debug("(here's the authz object: $authz)\n"); 204 $r->authz($authz); 205 206 debug("Now we deal with the effective user:\n"); 207 my $userID = $r->param("user"); 208 my $eUserID = $r->param("effectiveUser") || $userID; 209 debug("userID=$userID eUserID=$eUserID\n"); 210 my $su_authorized = $authz->hasPermissions($userID, "become_student", $eUserID); 211 if ($su_authorized) { 212 debug("Ok, looks like you're is allowed to become $eUserID. Whoopie!\n"); 213 } else { 214 debug("Uh oh, you're isn't allowed to become $eUserID. Nice try!\n"); 215 $eUserID = $userID; 216 } 217 $r->param("effectiveUser" => $eUserID); 218 } else { 219 debug("Bad news: authentication failed!\n"); 220 $displayModule = AUTHEN_MODULE; 221 debug("set displayModule to $displayModule\n"); 222 } 223 } 224 225 debug(("-" x 80) . "\n"); 226 debug("Finally, we'll load the display module...\n"); 227 228 runtime_use($displayModule); 229 230 debug("...instantiate it...\n"); 231 232 my $instance = $displayModule->new($r); 233 234 debug("...and call it:\n"); 235 debug("-------------------- call to ${displayModule}::go\n"); 236 237 $WeBWorK::timer = WeBWorK::Timing->new("$displayArgs{courseID}") if $timingON; 238 $WeBWorK::timer -> start() if $timingON; 239 my $result = $instance->go(); 240 241 debug("-------------------- call to ${displayModule}::go\n"); 242 243 debug("returning result: " . (defined $result ? $result : "UNDEF") . "\n"); 244 $WeBWorK::timer -> save() if $timingON; 245 return $result; 246 247 } 248 249 sub mungeParams { 250 my ($r) = @_; 251 252 my @paramQueue; 253 254 # remove all the params from the request, and store them in the param queue 255 foreach my $key ($r->param) { 256 push @paramQueue, [ $key => [ $r->param($key) ] ]; 257 $r->parms->unset($key) 258 } 259 260 # exhaust the param queue, decoding encoded params 261 while (@paramQueue) { 262 my ($key, $values) = @{ shift @paramQueue }; 263 264 if ($key =~ m/\,/) { 265 # we have multiple params encoded in a single param 266 # split them up and add them to the end of the queue 267 push @paramQueue, map { [ $_, $values ] } split m/\,/, $key; 268 } elsif ($key =~ m/\:/) { 269 # we have a whole param encoded in a key 270 # split it up and add it to the end of the queue 271 my ($newKey, $newValue) = split m/\:/, $key; 272 push @paramQueue, [ $newKey, [ $newValue ] ]; 273 } else { 274 # this is a "normal" param 275 # add it to the param list 276 if (defined $r->param($key)) { 277 # the param already exists -- append the values we have 278 $r->param($key => [ $r->param($key), @$values ]); 279 } else { 280 # the param doesn't exist -- create it with the values we have 281 $r->param($key => $values); 282 } 283 } 284 } 285 } 286 287 288 =head1 AUTHOR 289 290 Written by Dennis Lambe, malsyned at math.rochester.edu. Modified by Sam 291 Hathaway, sh002i at math.rochester.edu. 292 293 =cut 294 295 1;
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |