version 1.308, 2002/12/05 23:27:46
|
version 1.316, 2003/01/10 20:55:44
|
Line 81 qw(%perlvar %hostname %homecache %badSer
|
Line 81 qw(%perlvar %hostname %homecache %badSer
|
%libserv %pr %prp %metacache %packagetab %titlecache |
%libserv %pr %prp %metacache %packagetab %titlecache |
%courselogs %accesshash $processmarker $dumpcount |
%courselogs %accesshash $processmarker $dumpcount |
%coursedombuf %coursehombuf %courseresdatacache |
%coursedombuf %coursehombuf %courseresdatacache |
%studentresdatacache %domaindescription); |
%domaindescription); |
use IO::Socket; |
use IO::Socket; |
use GDBM_File; |
use GDBM_File; |
use Apache::Constants qw(:common :http); |
use Apache::Constants qw(:common :http); |
Line 143 sub reply {
|
Line 143 sub reply {
|
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') { |
if ($answer eq 'con_lost') { |
#sleep 5; |
#sleep 5; |
#$answer=subreply($cmd,$server); |
#$answer=subreply($cmd,$server); |
#if ($answer eq 'con_lost') { |
#if ($answer eq 'con_lost') { |
# &logthis("Second attempt con_lost on $server"); |
# &logthis("Second attempt con_lost on $server"); |
# my $peerfile="$perlvar{'lonSockDir'}/$server"; |
# my $peerfile="$perlvar{'lonSockDir'}/$server"; |
# my $client=IO::Socket::UNIX->new(Peer =>"$peerfile", |
# my $client=IO::Socket::UNIX->new(Peer =>"$peerfile", |
Line 203 sub critical {
|
Line 203 sub critical {
|
" Critical message to unknown server ($server)</font>"); |
" Critical message to unknown server ($server)</font>"); |
return 'no_such_host'; |
return 'no_such_host'; |
} |
} |
sleep 2; |
|
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); |
my $pingreply=reply('ping',$server); |
Line 730 sub currentversion {
|
Line 729 sub currentversion {
|
|
|
sub subscribe { |
sub subscribe { |
my $fname=shift; |
my $fname=shift; |
|
if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; } |
my $author=$fname; |
my $author=$fname; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; |
my ($udom,$uname)=split(/\//,$author); |
my ($udom,$uname)=split(/\//,$author); |
Line 857 sub tokenwrapper {
|
Line 857 sub tokenwrapper {
|
sub userfileupload { |
sub userfileupload { |
my ($formname,$coursedoc)=@_; |
my ($formname,$coursedoc)=@_; |
my $fname=$ENV{'form.'.$formname.'.filename'}; |
my $fname=$ENV{'form.'.$formname.'.filename'}; |
|
# Replace Windows backslashes by forward slashes |
$fname=~s/\\/\//g; |
$fname=~s/\\/\//g; |
|
# Get rid of everything but the actual filename |
$fname=~s/^.*\/([^\/]+)$/$1/; |
$fname=~s/^.*\/([^\/]+)$/$1/; |
|
# Replace spaces by underscores |
|
$fname=~s/\s+/\_/g; |
|
# Replace all other weird characters by nothing |
|
$fname=~s/[^\w\.\-\+]//g; |
|
# See if there is anything left |
unless ($fname) { return 'error: no uploaded file'; } |
unless ($fname) { return 'error: no uploaded file'; } |
chop($ENV{'form.'.$formname}); |
chop($ENV{'form.'.$formname}); |
# Create the directory if not present |
# Create the directory if not present |
Line 1864 sub allowed {
|
Line 1871 sub allowed {
|
$thisallowed.=$1; |
$thisallowed.=$1; |
} |
} |
|
|
|
# URI is an uploaded document for this course |
|
|
|
if (($priv eq 'bre') && |
|
($uri=~/^uploaded\/$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}\/$ENV{'course.'.$ENV{'request.course.id'}.'.num'}/)) { |
|
return 'F'; |
|
} |
# Full access at system, domain or course-wide level? Exit. |
# Full access at system, domain or course-wide level? Exit. |
|
|
if ($thisallowed=~/F/) { |
if ($thisallowed=~/F/) { |
Line 2350 sub modifyuser {
|
Line 2363 sub modifyuser {
|
} |
} |
} |
} |
# -------------------------------------------------------------- Add names, etc |
# -------------------------------------------------------------- Add names, etc |
my %names=&get('environment', |
my @tmp=&get('environment', |
['firstname','middlename','lastname','generation'], |
['firstname','middlename','lastname','generation'], |
$udom,$uname); |
$udom,$uname); |
if ($names{'firstname'} =~ m/^error:.*/) { %names=(); } |
my %names; |
|
if ($tmp[0] =~ m/^error:.*/) { |
|
%names=(); |
|
} else { |
|
%names = @tmp; |
|
} |
if ($first) { $names{'firstname'} = $first; } |
if ($first) { $names{'firstname'} = $first; } |
if ($middle) { $names{'middlename'} = $middle; } |
if ($middle) { $names{'middlename'} = $middle; } |
if ($last) { $names{'lastname'} = $last; } |
if ($last) { $names{'lastname'} = $last; } |
Line 2851 sub EXT {
|
Line 2869 sub EXT {
|
# ----------------------------------------------------------- first, check user |
# ----------------------------------------------------------- first, check user |
#most student don't have any data set, check if there is some data |
#most student don't have any data set, check if there is some data |
#every thirty minutes |
#every thirty minutes |
if (!exists($studentresdatacache{$uname.'_'.$udom}) |
if (! |
|| $studentresdatacache{$uname.'_'.$udom} > (time+1800)) { |
(exists($ENV{'cache.studentresdata'}) |
|
&& (($ENV{'cache.studentresdata'}+1800) > time))) { |
my %resourcedata=&get('resourcedata', |
my %resourcedata=&get('resourcedata', |
[$courselevelr,$courselevelm,$courselevel], |
[$courselevelr,$courselevelm,$courselevel], |
$udom,$uname); |
$udom,$uname); |
Line 2871 sub EXT {
|
Line 2890 sub EXT {
|
$uname." at ".$udom.": ". |
$uname." at ".$udom.": ". |
$tmp."</font>"); |
$tmp."</font>"); |
} elsif ($tmp=~/error:No such file/) { |
} elsif ($tmp=~/error:No such file/) { |
$studentresdatacache{$uname.'_'.$udom}=time; |
$ENV{'cache.studentresdata'}=time; |
|
&appenv(('cache.studentresdata'=> |
|
$ENV{'cache.studentresdata'})); |
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
} elsif ($tmp =~ /^(con_lost|no_such_host)/) { |
return $tmp; |
return $tmp; |
} |
} |