--- loncom/lonnet/perl/lonnet.pm 2007/03/03 02:16:10 1.844
+++ loncom/lonnet/perl/lonnet.pm 2007/03/14 23:36:10 1.848
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.844 2007/03/03 02:16:10 albertel Exp $
+# $Id: lonnet.pm,v 1.848 2007/03/14 23:36:10 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -35,12 +35,10 @@ use HTTP::Headers;
use HTTP::Date;
# use Date::Parse;
use vars
-qw(%perlvar %badServerCache %iphost %spareid
- %libserv %pr %prp $memcache %packagetab
+qw(%perlvar %badServerCache %spareid
+ %pr %prp $memcache %packagetab
%courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf
- %domaindescription %domain_auth_def %domain_auth_arg_def
- %domain_lang_def %domain_city %domain_longi %domain_lati %domain_primary
$tmpdir $_64bit %env);
use IO::Socket;
@@ -727,8 +725,8 @@ sub get_dom {
}
$items=~s/\&$//;
if (!$udom) { $udom=$env{'user.domain'}; }
- if (exists($domain_primary{$udom})) {
- my $uhome=$domain_primary{$udom};
+ if (defined(&domain($udom,'primary'))) {
+ my $uhome=&domain($udom,'primary');
my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
my @pairs=split(/\&/,$rep);
if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) {
@@ -751,8 +749,8 @@ sub get_dom {
sub put_dom {
my ($namespace,$storehash,$udom)=@_;
if (!$udom) { $udom=$env{'user.domain'}; }
- if (exists($domain_primary{$udom})) {
- my $uhome=$domain_primary{$udom};
+ if (defined(&domain($udom,'primary'))) {
+ my $uhome=&domain($udom,'primary');
my $items='';
foreach my $item (keys(%$storehash)) {
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
@@ -767,8 +765,8 @@ sub put_dom {
sub retrieve_inst_usertypes {
my ($udom) = @_;
my (%returnhash,@order);
- if (exists($domain_primary{$udom})) {
- my $uhome=$domain_primary{$udom};
+ if (defined(&domain($udom,'primary'))) {
+ my $uhome=&domain($udom,'primary');
my $rep=&reply("inst_usertypes:$udom",$uhome);
my ($hashitems,$orderitems) = split(/:/,$rep);
my @pairs=split(/\&/,$hashitems);
@@ -2133,9 +2131,14 @@ sub courseiddump {
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_;
my %returnhash=();
unless ($domfilter) { $domfilter=''; }
- foreach my $tryserver (keys %libserv) {
- if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) {
- if ((!$domfilter) || (&host_domain($tryserver) eq $domfilter)) {
+ my %libserv = &all_library();
+ foreach my $tryserver (keys(%libserv)) {
+ if ( ( $hostidflag == 1
+ && grep(/^\Q$tryserver\E$/,@{$hostidref}) )
+ || (!defined($hostidflag)) ) {
+
+ if ($domfilter eq ''
+ || (&host_domain($tryserver) eq $domfilter)) {
foreach my $line (
split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'.
$sincefilter.':'.&escape($descfilter).':'.
@@ -2165,12 +2168,13 @@ sub dcmailput {
sub dcmaildump {
my ($dom,$startdate,$enddate,$senders) = @_;
my %returnhash=();
- if (exists($domain_primary{$dom})) {
+
+ if (defined(&domain($dom,'primary'))) {
my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'.
&escape($enddate).':';
my @esc_senders=map { &escape($_)} @$senders;
$cmd.=&escape(join('&',@esc_senders));
- foreach my $line (split(/\&/,&reply($cmd,$domain_primary{$dom}))) {
+ foreach my $line (split(/\&/,&reply($cmd,&domain($dom,'primary')))) {
my ($key,$value) = split(/\=/,$line,2);
if (($key) && ($value)) {
$returnhash{&unescape($key)} = &unescape($value);
@@ -4170,6 +4174,7 @@ sub definerole {
sub metadata_query {
my ($query,$custom,$customshow,$server_array)=@_;
my %rhash;
+ my %libserv = &all_library();
my @server_list = (defined($server_array) ? @$server_array
: keys(%libserv) );
for my $server (@server_list) {
@@ -5038,7 +5043,7 @@ sub createcourse {
}
# ------------------------------------------------ Check supplied server name
$course_server = $env{'user.homeserver'} if (! defined($course_server));
- if (! exists($libserv{$course_server})) {
+ if (! &is_library($course_server)) {
return 'error:bad server name '.$course_server;
}
# ------------------------------------------------------------- Make the course
@@ -6171,7 +6176,8 @@ sub packages_tab_default {
$do_default=1;
} elsif ($pack_type eq 'extension') {
push(@extension,[$package,$pack_type,$pack_part]);
- } else {
+ } elsif ($pack_part eq $part) {
+ # only look at packages defaults for packages that this id is
push(@specifics,[$package,$pack_type,$pack_part]);
}
}
@@ -7561,31 +7567,36 @@ BEGIN {
# ------------------------------------------------------------ Read domain file
{
- %domaindescription = ();
- %domain_auth_def = ();
- %domain_auth_arg_def = ();
+ my %domain;
+
my $fh;
if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) {
while (my $line = <$fh>) {
- next if ($line =~ /^(\#|\s*$)/);
-# next if /^\#/;
- chomp $line;
- my ($domain, $domain_description, $def_auth, $def_auth_arg,
- $def_lang, $city, $longi, $lati, $primary) = split(/:/,$line,9);
- $domain_auth_def{$domain}=$def_auth;
- $domain_auth_arg_def{$domain}=$def_auth_arg;
- $domaindescription{$domain}=$domain_description;
- $domain_lang_def{$domain}=$def_lang;
- $domain_city{$domain}=$city;
- $domain_longi{$domain}=$longi;
- $domain_lati{$domain}=$lati;
- $domain_primary{$domain}=$primary;
+ next if ($line =~ /^(\#|\s*$ )/);
- # &logthis("Domain.tab: $domain, $domain_auth_def{$domain}, $domain_auth_arg_def{$domain},$domaindescription{$domain}");
+ chomp($line);
+ my ($name,@elements) = split(/:/,$line,9);
+ my %this_domain;
+ foreach my $field ('description', 'auth_def', 'auth_arg_def',
+ 'lang_def', 'city', 'longi', 'lati',
+ 'primary') {
+ $this_domain{$field} = shift(@elements);
+ }
+ $domain{$name} = \%this_domain;
# &logthis("Domain.tab: $domain ".$domaindescription{$domain} );
}
}
close ($fh);
+
+ sub domain {
+ my ($name,$what) = @_;
+ return if ( !exists($domain{$name}) );
+
+ if (!$what) {
+ return $domain{$name}{'description'};
+ }
+ return $domain{$name}{$what};
+ }
}
@@ -7593,6 +7604,7 @@ BEGIN {
{
my %hostname;
my %hostdom;
+ my %libserv;
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab");
while (my $configline=<$config>) {
@@ -7614,9 +7626,19 @@ BEGIN {
my ($lonid) = @_;
return $hostname{$lonid};
}
+
sub all_hostnames {
return %hostname;
}
+
+ sub is_library {
+ return exists($libserv{$_[0]});
+ }
+
+ sub all_library {
+ return %libserv;
+ }
+
sub get_servers {
my ($domain,$type) = @_;
my %possible_hosts = ($type eq 'library') ? %libserv
@@ -7637,6 +7659,7 @@ BEGIN {
}
return %result;
}
+
sub host_domain {
my ($lonid) = @_;
return $hostdom{$lonid};
@@ -7649,36 +7672,39 @@ BEGIN {
}
}
-sub get_hosts_from_ip {
- my ($ip) = @_;
- my %iphosts = &get_iphost();
- if (ref($iphosts{$ip})) {
- return @{$iphosts{$ip}};
+{
+ my %iphost;
+ sub get_hosts_from_ip {
+ my ($ip) = @_;
+ my %iphosts = &get_iphost();
+ if (ref($iphosts{$ip})) {
+ return @{$iphosts{$ip}};
+ }
+ return;
}
- return;
-}
-
-sub get_iphost {
- if (%iphost) { return %iphost; }
- my %name_to_ip;
- my %hostname = &all_hostnames();
- foreach my $id (keys(%hostname)) {
- my $name=$hostname{$id};
- 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;
+
+ sub get_iphost {
+ if (%iphost) { return %iphost; }
+ my %name_to_ip;
+ my %hostname = &all_hostnames();
+ foreach my $id (keys(%hostname)) {
+ my $name=$hostname{$id};
+ 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;
+ }
+ $ip=inet_ntoa($ip);
+ $name_to_ip{$name} = $ip;
+ } else {
+ $ip = $name_to_ip{$name};
}
- $ip=inet_ntoa($ip);
- $name_to_ip{$name} = $ip;
- } else {
- $ip = $name_to_ip{$name};
+ push(@{$iphost{$ip}},$id);
}
- push(@{$iphost{$ip}},$id);
+ return %iphost;
}
- return %iphost;
}
# ------------------------------------------------------ Read spare server file