version 1.587, 2005/01/11 22:12:22
|
version 1.587.2.2, 2005/01/28 09:25:18
|
Line 157 sub reply {
|
Line 157 sub reply {
|
my ($cmd,$server)=@_; |
my ($cmd,$server)=@_; |
unless (defined($hostname{$server})) { return 'no_such_host'; } |
unless (defined($hostname{$server})) { return 'no_such_host'; } |
my $answer=subreply($cmd,$server); |
my $answer=subreply($cmd,$server); |
if ($answer eq 'con_lost') { |
|
#sleep 5; |
|
#$answer=subreply($cmd,$server); |
|
#if ($answer eq 'con_lost') { |
|
# &logthis("Second attempt con_lost on $server"); |
|
# my $peerfile="$perlvar{'lonSockDir'}/$server"; |
|
# my $client=IO::Socket::UNIX->new(Peer =>"$peerfile", |
|
# Type => SOCK_STREAM, |
|
# Timeout => 10) |
|
# or return "con_lost"; |
|
# &logthis("Killing socket"); |
|
# print $client "close_connection_exit\n"; |
|
#sleep 5; |
|
# $answer=subreply($cmd,$server); |
|
#} |
|
} |
|
if (($answer=~/^refused/) || ($answer=~/^rejected/)) { |
if (($answer=~/^refused/) || ($answer=~/^rejected/)) { |
&logthis("<font color=blue>WARNING:". |
&logthis("<font color=blue>WARNING:". |
" $cmd to $server returned $answer</font>"); |
" $cmd to $server returned $answer</font>"); |
Line 220 sub critical {
|
Line 204 sub critical {
|
} |
} |
my $answer=reply($cmd,$server); |
my $answer=reply($cmd,$server); |
if ($answer eq 'con_lost') { |
if ($answer eq 'con_lost') { |
my $pingreply=reply('ping',$server); |
|
&reconlonc("$perlvar{'lonSockDir'}/$server"); |
&reconlonc("$perlvar{'lonSockDir'}/$server"); |
my $pongreply=reply('pong',$server); |
my $answer=reply($cmd,$server); |
&logthis("Ping/Pong for $server: $pingreply/$pongreply"); |
|
$answer=reply($cmd,$server); |
|
if ($answer eq 'con_lost') { |
if ($answer eq 'con_lost') { |
my $now=time; |
my $now=time; |
my $middlename=$cmd; |
my $middlename=$cmd; |
Line 2111 sub tmpreset {
|
Line 2092 sub tmpreset {
|
$namespace=~s/\//\_/g; |
$namespace=~s/\//\_/g; |
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
|
|
#FIXME needs to do something for /pub resources |
|
if (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
if ($domain eq 'public' && $stuname eq 'public') { |
|
$stuname=$ENV{'REMOTE_ADDR'}; |
|
} |
my $path=$perlvar{'lonDaemons'}.'/tmp'; |
my $path=$perlvar{'lonDaemons'}.'/tmp'; |
my %hash; |
my %hash; |
if (tie(%hash,'GDBM_File', |
if (tie(%hash,'GDBM_File', |
Line 2146 sub tmpstore {
|
Line 2129 sub tmpstore {
|
} |
} |
$namespace=~s/\//\_/g; |
$namespace=~s/\//\_/g; |
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
#FIXME needs to do something for /pub resources |
|
if (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
if ($domain eq 'public' && $stuname eq 'public') { |
|
$stuname=$ENV{'REMOTE_ADDR'}; |
|
} |
my $now=time; |
my $now=time; |
my %hash; |
my %hash; |
my $path=$perlvar{'lonDaemons'}.'/tmp'; |
my $path=$perlvar{'lonDaemons'}.'/tmp'; |
Line 2160 sub tmpstore {
|
Line 2145 sub tmpstore {
|
my $allkeys=''; |
my $allkeys=''; |
foreach my $key (keys(%$storehash)) { |
foreach my $key (keys(%$storehash)) { |
$allkeys.=$key.':'; |
$allkeys.=$key.':'; |
$hash{"$version:$symb:$key"}=$$storehash{$key}; |
$hash{"$version:$symb:$key"}=&freeze_escape($$storehash{$key}); |
} |
} |
$hash{"$version:$symb:timestamp"}=$now; |
$hash{"$version:$symb:timestamp"}=$now; |
$allkeys.='timestamp'; |
$allkeys.='timestamp'; |
Line 2187 sub tmprestore {
|
Line 2172 sub tmprestore {
|
$symb=escape($symb); |
$symb=escape($symb); |
|
|
if (!$namespace) { $namespace=$ENV{'request.state'}; } |
if (!$namespace) { $namespace=$ENV{'request.state'}; } |
#FIXME needs to do something for /pub resources |
|
if (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$domain) { $domain=$ENV{'user.domain'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
if ($domain eq 'public' && $stuname eq 'public') { |
|
$stuname=$ENV{'REMOTE_ADDR'}; |
|
} |
my %returnhash; |
my %returnhash; |
$namespace=~s/\//\_/g; |
$namespace=~s/\//\_/g; |
$namespace=~s/\W//g; |
$namespace=~s/\W//g; |
Line 2208 sub tmprestore {
|
Line 2195 sub tmprestore {
|
my $key; |
my $key; |
$returnhash{"$scope:keys"}=$vkeys; |
$returnhash{"$scope:keys"}=$vkeys; |
foreach $key (@keys) { |
foreach $key (@keys) { |
$returnhash{"$scope:$key"}=$hash{"$scope:$symb:$key"}; |
$returnhash{"$scope:$key"}=&thaw_unescape($hash{"$scope:$symb:$key"}); |
$returnhash{"$key"}=$hash{"$scope:$symb:$key"}; |
$returnhash{"$key"}=&thaw_unescape($hash{"$scope:$symb:$key"}); |
} |
} |
} |
} |
if (!(untie(%hash))) { |
if (!(untie(%hash))) { |
Line 2250 sub store {
|
Line 2237 sub store {
|
|
|
my $namevalue=''; |
my $namevalue=''; |
foreach (keys %$storehash) { |
foreach (keys %$storehash) { |
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; |
$namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; |
} |
} |
$namevalue=~s/\&$//; |
$namevalue=~s/\&$//; |
&courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue); |
&courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue); |
Line 2286 sub cstore {
|
Line 2273 sub cstore {
|
|
|
my $namevalue=''; |
my $namevalue=''; |
foreach (keys %$storehash) { |
foreach (keys %$storehash) { |
$namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; |
$namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; |
} |
} |
$namevalue=~s/\&$//; |
$namevalue=~s/\&$//; |
&courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); |
&courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); |
Line 2320 sub restore {
|
Line 2307 sub restore {
|
my %returnhash=(); |
my %returnhash=(); |
foreach (split(/\&/,$answer)) { |
foreach (split(/\&/,$answer)) { |
my ($name,$value)=split(/\=/,$_); |
my ($name,$value)=split(/\=/,$_); |
$returnhash{&unescape($name)}=&unescape($value); |
$returnhash{&unescape($name)}=&thaw_unescape($value); |
} |
} |
my $version; |
my $version; |
for ($version=1;$version<=$returnhash{'version'};$version++) { |
for ($version=1;$version<=$returnhash{'version'};$version++) { |
Line 2711 sub putstore {
|
Line 2698 sub putstore {
|
my $key = $1.':keys:'.$2; |
my $key = $1.':keys:'.$2; |
$allitems{$key} .= $3.':'; |
$allitems{$key} .= $3.':'; |
} |
} |
$items.=$_.'='.&escape($$storehash{$_}).'&'; |
$items.=$_.'='.&freeze_escape($$storehash{$_}).'&'; |
} |
} |
foreach (keys %allitems) { |
foreach (keys %allitems) { |
$allitems{$_} =~ s/\:$//; |
$allitems{$_} =~ s/\:$//; |