version 1.1056.2.2, 2010/03/26 21:27:41
|
version 1.1056.2.7, 2010/10/01 14:26:24
|
Line 3059 sub courseiddump {
|
Line 3059 sub courseiddump {
|
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok, |
$selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone, |
$selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone, |
$cloneonly,$createdbefore,$createdafter,$creationcontext)=@_; |
$cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner)=@_; |
my $as_hash = 1; |
my $as_hash = 1; |
my %returnhash; |
my %returnhash; |
if (!$domfilter) { $domfilter=''; } |
if (!$domfilter) { $domfilter=''; } |
Line 3081 sub courseiddump {
|
Line 3081 sub courseiddump {
|
$showhidden.':'.$caller.':'.&escape($cloner).':'. |
$showhidden.':'.$caller.':'.&escape($cloner).':'. |
&escape($cc_clone).':'.$cloneonly.':'. |
&escape($cc_clone).':'.$cloneonly.':'. |
&escape($createdbefore).':'.&escape($createdafter).':'. |
&escape($createdbefore).':'.&escape($createdafter).':'. |
&escape($creationcontext),$tryserver); |
&escape($creationcontext).':'.$domcloner, |
|
$tryserver); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
foreach my $item (@pairs) { |
foreach my $item (@pairs) { |
my ($key,$value)=split(/\=/,$item,2); |
my ($key,$value)=split(/\=/,$item,2); |
Line 4028 sub standard_roleprivs {
|
Line 4029 sub standard_roleprivs {
|
} |
} |
|
|
sub set_userprivs { |
sub set_userprivs { |
my ($userroles,$allroles,$allgroups) = @_; |
my ($userroles,$allroles,$allgroups,$groups_roles) = @_; |
my $author=0; |
my $author=0; |
my $adv=0; |
my $adv=0; |
my %grouproles = (); |
my %grouproles = (); |
if (keys(%{$allgroups}) > 0) { |
if (keys(%{$allgroups}) > 0) { |
|
my @groupkeys; |
foreach my $role (keys(%{$allroles})) { |
foreach my $role (keys(%{$allroles})) { |
my ($trole,$area,$sec,$extendedarea); |
push(@groupkeys,$role); |
if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) { |
} |
$trole = $1; |
if (ref($groups_roles) eq 'HASH') { |
$area = $2; |
foreach my $key (keys(%{$groups_roles})) { |
$sec = $3; |
unless (grep(/^\Q$key\E$/,@groupkeys)) { |
$extendedarea = $area.$sec; |
push(@groupkeys,$key); |
if (exists($$allgroups{$area})) { |
} |
foreach my $group (keys(%{$$allgroups{$area}})) { |
} |
my $spec = $trole.'.'.$extendedarea; |
} |
$grouproles{$spec.'.'.$area.'/'.$group} = |
if (@groupkeys > 0) { |
$$allgroups{$area}{$group}; |
foreach my $role (@groupkeys) { |
|
my ($trole,$area,$sec,$extendedarea); |
|
if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) { |
|
$trole = $1; |
|
$area = $2; |
|
$sec = $3; |
|
$extendedarea = $area.$sec; |
|
if (exists($$allgroups{$area})) { |
|
foreach my $group (keys(%{$$allgroups{$area}})) { |
|
my $spec = $trole.'.'.$extendedarea; |
|
$grouproles{$spec.'.'.$area.'/'.$group} = |
|
$$allgroups{$area}{$group}; |
|
} |
} |
} |
} |
} |
} |
} |
Line 4091 sub role_status {
|
Line 4105 sub role_status {
|
if ($$tstart<$now) { |
if ($$tstart<$now) { |
if ($$tstart && $$tstart>$refresh) { |
if ($$tstart && $$tstart>$refresh) { |
if (($$where ne '') && ($$role ne '')) { |
if (($$where ne '') && ($$role ne '')) { |
my (%allroles,%allgroups,$group_privs); |
my (%allroles,%allgroups,$group_privs, |
|
%groups_roles,@rolecodes); |
my %userroles = ( |
my %userroles = ( |
'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend |
'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend |
); |
); |
|
@rolecodes = ('cm'); |
my $spec=$$role.'.'.$$where; |
my $spec=$$role.'.'.$$where; |
my ($tdummy,$tdomain,$trest)=split(/\//,$$where); |
my ($tdummy,$tdomain,$trest)=split(/\//,$$where); |
if ($$role =~ /^cr\//) { |
if ($$role =~ /^cr\//) { |
&custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where); |
&custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where); |
|
push(@rolecodes,'cr'); |
} elsif ($$role eq 'gr') { |
} elsif ($$role eq 'gr') { |
|
push(@rolecodes,$$role); |
my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'}, |
my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'}, |
$env{'user.name'}); |
$env{'user.name'}); |
my $trole = split('_',$rolehash{$$where.'_'.$$role},1); |
my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2); |
(undef,my $group_privs) = split(/\//,$trole); |
(undef,my $group_privs) = split(/\//,$trole); |
$group_privs = &unescape($group_privs); |
$group_privs = &unescape($group_privs); |
&group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart); |
&group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart); |
|
my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1); |
|
if (keys(%course_roles) > 0) { |
|
my ($tnum) = ($trest =~ /^($match_courseid)/); |
|
if ($tdomain ne '' && $tnum ne '') { |
|
foreach my $key (keys(%course_roles)) { |
|
if ($key =~ /^\Q$tnum\E:\Q$tdomain\E:([^:]+):?([^:]*)/) { |
|
my $crsrole = $1; |
|
my $crssec = $2; |
|
if ($crsrole =~ /^cr/) { |
|
unless (grep(/^cr$/,@rolecodes)) { |
|
push(@rolecodes,'cr'); |
|
} |
|
} else { |
|
unless(grep(/^\Q$crsrole\E$/,@rolecodes)) { |
|
push(@rolecodes,$crsrole); |
|
} |
|
} |
|
my $rolekey = $crsrole.'./'.$tdomain.'/'.$tnum; |
|
if ($crssec ne '') { |
|
$rolekey .= '/'.$crssec; |
|
} |
|
$rolekey .= './'; |
|
$groups_roles{$rolekey} = \@rolecodes; |
|
} |
|
} |
|
} |
|
} |
} else { |
} else { |
|
push(@rolecodes,$$role); |
&standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where); |
&standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where); |
} |
} |
my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups); |
my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles); |
&appenv(\%userroles,[$$role,'cm']); |
&appenv(\%userroles,\@rolecodes); |
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role); |
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role); |
} |
} |
} |
} |
Line 5617 sub update_allusers_table {
|
Line 5663 sub update_allusers_table {
|
'generation='.&escape($names->{'generation'}).'%%'. |
'generation='.&escape($names->{'generation'}).'%%'. |
'permanentemail='.&escape($names->{'permanentemail'}).'%%'. |
'permanentemail='.&escape($names->{'permanentemail'}).'%%'. |
'id='.&escape($names->{'id'}),$homeserver); |
'id='.&escape($names->{'id'}),$homeserver); |
my $reply = &get_query_reply($queryid); |
return; |
return $reply; |
|
} |
} |
|
|
# ------- Request retrieval of institutional classlists for course(s) |
# ------- Request retrieval of institutional classlists for course(s) |
Line 5812 sub auto_validate_instcode {
|
Line 5857 sub auto_validate_instcode {
|
$homeserver = &domain($cdom,'primary'); |
$homeserver = &domain($cdom,'primary'); |
} |
} |
} |
} |
my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'. |
$response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'. |
&escape($instcode).':'.&escape($owner),$homeserver)); |
&escape($instcode).':'.&escape($owner),$homeserver)); |
my ($outcome,$description) = map { &unescape($_); } split('&',$response,2); |
my ($outcome,$description) = map { &unescape($_); } split('&',$response,2); |
return ($outcome,$description); |
return ($outcome,$description); |
} |
} |
Line 6541 sub modifyuser {
|
Line 6586 sub modifyuser {
|
' by '.$env{'user.name'}.' at '.$env{'user.domain'}. |
' by '.$env{'user.name'}.' at '.$env{'user.domain'}. |
' in domain '.$env{'request.role.domain'}); |
' in domain '.$env{'request.role.domain'}); |
my $uhome=&homeserver($uname,$udom,'true'); |
my $uhome=&homeserver($uname,$udom,'true'); |
|
my $newuser; |
|
if ($uhome eq 'no_host') { |
|
$newuser = 1; |
|
} |
# ----------------------------------------------------------------- Create User |
# ----------------------------------------------------------------- Create User |
if (($uhome eq 'no_host') && |
if (($uhome eq 'no_host') && |
(($umode && $upass) || ($umode eq 'localauth'))) { |
(($umode && $upass) || ($umode eq 'localauth'))) { |
Line 6593 sub modifyuser {
|
Line 6642 sub modifyuser {
|
['firstname','middlename','lastname','generation','id', |
['firstname','middlename','lastname','generation','id', |
'permanentemail','inststatus'], |
'permanentemail','inststatus'], |
$udom,$uname); |
$udom,$uname); |
my %names; |
my (%names,%oldnames); |
if ($tmp[0] =~ m/^error:.*/) { |
if ($tmp[0] =~ m/^error:.*/) { |
%names=(); |
%names=(); |
} else { |
} else { |
%names = @tmp; |
%names = @tmp; |
|
%oldnames = %names; |
} |
} |
# |
# |
# If name, email and/or uid are blank (e.g., because an uploaded file |
# If name, email and/or uid are blank (e.g., because an uploaded file |
Line 6651 sub modifyuser {
|
Line 6701 sub modifyuser {
|
} |
} |
} |
} |
} |
} |
my $reply = &put('environment', \%names, $udom,$uname); |
my $logmsg = $udom.', '.$uname.', '.$uid.', '. |
if ($reply ne 'ok') { return 'error: '.$reply; } |
|
my $sqlresult = &update_allusers_table($uname,$udom,\%names); |
|
&devalidate_cache_new('namescache',$uname.':'.$udom); |
|
my $logmsg = 'Success modifying user '.$udom.', '.$uname.', '.$uid.', '. |
|
$umode.', '.$first.', '.$middle.', '. |
$umode.', '.$first.', '.$middle.', '. |
$last.', '.$gene.', '.$email.', '.$inststatus; |
$last.', '.$gene.', '.$email.', '.$inststatus; |
if ($env{'user.name'} ne '' && $env{'user.domain'}) { |
if ($env{'user.name'} ne '' && $env{'user.domain'}) { |
Line 6663 sub modifyuser {
|
Line 6709 sub modifyuser {
|
} else { |
} else { |
$logmsg .= ' during self creation'; |
$logmsg .= ' during self creation'; |
} |
} |
|
my $changed; |
|
if ($newuser) { |
|
$changed = 1; |
|
} else { |
|
foreach my $field (@fields) { |
|
if ($names{$field} ne $oldnames{$field}) { |
|
$changed = 1; |
|
last; |
|
} |
|
} |
|
} |
|
unless ($changed) { |
|
$logmsg = 'No changes in user information needed for: '.$logmsg; |
|
&logthis($logmsg); |
|
return 'ok'; |
|
} |
|
my $reply = &put('environment', \%names, $udom,$uname); |
|
if ($reply ne 'ok') { |
|
return 'error: '.$reply; |
|
} |
|
if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) { |
|
&Apache::lonnet::devalidate_cache_new('emailscache',$uname.':'.$udom); |
|
} |
|
my $sqlresult = &update_allusers_table($uname,$udom,\%names); |
|
&devalidate_cache_new('namescache',$uname.':'.$udom); |
|
$logmsg = 'Success modifying user '.$logmsg; |
&logthis($logmsg); |
&logthis($logmsg); |
return 'ok'; |
return 'ok'; |
} |
} |