--- loncom/lonnet/perl/lonnet.pm 2007/04/04 00:07:07 1.862 +++ loncom/lonnet/perl/lonnet.pm 2007/06/18 22:52:33 1.892 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.862 2007/04/04 00:07:07 albertel Exp $ +# $Id: lonnet.pm,v 1.892 2007/06/18 22:52:33 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -31,22 +31,21 @@ package Apache::lonnet; use strict; use LWP::UserAgent(); -use HTTP::Headers; use HTTP::Date; # use Date::Parse; -use vars -qw(%perlvar %badServerCache %spareid - %pr %prp $memcache %packagetab - %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount - %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf - $tmpdir $_64bit %env); +use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir + $_64bit %env); + +my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, + %userrolehash, $processmarker, $dumpcount, %coursedombuf, + %coursenumbuf, %coursehombuf, %coursedescrbuf, %courseinstcodebuf, + %courseownerbuf, %coursetypebuf); use IO::Socket; use GDBM_File; use HTML::LCParser; -use HTML::Parser; use Fcntl qw(:flock); -use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze); +use Storable qw(thaw nfreeze); use Time::HiRes qw( gettimeofday tv_interval ); use Cache::Memcached; use Digest::MD5; @@ -150,7 +149,7 @@ sub create_connection { Type => SOCK_STREAM, Timeout => 10); return 0 if (!$client); - print $client (join(':',$hostname,$lonid,&machine_ids($lonid))."\n"); + print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n"); my $result = <$client>; chomp($result); return 1 if ($result eq 'done'); @@ -182,7 +181,7 @@ sub subreply { $client=IO::Socket::UNIX->new(Peer =>"$peerfile", Type => SOCK_STREAM, Timeout => 10); - if($client) { + if ($client) { last; # Connected! } else { &create_connection(&hostname($server),$server); @@ -215,6 +214,24 @@ sub reply { # ----------------------------------------------------------- Send USR1 to lonc sub reconlonc { + my ($lonid) = @_; + my $hostname = &hostname($lonid); + if ($lonid) { + my $peerfile="$perlvar{'lonSockDir'}/$hostname"; + if ($hostname && -e $peerfile) { + &logthis("Trying to reconnect lonc for $lonid ($hostname)"); + my $client=IO::Socket::UNIX->new(Peer => $peerfile, + Type => SOCK_STREAM, + Timeout => 10); + if ($client) { + print $client ("reset_retries\n"); + my $answer=<$client>; + #reset just this one. + } + } + return; + } + &logthis("Trying to reconnect lonc"); my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; if (open(my $fh,"<$loncfile")) { @@ -671,61 +688,6 @@ sub homeserver { return 'no_host'; } -# ---------------------- Get domain configuration for a domain -sub get_domainconf { - my ($udom) = @_; - my $cachetime=1800; - my ($result,$cached)=&is_cached_new('domainconfig',$udom); - if (defined($cached)) { return %{$result}; } - - if ($udom eq '') { - $udom = &Apache::loncommon::determinedomain(); - } - my %domconfig = &get_dom('configuration',['login','rolecolors'],$udom); - my %designhash; - if (keys(%domconfig) > 0) { - if (ref($domconfig{'login'}) eq 'HASH') { - foreach my $key (keys(%{$domconfig{'login'}})) { - $designhash{$udom.'.login.'.$key}=$domconfig{'login'}{$key}; - } - } - if (ref($domconfig{'rolecolors'}) eq 'HASH') { - foreach my $role (keys(%{$domconfig{'rolecolors'}})) { - if (ref($domconfig{'rolecolors'}{$role}) eq 'HASH') { - foreach my $item (keys(%{$domconfig{'rolecolors'}{$role}})) { - $designhash{$udom.'.'.$role.'.'.$item}=$domconfig{'rolecolors'}{$role}{$item}; - } - } - } - } - } else { - my $designdir=$perlvar{'lonTabDir'}.'/lonDomColors'; - my $designfile = $designdir.'/'.$udom.'.tab'; - if (-e $designfile) { - if ( open (my $fh,"<$designfile") ) { - while (my $line = <$fh>) { - next if ($line =~ /^\#/); - chomp($line); - my ($key,$val)=(split(/\=/,$line)); - if ($val) { $designhash{$udom.'.'.$key}=$val; } - } - close($fh); - } - } - if (-e '/home/httpd/html/adm/lonDomLogos/'.$udom.'.gif') { - $designhash{$udom.'.login.domlogo'} = - &lonhttpdurl("/adm/lonDomLogos/$udom.gif"); - } - } - &do_cache_new('domainconfig',$udom,\%designhash,$cachetime); - return %designhash; -} - -sub devalidate_domconfig_cache { - my ($udom)=@_; - &devalidate_cache_new('domainconfig',$udom); -} - # ------------------------------------- Find the usernames behind a list of IDs sub idget { @@ -800,7 +762,7 @@ sub get_dom { if (defined(&domain($udom,'primary'))) { $uhome=&domain($udom,'primary'); } else { - $uhome eq ''; + undef($uhome); } } else { if (!$uhome) { @@ -811,11 +773,14 @@ sub get_dom { } if ($udom && $uhome && ($uhome ne 'no_host')) { my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); + my %returnhash; + if ($rep eq '' || $rep =~ /^error: 2 /) { + return %returnhash; + } my @pairs=split(/\&/,$rep); if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { return @pairs; } - my %returnhash=(); my $i=0; foreach my $item (@$storearr) { $returnhash{$item}=&thaw_unescape($pairs[$i]); @@ -823,7 +788,7 @@ sub get_dom { } return %returnhash; } else { - &logthis("get_dom failed - no homeserver and/or domain"); + &logthis("get_dom failed - no homeserver and/or domain ($udom) ($uhome)"); } } @@ -836,7 +801,7 @@ sub put_dom { if (defined(&domain($udom,'primary'))) { $uhome=&domain($udom,'primary'); } else { - $uhome eq ''; + undef($uhome); } } else { if (!$uhome) { @@ -881,6 +846,16 @@ sub retrieve_inst_usertypes { return (\%returnhash,\@order); } +sub is_domainimage { + my ($url) = @_; + if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+-) { + if (&domain($1) ne '') { + return '1'; + } + } + return; +} + # --------------------------------------------------- Assign a key to a student sub assign_access_key { @@ -1107,7 +1082,10 @@ my $kicks=0; my $hits=0; sub make_key { my ($name,$id) = @_; - if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); } + if (length($id) > 65 + && length(&escape($id)) > 200) { + $id=length($id).':'.&Digest::MD5::md5_hex($id); + } return &escape($name.':'.$id); } @@ -1154,7 +1132,9 @@ sub do_cache_new { $time=600; } if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); } - $memcache->set($id,$setvalue,$time); + if (!($memcache->set($id,$setvalue,$time))) { + &logthis("caching of id -> $id failed"); + } # need to make a copy of $value #&make_room($id,$value,$debug); return $value; @@ -1777,13 +1757,16 @@ sub extract_embedded_items { while (my $t=$p->get_token()) { if ($t->[0] eq 'S') { my ($tagname, $attr) = ($t->[1],$t->[2]); - push (@state, $tagname); + push(@state, $tagname); if (lc($tagname) eq 'allow') { &add_filetype($allfiles,$attr->{'src'},'src'); } if (lc($tagname) eq 'img') { &add_filetype($allfiles,$attr->{'src'},'src'); } + if (lc($tagname) eq 'a') { + &add_filetype($allfiles,$attr->{'href'},'href'); + } if (lc($tagname) eq 'script') { if ($attr->{'archive'} =~ /\.jar$/i) { &add_filetype($allfiles,$attr->{'archive'},'archive'); @@ -2188,7 +2171,12 @@ sub get_my_roles { my %returnhash=(); my $now=time; foreach my $entry (keys(%dumphash)) { - my ($tend,$tstart)=split(/\:/,$dumphash{$entry}); + my ($role,$tend,$tstart); + if ($context eq 'userroles') { + ($role,$tend,$tstart)=split(/_/,$dumphash{$entry}); + } else { + ($tend,$tstart)=split(/\:/,$dumphash{$entry}); + } if (($tstart) && ($tstart<0)) { next; } my $status = 'active'; if (($tend) && ($tend<$now)) { @@ -2206,7 +2194,13 @@ sub get_my_roles { next; } } - my ($role,$username,$domain,$section)=split(/\:/,$entry); + my ($rolecode,$username,$domain,$section,$area); + if ($context eq 'userroles') { + ($area,$rolecode) = split(/_/,$entry); + (undef,$domain,$username,$section) = split(/\//,$area); + } else { + ($role,$username,$domain,$section) = split(/\:/,$entry); + } if (ref($roledoms) eq 'ARRAY') { if (!grep(/^\Q$domain\E$/,@{$roledoms})) { next; @@ -2216,7 +2210,7 @@ sub get_my_roles { if (!grep(/^\Q$role\E$/,@{$roles})) { next; } - } + } $returnhash{$username.':'.$domain.':'.$role}=$tstart.':'.$tend; } return %returnhash; @@ -3160,7 +3154,7 @@ sub set_userprivs { if (keys(%{$allgroups}) > 0) { foreach my $role (keys %{$allroles}) { my ($trole,$area,$sec,$extendedarea); - if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)-) { + if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) { $trole = $1; $area = $2; $sec = $3; @@ -3641,9 +3635,16 @@ sub get_portfolio_access { } if (@users > 0) { foreach my $userkey (@users) { - if (exists($access_hash->{$userkey}{'users'}{$env{'user.name'}.':'.$env{'user.domain'}})) { - return 'ok'; - } + if (ref($access_hash->{$userkey}{'users'}) eq 'ARRAY') { + foreach my $item (@{$access_hash->{$userkey}{'users'}}) { + if (ref($item) eq 'HASH') { + if (($item->{'uname'} eq $env{'user.name'}) && + ($item->{'udom'} eq $env{'user.domain'})) { + return 'ok'; + } + } + } + } } } my %roleshash; @@ -4474,8 +4475,18 @@ sub userlog_query { sub auto_run { my ($cnum,$cdom) = @_; - my $homeserver = &homeserver($cnum,$cdom); - my $response = &reply('autorun:'.$cdom,$homeserver); + my $response = 0; + my $settings; + my %domconfig = &get_dom('configuration',['autoenroll'],$cdom); + if (ref($domconfig{'autoenroll'}) eq 'HASH') { + $settings = $domconfig{'autoenroll'}; + if ($settings->{'run'} eq '1') { + $response = 1; + } + } else { + my $homeserver = &homeserver($cnum,$cdom); + $response = &reply('autorun:'.$cdom,$homeserver); + } return $response; } @@ -4505,15 +4516,27 @@ sub auto_validate_courseID { } sub auto_create_password { - my ($cnum,$cdom,$authparam) = @_; - my $homeserver = &homeserver($cnum,$cdom); + my ($cnum,$cdom,$authparam,$udom) = @_; + my ($homeserver,$response); my $create_passwd = 0; my $authchk = ''; - my $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver)); - if ($response eq 'refused') { - $authchk = 'refused'; + if ($udom =~ /^$match_domain$/) { + $homeserver = &domain($udom,'primary'); + } + if ($homeserver eq '') { + if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) { + $homeserver = &homeserver($cnum,$cdom); + } + } + if ($homeserver eq '') { + $authchk = 'nodomain'; } else { - ($authparam,$create_passwd,$authchk) = split/:/,$response; + $response=&unescape(&reply('autocreatepassword:'.$authparam.':'.$cdom,$homeserver)); + if ($response eq 'refused') { + $authchk = 'refused'; + } else { + ($authparam,$create_passwd,$authchk) = split/:/,$response; + } } return ($authparam,$create_passwd,$authchk); } @@ -5318,7 +5341,7 @@ sub save_selected_files { my ($user, $path, @files) = @_; my $filename = $user."savedfiles"; my @other_files = &files_not_in_path($user, $path); - open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); + open (OUT, '>'.$tmpdir.$filename); foreach my $file (@files) { print (OUT $env{'form.currentpath'}.$file."\n"); } @@ -5910,6 +5933,13 @@ sub devalidatecourseresdata { # --------------------------------------------------- Course Resourcedata Query +# +# Parameters: +# $coursenum - Number of the course. +# $coursedomain - Domain at which the course was created. +# Returns: +# A hash of the course parameters along (I think) with timestamps +# and version info. sub get_courseresdata { my ($coursenum,$coursedomain)=@_; @@ -5968,7 +5998,21 @@ sub get_userresdata { } return $tmp; } - +#----------------------------------------------- resdata - return resource data +# Purpose: +# Return resource data for either users or for a course. +# Parameters: +# $name - Course/user name. +# $domain - Name of the domain the user/course is registered on. +# $type - Type of thing $name is (must be 'course' or 'user' +# @which - Array of names of resources desired. +# Returns: +# The value of the first reasource in @which that is found in the +# resource hash. +# Exceptional Conditions: +# If the $type passed in is not valid (not the string 'course' or +# 'user', an undefined reference is returned. +# If none of the resources are found, an undef is returned sub resdata { my ($name,$domain,$type,@which)=@_; my $result; @@ -6315,7 +6359,7 @@ sub packages_tab_default { $do_default=1; } elsif ($pack_type eq 'extension') { push(@extension,[$package,$pack_type,$pack_part]); - } elsif ($pack_part eq $part) { + } elsif ($pack_part eq $part || $pack_type eq 'part') { # only look at packages defaults for packages that this id is push(@specifics,[$package,$pack_type,$pack_part]); } @@ -6532,13 +6576,18 @@ sub metadata { } } my ($extension) = ($uri =~ /\.(\w+)$/); + $extension = lc($extension); + if ($extension eq 'htm') { $extension='html'; } + foreach my $key (keys(%packagetab)) { #no specific packages #how's our extension if ($key!~/^extension_\Q$extension\E&/) { next; } &metadata_create_package_def($uri,$key,'extension_'.$extension, \%metathesekeys); } - if (!exists($metaentry{':packages'})) { + + if (!exists($metaentry{':packages'}) + || $packagetab{"import_defaults&extension_$extension"}) { foreach my $key (keys(%packagetab)) { #no specific packages well let's get default then if ($key!~/^default&/) { next; } @@ -7487,6 +7536,7 @@ sub filelocation { $file=~s-^/adm/wrapper/-/-; $file=~s-^/adm/coursedocs/showdoc/-/-; } + if ($file=~m:^/~:) { # is a contruction space reference $location = $file; $location =~ s:/~(.*?)/(.*):/home/$1/public_html/$2:; @@ -7507,6 +7557,8 @@ sub filelocation { $location=$Apache::lonnet::perlvar{'lonDocRoot'}.'/userfiles/'. $udom.'/'.$uname.'/'.$filename; } + } elsif ($file =~ m-^/adm/-) { + $location = $perlvar{'lonDocRoot'}.'/'.$file; } else { $file=~s/^\Q$perlvar{'lonDocRoot'}\E//; $file=~s:^/res/:/:; @@ -7566,14 +7618,11 @@ sub machine_ids { my ($hostname) = @_; $hostname ||= &hostname($perlvar{'lonHostID'}); my @ids; - my %hostname = &all_hostnames(); - while( my($id, $name) = each(%hostname)) { -# &logthis("-$id-$name-$hostname-"); - if ($hostname eq $name) { - push(@ids,$id); - } + my %name_to_host = &all_names(); + if (ref($name_to_host{$hostname}) eq 'ARRAY') { + return @{ $name_to_host{$hostname} }; } - return @ids; + return; } sub additional_machine_domains { @@ -7617,7 +7666,8 @@ sub declutter { sub clutter { my $thisfn='/'.&declutter(shift); - unless ($thisfn=~/^\/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)\//) { + if ($thisfn !~ m{^/(uploaded|editupload|adm|userfiles|ext|raw|priv|public)/} + || $thisfn =~ m{^/adm/(includes|pages)} ) { $thisfn='/res'.$thisfn; } if ($thisfn !~m|/adm|) { @@ -7686,18 +7736,18 @@ sub correct_line_ends { sub goodbye { &logthis("Starting Shut down"); #not converted to using infrastruture and probably shouldn't be - &logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache)))); + &logthis(sprintf("%-20s is %s",'%badServerCache',length(&nfreeze(\%badServerCache)))); #converted # &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache))); - &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache)))); -# &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache)))); -# &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache)))); + &logthis(sprintf("%-20s is %s",'%homecache',length(&nfreeze(\%homecache)))); +# &logthis(sprintf("%-20s is %s",'%titlecache',length(&nfreeze(\%titlecache)))); +# &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&nfreeze(\%courseresdatacache)))); #1.1 only -# &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache)))); -# &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&freeze(\%getsectioncache)))); -# &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache)))); -# &logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache)))); - &logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered)))); +# &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&nfreeze(\%userresdatacache)))); +# &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&nfreeze(\%getsectioncache)))); +# &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&nfreeze(\%courseresversioncache)))); +# &logthis(sprintf("%-20s is %s",'%resversioncache',length(&nfreeze(\%resversioncache)))); + &logthis(sprintf("%-20s is %s",'%remembered',length(&nfreeze(\%remembered)))); &logthis(sprintf("%-20s is %s",'kicks',$kicks)); &logthis(sprintf("%-20s is %s",'hits',$hits)); &flushcourselogs(); @@ -7705,19 +7755,41 @@ sub goodbye { } sub get_dns { - my ($url,$func) = @_; + my ($url,$func,$ignore_cache) = @_; + if (!$ignore_cache) { + my ($content,$cached)= + &Apache::lonnet::is_cached_new('dns',$url); + if ($cached) { + &$func($content); + return; + } + } + + my %alldns; open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); foreach my $dns (<$config>) { next if ($dns !~ /^\^(\S*)/x); - $dns = $1; + $alldns{$1} = 1; + } + while (%alldns) { + my ($dns) = keys(%alldns); + delete($alldns{$dns}); my $ua=new LWP::UserAgent; my $request=new HTTP::Request('GET',"http://$dns$url"); my $response=$ua->request($request); next if ($response->is_error()); my @content = split("\n",$response->content); + &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60); &$func(\@content); + return; } close($config); + my $which = (split('/',$url))[3]; + &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n"); + open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab"); + my @content = <$config>; + &$func(\@content); + return; } # ------------------------------------------------------------ Read domain file { @@ -7740,9 +7812,15 @@ sub get_dns { $domain{$name} = \%this_domain; } } - + + sub reset_domain_info { + undef($loaded); + undef(%domain); + } + sub load_domain_tab { - &get_dns('/adm/dns/domain',\&parse_domain_tab); + my ($ignore_cache) = @_; + &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache); my $fh; if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) { my @lines = <$fh>; @@ -7772,6 +7850,7 @@ sub get_dns { my %hostdom; my %libserv; my $loaded; + my %name_to_host; sub parse_hosts_tab { my ($file) = @_; @@ -7783,14 +7862,26 @@ sub get_dns { $name=~s/\s//g; if ($id && $domain && $role && $name) { $hostname{$id}=$name; + push(@{$name_to_host{$name}}, $id); $hostdom{$id}=$domain; if ($role eq 'library') { $libserv{$id}=$name; } } } } + + sub reset_hosts_info { + &reset_domain_info(); + &reset_hosts_ip_info(); + undef(%name_to_host); + undef(%hostname); + undef(%hostdom); + undef(%libserv); + undef($loaded); + } sub load_hosts_tab { - &get_dns('/adm/dns/hosts',\&parse_hosts_tab); + my ($ignore_cache) = @_; + &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache); open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); my @config = <$config>; &parse_hosts_tab(\@config); @@ -7811,6 +7902,12 @@ sub get_dns { return %hostname; } + sub all_names { + &load_hosts_tab() if (!$loaded); + + return %name_to_host; + } + sub is_library { &load_hosts_tab() if (!$loaded); @@ -7866,6 +7963,7 @@ sub get_dns { my %iphost; my %name_to_ip; my %lonid_to_ip; + sub get_hosts_from_ip { my ($ip) = @_; my %iphosts = &get_iphost(); @@ -7874,6 +7972,12 @@ sub get_dns { } return; } + + sub reset_hosts_ip_info { + undef(%iphost); + undef(%name_to_ip); + undef(%lonid_to_ip); + } sub get_host_ip { my ($lonid) = @_; @@ -7890,15 +7994,27 @@ sub get_dns { } sub get_iphost { - if (%iphost) { return %iphost; } - my %hostname = &all_hostnames(); - foreach my $id (keys(%hostname)) { - my $name=$hostname{$id}; + my ($ignore_cache) = @_; + if (!$ignore_cache) { + if (%iphost) { + return %iphost; + } + my ($ip_info,$cached)= + &Apache::lonnet::is_cached_new('iphost','iphost'); + if ($cached) { + %iphost = %{$ip_info->[0]}; + %name_to_ip = %{$ip_info->[1]}; + %lonid_to_ip = %{$ip_info->[2]}; + return %iphost; + } + } + my %name_to_host = &all_names(); + foreach my $name (keys(%name_to_host)) { my $ip; if (!exists($name_to_ip{$name})) { $ip = gethostbyname($name); if (!$ip || length($ip) ne 4) { - &logthis("Skipping host $id name $name no IP found"); + &logthis("Skipping name $name no IP found"); next; } $ip=inet_ntoa($ip); @@ -7906,9 +8022,15 @@ sub get_dns { } else { $ip = $name_to_ip{$name}; } - $lonid_to_ip{$id} = $ip; - push(@{$iphost{$ip}},$id); + foreach my $id (@{ $name_to_host{$name} }) { + $lonid_to_ip{$id} = $ip; + } + push(@{$iphost{$ip}},@{$name_to_host{$name}}); } + &Apache::lonnet::do_cache_new('iphost','iphost', + [\%iphost,\%name_to_ip,\%lonid_to_ip], + 24*60*60); + return %iphost; } } @@ -8448,6 +8570,14 @@ setting for a specific $type, where $typ @what should be a list of parameters to ask about. This routine caches answers for 5 minutes. +=item * + +get_courseresdata($courseid, $domain) : dump the entire course resource +data base, returning a hash that is keyed by the resource name and has +values that are the resource value. I believe that the timestamps and +versions are also returned. + + =back =head2 Course Modification @@ -9130,3 +9260,4 @@ symblist($mapname,%newhash) : update sym =back =cut +