--- loncom/interface/createaccount.pm 2012/05/17 17:41:48 1.49 +++ loncom/interface/createaccount.pm 2012/05/18 04:31:05 1.51 @@ -3,7 +3,7 @@ # institutional log-in ID (institutional authentication required - localauth # or kerberos) or an e-mail address. # -# $Id: createaccount.pm,v 1.49 2012/05/17 17:41:48 www Exp $ +# $Id: createaccount.pm,v 1.51 2012/05/18 04:31:05 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -121,16 +121,14 @@ sub handler { &print_footer($r); return OK; } else { - $start_page = - &Apache::loncommon::start_page($title,$js); + $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); + $start_page = &Apache::loncommon::start_page($title,$js); my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$domain); @@ -191,7 +189,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; @@ -621,8 +619,8 @@ sub process_mailtoken { ($data{'username'} =~ /^[^\@]+\@[^\@]+\.[^\@\.]+$/)) { if ($now - $data{'time'} < 7200) { if ($env{'form.phase'} eq 'createaccount') { - my ($result,$output) = &create_account($r,$domain,$lonhost, - $data{'username'},$domdesc); + my ($result,$output,$uhome) = + &create_account($r,$domain,$data{'username'},$domdesc); if ($result eq 'ok') { $msg = $output; my $shownow = &Apache::lonlocal::locallocaltime($now); @@ -635,8 +633,8 @@ sub process_mailtoken { } else { $msg .= &mt('An error occurred when sending e-mail to [_1] confirming creation of your LON-CAPA account.',$data{'username'}); } - &start_session($r, $data{'username'}, $domain, $lonhost, - $data{'courseid'}, $token); + &start_session($r,$data{'username'},$domain,$uhome, + $data{'courseid'},$token); $nostart = 1; $noend = 1; } else { @@ -663,10 +661,10 @@ sub process_mailtoken { } sub start_session { - my ($r, $username, $domain, $lonhost, $courseid, $token) = @_; + my ($r,$username,$domain,$uhome,$courseid,$token) = @_; if ($r->dir_config('lonBalancer') eq 'yes') { - Apache::lonauth::success($r, $username, $domain, $lonhost, + Apache::lonauth::success($r, $username, $domain, $uhome, 'noredirect', undef, {}); Apache::lonnet::tmpdel($token) if $token; @@ -675,7 +673,7 @@ sub start_session { } else { $courseid = Apache::lonnet::is_course($courseid); - Apache::lonauth::success($r, $username, $domain, $lonhost, + Apache::lonauth::success($r, $username, $domain, $uhome, ($courseid ? "/adm/selfenroll?courseid=$courseid" : '/adm/roles'), undef, {}); } @@ -683,7 +681,11 @@ sub start_session { 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); @@ -763,6 +765,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); @@ -801,9 +807,13 @@ 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 = '

'; @@ -812,6 +822,7 @@ sub create_account { &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. @@ -822,17 +833,21 @@ 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 { @@ -858,7 +873,7 @@ sub username_validation { if ($uhome ne 'no_host') { my $result = &Apache::lonnet::authenticate($username,$upass,$domain); if ($result ne 'no_host') { - &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 { @@ -1012,7 +1027,7 @@ 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 = '

'; @@ -1082,7 +1097,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); - &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 { @@ -1098,6 +1114,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}} = (