--- loncom/lonnet/perl/lonnet.pm 2001/08/20 23:28:43 1.155
+++ loncom/lonnet/perl/lonnet.pm 2001/10/16 08:53:19 1.164
@@ -118,6 +118,7 @@
# 05/01,06/01,09/01 Gerd Kortemeyer
# 09/01 Guy Albertelli
# 09/01,10/01,11/01 Gerd Kortemeyer
+# YEAR=2001
# 02/27/01 Scott Harrison
# 3/2 Gerd Kortemeyer
# 3/15,3/19 Scott Harrison
@@ -127,7 +128,10 @@
# 5/30 H. K. Ng
# 6/1 Gerd Kortemeyer
# July Guy Albertelli
-# 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20 Gerd Kortemeyer
+# 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26,
+# 10/2 Gerd Kortemeyer
+# 10/5,10/10 Scott Harrison
+# 10/15 Gerd Kortemeyer
package Apache::lonnet;
@@ -136,7 +140,7 @@ use Apache::File;
use LWP::UserAgent();
use HTTP::Headers;
use vars
-qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab);
+qw(%perlvar %hostname %homecache %hostip %spareid %hostdom %libserv %pr %prp %fe %fd $readit %metacache %packagetab %courselogs);
use IO::Socket;
use GDBM_File;
use Apache::Constants qw(:common :http);
@@ -145,6 +149,16 @@ use Fcntl qw(:flock);
# --------------------------------------------------------------------- Logging
+sub logtouch {
+ my $execdir=$perlvar{'lonDaemons'};
+ unless (-e "$execdir/logs/lonnet.log") {
+ my $fh=Apache::File->new(">>$execdir/logs/lonnet.log");
+ close $fh;
+ }
+ my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3];
+ chown($wwwuid,$wwwgid,$execdir.'/logs/lonnet.log');
+}
+
sub logthis {
my $message=shift;
my $execdir=$perlvar{'lonDaemons'};
@@ -665,6 +679,56 @@ sub log {
return critical("log:$dom:$nam:$what",$hom);
}
+# ------------------------------------------------------------------ Course Log
+
+sub flushcourselogs {
+ &logthis('Flushing course log buffers');
+ map {
+ my $crsid=$_;
+ if (&reply('log:'.$ENV{'course.'.$crsid.'.domain'}.':'.
+ $ENV{'course.'.$crsid.'.num'}.':'.
+ &escape($courselogs{$crsid}),
+ $ENV{'course.'.$crsid.'.home'}) eq 'ok') {
+ delete $courselogs{$crsid};
+ } else {
+ &logthis('Failed to flush log buffer for '.$crsid);
+ if (length($courselogs{$crsid})>40000) {
+ &logthis("WARNING: Buffer for ".$crsid.
+ " exceeded maximum size, deleting.");
+ delete $courselogs{$crsid};
+ }
+ }
+ } keys %courselogs;
+}
+
+sub courselog {
+ my $what=shift;
+ $what=time.':'.$what;
+ unless ($ENV{'request.course.id'}) { return ''; }
+ if (defined $courselogs{$ENV{'request.course.id'}}) {
+ $courselogs{$ENV{'request.course.id'}}.='&'.$what;
+ } else {
+ $courselogs{$ENV{'request.course.id'}}.=$what;
+ }
+ if (length($courselogs{$ENV{'request.course.id'}})>4048) {
+ &flushcourselogs();
+ }
+}
+
+sub courseacclog {
+ my $fnsymb=shift;
+ unless ($ENV{'request.course.id'}) { return ''; }
+ my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'};
+ if ($what=~/(problem|exam|quiz|assess|survey|form)$/) {
+ map {
+ if ($_=~/^form\.(.*)/) {
+ $what.=':'.$1.'='.$ENV{$_};
+ }
+ } keys %ENV;
+ }
+ &courselog($what);
+}
+
# ----------------------------------------------------------- Check out an item
sub checkout {
@@ -1137,6 +1201,12 @@ sub allowed {
return 'F';
}
+# Free bre to public access
+
+ if ($priv eq 'bre') {
+ if (&metadata($uri,'copyright') eq 'public') { return 'F'; }
+ }
+
my $thisallowed='';
my $statecond=0;
my $courseprivid='';
@@ -1209,6 +1279,7 @@ sub allowed {
map {
if ($_=~/^httpref\..*\*/) {
my $pattern=$_;
+ $pattern=~s/^httpref\.\/res\///;
$pattern=~s/\*/\[\^\/\]\+/g;
$pattern=~s/\//\\\//g;
if ($orguri=~/$pattern/) {
@@ -1575,7 +1646,7 @@ sub modifystudent {
return 'error: no such user';
}
# -------------------------------------------------- Add student to course list
- my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
+ $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
$ENV{'course.'.$cid.'.num'}.':classlist:'.
&escape($uname.':'.$udom).'='.
&escape($end.':'.$start),
@@ -1640,7 +1711,7 @@ sub createcourse {
my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::',
$ENV{'user.home'});
unless ($reply eq 'ok') { return 'error: '.$reply; }
- my $uhome=&homeserver($uname,$udom);
+ $uhome=&homeserver($uname,$udom);
if (($uhome eq '') || ($uhome eq 'no_host')) {
return 'error: no such course';
}
@@ -1840,10 +1911,6 @@ sub EXT {
$spacequalifierrest};
} elsif ($realm eq 'resource') {
if ($ENV{'request.course.id'}) {
-
-# print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
-
-
# ----------------------------------------------------- Cascading lookup scheme
my $symbp;
if ($symbparm) {
@@ -1941,7 +2008,7 @@ sub EXT {
# ------------------------------------------------------------------ Cascade up
unless ($space eq '0') {
- my ($part,$id)=split(/\_/,$space);
+ my ($part,$id)=split(/(\.|\_)/,$space);
if ($id) {
my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest,
$symbparm);
@@ -1990,7 +2057,7 @@ sub metadata {
$keyroot.='_'.$token->[2]->{'part'};
}
if (defined($token->[2]->{'id'})) {
- $keyroot.='_'.$token->[2]->{'id'};
+ $keyroot.='.'.$token->[2]->{'id'};
}
if ($metacache{$uri.':packages'}) {
$metacache{$uri.':packages'}.=','.$package.$keyroot;
@@ -2003,6 +2070,7 @@ sub metadata {
my $value=$packagetab{$_};
my $part=$keyroot;
$part=~s/^\_//;
+ $part=~s/\./\_/g;
if ($subp eq 'display') {
$value.=' [Part: '.$part.']';
}
@@ -2022,7 +2090,7 @@ sub metadata {
$unikey.='_'.$token->[2]->{'part'};
}
if (defined($token->[2]->{'id'})) {
- $unikey.='_'.$token->[2]->{'id'};
+ $unikey.='.'.$token->[2]->{'id'};
}
if (defined($token->[2]->{'name'})) {
$unikey.='_'.$token->[2]->{'name'};
@@ -2266,7 +2334,7 @@ sub unescape {
# ================================================================ Main Program
sub BEGIN {
-if ($readit ne 'done') {
+unless ($readit) {
# ------------------------------------------------------------ Read access.conf
{
my $config=Apache::File->new("/etc/httpd/conf/access.conf");
@@ -2311,8 +2379,10 @@ if ($readit ne 'done') {
while (my $configline=<$config>) {
chomp($configline);
+ if ($configline) {
my ($role,$perm)=split(/ /,$configline);
if ($perm ne '') { $pr{$role}=$perm; }
+ }
}
}
@@ -2322,8 +2392,10 @@ if ($readit ne 'done') {
while (my $configline=<$config>) {
chomp($configline);
+ if ($configline) {
my ($short,$plain)=split(/:/,$configline);
if ($plain ne '') { $prp{$short}=$plain; }
+ }
}
}
@@ -2359,6 +2431,7 @@ if ($readit ne 'done') {
%metacache=();
$readit='done';
+&logtouch();
&logthis('INFO: Read configuration');
}
}