--- loncom/interface/createaccount.pm 2010/11/29 14:57:20 1.37.2.2 +++ loncom/interface/createaccount.pm 2012/12/05 18:23:54 1.54 @@ -3,7 +3,7 @@ # institutional log-in ID (institutional authentication required - localauth # or kerberos) or an e-mail address. # -# $Id: createaccount.pm,v 1.37.2.2 2010/11/29 14:57:20 raeburn Exp $ +# $Id: createaccount.pm,v 1.54 2012/12/05 18:23:54 bisitz Exp $ # # Copyright Michigan State University Board of Trustees # @@ -39,12 +39,13 @@ use Apache::lonhtmlcommon; use Apache::lonlocal; use Apache::lonauth; use Apache::resetpw; -use Captcha::reCAPTCHA; use DynaLoader; # for Crypt::DES version use Crypt::DES; use LONCAPA qw(:DEFAULT :match); use HTML::Entities; +#TODO this module needs documentation + sub handler { my $r = shift; &Apache::loncommon::content_type($r,'text/html'); @@ -65,14 +66,8 @@ sub handler { if ($sso_username ne '' && $sso_domain ne '') { $domain = $sso_domain; } else { - $domain = &Apache::lonnet::default_login_domain(); - if (defined($env{'form.courseid'})) { - if (&validate_course($env{'form.courseid'})) { - if ($env{'form.courseid'} =~ /^($match_domain)_($match_courseid)$/) { - $domain = $1; - } - } - } + ($domain, undef) = Apache::lonnet::is_course($env{'form.courseid'}); + $domain ||= &Apache::lonnet::default_login_domain(); } my $domdesc = &Apache::lonnet::domain($domain,'description'); my $contact_name = &mt('LON-CAPA helpdesk'); @@ -98,9 +93,7 @@ sub handler { } my ($js,$courseid,$title); - if (defined($env{'form.courseid'})) { - $courseid = &validate_course($env{'form.courseid'}); - } + $courseid = Apache::lonnet::is_course($env{'form.courseid'}); if ($courseid ne '') { $js = &catreturn_js(); $title = 'Self-enroll in a LON-CAPA course'; @@ -127,18 +120,14 @@ sub handler { &print_footer($r); return OK; } else { - $start_page = - &Apache::loncommon::start_page($title,$js, - {'no_inline_link' => 1,}); + $start_page = &Apache::loncommon::start_page($title,$js); &print_header($r,$start_page,$courseid); $r->print($output); &print_footer($r); return OK; } } - $start_page = - &Apache::loncommon::start_page($title,$js, - {'no_inline_link' => 1,}); + $start_page = &Apache::loncommon::start_page($title,$js); my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$domain); @@ -147,7 +136,7 @@ sub handler { &print_header($r,$start_page,$courseid); my $output = '

'.&mt('Account creation unavailable').'

'. ''. - &mt('Creation of a new user account using an e-mail address or an institutional log-in ID as username is not permitted for the GCI WebCenter.').'

'; + &mt('Creation of a new user account using an e-mail address or an institutional log-in ID as username is not permitted at this institution ([_1]).',$domdesc).'

'; $r->print($output); &print_footer($r); return OK; @@ -199,7 +188,7 @@ sub handler { if ($env{'form.phase'} eq 'username_activation') { (my $result,$output,$nostart) = &username_activation($r,$env{'form.uname'},$domain,$domdesc, - $lonhost,$courseid); + $courseid); if ($result eq 'ok') { if ($nostart) { return OK; @@ -286,7 +275,7 @@ sub selfenroll_crumbs { } my $last_crumb; if ($desc ne '') { - $last_crumb = &mt('Self-enroll in [_1]',''.$desc.''); + $last_crumb = &mt('Self-enroll in [_1]',"$desc"); } else { $last_crumb = &mt('Self-enroll'); } @@ -297,17 +286,6 @@ sub selfenroll_crumbs { return; } -sub validate_course { - my ($courseid) = @_; - my ($cdom,$cnum) = ($courseid =~ /^($match_domain)_($match_courseid)$/); - if (($cdom ne '') && ($cnum ne '')) { - if (&Apache::lonnet::is_course($cdom,$cnum)) { - return ($courseid); - } - } - return; -} - sub javascript_setforms { my ($now) = @_; my $js = <'; - my $captchaform = &create_recaptcha(); - if ($captchaform) { + my ($captchaform,$error) = &Apache::loncommon::captcha_display('usercreation',$lonhost); + if ($error) { + my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount'; + if ($courseid ne '') { + $helpdesk .= '&courseid='.$courseid; + } + $output .= ''.&mt('An error occurred generating the validation code[_1] required for an e-mail address to be used as username.','
').'


'.&mt('[_1]Contact the helpdesk[_2] or [_3]reload[_2] the page and try again.','','',''); + } else { my $submit_text = &mt('Request LON-CAPA account'); my $emailform = ''; if (grep(/^login$/,@{$cancreate})) { @@ -419,16 +396,17 @@ sub print_username_form { } else { $output .= '
'; } - $output .= '
'. + $output .= ''. &Apache::lonhtmlcommon::start_pick_box()."\n". &Apache::lonhtmlcommon::row_title(&mt('E-mail address'), - 'LC_pick_box_title')."\n". - $emailform."\n". - &Apache::lonhtmlcommon::row_closure(1). - &Apache::lonhtmlcommon::row_title(&mt('Validation'), - 'LC_pick_box_title')."\n". - $captchaform."\n". - &mt('If either word is hard to read, [_1] will replace them.','reCAPTCHA refresh').'

'; + 'LC_pick_box_title')."\n". + $emailform."\n"; + if ($captchaform) { + $output .= &Apache::lonhtmlcommon::row_closure(1). + &Apache::lonhtmlcommon::row_title(&mt('Validation'), + 'LC_pick_box_title')."\n". + $captchaform."\n".'

'; + } if ($courseid ne '') { $output .= ''."\n"; } @@ -442,12 +420,6 @@ sub print_username_form { $output .= &Apache::lonhtmlcommon::echo_form_input(['courseid']); } $output .= '
'; - } else { - my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount'; - if ($courseid ne '') { - $helpdesk .= '&courseid='.$courseid; - } - $output .= ''.&mt('An error occurred generating the validation code[_1] required for an e-mail address to be used as username.','
').'


'.&mt('[_1]Contact the helpdesk[_2] or [_3]reload[_2] the page and try again.','
','',''); } $output .= ''; } @@ -469,13 +441,12 @@ sub login_box { ); my ($lkey,$ukey) = &Apache::lonpreferences::des_keys(); my ($lextkey,$uextkey) = &getkeys($lkey,$ukey); - my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount', + my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount', $lonhost); $output = &serverform($logtoken,$lonhost,undef,$courseid,$context); my $unameform = ''; my $upassform = ''; - $output .= '
'."\n". - ''. + $output .= ''."\n". &Apache::lonhtmlcommon::start_pick_box()."\n". &Apache::lonhtmlcommon::row_title($titles{$context}, 'LC_pick_box_title')."\n". @@ -484,6 +455,16 @@ sub login_box { &Apache::lonhtmlcommon::row_title(&mt('Password'), 'LC_pick_box_title')."\n". $upassform; + if ($context eq 'selfenroll') { + my $udomform = ''; + $output .= &Apache::lonhtmlcommon::row_closure(1)."\n". + &Apache::lonhtmlcommon::row_title(&mt('Domain'), + 'LC_pick_box_title')."\n". + $udomform."\n"; + } else { + $output .= ''; + } $output .= &Apache::lonhtmlcommon::row_closure(1). &Apache::lonhtmlcommon::row_title(). '
$username, - udom => $domain, - ); - my $firsturl = '/adm/roles'; - if (defined($courseid)) { - $courseid = &validate_course($courseid); - if ($courseid ne '') { - $form{'courseid'} = $courseid; - $firsturl = '/adm/selfenroll?courseid='.$courseid; - } - } + my ($r,$username,$domain,$uhome,$courseid,$token) = @_; + if ($r->dir_config('lonBalancer') eq 'yes') { - &Apache::lonauth::success($r,$form{'uname'},$form{'udom'}, - $lonhost,'noredirect',undef,\%form); - if ($token ne '') { - my $delete = &Apache::lonnet::tmpdel($token); - } + Apache::lonauth::success($r, $username, $domain, $uhome, + 'noredirect', undef, {}); + + Apache::lonnet::tmpdel($token) if $token; + $r->internal_redirect('/adm/switchserver'); } else { - &Apache::lonauth::success($r,$form{'uname'},$form{'udom'}, - $lonhost,$firsturl,undef,\%form); + $courseid = Apache::lonnet::is_course($courseid); + + Apache::lonauth::success($r, $username, $domain, $uhome, + ($courseid ? "/adm/selfenroll?courseid=$courseid" : '/adm/roles'), + undef, {}); } - return %form; -} + return; +} +# +# The screen that the user gets to create his or her account +# Desired username, desired password, etc +# Stores token to store DES-key and stage during creation session +# sub print_dataentry_form { my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_; my ($error,$output); @@ -717,7 +686,7 @@ sub print_dataentry_form { $output .= &javascript_setforms($now)."\n".&javascript_checkpass($now); my ($lkey,$ukey) = &Apache::lonpreferences::des_keys(); my ($lextkey,$uextkey) = &getkeys($lkey,$ukey); - my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount', + my $logtoken=Apache::lonnet::reply('tmpput:'.$ukey.$lkey.'&createaccount:createaccount', $lonhost); my $formtag = ''; my ($datatable,$rowcount) = @@ -746,7 +715,7 @@ ENDSERVERFORM my $upasstwo = ''; my $submit_text = &mt('Create LON-CAPA account'); $output .= '

'.&mt('Login Data').'

'."\n". - ''."\n". &Apache::lonhtmlcommon::start_pick_box()."\n". &Apache::lonhtmlcommon::row_title(&mt('Username'), @@ -784,6 +753,10 @@ ENDSERVERFORM return $output; } +# +# Retrieve rules for generating accounts from domain configuration +# Can the user make a new account or just self-enroll? + sub get_creation_controls { my ($domain,$usercreation) = @_; my (@cancreate,@statustocreate); @@ -791,6 +764,17 @@ sub get_creation_controls { if (ref($usercreation->{'cancreate'}) eq 'HASH') { if (ref($usercreation->{'cancreate'}{'statustocreate'}) eq 'ARRAY') { @statustocreate = @{$usercreation->{'cancreate'}{'statustocreate'}}; + if (@statustocreate == 0) { + my ($othertitle,$usertypes,$types) = + &Apache::loncommon::sorted_inst_types($domain); + if (ref($types) eq 'ARRAY') { + if (@{$types} == 0) { + @statustocreate = ('default'); + } + } else { + @statustocreate = ('default'); + } + } } else { @statustocreate = ('default'); my ($othertitle,$usertypes,$types) = @@ -811,17 +795,22 @@ sub get_creation_controls { } sub create_account { - my ($r,$domain,$lonhost,$username,$domdesc) = @_; + my ($r,$domain,$username,$domdesc) = @_; +# Get the token info my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'}, $env{'form.serverid'}); +# $retrieved is 'ok' if things worked +# $output is user error output +# $upass is the decrypted password # Error messages my $error = ''.&mt('Error:').' '; my $end = '

'; - my $rtnlink = '
'. + my $rtnlink = ''. &mt('Return to previous page').''. &Apache::loncommon::end_page(); if ($retrieved eq 'ok') { if ($env{'form.courseid'} ne '') { +# See if we are allowed to use this username per domain rules (number of characters, etc) my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc); if ($result eq 'fail') { $output = $error.&mt('Invalid ID format').$end. @@ -832,22 +821,32 @@ sub create_account { } else { return ('fail',$error.$output.$end.$rtnlink); } - # Call modifyuser + # Yes! We can do this. Valid token, valid username format + # Create an internally authenticated account with password $upass + # if the account does not exist yet + # Assign student/staff number $env{'form.cid'}, first name, last name, etc my $result = &Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'}, 'internal',$upass,$env{'form.cfirstname'}, $env{'form.cmiddlename'},$env{'form.clastname'}, $env{'form.cgeneration'},undef,undef,$username); $output = &mt('Generating user: [_1]',$result); + # Now that the user exists, we can have a homeserver my $uhome = &Apache::lonnet::homeserver($username,$domain); $output .= '
'.&mt('Home server: [_1]',$uhome).' '. &Apache::lonnet::hostname($uhome).'

'; - return ('ok',$output); + return ('ok',$output,$uhome); } sub username_validation { my ($r,$username,$domain,$domdesc,$contact_name,$contact_email,$courseid, $lonhost,$statustocreate) = @_; +# $username,$domain: for the user who needs to be validated +# $domdesc: full name of the domain (for error messages) +# $contact_name, $contact_email: name and email for user assistance (for error messages in &username_check +# $courseid: ID of the course that the user should be validated for, goes into start_session +# $statustocreate: -> inststatus in username_check ('faculty', 'staff', 'student', ...) + my ($retrieved,$output,$upass); $username= &LONCAPA::clean_username($username); @@ -862,7 +861,7 @@ sub username_validation { if ($uhome ne 'no_host') { my $result = &Apache::lonnet::authenticate($username,$upass,$domain); if ($result ne 'no_host') { - my %form = &start_session($r,$username,$domain,$lonhost,$courseid); + &start_session($r,$username,$domain,$uhome,$courseid); $output = '

'.&mt('A LON-CAPA account already exists for username [_1] at this institution ([_2]).',''.$username.'',$domdesc).'
'.&mt('The password entered was also correct so you have been logged in.'); return ('existingaccount',$output); } else { @@ -912,7 +911,7 @@ sub username_check { my (%rulematch,%inst_results,$checkfail,$rowcount,$editable,$output,$msg, %alerts,%curr_rules,%got_rules); &call_rulecheck($username,$domain,\%alerts,\%rulematch, - \%inst_results,\%curr_rules,%got_rules,'username'); + \%inst_results,\%curr_rules,\%got_rules,'username'); if (ref($alerts{'username'}) eq 'HASH') { if (ref($alerts{'username'}{$domain}) eq 'HASH') { if ($alerts{'username'}{$domain}{$username}) { @@ -958,7 +957,7 @@ sub username_check { 'time' => $now, 'domain' => $domain, 'username' => $username); - my $authtoken = &Apache::lonnet::tmpput(\%info,$lonhost); + my $authtoken = &Apache::lonnet::tmpput(\%info,$lonhost,'createaccount'); if ($authtoken !~ /^error/ && $authtoken ne 'no_such_host') { $output .= ''; } else { @@ -969,7 +968,7 @@ sub username_check { } } if ($checkfail) { - $msg = '

'.&mt('Account creation unavailable').'

'; + $msg = '

'.&mt('Account creation unavailable').'

'; if ($checkfail eq 'username') { $msg .= ''. &mt('A LON-CAPA account may not be created with the username you use.'). @@ -995,7 +994,7 @@ sub username_check { if ($rowcount) { if ($editable) { if ($courseid ne '') { - $msg = '

'.&mt('User information').'

'; + $msg = '

'.&mt('User information').'

'; } $msg .= &mt('To create one, use the table below to provide information about yourself, then click the [_1]Create LON-CAPA account[_2] button.','','').'
'; } else { @@ -1016,11 +1015,11 @@ sub username_check { } sub username_activation { - my ($r,$username,$domain,$domdesc,$lonhost,$courseid) = @_; + my ($r,$username,$domain,$domdesc,$courseid) = @_; my $output; my $error = ''.&mt('Error:').' '; my $end = '

'; - my $rtnlink = ''. + my $rtnlink = ''. &mt('Return to previous page').''. &Apache::loncommon::end_page(); my %domdefaults = &Apache::lonnet::get_domain_defaults($domain); @@ -1059,7 +1058,7 @@ sub username_activation { # Call modifyuser my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info); &call_rulecheck($username,$domain,\%alerts,\%rulematch, - \%inst_results,\%curr_rules,%got_rules); + \%inst_results,\%curr_rules,\%got_rules); my @userinfo = ('firstname','middlename','lastname','generation', 'permanentemail','id'); my %canmodify = @@ -1086,7 +1085,8 @@ sub username_activation { if ($result eq 'ok') { my $delete = &Apache::lonnet::tmpdel($env{'form.authtoken'}); $output = &mt('A LON-CAPA account has been created for username: [_1] in domain: [_2].',$username,$domain); - my %form = &start_session($r,$username,$domain,$lonhost,$courseid); + my $uhome=&Apache::lonnet::homeserver($username,$domain,'true'); + &start_session($r,$username,$domain,$uhome,$courseid); my $nostart = 1; return ('ok',$output,$nostart); } else { @@ -1102,6 +1102,9 @@ sub username_activation { sub check_id { my ($username,$domain,$domdesc) = @_; # Check ID format + # Is $username in an okay format for $domain + # (right number of characters, special characters, etc - follow domain rules)? + # $domdesc is just used for user error messages my (%alerts,%rulematch,%inst_results,%curr_rules,%checkhash); my %checks = ('id' => 1); %{$checkhash{$username.':'.$domain}} = ( @@ -1132,45 +1135,44 @@ sub invalid_state { my ($error,$domdesc,$contact_name,$contact_email,$msgtext) = @_; my $msg = '

'.&mt('Account creation unavailable').'

'; if ($error eq 'baduseremail') { - $msg = &mt('The e-mail address you provided does not appear to be a valid address.'); + $msg .= &mt('The e-mail address you provided does not appear to be a valid address.'); } elsif ($error eq 'existinguser') { - $msg = &mt('The e-mail address you provided is already in use as a username in LON-CAPA at this institution.'); + $msg .= &mt('The e-mail address you provided is already in use as a username in LON-CAPA at this institution.'); } elsif ($error eq 'userrules') { - $msg = &mt('Username rules at this institution do not allow the e-mail address you provided to be used as a username.'); + $msg .= &mt('Username rules at this institution do not allow the e-mail address you provided to be used as a username.'); } elsif ($error eq 'userformat') { - $msg = &mt('The e-mail address you provided may not be used as a username at this LON-CAPA institution.'); + $msg .= &mt('The e-mail address you provided may not be used as a username at this LON-CAPA institution.'); } elsif ($error eq 'captcha') { - $msg = &mt('Validation of the code your entered failed.'); + $msg .= &mt('Validation of the code you entered failed.'); } elsif ($error eq 'noemails') { - $msg = &mt('Creation of a new user account using an e-mail address as username is not permitted at this LON-CAPA institution.'); + $msg .= &mt('Creation of a new user account using an e-mail address as username is not permitted at this LON-CAPA institution.'); } $msg .= ''; if ($msgtext) { $msg .= '
'.$msgtext; } - $msg .= &linkto_email_help($contact_email,$domdesc); + $msg .= &linkto_email_help($contact_email,$domdesc,$error); return $msg; } sub linkto_email_help { - my ($contact_email,$domdesc) = @_; + my ($contact_email,$domdesc,$error) = @_; my $msg; + my $href = '/adm/helpdesk'; if ($contact_email ne '') { my $escuri = &HTML::Entities::encode('/adm/createaccount','&<>"'); - $msg .= '
'.&mt('You may wish to contact the [_1]LON-CAPA helpdesk[_2] for [_3].','','',$domdesc).'
'; + $href .= '?origurl='.$escuri; + if ($error eq 'existinguser') { + my $escemail = &HTML::Entities::encode($env{'form.useremail'}); + $href .= '&useremail='.$escemail.'&useraccount='.$escemail; + } + $msg .= '
'.&mt('You may wish to contact the [_1]LON-CAPA helpdesk[_2] for [_3].','','',$domdesc).'
'; } else { $msg .= '
'.&mt('You may wish to send an e-mail to the server administrator: [_1] for [_2].',$Apache::lonnet::perlvar{'AdminEmail'},$domdesc).'
'; } return $msg; } -sub create_recaptcha { - my $captcha = Captcha::reCAPTCHA->new; - return $captcha->get_options_setter({theme => 'white'})."\n". - $captcha->get_html('PUBLICKEY'); # generate public key for IP - # from http://recaptcha.net/ -} - sub getkeys { my ($lkey,$ukey) = @_; my $lextkey=hex($lkey); @@ -1208,6 +1210,12 @@ ENDSERVERFORM } sub process_credentials { +# +# Fetches the information from the logtoken via tmpget +# Token contains the DES-key and the stage of the process (would only be "createaccount") +# $lonhost in this routine is *not* necessarily the machine that this runs on, +# but $env{'form.serverid'}, the machine that issued the token. +# my ($logtoken,$lonhost) = @_; my $tmpinfo=Apache::lonnet::reply('tmpget:'.$logtoken,$lonhost); my ($retrieved,$output,$upass); @@ -1229,6 +1237,10 @@ sub process_credentials { } else { $output = &mt('Unable to retrieve your log-in information - unexpected context'); } +# $retrieved is 'ok' if retrieved okay +# $output is screen output for the user +# $upass is $env{'form.upass'}, decrypted with the DES-key, if stage was 'createaccount' + return ($retrieved,$output,$upass); } 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.