[Bio] / FortyEight / WebPage / Login.pm Repository:
ViewVC logotype

Annotation of /FortyEight/WebPage/Login.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.13 - (view) (download) (as text)

1 : paarmann 1.1 package WebPage::Login;
2 : paczian 1.2
3 : paarmann 1.9 use base qw( WebApp::WebPage );
4 : paarmann 1.1
5 :     1;
6 :    
7 :     use CGI;
8 :     use Mail::Mailer;
9 :     use Carp qw( confess );
10 :    
11 :     =pod
12 :    
13 :     =head1 NAME
14 :    
15 :     Login - an instance of WebPage which handles login, password retrieval and registration of new accounts.
16 :    
17 :     =head1 DESCRIPTION
18 :    
19 :     TODO
20 :    
21 :     =head1 METHODS
22 :    
23 :     =over 4
24 :    
25 :     =item * B<output> ()
26 :    
27 :     Returns the html output of the Login page.
28 :    
29 :     =cut
30 :    
31 :     sub output {
32 :     my ($self) = @_;
33 :    
34 :     my $cgi = $self->application->cgi;
35 :     my $session = $self->application->session;
36 :     my $content = 'unknown action';
37 :    
38 :     my $action = 'default';
39 :     if (defined($cgi->param('action'))) {
40 :     $action = $cgi->param('action');
41 :     }
42 :    
43 : paarmann 1.8 if ($action eq 'logout') {
44 : paczian 1.2 $self->title('Annotation Server - Login');
45 :     $content = "<div style='padding-left: 50px; padding-top: 50px;'>" . perform_logout($self, $session, $cgi);
46 :     $content .= login($self, $session, $cgi) . "</div>";
47 : paarmann 1.1 }
48 : paarmann 1.8 else {
49 :    
50 :     # none of these pages should be shown when a user is logged in
51 :     my $webpage = $self->load_page_after_login;
52 :     if ($webpage) {
53 :     return $webpage->output();
54 :     }
55 :    
56 :     if ($action eq 'default') {
57 :     $self->title('Annotation Server - Login');
58 :     $content = "<div style='padding-left: 50px; padding-top: 50px;'>" . login($self, $session, $cgi) . "</div>";
59 :     } elsif ($action eq 'check_login') {
60 :     $content = check_login($self, $session, $cgi);
61 :     } elsif ($action eq 'forgot_password') {
62 :     $self->title('Annotation Server - Reset Password');
63 :     $content = forgot_password($self, $session, $cgi);
64 :     } elsif ($action eq 'reset_password') {
65 :     $self->title('Annotation Server - Reset Password');
66 :     $content = reset_password($self, $session, $cgi);
67 :     } elsif ($action eq 'register') {
68 :     $self->title('Annotation Server - Register a new Account');
69 :     $content = register($self, $session, $cgi);
70 :     } elsif ($action eq 'perform_registration') {
71 :     $self->title('Annotation Server - Register a new Account');
72 :     $content = perform_registration($self, $session, $cgi);
73 :     }
74 :    
75 :     }
76 : paarmann 1.1
77 :     return $content;
78 :     }
79 :    
80 :     =pod
81 :    
82 :     =item * B<login> ()
83 :    
84 :     Returns the html for a login screen.
85 :    
86 :     =cut
87 :    
88 :     sub login {
89 :     my ($self, $session, $cgi, $failed) = @_;
90 :    
91 : paczian 1.2 my $content = $self->start_form;
92 : paarmann 1.1
93 :     $content .= "<input type=hidden name=action value=check_login >";
94 :    
95 :     if ($failed) {
96 :     $content .= "<span class='warning'>Login or password incorrect, please retry.</span>";
97 :     }
98 :    
99 : paczian 1.11 $content .= "<p style='width: 95%;border: 1px solid black; padding-left: 5px; padding-top: 3px; padding-bottom: 5px; padding-right: 5px;'><table><tr><td><b>Note:</b></td><td>We have updated the RAST-Server to Version 1.2 to provide you with our current improvements. All your jobs have been rerun at this server. Your old results have been preserved at <a href='http://www.nmpdr.org/anno-server-1-0/'>RAST v1.0</a>. For more information, visit our update information page <a href='http://www.theseed.org/wiki/RAST_update'>here</a>.</td></tr></table></p>";
100 : paczian 1.10
101 : paarmann 1.7 $content .= "<p style='width: 95%;'>While originally only designed in the <a target=_blank href='http://www.nmpdr.org'>NMPDR project</a> for the annotation of <a target=_blank href='http://www.nmpdr.org/content/organisms.php'>a specific set of pathogens</a>, RAST (Rapid Annotation using Subsystem Technology) provides high quality genome annotations for prokaryotes across the whole phylogenetic tree.</p>\n";
102 : paczian 1.4
103 : paarmann 1.7 $content .= "<p style='width: 95%;'>As the number of sequenced more or less complete bacterial and archaeal genomes is constantly rising, the need for high quality automated initial annotations is rising with it. In response to numerous requests for a SEED-quality automated annotation service, we provide RAST as a free service to the community. It leverages the data and procedures established within the <a target=_blank href='http://www.theseed.org'>SEED framework</a> to provide automated high quality gene calling and functional annotation. RAST supports both the automated annotation of high quality genome sequences AND the analysis of draft genomes. While the actual computational costs are reasonably low, the \"guaranteed\" turn-around time for this service is 48 hours.</p>\n";
104 :    
105 :     $content .= "<p style='width: 95%;'>Please note that while the SEED environment and SEED data structures (most prominently <a target=_blank href='http://www.theseed.org/wiki/Glossary#FIGfam'>FIGfams</a>) are used to compute the automatic annotations, the data is NOT added into the SEED automatically. Users can however request inclusion of a their genome in the SEED. Once annotation is completed, genomes can be downloaded in a variety of formats or viewed online. The genome annotation provided does include a mapping of genes to <a target=_blank href='http://www.theseed.org/wiki/Glossary#Subsystem'>subsystems</a> and a metabolic reconstruction.</p>";
106 :     $content .= "<p style='width: 95%;'>To be able to contact you once the computation is finished and in case user intervention is required, we request that users register with email address.</\p>\n";
107 : paczian 1.4
108 : paarmann 1.1 $content .= "<table>";
109 :     $content .= "<tr><td>Login</td><td><input type=text name=login></td></tr>";
110 :     $content .= "<tr><td>Password</td><td><input type=password name=password></td>";
111 :     $content .= "<td><input type=submit value='Login'></td></tr>";
112 :     $content .= "</table>";
113 :    
114 : paczian 1.2 $content .= "<br/><br/><a href='" . $self->url . "action=forgot_password'>Forgot your password?</a><br/>";
115 : paarmann 1.1 $content .= "<a href='" . $self->url . "action=register'>Register a new account</a>";
116 :    
117 :     $content .= "</form>";
118 :    
119 :     return $content;
120 :     }
121 :    
122 :     =pod
123 :    
124 :     =item * B<check_login> ()
125 :    
126 :     Tries to initialize a user using the login and password in the current cgi object.
127 :     On success calls the redirect method of the WebApplication object, on failure
128 :     calls the login method with the 'failed' parameter.
129 :    
130 :     =cut
131 :    
132 :     sub check_login {
133 :     my ($self, $session, $cgi) = @_;
134 :    
135 : paczian 1.2 # get login and password from cgi
136 : paarmann 1.1 my $login = $cgi->param('login');
137 :     my $password = $cgi->param('password');
138 :    
139 : paczian 1.2 # try to initialize user
140 : paarmann 1.1 my $user = undef;
141 : paczian 1.2 my $possible_users = $self->application->dbmaster->User->get_objects( { login => $login } );
142 :     if (@$possible_users) {
143 :     $user = $possible_users->[0];
144 :     if (crypt($password, $user->password) eq $user->password) {
145 :     $session->user($user);
146 :     } else {
147 :     $user = undef;
148 : paarmann 1.1 }
149 :     }
150 : paczian 1.2
151 :     # if user initialization is successful, call first page
152 :     # otherwise recall login page with login failed
153 : paarmann 1.8 my $webpage = $self->load_page_after_login;
154 :     if ($webpage) {
155 : paarmann 1.6
156 :     # update menu
157 : paarmann 1.7 $self->application->menu->add_category( "Logout", "rast.cgi?page=Login&action=logout" );
158 :     $self->application->menu->add_category( "Manage Account", "rast.cgi?page=UserManagement");
159 :     $self->application->menu->add_category( "Your Jobs", "rast.cgi?page=Jobs");
160 :     $self->application->menu->add_entry( "Your Jobs", "Jobs Overview", "rast.cgi?page=Jobs" );
161 :     $self->application->menu->add_entry( "Your Jobs", "Upload New Job", "rast.cgi?page=Upload" );
162 : paarmann 1.6
163 : paarmann 1.1 return $webpage->output();
164 : paczian 1.2 } else {
165 :     return "<div style='padding-left: 50px; padding-top: 50px;'>" . $self->login($session, $cgi, 1) . "</div>";
166 :     }
167 :     }
168 :    
169 :     =pod
170 :    
171 : paarmann 1.8 =item * B<load_page_after_login> ()
172 :    
173 :     Expires the session cookie.
174 :    
175 :     =cut
176 :    
177 :     sub load_page_after_login {
178 :     my ($self) = @_;
179 :    
180 :     $self->title('Annotation Server - Jobs Overview');
181 :    
182 :     # if the session has a user, call the first page
183 :     if (defined($self->application->session->user)) {
184 :    
185 :     use WebPage::Jobs;
186 :     my $webpage = WebPage::Jobs->new($self->application);
187 :     unless (ref $webpage) {
188 :     confess "Unable to initialize Jobs Page.\n";
189 :     }
190 :     $self->application->cgi->delete('action');
191 :    
192 :     return $webpage;
193 :     }
194 :    
195 :     return undef;
196 :     }
197 :    
198 :    
199 :     =pod
200 :    
201 : paczian 1.2 =item * B<perform_logout> ()
202 :    
203 :     Expires the session cookie.
204 : paarmann 1.1
205 : paczian 1.2 =cut
206 :    
207 :     sub perform_logout {
208 :     my ($self, $session, $cgi) = @_;
209 :    
210 :     $session->expire_cookie();
211 :     $session->user(undef);
212 : paarmann 1.7 $self->application->menu->flush();
213 :    
214 : paczian 1.2 my $content = "<span class='info'>You have been logged out.</span><br/><br/>";
215 : paarmann 1.1
216 : paczian 1.2 return $content;
217 : paarmann 1.1 }
218 :    
219 :     =pod
220 :    
221 :     =item * B<register> ()
222 :    
223 :     Returns the html for the registration of a new user.
224 :    
225 :     =cut
226 :    
227 :     sub register {
228 :     my ($self, $session, $cgi) = @_;
229 :    
230 : paczian 1.2 my $content = $self->start_form;
231 : paarmann 1.1
232 : paczian 1.2 $content .= "<div style='padding-left: 50px; padding-top: 50px;'><input type=hidden name=action value=perform_registration >";
233 : paarmann 1.1
234 :     $content .= "<table>";
235 :     $content .= "<tr><td>First Name</td><td><input type=text name=firstname></td></tr>";
236 :     $content .= "<tr><td>Last Name</td><td><input type=text name=lastname></td></tr>";
237 : paczian 1.2 $content .= "<tr><td>eMail</td><td><input type=text name=email></td></tr>";
238 :     $content .= "<tr><td>Organization</td><td><input type=text name=organisation></td></tr>";
239 : paczian 1.13 $content .= "<tr><td colspan=2>Please note that you may not include html in the note field.</td>";
240 : paarmann 1.1 $content .= "<tr><td>Note</td><td><textarea cols=50 rows=5 name=note></textarea></td>";
241 :     $content .= "<td><input type=submit value='Request'></td></tr>";
242 :     $content .= "</table>";
243 :    
244 : paarmann 1.7 $content .= "</form><br/><a href='".$self->application->url."?page=Login'>return to login</a></div>";
245 : paarmann 1.1
246 :     return $content;
247 :     }
248 :    
249 :     =pod
250 :    
251 :     =item * B<perform_registration> ()
252 :    
253 :     Sends a mail to the administrator mailing list of the site. The mail will contain
254 :     the registration information entered by the user and a link to the webpage.
255 :    
256 :     =cut
257 :    
258 :     sub perform_registration {
259 :     my ($self, $session, $cgi) = @_;
260 :    
261 : paczian 1.13 # test for bots
262 :     if ($cgi->param('note') =~ /\<(.*)\>/) {
263 :     return "<h2>You may not use html in the note field, please retry.</h2>" . $self->register($session, $cgi);
264 :     }
265 :    
266 : paczian 1.2 my $content = "<div style='padding-left: 50px; padding-top: 50px;'>";
267 :    
268 :     unless ($cgi->param('email')) {
269 :     return "You must enter a valid eMail address.<br/>" . $self->register($session, $cgi);
270 :     }
271 :    
272 :     # check if this email already has an account
273 :     my $potential = $self->application->dbmaster->User->get_objects( { eMail => $cgi->param('email') } );
274 :     if (@$potential) {
275 :     $content .= "This eMail address is already registered for " . $potential->[0]->firstName . " " . $potential->[0]->lastName . ".";
276 :     } else {
277 :    
278 :     my $request = $self->application->dbmaster->Request->create( { eMail => $cgi->param('email'),
279 :     firstName => $cgi->param('firstname'),
280 :     lastName => $cgi->param('lastname'),
281 :     organisation => $cgi->param('organisation'),
282 :     note => $cgi->param('note') } );
283 :    
284 : paarmann 1.8 my $body = qq~A request for a new account has been submitted at the RAST annotation server website.
285 : paarmann 1.1 You are receiving this mail, because you are on the administrators mailing list for this service. The user has sent the following data:
286 :    
287 :     First Name\t:\t ~ . $cgi->param('firstname') . qq~
288 :     Last Name\t:\t ~ . $cgi->param('lastname') . qq~
289 : paczian 1.2 eMail\t\t:\t ~ . $cgi->param('email') . qq~
290 :     Organization\t:\t ~ . $cgi->param('organisation') . qq~
291 : paarmann 1.1 Note\t\t\t:\t ~ . $cgi->param('note') . qq~
292 :    
293 :     To process this request, click the following link:
294 : paczian 1.3 http://www.nmpdr.org/anno-server/~;
295 : paczian 1.2
296 :     my $mailer = Mail::Mailer->new();
297 :     $mailer->open({ From => &admin_email,
298 :     To => &admin_email,
299 : paarmann 1.8 Subject => "RAST server: registration request",
300 : paczian 1.2 })
301 :     or die "Can't open: $!\n";
302 :     print $mailer $body;
303 :     $mailer->close();
304 :    
305 :     $content .= "Your registration request has been sent.<br/>You will be notified as soon as your request has been processed.";
306 :     }
307 : paarmann 1.1
308 : paarmann 1.7 $content .= "<br/><br/><a href='".$self->application->url."?page=Login'>return to login</a></div>";
309 : paarmann 1.1
310 :     return $content;
311 :     }
312 :    
313 :     =pod
314 :    
315 :     =item * B<forgot_password> ()
316 :    
317 :     Returns the html for a form for the user to enable them to resend their password.
318 :    
319 :     =cut
320 :    
321 :     sub forgot_password {
322 :     my ($self, $session, $cgi) = @_;
323 :    
324 : paczian 1.2 my $content = $self->start_form;
325 : paarmann 1.1
326 : paczian 1.2 $content .= "<div style='padding-left: 50px; padding-top: 50px;'><input type=hidden name=action value=reset_password>";
327 : paarmann 1.1
328 : paczian 1.2 $content .= "<span class=info>Enter your information to have your password reset.<br/>You will then shortly receive an email with your new password.<br/>Please change your password as soon as you receive this mail.</span>";
329 :    
330 :     $content .= "<br/><br/><table>";
331 : paarmann 1.1 $content .= "<tr><td>Login</td><td><input type=text name=login></td></tr>";
332 :     $content .= "<tr><td>eMail</td><td><input type=text name=email></td>";
333 : paczian 1.2 $content .= "<td><input type=submit value='Reset'></td></tr>";
334 : paarmann 1.1 $content .= "</table>";
335 :    
336 : paarmann 1.7 $content .= "</form><br/><a href='".$self->application->url."?page=Login'>return to login</a></div>";
337 : paarmann 1.1
338 :     return $content;
339 :     }
340 :    
341 :     =pod
342 :    
343 : paczian 1.2 =item * B<reset_password> ()
344 : paarmann 1.1
345 :     Tries to initialize a user, given the email and login parameters in the current cgi object.
346 : paczian 1.2 On success, informs the user that their password has been reset, on failure informs
347 : paarmann 1.1 the user that login and email do not match.
348 :    
349 :     =cut
350 :    
351 : paczian 1.2 sub reset_password {
352 : paarmann 1.1 my ($self, $session, $cgi) = @_;
353 :    
354 :     # get all parameters
355 :     my $login = $cgi->param('login') || "";
356 :     my $email = $cgi->param('email') || "";
357 :    
358 : paczian 1.2 # initialize content
359 : paarmann 1.1 my $content = "";
360 :    
361 : paczian 1.2 # try to initialize user
362 :     my $user = undef;
363 :     my $possible_users = $self->application->dbmaster->User->get_objects( { login => $login } );
364 :     if (@$possible_users) {
365 :     $user = $possible_users->[0];
366 : paczian 1.12 unless ($user->eMail eq $email) {
367 : paczian 1.2 $user = undef;
368 :     }
369 :     }
370 :    
371 : paarmann 1.1 # check whether login and email match
372 : paczian 1.2 if (defined($user)) {
373 :     my $new_password = join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64, rand 64, rand 64, rand 64, rand 64, rand 64, rand 64];
374 :    
375 : paarmann 1.8 my $body = qq~This email was automatically generated by the RAST annotation server.
376 : paarmann 1.1 You have requested your password to be resent. Your password is:
377 :    
378 : paczian 1.2 $new_password
379 :    
380 :     Please go to
381 : paarmann 1.1
382 : paczian 1.3 http://www.nmpdr.org/anno-server/
383 : paarmann 1.1
384 : paczian 1.2 and change your password.~;
385 :    
386 :     my $mailer = Mail::Mailer->new();
387 :     $mailer->open({ From => &admin_email,
388 :     To => $email,
389 : paarmann 1.8 Subject => "RAST server: password request",
390 : paczian 1.2 })
391 :     or die "Can't open: $!\n";
392 :     print $mailer $body;
393 :     $mailer->close();
394 :    
395 :     # reset the user's password
396 :     my $seed = join '', ('.', '/', 0..9, 'A'..'Z', 'a'..'z')[rand 64, rand 64];
397 :     $new_password = crypt($new_password, $seed);
398 :     $user->password($new_password);
399 :    
400 :     $content = "Your password has been resent to your email address.<br/><a href='" . $self->url . "'>return to login</a>";
401 : paarmann 1.1 } else {
402 : paczian 1.2 $content = "Login and user do not match.";
403 : paarmann 1.1 }
404 :    
405 :     return $content;
406 :     }
407 :    
408 :     ################
409 :    
410 :     sub admin_email {
411 :     ### stub until user management exists
412 : paarmann 1.8 return $FIG_Config::rast_admin_email;
413 : paarmann 1.1 }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3