--- loncom/lonnet/perl/lonnet.pm 2010/05/22 13:50:19 1.1056.2.4
+++ loncom/lonnet/perl/lonnet.pm 2010/03/21 18:31:53 1.1057
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1056.2.4 2010/05/22 13:50:19 raeburn Exp $
+# $Id: lonnet.pm,v 1.1057 2010/03/21 18:31:53 www Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -3207,7 +3207,7 @@ sub get_domain_roles {
return %personnel;
}
-# ----------------------------------------------------------- Check out an item
+# ----------------------------------------------------------- Interval timing
sub get_first_access {
my ($type,$argsymb)=@_;
@@ -3243,91 +3243,6 @@ sub set_first_access {
return 'already_set';
}
-sub checkout {
- my ($symb,$tuname,$tudom,$tcrsid)=@_;
- my $now=time;
- my $lonhost=$perlvar{'lonHostID'};
- my $infostr=&escape(
- 'CHECKOUTTOKEN&'.
- $tuname.'&'.
- $tudom.'&'.
- $tcrsid.'&'.
- $symb.'&'.
- $now.'&'.$ENV{'REMOTE_ADDR'});
- my $token=&reply('tmpput:'.$infostr,$lonhost);
- if ($token=~/^error\:/) {
- &logthis("WARNING: ".
- "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
- "");
- return '';
- }
-
- $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
- $token=~tr/a-z/A-Z/;
-
- my %infohash=('resource.0.outtoken' => $token,
- 'resource.0.checkouttime' => $now,
- 'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
-
- unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
- return '';
- } else {
- &logthis("WARNING: ".
- "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
- "");
- }
-
- if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
- &escape('Checkout '.$infostr.' - '.
- $token)) ne 'ok') {
- return '';
- } else {
- &logthis("WARNING: ".
- "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
- "");
- }
- return $token;
-}
-
-# ------------------------------------------------------------ Check in an item
-
-sub checkin {
- my $token=shift;
- my $now=time;
- my ($ta,$tb,$lonhost)=split(/\*/,$token);
- $lonhost=~tr/A-Z/a-z/;
- my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
- $dtoken=~s/\W/\_/g;
- my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
- split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
-
- unless (($tuname) && ($tudom)) {
- &logthis('Check in '.$token.' ('.$dtoken.') failed');
- return '';
- }
-
- unless (&allowed('mgr',$tcrsid)) {
- &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.
- $env{'user.name'}.' - '.$env{'user.domain'});
- return '';
- }
-
- my %infohash=('resource.0.intoken' => $token,
- 'resource.0.checkintime' => $now,
- 'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
-
- unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
- return '';
- }
-
- if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
- &escape('Checkin - '.$token)) ne 'ok') {
- return '';
- }
-
- return ($symb,$tuname,$tudom,$tcrsid);
-}
-
# --------------------------------------------- Set Expire Date for Spreadsheet
sub expirespread {
@@ -4028,36 +3943,23 @@ sub standard_roleprivs {
}
sub set_userprivs {
- my ($userroles,$allroles,$allgroups,$groups_roles) = @_;
+ my ($userroles,$allroles,$allgroups) = @_;
my $author=0;
my $adv=0;
my %grouproles = ();
if (keys(%{$allgroups}) > 0) {
- my @groupkeys;
foreach my $role (keys(%{$allroles})) {
- push(@groupkeys,$role);
- }
- if (ref($groups_roles) eq 'HASH') {
- foreach my $key (keys(%{$groups_roles})) {
- unless (grep(/^\Q$key\E$/,@groupkeys)) {
- push(@groupkeys,$key);
- }
- }
- }
- if (@groupkeys > 0) {
- 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};
- }
+ 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};
}
}
}
@@ -4104,58 +4006,26 @@ sub role_status {
if ($$tstart<$now) {
if ($$tstart && $$tstart>$refresh) {
if (($$where ne '') && ($$role ne '')) {
- my (%allroles,%allgroups,$group_privs,
- %groups_roles,@rolecodes);
+ my (%allroles,%allgroups,$group_privs);
my %userroles = (
'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
);
- @rolecodes = ('cm');
my $spec=$$role.'.'.$$where;
my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
if ($$role =~ /^cr\//) {
&custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
- push(@rolecodes,'cr');
} elsif ($$role eq 'gr') {
- push(@rolecodes,$$role);
my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
$env{'user.name'});
- my ($trole) = split('_',$rolehash{$$where.'_'.$$role},2);
+ my $trole = split('_',$rolehash{$$where.'_'.$$role},1);
(undef,my $group_privs) = split(/\//,$trole);
$group_privs = &unescape($group_privs);
&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 {
- push(@rolecodes,$$role);
&standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
}
- my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups,\%groups_roles);
- &appenv(\%userroles,\@rolecodes);
+ my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups);
+ &appenv(\%userroles,[$$role,'cm']);
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
}
}
@@ -4669,7 +4539,7 @@ sub get_portfolio_access {
my (%allgroups,%allroles);
my ($start,$end,$role,$sec,$group);
foreach my $envkey (%env) {
- if ($envkey =~ m-^user\.role\.(gr|cc|co|in|ta|ep|ad|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) {
+ if ($envkey =~ m-^user\.role\.(gr|cc|in|ta|ep|st)\./($match_domain)/($match_courseid)/?([^/]*)$-) {
my $cid = $2.'_'.$3;
if ($1 eq 'gr') {
$group = $4;
@@ -5857,8 +5727,8 @@ sub auto_validate_instcode {
$homeserver = &domain($cdom,'primary');
}
}
- $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
- &escape($instcode).':'.&escape($owner),$homeserver));
+ my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
+ &escape($instcode).':'.&escape($owner),$homeserver));
my ($outcome,$description) = map { &unescape($_); } split('&',$response,2);
return ($outcome,$description);
}
@@ -6569,18 +6439,12 @@ sub modifyuser {
my ($udom, $uname, $uid,
$umode, $upass, $first,
$middle, $last, $gene,
- $forceid, $desiredhome, $email, $inststatus, $candelete)=@_;
+ $forceid, $desiredhome, $email, $inststatus)=@_;
$udom= &LONCAPA::clean_domain($udom);
$uname=&LONCAPA::clean_username($uname);
- my $showcandelete = 'none';
- if (ref($candelete) eq 'ARRAY') {
- if (@{$candelete} > 0) {
- $showcandelete = join(', ',@{$candelete});
- }
- }
&logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '.
$umode.', '.$first.', '.$middle.', '.
- $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'.
+ $last.', '.$gene.'(forceid: '.$forceid.')'.
(defined($desiredhome) ? ' desiredhome = '.$desiredhome :
' desiredhome not specified').
' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
@@ -6645,33 +6509,9 @@ sub modifyuser {
%names = @tmp;
}
#
-# If name, email and/or uid are blank (e.g., because an uploaded file
-# of users did not contain them), do not overwrite existing values
-# unless field is in $candelete array ref.
-#
- my @fields = ('firstname','middlename','lastname','generation',
- 'permanentemail','id');
- my %newvalues;
- if (ref($candelete) eq 'ARRAY') {
- foreach my $field (@fields) {
- if (grep(/^\Q$field\E$/,@{$candelete})) {
- if ($field eq 'firstname') {
- $names{$field} = $first;
- } elsif ($field eq 'middlename') {
- $names{$field} = $middle;
- } elsif ($field eq 'lastname') {
- $names{$field} = $last;
- } elsif ($field eq 'generation') {
- $names{$field} = $gene;
- } elsif ($field eq 'permanentemail') {
- $names{$field} = $email;
- } elsif ($field eq 'id') {
- $names{$field} = $uid;
- }
- }
- }
- }
-
+# Make sure to not trash student environment if instructor does not bother
+# to supply name and email information
+#
if ($first) { $names{'firstname'} = $first; }
if (defined($middle)) { $names{'middlename'} = $middle; }
if ($last) { $names{'lastname'} = $last; }
@@ -10398,16 +10238,9 @@ modifyuserauth($udom,$uname,$umode,$upas
=item *
-modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last, $gene,
- $forceid,$desiredhome,$email,$inststatus,$candelete) :
-
-will update user information (firstname,middlename,lastname,generation,
-permanentemail), and if forceid is true, student/employee ID also.
-A user's institutional affiliation(s) can also be updated.
-User information fields will not be overwritten with empty entries
-unless the field is included in the $candelete array reference.
-This array is included when a single user is modified via "Manage Users",
-or when Autoupdate.pl is run by cron in a domain.
+modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,
+ $forceid,$desiredhome,$email,$inststatus) :
+modify user
=item *