version 1.838, 2007/03/02 23:17:40
|
version 1.847, 2007/03/12 17:07:43
|
Line 35 use HTTP::Headers;
|
Line 35 use HTTP::Headers;
|
use HTTP::Date; |
use HTTP::Date; |
# use Date::Parse; |
# use Date::Parse; |
use vars |
use vars |
qw(%perlvar %badServerCache %iphost %spareid %hostdom |
qw(%perlvar %badServerCache %spareid |
%libserv %pr %prp $memcache %packagetab |
%pr %prp $memcache %packagetab |
%courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount |
%courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount |
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf |
%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); |
$tmpdir $_64bit %env); |
|
|
use IO::Socket; |
use IO::Socket; |
Line 640 sub homeserver {
|
Line 638 sub homeserver {
|
my $index="$uname:$udom"; |
my $index="$uname:$udom"; |
|
|
if (exists($homecache{$index})) { return $homecache{$index}; } |
if (exists($homecache{$index})) { return $homecache{$index}; } |
my $tryserver; |
|
foreach $tryserver (keys %libserv) { |
my %servers = &get_servers($udom,'library'); |
|
foreach my $tryserver (keys(%servers)) { |
next if ($ignoreBadCache ne 'true' && |
next if ($ignoreBadCache ne 'true' && |
exists($badServerCache{$tryserver})); |
exists($badServerCache{$tryserver})); |
if ($hostdom{$tryserver} eq $udom) { |
|
my $answer=reply("home:$udom:$uname",$tryserver); |
my $answer=reply("home:$udom:$uname",$tryserver); |
if ($answer eq 'found') { |
if ($answer eq 'found') { |
delete($badServerCache{$tryserver}); |
delete($badServerCache{$tryserver}); |
return $homecache{$index}=$tryserver; |
return $homecache{$index}=$tryserver; |
} elsif ($answer eq 'no_host') { |
} elsif ($answer eq 'no_host') { |
$badServerCache{$tryserver}=1; |
$badServerCache{$tryserver}=1; |
} |
} |
} |
|
} |
} |
return 'no_host'; |
return 'no_host'; |
} |
} |
Line 663 sub idget {
|
Line 661 sub idget {
|
my ($udom,@ids)=@_; |
my ($udom,@ids)=@_; |
my %returnhash=(); |
my %returnhash=(); |
|
|
my $tryserver; |
my %servers = &get_servers($udom,'library'); |
foreach $tryserver (keys %libserv) { |
foreach my $tryserver (keys(%servers)) { |
if ($hostdom{$tryserver} eq $udom) { |
my $idlist=join('&',@ids); |
my $idlist=join('&',@ids); |
$idlist=~tr/A-Z/a-z/; |
$idlist=~tr/A-Z/a-z/; |
my $reply=&reply("idget:$udom:".$idlist,$tryserver); |
my $reply=&reply("idget:$udom:".$idlist,$tryserver); |
my @answer=(); |
my @answer=(); |
if (($reply ne 'con_lost') && ($reply!~/^error\:/)) { |
if (($reply ne 'con_lost') && ($reply!~/^error\:/)) { |
@answer=split(/\&/,$reply); |
@answer=split(/\&/,$reply); |
} ; |
} ; |
my $i; |
my $i; |
for ($i=0;$i<=$#ids;$i++) { |
for ($i=0;$i<=$#ids;$i++) { |
if ($answer[$i]) { |
if ($answer[$i]) { |
$returnhash{$ids[$i]}=$answer[$i]; |
$returnhash{$ids[$i]}=$answer[$i]; |
} |
} |
} |
} |
} |
} |
|
} |
|
return %returnhash; |
return %returnhash; |
} |
} |
|
|
Line 729 sub get_dom {
|
Line 725 sub get_dom {
|
} |
} |
$items=~s/\&$//; |
$items=~s/\&$//; |
if (!$udom) { $udom=$env{'user.domain'}; } |
if (!$udom) { $udom=$env{'user.domain'}; } |
if (exists($domain_primary{$udom})) { |
if (defined(&domain($udom,'primary'))) { |
my $uhome=$domain_primary{$udom}; |
my $uhome=&domain($udom,'primary'); |
my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
my $rep=&reply("getdom:$udom:$namespace:$items",$uhome); |
my @pairs=split(/\&/,$rep); |
my @pairs=split(/\&/,$rep); |
if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { |
if ( $#pairs==0 && $pairs[0] =~ /^(con_lost|error|no_such_host)/i) { |
Line 753 sub get_dom {
|
Line 749 sub get_dom {
|
sub put_dom { |
sub put_dom { |
my ($namespace,$storehash,$udom)=@_; |
my ($namespace,$storehash,$udom)=@_; |
if (!$udom) { $udom=$env{'user.domain'}; } |
if (!$udom) { $udom=$env{'user.domain'}; } |
if (exists($domain_primary{$udom})) { |
if (defined(&domain($udom,'primary'))) { |
my $uhome=$domain_primary{$udom}; |
my $uhome=&domain($udom,'primary'); |
my $items=''; |
my $items=''; |
foreach my $item (keys(%$storehash)) { |
foreach my $item (keys(%$storehash)) { |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
$items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&'; |
Line 769 sub put_dom {
|
Line 765 sub put_dom {
|
sub retrieve_inst_usertypes { |
sub retrieve_inst_usertypes { |
my ($udom) = @_; |
my ($udom) = @_; |
my (%returnhash,@order); |
my (%returnhash,@order); |
if (exists($domain_primary{$udom})) { |
if (defined(&domain($udom,'primary'))) { |
my $uhome=$domain_primary{$udom}; |
my $uhome=&domain($udom,'primary'); |
my $rep=&reply("inst_usertypes:$udom",$uhome); |
my $rep=&reply("inst_usertypes:$udom",$uhome); |
my ($hashitems,$orderitems) = split(/:/,$rep); |
my ($hashitems,$orderitems) = split(/:/,$rep); |
my @pairs=split(/\&/,$hashitems); |
my @pairs=split(/\&/,$hashitems); |
Line 1843 sub flushcourselogs {
|
Line 1839 sub flushcourselogs {
|
# Write course id database (reverse lookup) to homeserver of courses |
# Write course id database (reverse lookup) to homeserver of courses |
# Is used in pickcourse |
# Is used in pickcourse |
# |
# |
foreach my $crsid (keys(%courseidbuffer)) { |
foreach my $crs_home (keys(%courseidbuffer)) { |
&courseidput($hostdom{$crsid},$courseidbuffer{$crsid},$crsid); |
&courseidput(&host_domain($crs_home),$courseidbuffer{$crs_home}, |
|
$crs_home); |
} |
} |
# |
# |
# File accesses |
# File accesses |
Line 1911 sub flushcourselogs {
|
Line 1908 sub flushcourselogs {
|
delete $domainrolehash{$entry}; |
delete $domainrolehash{$entry}; |
} |
} |
foreach my $dom (keys(%domrolebuffer)) { |
foreach my $dom (keys(%domrolebuffer)) { |
foreach my $tryserver (keys %libserv) { |
my %servers = &get_servers($dom,'library'); |
if ($hostdom{$tryserver} eq $dom) { |
foreach my $tryserver (keys(%servers)) { |
unless (&reply('domroleput:'.$dom.':'. |
unless (&reply('domroleput:'.$dom.':'. |
$domrolebuffer{$dom},$tryserver) eq 'ok') { |
$domrolebuffer{$dom},$tryserver) eq 'ok') { |
&logthis('Put of domain roles failed for '.$dom.' and '.$tryserver); |
&logthis('Put of domain roles failed for '.$dom.' and '.$tryserver); |
} |
} |
} |
|
} |
} |
} |
} |
$dumpcount++; |
$dumpcount++; |
Line 2099 sub get_my_roles {
|
Line 2095 sub get_my_roles {
|
|
|
sub postannounce { |
sub postannounce { |
my ($server,$text)=@_; |
my ($server,$text)=@_; |
unless (&allowed('psa',$hostdom{$server})) { return 'refused'; } |
unless (&allowed('psa',&host_domain($server))) { return 'refused'; } |
unless ($text=~/\w/) { $text=''; } |
unless ($text=~/\w/) { $text=''; } |
return &reply('setannounce:'.&escape($text),$server); |
return &reply('setannounce:'.&escape($text),$server); |
} |
} |
Line 2135 sub courseiddump {
|
Line 2131 sub courseiddump {
|
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_; |
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok)=@_; |
my %returnhash=(); |
my %returnhash=(); |
unless ($domfilter) { $domfilter=''; } |
unless ($domfilter) { $domfilter=''; } |
foreach my $tryserver (keys %libserv) { |
my %libserv = &all_library(); |
if ( ($hostidflag == 1 && grep/^$tryserver$/,@{$hostidref}) || (!defined($hostidflag)) ) { |
foreach my $tryserver (keys(%libserv)) { |
if ((!$domfilter) || ($hostdom{$tryserver} eq $domfilter)) { |
if ( ( $hostidflag == 1 |
|
&& grep(/^\Q$tryserver\E$/,@{$hostidref}) ) |
|
|| (!defined($hostidflag)) ) { |
|
|
|
if ($domfilter eq '' |
|
|| (&host_domain($tryserver) eq $domfilter)) { |
foreach my $line ( |
foreach my $line ( |
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'. |
split(/\&/,&reply('courseiddump:'.&host_domain($tryserver).':'. |
$sincefilter.':'.&escape($descfilter).':'. |
$sincefilter.':'.&escape($descfilter).':'. |
&escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok), |
&escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter).':'.&escape($typefilter).':'.&escape($regexp_ok), |
$tryserver))) { |
$tryserver))) { |
Line 2167 sub dcmailput {
|
Line 2168 sub dcmailput {
|
sub dcmaildump { |
sub dcmaildump { |
my ($dom,$startdate,$enddate,$senders) = @_; |
my ($dom,$startdate,$enddate,$senders) = @_; |
my %returnhash=(); |
my %returnhash=(); |
if (exists($domain_primary{$dom})) { |
|
|
if (defined(&domain($dom,'primary'))) { |
my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'. |
my $cmd='dcmaildump:'.$dom.':'.&escape($startdate).':'. |
&escape($enddate).':'; |
&escape($enddate).':'; |
my @esc_senders=map { &escape($_)} @$senders; |
my @esc_senders=map { &escape($_)} @$senders; |
$cmd.=&escape(join('&',@esc_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); |
my ($key,$value) = split(/\=/,$line,2); |
if (($key) && ($value)) { |
if (($key) && ($value)) { |
$returnhash{&unescape($key)} = &unescape($value); |
$returnhash{&unescape($key)} = &unescape($value); |
Line 2193 sub get_domain_roles {
|
Line 2195 sub get_domain_roles {
|
} |
} |
my $rolelist = join(':',@{$roles}); |
my $rolelist = join(':',@{$roles}); |
my %personnel = (); |
my %personnel = (); |
foreach my $tryserver (keys(%libserv)) { |
|
if ($hostdom{$tryserver} eq $dom) { |
my %servers = &get_servers($dom,'library'); |
%{$personnel{$tryserver}}=(); |
foreach my $tryserver (keys(%servers)) { |
foreach my $line ( |
%{$personnel{$tryserver}}=(); |
split(/\&/,&reply('domrolesdump:'.$dom.':'. |
foreach my $line (split(/\&/,&reply('domrolesdump:'.$dom.':'. |
&escape($startdate).':'.&escape($enddate).':'. |
&escape($startdate).':'. |
&escape($rolelist), $tryserver))) { |
&escape($enddate).':'. |
my ($key,$value) = split(/\=/,$line,2); |
&escape($rolelist), $tryserver))) { |
if (($key) && ($value)) { |
my ($key,$value) = split(/\=/,$line,2); |
$personnel{$tryserver}{&unescape($key)} = &unescape($value); |
if (($key) && ($value)) { |
} |
$personnel{$tryserver}{&unescape($key)} = &unescape($value); |
} |
} |
} |
} |
} |
} |
return %personnel; |
return %personnel; |
} |
} |
Line 4172 sub definerole {
|
Line 4174 sub definerole {
|
sub metadata_query { |
sub metadata_query { |
my ($query,$custom,$customshow,$server_array)=@_; |
my ($query,$custom,$customshow,$server_array)=@_; |
my %rhash; |
my %rhash; |
|
my %libserv = &all_library(); |
my @server_list = (defined($server_array) ? @$server_array |
my @server_list = (defined($server_array) ? @$server_array |
: keys(%libserv) ); |
: keys(%libserv) ); |
for my $server (@server_list) { |
for my $server (@server_list) { |
Line 4458 sub auto_instcode_format {
|
Line 4461 sub auto_instcode_format {
|
my $courses = ''; |
my $courses = ''; |
my @homeservers; |
my @homeservers; |
if ($caller eq 'global') { |
if ($caller eq 'global') { |
foreach my $tryserver (keys(%libserv)) { |
my %servers = &get_servers($codedom,'library'); |
if ($hostdom{$tryserver} eq $codedom) { |
foreach my $tryserver (keys(%servers)) { |
if (!grep(/^\Q$tryserver\E$/,@homeservers)) { |
if (!grep(/^\Q$tryserver\E$/,@homeservers)) { |
push(@homeservers,$tryserver); |
push(@homeservers,$tryserver); |
} |
} |
} |
|
} |
} |
} else { |
} else { |
push(@homeservers,&homeserver($caller,$codedom)); |
push(@homeservers,&homeserver($caller,$codedom)); |
Line 4497 sub auto_instcode_format {
|
Line 4499 sub auto_instcode_format {
|
sub auto_instcode_defaults { |
sub auto_instcode_defaults { |
my ($domain,$returnhash,$code_order) = @_; |
my ($domain,$returnhash,$code_order) = @_; |
my @homeservers; |
my @homeservers; |
foreach my $tryserver (keys(%libserv)) { |
|
if ($hostdom{$tryserver} eq $domain) { |
my %servers = &get_servers($domain,'library'); |
if (!grep(/^\Q$tryserver\E$/,@homeservers)) { |
foreach my $tryserver (keys(%servers)) { |
push(@homeservers,$tryserver); |
if (!grep(/^\Q$tryserver\E$/,@homeservers)) { |
} |
push(@homeservers,$tryserver); |
} |
} |
} |
} |
my $ok_response = 0; |
|
my $response; |
my $response; |
while (@homeservers > 0 && $ok_response == 0) { |
foreach my $server (@homeservers) { |
my $server = shift(@homeservers); |
|
$response=&reply('autoinstcodedefaults:'.$domain,$server); |
$response=&reply('autoinstcodedefaults:'.$domain,$server); |
if ($response !~ /(con_lost|error|no_such_host|refused)/) { |
next if ($response =~ /(con_lost|error|no_such_host|refused)/); |
foreach my $pair (split(/\&/,$response)) { |
|
my ($name,$value)=split(/\=/,$pair); |
foreach my $pair (split(/\&/,$response)) { |
if ($name eq 'code_order') { |
my ($name,$value)=split(/\=/,$pair); |
@{$code_order} = split(/\&/,&unescape($value)); |
if ($name eq 'code_order') { |
} else { |
@{$code_order} = split(/\&/,&unescape($value)); |
$returnhash->{&unescape($name)}=&unescape($value); |
} else { |
} |
$returnhash->{&unescape($name)}=&unescape($value); |
} |
} |
$ok_response = 1; |
} |
} |
return 'ok'; |
} |
|
if ($ok_response) { |
|
return 'ok'; |
|
} else { |
|
return $response; |
|
} |
} |
|
|
|
return $response; |
} |
} |
|
|
sub auto_validate_class_sec { |
sub auto_validate_class_sec { |
Line 4818 sub modifyuser {
|
Line 4816 sub modifyuser {
|
if (($uhome eq 'no_host') && |
if (($uhome eq 'no_host') && |
(($umode && $upass) || ($umode eq 'localauth'))) { |
(($umode && $upass) || ($umode eq 'localauth'))) { |
my $unhome=''; |
my $unhome=''; |
if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { |
if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { |
$unhome = $desiredhome; |
$unhome = $desiredhome; |
} elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) { |
} elsif($env{'course.'.$env{'request.course.id'}.'.domain'} eq $udom) { |
$unhome=$env{'course.'.$env{'request.course.id'}.'.home'}; |
$unhome=$env{'course.'.$env{'request.course.id'}.'.home'}; |
} else { # load balancing routine for determining $unhome |
} else { # load balancing routine for determining $unhome |
my $tryserver; |
|
my $loadm=10000000; |
my $loadm=10000000; |
foreach $tryserver (keys %libserv) { |
my %servers = &get_servers($udom,'library'); |
if ($hostdom{$tryserver} eq $udom) { |
foreach my $tryserver (keys(%servers)) { |
my $answer=reply('load',$tryserver); |
my $answer=reply('load',$tryserver); |
if (($answer=~/\d+/) && ($answer<$loadm)) { |
if (($answer=~/\d+/) && ($answer<$loadm)) { |
$loadm=$answer; |
$loadm=$answer; |
$unhome=$tryserver; |
$unhome=$tryserver; |
} |
} |
} |
|
} |
} |
} |
} |
if (($unhome eq '') || ($unhome eq 'no_host')) { |
if (($unhome eq '') || ($unhome eq 'no_host')) { |
Line 5047 sub createcourse {
|
Line 5043 sub createcourse {
|
} |
} |
# ------------------------------------------------ Check supplied server name |
# ------------------------------------------------ Check supplied server name |
$course_server = $env{'user.homeserver'} if (! defined($course_server)); |
$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; |
return 'error:bad server name '.$course_server; |
} |
} |
# ------------------------------------------------------------- Make the course |
# ------------------------------------------------------------- Make the course |
Line 5580 sub dirlist {
|
Line 5576 sub dirlist {
|
return @listing_results; |
return @listing_results; |
} elsif(!defined($alternateDirectoryRoot)) { |
} elsif(!defined($alternateDirectoryRoot)) { |
my %allusers; |
my %allusers; |
foreach my $tryserver (keys(%libserv)) { |
my %servers = &get_servers($udom,'library'); |
if($hostdom{$tryserver} eq $udom) { |
foreach my $tryserver (keys(%servers)) { |
my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'. |
my $listing = &reply('ls2:'.$perlvar{'lonDocRoot'}.'/res/'. |
$udom, $tryserver); |
$udom, $tryserver); |
my @listing_results; |
my @listing_results; |
if ($listing eq 'unknown_cmd') { |
if ($listing eq 'unknown_cmd') { |
$listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'. |
$listing = &reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'. |
$udom, $tryserver); |
$udom, $tryserver); |
@listing_results = split(/:/,$listing); |
@listing_results = split(/:/,$listing); |
} else { |
} else { |
@listing_results = |
@listing_results = |
map { &unescape($_); } split(/:/,$listing); |
map { &unescape($_); } split(/:/,$listing); |
} |
} |
if ($listing_results[0] ne 'no_such_dir' && |
if ($listing_results[0] ne 'no_such_dir' && |
$listing_results[0] ne 'empty' && |
$listing_results[0] ne 'empty' && |
$listing_results[0] ne 'con_lost') { |
$listing_results[0] ne 'con_lost') { |
foreach my $line (@listing_results) { |
foreach my $line (@listing_results) { |
my ($entry) = split(/&/,$line,2); |
my ($entry) = split(/&/,$line,2); |
$allusers{$entry} = 1; |
$allusers{$entry} = 1; |
} |
} |
} |
} |
} |
|
} |
} |
my $alluserstr=''; |
my $alluserstr=''; |
foreach my $user (sort(keys(%allusers))) { |
foreach my $user (sort(keys(%allusers))) { |
Line 5613 sub dirlist {
|
Line 5608 sub dirlist {
|
return ('missing user name'); |
return ('missing user name'); |
} |
} |
} elsif(!defined($alternateDirectoryRoot)) { |
} elsif(!defined($alternateDirectoryRoot)) { |
my $tryserver; |
my @all_domains = sort(&all_domains()); |
my %alldom=(); |
foreach my $domain (@all_domains) { |
foreach $tryserver (keys(%libserv)) { |
$domain = $perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain'; |
$alldom{$hostdom{$tryserver}}=1; |
} |
} |
return @all_domains; |
my $alldomstr=''; |
} else { |
foreach my $domain (sort(keys(%alldom))) { |
|
$alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$domain.'/&domain:'; |
|
} |
|
$alldomstr=~s/:$//; |
|
return split(/:/,$alldomstr); |
|
} else { |
|
return ('missing domain'); |
return ('missing domain'); |
} |
} |
} |
} |
Line 7420 sub current_machine_domains {
|
Line 7409 sub current_machine_domains {
|
while( my($id, $name) = each(%hostname)) { |
while( my($id, $name) = each(%hostname)) { |
# &logthis("-$id-$name-$hostname-"); |
# &logthis("-$id-$name-$hostname-"); |
if ($hostname eq $name) { |
if ($hostname eq $name) { |
push(@domains,$hostdom{$id}); |
push(@domains,&host_domain($id)); |
} |
} |
} |
} |
return @domains; |
return @domains; |
Line 7577 BEGIN {
|
Line 7566 BEGIN {
|
|
|
# ------------------------------------------------------------ Read domain file |
# ------------------------------------------------------------ Read domain file |
{ |
{ |
%domaindescription = (); |
my %domain; |
%domain_auth_def = (); |
|
%domain_auth_arg_def = (); |
|
my $fh; |
my $fh; |
if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) { |
if (open($fh,"<".$Apache::lonnet::perlvar{'lonTabDir'}.'/domain.tab')) { |
while (my $line = <$fh>) { |
while (my $line = <$fh>) { |
next if ($line =~ /^(\#|\s*$)/); |
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; |
|
|
|
# &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} ); |
# &logthis("Domain.tab: $domain ".$domaindescription{$domain} ); |
} |
} |
} |
} |
close ($fh); |
close ($fh); |
|
|
|
sub domain { |
|
my ($name,$what) = @_; |
|
return if ( !exists($domain{$name}) ); |
|
|
|
if (!$what) { |
|
return $domain{$name}{'description'}; |
|
} |
|
return $domain{$name}{$what}; |
|
} |
} |
} |
|
|
|
|
# ------------------------------------------------------------- Read hosts file |
# ------------------------------------------------------------- Read hosts file |
{ |
{ |
my %hostname; |
my %hostname; |
|
my %hostdom; |
|
my %libserv; |
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); |
open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
Line 7629 BEGIN {
|
Line 7625 BEGIN {
|
my ($lonid) = @_; |
my ($lonid) = @_; |
return $hostname{$lonid}; |
return $hostname{$lonid}; |
} |
} |
|
|
sub all_hostnames { |
sub all_hostnames { |
return %hostname; |
return %hostname; |
} |
} |
} |
|
|
|
sub get_iphost { |
sub is_library { |
if (%iphost) { return %iphost; } |
return exists($libserv{$_[0]}); |
my %name_to_ip; |
} |
my %hostname = &all_hostnames(); |
|
foreach my $id (keys(%hostname)) { |
sub all_library { |
my $name=$hostname{$id}; |
return %libserv; |
my $ip; |
} |
if (!exists($name_to_ip{$name})) { |
|
$ip = gethostbyname($name); |
sub get_servers { |
if (!$ip || length($ip) ne 4) { |
my ($domain,$type) = @_; |
&logthis("Skipping host $id name $name no IP found"); |
my %possible_hosts = ($type eq 'library') ? %libserv |
next; |
: %hostname; |
|
my %result; |
|
if (ref($domain) eq 'ARRAY') { |
|
while ( my ($host,$hostname) = each(%possible_hosts)) { |
|
if (grep(/^\Q$hostdom{$host}\E$/,@$domain)) { |
|
$result{$host} = $hostname; |
|
} |
} |
} |
$ip=inet_ntoa($ip); |
|
$name_to_ip{$name} = $ip; |
|
} else { |
} else { |
$ip = $name_to_ip{$name}; |
while ( my ($host,$hostname) = each(%possible_hosts)) { |
|
if ($hostdom{$host} eq $domain) { |
|
$result{$host} = $hostname; |
|
} |
|
} |
|
} |
|
return %result; |
|
} |
|
|
|
sub host_domain { |
|
my ($lonid) = @_; |
|
return $hostdom{$lonid}; |
|
} |
|
|
|
sub all_domains { |
|
my %seen; |
|
my @uniq = grep(!$seen{$_}++, values(%hostdom)); |
|
return @uniq; |
|
} |
|
} |
|
|
|
{ |
|
my %iphost; |
|
sub get_hosts_from_ip { |
|
my ($ip) = @_; |
|
my %iphosts = &get_iphost(); |
|
if (ref($iphosts{$ip})) { |
|
return @{$iphosts{$ip}}; |
|
} |
|
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; |
|
} |
|
$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 |
# ------------------------------------------------------ Read spare server file |