--- loncom/lonnet/perl/lonnet.pm 2010/05/26 17:14:43 1.1056.4.2 +++ loncom/lonnet/perl/lonnet.pm 2010/03/26 00:47:25 1.1060 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1056.4.2 2010/05/26 17:14:43 raeburn Exp $ +# $Id: lonnet.pm,v 1.1060 2010/03/26 00:47:25 raeburn 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} = + 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,59 +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); } } @@ -5858,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); } @@ -6581,7 +6450,7 @@ sub modifyuser { } &logthis('Call to modify user '.$udom.', '.$uname.', '.$uid.', '. $umode.', '.$first.', '.$middle.', '. - $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'. + $last.', '.$gene.'(forceid: '.$forceid.'; candelete: '.$showcandelete.')'. (defined($desiredhome) ? ' desiredhome = '.$desiredhome : ' desiredhome not specified'). ' by '.$env{'user.name'}.' at '.$env{'user.domain'}. @@ -6645,6 +6514,7 @@ sub modifyuser { } else { %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. @@ -9813,12 +9683,6 @@ sub get_dns { return %libserv; } - sub unique_library { - #2x reverse removes all hostnames that appear more than once - my %unique = reverse &all_library(); - return reverse %unique; - } - sub get_servers { &load_hosts_tab() if (!$loaded); @@ -9842,11 +9706,6 @@ sub get_dns { return %result; } - sub get_unique_servers { - my %unique = reverse &get_servers(@_); - return reverse %unique; - } - sub host_domain { &load_hosts_tab() if (!$loaded);