--- loncom/lonnet/perl/lonnet.pm 2001/09/20 16:09:07 1.157
+++ 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,8/23,9/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;
@@ -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'};
@@ -689,6 +703,7 @@ sub flushcourselogs {
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;
@@ -700,6 +715,20 @@ sub courselog {
}
}
+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 {
@@ -1172,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='';
@@ -1611,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),
@@ -1676,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';
}
@@ -1876,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) {
@@ -1977,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);
@@ -2026,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;
@@ -2039,6 +2070,7 @@ sub metadata {
my $value=$packagetab{$_};
my $part=$keyroot;
$part=~s/^\_//;
+ $part=~s/\./\_/g;
if ($subp eq 'display') {
$value.=' [Part: '.$part.']';
}
@@ -2058,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'};
@@ -2302,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");
@@ -2347,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; }
+ }
}
}
@@ -2358,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; }
+ }
}
}
@@ -2395,6 +2431,7 @@ if ($readit ne 'done') {
%metacache=();
$readit='done';
+&logtouch();
&logthis('INFO: Read configuration');
}
}