version 1.577, 2004/12/16 20:34:33
|
version 1.587.2.3, 2005/01/28 09:26:28
|
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 1588 sub courseacclog {
|
Line 1569 sub courseacclog {
|
my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'}; |
my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'}; |
if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) { |
if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) { |
$what.=':POST'; |
$what.=':POST'; |
|
# FIXME: Probably ought to escape things.... |
foreach (keys %ENV) { |
foreach (keys %ENV) { |
if ($_=~/^form\.(.*)/) { |
if ($_=~/^form\.(.*)/) { |
$what.=':'.$1.'='.$ENV{$_}; |
$what.=':'.$1.'='.$ENV{$_}; |
} |
} |
} |
} |
|
} elsif ($fnsymb =~ m:^/adm/searchcat:) { |
|
# FIXME: We should not be depending on a form parameter that someone |
|
# editing lonsearchcat.pm might change in the future. |
|
if ($ENV{'form.phase'} eq 'course_search') { |
|
$what.= ':POST'; |
|
# FIXME: Probably ought to escape things.... |
|
foreach my $element ('courseexp','crsfulltext','crsrelated', |
|
'crsdiscuss') { |
|
$what.=':'.$element.'='.$ENV{'form.'.$element}; |
|
} |
|
} |
} |
} |
&courselog($what); |
&courselog($what); |
} |
} |
Line 2364 sub privileged {
|
Line 2357 sub privileged {
|
my $now=time; |
my $now=time; |
if ($rolesdump ne '') { |
if ($rolesdump ne '') { |
foreach (split(/&/,$rolesdump)) { |
foreach (split(/&/,$rolesdump)) { |
if ($_!~/^rolesdef\&/) { |
if ($_!~/^rolesdef_/) { |
my ($area,$role)=split(/=/,$_); |
my ($area,$role)=split(/=/,$_); |
$area=~s/\_\w\w$//; |
$area=~s/\_\w\w$//; |
my ($trole,$tend,$tstart)=split(/_/,$role); |
my ($trole,$tend,$tstart)=split(/_/,$role); |
Line 2396 sub rolesinit {
|
Line 2389 sub rolesinit {
|
|
|
if ($rolesdump ne '') { |
if ($rolesdump ne '') { |
foreach (split(/&/,$rolesdump)) { |
foreach (split(/&/,$rolesdump)) { |
if ($_!~/^rolesdef\&/) { |
if ($_!~/^rolesdef_/) { |
my ($area,$role)=split(/=/,$_); |
my ($area,$role)=split(/=/,$_); |
$area=~s/\_\w\w$//; |
$area=~s/\_\w\w$//; |
my ($trole,$tend,$tstart)=split(/_/,$role); |
|
|
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); |
$userroles.=&set_arearole($trole,$area,$tstart,$tend,$domain,$username); |
if (($tend!=0) && ($tend<$now)) { $trole=''; } |
if (($tend!=0) && ($tend<$now)) { $trole=''; } |
if (($tstart!=0) && ($tstart>$now)) { $trole=''; } |
if (($tstart!=0) && ($tstart>$now)) { $trole=''; } |
Line 2777 sub customaccess {
|
Line 2777 sub customaccess {
|
# ------------------------------------------------- Check for a user privilege |
# ------------------------------------------------- Check for a user privilege |
|
|
sub allowed { |
sub allowed { |
my ($priv,$uri)=@_; |
my ($priv,$uri,$symb)=@_; |
$uri=&deversion($uri); |
$uri=&deversion($uri); |
my $orguri=$uri; |
my $orguri=$uri; |
$uri=&declutter($uri); |
$uri=&declutter($uri); |
Line 3058 sub allowed {
|
Line 3058 sub allowed {
|
|
|
if ($thisallowed=~/X/) { |
if ($thisallowed=~/X/) { |
if ($ENV{'acc.randomout'}) { |
if ($ENV{'acc.randomout'}) { |
my $symb=&symbread($uri,1); |
if (!$symb) { $symb=&symbread($uri,1); } |
if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) { |
if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) { |
return ''; |
return ''; |
} |
} |
Line 3360 sub auto_instcode_format {
|
Line 3360 sub auto_instcode_format {
|
my $courses = ''; |
my $courses = ''; |
my $homeserver; |
my $homeserver; |
if ($caller eq 'global') { |
if ($caller eq 'global') { |
$homeserver = $perlvar{'lonHostID'}; |
foreach my $tryserver (keys %libserv) { |
|
if ($hostdom{$tryserver} eq $codedom) { |
|
$homeserver = $tryserver; |
|
last; |
|
} |
|
} |
|
if (($ENV{'user.name'}) && ($ENV{'user.domain'} eq $codedom)) { |
|
$homeserver = &homeserver($ENV{'user.name'},$codedom); |
|
} |
} else { |
} else { |
$homeserver = &homeserver($caller,$codedom); |
$homeserver = &homeserver($caller,$codedom); |
} |
} |
my $host=$hostname{$homeserver}; |
|
foreach (keys %{$instcodes}) { |
foreach (keys %{$instcodes}) { |
$courses .= &escape($_).'='.&escape($$instcodes{$_}).'&'; |
$courses .= &escape($_).'='.&escape($$instcodes{$_}).'&'; |
} |
} |
Line 3819 sub save_selected_files {
|
Line 3826 sub save_selected_files {
|
my ($user, $path, @files) = @_; |
my ($user, $path, @files) = @_; |
my $filename = $user."savedfiles"; |
my $filename = $user."savedfiles"; |
my @other_files = &files_not_in_path($user, $path); |
my @other_files = &files_not_in_path($user, $path); |
foreach (@other_files) { |
|
&logthis("other dir file $_"); |
|
} |
|
foreach (@files) { |
|
&logthis("current dir file $_"); |
|
} |
|
open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); |
open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename); |
foreach my $file (@files) { |
foreach my $file (@files) { |
print (OUT $ENV{'form.currentpath'}.$file."\n"); |
print (OUT $ENV{'form.currentpath'}.$file."\n"); |
Line 4437 sub packages_tab_default {
|
Line 4438 sub packages_tab_default {
|
if (defined($packagetab{"$pack_type&$name&default"})) { |
if (defined($packagetab{"$pack_type&$name&default"})) { |
return $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"})) { |
if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) { |
return $packagetab{$pack_type."_".$pack_part."&$name&default"}; |
return $packagetab{$pack_type."_".$pack_part."&$name&default"}; |
} |
} |
Line 4796 sub symbverify {
|
Line 4798 sub symbverify {
|
if ( |
if ( |
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) |
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) |
eq $symb) { |
eq $symb) { |
$okay=1; |
if (($ENV{'request.role.adv'}) || |
} |
$bighash{'encrypted_'.$_} eq $ENV{'request.enc'}) { |
|
$okay=1; |
|
} |
|
} |
} |
} |
} |
} |
untie(%bighash); |
untie(%bighash); |
Line 5552 sub thaw_unescape {
|
Line 5557 sub thaw_unescape {
|
} |
} |
|
|
sub mod_perl_version { |
sub mod_perl_version { |
|
return 1; |
if (defined($perlvar{'MODPERL2'})) { |
if (defined($perlvar{'MODPERL2'})) { |
return 2; |
return 2; |
} |
} |
return 1; |
|
} |
} |
|
|
sub correct_line_ends { |
sub correct_line_ends { |
Line 5588 BEGIN {
|
Line 5593 BEGIN {
|
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf |
unless ($readit) { |
unless ($readit) { |
{ |
{ |
|
# FIXME: Use LONCAPA::Configuration::read_conf here and omit next block |
open(my $config,"</etc/httpd/conf/loncapa.conf"); |
open(my $config,"</etc/httpd/conf/loncapa.conf"); |
|
|
while (my $configline=<$config>) { |
while (my $configline=<$config>) { |
Line 6223 returns the data handle
|
Line 6229 returns the data handle
|
=item * |
=item * |
|
|
symbverify($symb,$thisfn) : verifies that $symb actually exists and is |
symbverify($symb,$thisfn) : verifies that $symb actually exists and is |
a possible symb for the URL in $thisfn, returns a 1 on success, 0 on |
a possible symb for the URL in $thisfn, and if is an encryypted |
failure, user must be in a course, as it assumes the existance of the |
resource that the user accessed using /enc/ returns a 1 on success, 0 |
course initi hash, and uses $ENV('request.course.id'} |
on failure, user must be in a course, as it assumes the existance of |
|
the course initial hash, and uses $ENV('request.course.id'} |
|
|
|
|
=item * |
=item * |