--- loncom/lonnet/perl/lonnet.pm 2007/04/10 20:29:53 1.867
+++ loncom/lonnet/perl/lonnet.pm 2007/06/25 23:08:55 1.895
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.867 2007/04/10 20:29:53 raeburn Exp $
+# $Id: lonnet.pm,v 1.895 2007/06/25 23:08:55 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")) {
@@ -745,7 +762,7 @@ sub get_dom {
if (defined(&domain($udom,'primary'))) {
$uhome=&domain($udom,'primary');
} else {
- $uhome eq '';
+ undef($uhome);
}
} else {
if (!$uhome) {
@@ -757,14 +774,13 @@ sub get_dom {
if ($udom && $uhome && ($uhome ne 'no_host')) {
my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
my %returnhash;
- if ($rep =~ /^error: 2 /) {
+ 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]);
@@ -772,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)");
}
}
@@ -785,7 +801,7 @@ sub put_dom {
if (defined(&domain($udom,'primary'))) {
$uhome=&domain($udom,'primary');
} else {
- $uhome eq '';
+ undef($uhome);
}
} else {
if (!$uhome) {
@@ -830,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 {
@@ -1056,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);
}
@@ -1103,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;
@@ -1365,7 +1396,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));
@@ -1726,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');
@@ -3120,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;
@@ -3770,26 +3804,40 @@ sub customaccess {
$ucrs = &LONCAPA::clean_username($ucrs);
my $access=0;
foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
- my ($effect,$realm,$role)=split(/\:/,$right);
- if ($role) {
- if ($role ne $urole) { next; }
- }
- foreach my $scope (split(/\s*\,\s*/,$realm)) {
- my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
- if ($tdom) {
- if ($tdom ne $udom) { next; }
- }
- if ($tcrs) {
- if ($tcrs ne $ucrs) { next; }
- }
- if ($tsec) {
- if ($tsec ne $usec) { next; }
- }
- $access=($effect eq 'allow');
- last;
- }
- if ($realm eq '' && $role eq '') {
- $access=($effect eq 'allow');
+ my ($effect,$realm,$role,$type)=split(/\:/,$right);
+ if ($type eq 'user') {
+ foreach my $scope (split(/\s*\,\s*/,$realm)) {
+ my ($tdom,$tcrs)=split(/\_/,$scope);
+ if ($tdom) {
+ if ($tdom ne $env{'user.domain'}) { next; }
+ }
+ if ($tcrs) {
+ if ($tcrs ne $env{'user.name'}) { next; }
+ }
+ $access=($effect eq 'allow');
+ last;
+ }
+ } else {
+ if ($role) {
+ if ($role ne $urole) { next; }
+ }
+ foreach my $scope (split(/\s*\,\s*/,$realm)) {
+ my ($tdom,$tcrs,$tsec)=split(/\_/,$scope);
+ if ($tdom) {
+ if ($tdom ne $udom) { next; }
+ }
+ if ($tcrs) {
+ if ($tcrs ne $ucrs) { next; }
+ }
+ if ($tsec) {
+ if ($tsec ne $usec) { next; }
+ }
+ $access=($effect eq 'allow');
+ last;
+ }
+ if ($realm eq '' && $role eq '') {
+ $access=($effect eq 'allow');
+ }
}
}
return $access;
@@ -4441,8 +4489,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;
}
@@ -4472,15 +4530,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);
}
@@ -5285,7 +5355,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");
}
@@ -5877,6 +5947,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)=@_;
@@ -5935,7 +6012,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;
@@ -6282,7 +6373,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]);
}
@@ -6499,13 +6590,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; }
@@ -7454,6 +7550,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:;
@@ -7474,6 +7571,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/:/:;
@@ -7533,14 +7632,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 {
@@ -7584,7 +7680,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|) {
@@ -7653,18 +7750,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();
@@ -7672,19 +7769,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
{
@@ -7714,7 +7833,8 @@ sub get_dns {
}
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>;
@@ -7744,6 +7864,7 @@ sub get_dns {
my %hostdom;
my %libserv;
my $loaded;
+ my %name_to_host;
sub parse_hosts_tab {
my ($file) = @_;
@@ -7755,6 +7876,7 @@ 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; }
}
@@ -7764,6 +7886,7 @@ sub get_dns {
sub reset_hosts_info {
&reset_domain_info();
&reset_hosts_ip_info();
+ undef(%name_to_host);
undef(%hostname);
undef(%hostdom);
undef(%libserv);
@@ -7771,7 +7894,8 @@ sub get_dns {
}
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);
@@ -7792,6 +7916,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);
@@ -7847,6 +7977,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();
@@ -7877,25 +8008,59 @@ 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;
+ }
+ }
+
+ # get yesterday's info for fallback
+ my %old_name_to_ip;
+ my ($ip_info,$cached)=
+ &Apache::lonnet::is_cached_new('iphost','iphost');
+ if ($cached) {
+ %old_name_to_ip = %{$ip_info->[1]};
+ }
+
+ 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");
- next;
+ if (defined($old_name_to_ip{$name})) {
+ $ip = $old_name_to_ip{$name};
+ &logthis("Can't find $name defaulting to old $ip");
+ } else {
+ &logthis("Name $name no IP found");
+ next;
+ }
+ } else {
+ $ip=inet_ntoa($ip);
}
- $ip=inet_ntoa($ip);
$name_to_ip{$name} = $ip;
} 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],
+ 48*60*60);
+
return %iphost;
}
}
@@ -8435,6 +8600,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
@@ -9117,3 +9290,4 @@ symblist($mapname,%newhash) : update sym
=back
=cut
+