Annotation of loncom/interface/createaccount.pm, revision 1.3
1.1 raeburn 1: # The LearningOnline Network
2: # Allow visitors to create a user account with the username being either an
3: # institutional log-in ID (institutional authentication required - localauth
4: # or kerberos) or an e-mail address.
5: #
1.3 ! raeburn 6: # $Id: createaccount.pm,v 1.2 2008/02/29 21:01:36 raeburn Exp $
1.1 raeburn 7: #
8: # Copyright Michigan State University Board of Trustees
9: #
10: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
11: #
12: # LON-CAPA is free software; you can redistribute it and/or modify
13: # it under the terms of the GNU General Public License as published by
14: # the Free Software Foundation; either version 2 of the License, or
15: # (at your option) any later version.
16: #
17: # LON-CAPA is distributed in the hope that it will be useful,
18: # but WITHOUT ANY WARRANTY; without even the implied warranty of
19: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20: # GNU General Public License for more details.
21: #
22: # You should have received a copy of the GNU General Public License
23: # along with LON-CAPA; if not, write to the Free Software
24: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25: #
26: # /home/httpd/html/adm/gpl.txt
27: #
28: # http://www.lon-capa.org/
29: #
30: #
31: package Apache::createaccount;
32:
33: use strict;
34: use Apache::Constants qw(:common);
35: use Apache::lonacc;
36: use Apache::lonnet;
37: use Apache::loncommon;
38: use Apache::lonlocal;
1.3 ! raeburn 39: use Apache::lonauth;
1.1 raeburn 40: use Apache::resetpw;
41: use Authen::Captcha;
42: use DynaLoader; # for Crypt::DES version
43: use Crypt::DES;
1.3 ! raeburn 44: use LONCAPA qw(:DEFAULT :match);
1.1 raeburn 45:
46: sub handler {
47: my $r = shift;
48: &Apache::loncommon::content_type($r,'text/html');
49: $r->send_http_header;
50: if ($r->header_only) {
51: return OK;
52: }
1.3 ! raeburn 53:
1.1 raeburn 54: my $domain = &Apache::lonnet::default_login_domain();
55: my $domdesc = &Apache::lonnet::domain($domain,'description');
56: my $contact_name = &mt('LON-CAPA helpdesk');
57: my $contact_email = $r->dir_config('lonSupportEMail');
58: my $lonhost = $r->dir_config('lonHostID');
59: my $include = $r->dir_config('lonIncludes');
1.3 ! raeburn 60:
! 61: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['token','courseid']);
1.1 raeburn 62: &Apache::lonacc::get_posted_cgi($r);
63: &Apache::lonlocal::get_language_handle($r);
1.3 ! raeburn 64:
! 65: my $handle = &Apache::lonnet::check_for_valid_session($r);
! 66: if ($handle ne '') {
! 67: my $start_page =
! 68: &Apache::loncommon::start_page('Already logged in');
! 69: my $end_page =
! 70: &Apache::loncommon::end_page();
! 71: $r->print($start_page."\n".'<h2>'.&mt('You are already logged in').'</h2>'.
! 72: '<p>'.&mt('Please either [_1]continue the current session[_2] or [_3]logout[_4].','<a href="/adm/roles">','</a>','<a href="/adm/logout">','</a>').
! 73: '</p><p><a href="/adm/loginproblems.html">'.&mt('Problems?').'</a></p>'.$end_page);
! 74: return OK;
! 75: }
! 76:
1.1 raeburn 77: my $cancreate;
78: my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
79: if (ref($domconfig{'usercreation'}) eq 'HASH') {
1.3 ! raeburn 80: if (ref($domconfig{'usercreation'}{'cancreate'}) eq 'HASH') {
1.2 raeburn 81: if ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne 'none') {
82: $cancreate = $domconfig{'usercreation'}{'cancreate'}{'selfcreate'};
1.1 raeburn 83: }
84: }
85: }
1.3 ! raeburn 86:
! 87: my $start_page =
! 88: &Apache::loncommon::start_page('Create a user account in LON-CAPA','',
! 89: {
! 90: 'no_inline_link' => 1,});
1.1 raeburn 91: if (!$cancreate) {
1.3 ! raeburn 92: &print_header($r,$start_page);
! 93: my $output = &mt('Creation of a new user account using an e-mail address as username or a loginID from your institution is not permitted in the domain: [_1] ([_2]).',$domain,$domdesc);
! 94: $r->print($output);
! 95: $r->print(&Apache::loncommon::end_page());
! 96: return OK;
! 97: }
! 98:
! 99: my $token = $env{'form.token'};
! 100: my ($output,$nostart,$noend);
! 101: if ($token) {
! 102: ($output,$nostart,$noend) =
! 103: &process_mailtoken($r,$token,$contact_name,$contact_email,$domain,
! 104: $domain,$domdesc,$lonhost,$include,$start_page);
! 105: if ($nostart) {
! 106: if ($noend) {
! 107: return OK;
! 108: } else {
! 109: $r->print($output);
! 110: $r->print(&Apache::loncommon::end_page());
! 111: return OK;
! 112: }
! 113: } else {
! 114: &print_header($r,$start_page);
! 115: $r->print($output);
! 116: $r->print(&Apache::loncommon::end_page());
! 117: return OK;
! 118: }
! 119: }
! 120:
! 121: my $courseid;
! 122: if (defined($env{'form.courseid'})) {
! 123: $courseid = &validate_course($env{'form.courseid'});
! 124: }
! 125:
! 126: if ($env{'form.phase'} eq 'username_activation') {
! 127: (my $result,$output,$nostart) =
! 128: &username_activation($r,$env{'form.uname'},$domain,$domdesc,
! 129: $lonhost,$courseid);
! 130: if ($result eq 'ok') {
! 131: if ($nostart) {
! 132: return OK;
! 133: }
! 134: }
! 135: &print_header($r,$start_page);
! 136: $r->print($output);
! 137: $r->print(&Apache::loncommon::end_page());
! 138: return OK;
! 139: }
! 140:
! 141: &print_header($r,$start_page);
! 142: if ($env{'form.create_with_email'}) {
1.1 raeburn 143: $output = &process_email_request($env{'form.useremail'},$domain,$domdesc,
144: $contact_name,$contact_email,$cancreate,
1.3 ! raeburn 145: $lonhost,$domconfig{'usercreation'},
! 146: $courseid);
1.1 raeburn 147: } elsif ($env{'form.phase'} eq 'username_validation') {
148: $output = &username_validation($env{'form.uname'},$domain,$domdesc,
1.3 ! raeburn 149: $contact_name,$contact_email,$courseid);
! 150: } elsif (!$token) {
1.1 raeburn 151: my $now=time;
152: if ($cancreate eq 'any' || $cancreate eq 'login') {
153: my $jsh=Apache::File->new($include."/londes.js");
154: $r->print(<$jsh>);
155: $r->print(&javascript_setforms($now));
156: }
1.3 ! raeburn 157: $output = &print_username_form($domain,$domdesc,$cancreate,$now,$lonhost,
! 158: $courseid);
1.1 raeburn 159: }
160: $r->print($output);
161: $r->print(&Apache::loncommon::end_page());
162: return OK;
163: }
164:
1.3 ! raeburn 165: sub print_header {
! 166: my ($r,$start_page) = @_;
! 167: $r->print($start_page);
! 168: &Apache::lonhtmlcommon::clear_breadcrumbs();
! 169: &Apache::lonhtmlcommon::add_breadcrumb
! 170: ({href=>"/adm/createuser",
! 171: text=>"New username"});
! 172: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Create account'));
! 173: return;
! 174: }
! 175:
! 176: sub validate_course {
! 177: my ($courseid) = @_;
! 178: my ($cdom,$cnum) = ($courseid =~ /^($match_domain)_($match_courseid)$/);
! 179: if (($cdom ne '') && ($cnum ne '')) {
! 180: if (&Apache::lonnet::is_course($cdom,$cnum)) {
! 181: return ($courseid);
! 182: }
! 183: }
! 184: return;
! 185: }
! 186:
1.1 raeburn 187: sub javascript_setforms {
188: my ($now) = @_;
189: my $js = <<ENDSCRIPT;
190: <script language="JavaScript">
191: function send() {
192: this.document.server.elements.uname.value = this.document.client.elements.uname.value;
193: uextkey=this.document.client.elements.uextkey.value;
194: lextkey=this.document.client.elements.lextkey.value;
195: initkeys();
196:
197: this.document.server.elements.upass.value
198: = crypted(this.document.client.elements.upass$now.value);
199:
200: this.document.client.elements.uname.value='';
201: this.document.client.elements.upass$now.value='';
202:
203: this.document.server.submit();
204: return false;
205: }
206: </script>
207: ENDSCRIPT
208: return $js;
209: }
210:
211: sub javascript_checkpass {
212: my ($now) = @_;
213: my $nopass = &mt('You must enter a password');
214: my $mismatchpass = &mt('The passwords you entered did not match.').'\\n'.
215: &mt('Please try again.');
216: my $js = <<"ENDSCRIPT";
217: <script type="text/javascript" language="JavaScript">
218: function checkpass() {
219: var upass = this.document.client.elements.upass$now.value;
220: var upasscheck = this.document.client.elements.upasscheck$now.value;
221: if (upass == '') {
222: alert("$nopass");
223: return;
224: }
225: if (upass == upasscheck) {
226: this.document.client.elements.upasscheck$now.value='';
227: send();
228: return;
229: } else {
230: alert("$mismatchpass");
231: return;
232: }
233: }
234: </script>
235: ENDSCRIPT
236: return $js;
237: }
238:
239: sub print_username_form {
1.3 ! raeburn 240: my ($domain,$domdesc,$cancreate,$now,$lonhost,$courseid) = @_;
1.1 raeburn 241: my %lt = &Apache::lonlocal::texthash(
242: unam => 'username',
243: udom => 'domain',
244: uemail => 'Email address in LON-CAPA',
245: proc => 'Proceed');
246: my $output;
247: if ($cancreate eq 'any' || $cancreate eq 'login') {
248: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
249: if ((($domdefaults{'auth_def'} =~/^krb/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth')) {
250: $output = '<div class="LC_left_float"><h3>'.&mt('Create account with a username provided by your institution').'</h3>';
251: $output .= &mt('If you already have a Log-in ID at your institution, you may be able to use it[_1] for LON-CAPA.','<br />').' '.&mt('Type in your Log-in ID and password to find out.').'<br /><br />';
252: my ($lkey,$ukey) = &Apache::lonpreferences::des_keys();
253: my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
254: my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount',
255: $lonhost);
1.3 ! raeburn 256: $output .= &serverform($logtoken,$lonhost,undef,$courseid);
1.1 raeburn 257: my $unameform = '<input type="text" name="uname" size="10" value="" />';
258: my $upassform = '<input type="password" name="upass'.$now.'" size="10" />';
259: my $submit_text = &mt('Create LON-CAPA account');
1.3 ! raeburn 260: $output .= '<form name="client" method="post" action="/adm/createaccount">'."\n".
1.1 raeburn 261: &Apache::lonhtmlcommon::start_pick_box()."\n".
262: &Apache::lonhtmlcommon::row_title(&mt('Log-in ID'),
263: 'LC_pick_box_title')."\n".
264: $unameform."\n".
265: &Apache::lonhtmlcommon::row_closure(1)."\n".
266: &Apache::lonhtmlcommon::row_title(&mt('Password'),
267: 'LC_pick_box_title')."\n".
268: $upassform."\n".'<br /><br />'."\n".
269: '<input type="button" name="username_validation" value="'.
270: $submit_text.'" onclick="javascript:send()" />'."\n".
271: &Apache::lonhtmlcommon::row_closure(1)."\n".
272: &Apache::lonhtmlcommon::end_pick_box().'<br /><br />'."\n".
273: '<input type="hidden" name="lextkey" value="'.$lextkey.'">'."\n".
274: '<input type="hidden" name="uextkey" value="'.$uextkey.'">'."\n".
275: '</form></div>';
276: }
277: }
278: if (($cancreate eq 'any') || ($cancreate eq 'email')) {
279: $output .= '<div class="LC_left_float"><h3>'.&mt('Create account with an e-mail address as your username').'</h3>';
280: if ($cancreate eq 'any') {
281: $output .= &mt('Provide your e-mail address to request a LON-CAPA account if you do not have [_1] a log-in ID at your institution.','<br />').'<br /><br />';
282: } elsif ($cancreate eq 'unofficial') {
283: $output .= '<br />';
284: }
285: my $emailform = '<input type="text" name="useremail" size="25" value="" />';
286: my $captchaform = &create_captcha();
287: my $submit_text = &mt('Request LON-CAPA account');
1.3 ! raeburn 288: $output .= '<form name="createaccount" method="post" onsubmit="validate_email();" action="/adm/createaccount">'.
1.1 raeburn 289: &Apache::lonhtmlcommon::start_pick_box()."\n".
290: &Apache::lonhtmlcommon::row_title(&mt('E-mail address'),
291: 'LC_pick_box_title')."\n".
292: $emailform."\n".
293: &Apache::lonhtmlcommon::row_closure(1).
294: &Apache::lonhtmlcommon::row_title(&mt('Validation'),
295: 'LC_pick_box_title')."\n".
1.3 ! raeburn 296: $captchaform."\n".'<br /><br />';
! 297: if ($courseid ne '') {
! 298: $output .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n";
! 299: }
! 300: $output .= '<input type="submit" name="create_with_email" value="'.
1.1 raeburn 301: $submit_text.'" />'.
302: &Apache::lonhtmlcommon::row_closure(1).
303: &Apache::lonhtmlcommon::end_pick_box().'<br /><br /></form>'.
304: '</div>';
305: }
306: if ($output eq '') {
307: $output = &mt('Creation of a new user account using either an e-mail address or institutional log-in ID as your username is not permitted in the domain: [_1] ([_2])',$domain,$domdesc);
308: } else {
309: $output .= '<div class="LC_clear_float_footer"></div>';
310: }
311: return $output;
312: }
313:
314: sub process_email_request {
315: my ($useremail,$domain,$domdesc,$contact_name,$contact_email,$cancreate,
1.3 ! raeburn 316: $server,$settings,$courseid) = @_;
1.1 raeburn 317: my $useremail = $env{'form.useremail'};
318: my $output;
319: if ($cancreate ne 'any' && $cancreate ne 'email') {
320: $output = &invalid_state('noemails',$domdesc,
321: $contact_name,$contact_email);
322: return $output;
323: } elsif ($useremail !~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/) {
324: $output = &invalid_state('baduseremail',$domdesc,
325: $contact_name,$contact_email);
326: return $output;
327: } else {
328: my $uhome = &Apache::lonnet::homeserver($useremail,$domain);
329: if ($uhome ne 'no_host') {
330: $output = &invalid_state('existinguser',$domdesc,
331: $contact_name,$contact_email);
332: return $output;
333: } else {
334: my $code = $env{'form.code'};
335: my $md5sum = $env{'form.crypt'};
336: my %captcha_params = &captcha_settings();
337: my $captcha = Authen::Captcha->new(
338: output_folder => $captcha_params{'output_dir'},
339: data_folder => $captcha_params{'db_dir'},
340: );
341: my $captcha_chk = $captcha->check_code($code,$md5sum);
342: my %captcha_hash = (
343: 0 => 'Code not checked (file error)',
344: -1 => 'Failed: code expired',
345: -2 => 'Failed: invalid code (not in database)',
346: -3 => 'Failed: invalid code (code does not match crypt)',
347: );
348: if ($captcha_chk != 1) {
349: $output = &invalid_state('captcha',$domdesc,$contact_name,
350: $contact_email,$captcha_hash{$captcha_chk});
351: return $output;
352: }
353: my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts);
354: my $uhome=&Apache::lonnet::homeserver($useremail,$domain);
355: if ($uhome eq 'no_host') {
356: my $checkhash;
357: my $checks = { 'username' => 1 };
358: $checkhash->{$useremail.':'.$domain} = { 'newuser' => 1, };
359: &Apache::loncommon::user_rule_check($checkhash,$checks,
360: \%alerts,\%rulematch,\%inst_results,\%curr_rules,
361: \%got_rules);
362: if (ref($alerts{'useremail'}) eq 'HASH') {
363: if (ref($alerts{'useremail'}{$domain}) eq 'HASH') {
364: if ($alerts{'username'}{$domain}{$useremail}) {
365: $output = &invalid_state('userrules',$domdesc,
366: $contact_name,$contact_email);
367: return $output;
368: }
369: }
370: }
371: my $format_msg =
372: &guest_format_check($useremail,$domain,$cancreate,
373: $settings);
374: if ($format_msg) {
375: $output = &invalid_state('userformat',$domdesc,$contact_name,
376: $contact_email,$format_msg);
377: return $output;
378: }
379: }
380: }
381: }
382: $output = &send_token($domain,$useremail,$server,$domdesc,$contact_name,
1.3 ! raeburn 383: $contact_email,$courseid);
1.1 raeburn 384: return $output;
385: }
386:
387: sub send_token {
1.3 ! raeburn 388: my ($domain,$email,$server,$domdesc,$contact_name,$contact_email,$courseid) = @_;
1.1 raeburn 389: my $msg = &mt('Thank you for your request to create a new LON-CAPA account.').'<br /><br />';
390: my $now = time;
391: my %info = ('ip' => $ENV{'REMOTE_ADDR'},
392: 'time' => $now,
393: 'domain' => $domain,
1.3 ! raeburn 394: 'username' => $email,
! 395: 'courseid' => $courseid);
1.1 raeburn 396: my $token = &Apache::lonnet::tmpput(\%info,$server);
397: if ($token !~ /^error/ && $token ne 'no_such_host') {
398: my $esc_token = &escape($token);
399: my $mailmsg = &mt('A request was submitted on [_1] for creation of a LON-CAPA account in the [_2] domain.',localtime(time),$domdesc).' '.
400: &mt('To complete this process please open a web browser and enter the following ".
401: "URL in the address/location box: ').&Apache::lonnet::absolute_url()."/adm/createaccount?token=$esc_token";
402: my $result = &Apache::resetpw::send_mail($domdesc,$email,$mailmsg,$contact_name,
403: $contact_email);
404: if ($result eq 'ok') {
405: $msg .= &mt('A message has been sent to the e-mail address you provided.').'<br />'.&mt('The message includes the web address for the link you will use to complete the account creation process.').'<br />'.&mt("The link included in the message will be valid for the next [_1]two[_2] hours.",'<b>','</b>');
406: } else {
407: $msg .= &mt('An error occurred when sending a message to the e-mail address you provided. Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
408: }
409: } else {
410: $msg .= &mt('An error occurred creating a token required for the account creation process. Please contact the [_1] ([_2]) for assistance.',$contact_name,$contact_email);
411: }
412: return $msg;
413: }
414:
415: sub process_mailtoken {
1.3 ! raeburn 416: my ($r,$token,$contact_name,$contact_email,$domain,$domdesc,$lonhost,
! 417: $include,$start_page) = @_;
! 418: my ($msg,$nostart,$noend);
1.1 raeburn 419: my %data = &Apache::lonnet::tmpget($token);
420: my $now = time;
421: if (keys(%data) == 0) {
422: $msg = &mt('Sorry, the URL you provided to complete creation of a new LON-CAPA account was invalid. Either the token included in the URL has been deleted or the URL you provided was invalid. Please submit a <a href="/adm/createaccount">new request</a> for account creation and follow the link to the new URL included in the e-mail that will be sent to you.');
423: return $msg;
424: }
425: if (($data{'time'} =~ /^\d+$/) &&
426: ($data{'domain'} ne '') &&
427: ($data{'username'} =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/)) {
428: my $reqtime = localtime($data{'time'});
429: if ($now - $data{'time'} < 7200) {
430: if ($env{'form.phase'} eq 'createaccount') {
1.3 ! raeburn 431: my ($result,$output) = &create_account($r,$domain,$lonhost,
1.1 raeburn 432: $data{'username'},$domdesc);
433: if ($result eq 'ok') {
434: $msg = $output;
435: my $now = localtime(time);
436: my $mailmsg = &mt('A LON-CAPA account in the [_1] domain has been created [_2] from IP address: [_3]. If you did not perform this action or authorize it, please contact the [_4] ([_5]).',$domdesc,$now,$ENV{'REMOTE_ADDR'},$contact_name,$contact_email)."\n";
437: my $mailresult = &Apache::resetpw::send_mail($domdesc,$data{'email'},
438: $mailmsg,$contact_name,
439: $contact_email);
440: if ($mailresult eq 'ok') {
441: $msg .= &mt('An e-mail confirming creation of your new LON-CAPA account has been sent to [_1].',$data{'username'});
442: } else {
443: $msg .= &mt('An error occurred when sending e-mail to [_1] confirming creation of your LON-CAPA account.',$data{'username'});
444: }
1.3 ! raeburn 445: my %form = &start_session($r,$data{'username'},$domain,
! 446: $lonhost,$data{'courseid'},
! 447: $token);
! 448: $nostart = 1;
! 449: $noend = 1;
1.1 raeburn 450: } else {
451: $msg .= &mt('A problem occurred when attempting to create your new LON-CAPA account').'<br />'.$output.&mt('Please contact the [_1] - (<a href="mailto:[_2]">[_2]</a>) for assistance.',$contact_name,$contact_email);
452: }
1.3 ! raeburn 453: my $delete = &Apache::lonnet::tmpdel($token);
1.1 raeburn 454: } else {
1.3 ! raeburn 455: $msg .= &mt('Please provide user information and a password for your new account.').'<br />'.&mt('Your password, which must contain at least seven characters, will be sent to the LON-CAPA server in an encrypted form.').'<br />';
! 456: $msg .= &print_dataentry_form($r,$domain,$lonhost,$include,$token,$now,$data{'username'},$start_page);
! 457: $nostart = 1;
1.1 raeburn 458: }
459: } else {
460: $msg = &mt('Sorry, the token generated when you requested creation of an account has expired. Please submit a <a href="/adm/createaccount">new request</a>, and follow the link to the web page included in the new e-mail that will be sent to you, to allow you to create the account.');
461: }
462: } else {
463: $msg .= &mt('Sorry, the URL generated when you requested creation of an accountcontained incomplete information. Please submit a <a href="/adm/createaccount">new request</a> for creation of an account, and use the new URL that will be sent to your e-mail address to complete the process.');
464: }
1.3 ! raeburn 465: return ($msg,$nostart,$noend);
! 466: }
! 467:
! 468: sub start_session {
! 469: my ($r,$username,$domain,$lonhost,$courseid,$token) = @_;
! 470: my %form = (
! 471: uname => $username,
! 472: udom => $domain,
! 473: );
! 474: my $firsturl = '/adm/roles';
! 475: if (defined($courseid)) {
! 476: $courseid = &validate_course($courseid);
! 477: if ($courseid ne '') {
! 478: $form{'courseid'} = $courseid;
! 479: $firsturl = '/adm/selfenroll?cid='.$courseid;
! 480: }
! 481: }
! 482: if ($r->dir_config('lonBalancer') eq 'yes') {
! 483: &Apache::lonauth::success($r,$form{'uname'},$form{'udom'},
! 484: $lonhost,'noredirect',undef,\%form);
! 485: my $delete = &Apache::lonnet::tmpdel($token);
! 486: $r->internal_redirect('/adm/switchserver');
! 487: } else {
! 488: &Apache::lonauth::success($r,$form{'uname'},$form{'udom'},
! 489: $lonhost,$firsturl,undef,\%form);
! 490: }
! 491: return %form;
1.1 raeburn 492: }
493:
1.3 ! raeburn 494:
1.1 raeburn 495: sub print_dataentry_form {
1.3 ! raeburn 496: my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_;
1.1 raeburn 497: my ($error,$output);
1.3 ! raeburn 498: &print_header($r,$start_page);
1.1 raeburn 499: if (open(my $jsh,"<$include/londes.js")) {
500: while(my $line = <$jsh>) {
501: $r->print($line);
502: }
503: close($jsh);
1.3 ! raeburn 504: $output .= &javascript_setforms($now)."\n".&javascript_checkpass($now);
1.1 raeburn 505: my ($lkey,$ukey) = &Apache::lonpreferences::des_keys();
506: my ($lextkey,$uextkey) = &getkeys($lkey,$ukey);
507: my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount',
508: $lonhost);
509: my @userinfo = ('firstname','middlename','lastname','generation','id',
510: 'permanentemail');
511: my %lt=&Apache::lonlocal::texthash(
512: 'pd' => "Personal Data",
513: 'firstname' => "First Name",
514: 'middlename' => "Middle Name",
515: 'lastname' => "Last Name",
516: 'generation' => "Generation",
517: 'permanentemail' => "Permanent e-mail address",
518: 'id' => "ID/Student Number",
519: 'lg' => "Login Data"
520: );
521: my %textboxsize = (
522: firstname => '15',
523: middlename => '15',
524: lastname => '15',
525: generation => '5',
526: id => '15',
527: );
528: my $genhelp=&Apache::loncommon::help_open_topic('Generation');
1.3 ! raeburn 529: $output .= '<div class="LC_left_float"><h3>'.$lt{'pd'}.'</h3>'.
! 530: '<form name="server" method="post" target="_top" action="/adm/createaccount">'.
1.1 raeburn 531: &Apache::lonhtmlcommon::start_pick_box();
532: foreach my $item (@userinfo) {
533: my $rowtitle = $lt{$item};
534: if ($item eq 'generation') {
535: $rowtitle = $genhelp.$rowtitle;
536: }
537: $output .= &Apache::lonhtmlcommon::row_title($rowtitle,undef,'LC_oddrow_value')."\n";
538: if ($item eq 'permanentemail') {
539: $output .= $username;
540: } else {
541: $output .= '<input type="text" name="c'.$item.'" size="'.$textboxsize{$item}.'" value="" />';
542: }
543: $output .= &Apache::lonhtmlcommon::row_closure(1);
544: }
545: $output .= &Apache::lonhtmlcommon::end_pick_box();
546: $output .= <<"ENDSERVERFORM";
547: <input type="hidden" name="logtoken" value="$logtoken" />
548: <input type="hidden" name="token" value="$mailtoken" />
549: <input type="hidden" name="serverid" value="$lonhost" />
550: <input type="hidden" name="uname" value="" />
551: <input type="hidden" name="upass" value="" />
552: <input type="hidden" name="phase" value="createaccount" />
553: </form></div>
554: ENDSERVERFORM
555: my $upassone = '<input type="password" name="upass'.$now.'" size="10" />';
556: my $upasstwo = '<input type="password" name="upasscheck'.$now.'" size="10" />';
557: my $submit_text = &mt('Create LON-CAPA account');
558: $output .= '<div class="LC_left_float"><h3>'.$lt{'lg'}.'</h3>'."\n".
559: '<form name="client" method="post" />'."\n".
560: &Apache::lonhtmlcommon::start_pick_box()."\n".
561: &Apache::lonhtmlcommon::row_title(&mt('Username'),
562: 'LC_pick_box_title')."\n".
563: $username."\n".
564: &Apache::lonhtmlcommon::row_closure(1)."\n".
565: &Apache::lonhtmlcommon::row_title(&mt('Password'),
566: 'LC_pick_box_title')."\n".
567: $upassone."\n".
568: &Apache::lonhtmlcommon::row_closure(1)."\n".
569: &Apache::lonhtmlcommon::row_title(&mt('Confirm password'),
570: 'LC_pick_box_title')."\n".
571: $upasstwo."\n".
572: &Apache::lonhtmlcommon::row_closure(1)."\n".
573: &Apache::lonhtmlcommon::end_pick_box()."\n".
574: '<input type="hidden" name="uname" value="'.$username.'">'."\n".
575: '<input type="hidden" name="lextkey" value="'.$lextkey.'">'."\n".
576: '<input type="hidden" name="uextkey" value="'.$uextkey.'">'."\n".
577: '</form></div>'."\n".
578: '<div class="LC_clear_float_footer"><br /><br />'."\n".
579: '<form name="buttonform">'."\n".
580: '<input type="button" name="createaccount" value="'.
581: $submit_text.'" onclick="javascript:checkpass();" /></form></div>';
582: } else {
1.3 ! raeburn 583: $output = &mt('Could not load javascript file [_1]','londes.js');
1.1 raeburn 584: }
1.3 ! raeburn 585: return $output;
1.1 raeburn 586: }
587:
588: sub create_account {
1.3 ! raeburn 589: my ($r,$domain,$lonhost,$username,$domdesc) = @_;
1.1 raeburn 590: my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},
591: $env{'form.serverid'});
592: # Error messages
593: my $error = '<span class="LC_error">'.&mt('Error').': ';
594: my $end = '</span><br /><br />';
595: my $rtnlink = '<a href="javascript:history.back();" />'.
596: &mt('Return to previous page').'</a>'.
597: &Apache::loncommon::end_page();
598: if ($retrieved eq 'ok') {
599: if ($env{'form.cid'} ne '') {
600: my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);
601: if ($result eq 'fail') {
602: $output = $error.&mt('Invalid ID format').$end.
603: $userchkmsg.$rtnlink;
604: return ('fail',$output);
605: }
606: }
607: } else {
608: return ('fail',$error.$output.$end.$rtnlink);
609: }
610: # Call modifyuser
611: my $result =
612: &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'},
613: 'internal',$upass,$env{'form.cfirstname'},
614: $env{'form.cmiddlename'},$env{'form.clastname'},
615: $env{'form.cgeneration'},undef,undef,$username);
616: $output = &mt('Generating user').': '.$result;
617: my $uhome = &Apache::lonnet::homeserver($username,$domain);
618: $output .= '<br />'.&mt('Home server').': '.$uhome.' '.
619: &Apache::lonnet::hostname($uhome).'<br /><br />';
620: return ('ok',$output);
621: }
622:
623: sub username_validation {
1.3 ! raeburn 624: my ($username,$domain,$domdesc,$contact_name,$contact_email,$courseid) = @_;
1.1 raeburn 625: my ($retrieved,$output,$upass);
626:
627: $username= &LONCAPA::clean_username($username);
628: $domain = &LONCAPA::clean_domain($domain);
629: my $uhome = &Apache::lonnet::homeserver($username,$domain);
630:
631: if ($uhome ne 'no_host') {
632: $output = &invalid_state('existinguser',$domdesc,
633: $contact_name,$contact_email);
634: return $output;
635: }
636: ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'},
637: $env{'form.serverid'});
638: if ($retrieved eq 'ok') {
639: my $primlibserv = &Apache::lonnet::domain($domain,'primary');
640: my $authok;
641: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
642: if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) && ($domdefaults{'auth_arg_def'} ne '')) || ($domdefaults{'auth_def'} eq 'localauth')) {
643: my $checkdefauth = 1;
644: $authok =
645: &Apache::lonnet::reply("encrypt:auth:$domain:$username:$upass:$checkdefauth",$primlibserv);
646: } else {
647: $authok = 'non_authorized';
648: }
649: if ($authok eq 'authorized') {
650: my (%rulematch,%inst_results,$newuser,%alerts,%curr_rules,%got_rules);
651: $newuser = 1;
652: my $checkhash;
653: my $checks = { 'username' => 1 };
654: $checkhash->{$username.':'.$domain} = { 'newuser' => $newuser };
655: &Apache::loncommon::user_rule_check($checkhash,$checks,
656: \%alerts,\%rulematch,\%inst_results,\%curr_rules,\%got_rules);
657: if (ref($alerts{'username'}) eq 'HASH') {
658: if (ref($alerts{'username'}{$domain}) eq 'HASH') {
659: if ($alerts{'username'}{$domain}{$username}) {
660: my $userchkmsg;
661: if (ref($curr_rules{$domain}) eq 'HASH') {
662: $userchkmsg =
663: &Apache::loncommon::instrule_disallow_msg('username',
664: $domdesc,1).
665: &Apache::loncommon::user_rule_formats($domain,
666: $domdesc,$curr_rules{$domain}{'username'},
667: 'username');
668: }
669: return $userchkmsg;
670: }
671: }
672: }
673: my $submit_text = &mt('Create LON-CAPA account');
1.3 ! raeburn 674: # FIXME need a cookie to confirm credentials were validated.
1.1 raeburn 675: $output =
1.3 ! raeburn 676: '<form method="post" action="/adm/createaccount">'.
1.1 raeburn 677: &Apache::loncreateuser::personal_data_display($username,$domain,1,
678: undef,$inst_results{$username.':'.$domain}).
679: '<br /><br /><input type="hidden" name="uname" value="'.$username.'" />'.
1.3 ! raeburn 680: '<input type="hidden" name="phase" value="username_activation" />';
! 681: if ($courseid ne '') {
! 682: $output .= '<input type="hidden" name="courseid" value="'.$courseid.'" />';
! 683: }
! 684: $output .= '<input type="submit" name="newaccount" value="'.
! 685: $submit_text.'" /></form>';
1.1 raeburn 686: } else {
687: $output = &mt('Not authenticated').' '.&mt('Please check the username and password');
688: }
689: }
690: return $output;
691: }
692:
693: sub username_activation {
1.3 ! raeburn 694: my ($r,$username,$domain,$domdesc,$lonhost,$courseid) = @_;
1.1 raeburn 695: my $output;
696: my $error = '<span class="LC_error">'.&mt('Error').': ';
697: my $end = '</span><br /><br />';
698: my $rtnlink = '<a href="javascript:history.back();" />'.
699: &mt('Return to previous page').'</a>'.
700: &Apache::loncommon::end_page();
701: my %domdefaults = &Apache::lonnet::get_domain_defaults($domain);
1.3 ! raeburn 702: if ((($domdefaults{'auth_def'} =~/^krb(4|5)$/) &&
! 703: ($domdefaults{'auth_arg_def'} ne '')) ||
! 704: ($domdefaults{'auth_def'} eq 'localauth')) {
1.1 raeburn 705: if ($env{'form.cid'} ne '') {
706: my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc);
707: if ($result eq 'fail') {
708: $output = $error.&mt('Invalid ID format').$end.
709: $userchkmsg.$rtnlink;
710: return ('fail',$output);
711: }
712: }
713: # Call modifyuser
714: my $result =
715: &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'},
716: $domdefaults{'auth_def'},
717: $domdefaults{'auth_arg_def'},$env{'form.cfirstname'},
718: $env{'form.cmiddlename'},$env{'form.clastname'},
719: $env{'form.cgeneration'},undef,undef,
720: $env{'form.cpermanentemail'});
1.3 ! raeburn 721: if ($result eq 'ok') {
! 722: $output = &mt('A LON-CAPA account has been created for username: [_1] in domain: [_2].',$username,$domain);
! 723: my %form = &start_session($r,$username,$domain,$lonhost,$courseid);
! 724: my $nostart = 1;
! 725: return ('ok',$output,$nostart);
! 726: } else {
! 727: $output = &mt('Account creation failed for username: [_1] in domain: [_2].',$username,$domain).'<br /><span class="LC_error">'.&mt('Error: [_1]',$result).'</span>';
! 728: return ('fail',$output);
! 729: }
1.1 raeburn 730: } else {
731: $output = &mt("User account creation is not available for the current default authentication type.\n");
732: return('fail',$output);
733: }
734: }
735:
736: sub check_id {
737: my ($username,$domain,$domdesc) = @_;
738: # Check ID format
739: my (%alerts,%rulematch,%inst_results,%curr_rules,%checkhash);
740: my %checks = ('id' => 1);
741: %{$checkhash{$username.':'.$domain}} = (
742: 'newuser' => 1,
743: 'id' => $env{'form.cid'},
744: );
745: &Apache::loncommon::user_rule_check(\%checkhash,\%checks,\%alerts,
746: \%rulematch,\%inst_results,\%curr_rules);
747: if (ref($alerts{'id'}) eq 'HASH') {
748: if (ref($alerts{'id'}{$domain}) eq 'HASH') {
749: if ($alerts{'id'}{$domain}{$env{'form.cid'}}) {
750: my $userchkmsg;
751: if (ref($curr_rules{$domain}) eq 'HASH') {
752: $userchkmsg =
753: &Apache::loncommon::instrule_disallow_msg('id',
754: $domdesc,1).
755: &Apache::loncommon::user_rule_formats($domain,
756: $domdesc,$curr_rules{$domain}{'id'},'id');
757: }
758: return ('fail',$userchkmsg);
759: }
760: }
761: }
762: return;
763: }
764:
765: sub invalid_state {
766: my ($error,$domdesc,$contact_name,$contact_email,$msgtext) = @_;
767: my $msg;
768: if ($error eq 'baduseremail') {
769: $msg = &mt('The e-mail address you provided does not appear to be a valid address.');
770: } elsif ($error eq 'existinguser') {
771: $msg = &mt('The e-mail address you provided is already in use as a username in this LON-CAPA domain.');
772: } elsif ($error eq 'userrules') {
773: $msg = &mt('Username rules for this LON-CAPA domain do not allow the e-mail address you provided to be used as a username.');
774: } elsif ($error eq 'userformat') {
775: $msg = &mt('The e-mail address you provided may not be used as a username in this LON-CAPA domain.');
776: } elsif ($error eq 'captcha') {
777: $msg = &mt('Validation of the code your entered failed.');
778: } elsif ($error eq 'noemails') {
779: $msg = &mt('Creation of a new user account using an e-mail address as username is not permitted in this LON-CAPA domain.');
780: }
781: if ($msgtext) {
782: $msg .= '<br />'.$msgtext;
783: }
784: if ($contact_email ne '') {
785: my $escuri = &HTML::Entities::encode('/adm/createaccount','&<>"');
786: $msg .= '<br />'.&mt(' You may wish to contact the <a href="/adm/helpdesk?origurl=[_1]">LON-CAPA helpdesk</a> for the [_2] domain.',$escuri,$domdesc);
787: } else {
788: $msg .= '<br />'.&mt(' You may wish to send an e-mail to the server administrator: [_1] for the [_2] domain.',$Apache::lonnet::perlvar{'AdminEmail'},$domdesc);
789: }
790: return $msg;
791: }
792:
793: sub create_captcha {
794: my ($output_dir,$db_dir) = @_;
795: my %captcha_params = &captcha_settings();
796: my $captcha = Authen::Captcha->new(
797: output_folder => $captcha_params{'output_dir'},
798: data_folder => $captcha_params{'db_dir'},
799: );
800: my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
801: my $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
802: &mt('Type in the letters/numbers shown below').' '.
803: '<input type="text" size="5" name="code" value="" /><br />'.
804: '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png">';
805: return $output;
806: }
807:
808: sub captcha_settings {
809: my %captcha_params = (
810: output_dir => "/home/httpd/html/captcha",
811: www_output_dir => "/captcha",
812: db_dir => "/home/www/captchadb",
813: numchars => '5',
814: );
815: return %captcha_params;
816: }
817:
818: sub getkeys {
819: my ($lkey,$ukey) = @_;
820: my $lextkey=hex($lkey);
821: if ($lextkey>2147483647) { $lextkey-=4294967296; }
822:
823: my $uextkey=hex($ukey);
824: if ($uextkey>2147483647) { $uextkey-=4294967296; }
825: return ($lextkey,$uextkey);
826: }
827:
828: sub serverform {
1.3 ! raeburn 829: my ($logtoken,$lonhost,$mailtoken,$courseid) = @_;
1.1 raeburn 830: my $output .= <<ENDSERVERFORM;
831: <form name="server" method="post" target="_top">
832: <input type="hidden" name="logtoken" value="$logtoken" />
833: <input type="hidden" name="token" value="$mailtoken" />
834: <input type="hidden" name="serverid" value="$lonhost" />
835: <input type="hidden" name="uname" value="" />
836: <input type="hidden" name="upass" value="" />
837: <input type="hidden" name="phase" value="username_validation" />
1.3 ! raeburn 838: <input type="hidden" name="courseid" value="$courseid" />
1.1 raeburn 839: </form>
840: ENDSERVERFORM
841: return $output;
842: }
843:
844: sub process_credentials {
845: my ($logtoken,$lonhost) = @_;
846: my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost);
847: my ($retrieved,$output,$upass);
848: if (($tmpinfo=~/^error/) || ($tmpinfo eq 'con_lost')) {
849: $output = &mt('Information needed to retrieve your log-in information is missing, inaccessible or expired.').'<br />'.&mt('You may need to reload the previous page to obtain a new token.');
850: return ($retrieved,$output,$upass);
851: } else {
852: my $reply = &Apache::lonnet::reply('tmpdel:'.$logtoken,$lonhost);
853: if ($reply eq 'ok') {
854: $retrieved = 'ok';
855: } else {
856: $output = &mt('Session could not be opened.');
857: }
858: }
859: my ($key,$caller)=split(/&/,$tmpinfo);
860: if ($caller eq 'createaccount') {
861: $upass = &Apache::lonpreferences::des_decrypt($key,$env{'form.upass'});
862: } else {
863: $output = &mt('Unable to retrieve your log-in information - unexpected context');
864: }
865: return ($retrieved,$output,$upass);
866: }
867:
868: sub guest_format_check {
869: my ($useremail,$domain,$cancreate,$settings) = @_;
870: my ($login,$format_match,$format_msg,@user_rules);
871: if (ref($settings) eq 'HASH') {
872: if (ref($settings->{'email_rule'}) eq 'ARRAY') {
873: push(@user_rules,@{$settings->{'email_rule'}});
874: }
875: }
876: if (@user_rules > 0) {
877: my %rule_check =
878: &Apache::lonnet::inst_rulecheck($domain,$useremail,undef,
1.2 raeburn 879: 'selfcreate',\@user_rules);
1.1 raeburn 880: if (keys(%rule_check) > 0) {
881: foreach my $item (keys(%rule_check)) {
882: if ($rule_check{$item}) {
883: $format_match = 1;
884: last;
885: }
886: }
887: }
888: }
889: if ($format_match) {
890: ($login) = ($useremail =~ /^([^\@]+)\@/);
891: $format_msg = '<br />'.&mt("Your e-mail address uses the same internet domain as your institution's LON-CAPA service.").'<br />'.&mt('Creation of a LON-CAPA account with this type of e-mail address as username is not permitted.').'<br />';
892: if ($cancreate eq 'any' || $cancreate eq 'login') {
893: $format_msg .= &mt('You should request creation of a LON-CAPA account for a Log-in ID of "[_1]" at your institution instead.',$login).'<br />';
894: }
895: }
896: return $format_msg;
897: }
898:
899: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to createaccount.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface