version 1.49, 2012/05/17 17:41:48
|
version 1.50, 2012/05/17 18:05:42
|
Line 683 sub start_session {
|
Line 683 sub start_session {
|
return; |
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 { |
sub print_dataentry_form { |
my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_; |
my ($r,$domain,$lonhost,$include,$mailtoken,$now,$username,$start_page) = @_; |
my ($error,$output); |
my ($error,$output); |
Line 763 ENDSERVERFORM
|
Line 767 ENDSERVERFORM
|
return $output; |
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 { |
sub get_creation_controls { |
my ($domain,$usercreation) = @_; |
my ($domain,$usercreation) = @_; |
my (@cancreate,@statustocreate); |
my (@cancreate,@statustocreate); |
Line 802 sub get_creation_controls {
|
Line 810 sub get_creation_controls {
|
|
|
sub create_account { |
sub create_account { |
my ($r,$domain,$lonhost,$username,$domdesc) = @_; |
my ($r,$domain,$lonhost,$username,$domdesc) = @_; |
|
# Get the token info |
my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'}, |
my ($retrieved,$output,$upass) = &process_credentials($env{'form.logtoken'}, |
$env{'form.serverid'}); |
$env{'form.serverid'}); |
|
# $retrieved is 'ok' if things worked |
|
# $output is user error output |
|
# $upass is the decrypted password |
# Error messages |
# Error messages |
my $error = '<span class="LC_error">'.&mt('Error:').' '; |
my $error = '<span class="LC_error">'.&mt('Error:').' '; |
my $end = '</span><br /><br />'; |
my $end = '</span><br /><br />'; |
Line 812 sub create_account {
|
Line 824 sub create_account {
|
&Apache::loncommon::end_page(); |
&Apache::loncommon::end_page(); |
if ($retrieved eq 'ok') { |
if ($retrieved eq 'ok') { |
if ($env{'form.courseid'} ne '') { |
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); |
my ($result,$userchkmsg) = &check_id($username,$domain,$domdesc); |
if ($result eq 'fail') { |
if ($result eq 'fail') { |
$output = $error.&mt('Invalid ID format').$end. |
$output = $error.&mt('Invalid ID format').$end. |
Line 822 sub create_account {
|
Line 835 sub create_account {
|
} else { |
} else { |
return ('fail',$error.$output.$end.$rtnlink); |
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 = |
my $result = |
&Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'}, |
&Apache::lonnet::modifyuser($domain,$username,$env{'form.cid'}, |
'internal',$upass,$env{'form.cfirstname'}, |
'internal',$upass,$env{'form.cfirstname'}, |
$env{'form.cmiddlename'},$env{'form.clastname'}, |
$env{'form.cmiddlename'},$env{'form.clastname'}, |
$env{'form.cgeneration'},undef,undef,$username); |
$env{'form.cgeneration'},undef,undef,$username); |
$output = &mt('Generating user: [_1]',$result); |
$output = &mt('Generating user: [_1]',$result); |
|
# Now that the user exists, we can have a homeserver |
my $uhome = &Apache::lonnet::homeserver($username,$domain); |
my $uhome = &Apache::lonnet::homeserver($username,$domain); |
$output .= '<br />'.&mt('Home server: [_1]',$uhome).' '. |
$output .= '<br />'.&mt('Home server: [_1]',$uhome).' '. |
&Apache::lonnet::hostname($uhome).'<br /><br />'; |
&Apache::lonnet::hostname($uhome).'<br /><br />'; |
Line 1098 sub username_activation {
|
Line 1115 sub username_activation {
|
sub check_id { |
sub check_id { |
my ($username,$domain,$domdesc) = @_; |
my ($username,$domain,$domdesc) = @_; |
# Check ID format |
# 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 (%alerts,%rulematch,%inst_results,%curr_rules,%checkhash); |
my %checks = ('id' => 1); |
my %checks = ('id' => 1); |
%{$checkhash{$username.':'.$domain}} = ( |
%{$checkhash{$username.':'.$domain}} = ( |