--- loncom/lonnet/perl/lonnet.pm 2003/08/20 01:13:56 1.403 +++ loncom/lonnet/perl/lonnet.pm 2003/09/02 13:07:51 1.408 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.403 2003/08/20 01:13:56 www Exp $ +# $Id: lonnet.pm,v 1.408 2003/09/02 13:07:51 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -245,6 +245,16 @@ sub critical { } return $answer; } + +# -------------- Remove all key from the env that start witha lowercase letter +# (Which is alweways a lon-capa value) +sub cleanenv { + foreach my $key (keys(%ENV)) { + if ($key =~ /^[a-z]/) { + delete($ENV{$key}); + } + } +} # ------------------------------------------- Transfer profile into environment @@ -379,8 +389,8 @@ sub userload { my $curtime=time; while ($filename=readdir(LONIDS)) { if ($filename eq '.' || $filename eq '..') {next;} - my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8]; - if ($curtime-$atime < 3600) { $numusers++; } + my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9]; + if ($curtime-$mtime < 3600) { $numusers++; } } closedir(LONIDS); } @@ -1218,7 +1228,7 @@ sub courseacclog { my $fnsymb=shift; unless ($ENV{'request.course.id'}) { return ''; } my $what=$fnsymb.':'.$ENV{'user.name'}.':'.$ENV{'user.domain'}; - if ($fnsymb=~/(problem|exam|quiz|assess|survey|form)$/) { + if ($fnsymb=~/(problem|exam|quiz|assess|survey|form|page)$/) { $what.=':POST'; foreach (keys %ENV) { if ($_=~/^form\.(.*)/) { @@ -2126,6 +2136,21 @@ sub dump { return %returnhash; } +# -------------------------------------------------------------- keys interface + +sub getkeys { + my ($namespace,$udomain,$uname)=@_; + if (!$udomain) { $udomain=$ENV{'user.domain'}; } + if (!$uname) { $uname=$ENV{'user.name'}; } + my $uhome=&homeserver($uname,$udomain); + my $rep=reply("keys:$udomain:$uname:$namespace",$uhome); + my @keyarray=(); + foreach (split(/\&/,$rep)) { + push (@keyarray,&unescape($_)); + } + return @keyarray; +} + # --------------------------------------------------------------- currentdump sub currentdump { my ($courseid,$sdom,$sname)=@_; @@ -2799,7 +2824,8 @@ sub modifyuser { ' in domain '.$ENV{'request.role.domain'}); my $uhome=&homeserver($uname,$udom,'true'); # ----------------------------------------------------------------- Create User - if (($uhome eq 'no_host') && ($umode) && ($upass)) { + if (($uhome eq 'no_host') && + (($umode && $upass) || ($umode eq 'localauth'))) { my $unhome=''; if (defined($desiredhome) && $hostdom{$desiredhome} eq $udom) { $unhome = $desiredhome;