--- loncom/lonnet/perl/lonnet.pm 2002/10/22 21:49:10 1.299 +++ loncom/lonnet/perl/lonnet.pm 2002/12/05 22:59:37 1.306 @@ -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.306 2002/12/05 22:59:37 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -77,8 +77,8 @@ 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); use IO::Socket; @@ -202,6 +202,7 @@ sub critical { " Critical message to unknown server ($server)"); return 'no_such_host'; } + sleep 2; my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { my $pingreply=reply('ping',$server); @@ -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")) { @@ -840,7 +842,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 +1545,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 +1563,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 +1807,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)) { @@ -2713,6 +2720,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) { @@ -2842,8 +2851,9 @@ sub EXT { my %resourcedata=&get('resourcedata', [$courselevelr,$courselevelm,$courselevel], $udom,$uname); - if (($resourcedata{$courselevelr}!~/^error\:/) && - ($resourcedata{$courselevelr}!~/^con_lost/)) { + my ($tmp)=keys(%resourcedata); + &Apache::lonnet::logthis("Returned $tmp: ".join(':',keys(%resourcedata))); + if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) { if ($resourcedata{$courselevelr}) { return $resourcedata{$courselevelr}; } @@ -2852,11 +2862,13 @@ sub EXT { if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } } else { - if ($resourcedata{$courselevelr}!~/No such file/) { + if ($tmp!~/No such file/) { &logthis("WARNING:". " Trying to get resource data for ". $uname." at ".$udom.": ". - $resourcedata{$courselevelr}.""); + $tmp.""); + } elsif ($tmp =~ /^(con_lost|no_such_host)/) { + return $tmp; } } @@ -3096,6 +3108,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 +3481,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 {