--- loncom/lonnet/perl/lonnet.pm 2007/06/25 18:12:24 1.894 +++ loncom/lonnet/perl/lonnet.pm 2007/08/02 20:40:13 1.903 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.894 2007/06/25 18:12:24 albertel Exp $ +# $Id: lonnet.pm,v 1.903 2007/08/02 20:40:13 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -856,6 +856,79 @@ sub is_domainimage { return; } +sub inst_directory_query { + my ($srch) = @_; + my $udom = $srch->{'srchdomain'}; + my %results; + my $homeserver = &domain($udom,'primary'); + if ($homeserver ne '') { + my $response=&reply("instdirsrch:$udom".':'. + &escape($srch->{'srchby'}).':'. + &escape($srch->{'srchterm'}).':'. + $srch->{'srchtype'},$homeserver); + if ($response ne 'refused') { + my @matches = split(/&/,$response); + foreach my $match (@matches) { + my ($key,$value) = split(/=/,$match); + my %userhash = &str2hash(&unescape($value)); + $results{&unescape($key).':'.$udom} = \%userhash; + } + } + } + return %results; +} + +sub usersearch { + my ($srch) = @_; + my $dom = $srch->{'srchdomain'}; + my %results; + my %libserv = &all_library(); + my $query = 'usersearch'; + foreach my $tryserver (keys(%libserv)) { + if (&host_domain($tryserver) eq $dom) { + my $host=&hostname($tryserver); + my $queryid= + &reply("querysend:".&escape($query).':'.&escape($dom).':'. + &escape($srch->{'srchby'}).'%%'. + &escape($srch->{'srchtype'}).':'. + &escape($srch->{'srchterm'}),$tryserver); + if ($queryid !~/^\Q$host\E\_/) { + &logthis('usersearch: invalid queryid: '.$queryid.' for host: '.$host.'in domain '.$dom.' and server: '.$tryserver); + next; + } + my $reply = &get_query_reply($queryid); + my $maxtries = 1; + my $tries = 1; + while (($reply=~/^timeout/) && ($tries < $maxtries)) { + $reply = &get_query_reply($queryid); + $tries ++; + } + if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { + &logthis('usersrch error: '.$reply.' for '.$dom.' - searching for : '.$srch->{'srchterm'}.' by '.$srch->{'srchby'}.' ('.$srch->{'srchtype'}.') - maxtries: '.$maxtries.' tries: '.$tries); + } else { + my @matches = split(/&/,$reply); + foreach my $match (@matches) { + my @items = split(/:/,$match); + my ($uname,$udom,%userhash); + foreach my $entry (@items) { + my ($key,$value) = split(/=/,$entry); + $key = &unescape($key); + $value = &unescape($value); + $userhash{$key} = $value; + if ($key eq 'username') { + $uname = $value; + } elsif ($key eq 'domain') { + $udom = $value; + } + } + $results{$uname.':'.$udom} = \%userhash; + } + } + } + } + return %results; +} + # --------------------------------------------------- Assign a key to a student sub assign_access_key { @@ -1396,7 +1469,7 @@ sub ssi { my $request; $form{'no_update_last_known'}=1; - + &Apache::lonenc::check_encrypt(\$fn); if (%form) { $request=new HTTP::Request('POST',&absolute_url().$fn); $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form)); @@ -2008,7 +2081,7 @@ sub flushcourselogs { # my %domrolebuffer = (); foreach my $entry (keys %domainrolehash) { - my ($role,$uname,$udom,$runame,$rudom,$rsec)=split/:/,$entry; + my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry); if ($domrolebuffer{$rudom}) { $domrolebuffer{$rudom}.='&'.&escape($entry). '='.&escape($domainrolehash{$entry}); @@ -2113,6 +2186,14 @@ sub userrolelog { {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} =$tend.':'.$tstart; } + if (($env{'request.role'} =~ /dc\./) && + (($trole=~/^au/) || ($trole=~/^in/) || + ($trole=~/^cc/) || ($trole=~/^ep/) || + ($trole=~/^cr/) || ($trole=~/^ta/))) { + $userrolehash + {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} + =$tend.':'.$tstart; + } if (($trole=~/^dc/) || ($trole=~/^ad/) || ($trole=~/^li/) || ($trole=~/^li/) || ($trole=~/^au/) || ($trole=~/^dg/) || @@ -3807,12 +3888,12 @@ sub customaccess { my ($effect,$realm,$role,$type)=split(/\:/,$right); if ($type eq 'user') { foreach my $scope (split(/\s*\,\s*/,$realm)) { - my ($tdom,$tcrs)=split(/\_/,$scope); + my ($tdom,$tuname)=split(m{/},$scope); if ($tdom) { if ($tdom ne $env{'user.domain'}) { next; } } - if ($tcrs) { - if ($tcrs ne $env{'user.name'}) { next; } + if ($tuname) { + if ($tuname ne $env{'user.name'}) { next; } } $access=($effect eq 'allow'); last; @@ -4366,6 +4447,23 @@ sub update_portfolio_table { return $reply; } +# -------------------------- Update MySQL allusers table + +sub update_allusers_table { + my ($uname,$udom,$names) = @_; + my $homeserver = &homeserver($uname,$udom); + my $queryid= + &reply('querysend:allusers:'.&escape($uname).':'.&escape($udom).':'. + 'lastname='.&escape($names->{'lastname'}).'%%'. + 'firstname='.&escape($names->{'firstname'}).'%%'. + 'middlename='.&escape($names->{'middlename'}).'%%'. + 'generation='.&escape($names->{'generation'}).'%%'. + 'permanentemail='.&escape($names->{'permanentemail'}).'%%'. + 'id='.&escape($names->{'id'}),$homeserver); + my $reply = &get_query_reply($queryid); + return $reply; +} + # ------- Request retrieval of institutional classlists for course(s) sub fetch_enrollment_query { @@ -4400,7 +4498,7 @@ sub fetch_enrollment_query { if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { &logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries); } else { - my @responses = split/:/,$reply; + my @responses = split(/:/,$reply); if ($homeserver eq $perlvar{'lonHostID'}) { foreach my $line (@responses) { my ($key,$value) = split(/=/,$line,2); @@ -4510,7 +4608,7 @@ sub auto_get_sections { my @secs = (); my $response=&unescape(&reply('autogetsections:'.$inst_coursecode.':'.$cdom,$homeserver)); unless ($response eq 'refused') { - @secs = split/:/,$response; + @secs = split(/:/,$response); } return @secs; } @@ -4549,7 +4647,7 @@ sub auto_create_password { if ($response eq 'refused') { $authchk = 'refused'; } else { - ($authparam,$create_passwd,$authchk) = split/:/,$response; + ($authparam,$create_passwd,$authchk) = split(/:/,$response); } } return ($authparam,$create_passwd,$authchk); @@ -4657,7 +4755,7 @@ sub auto_instcode_format { $response=&reply('autoinstcodeformat:'.$codedom.':'.$courses,$server); if ($response !~ /(con_lost|error|no_such_host|refused)/) { my ($codes_str,$codetitles_str,$cat_titles_str,$cat_order_str) = - split/:/,$response; + split(/:/,$response); %{$codes} = (%{$codes},&str2hash($codes_str)); push(@{$codetitles},&str2array($codetitles_str)); %{$cat_titles} = (%{$cat_titles},&str2hash($cat_titles_str)); @@ -5037,7 +5135,8 @@ sub modifyuser { } # -------------------------------------------------------------- Add names, etc my @tmp=&get('environment', - ['firstname','middlename','lastname','generation'], + ['firstname','middlename','lastname','generation','id', + 'permanentemail'], $udom,$uname); my %names; if ($tmp[0] =~ m/^error:.*/) { @@ -5059,8 +5158,10 @@ sub modifyuser { $names{'critnotification'} = $email; $names{'permanentemail'} = $email; } } + if ($uid) { $names{'id'} = $uid; } my $reply = &put('environment', \%names, $udom,$uname); if ($reply ne 'ok') { return 'error: '.$reply; } + my $sqlresult = &update_allusers_table($uname,$udom,\%names); &devalidate_cache_new('namescache',$uname.':'.$udom); &logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '. $umode.', '.$first.', '.$middle.', '. @@ -7098,7 +7199,7 @@ sub getCODE { sub rndseed { my ($symb,$courseid,$domain,$username)=@_; my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser(); - if (!$symb) { + if (!defined($symb)) { unless ($symb=$wsymb) { return time; } } if (!$courseid) { $courseid=$wcourseid; } @@ -7884,6 +7985,7 @@ sub get_dns { } sub reset_hosts_info { + &purge_remembered(); &reset_domain_info(); &reset_hosts_ip_info(); undef(%name_to_host);