--- loncom/lonnet/perl/lonnet.pm 2003/05/02 15:26:36 1.367
+++ loncom/lonnet/perl/lonnet.pm 2003/07/03 19:26:21 1.386
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.367 2003/05/02 15:26:36 www Exp $
+# $Id: lonnet.pm,v 1.386 2003/07/03 19:26:21 matthew Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -243,6 +243,26 @@ sub critical {
}
return $answer;
}
+
+# ------------------------------------------- Transfer profile into environment
+
+sub transfer_profile_to_env {
+ my ($lonidsdir,$handle)=@_;
+ my @profile;
+ {
+ my $idf=Apache::File->new("$lonidsdir/$handle.id");
+ flock($idf,LOCK_SH);
+ @profile=<$idf>;
+ $idf->close();
+ }
+ my $envi;
+ for ($envi=0;$envi<=$#profile;$envi++) {
+ chomp($profile[$envi]);
+ my ($envname,$envvalue)=split(/=/,$profile[$envi]);
+ $ENV{$envname} = $envvalue;
+ }
+ $ENV{'user.environment'} = "$lonidsdir/$handle.id";
+}
# ---------------------------------------------------------- Append Environment
@@ -347,6 +367,30 @@ sub delenv {
return 'ok';
}
+# ------------------------------------------ Find out current server userload
+# there is a copy in lond
+sub userload {
+ my $numusers=0;
+ {
+ opendir(LONIDS,$perlvar{'lonIDsDir'});
+ my $filename;
+ 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++; }
+ }
+ closedir(LONIDS);
+ }
+ my $userloadpercent=0;
+ my $maxuserload=$perlvar{'lonUserLoadLim'};
+ if ($maxuserload) {
+ $userloadpercent=100*$numusers/$maxuserload;
+ }
+ $userloadpercent=sprintf("%.2f",$userloadpercent);
+ return $userloadpercent;
+}
+
# ------------------------------------------ Fight off request when overloaded
sub overloaderror {
@@ -373,17 +417,23 @@ sub overloaderror {
# ------------------------------ Find server with least workload from spare.tab
sub spareserver {
- my $loadpercent = shift;
+ my ($loadpercent,$userloadpercent) = @_;
my $tryserver;
my $spareserver='';
- my $lowestserver=$loadpercent;
+ if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
+ my $lowestserver=$loadpercent > $userloadpercent?
+ $loadpercent : $userloadpercent;
foreach $tryserver (keys %spareid) {
- my $answer=reply('load',$tryserver);
+ my $loadans=reply('load',$tryserver);
+ my $userloadans=reply('userload',$tryserver);
+ if ($userloadans !~ /\d/) { $userloadans=0; }
+ my $answer=$loadans > $userloadans?
+ $loadans : $userloadans;
if (($answer =~ /\d/) && ($answer<$lowestserver)) {
$spareserver="http://$hostname{$tryserver}";
$lowestserver=$answer;
}
- }
+ }
return $spareserver;
}
@@ -932,9 +982,9 @@ sub repcopy {
# ------------------------------------------------ Get server side include body
sub ssi_body {
- my $filelink=shift;
+ my ($filelink,%form)=@_;
my $output=($filelink=~/^http\:/?&externalssi($filelink):
- &ssi($filelink));
+ &ssi($filelink,%form));
$output=~s/^.*\<body[^\>]*\>//si;
$output=~s/\<\/body\s*\>.*$//si;
$output=~
@@ -1230,8 +1280,8 @@ sub get_course_adv_roles {
} else {
$returnhash{$key}=$username.':'.$domain;
}
- }
- return sort %returnhash;
+ }
+ return %returnhash;
}
# ---------------------------------------------------------- Course ID routines
@@ -1593,7 +1643,7 @@ sub tmpreset {
my ($symb,$namespace,$domain,$stuname) = @_;
if (!$symb) {
$symb=&symbread();
- if (!$symb) { $symb= $ENV{'REQUEST_URI'}; }
+ if (!$symb) { $symb= $ENV{'request.url'}; }
}
$symb=escape($symb);
@@ -2611,7 +2661,7 @@ sub assignrole {
} else {
my $cwosec=$url;
$cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
- unless (&allowed('c'.$role,$cwosec)) {
+ unless ((&allowed('c'.$role,$cwosec)) || &allowed('c'.$role,$udom)) {
&logthis('Refused assignrole: '.
$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
$ENV{'user.name'}.' at '.$ENV{'user.domain'});
@@ -2631,10 +2681,11 @@ sub assignrole {
}
# actually delete
if ($deleteflag) {
- if (&allowed('dro',$udom)) {
+ if ((&allowed('dro',$udom)) || (&allowed('dro',$url))) {
# modify command to delete the role
$command="encrypt:rolesdel:$ENV{'user.domain'}:$ENV{'user.name'}:".
"$udom:$uname:$url".'_'."$mrole";
+ &logthis("$ENV{'user.name'} at $ENV{'user.domain'} deletes $mrole in $url for $uname at $udom");
# set start and finish to negative values for userrolelog
$start=-1;
$end=-1;
@@ -2723,7 +2774,7 @@ sub modifyuser {
}
$uhome=&homeserver($uname,$udom,'true');
if (($uhome eq '') || ($uhome eq 'no_host') || ($uhome ne $unhome)) {
- return 'error: verify home';
+ return 'error: unable verify users home machine.';
}
} # End of creation of new user
# ---------------------------------------------------------------------- Add ID
@@ -2733,7 +2784,8 @@ sub modifyuser {
if (($uidhash{$uname}) && ($uidhash{$uname}!~/error\:/)
&& (!$forceid)) {
unless ($uid eq $uidhash{$uname}) {
- return 'error: mismatch '.$uidhash{$uname}.' versus '.$uid;
+ return 'error: user id "'.$uid.'" does not match '.
+ 'current user id "'.$uidhash{$uname}.'".';
}
} else {
&idput($udom,($uname => $uid));
@@ -2749,10 +2801,10 @@ sub modifyuser {
} else {
%names = @tmp;
}
- if ($first) { $names{'firstname'} = $first; }
- if ($middle) { $names{'middlename'} = $middle; }
- if ($last) { $names{'lastname'} = $last; }
- if ($gene) { $names{'generation'} = $gene; }
+ if (defined($first)) { $names{'firstname'} = $first; }
+ if (defined($middle)) { $names{'middlename'} = $middle; }
+ if (defined($last)) { $names{'lastname'} = $last; }
+ if (defined($gene)) { $names{'generation'} = $gene; }
my $reply = &put('environment', \%names, $udom,$uname);
if ($reply ne 'ok') { return 'error: '.$reply; }
&logthis('Success modifying user '.$udom.', '.$uname.', '.$uid.', '.
@@ -3033,12 +3085,12 @@ sub GetFileTimestamp {
$subdir =~ s/(.)(.)(.).*/$1\/$2\/$3/;
my $proname="$studentDomain/$subdir/$studentName";
$proname .= '/'.$filename;
- my @dir = &Apache::lonnet::dirlist($proname, $studentDomain, $studentName,
- $root);
- my $fileStat = $dir[0];
+ my ($fileStat) = &Apache::lonnet::dirlist($proname, $studentDomain,
+ $studentName, $root);
my @stats = split('&', $fileStat);
if($stats[0] ne 'empty' && $stats[0] ne 'no_such_dir') {
- return $stats[9];
+ # @stats contains first the filename, then the stat output
+ return $stats[10]; # so this is 10 instead of 9.
} else {
return -1;
}
@@ -3134,10 +3186,34 @@ sub courseresdata {
return undef;
}
-# --------------------------------------------------------- Value of a Variable
+#
+# EXT resource caching routines
+#
+sub clear_EXT_cache_status {
+ &delenv('cache.EXT.');
+}
+
+sub EXT_cache_status {
+ my ($target_domain,$target_user) = @_;
+ my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;
+ if (exists($ENV{$cachename}) && ($ENV{$cachename}+1800) > time) {
+ # We know already the user has no data
+ return 1;
+ } else {
+ return 0;
+ }
+}
+
+sub EXT_cache_set {
+ my ($target_domain,$target_user) = @_;
+ my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;
+ &appenv($cachename => time);
+}
+
+# --------------------------------------------------------- Value of a Variable
sub EXT {
- my ($varname,$symbparm,$udom,$uname,)=@_;
+ my ($varname,$symbparm,$udom,$uname,$usection)=@_;
unless ($varname) { return ''; }
#get real user name/domain, courseid and symb
@@ -3145,7 +3221,7 @@ sub EXT {
my $publicuser;
if (!($uname && $udom)) {
(my $cursymb,$courseid,$udom,$uname,$publicuser)=
- &Apache::lonxml::whichuser();
+ &Apache::lonxml::whichuser($symbparm);
if (!$symbparm) { $symbparm=$cursymb; }
} else {
$courseid=$ENV{'request.course.id'};
@@ -3222,8 +3298,9 @@ sub EXT {
}
} elsif ($realm eq 'query') {
# ---------------------------------------------- pull stuff out of query string
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},[$space]);
- return $ENV{'form.'.$space};
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
+ [$spacequalifierrest]);
+ return $ENV{'form.'.$spacequalifierrest};
} elsif ($realm eq 'request') {
# ------------------------------------------------------------- request.browser
if ($space eq 'browser') {
@@ -3254,7 +3331,11 @@ sub EXT {
($ENV{'user.domain'} eq $udom)) {
$section=$ENV{'request.course.sec'};
} else {
- $section=&usection($udom,$uname,$courseid);
+ if (! defined($usection)) {
+ $section=&usection($udom,$uname,$courseid);
+ } else {
+ $section = $usection;
+ }
}
my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest;
@@ -3266,11 +3347,9 @@ sub EXT {
my $courselevelm=$courseid.'.'.$mapparm;
# ----------------------------------------------------------- first, check user
- #most student don't have any data set, check if there is some data
+ #most student don\'t have any data set, check if there is some data
#every thirty minutes
- if (!
- (exists($ENV{'cache.studentresdata'})
- && (($ENV{'cache.studentresdata'}+1800) > time))) {
+ if (! &EXT_cache_status($udom,$uname)) {
my %resourcedata=&get('resourcedata',
[$courselevelr,$courselevelm,$courselevel],
$udom,$uname);
@@ -3289,9 +3368,7 @@ sub EXT {
$uname." at ".$udom.": ".
$tmp."</font>");
} elsif ($tmp=~/error:No such file/) {
- $ENV{'cache.studentresdata'}=time;
- &appenv(('cache.studentresdata'=>
- $ENV{'cache.studentresdata'}));
+ &EXT_cache_set($udom,$uname);
} elsif ($tmp =~ /^(con_lost|no_such_host)/) {
return $tmp;
}
@@ -3577,7 +3654,13 @@ sub gettitle {
unless ($urlsymb) { $urlsymb=$ENV{'request.filename'}; }
return &metadata($urlsymb,'title');
}
- if ($titlecache{$symb}) { return $titlecache{$symb}; }
+ if ($titlecache{$symb}) {
+ if (time < ($titlecache{$symb}[1] + 600)) {
+ return $titlecache{$symb}[0];
+ } else {
+ delete($titlecache{$symb});
+ }
+ }
my ($map,$resid,$url)=split(/\_\_\_/,$symb);
my $title='';
my %bighash;
@@ -3589,7 +3672,7 @@ sub gettitle {
}
$title=~s/\&colon\;/\:/gs;
if ($title) {
- $titlecache{$symb}=$title;
+ $titlecache{$symb}=[$title,time];
return $title;
} else {
return &metadata($urlsymb,'title');
@@ -3763,6 +3846,10 @@ sub numval {
return int($txt);
}
+sub latest_rnd_algorithm_id {
+ return '64bit';
+}
+
sub rndseed {
my ($symb,$courseid,$domain,$username)=@_;