--- loncom/lonnet/perl/lonnet.pm 2006/03/27 23:00:18 1.722 +++ loncom/lonnet/perl/lonnet.pm 2006/04/18 20:36:00 1.730 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.722 2006/03/27 23:00:18 albertel Exp $ +# $Id: lonnet.pm,v 1.730 2006/04/18 20:36:00 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -45,7 +45,6 @@ qw(%perlvar %hostname %badServerCache %i use IO::Socket; use GDBM_File; -use Apache::Constants qw(:common :http); use HTML::LCParser; use HTML::Parser; use Fcntl qw(:flock); @@ -86,6 +85,29 @@ delayed. # --------------------------------------------------------------------- Logging +{ + my $logid; + sub instructor_log { + my ($hash_name,$storehash,$delflag,$uname,$udom)=@_; + $logid++; + my $id=time().'00000'.$$.'00000'.$logid; + return &Apache::lonnet::put('nohist_'.$hash_name, + { $id => { + 'exe_uname' => $env{'user.name'}, + 'exe_udom' => $env{'user.domain'}, + 'exe_time' => time(), + 'exe_ip' => $ENV{'REMOTE_ADDR'}, + 'delflag' => $delflag, + 'logentry' => $storehash, + 'uname' => $uname, + 'udom' => $udom, + } + }, + $env{'course.'.$env{'request.course.id'}.'.domain'}, + $env{'course.'.$env{'request.course.id'}.'.num'} + ); + } +} sub logtouch { my $execdir=$perlvar{'lonDaemons'}; @@ -279,6 +301,8 @@ sub transfer_profile_to_env { for ($envi=0;$envi<=$#profile;$envi++) { chomp($profile[$envi]); my ($envname,$envvalue)=split(/=/,$profile[$envi],2); + $envname=&unescape($envname); + $envvalue=&unescape($envvalue); $env{$envname} = $envvalue; if (my ($key,$time) = ($envname =~ /^(cgi\.(\d+)_\d+\.)/)) { if ($time < time-300) { @@ -331,6 +355,8 @@ sub appenv { chomp($oldenv[$i]); if ($oldenv[$i] ne '') { my ($name,$value)=split(/=/,$oldenv[$i],2); + $name=&unescape($name); + $value=&unescape($value); unless (defined($newenv{$name})) { $newenv{$name}=$value; } @@ -343,7 +369,7 @@ sub appenv { } my $newname; foreach $newname (keys %newenv) { - print $fh "$newname=$newenv{$newname}\n"; + print $fh &escape($newname).'='.&escape($newenv{$newname})."\n"; } close($fh); } @@ -355,7 +381,6 @@ sub appenv { sub delenv { my $delthis=shift; - my %newenv=(); if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { &logthis("WARNING: ". "Attempt to delete from environment ".$delthis); @@ -388,8 +413,10 @@ sub delenv { return 'error: '.$!; } foreach my $cur_key (@oldenv) { - if ($cur_key=~/^$delthis/) { - my ($key,undef) = split('=',$cur_key,2); + my $unescaped_cur_key = &unescape($cur_key); + if ($unescaped_cur_key=~/^$delthis/) { + my ($key) = split('=',$cur_key,2); + $key = &unescape($key); delete($env{$key}); } else { print $fh $cur_key; @@ -847,12 +874,9 @@ sub getsection { } sub save_cache { - my ($r)=@_; - if (! $r->is_initial_req()) { return DECLINED; } &purge_remembered(); #&Apache::loncommon::validate_page(); undef(%env); - return OK; } my $to_remember=-1; @@ -1004,13 +1028,13 @@ sub retrievestudentphoto { # -------------------------------------------------------------------- New chat sub chatsend { - my ($newentry,$anon)=@_; + my ($newentry,$anon,$group)=@_; my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; my $chome=$env{'course.'.$env{'request.course.id'}.'.home'}; &reply('chatsend:'.$cdom.':'.$cnum.':'. &escape($env{'user.domain'}.':'.$env{'user.name'}.':'.$anon.':'. - &escape($newentry)),$chome); + &escape($newentry)).':'.$group,$chome); } # ------------------------------------------ Find current version of a resource @@ -3987,7 +4011,7 @@ sub get_users_groups { my $grouplist; foreach my $key (keys %roleshash) { if ($key =~ /^\Q$courseid\E\/(\w+)\_gr$/) { - unless ($roleshash{$key} =~ /_1_1$/) { # deleted membership + unless ($roleshash{$key} =~ /_\d+_\-1$/) { # deleted membership $grouplist .= $1.':'; } } @@ -4743,11 +4767,10 @@ sub stat_file { $uri = &clutter($uri); # we want just the url part without the unneeded accessor url bits - if ($file =~ m-^/adm/-) { - $file=~s-^/adm/wrapper/-/-; - $file=~s-^/adm/coursedocs/showdoc/-/-; + if ($uri =~ m-^/adm/-) { + $uri=~s-^/adm/wrapper/-/-; + $uri=~s-^/adm/coursedocs/showdoc/-/-; } - my ($udom,$uname,$file,$dir); if ($uri =~ m-^/(uploaded|editupload)/-) { ($udom,$uname,$file) = @@ -5115,9 +5138,6 @@ sub EXT { ($env{'user.domain'} eq $udom)) { $section=$env{'request.course.sec'}; @groups=&sort_course_groups($env{'request.course.groups'},$courseid); - if (@groups > 0) { - @groups = sort(@groups); - } } else { if (! defined($usection)) { $section=&getsection($udom,$uname,$courseid); @@ -6524,7 +6544,6 @@ sub goodbye { &logthis(sprintf("%-20s is %s",'hits',$hits)); &flushcourselogs(); &logthis("Shutting down"); - return DONE; } BEGIN {