version 1.305.2.6, 2006/05/18 19:58:36
|
version 1.318.2.5, 2006/03/03 22:03:17
|
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 2291 sub token_auth_user_file_handler {
|
Line 2292 sub token_auth_user_file_handler {
|
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'. |
$session.'.id')) { |
$session.'.id')) { |
while (my $line=<ENVIN>) { |
while (my $line=<ENVIN>) { |
my ($envname)=split(/=/,$line,2); |
if ($line=~ m|userfile\.\Q$fname\E\=|) { $reply="ok\n"; } |
$envname=&unescape($envname); |
|
if ($envname=~ m|^userfile\.\Q$fname\E|) { $reply="ok\n"; } |
|
} |
} |
close(ENVIN); |
close(ENVIN); |
&Reply($client, $reply, "$cmd:$tail"); |
&Reply($client, $reply, "$cmd:$tail"); |
Line 2916 sub dump_profile_database {
|
Line 2915 sub dump_profile_database {
|
while (my ($key,$value) = each(%$hashref)) { |
while (my ($key,$value) = each(%$hashref)) { |
my ($v,$symb,$param) = split(/:/,$key); |
my ($v,$symb,$param) = split(/:/,$key); |
next if ($v eq 'version' || $symb eq 'keys'); |
next if ($v eq 'version' || $symb eq 'keys'); |
next if (exists($data{$symb}) && |
# making old style store entries '$ver:$symb:$key = $value' |
exists($data{$symb}->{$param}) && |
# look like new '$ver:compressed:$symb = "$key=$value"' |
$data{$symb}->{'v.'.$param} > $v); |
if ($symb eq 'compressed') { |
$data{$symb}->{$param}=$value; |
$symb = $param; |
$data{$symb}->{'v.'.$param}=$v; |
} else { |
|
$value = $param.'='.$value; |
|
} |
|
foreach my $pair (split(/\&/,$value)) { |
|
my ($param,$value)=split(/=/,$pair); |
|
next if (exists($data{$symb}) && |
|
exists($data{$symb}->{$param}) && |
|
$data{$symb}->{'v.'.$param} > $v); |
|
$data{$symb}->{$param}=$value; |
|
$data{$symb}->{'v.'.$param}=$v; |
|
} |
} |
} |
if (&untie_user_hash($hashref)) { |
if (&untie_user_hash($hashref)) { |
while (my ($symb,$param_hash) = each(%data)) { |
while (my ($symb,$param_hash) = each(%data)) { |
Line 2977 sub dump_with_regexp {
|
Line 2986 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 3052 sub store_handler {
|
Line 3078 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:compressed:$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 3122 sub restore_handler {
|
Line 3147 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:compressed:$rid"})) { |
$qresult.="$scope:$key=".$hashref->{"$scope:$rid:$key"}."&"; |
foreach my $pair (split(/\&/,$hashref->{"$scope:compressed:$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 4332 sub photo_permission_handler {
|
Line 4364 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 4369 sub photo_check_handler {
|
Line 4392 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 4383 sub photo_choice_handler {
|
Line 4405 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 4426 sub student_photo_handler {
|
Line 4439 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 4853 sub ReadHostTable {
|
Line 4863 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 5103 sub reconlonc {
|
Line 5114 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 5124 sub reply {
|
Line 5135 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 5151 sub sub_sql_reply {
|
Line 5162 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:$currentdomainid\n"; |
print $sclient "$cmd\n"; |
my $answer=<$sclient>; |
my $answer=<$sclient>; |
chomp($answer); |
chomp($answer); |
if (!$answer) { $answer="con_lost"; } |
if (!$answer) { $answer="con_lost"; } |
Line 5430 sub make_new_child {
|
Line 5441 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); |