version 1.305.2.4, 2006/02/10 09:48:17
|
version 1.322, 2006/03/03 20:06:21
|
Line 89 my $ConnectionType;
|
Line 89 my $ConnectionType;
|
|
|
my %hostid; # ID's for hosts in cluster by ip. |
my %hostid; # ID's for hosts in cluster by ip. |
my %hostdom; # LonCAPA domain for hosts in cluster. |
my %hostdom; # LonCAPA domain for hosts in cluster. |
|
my %hostname; # DNSname -> ID's mapping. |
my %hostip; # IPs for hosts in cluster. |
my %hostip; # IPs for hosts in cluster. |
my %hostdns; # ID's of hosts looked up by DNS name. |
my %hostdns; # ID's of hosts looked up by DNS name. |
|
|
Line 2975 sub dump_with_regexp {
|
Line 2976 sub dump_with_regexp {
|
|
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
my ($udom,$uname,$namespace,$regexp)=split(/:/,$tail); |
my ($udom,$uname,$namespace,$regexp,$range)=split(/:/,$tail); |
if (defined($regexp)) { |
if (defined($regexp)) { |
$regexp=&unescape($regexp); |
$regexp=&unescape($regexp); |
} else { |
} else { |
$regexp='.'; |
$regexp='.'; |
} |
} |
|
my ($start,$end); |
|
if (defined($range)) { |
|
if ($range =~/^(\d+)\-(\d+)$/) { |
|
($start,$end) = ($1,$2); |
|
} elsif ($range =~/^(\d+)$/) { |
|
($start,$end) = (0,$1); |
|
} else { |
|
undef($range); |
|
} |
|
} |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
my $hashref = &tie_user_hash($udom, $uname, $namespace, |
&GDBM_READER()); |
&GDBM_READER()); |
if ($hashref) { |
if ($hashref) { |
my $qresult=''; |
my $qresult=''; |
|
my $count=0; |
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
if ($regexp eq '.') { |
if ($regexp eq '.') { |
|
$count++; |
|
if (defined($range) && $count >= $end) { last; } |
|
if (defined($range) && $count < $start) { next; } |
$qresult.=$key.'='.$value.'&'; |
$qresult.=$key.'='.$value.'&'; |
} else { |
} else { |
my $unescapeKey = &unescape($key); |
my $unescapeKey = &unescape($key); |
if (eval('$unescapeKey=~/$regexp/')) { |
if (eval('$unescapeKey=~/$regexp/')) { |
|
$count++; |
|
if (defined($range) && $count >= $end) { last; } |
|
if (defined($range) && $count < $start) { next; } |
$qresult.="$key=$value&"; |
$qresult.="$key=$value&"; |
} |
} |
} |
} |
Line 4497 sub process_request {
|
Line 4515 sub process_request {
|
# fix all the userinput -> user_input. |
# fix all the userinput -> user_input. |
my $wasenc = 0; # True if request was encrypted. |
my $wasenc = 0; # True if request was encrypted. |
# ------------------------------------------------------------ See if encrypted |
# ------------------------------------------------------------ See if encrypted |
|
# for command |
|
# sethost:<server> |
|
# <command>:<args> |
|
# we just send it to the processor |
|
# for |
|
# sethost:<server>:<command>:<args> |
|
# we do the implict set host and then do the command |
|
if ($userinput =~ /^sethost:/) { |
|
(my $cmd,my $newid,$userinput) = split(':',$userinput,3); |
|
if (defined($userinput)) { |
|
&sethost("$cmd:$newid"); |
|
} else { |
|
$userinput = "$cmd:$newid"; |
|
} |
|
} |
|
|
if ($userinput =~ /^enc/) { |
if ($userinput =~ /^enc/) { |
$userinput = decipher($userinput); |
$userinput = decipher($userinput); |
$wasenc=1; |
$wasenc=1; |
Line 4851 sub ReadHostTable {
|
Line 4885 sub ReadHostTable {
|
} |
} |
$hostid{$ip}=$id; # LonCAPA name of host by IP. |
$hostid{$ip}=$id; # LonCAPA name of host by IP. |
$hostdom{$id}=$domain; # LonCAPA domain name of host. |
$hostdom{$id}=$domain; # LonCAPA domain name of host. |
|
$hostname{$id}=$name; # LonCAPA name -> DNS name |
$hostip{$id}=$ip; # IP address of host. |
$hostip{$id}=$ip; # IP address of host. |
$hostdns{$name} = $id; # LonCAPA name of host by DNS. |
$hostdns{$name} = $id; # LonCAPA name of host by DNS. |
|
|
Line 5101 sub reconlonc {
|
Line 5136 sub reconlonc {
|
|
|
sub subreply { |
sub subreply { |
my ($cmd,$server)=@_; |
my ($cmd,$server)=@_; |
my $peerfile="$perlvar{'lonSockDir'}/$server"; |
my $peerfile="$perlvar{'lonSockDir'}/".$hostname{$server}; |
my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", |
my $sclient=IO::Socket::UNIX->new(Peer =>"$peerfile", |
Type => SOCK_STREAM, |
Type => SOCK_STREAM, |
Timeout => 10) |
Timeout => 10) |
or return "con_lost"; |
or return "con_lost"; |
print $sclient "$cmd\n"; |
print $sclient "sethost:$server:$cmd\n"; |
my $answer=<$sclient>; |
my $answer=<$sclient>; |
chomp($answer); |
chomp($answer); |
if (!$answer) { $answer="con_lost"; } |
if (!$answer) { $answer="con_lost"; } |
Line 5122 sub reply {
|
Line 5157 sub reply {
|
$answer=subreply("ping",$server); |
$answer=subreply("ping",$server); |
if ($answer ne $server) { |
if ($answer ne $server) { |
&logthis("sub reply: answer != server answer is $answer, server is $server"); |
&logthis("sub reply: answer != server answer is $answer, server is $server"); |
&reconlonc("$perlvar{'lonSockDir'}/$server"); |
&reconlonc("$perlvar{'lonSockDir'}/".$hostname{$server}); |
} |
} |
$answer=subreply($cmd,$server); |
$answer=subreply($cmd,$server); |
} |
} |
Line 5149 sub sub_sql_reply {
|
Line 5184 sub sub_sql_reply {
|
Type => SOCK_STREAM, |
Type => SOCK_STREAM, |
Timeout => 10) |
Timeout => 10) |
or return "con_lost"; |
or return "con_lost"; |
print $sclient "$cmd\n"; |
print $sclient "$cmd:$currentdomainid\n"; |
my $answer=<$sclient>; |
my $answer=<$sclient>; |
chomp($answer); |
chomp($answer); |
if (!$answer) { $answer="con_lost"; } |
if (!$answer) { $answer="con_lost"; } |
Line 5428 sub make_new_child {
|
Line 5463 sub make_new_child {
|
# no need to try to do recon's to myself |
# no need to try to do recon's to myself |
next; |
next; |
} |
} |
&reconlonc("$perlvar{'lonSockDir'}/$id"); |
&reconlonc("$perlvar{'lonSockDir'}/".$hostname{$id}); |
} |
} |
&logthis("<font color='green'>Established connection: $clientname</font>"); |
&logthis("<font color='green'>Established connection: $clientname</font>"); |
&status('Will listen to '.$clientname); |
&status('Will listen to '.$clientname); |
Line 5484 sub is_author {
|
Line 5519 sub is_author {
|
|
|
# Author role should show up as a key /domain/_au |
# Author role should show up as a key /domain/_au |
|
|
my $key = "/$domain/_au"; |
my $key = "/$domain/_au"; |
my $value = $hashref->{$key}; |
my $value; |
|
if (defined($hashref)) { |
|
$value = $hashref->{$key}; |
|
} |
|
|
if(defined($value)) { |
if(defined($value)) { |
&Debug("$user @ $domain is an author"); |
&Debug("$user @ $domain is an author"); |
Line 6085 sub convert_photo {
|
Line 6123 sub convert_photo {
|
sub sethost { |
sub sethost { |
my ($remotereq) = @_; |
my ($remotereq) = @_; |
my (undef,$hostid)=split(/:/,$remotereq); |
my (undef,$hostid)=split(/:/,$remotereq); |
|
# ignore sethost if we are already correct |
|
if ($hostid eq $currenthostid) { |
|
return 'ok'; |
|
} |
|
|
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
if (!defined($hostid)) { $hostid=$perlvar{'lonHostID'}; } |
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
if ($hostip{$perlvar{'lonHostID'}} eq $hostip{$hostid}) { |
$currenthostid =$hostid; |
$currenthostid =$hostid; |