|
|
1 | #TODO: The HTML code here has two failings: |
|
|
2 | # - It is hard-coded into the script, which is against policy |
|
|
3 | # - It is very ugly and hastily written |
|
|
4 | |
|
|
5 | # Other than that, this file is done for the forseeable future, |
|
|
6 | # and should serve us nicely unless the interface to WeBWorK::Authen |
|
|
7 | # changes. |
|
|
8 | |
| 1 | package WeBWorK::Login; |
9 | package WeBWorK::Login; |
| 2 | |
10 | |
| 3 | sub new($$$) { |
11 | use WeBWorK::ContentGenerator; |
| 4 | my $class = shift; |
12 | |
| 5 | my $self = {}; |
13 | our @ISA = qw(WeBWorK::ContentGenerator); |
| 6 | ($self->{r}, $self->{courseEnvironment}) = @_; |
|
|
| 7 | bless $self, $class; |
|
|
| 8 | return $self; |
|
|
| 9 | } |
|
|
| 10 | |
14 | |
| 11 | sub go($) { |
15 | sub go($) { |
| 12 | my $self = shift; |
16 | my $self = shift; |
| 13 | my $r = $self->{r}; |
17 | my $r = $self->{r}; |
| 14 | my $course_env = $self->{courseEnvironment}; |
18 | my $course_env = $self->{courseEnvironment}; |
| … | |
… | |
| 20 | |
24 | |
| 21 | |
25 | |
| 22 | $r->content_type("text/html"); |
26 | $r->content_type("text/html"); |
| 23 | $r->send_http_header; |
27 | $r->send_http_header; |
| 24 | print '<html><head><title>WeBWorK Login Page</title></head><body>', |
28 | print '<html><head><title>WeBWorK Login Page</title></head><body>', |
| 25 | '<h1>WeBWorK Login Page</h1>', |
29 | '<h1>WeBWorK Login Page</h1>'; |
|
|
30 | |
|
|
31 | # WeBWorK::Authen::verify will set the note "authen_error" |
|
|
32 | # if invalid authentication is found. If this is done, it's a signal to |
|
|
33 | # us to yell at the user for doing that, since Authen isn't a content- |
|
|
34 | # generating module. |
|
|
35 | if ($r->notes("authen_error")) { |
|
|
36 | print '<font color="red"><b>',$r->notes("authen_error"),"</b></font><br>"; |
|
|
37 | } |
|
|
38 | |
|
|
39 | # $self->print_form_data(""," = ","<br>\n"); |
|
|
40 | |
| 26 | "Please enter your username and password for <b>", |
41 | print "Please enter your username and password for <b>", |
| 27 | $course, |
42 | $course, |
| 28 | "</b> below: <p>", |
43 | "</b> below: <p>", |
| 29 | '<form method="POST" action="',$r->uri,'">'; |
44 | '<form method="POST" action="',$r->uri,'">'; |
| 30 | |
45 | |
| 31 | # write out the form data posted to the requested URI |
46 | # write out the form data posted to the requested URI |
| 32 | my @previous_data = $r->param; |
47 | $self->print_form_data('<input type="hidden" name="','" value="',"\">\n",qr/^(user|passwd|key)$/); |
| 33 | foreach my $name (@previous_data) { |
|
|
| 34 | next if ($name =~ /^(user|passwd|key)$/); |
|
|
| 35 | my @values = $r->param($name); |
|
|
| 36 | foreach my $value (@values) { |
|
|
| 37 | print "\n<input type=\"hidden\" name=\"$name\" value=\"$value\">\n"; |
|
|
| 38 | } |
|
|
| 39 | } |
|
|
| 40 | |
48 | |
| 41 | print '<input type="textfield" name="user" value="',$user,'"><br>', |
49 | print '<table border="0"><tr><td>Username:</td><td><input type="textfield" name="user" value="',$user,'"><br></td></tr>', |
| 42 | '<input type="password" name="passwd" value="',$passwd,'"><br>', |
50 | '<tr><td>Password:</td><td><input type="password" name="passwd" value="',$passwd,'"><i>(Will not be echoed)</i></tr></table>', |
| 43 | '<input type="submit" value="Continue">', |
51 | '<input type="submit" value="Continue">', |
| 44 | '</form></body></html>'; |
52 | '</form></body></html>'; |
| 45 | |
53 | |
| 46 | return OK; |
54 | return OK; |
| 47 | } |
55 | } |