--- loncom/lonnet/perl/lonnet.pm 2002/05/21 13:06:07 1.229
+++ loncom/lonnet/perl/lonnet.pm 2002/08/02 21:11:55 1.260
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.229 2002/05/21 13:06:07 stredwic Exp $
+# $Id: lonnet.pm,v 1.260 2002/08/02 21:11:55 ng Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -77,10 +77,10 @@ use Apache::File;
use LWP::UserAgent();
use HTTP::Headers;
use vars
-qw(%perlvar %hostname %homecache %badhomecache %hostip %spareid %hostdom
+qw(%perlvar %hostname %homecache %badServerCache %hostip %spareid %hostdom
%libserv %pr %prp %metacache %packagetab
%courselogs %accesshash $processmarker $dumpcount
- %coursedombuf %coursehombuf %courseresdatacache);
+ %coursedombuf %coursehombuf %courseresdatacache %domaindescription);
use IO::Socket;
use GDBM_File;
use Apache::Constants qw(:common :http);
@@ -140,20 +140,20 @@ 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') {
- &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);
- }
+ #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/)) {
&logthis("<font color=blue>WARNING:".
@@ -481,25 +481,23 @@ sub authenticate {
# ---------------------- Find the homebase for a user from domain's lib servers
sub homeserver {
- my ($uname,$udom, $cacheBadFlag)=@_;
+ my ($uname,$udom,$ignoreBadCache)=@_;
my $index="$uname:$udom";
if ($homecache{$index}) {
return "$homecache{$index}";
}
my $tryserver;
foreach $tryserver (keys %libserv) {
- next if ($cacheBadFlag eq 'true' &&
- exists($badhomecache{$index}->{$tryserver}));
+ next if ($ignoreBadCache ne 'true' &&
+ exists($badServerCache{$tryserver}));
if ($hostdom{$tryserver} eq $udom) {
my $answer=reply("home:$udom:$uname",$tryserver);
if ($answer eq 'found') {
$homecache{$index}=$tryserver;
return $tryserver;
- } else {
- $badhomecache{$index}->{$tryserver}=1;
+ } elsif ($answer eq 'no_host') {
+ $badServerCache{$tryserver}=1;
}
- } else {
- $badhomecache{$index}->{$tryserver}=1;
}
}
return 'no_host';
@@ -710,6 +708,70 @@ sub ssi {
return $response->content;
}
+# ------- Add a token to a remote URI's query string to vouch for access rights
+
+sub tokenwrapper {
+ my $uri=shift;
+ $uri=~s/^http\:\/\/([^\/]+)//;
+ $uri=~s/^\///;
+ $ENV{'user.environment'}=~/\/([^\/]+)\.id/;
+ my $token=$1;
+ if ($uri=~/^uploaded\/([^\/]+)\/([^\/]+)\/([^\/]+)(\?\.*)*$/) {
+ &appenv('userfile.'.$1.'/'.$2.'/'.$3 => $ENV{'request.course.id'});
+ return 'http://'.$hostname{ &homeserver($2,$1)}.'/'.$uri.
+ (($uri=~/\?/)?'&':'?').'token='.$token;
+ } else {
+ return '/adm/notfound.html';
+ }
+}
+
+# --------------- Take an uploaded file and put it into the userfiles directory
+# input: name of form element, coursedoc=1 means this is for the course
+# output: url of file in userspace
+
+sub userfileupload {
+ my ($formname,$coursedoc)=@_;
+ my $fname=$ENV{'form.'.$formname.'.filename'};
+ $fname=~s/\\/\//g;
+ $fname=~s/^.*\/([^\/]+)$/$1/;
+ unless ($fname) { return 'error: no uploaded file'; }
+ chop($ENV{'form.'.$formname});
+# Create the directory if not present
+ my $docuname='';
+ my $docudom='';
+ my $docuhome='';
+ if ($coursedoc) {
+ $docuname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+ $docudom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+ $docuhome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'};
+ } else {
+ $docuname=$ENV{'user.name'};
+ $docudom=$ENV{'user.domain'};
+ $docuhome=$ENV{'user.home'};
+ }
+ my $path=$docudom.'/'.$docuname.'/';
+ my $filepath=$perlvar{'lonDocRoot'};
+ my @parts=split(/\//,$filepath.'/userfiles/'.$path);
+ my $count;
+ for ($count=4;$count<=$#parts;$count++) {
+ $filepath.="/$parts[$count]";
+ if ((-e $filepath)!=1) {
+ mkdir($filepath,0777);
+ }
+ }
+# Save the file
+ {
+ my $fh=Apache::File->new('>'.$filepath.'/'.$fname);
+ print $fh $ENV{'form.'.$formname};
+ }
+# Notify homeserver to grep it
+#
+# FIXME - this still needs to happen
+#
+# Return the URL to it
+ return '/uploaded/'.$path.$fname;
+}
+
# ------------------------------------------------------------------------- Log
sub log {
@@ -801,6 +863,7 @@ sub checkout {
my $now=time;
my $lonhost=$perlvar{'lonHostID'};
my $infostr=&escape(
+ 'CHECKOUTTOKEN&'.
$tuname.'&'.
$tudom.'&'.
$tcrsid.'&'.
@@ -850,7 +913,7 @@ sub checkin {
$lonhost=~tr/A-Z/a-z/;
my $dtoken=$ta.'_'.$hostip{$lonhost}.'_'.$tb;
$dtoken=~s/\W/\_/g;
- my ($tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
+ my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
unless (($tuname) && ($tudom)) {
@@ -1034,7 +1097,7 @@ sub tmpreset {
my %hash;
if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
- &GDBM_WRCREAT,0640)) {
+ &GDBM_WRCREAT(),0640)) {
foreach my $key (keys %hash) {
if ($key=~ /:$symb/) {
delete($hash{$key});
@@ -1070,7 +1133,7 @@ sub tmpstore {
my $path=$perlvar{'lonDaemons'}.'/tmp';
if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
- &GDBM_WRCREAT,0640)) {
+ &GDBM_WRCREAT(),0640)) {
$hash{"version:$symb"}++;
my $version=$hash{"version:$symb"};
my $allkeys='';
@@ -1114,7 +1177,7 @@ sub tmprestore {
my $path=$perlvar{'lonDaemons'}.'/tmp';
if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
my $version=$hash{"version:$symb"};
$returnhash{'version'}=$version;
my $scope;
@@ -1502,7 +1565,21 @@ sub allowed {
# Free bre to public access
if ($priv eq 'bre') {
- if (&metadata($uri,'copyright') eq 'public') { return 'F'; }
+ my $copyright=&metadata($uri,'copyright');
+ if ($copyright eq 'public') { return 'F'; }
+ if ($copyright eq 'priv') {
+ $uri=~/([^\/]+)\/([^\/]+)\//;
+ unless (($ENV{'user.name'} eq $2) && ($ENV{'user.domain'} eq $1)) {
+ return '';
+ }
+ }
+ if ($copyright eq 'domain') {
+ $uri=~/([^\/]+)\/([^\/]+)\//;
+ unless (($ENV{'user.domain'} eq $1) ||
+ ($ENV{'course.'.$ENV{'request.course.id'}.'.domain'} eq $1)) {
+ return '';
+ }
+ }
}
my $thisallowed='';
@@ -1550,19 +1627,16 @@ sub allowed {
# the course
if ($ENV{'request.course.id'}) {
+
$courseprivid=$ENV{'request.course.id'};
if ($ENV{'request.course.sec'}) {
$courseprivid.='/'.$ENV{'request.course.sec'};
}
$courseprivid=~s/\_/\//;
my $checkreferer=1;
- my @uriparts=split(/\//,$uri);
- my $filename=$uriparts[$#uriparts];
- my $pathname=$uri;
- $pathname=~s/\/$filename$//;
- if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
- /\&$filename\:([\d\|]+)\&/) {
- $statecond=$1;
+ my ($match,$cond)=&is_on_map($uri);
+ if ($match) {
+ $statecond=$cond;
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
=~/$priv\&([^\:]*)/) {
$thisallowed.=$1;
@@ -1572,7 +1646,6 @@ sub allowed {
if ($checkreferer) {
my $refuri=$ENV{'httpref.'.$orguri};
-
unless ($refuri) {
foreach (keys %ENV) {
if ($_=~/^httpref\..*\*/) {
@@ -1586,15 +1659,12 @@ sub allowed {
}
}
}
+
if ($refuri) {
$refuri=&declutter($refuri);
- my @uriparts=split(/\//,$refuri);
- my $filename=$uriparts[$#uriparts];
- my $pathname=$refuri;
- $pathname=~s/\/$filename$//;
- if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
- /\&$filename\:([\d\|]+)\&/) {
- my $refstatecond=$1;
+ my ($match,$cond)=&is_on_map($refuri);
+ if ($match) {
+ my $refstatecond=$cond;
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
=~/$priv\&([^\:]*)/) {
$thisallowed.=$1;
@@ -1653,7 +1723,7 @@ sub allowed {
|| ($ENV{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) {
if ($ENV{$prefix.'res.'.$uri.'.lock.expire'}>time) {
&log($ENV{'user.domain'},$ENV{'user.name'},
- $ENV{'user.host'},
+ $ENV{'user.home'},
'Locked by res: '.$priv.' for '.$uri.' due to '.
$cdom.'/'.$cnum.'/'.$csec.' expire '.
$ENV{$prefix.'priv.'.$priv.'.lock.expire'});
@@ -1664,7 +1734,7 @@ sub allowed {
|| ($ENV{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
if ($ENV{'priv.'.$priv.'.lock.expire'}>time) {
&log($ENV{'user.domain'},$ENV{'user.name'},
- $ENV{'user.host'},
+ $ENV{'user.home'},
'Locked by priv: '.$priv.' for '.$uri.' due to '.
$cdom.'/'.$cnum.'/'.$csec.' expire '.
$ENV{$prefix.'priv.'.$priv.'.lock.expire'});
@@ -1692,6 +1762,7 @@ sub allowed {
if ($thisallowed=~/C/) {
my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
+ my $unamedom=$ENV{'user.name'}.':'.$ENV{'user.domain'};
if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
=~/$rolecode/) {
&log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
@@ -1699,6 +1770,14 @@ sub allowed {
$ENV{'request.course.id'});
return '';
}
+
+ if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.users.denied'}
+ =~/$unamedom/) {
+ &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
+ 'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
+ $ENV{'request.course.id'});
+ return '';
+ }
}
# Resource preferences
@@ -1722,9 +1801,15 @@ sub allowed {
}
}
-# Restricted by state?
+# Restricted by state or randomout?
if ($thisallowed=~/X/) {
+ if ($ENV{'acc.randomout'}) {
+ my $symb=&symbread($uri,1);
+ if (($symb) && ($ENV{'acc.randomout'}=~/\&$symb\&/)) {
+ return '';
+ }
+ }
if (&condval($statecond)) {
return '2';
} else {
@@ -1735,6 +1820,23 @@ sub allowed {
return 'F';
}
+# --------------------------------------------------- Is a resource on the map?
+
+sub is_on_map {
+ my $uri=&declutter(shift);
+ my @uriparts=split(/\//,$uri);
+ my $filename=$uriparts[$#uriparts];
+ my $pathname=$uri;
+ $pathname=~s/\/$filename$//;
+ my $match=($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
+ /\&$filename\:([\d\|]+)\&/);
+ if ($match) {
+ return (1,$1);
+ } else {
+ return (0,0);
+ }
+}
+
# ----------------------------------------------------------------- Define Role
sub definerole {
@@ -1780,9 +1882,11 @@ sub definerole {
# ---------------- Make a metadata query against the network of library servers
sub metadata_query {
- my ($query,$custom,$customshow)=@_;
+ my ($query,$custom,$customshow,$server_array)=@_;
my %rhash;
- for my $server (keys %libserv) {
+ my @server_list = (defined($server_array) ? @$server_array
+ : keys(%libserv) );
+ for my $server (@server_list) {
unless ($custom or $customshow) {
my $reply=&reply("querysend:".&escape($query),$server);
$rhash{$server}=$reply;
@@ -1797,6 +1901,64 @@ sub metadata_query {
return \%rhash;
}
+# ----------------------------------------- Send log queries and wait for reply
+
+sub log_query {
+ my ($uname,$udom,$query,%filters)=@_;
+ my $uhome=&homeserver($uname,$udom);
+ if ($uhome eq 'no_host') { return 'error: no_host'; }
+ my $uhost=$hostname{$uhome};
+ my $command=&escape(join(':',map{$_.'='.$filters{$_}} keys %filters));
+ my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command,
+ $uhome);
+ unless ($queryid=~/^$uhost\_/) { return 'error: '.$queryid; }
+ return get_query_reply($queryid);
+}
+
+sub get_query_reply {
+ my $queryid=shift;
+ my $replyfile=$perlvar{'lonDaemons'}.'/tmp/'.$queryid;
+ my $reply='';
+ for (1..100) {
+ sleep 2;
+ if (-e $replyfile.'.end') {
+ if (my $fh=Apache::File->new($replyfile)) {
+ $reply.=<$fh>;
+ $fh->close;
+ } else { return 'error: reply_file_error'; }
+ return &unescape($reply);
+ }
+ }
+ return 'timeout:'.$queryid;
+}
+
+sub courselog_query {
+#
+# possible filters:
+# url: url or symb
+# username
+# domain
+# action: view, submit, grade
+# start: timestamp
+# end: timestamp
+#
+ my (%filters)=@_;
+ unless ($ENV{'request.course.id'}) { return 'no_course'; }
+ if ($filters{'url'}) {
+ $filters{'url'}=&symbclean(&declutter($filters{'url'}));
+ $filters{'url'}=~s/\.(\w+)$/(\\.\\d+)*\\.$1/;
+ $filters{'url'}=~s/\.(\w+)\_\_\_/(\\.\\d+)*\\.$1/;
+ }
+ my $cname=$ENV{'course.'.$ENV{'request.course.id'}.'.num'};
+ my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
+ return &log_query($cname,$cdom,'courselog',%filters);
+}
+
+sub userlog_query {
+ my ($uname,$udom,%filters)=@_;
+ return &log_query($uname,$udom,'userlog',%filters);
+}
+
# ------------------------------------------------------------------ Plain Text
sub plaintext {
@@ -1881,7 +2043,7 @@ sub modifyuser {
(defined($desiredhome) ? ' desiredhome = '.$desiredhome :
' desiredhome not specified').
' by '.$ENV{'user.name'}.' at '.$ENV{'user.domain'});
- my $uhome=&homeserver($uname,$udom);
+ my $uhome=&homeserver($uname,$udom,'true');
# ----------------------------------------------------------------- Create User
if (($uhome eq 'no_host') && ($umode) && ($upass)) {
my $unhome='';
@@ -1911,7 +2073,7 @@ sub modifyuser {
unless ($reply eq 'ok') {
return 'error: '.$reply;
}
- $uhome=&homeserver($uname,$udom);
+ $uhome=&homeserver($uname,$udom,'true');
if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {
return 'error: verify home';
}
@@ -2018,11 +2180,11 @@ sub createcourse {
my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
# ----------------------------------------------- Make sure that does not exist
- my $uhome=&homeserver($uname,$udom);
+ my $uhome=&homeserver($uname,$udom,'true');
unless (($uhome eq '') || ($uhome eq 'no_host')) {
$uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).
unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
- $uhome=&homeserver($uname,$udom);
+ $uhome=&homeserver($uname,$udom,'true');
unless (($uhome eq '') || ($uhome eq 'no_host')) {
return 'error: unable to generate unique course-ID';
}
@@ -2031,7 +2193,7 @@ sub createcourse {
my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
$ENV{'user.home'});
unless ($reply eq 'ok') { return 'error: '.$reply; }
- $uhome=&homeserver($uname,$udom);
+ $uhome=&homeserver($uname,$udom,'true');
if (($uhome eq '') || ($uhome eq 'no_host')) {
return 'error: no such course';
}
@@ -2068,51 +2230,74 @@ sub revokecustomrole {
# ------------------------------------------------------------ Directory lister
sub dirlist {
- my $uri=shift;
+ my ($uri,$userdomain,$username,$alternateDirectoryRoot)=@_;
+
$uri=~s/^\///;
$uri=~s/\/$//;
- my ($res,$udom,$uname,@rest)=split(/\//,$uri);
- if ($udom) {
- if ($uname) {
- my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/'.$uri,
- homeserver($uname,$udom));
- return split(/:/,$listing);
- } else {
- my $tryserver;
- my %allusers=();
- foreach $tryserver (keys %libserv) {
- if ($hostdom{$tryserver} eq $udom) {
- my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.$udom,
- $tryserver);
- if (($listing ne 'no_such_dir') && ($listing ne 'empty')
- && ($listing ne 'con_lost')) {
- foreach (split(/:/,$listing)) {
- my ($entry,@stat)=split(/&/,$_);
- $allusers{$entry}=1;
+ my ($udom, $uname);
+ (undef,$udom,$uname)=split(/\//,$uri);
+ if(defined($userdomain)) {
+ $udom = $userdomain;
+ }
+ if(defined($username)) {
+ $uname = $username;
+ }
+
+ my $dirRoot = $perlvar{'lonDocRoot'};
+ if(defined($alternateDirectoryRoot)) {
+ $dirRoot = $alternateDirectoryRoot;
+ $dirRoot =~ s/\/$//;
+ }
+
+ if($udom) {
+ if($uname) {
+ my $listing=reply('ls:'.$dirRoot.'/'.$uri,
+ homeserver($uname,$udom));
+ return split(/:/,$listing);
+ } elsif(!defined($alternateDirectoryRoot)) {
+ my $tryserver;
+ my %allusers=();
+ foreach $tryserver (keys %libserv) {
+ if($hostdom{$tryserver} eq $udom) {
+ my $listing=reply('ls:'.$perlvar{'lonDocRoot'}.'/res/'.
+ $udom, $tryserver);
+ if (($listing ne 'no_such_dir') && ($listing ne 'empty')
+ && ($listing ne 'con_lost')) {
+ foreach (split(/:/,$listing)) {
+ my ($entry,@stat)=split(/&/,$_);
+ $allusers{$entry}=1;
+ }
+ }
}
- }
- }
- }
- my $alluserstr='';
- foreach (sort keys %allusers) {
- $alluserstr.=$_.'&user:';
- }
- $alluserstr=~s/:$//;
- return split(/:/,$alluserstr);
- }
- } else {
- my $tryserver;
- my %alldom=();
- foreach $tryserver (keys %libserv) {
- $alldom{$hostdom{$tryserver}}=1;
- }
- my $alldomstr='';
- foreach (sort keys %alldom) {
- $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
- }
- $alldomstr=~s/:$//;
- return split(/:/,$alldomstr);
- }
+ }
+ my $alluserstr='';
+ foreach (sort keys %allusers) {
+ $alluserstr.=$_.'&user:';
+ }
+ $alluserstr=~s/:$//;
+ return split(/:/,$alluserstr);
+ } else {
+ my @emptyResults = ();
+ push(@emptyResults, 'missing user name');
+ return split(':',@emptyResults);
+ }
+ } elsif(!defined($alternateDirectoryRoot)) {
+ my $tryserver;
+ my %alldom=();
+ foreach $tryserver (keys %libserv) {
+ $alldom{$hostdom{$tryserver}}=1;
+ }
+ my $alldomstr='';
+ foreach (sort keys %alldom) {
+ $alldomstr.=$perlvar{'lonDocRoot'}.'/res/'.$_.'&domain:';
+ }
+ $alldomstr=~s/:$//;
+ return split(/:/,$alldomstr);
+ } else {
+ my @emptyResults = ();
+ push(@emptyResults, 'missing domain');
+ return split(':',@emptyResults);
+ }
}
# -------------------------------------------------------- Value of a Condition
@@ -2173,30 +2358,26 @@ sub courseresdata {
my ($coursenum,$coursedomain,@which)=@_;
my $coursehom=&homeserver($coursenum,$coursedomain);
my $hashid=$coursenum.':'.$coursedomain;
- unless (defined($courseresdatacache{$hashid.'.time'})) {
- unless (time-$courseresdatacache{$hashid.'.time'}<300) {
- my $coursehom=&homeserver($coursenum,$coursedomain);
- if ($coursehom) {
- my $dumpreply=&reply('dump:'.$coursedomain.':'.$coursenum.
- ':resourcedata:.',$coursehom);
- unless ($dumpreply=~/^error\:/) {
- $courseresdatacache{$hashid.'.time'}=time;
- $courseresdatacache{$hashid}=$dumpreply;
- }
- }
- }
+ my $dodump=0;
+ if (!defined($courseresdatacache{$hashid.'.time'})) {
+ $dodump=1;
+ } else {
+ if (time-$courseresdatacache{$hashid.'.time'}>300) { $dodump=1; }
}
- my @pairs=split(/\&/,$courseresdatacache{$hashid});
- my %returnhash=();
- foreach (@pairs) {
- my ($key,$value)=split(/=/,$_);
- $returnhash{unescape($key)}=unescape($value);
- }
- my $item;
- foreach $item (@which) {
- if ($returnhash{$item}) { return $returnhash{$item}; }
- }
- return '';
+ if ($dodump) {
+ my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
+ my ($tmp) = keys(%dumpreply);
+ if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+ $courseresdatacache{$hashid.'.time'}=time;
+ $courseresdatacache{$hashid}=\%dumpreply;
+ }
+ }
+ foreach my $item (@which) {
+ if ($courseresdatacache{$hashid}->{$item}) {
+ return $courseresdatacache{$hashid}->{$item};
+ }
+ }
+ return '';
}
# --------------------------------------------------------- Value of a Variable
@@ -2269,7 +2450,11 @@ sub EXT {
my %reply=&get($space,[$item]);
return $reply{$item};
}
- } elsif ($realm eq 'request') {
+ } elsif ($realm eq 'query') {
+# ---------------------------------------------- pull stuff out of query string
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]);
+ return $ENV{'form.'.$space};
+ } elsif ($realm eq 'request') {
# ------------------------------------------------------------- request.browser
if ($space eq 'browser') {
return $ENV{'browser.'.$qualifier};
@@ -2297,7 +2482,7 @@ sub EXT {
my $section;
if (($ENV{'user.name'} eq $uname) &&
($ENV{'user.domain'} eq $udom)) {
- $section={'request.course.sec'};
+ $section=$ENV{'request.course.sec'};
} else {
$section=&usection($udom,$uname,$courseid);
}
@@ -2346,7 +2531,7 @@ sub EXT {
my $thisparm='';
if (tie(%parmhash,'GDBM_File',
$ENV{'request.course.fn'}.'_parms.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
$thisparm=$parmhash{$symbparm};
untie(%parmhash);
}
@@ -2533,7 +2718,7 @@ sub symblist {
my %hash;
if (($ENV{'request.course.fn'}) && (%newhash)) {
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
- &GDBM_WRCREAT,0640)) {
+ &GDBM_WRCREAT(),0640)) {
foreach (keys %newhash) {
$hash{declutter($_)}=$mapname.'___'.$newhash{$_};
}
@@ -2561,7 +2746,7 @@ sub symbverify {
my %bighash;
my $okay=0;
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
my $ids=$bighash{'ids_/res/'.$thisfn};
unless ($ids) {
$ids=$bighash{'ids_/'.$thisfn};
@@ -2599,18 +2784,23 @@ sub symbclean {
# ------------------------------------------------------ Return symb list entry
sub symbread {
- my $thisfn=shift;
+ my ($thisfn,$donotrecurse)=@_;
+# no filename provided? try from environment
unless ($thisfn) {
if ($ENV{'request.symb'}) { return &symbclean($ENV{'request.symb'}); }
$thisfn=$ENV{'request.filename'};
}
+# is that filename actually a symb? Verify, clean, and return
+ if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
+ if (&symbverify($thisfn,$1)) { return &symbclean($thisfn); }
+ }
$thisfn=declutter($thisfn);
my %hash;
my %bighash;
my $syval='';
if (($ENV{'request.course.fn'}) && ($thisfn)) {
if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
$syval=$hash{$thisfn};
untie(%hash);
}
@@ -2626,12 +2816,16 @@ sub symbread {
} else {
# ------------------------------------------------------- Was not in symb table
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
- &GDBM_READER,0640)) {
+ &GDBM_READER(),0640)) {
# ---------------------------------------------- Get ID(s) for current resource
my $ids=$bighash{'ids_/res/'.$thisfn};
unless ($ids) {
$ids=$bighash{'ids_/'.$thisfn};
}
+ unless ($ids) {
+# alias?
+ $ids=$bighash{'mapalias_'.$thisfn};
+ }
if ($ids) {
# ------------------------------------------------------------------- Has ID(s)
my @possibilities=split(/\,/,$ids);
@@ -2639,7 +2833,7 @@ sub symbread {
# ----------------------------------------------- There is only one possibility
my ($mapid,$resid)=split(/\./,$ids);
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;
- } else {
+ } elsif (!$donotrecurse) {
# ------------------------------------------ There is more than one possibility
my $realpossible=0;
foreach (@possibilities) {
@@ -2654,6 +2848,8 @@ sub symbread {
}
}
if ($realpossible!=1) { $syval=''; }
+ } else {
+ $syval='';
}
}
untie(%bighash)
@@ -2722,10 +2918,10 @@ sub ireceipt {
}
sub receipt {
- return &ireceipt($ENV{'user.name'},$ENV{'user.domain'},
- $ENV{'request.course.id'},&symbread());
+ my ($symb,$courseid,$domain,$name) = &Apache::lonxml::whichuser();
+ return &ireceipt($name,$domain,$courseid,$symb);
}
-
+
# ------------------------------------------------------------ Serves up a file
# returns either the contents of the file or a -1
sub getfile {
@@ -2778,6 +2974,7 @@ sub declutter {
$thisfn=~s/^$perlvar{'lonDocRoot'}//;
$thisfn=~s/^\///;
$thisfn=~s/^res\///;
+ $thisfn=~s/\?.+$//;
return $thisfn;
}
@@ -2837,11 +3034,18 @@ BEGIN {
while (my $configline=<$config>) {
chomp($configline);
- my ($id,$domain,$role,$name,$ip)=split(/:/,$configline);
- $hostname{$id}=$name;
- $hostdom{$id}=$domain;
- $hostip{$id}=$ip;
- if ($role eq 'library') { $libserv{$id}=$name; }
+ my ($id,$domain,$role,$name,$ip,$domdescr)=split(/:/,$configline);
+ if ($id && $domain && $role && $name && $ip) {
+ $hostname{$id}=$name;
+ $hostdom{$id}=$domain;
+ $hostip{$id}=$ip;
+ if ($domdescr) { $domaindescription{$domain}=$domdescr; }
+ if ($role eq 'library') { $libserv{$id}=$name; }
+ } else {
+ if ($configline) {
+ &logthis("Skipping hosts.tab line -$configline-");
+ }
+ }
}
}
@@ -2911,75 +3115,105 @@ $readit=1;
1;
__END__
+=pod
+
=head1 NAME
-Apache::lonnet - TCP networking package
+Apache::lonnet - Subroutines to ask questions about things in the network.
=head1 SYNOPSIS
-Invoked by other LON-CAPA modules.
+Invoked by other LON-CAPA modules, when they need to talk to or about objects in the network.
&Apache::lonnet::SUBROUTINENAME(ARGUMENTS);
+Common parameters:
+
+=over 4
+
+=item *
+
+$uname : an internal username (if $cname expecting a course Id specifically)
+
+=item *
+
+$udom : a domain (if $cdom expecting a course's domain specifically)
+
+=item *
+
+$symb : a resource instance identifier
+
+=item *
+
+$namespace : the name of a .db file that contains the data needed or
+being set.
+
+=back
+
=head1 INTRODUCTION
This module provides subroutines which interact with the
-lonc/lond (TCP) network layer of LON-CAPA.
+lonc/lond (TCP) network layer of LON-CAPA. And Can be used to ask about
+- classes
+- users
+- resources
+
+For many of these objects you can also use this to store data about
+them or modify them in various ways.
This is part of the LearningOnline Network with CAPA project
described at http://www.lon-capa.org.
-=head1 HANDLER SUBROUTINE
-
-There is no handler routine for this module.
-
-=head1 OTHER SUBROUTINES
+=head1 RETURN MESSAGES
=over 4
=item *
-logtouch() : make sure the logfile, lonnet.log, exists
+con_lost : unable to contact remote host
=item *
-logthis() : append message to lonnet.log
+con_delayed : unable to contact remote host, message will be delivered
+when the connection is brought back up
=item *
-logperm() : append a permanent message to lonnet.perm.log
+con_failed : unable to contact remote host and unable to save message
+for later delivery
=item *
-subreply() : non-critical communication, called by &reply
+error: : an error a occured, a description of the error follows the :
=item *
-reply() : makes two attempts to pass message; logs refusals and rejections
+no_such_host : unable to fund a host associated with the user/domain
+that was requested
-=item *
+=back
-reconlonc() : tries to reconnect lonc client processes.
+=head1 PUBLIC SUBROUTINES
-=item *
+=head2 Session Environment Functions
-critical() : passes a critical message to another server; if cannot get
-through then place message in connection buffer
+=over 4
=item *
-appenv(%hash) : read in current user environment, append new environment
-values to make new user environment
+appenv(%hash) : the value of %hash is written to the user envirnoment
+file, and will be restored for each access this user makes during this
+session, also modifies the %ENV for the current process
=item *
-delenv($varname) : read in current user environment, remove all values
-beginning with $varname, write new user environment (note: flock is used
-to prevent conflicting shared read/writes with file)
+delenv($regexp) : removes all items from the session environment file that matches the regular expression in $regexp. The values are also delted from the current processes %ENV.
-=item *
+=back
-spareserver() : find server with least workload from spare.tab
+=head2 User Information
+
+=over 4
=item *
@@ -2989,16 +3223,19 @@ authentication scheme
=item *
authenticate($uname,$upass,$udom) : try to authenticate user from domain's lib
-servers (first use the current one)
+servers (first use the current one), $upass should be the users password
=item *
-homeserver($uname,$udom) : find the homebase for a user from domain's lib
-servers
+homeserver($uname,$udom) : find the server which has the user's
+directory and files (there must be only one), this caches the answer,
+and also caches if there is a borken connection.
=item *
-idget($udom,@ids) : find the usernames behind a list of IDs (returns hash:
+idget($udom,@ids) : find the usernames behind a list of IDs (IDs are a
+unique resource in a domain, there must be only 1 ID per username, and
+only 1 username per ID in a specific domain) (returns hash:
id=>name,id=>name)
=item *
@@ -3012,226 +3249,332 @@ idput($udom,%ids) : store away a list of
=item *
-usection($domain,$user,$courseid) : output of section name/number or '' for
-"not in course" and '-1' for "no section"
+rolesinit($udom,$username,$authhost) : get user privileges
=item *
-userenvironment($domain,$user,$what) : puts out any environment parameter
-for a user
+usection($udom,$uname,$cname) : finds the section of student in the
+course $cname, return section name/number or '' for "not in course"
+and '-1' for "no section"
=item *
-subscribe($fname) : subscribe to a resource, return URL if possible
+userenvironment($udom,$uname,@what) : gets the values of the keys
+passed in @what from the requested user's environment, returns a hash
+
+=back
+
+=head2 User Roles
+
+=over 4
=item *
-repcopy($filename) : replicate file
+allowed($priv,$uri) : check for a user privilege; returns codes for allowed
+actions
+ F: full access
+ U,I,K: authentication modes (cxx only)
+ '': forbidden
+ 1: user needs to choose course
+ 2: browse allowed
=item *
-ssi($url,%hash) : server side include, does a complete request cycle on url to
-localhost, posts hash
+definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom
+role rolename set privileges in format of lonTabs/roles.tab for system, domain,
+and course level
=item *
-log($domain,$name,$home,$message) : write to permanent log for user; use
-critical subroutine
+plaintext($short) : return value in %prp hash (rolesplain.tab); plain text
+explanation of a user role term
+
+=back
+
+=head2 User Modification
+
+=over 4
=item *
-flushcourselogs() : flush (save) buffer logs and access logs
+assignrole($udom,$uname,$url,$role,$end,$start) : assign role; give a role to a
+user for the level given by URL. Optional start and end dates (leave empty
+string or zero for "no date")
=item *
-courselog($what) : save message for course in hash
+changepass($uname,$udom,$currentpass,$newpass,$server) : attempts to
+change a users, password, possible return values are: ok,
+pwchange_failure, non_authorized, auth_mode_error, unknown_user,
+refused
=item *
-courseacclog($what) : save message for course using &courselog(). Perform
-special processing for specific resource types (problems, exams, quizzes, etc).
+modifyuserauth($udom,$uname,$umode,$upass) : modify user authentication
=item *
-countacc($url) : count the number of accesses to a given URL
+modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene) :
+modify user
=item *
-sub checkout($symb,$tuname,$tudom,$tcrsid) : check out an item
+modifystudent($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,$end,$start) : modify student
=item *
-sub checkin($token) : check in an item
+assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start) : assign
+custom role; give a custom role to a user for the level given by URL. Specify
+name and domain of role author, and role name
=item *
-sub expirespread($uname,$udom,$stype,$usymb) : set expire date for spreadsheet
+revokerole($udom,$uname,$url,$role) : revoke a role for url
=item *
-devalidate($symb) : devalidate spreadsheets
+revokecustomrole($udom,$uname,$url,$role) : revoke a custom role
+
+=back
+
+=head2 Course Infomation
+
+=over 4
=item *
-hash2str(%hash) : convert a hash into a string complete with escaping and '='
-and '&' separators, supports elements that are arrayrefs and hashrefs
+coursedescription($courseid) : course description
=item *
-hashref2str($hashref) : convert a hashref into a string complete with
-escaping and '=' and '&' separators, supports elements that are
-arrayrefs and hashrefs
+courseresdata($coursenum,$coursedomain,@which) : request for current
+parameter setting for a specific course, @what should be a list of
+parameters to ask about. This routine caches answers for 5 minutes.
+
+=back
+
+=head2 Course Modification
+
+=over 4
=item *
-arrayref2str($arrayref) : convert an arrayref into a string complete
-with escaping and '&' separators, supports elements that are arrayrefs
-and hashrefs
+writecoursepref($courseid,%prefs) : write preferences (environment
+database) for a course
=item *
-str2hash($string) : convert string to hash using unescaping and
-splitting on '=' and '&', supports elements that are arrayrefs and
-hashrefs
+createcourse($udom,$description,$url) : make/modify course
+
+=back
+
+=head2 Resource Subroutines
+
+=over 4
=item *
-str2array($string) : convert string to hash using unescaping and
-splitting on '&', supports elements that are arrayrefs and hashrefs
+subscribe($fname) : subscribe to a resource, returns URL if possible (probably should use repcopy instead)
+
+=item *
+
+repcopy($filename) : subscribes to the requested file, and attempts to
+replicate from the owning library server, Might return
+HTTP_SERVICE_UNAVAILABLE, HTTP_NOT_FOUND, FORBIDDEN, OK, or
+HTTP_BAD_REQUEST, also attempts to grab the metadata for the
+resource. Expects the local filesystem pathname
+(/home/httpd/html/res/....)
+
+=back
+
+=head2 Resource Information
+
+=over 4
=item *
-tmpreset($symb,$namespace,$domain,$stuname) : temporary storage
+EXT($varname,$symb,$udom,$uname) : evaluates and returns the value of
+a vairety of different possible values, $varname should be a request
+string, and the other parameters can be used to specify who and what
+one is asking about.
+
+Possible values for $varname are environment.lastname (or other item
+from the envirnment hash), user.name (or someother aspect about the
+user), resource.0.maxtries (or some other part and parameter of a
+resource)
=item *
-tmprestore($symb,$namespace,$domain,$stuname) : temporary restore
+directcondval($number) : get current value of a condition; reads from a state
+string
=item *
-store($storehash,$symb,$namespace,$domain,$stuname) : stores hash permanently
-for this url; hashref needs to be given and should be a \%hashname; the
-remaining args aren't required and if they aren't passed or are '' they will
-be derived from the ENV
+condval($condidx) : value of condition index based on state
=item *
-cstore($storehash,$symb,$namespace,$domain,$stuname) : same as store but
-uses critical subroutine
+metadata($uri,$what,$liburi,$prefix,$depthcount) : request a
+resource's metadata, $what should be either a specific key, or either
+'keys' (to get a list of possible keys) or 'packages' to get a list of
+packages that this resource currently uses, the last 3 arguments are only used internally for recursive metadata.
+
+this function automatically caches all requests
=item *
-restore($symb,$namespace,$domain,$stuname) : returns hash for this symb;
-all args are optional
+metadata_query($query,$custom,$customshow) : make a metadata query against the
+network of library servers; returns file handle of where SQL and regex results
+will be stored for query
=item *
-coursedescription($courseid) : course description
+symbread($filename) : return symbolic list entry (filename argument optional);
+returns the data handle
=item *
-rolesinit($domain,$username,$authhost) : get user privileges
+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
+failure, user must be in a course, as it assumes the existance of the
+course initi hash, and uses $ENV('request.course.id'}
+
=item *
-get($namespace,$storearr,$udomain,$uname) : returns hash with keys from array
-reference filled in from namesp ($udomain and $uname are optional)
+symbclean($symb) : removes versions numbers from a symb, returns the
+cleaned symb
=item *
-del($namespace,$storearr,$udomain,$uname) : deletes keys out of array from
-namesp ($udomain and $uname are optional)
+is_on_map($uri) : checks if the $uri is somewhere on the current
+course map, user must be in a course for it to work.
=item *
-dump($namespace,$udomain,$uname,$regexp) :
-dumps the complete (or key matching regexp) namespace into a hash
-($udomain, $uname and $regexp are optional)
+numval($salt) : return random seed value (addend for rndseed)
=item *
-put($namespace,$storehash,$udomain,$uname) : stores hash in namesp
-($udomain and $uname are optional)
+rndseed($symb,$courseid,$udom,$uname) : create a random sum; returns
+a random seed, all arguments are optional, if they aren't sent it uses the
+environment to derive them. Note: if symb isn't sent and it can't get one
+from &symbread it will use the current time as its return value
=item *
-cput($namespace,$storehash,$udomain,$uname) : critical put
-($udomain and $uname are optional)
+ireceipt($funame,$fudom,$fucourseid,$fusymb) : return unique,
+unfakeable, receipt
=item *
-eget($namespace,$storearr,$udomain,$uname) : returns hash with keys from array
-reference filled in from namesp (encrypts the return communication)
-($udomain and $uname are optional)
+receipt() : API to ireceipt working off of ENV values; given out to users
=item *
-allowed($priv,$uri) : check for a user privilege; returns codes for allowed
-actions
- F: full access
- U,I,K: authentication modes (cxx only)
- '': forbidden
- 1: user needs to choose course
- 2: browse allowed
+countacc($url) : count the number of accesses to a given URL
=item *
-definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom
-role rolename set privileges in format of lonTabs/roles.tab for system, domain,
-and course level
+checkout($symb,$tuname,$tudom,$tcrsid) : creates a record of a user having looked at an item, most likely printed out or otherwise using a resource
=item *
-metadata_query($query,$custom,$customshow) : make a metadata query against the
-network of library servers; returns file handle of where SQL and regex results
-will be stored for query
+checkin($token) : updates that a resource has beeen returned (a hard copy version for instance) and returns the data that $token was Checkout with ($symb, $tuname, $tudom, and $tcrsid)
=item *
-plaintext($short) : return value in %prp hash (rolesplain.tab); plain text
-explanation of a user role term
+expirespread($uname,$udom,$stype,$usymb) : set expire date for spreadsheet
=item *
-assignrole($udom,$uname,$url,$role,$end,$start) : assign role; give a role to a
-user for the level given by URL. Optional start and end dates (leave empty
-string or zero for "no date")
+devalidate($symb) : devalidate temporary spreadsheet calculations,
+forcing spreadsheet to reevaluate the resource scores next time.
+
+=back
+
+=head2 Storing/Retreiving Data
+
+=over 4
=item *
-modifyuserauth($udom,$uname,$umode,$upass) : modify user authentication
+store($storehash,$symb,$namespace,$udom,$uname) : stores hash permanently
+for this url; hashref needs to be given and should be a \%hashname; the
+remaining args aren't required and if they aren't passed or are '' they will
+be derived from the ENV
=item *
-modifyuser($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene) :
-modify user
+cstore($storehash,$symb,$namespace,$udom,$uname) : same as store but
+uses critical subroutine
=item *
-modifystudent($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
-$end,$start) : modify student
+restore($symb,$namespace,$udom,$uname) : returns hash for this symb;
+all args are optional
=item *
-writecoursepref($courseid,%prefs) : write preferences for a course
+tmpstore($storehash,$symb,$namespace,$udom,$uname) : storage that
+works very similar to store/cstore, but all data is stored in a
+temporary location and can be reset using tmpreset, $storehash should
+be a hash reference, returns nothing on success
=item *
-createcourse($udom,$description,$url) : make/modify course
+tmprestore($symb,$namespace,$udom,$uname) : storage that works very
+similar to restore, but all data is stored in a temporary location and
+can be reset using tmpreset. Returns a hash of values on success,
+error string otherwise.
=item *
-assigncustomrole($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start) : assign
-custom role; give a custom role to a user for the level given by URL. Specify
-name and domain of role author, and role name
+tmpreset($symb,$namespace,$udom,$uname) : temporary storage reset,
+deltes all keys for $symb form the temporary storage hash.
=item *
-revokerole($udom,$uname,$url,$role) : revoke a role for url
+get($namespace,$storearr,$udom,$uname) : returns hash with keys from array
+reference filled in from namesp ($udom and $uname are optional)
=item *
-revokecustomrole($udom,$uname,$url,$role) : revoke a custom role
+del($namespace,$storearr,$udom,$uname) : deletes keys out of array from
+namesp ($udom and $uname are optional)
+
+=item *
+
+dump($namespace,$udom,$uname,$regexp) :
+dumps the complete (or key matching regexp) namespace into a hash
+($udom, $uname and $regexp are optional)
+
+=item *
+
+put($namespace,$storehash,$udom,$uname) : stores hash in namesp
+($udom and $uname are optional)
+
+=item *
+
+cput($namespace,$storehash,$udom,$uname) : critical put
+($udom and $uname are optional)
+
+=item *
+
+eget($namespace,$storearr,$udom,$uname) : returns hash with keys from array
+reference filled in from namesp (encrypts the return communication)
+($udom and $uname are optional)
+
+=item *
+
+log($udom,$name,$home,$message) : write to permanent log for user; use
+critical subroutine
+
+=back
+
+=head2 Network Status Functions
+
+=over 4
=item *
@@ -3239,60 +3582,94 @@ dirlist($uri) : return directory list ba
=item *
-directcondval($number) : get current value of a condition; reads from a state
-string
+spareserver() : find server with least workload from spare.tab
+
+=back
+
+=head2 Apache Request
+
+=over 4
=item *
-condval($condidx) : value of condition index based on state
+ssi($url,%hash) : server side include, does a complete request cycle on url to
+localhost, posts hash
+
+=back
+
+=head2 Data to String to Data
+
+=over 4
=item *
-EXT($varname,$symbparm) : value of a variable
+hash2str(%hash) : convert a hash into a string complete with escaping and '='
+and '&' separators, supports elements that are arrayrefs and hashrefs
=item *
-metadata($uri,$what,$liburi,$prefix,$depthcount) : get metadata; returns the
-metadata entry for a file; entry='keys', returns a comma separated list of keys
+hashref2str($hashref) : convert a hashref into a string complete with
+escaping and '=' and '&' separators, supports elements that are
+arrayrefs and hashrefs
=item *
-symblist($mapname,%newhash) : update symbolic storage links
+arrayref2str($arrayref) : convert an arrayref into a string complete
+with escaping and '&' separators, supports elements that are arrayrefs
+and hashrefs
=item *
-symbread($filename) : return symbolic list entry (filename argument optional);
-returns the data handle
+str2hash($string) : convert string to hash using unescaping and
+splitting on '=' and '&', supports elements that are arrayrefs and
+hashrefs
=item *
-numval($salt) : return random seed value (addend for rndseed)
+str2array($string) : convert string to hash using unescaping and
+splitting on '&', supports elements that are arrayrefs and hashrefs
+
+=back
+
+=head2 Logging Routines
+
+=over 4
+
+These routines allow one to make log messages in the lonnet.log and
+lonnet.perm logfiles.
=item *
-rndseed($symb,$courseid,$domain,$username) : create a random sum; returns
-a random seed, all arguments are optional, if they aren't sent it uses the
-environment to derive them. Note: if symb isn't sent and it can't get one
-from &symbread it will use the current time as its return value
+logtouch() : make sure the logfile, lonnet.log, exists
=item *
-ireceipt($funame,$fudom,$fucourseid,$fusymb) : return unique,
-unfakeable, receipt
+logthis() : append message to the normal lonnet.log file, it gets
+preiodically rolled over and deleted.
=item *
-receipt() : API to ireceipt working off of ENV values; given out to users
+logperm() : append a permanent message to lonnet.perm.log, this log
+file never gets deleted by any automated portion of the system, only
+messages of critical importance should go in here.
+
+=back
+
+=head2 General File Helper Routines
+
+=over 4
=item *
-getfile($file) : serves up a file, returns the contents of a file or -1;
-replicates and subscribes to the file
+getfile($file) : returns the entire contents of a file or -1; it
+properly subscribes to and replicates the file if neccessary.
=item *
-filelocation($dir,$file) : returns file system location of a file based on URI;
-meant to be "fairly clean" absolute reference, $dir is a directory that relative $file lookups are to looked in ($dir of /a/dir and a file of ../bob will become /a/bob)
+filelocation($dir,$file) : returns file system location of a file
+based on URI; meant to be "fairly clean" absolute reference, $dir is a
+directory that relative $file lookups are to looked in ($dir of /a/dir
+and a file of ../bob will become /a/bob)
=item *
@@ -3303,6 +3680,12 @@ filelocation except for hrefs
declutter() : declutters URLs (remove docroot, beginning slashes, 'res' etc)
+=back
+
+=head2 HTTP Helper Routines
+
+=over 4
+
=item *
escape() : unpack non-word characters into CGI-compatible hex codes
@@ -3311,6 +3694,52 @@ escape() : unpack non-word characters in
unescape() : pack CGI-compatible hex codes into actual non-word ASCII character
+=back
+
+=head1 PRIVATE SUBROUTINES
+
+=head2 Underlying communication routines (Shouldn't call)
+
+=over 4
+
+=item *
+
+subreply() : tries to pass a message to lonc, returns con_lost if incapable
+
+=item *
+
+reply() : uses subreply to send a message to remote machine, logs all failures
+
+=item *
+
+critical() : passes a critical message to another server; if cannot
+get through then place message in connection buffer directory and
+returns con_delayed, if incapable of saving message, returns
+con_failed
+
+=item *
+
+reconlonc() : tries to reconnect lonc client processes.
+
+=back
+
+=head2 Resource Access Logging
+
+=over 4
+
+=item *
+
+flushcourselogs() : flush (save) buffer logs and access logs
+
+=item *
+
+courselog($what) : save message for course in hash
+
+=item *
+
+courseacclog($what) : save message for course using &courselog(). Perform
+special processing for specific resource types (problems, exams, quizzes, etc).
+
=item *
goodbye() : flush course logs and log shutting down; it is called in srm.conf
@@ -3318,4 +3747,14 @@ as a PerlChildExitHandler
=back
+=head2 Other
+
+=over 4
+
+=item *
+
+symblist($mapname,%newhash) : update symbolic storage links
+
+=back
+
=cut