| … | |
… | |
| 14 | package Apache::WeBWorK; |
14 | package Apache::WeBWorK; |
| 15 | |
15 | |
| 16 | use strict; |
16 | use strict; |
| 17 | use Apache::Constants qw(:common REDIRECT); |
17 | use Apache::Constants qw(:common REDIRECT); |
| 18 | use Apache::Request; |
18 | use Apache::Request; |
| 19 | use Data::UUID; |
|
|
| 20 | use WeBWorK::CourseEnvironment; |
19 | use WeBWorK::CourseEnvironment; |
| 21 | use WeBWorK::Authen; |
20 | use WeBWorK::Authen; |
| 22 | use WeBWorK::Authz; |
21 | use WeBWorK::Authz; |
| 23 | use WeBWorK::ContentGenerator::Test; |
22 | use WeBWorK::ContentGenerator::Test; |
| 24 | use WeBWorK::ContentGenerator::Login; |
23 | use WeBWorK::ContentGenerator::Login; |
| 25 | use WeBWorK::ContentGenerator::ProblemSets; |
24 | use WeBWorK::ContentGenerator::ProblemSets; |
| 26 | use WeBWorK::ContentGenerator::ProblemSet; |
25 | use WeBWorK::ContentGenerator::ProblemSet; |
| 27 | use WeBWorK::ContentGenerator::Problem; |
26 | #use WeBWorK::ContentGenerator::Problem; |
| 28 | use WeBWorK::Constants qw(SECRET); |
|
|
| 29 | |
|
|
| 30 | # Yes, this is supposed to be in the global namespace. We're only setting it if |
|
|
| 31 | my $SECRET; |
|
|
| 32 | |
27 | |
| 33 | # Sets up the common environment needed for every subsystem and then dispatches |
28 | # Sets up the common environment needed for every subsystem and then dispatches |
| 34 | # the page request to the appropriate content generator. |
29 | # the page request to the appropriate content generator. |
| 35 | |
30 | |
| 36 | # This function has MANY MANY points of exit (return statements)! woo! |
31 | # This function has MANY MANY points of exit (return statements)! woo! |
| 37 | # call it a quirk of my coding style. I think it makes it easier to read in this case. |
32 | # call it a quirk of my coding style. I think it makes it easier to read in this case. |
| 38 | |
33 | |
| 39 | sub handler() { |
34 | sub handler() { |
| 40 | my $r = Apache::Request->new(shift); # have to deal with unpredictable GET or POST data ,and sift through it for the key. So use Apache::Request |
35 | my $r = Apache::Request->new(shift); # have to deal with unpredictable GET or POST data, and sift through it for the key. So use Apache::Request |
| 41 | |
36 | |
| 42 | # This stuff is pretty much copied out of the O'Reilly mod_perl book. |
37 | # This stuff is pretty much copied out of the O'Reilly mod_perl book. |
| 43 | # It's for figuring out the basepath. I may change this up if I |
38 | # It's for figuring out the basepath. I may change this up if I |
| 44 | # find a better way to do it. |
39 | # find a better way to do it. |
| 45 | my $path_info = $r->path_info; |
40 | my $path_info = $r->path_info; |
| … | |
… | |
| 71 | # check to see if the course directory exists. |
66 | # check to see if the course directory exists. |
| 72 | if (!-e $course_env->{webworkDirs}->{courses} . "/$course") { |
67 | if (!-e $course_env->{webworkDirs}->{courses} . "/$course") { |
| 73 | return DECLINED; |
68 | return DECLINED; |
| 74 | } |
69 | } |
| 75 | |
70 | |
| 76 | |
|
|
| 77 | |
|
|
| 78 | ### Begin dispatching ### |
71 | ### Begin dispatching ### |
| 79 | |
72 | |
| 80 | # WeBWorK::Authen::verify erases the passwd field and sets the key field |
73 | # WeBWorK::Authen::verify erases the passwd field and sets the key field |
| 81 | # if login is successful. |
74 | # if login is successful. |
| 82 | if (!WeBWorK::Authen->new($r, $course_env)->verify) { |
75 | if (!WeBWorK::Authen->new($r, $course_env)->verify) { |
| … | |
… | |
| 88 | my $effectiveUser = $r->param("effectiveUser"); |
81 | my $effectiveUser = $r->param("effectiveUser"); |
| 89 | my $user = $r->param("user"); |
82 | my $user = $r->param("user"); |
| 90 | my $su_authorized = WeBWorK::Authz->new($r, $course_env)->hasPermissions($user, "become_student", $effectiveUser); |
83 | my $su_authorized = WeBWorK::Authz->new($r, $course_env)->hasPermissions($user, "become_student", $effectiveUser); |
| 91 | # This hoary statement has the effect of forcing effectiveUser to equal user unless |
84 | # This hoary statement has the effect of forcing effectiveUser to equal user unless |
| 92 | # the user is otherwise authorized. |
85 | # the user is otherwise authorized. |
| 93 | if (!defined $effectiveUser || !($user ne $effectiveUser && $su_authorized)) { |
86 | if (!($user ne $effectiveUser && $su_authorized) || !defined $effectiveUser) { |
| 94 | $r->param("effectiveUser",$user); |
87 | $r->param("effectiveUser",$user); |
| 95 | } |
88 | } |
| 96 | |
89 | |
| 97 | my $arg = shift @components; |
90 | my $arg = shift @components; |
| 98 | if (!defined $arg) { # We want the list of problem sets |
91 | if (!defined $arg) { # We want the list of problem sets |
| … | |
… | |
| 114 | ### |
107 | ### |
| 115 | } |
108 | } |
| 116 | else { |
109 | else { |
| 117 | # We've got the name of a problem |
110 | # We've got the name of a problem |
| 118 | my $problem = $ps_arg; |
111 | my $problem = $ps_arg; |
| 119 | return WeBWorK::ContentGenerator::Problem->new($r, $course_env)->go($problem_set, $problem); |
112 | # return WeBWorK::ContentGenerator::Problem->new($r, $course_env)->go($problem_set, $problem); |
| 120 | } |
113 | } |
| 121 | } |
114 | } |
| 122 | |
115 | |
| 123 | } |
116 | } |
| 124 | |
117 | |