version 1.579, 2004/12/17 22:40:09
|
version 1.589, 2005/01/18 22:09:14
|
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 1746 sub get_first_access {
|
Line 1739 sub get_first_access {
|
my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); |
my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); |
if ($argsymb) { $symb=$argsymb; } |
if ($argsymb) { $symb=$argsymb; } |
my ($map,$id,$res)=&decode_symb($symb); |
my ($map,$id,$res)=&decode_symb($symb); |
if ($type eq 'map') { $res=$map; } |
if ($type eq 'map') { |
my %times=&get('firstaccesstimes',[$res],$udom,$uname); |
$res=&symbread($map); |
return $times{$res}; |
} else { |
|
$res=$symb; |
|
} |
|
my %times=&get('firstaccesstimes',["$courseid\0$res"],$udom,$uname); |
|
return $times{"$courseid\0$res"}; |
} |
} |
|
|
sub set_first_access { |
sub set_first_access { |
my ($type)=@_; |
my ($type)=@_; |
my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); |
my ($symb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); |
my ($map,$id,$res)=&decode_symb($symb); |
my ($map,$id,$res)=&decode_symb($symb); |
if ($type eq 'map') { $res=$map; } |
if ($type eq 'map') { |
my $firstaccess=&get_first_access($type); |
$res=&symbread($map); |
|
} else { |
|
$res=$symb; |
|
} |
|
my $firstaccess=&get_first_access($type,$symb); |
if (!$firstaccess) { |
if (!$firstaccess) { |
return &put('firstaccesstimes',{$res=>time},$udom,$uname); |
return &put('firstaccesstimes',{"$courseid\0$res"=>time},$udom,$uname); |
} |
} |
return 'already_set'; |
return 'already_set'; |
} |
} |
Line 2364 sub privileged {
|
Line 2365 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 2397 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 3360 sub auto_instcode_format {
|
Line 3368 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 4431 sub packages_tab_default {
|
Line 4446 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 4790 sub symbverify {
|
Line 4806 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 5546 sub thaw_unescape {
|
Line 5565 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 5582 BEGIN {
|
Line 5601 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 6217 returns the data handle
|
Line 6237 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 * |