--- loncom/lonnet/perl/lonnet.pm 2004/12/30 16:07:48 1.584 +++ loncom/lonnet/perl/lonnet.pm 2005/01/28 09:25:18 1.587.2.2 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.584 2004/12/30 16:07:48 raeburn Exp $ +# $Id: lonnet.pm,v 1.587.2.2 2005/01/28 09:25:18 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -157,22 +157,6 @@ sub reply { my ($cmd,$server)=@_; unless (defined($hostname{$server})) { return 'no_such_host'; } 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/)) { &logthis("WARNING:". " $cmd to $server returned $answer"); @@ -220,11 +204,8 @@ sub critical { } my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { - my $pingreply=reply('ping',$server); &reconlonc("$perlvar{'lonSockDir'}/$server"); - my $pongreply=reply('pong',$server); - &logthis("Ping/Pong for $server: $pingreply/$pongreply"); - $answer=reply($cmd,$server); + my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { my $now=time; my $middlename=$cmd; @@ -2111,9 +2092,11 @@ sub tmpreset { $namespace=~s/\//\_/g; $namespace=~s/\W//g; - #FIXME needs to do something for /pub resources if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } + if ($domain eq 'public' && $stuname eq 'public') { + $stuname=$ENV{'REMOTE_ADDR'}; + } my $path=$perlvar{'lonDaemons'}.'/tmp'; my %hash; if (tie(%hash,'GDBM_File', @@ -2146,9 +2129,11 @@ sub tmpstore { } $namespace=~s/\//\_/g; $namespace=~s/\W//g; -#FIXME needs to do something for /pub resources if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } + if ($domain eq 'public' && $stuname eq 'public') { + $stuname=$ENV{'REMOTE_ADDR'}; + } my $now=time; my %hash; my $path=$perlvar{'lonDaemons'}.'/tmp'; @@ -2160,7 +2145,7 @@ sub tmpstore { my $allkeys=''; foreach my $key (keys(%$storehash)) { $allkeys.=$key.':'; - $hash{"$version:$symb:$key"}=$$storehash{$key}; + $hash{"$version:$symb:$key"}=&freeze_escape($$storehash{$key}); } $hash{"$version:$symb:timestamp"}=$now; $allkeys.='timestamp'; @@ -2187,10 +2172,12 @@ sub tmprestore { $symb=escape($symb); if (!$namespace) { $namespace=$ENV{'request.state'}; } - #FIXME needs to do something for /pub resources + if (!$domain) { $domain=$ENV{'user.domain'}; } if (!$stuname) { $stuname=$ENV{'user.name'}; } - + if ($domain eq 'public' && $stuname eq 'public') { + $stuname=$ENV{'REMOTE_ADDR'}; + } my %returnhash; $namespace=~s/\//\_/g; $namespace=~s/\W//g; @@ -2208,8 +2195,8 @@ sub tmprestore { my $key; $returnhash{"$scope:keys"}=$vkeys; foreach $key (@keys) { - $returnhash{"$scope:$key"}=$hash{"$scope:$symb:$key"}; - $returnhash{"$key"}=$hash{"$scope:$symb:$key"}; + $returnhash{"$scope:$key"}=&thaw_unescape($hash{"$scope:$symb:$key"}); + $returnhash{"$key"}=&thaw_unescape($hash{"$scope:$symb:$key"}); } } if (!(untie(%hash))) { @@ -2250,7 +2237,7 @@ sub store { my $namevalue=''; foreach (keys %$storehash) { - $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; + $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; } $namevalue=~s/\&$//; &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue); @@ -2286,7 +2273,7 @@ sub cstore { my $namevalue=''; foreach (keys %$storehash) { - $namevalue.=escape($_).'='.escape($$storehash{$_}).'&'; + $namevalue.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&'; } $namevalue=~s/\&$//; &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); @@ -2320,7 +2307,7 @@ sub restore { my %returnhash=(); foreach (split(/\&/,$answer)) { my ($name,$value)=split(/\=/,$_); - $returnhash{&unescape($name)}=&unescape($value); + $returnhash{&unescape($name)}=&thaw_unescape($value); } my $version; for ($version=1;$version<=$returnhash{'version'};$version++) { @@ -2376,7 +2363,7 @@ sub privileged { my $now=time; if ($rolesdump ne '') { foreach (split(/&/,$rolesdump)) { - if ($_!~/^rolesdef\&/) { + if ($_!~/^rolesdef_/) { my ($area,$role)=split(/=/,$_); $area=~s/\_\w\w$//; my ($trole,$tend,$tstart)=split(/_/,$role); @@ -2408,10 +2395,17 @@ sub rolesinit { if ($rolesdump ne '') { foreach (split(/&/,$rolesdump)) { - if ($_!~/^rolesdef\&/) { + if ($_!~/^rolesdef_/) { my ($area,$role)=split(/=/,$_); - $area=~s/\_\w\w$//; - my ($trole,$tend,$tstart)=split(/_/,$role); + $area=~s/\_\w\w$//; + + my ($trole,$tend,$tstart); + if ($role=~/^cr/) { + ($trole,my $trest)=($role=~m|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$|); + ($tend,$tstart)=split('_',$trest); + } else { + ($trole,$tend,$tstart)=split(/_/,$role); + } $userroles.=&set_arearole($trole,$area,$tstart,$tend,$domain,$username); if (($tend!=0) && ($tend<$now)) { $trole=''; } if (($tstart!=0) && ($tstart>$now)) { $trole=''; } @@ -2704,7 +2698,7 @@ sub putstore { my $key = $1.':keys:'.$2; $allitems{$key} .= $3.':'; } - $items.=$_.'='.&escape($$storehash{$_}).'&'; + $items.=$_.'='.&freeze_escape($$storehash{$_}).'&'; } foreach (keys %allitems) { $allitems{$_} =~ s/\:$//; @@ -4450,6 +4444,7 @@ sub packages_tab_default { if (defined($packagetab{"$pack_type&$name&default"})) { return $packagetab{"$pack_type&$name&default"}; } + if ($pack_type eq 'part') { $pack_part='0'; } if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) { return $packagetab{$pack_type."_".$pack_part."&$name&default"}; }