version 1.305.2.4, 2006/02/10 09:48:17
|
version 1.318.2.2, 2006/02/09 20:39:25
|
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 3050 sub store_handler {
|
Line 3068 sub store_handler {
|
my $version=$hashref->{"version:$rid"}; |
my $version=$hashref->{"version:$rid"}; |
my $allkeys=''; |
my $allkeys=''; |
foreach my $pair (@pairs) { |
foreach my $pair (@pairs) { |
my ($key,$value)=split(/=/,$pair); |
my ($key)=split(/=/,$pair); |
$allkeys.=$key.':'; |
$allkeys.=$key.':'; |
$hashref->{"$version:$rid:$key"}=$value; |
|
} |
} |
$hashref->{"$version:$rid:timestamp"}=$now; |
$hashref->{"$version:$rid"}=$what."\×tamp=$now"; |
$allkeys.='timestamp'; |
$allkeys.='timestamp'; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
$hashref->{"$version:keys:$rid"}=$allkeys; |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
Line 3120 sub restore_handler {
|
Line 3137 sub restore_handler {
|
my @keys=split(/:/,$vkeys); |
my @keys=split(/:/,$vkeys); |
my $key; |
my $key; |
$qresult.="$scope:keys=$vkeys&"; |
$qresult.="$scope:keys=$vkeys&"; |
foreach $key (@keys) { |
if (exists($hashref->{"$scope:$rid"})) { |
$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; |
my $what=$hashref->{"$scope:$rid"}; |
} |
foreach my $pair (split(/\&/,$hashref->{"$scope:$rid"})) { |
|
my ($key,$value)=split(/=/,$pair); |
|
$qresult.="$scope:".$pair."&"; |
|
} |
|
} else { |
|
foreach $key (@keys) { |
|
$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; |
|
} |
|
} |
} |
} |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
Line 4330 sub photo_permission_handler {
|
Line 4355 sub photo_permission_handler {
|
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my $cdom = $tail; |
my $cdom = $tail; |
my ($perm_reqd,$conditions); |
my ($perm_reqd,$conditions); |
my $outcome; |
my $outcome = &localenroll::photo_permission($cdom,\$perm_reqd, |
eval { |
\$conditions); |
local($SIG{__DIE__})='DEFAULT'; |
&Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n", |
$outcome = &localenroll::photo_permission($cdom,\$perm_reqd, |
$userinput); |
\$conditions); |
|
}; |
|
if (!$@) { |
|
&Reply($client, &escape($outcome.':'.$perm_reqd.':'. $conditions)."\n", |
|
$userinput); |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
return 1; |
|
} |
} |
®ister_handler("autophotopermission",\&photo_permission_handler,0,1,0); |
®ister_handler("autophotopermission",\&photo_permission_handler,0,1,0); |
|
|
Line 4367 sub photo_check_handler {
|
Line 4383 sub photo_check_handler {
|
my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response); |
my $result = &localstudentphoto::fetch($udom,$uname,$pid,\$response); |
$result .= ':'.$response; |
$result .= ':'.$response; |
&Reply($client, &escape($result)."\n",$userinput); |
&Reply($client, &escape($result)."\n",$userinput); |
return 1; |
|
} |
} |
®ister_handler("autophotocheck",\&photo_check_handler,0,1,0); |
®ister_handler("autophotocheck",\&photo_check_handler,0,1,0); |
|
|
Line 4381 sub photo_choice_handler {
|
Line 4396 sub photo_choice_handler {
|
my ($cmd, $tail, $client) = @_; |
my ($cmd, $tail, $client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
my $cdom = &unescape($tail); |
my $cdom = &unescape($tail); |
my ($update,$comment); |
my ($update,$comment) = &localenroll::manager_photo_update($cdom); |
eval { |
&Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput); |
local($SIG{__DIE__})='DEFAULT'; |
|
($update,$comment) = &localenroll::manager_photo_update($cdom); |
|
}; |
|
if (!$@) { |
|
&Reply($client,&escape($update).':'.&escape($comment)."\n",$userinput); |
|
} else { |
|
&Failure($client,"unknown_cmd\n",$userinput); |
|
} |
|
return 1; |
|
} |
} |
®ister_handler("autophotochoice",\&photo_choice_handler,0,1,0); |
®ister_handler("autophotochoice",\&photo_choice_handler,0,1,0); |
|
|
Line 4424 sub student_photo_handler {
|
Line 4430 sub student_photo_handler {
|
&mkpath($path); |
&mkpath($path); |
my $file; |
my $file; |
if ($type eq 'thumbnail') { |
if ($type eq 'thumbnail') { |
eval { |
$file=&localstudentphoto::fetch_thumbnail($domain,$uname); |
local($SIG{__DIE__})='DEFAULT'; |
|
$file=&localstudentphoto::fetch_thumbnail($domain,$uname); |
|
}; |
|
} else { |
} else { |
$file=&localstudentphoto::fetch($domain,$uname); |
$file=&localstudentphoto::fetch($domain,$uname); |
} |
} |
Line 4851 sub ReadHostTable {
|
Line 4854 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 5105 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 5126 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 5428 sub make_new_child {
|
Line 5432 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); |