--- loncom/interface/loncreateuser.pm 2007/11/09 20:51:20 1.192
+++ loncom/interface/loncreateuser.pm 2007/11/15 21:24:51 1.196
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Create a user
#
-# $Id: loncreateuser.pm,v 1.192 2007/11/09 20:51:20 albertel Exp $
+# $Id: loncreateuser.pm,v 1.196 2007/11/15 21:24:51 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -440,31 +440,41 @@ sub print_user_query_page {
}
sub print_user_modification_page {
- my ($r,$ccuname,$ccdomain,$srch,$response) = @_;
+ my ($r,$ccuname,$ccdomain,$srch,$response,$context) = @_;
if (($ccuname eq '') || ($ccdomain eq '')) {
my $usermsg = &mt('No username and/or domain provided.');
&print_username_entry_form($r,$usermsg);
return;
}
my %abv_auth = &auth_abbrev();
- my ($curr_authtype,$instsrch,$rulematch,$rules,%inst_results,
- $curr_kerb_ver,$newuser);
+ my ($curr_authtype,%rulematch,%inst_results,$curr_kerb_ver,$newuser,
+ %alerts,%curr_rules,%got_rules);
my $uhome=&Apache::lonnet::homeserver($ccuname,$ccdomain);
if ($uhome eq 'no_host') {
$newuser = 1;
- $instsrch =
- {
- srchin => 'instd',
- srchby => 'uname',
- srchtype => 'exact',
- srchterm => $ccuname,
- srchdomain => $ccdomain,
- };
- (my $usercheckmsg,$rulematch,$rules,%inst_results) =
- &Apache::loncommon::username_rule_check($instsrch,'new');
- if ($usercheckmsg) {
- &print_username_entry_form($r,$usercheckmsg);
- return;
+ my $checkhash;
+ my $checks = { 'username' => 1 };
+ $checkhash->{$ccuname.':'.$ccdomain} = { 'newuser' => $newuser };
+ &Apache::loncommon::user_rule_check($checkhash,$checks,
+ \%alerts,\%rulematch,\%inst_results,\%curr_rules,\%got_rules);
+ if (ref($alerts{'username'}) eq 'HASH') {
+ if (ref($alerts{'username'}{$ccdomain}) eq 'HASH') {
+ my $domdesc =
+ &Apache::lonnet::domain($ccdomain,'description');
+ if ($alerts{'username'}{$ccdomain}{$ccuname}) {
+ my $userchkmsg;
+ if (ref($curr_rules{$ccdomain}) eq 'HASH') {
+ $userchkmsg =
+ &Apache::loncommon::instrule_disallow_msg('username',
+ $domdesc,1).
+ &Apache::loncommon::user_rule_formats($ccdomain,
+ $domdesc,$curr_rules{$ccdomain}{'username'},
+ 'username');
+ }
+ &print_username_entry_form($r,$userchkmsg);
+ return;
+ }
+ }
}
} else {
$newuser = 0;
@@ -766,7 +776,7 @@ $forminfo
$loginscript
</script>
<input type='hidden' name='makeuser' value='1' />
-<h3>$lt{'cnu'} "$ccuname" $lt{'ind'} $ccdomain</h3>
+<h2>$lt{'cnu'} "$ccuname" $lt{'ind'} $ccdomain</h2>
ENDTITLE
$r->print('<div class="LC_left_float">'.
&personal_data_display($ccuname,$ccdomain,$newuser,
@@ -782,17 +792,23 @@ $lt{'hs'}: $home_server_pick
} else {
$r->print($home_server_pick);
}
+ if ($context eq 'domain') {
+ $r->print(&Apache::lonuserutils::forceid_change());
+ }
$r->print('</div>'."\n".'<div class="LC_left_float"><h3>'.
$lt{'lg'}.'</h3>');
my ($fixedauth,$varauth,$authmsg);
- if ($rulematch) {
+ if (ref($rulematch{$ccuname.':'.$ccdomain}) eq 'HASH') {
+ my $matchedrule = $rulematch{$ccuname.':'.$ccdomain}{'username'};
+ my ($rules,$ruleorder) =
+ &Apache::lonnet::inst_userrules($ccdomain,'username');
if (ref($rules) eq 'HASH') {
- if (ref($rules->{$rulematch}) eq 'HASH') {
- my $authtype = $rules->{$rulematch}{'authtype'};
+ if (ref($rules->{$matchedrule}) eq 'HASH') {
+ my $authtype = $rules->{$matchedrule}{'authtype'};
if ($authtype !~ /^(krb4|krb5|int|fsys|loc)$/) {
$r->print(&Apache::lonuserutils::set_login($ccdomain,$authformkrb,$authformint,$authformloc));
} else {
- my $authparm = $rules->{$rulematch}{'authparm'};
+ my $authparm = $rules->{$matchedrule}{'authparm'};
if ($authtype =~ /^krb(4|5)$/) {
my $ver = $1;
if ($authparm ne '') {
@@ -801,12 +817,12 @@ $lt{'hs'}: $home_server_pick
<input type="hidden" name="krbver" value="$ver" />
<input type="hidden" name="krbarg" value="$authparm" />
KERB
- $authmsg = $rules->{$rulematch}{'authmsg'};
+ $authmsg = $rules->{$matchedrule}{'authmsg'};
}
} else {
$fixedauth =
'<input type="hidden" name="login" value="'.$authtype.'" />'."\n";
- if ($rules->{$rulematch}{'authparmfixed'}) {
+ if ($rules->{$matchedrule}{'authparmfixed'}) {
$fixedauth .=
'<input type="hidden" name="'.$authtype.'arg" value="'.$authparm.'" />'."\n";
} else {
@@ -1450,8 +1466,8 @@ sub update_user_data {
$env{'form.ccdomain'});
# Error messages
my $error = '<span class="LC_error">'.&mt('Error').': ';
- my $end = '</span><br /><br />'.
- '<a href="javascript:backPage(document.userupdate,'.
+ my $end = '</span><br /><br />';
+ my $rtnlink = '<a href="javascript:backPage(document.userupdate,'.
"'$env{'form.prevphase'}','modify')".'" />'.
&mt('Return to previous page').'</a>'.&Apache::loncommon::end_page();
my $title;
@@ -1489,25 +1505,25 @@ sub update_user_data {
$r->print(&update_result_form($uhome));
# Check Inputs
if (! $env{'form.ccuname'} ) {
- $r->print($error.&mt('No login name specified').'.'.$end);
+ $r->print($error.&mt('No login name specified').'.'.$end.$rtnlink);
return;
}
if ( $env{'form.ccuname'} ne
&LONCAPA::clean_username($env{'form.ccuname'}) ) {
$r->print($error.&mt('Invalid login name').'. '.
&mt('Only letters, numbers, periods, dashes, @, and underscores are valid').'.'.
- $end);
+ $end.$rtnlink);
return;
}
if (! $env{'form.ccdomain'} ) {
- $r->print($error.&mt('No domain specified').'.'.$end);
+ $r->print($error.&mt('No domain specified').'.'.$end.$rtnlink);
return;
}
if ( $env{'form.ccdomain'} ne
&LONCAPA::clean_domain($env{'form.ccdomain'}) ) {
$r->print($error.&mt ('Invalid domain name').'. '.
&mt('Only letters, numbers, periods, dashes, and underscores are valid').'.'.
- $end);
+ $end.$rtnlink);
return;
}
if (! exists($env{'form.makeuser'})) {
@@ -1543,19 +1559,19 @@ sub update_user_data {
# If they are creating a new user but have not specified login
# information this will be caught below.
} else {
- $r->print($error.&mt('Invalid login mode or password').$end);
+ $r->print($error.&mt('Invalid login mode or password').$end.$rtnlink);
return;
}
$r->print('<h3>'.&mt('User [_1] in domain [_2]',
$env{'form.ccuname'}, $env{'form.ccdomain'}).'</h3>');
-
+ my (%alerts,%rulematch,%inst_results,%curr_rules);
if ($env{'form.makeuser'}) {
$r->print('<h3>'.&mt('Creating new account.').'</h3>');
# Check for the authentication mode and password
if (! $amode || ! $genpwd) {
- $r->print($error.&mt('Invalid login mode or password').$end);
+ $r->print($error.&mt('Invalid login mode or password').$end.$rtnlink);
return;
}
# Determine desired host
@@ -1566,13 +1582,43 @@ sub update_user_data {
my %home_servers =
&Apache::lonnet::get_servers($env{'form.ccdomain'},'library');
if (! exists($home_servers{$desiredhost})) {
- $r->print($error.&mt('Invalid home server specified'));
+ $r->print($error.&mt('Invalid home server specified').$end.$rtnlink);
return;
}
}
+ # Check ID format
+ my %checkhash;
+ my %checks = ('id' => 1);
+ %{$checkhash{$env{'form.ccuname'}.':'.$env{'form.ccdomain'}}} = (
+ 'newuser' => 1,
+ 'id' => $env{'form.cid'},
+ );
+ if ($env{'form.cid'} ne '') {
+ &Apache::loncommon::user_rule_check(\%checkhash,\%checks,\%alerts,
+ \%rulematch,\%inst_results,\%curr_rules);
+ if (ref($alerts{'id'}) eq 'HASH') {
+ if (ref($alerts{'id'}{$env{'form.ccdomain'}}) eq 'HASH') {
+ my $domdesc =
+ &Apache::lonnet::domain($env{'form.ccdomain'},'description');
+ if ($alerts{'id'}{$env{'form.ccdomain'}}{$env{'form.cid'}}) {
+ my $userchkmsg;
+ if (ref($curr_rules{$env{'form.ccdomain'}}) eq 'HASH') {
+ $userchkmsg =
+ &Apache::loncommon::instrule_disallow_msg('id',
+ $domdesc,1).
+ &Apache::loncommon::user_rule_formats($env{'form.ccdomain'},
+ $domdesc,$curr_rules{$env{'form.ccdomain'}}{'id'},'id');
+ }
+ $r->print($error.&mt('Invalid ID format').$end.
+ $userchkmsg.$rtnlink);
+ return;
+ }
+ }
+ }
+ }
# Call modifyuser
my $result = &Apache::lonnet::modifyuser
- ($env{'form.ccdomain'},$env{'form.ccuname'},$env{'form.cstid'},
+ ($env{'form.ccdomain'},$env{'form.ccuname'},$env{'form.cid'},
$amode,$genpwd,$env{'form.cfirstname'},
$env{'form.cmiddlename'},$env{'form.clastname'},
$env{'form.cgeneration'},undef,$desiredhost,
@@ -1586,7 +1632,7 @@ sub update_user_data {
($env{'form.login'} ne '' )) {
# Modify user privileges
if (! $amode || ! $genpwd) {
- $r->print($error.'Invalid login mode or password'.$end);
+ $r->print($error.'Invalid login mode or password'.$end.$rtnlink);
return;
}
# Only allow authentification modification if the person has authority
@@ -1599,7 +1645,7 @@ sub update_user_data {
($env{'form.ccuname'},$env{'form.ccdomain'}));
} else {
# Okay, this is a non-fatal error.
- $r->print($error.&mt('You do not have the authority to modify this users authentification information').'.');
+ $r->print($error.&mt('You do not have the authority to modify this users authentification information').'.'.$end);
}
}
##
@@ -1607,17 +1653,40 @@ sub update_user_data {
# Check for need to change
my %userenv = &Apache::lonnet::get
('environment',['firstname','middlename','lastname','generation',
- 'permanentemail','portfolioquota','inststatus'],
+ 'id','permanentemail','portfolioquota','inststatus'],
$env{'form.ccdomain'},$env{'form.ccuname'});
my ($tmp) = keys(%userenv);
if ($tmp =~ /^(con_lost|error)/i) {
%userenv = ();
}
# Check to see if we need to change user information
- foreach my $item ('firstname','middlename','lastname','generation','permanentemail') {
+ foreach my $item ('firstname','middlename','lastname','generation','permanentemail','id') {
# Strip leading and trailing whitespace
$env{'form.c'.$item} =~ s/(\s+$|^\s+)//g;
}
+ # Check to see if we can change the ID/student number
+ my $forceid = $env{'form.forceid'};
+ my $recurseid = $env{'form.recurseid'};
+ my $newuser = 0;
+ my $disallowed_id = 0;
+ my (%alerts,%rulematch,%idinst_results,%curr_rules,%got_rules);
+ if (!$forceid) {
+ $env{'form.cid'} = $userenv{'id'};
+ } elsif ($env{'form.cid'} ne $userenv{'id'}) {
+ my $checkhash;
+ my $checks = { 'id' => 1 };
+ $checkhash->{$env{'form.ccuname'}.':'.$env{'form.ccdomain'}} =
+ { 'newuser' => $newuser,
+ 'id' => $env{'form.cid'},
+ };
+ &Apache::loncommon::user_rule_check($checkhash,$checks,
+ \%alerts,\%rulematch,\%idinst_results,\%curr_rules,\%got_rules);
+ if (ref($alerts{'id'}) eq 'HASH') {
+ if (ref($alerts{'id'}{$env{'form.ccdomain'}}) eq 'HASH') {
+ $disallowed_id = 1;
+ }
+ }
+ }
my ($quotachanged,$namechanged,$oldportfolioquota,$newportfolioquota,
$inststatus,$isdefault,$defquotatext);
my ($defquota,$settingstatus) =
@@ -1673,6 +1742,7 @@ sub update_user_data {
$env{'form.cmiddlename'} ne $userenv{'middlename'} ||
$env{'form.clastname'} ne $userenv{'lastname'} ||
$env{'form.cgeneration'} ne $userenv{'generation'} ||
+ $env{'form.cid'} ne $userenv{'id'} ||
$env{'form.cpermanentemail'} ne $userenv{'permanentemail'} )) {
$namechanged = 1;
}
@@ -1682,6 +1752,7 @@ sub update_user_data {
$changeHash{'middlename'} = $env{'form.cmiddlename'};
$changeHash{'lastname'} = $env{'form.clastname'};
$changeHash{'generation'} = $env{'form.cgeneration'};
+ $changeHash{'id'} = $env{'form.cid'};
$changeHash{'permanentemail'} = $env{'form.cpermanentemail'};
my $putresult = &Apache::lonnet::put
('environment',\%changeHash,
@@ -1694,6 +1765,7 @@ sub update_user_data {
'mddl' => "middle",
'lst' => "last",
'gen' => "generation",
+ 'id' => "ID/Student number",
'mail' => "permanent e-mail",
'disk' => "disk space allocated to portfolio files",
'prvs' => "Previous",
@@ -1707,6 +1779,7 @@ sub update_user_data {
<th>$lt{'mddl'}</th>
<th>$lt{'lst'}</th>
<th>$lt{'gen'}</th>
+ <th>$lt{'id'}</th>
<th>$lt{'mail'}</th>
<th>$lt{'disk'}</th></tr>
<tr><td>$lt{'prvs'}</td>
@@ -1714,6 +1787,7 @@ sub update_user_data {
<td>$userenv{'middlename'} </td>
<td>$userenv{'lastname'} </td>
<td>$userenv{'generation'} </td>
+ <td>$userenv{'id'}</td>
<td>$userenv{'permanentemail'} </td>
<td>$oldportfolioquota Mb</td>
</tr>
@@ -1722,10 +1796,24 @@ sub update_user_data {
<td>$env{'form.cmiddlename'} </td>
<td>$env{'form.clastname'} </td>
<td>$env{'form.cgeneration'} </td>
+ <td>$env{'form.cid'} </td>
<td>$env{'form.cpermanentemail'} </td>
<td>$newportfolioquota Mb $defquotatext </td></tr>
</table>
END
+ if (($forceid) && ($recurseid) && (!$disallowed_id) &&
+ (&Apache::lonnet::allowed('mau',$env{'form.ccdomain'}))) {
+ my %userupdate = (
+ lastname => $env{'form.clasaname'},
+ middlename => $env{'form.cmiddlename'},
+ firstname => $env{'form.cfirstname'},
+ generation => $env{'fora.cgeneration'},
+ id => $env{'form.cid'},
+ );
+ my $idresult = &propagate_id_change($env{'form.ccname'},
+ $env{'form.ccdomain'},\%userupdate);
+ $r->print('<br />'.$idresult.'<br />');
+ }
if (($env{'form.ccdomain'} eq $env{'user.domain'}) &&
($env{'form.ccuname'} eq $env{'user.name'})) {
my %newenvhash;
@@ -1749,12 +1837,19 @@ END
# They did not want to change the users name but we can
# still tell them what the name is
my %lt=&Apache::lonlocal::texthash(
+ 'id' => "ID/Student number",
'mail' => "Permanent e-mail",
'disk' => "Disk space allocated to user's portfolio files",
);
$r->print(<<"END");
-<h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} $userenv{'generation'} ($lt{'mail'}: $userenv{'permanentemail'})</h4>
+<h4>$userenv{'firstname'} $userenv{'middlename'} $userenv{'lastname'} $userenv{'generation'}
END
+ if ($userenv{'permanentemail'} eq '') {
+ $r->print('</h4>');
+ } else {
+ $r->print(' ('.$lt{'mail'}.': '.
+ $userenv{'permanentemail'}.')</h4>');
+ }
if ($putresult eq 'ok') {
if ($oldportfolioquota != $newportfolioquota) {
$r->print('<h4>'.$lt{'disk'}.': '.$newportfolioquota.' Mb '.
@@ -1766,6 +1861,7 @@ END
}
##
my $now=time;
+ my $rolechanges = 0;
$r->print('<h3>'.&mt('Modifying Roles').'</h3>');
foreach my $key (keys (%env)) {
next if (! $env{$key});
@@ -1786,8 +1882,8 @@ END
$env{'form.ccdomain'},$now);
$r->print($result);
}
- }
- if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$ }s) {
+ }
+ if ($key=~m{^form\.rev\:([^_]+)_cr\.cr/($match_domain)/($match_username)/(\w+)$}s) {
# Revoke custom role
$r->print(&mt('Revoking custom role:').
' '.$4.' by '.$3.':'.$2.' in '.$1.': <b>'.
@@ -1795,6 +1891,7 @@ END
$env{'form.ccuname'},$1,$2,$3,$4).
'</b><br />');
}
+ $rolechanges ++;
} elsif ($key=~/^form\.del/) {
if ($key=~/^form\.del\:([^\_]+)\_([^\_\.]+)$/) {
# Delete standard role
@@ -1820,6 +1917,7 @@ END
$env{'form.ccuname'},$url,$rdom,$rnam,$rolename,$now,
0,1).'</b><br />');
}
+ $rolechanges ++;
} elsif ($key=~/^form\.ren/) {
my $udom = $env{'form.ccdomain'};
my $uname = $env{'form.ccuname'};
@@ -1858,6 +1956,7 @@ END
$r->print(&mt('Re-enabling custom role [_1] by [_2]@[_3] in [_4] : <b>[_5]</b>',
$rolename,$rnam,$rdom,$url,$result).'<br />');
}
+ $rolechanges ++;
} elsif ($key=~/^form\.act/) {
my $udom = $env{'form.ccdomain'};
my $uname = $env{'form.ccuname'};
@@ -1971,10 +2070,14 @@ END
}
$r->print(' '.&mt('Please <a href="javascript:history.go(-1)">go back</a> and choose a different section name.').'</p><br />');
}
+ $rolechanges ++;
}
} # End of foreach (keys(%env))
# Flush the course logs so reverse user roles immediately updated
&Apache::lonnet::flushcourselogs();
+ if (!$rolechanges) {
+ $r->print(&mt('No roles to modify'));
+ }
$r->print(&Apache::loncommon::end_page());
}
@@ -2466,7 +2569,7 @@ sub handler {
$response = '';
}
&print_user_modification_page($r,$ccuname,$ccdomain,
- $srch,$response);
+ $srch,$response,$context);
} elsif ($currstate eq 'query') {
&print_user_query_page($r,'createuser');
} else {
@@ -2476,7 +2579,8 @@ sub handler {
} elsif ($env{'form.phase'} eq 'userpicked') {
my $ccuname = &LONCAPA::clean_username($env{'form.seluname'});
my $ccdomain = &LONCAPA::clean_domain($env{'form.seludom'});
- &print_user_modification_page($r,$ccuname,$ccdomain,$srch);
+ &print_user_modification_page($r,$ccuname,$ccdomain,$srch,'',
+ $context);
}
} elsif ($env{'form.phase'} eq 'update_user_data') {
&update_user_data($r);
@@ -2778,7 +2882,8 @@ sub user_search_result {
{&Apache::lonnet::get('environment',
['firstname',
'lastname',
- 'permanentemail'])};
+ 'permanentemail'],
+ $cudomain,$cuname)};
}
}
}