--- loncom/lonnet/perl/lonnet.pm 2002/10/22 21:49:10 1.299
+++ loncom/lonnet/perl/lonnet.pm 2002/12/09 22:09:58 1.313
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.299 2002/10/22 21:49:10 matthew Exp $
+# $Id: lonnet.pm,v 1.313 2002/12/09 22:09:58 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -77,10 +77,11 @@ use Apache::File;
use LWP::UserAgent();
use HTTP::Headers;
use vars
-qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom
- %libserv %pr %prp %metacache %packagetab
+qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom
+ %libserv %pr %prp %metacache %packagetab %titlecache
%courselogs %accesshash $processmarker $dumpcount
- %coursedombuf %coursehombuf %courseresdatacache %domaindescription);
+ %coursedombuf %coursehombuf %courseresdatacache
+ %domaindescription);
use IO::Socket;
use GDBM_File;
use Apache::Constants qw(:common :http);
@@ -142,9 +143,9 @@ sub reply {
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') {
+ #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",
@@ -215,7 +216,8 @@ sub critical {
$middlename=substr($middlename,0,16);
$middlename=~s/\W//g;
my $dfilename=
- "$perlvar{'lonSockDir'}/delayed/$now.$middlename.$server";
+ "$perlvar{'lonSockDir'}/delayed/$now.$dumpcount.$$.$middlename.$server";
+ $dumpcount++;
{
my $dfh;
if ($dfh=Apache::File->new(">$dfilename")) {
@@ -727,6 +729,7 @@ sub currentversion {
sub subscribe {
my $fname=shift;
+ if ($fname=~/\/(aboutme|syllabus|bulletinboard|smppg)$/) { return ''; }
my $author=$fname;
$author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
my ($udom,$uname)=split(/\//,$author);
@@ -840,7 +843,8 @@ sub tokenwrapper {
if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
&appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});
return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.
- (($uri=~/\?/)?'&':'?').'token='.$token;
+ (($uri=~/\?/)?'&':'?').'token='.$token.
+ '&tokenissued='.$perlvar{'lonHostID'};
} else {
return '/adm/notfound.html';
}
@@ -1542,11 +1546,15 @@ sub coursedescription {
$courseid=~s/\_/\//g;
my ($cdomain,$cnum)=split(/\//,$courseid);
my $chome=&homeserver($cnum,$cdomain);
+ my $normalid=$cdomain.'_'.$cnum;
+ # need to always cache even if we get errors otherwise we keep
+ # trying and trying and trying to get the course description.
+ my %envhash=();
+ my %returnhash=();
+ $envhash{'course.'.$normalid.'.last_cache'}=time;
if ($chome ne 'no_host') {
- my %returnhash=&dump('environment',$cdomain,$cnum);
+ %returnhash=&dump('environment',$cdomain,$cnum);
if (!exists($returnhash{'con_lost'})) {
- my $normalid=$cdomain.'_'.$cnum;
- my %envhash=();
$returnhash{'home'}= $chome;
$returnhash{'domain'} = $cdomain;
$returnhash{'num'} = $cnum;
@@ -1556,15 +1564,13 @@ sub coursedescription {
$returnhash{'url'}=&clutter($returnhash{'url'});
$returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
$ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
- $envhash{'course.'.$normalid.'.last_cache'}=time;
$envhash{'course.'.$normalid.'.home'}=$chome;
$envhash{'course.'.$normalid.'.domain'}=$cdomain;
$envhash{'course.'.$normalid.'.num'}=$cnum;
- &appenv(%envhash);
- return %returnhash;
}
}
- return ();
+ &appenv(%envhash);
+ return %returnhash;
}
# -------------------------------------------------------- Get user privileges
@@ -1802,7 +1808,9 @@ sub allowed {
if ($priv eq 'bre') {
my $copyright=&metadata($uri,'copyright');
- if ($copyright eq 'public') { return 'F'; }
+ if (($copyright eq 'public') && (!$ENV{'request.course.id'})) {
+ return 'F';
+ }
if ($copyright eq 'priv') {
$uri=~/([^\/]+)\/([^\/]+)\//;
unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) {
@@ -2342,10 +2350,15 @@ sub modifyuser {
}
}
# -------------------------------------------------------------- Add names, etc
- my %names=&get('environment',
+ my @tmp=&get('environment',
['firstname','middlename','lastname','generation'],
$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 ($middle) { $names{'middlename'} = $middle; }
if ($last) { $names{'lastname'} = $last; }
@@ -2713,6 +2726,8 @@ sub courseresdata {
if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
$courseresdatacache{$hashid.'.time'}=time;
$courseresdatacache{$hashid}=\%dumpreply;
+ } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
+ return $tmp;
}
}
foreach my $item (@which) {
@@ -2839,24 +2854,35 @@ sub EXT {
my $courselevelm=$courseid.'.'.$mapparm;
# ----------------------------------------------------------- first, check user
- my %resourcedata=&get('resourcedata',
- [$courselevelr,$courselevelm,$courselevel],
- $udom,$uname);
- if (($resourcedata{$courselevelr}!~/^error\:/) &&
- ($resourcedata{$courselevelr}!~/^con_lost/)) {
-
- if ($resourcedata{$courselevelr}) {
- return $resourcedata{$courselevelr}; }
- if ($resourcedata{$courselevelm}) {
- return $resourcedata{$courselevelm}; }
- if ($resourcedata{$courselevel}) {
- return $resourcedata{$courselevel}; }
- } else {
- if ($resourcedata{$courselevelr}!~/No such file/) {
- &logthis("<font color=blue>WARNING:".
- " Trying to get resource data for ".
- $uname." at ".$udom.": ".
- $resourcedata{$courselevelr}."</font>");
+ #most student don't have any data set, check if there is some data
+ #every thirty minutes
+ if (!
+ (exists($ENV{'cache.studentresdata'})
+ && (($ENV{'cache.studentresdata'}+1800) > time))) {
+ my %resourcedata=&get('resourcedata',
+ [$courselevelr,$courselevelm,$courselevel],
+ $udom,$uname);
+ my ($tmp)=keys(%resourcedata);
+ if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
+ if ($resourcedata{$courselevelr}) {
+ return $resourcedata{$courselevelr}; }
+ if ($resourcedata{$courselevelm}) {
+ return $resourcedata{$courselevelm}; }
+ if ($resourcedata{$courselevel}) {
+ return $resourcedata{$courselevel}; }
+ } else {
+ if ($tmp!~/No such file/) {
+ &logthis("<font color=blue>WARNING:".
+ " Trying to get resource data for ".
+ $uname." at ".$udom.": ".
+ $tmp."</font>");
+ } elsif ($tmp=~/error:No such file/) {
+ $ENV{'cache.studentresdata'}=time;
+ &appenv(('cache.studentresdata'=>
+ $ENV{'cache.studentresdata'}));
+ } elsif ($tmp =~ /^(con_lost|no_such_host)/) {
+ return $tmp;
+ }
}
}
@@ -3096,6 +3122,33 @@ sub metadata_generate_part0 {
}
}
+# ------------------------------------------------- Get the title of a resource
+
+sub gettitle {
+ my $urlsymb=shift;
+ my $symb=&symbread($urlsymb);
+ unless ($symb) {
+ unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
+ return &metadata($urlsymb,'title');
+ }
+ if ($titlecache{$symb}) { return $titlecache{$symb}; }
+ my ($map,$resid,$url)=split(/\_\_\_/,$symb);
+ my $title='';
+ my %bighash;
+ if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
+ &GDBM_READER(),0640)) {
+ my $mapid=$bighash{'map_pc_'.&clutter($map)};
+ $title=$bighash{'title_'.$mapid.'.'.$resid};
+ untie %bighash;
+ }
+ if ($title) {
+ $titlecache{$symb}=$title;
+ return $title;
+ } else {
+ return &metadata($urlsymb,'title');
+ }
+}
+
# ------------------------------------------------- Update symbolic store links
sub symblist {
@@ -3442,12 +3495,14 @@ BEGIN {
my $config=Apache::File->new("$perlvar{'lonTabDir'}/hosts.tab");
while (my $configline=<$config>) {
+ next if ($configline =~ /^(\#|\s*$)/);
chomp($configline);
my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
if ($id && $domain && $role && $name && $ip) {
$hostname{$id}=$name;
$hostdom{$id}=$domain;
$hostip{$id}=$ip;
+ $iphost{$ip}=$id;
if ($domdescr) { $domaindescription{$domain}=$domdescr; }
if ($role eq 'library') { $libserv{$id}=$name; }
} else {