--- loncom/lonnet/perl/lonnet.pm 2001/08/20 23:28:43 1.155 +++ loncom/lonnet/perl/lonnet.pm 2001/10/06 20:57:45 1.162 @@ -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,9 @@ # 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 Scott Harrison package Apache::lonnet; @@ -136,7 +139,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); @@ -665,6 +668,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 +1190,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 +1268,7 @@ sub allowed { map { if ($_=~/^httpref\..*\*/) { my $pattern=$_; + $pattern=~s/^httpref\.\/res\///; $pattern=~s/\*/\[\^\/\]\+/g; $pattern=~s/\//\\\//g; if ($orguri=~/$pattern/) { @@ -1575,7 +1635,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 +1700,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'; } @@ -2266,7 +2326,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 +2371,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 +2384,10 @@ if ($readit ne 'done') { while (my $configline=<$config>) { chomp($configline); + if ($configline) { my ($short,$plain)=split(/:/,$configline); if ($plain ne '') { $prp{$short}=$plain; } + } } }