loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.87 and 1.127

version 1.87, 2001/01/05 20:45:09	version 1.127, 2001/05/30 21:53:17
Line 3	Line 3
#	#
# Functions for use by content handlers:	# Functions for use by content handlers:
#	#
	# metadata_query(sql-query-string,custom-metadata-regex) :
	# returns file handle of where sql and
	# regex results will be stored for query
# plaintext(short) : plain text explanation of short term	# plaintext(short) : plain text explanation of short term
# fileembstyle(ext) : embed style in page for file extension	# fileembstyle(ext) : embed style in page for file extension
# filedescription(ext) : descriptor text for file extension	# filedescription(ext) : descriptor text for file extension
Line 13	Line 16
# 1: user needs to choose course	# 1: user needs to choose course
# 2: browse allowed	# 2: browse allowed
# definerole(rolename,sys,dom,cou) : define a custom role rolename	# definerole(rolename,sys,dom,cou) : define a custom role rolename
# set priviledges in format of lonTabs/roles.tab for	# set privileges in format of lonTabs/roles.tab for
# system, domain and course level,	# system, domain and course level,
# assignrole(udom,uname,url,role,end,start) : give a role to a user for the	# assignrole(udom,uname,url,role,end,start) : give a role to a user for the
# level given by url. Optional start and end dates	# level given by url. Optional start and end dates
Line 25	Line 28
# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role	# revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
# appenv(hash) : adds hash to session environment	# appenv(hash) : adds hash to session environment
# delenv(varname) : deletes all environment entries starting with varname	# delenv(varname) : deletes all environment entries starting with varname
# store(hash) : stores hash permanently for this url	# store(hashref,symb,courseid,udom,uname)
# cstore(hash) : critical store	# : stores hash permanently for this url
# restore : returns hash for this url	# hashref needs to be given, and should be a \%hashname
	# the remaining args aren't required and if they aren't
	# passed or are '' they will be derived from the ENV
	# cstore(hashref,symb,courseid,udom,uname)
	# : same as store but uses the critical interface to
	# guarentee a store
	# restore(symb,courseid,udom,uname)
	# : returns hash for this symb, all args are optional
	# if they aren't given they will be derived from the
	# current enviroment
# eget(namesp,array) : returns hash with keys from array filled in from namesp	# eget(namesp,array) : returns hash with keys from array filled in from namesp
# get(namesp,array) : returns hash with keys from array filled in from namesp	# get(namesp,array) : returns hash with keys from array filled in from namesp
# del(namesp,array) : deletes keys out of array from namesp	# del(namesp,array) : deletes keys out of array from namesp
Line 49	Line 61
# receipt() : returns a receipt to be given out to users	# receipt() : returns a receipt to be given out to users
# getfile(filename) : returns the contents of filename, or a -1 if it can't	# getfile(filename) : returns the contents of filename, or a -1 if it can't
# be found, replicates and subscribes to the file	# be found, replicates and subscribes to the file
# filelocation(dir,file) : returns a farily clean absolute reference to file	# filelocation(dir,file) : returns a fairly clean absolute reference to file
# from the directory dir	# from the directory dir
# hreflocation(dir,file) : same as filelocation, but for hrefs	# hreflocation(dir,file) : same as filelocation, but for hrefs
# log(domain,user,home,msg) : write to permanent log for user	# log(domain,user,home,msg) : write to permanent log for user
Line 83	Line 95
# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,	# 11/2,11/14,11/15,11/16,11/20,11/21,11/22,11/25,11/27,
# 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer	# 12/02,12/12,12/13,12/14,12/28,12/29 Gerd Kortemeyer
# 05/01/01 Guy Albertelli	# 05/01/01 Guy Albertelli
# 05/01 Gerd Kortemeyer	# 05/01,06/01,09/01 Gerd Kortemeyer
	# 09/01 Guy Albertelli
	# 09/01,10/01,11/01 Gerd Kortemeyer
	# 02/27/01 Scott Harrison
	# 3/2 Gerd Kortemeyer
	# 3/15,3/19 Scott Harrison
	# 3/19,3/20 Gerd Kortemeyer
	# 3/22,3/27,4/2,4/16,4/17 Scott Harrison
	# 5/26,5/28 Gerd Kortemeyer
	# 5/30 H. K. Ng
	#
package Apache::lonnet;	package Apache::lonnet;

use strict;	use strict;
Line 97 use IO::Socket;	Line 118 use IO::Socket;
use GDBM_File;	use GDBM_File;
use Apache::Constants qw(:common :http);	use Apache::Constants qw(:common :http);
use HTML::TokeParser;	use HTML::TokeParser;
	use Fcntl qw(:flock);

# --------------------------------------------------------------------- Logging	# --------------------------------------------------------------------- Logging

Line 179 sub reconlonc {	Line 201 sub reconlonc {

sub critical {	sub critical {
my ($cmd,$server)=@_;	my ($cmd,$server)=@_;
	unless ($hostname{$server}) {
	&logthis("<font color=blue>WARNING:".
	" Critical message to unknown server ($server)</font>");
	return 'no_such_host';
	}
my $answer=reply($cmd,$server);	my $answer=reply($cmd,$server);
if ($answer eq 'con_lost') {	if ($answer eq 'con_lost') {
my $pingreply=reply('ping',$server);	my $pingreply=reply('ping',$server);
Line 237 sub appenv {	Line 264 sub appenv {
$ENV{$_}=$newenv{$_};	$ENV{$_}=$newenv{$_};
}	}
} keys %newenv;	} keys %newenv;

	my $lockfh;
	unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) {
	return 'error: '.$!;
	}
	unless (flock($lockfh,LOCK_EX)) {
	&logthis("<font color=blue>WARNING: ".
	'Could not obtain exclusive lock in appenv: '.$!);
	$lockfh->close();
	return 'error: '.$!;
	}

my @oldenv;	my @oldenv;
{	{
my $fh;	my $fh;
unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {	unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
return 'error';	return 'error: '.$!;
}	}
@oldenv=<$fh>;	@oldenv=<$fh>;
	$fh->close();
}	}
for (my $i=0; $i<=$#oldenv; $i++) {	for (my $i=0; $i<=$#oldenv; $i++) {
chomp($oldenv[$i]);	chomp($oldenv[$i]);
Line 260 sub appenv {	Line 300 sub appenv {
return 'error';	return 'error';
}	}
my $newname;	my $newname;
flock($fh,'LOCK_EX');
foreach $newname (keys %newenv) {	foreach $newname (keys %newenv) {
print $fh "$newname=$newenv{$newname}\n";	print $fh "$newname=$newenv{$newname}\n";
}	}
$fh->close();	$fh->close();
}	}

	$lockfh->close();
return 'ok';	return 'ok';
}	}
# ----------------------------------------------------- Delete from Environment	# ----------------------------------------------------- Delete from Environment
Line 284 sub delenv {	Line 325 sub delenv {
unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {	unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
return 'error';	return 'error';
}	}
	unless (flock($fh,LOCK_SH)) {
	&logthis("<font color=blue>WARNING: ".
	'Could not obtain shared lock in delenv: '.$!);
	$fh->close();
	return 'error: '.$!;
	}
@oldenv=<$fh>;	@oldenv=<$fh>;
	$fh->close();
}	}
{	{
my $fh;	my $fh;
unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {	unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
return 'error';	return 'error';
}	}
flock($fh,'LOCK_EX');	unless (flock($fh,LOCK_EX)) {
	&logthis("<font color=blue>WARNING: ".
	'Could not obtain exclusive lock in delenv: '.$!);
	$fh->close();
	return 'error: '.$!;
	}
map {	map {
unless ($_=~/^$delthis/) { print $fh $_; }	unless ($_=~/^$delthis/) { print $fh $_; }
} @oldenv;	} @oldenv;
Line 588 sub log {	Line 641 sub log {
return critical("log:$dom:$nam:$what",$hom);	return critical("log:$dom:$nam:$what",$hom);
}	}

	# --------------------------------------------- Set Expire Date for Spreadsheet

	sub expirespread {
	my ($uname,$udom,$stype,$usymb)=@_;
	my $cid=$ENV{'request.course.id'};
	if ($cid) {
	my $now=time;
	my $key=$uname.':'.$udom.':'.$stype.':'.$usymb;
	return &reply('put:'.$ENV{'course.'.$cid.'.domain'}.':'.
	$ENV{'course.'.$cid.'.num'}.
	':nohist_expirationdates:'.
	&escape($key).'='.$now,
	$ENV{'course.'.$cid.'.home'})
	}
	return 'ok';
	}

	# ----------------------------------------------------- Devalidate Spreadsheets

	sub devalidate {
	my $symb=shift;
	my $cid=$ENV{'request.course.id'};
	if ($cid) {
	my $key=$ENV{'user.name'}.':'.$ENV{'user.domain'}.':';
	my $status=
	&reply('del:'.$ENV{'course.'.$cid.'.domain'}.':'.
	$ENV{'course.'.$cid.'.num'}.
	':nohist_calculatedsheets:'.
	&escape($key.'studentcalc:'),
	$ENV{'course.'.$cid.'.home'})
	.' '.
	&reply('del:'.$ENV{'user.domain'}.':'.
	$ENV{'user.name'}.
	':nohist_calculatedsheets_'.$cid.':'.
	&escape($key.'assesscalc:'.$symb),
	$ENV{'user.home'});
	unless ($status eq 'ok ok') {
	&logthis('Could not devalidate spreadsheet '.
	$ENV{'user.name'}.' at '.$ENV{'user.domain'}.' for '.
	$symb.': '.$status);
	}
	}
	}

# ----------------------------------------------------------------------- Store	# ----------------------------------------------------------------------- Store

sub store {	sub store {
my %storehash=@_;	my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
my $symb;	my $home='';
unless ($symb=escape(&symbread())) { return ''; }
my $namespace;	if ($stuname) {
unless ($namespace=$ENV{'request.course.id'}) { return ''; }	$home=&homeserver($stuname,$domain);
	}

	if (!$symb) { unless ($symb=&symbread()) { return ''; } }

	&devalidate($symb);

	$symb=escape($symb);
	if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
	if (!$domain) { $domain=$ENV{'user.domain'}; }
	if (!$stuname) { $stuname=$ENV{'user.name'}; }
	if (!$home) { $home=$ENV{'user.home'}; }
my $namevalue='';	my $namevalue='';
map {	map {
$namevalue.=escape($_).'='.escape($storehash{$_}).'&';	$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
} keys %storehash;	} keys %$storehash;
$namevalue=~s/\&$//;	$namevalue=~s/\&$//;
return reply(	return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
"store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
"$ENV{'user.home'}");
}	}

# -------------------------------------------------------------- Critical Store	# -------------------------------------------------------------- Critical Store

sub cstore {	sub cstore {
my %storehash=@_;	my ($storehash,$symb,$namespace,$domain,$stuname) = @_;
my $symb;	my $home='';
unless ($symb=escape(&symbread())) { return ''; }
my $namespace;	if ($stuname) {
unless ($namespace=$ENV{'request.course.id'}) { return ''; }	$home=&homeserver($stuname,$domain);
	}

	if (!$symb) { unless ($symb=&symbread()) { return ''; } }

	&devalidate($symb);

	$symb=escape($symb);
	if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
	if (!$domain) { $domain=$ENV{'user.domain'}; }
	if (!$stuname) { $stuname=$ENV{'user.name'}; }
	if (!$home) { $home=$ENV{'user.home'}; }

my $namevalue='';	my $namevalue='';
map {	map {
$namevalue.=escape($_).'='.escape($storehash{$_}).'&';	$namevalue.=escape($_).'='.escape($$storehash{$_}).'&';
} keys %storehash;	} keys %$storehash;
$namevalue=~s/\&$//;	$namevalue=~s/\&$//;
return critical(	return critical("store:$domain:$stuname:$namespace:$symb:$namevalue","$home");
"store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
"$ENV{'user.home'}");
}	}

# --------------------------------------------------------------------- Restore	# --------------------------------------------------------------------- Restore

sub restore {	sub restore {
my $symb;	my ($symb,$namespace,$domain,$stuname) = @_;
unless ($symb=escape(&symbread())) { return ''; }	my $home='';
my $namespace;
unless ($namespace=$ENV{'request.course.id'}) { return ''; }	if ($stuname) {
my $answer=reply(	$home=&homeserver($stuname,$domain);
"restore:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb",	}
"$ENV{'user.home'}");
	if (!$symb) {
	unless ($symb=escape(&symbread())) { return ''; }
	} else {
	$symb=&escape($symb);
	}
	if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { return ''; } }
	if (!$domain) { $domain=$ENV{'user.domain'}; }
	if (!$stuname) { $stuname=$ENV{'user.name'}; }
	if (!$home) { $home=$ENV{'user.home'}; }
	my $answer=&reply("restore:$domain:$stuname:$namespace:$symb","$home");

my %returnhash=();	my %returnhash=();
map {	map {
my ($name,$value)=split(/\=/,$_);	my ($name,$value)=split(/\=/,$_);
Line 659 sub coursedescription {	Line 786 sub coursedescription {
if ($chome ne 'no_host') {	if ($chome ne 'no_host') {
my $rep=reply("dump:$cdomain:$cnum:environment",$chome);	my $rep=reply("dump:$cdomain:$cnum:environment",$chome);
if ($rep ne 'con_lost') {	if ($rep ne 'con_lost') {
my $normalid=$courseid;	my $normalid=$cdomain.'_'.$cnum;
$normalid=~s/\//\_/g;
my %envhash=();	my %envhash=();
my %returnhash=('home' => $chome,	my %returnhash=('home' => $chome,
'domain' => $cdomain,	'domain' => $cdomain,
Line 686 sub coursedescription {	Line 812 sub coursedescription {
return ();	return ();
}	}

# -------------------------------------------------------- Get user priviledges	# -------------------------------------------------------- Get user privileges

sub rolesinit {	sub rolesinit {
my ($domain,$username,$authhost)=@_;	my ($domain,$username,$authhost)=@_;
Line 756 sub rolesinit {	Line 882 sub rolesinit {
}	}
}	}
} split(/&/,$rolesdump);	} split(/&/,$rolesdump);
	my $adv=0;
map {	map {
%thesepriv=();	%thesepriv=();
	if ($_ ne 'st') { $adv=1; }
map {	map {
if ($_ ne '') {	if ($_ ne '') {
my ($priviledge,$restrictions)=split(/&/,$_);	my ($privilege,$restrictions)=split(/&/,$_);
if ($restrictions eq '') {	if ($restrictions eq '') {
$thesepriv{$priviledge}='F';	$thesepriv{$privilege}='F';
} else {	} else {
if ($thesepriv{$priviledge} ne 'F') {	if ($thesepriv{$privilege} ne 'F') {
$thesepriv{$priviledge}.=$restrictions;	$thesepriv{$privilege}.=$restrictions;
}	}
}	}
}	}
Line 774 sub rolesinit {	Line 902 sub rolesinit {
map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;	map { $thesestr.=':'.$_.'&'.$thesepriv{$_}; } keys %thesepriv;
$userroles.='user.priv.'.$_.'='.$thesestr."\n";	$userroles.='user.priv.'.$_.'='.$thesestr."\n";
} keys %allroles;	} keys %allroles;
	$userroles.='user.adv='.$adv."\n";
	$ENV{'user.adv'}=$adv;
}	}
return $userroles;	return $userroles;
}	}
Line 875 sub eget {	Line 1005 sub eget {
return %returnhash;	return %returnhash;
}	}

# ------------------------------------------------- Check for a user priviledge	# ------------------------------------------------- Check for a user privilege

sub allowed {	sub allowed {
my ($priv,$uri)=@_;	my ($priv,$uri)=@_;
Line 926 sub allowed {	Line 1056 sub allowed {
return $thisallowed;	return $thisallowed;
}	}
#	#
# Gathered so far: system, domain and course wide priviledges	# Gathered so far: system, domain and course wide privileges
#	#
# Course: See if uri or referer is an individual resource that is part of	# Course: See if uri or referer is an individual resource that is part of
# the course	# the course
Line 977 sub allowed {	Line 1107 sub allowed {
}	}

#	#
# Gathered now: all priviledges that could apply, and condition number	# Gathered now: all privileges that could apply, and condition number
#	#
#	#
# Full or no access?	# Full or no access?
Line 1009 sub allowed {	Line 1139 sub allowed {
if ($envkey=~/^user\.role\.(st\|ta)\.([^\.]*)/) {	if ($envkey=~/^user\.role\.(st\|ta)\.([^\.]*)/) {
my $courseid=$2;	my $courseid=$2;
my $roleid=$1.'.'.$2;	my $roleid=$1.'.'.$2;
	$courseid=~s/^\///;
my $expiretime=600;	my $expiretime=600;
if ($ENV{'request.role'} eq $roleid) {	if ($ENV{'request.role'} eq $roleid) {
$expiretime=120;	$expiretime=120;
Line 1146 sub definerole {	Line 1277 sub definerole {
}	}
}	}

	# ---------------- Make a metadata query against the network of library servers

	sub metadata_query {
	my ($query,$custom,$customshow)=@_;
	# need to put in a library server loop here and return a hash
	my %rhash;
	for my $server (keys %libserv) {
	unless ($custom or $customshow) {
	my $reply=&reply("querysend:".&escape($query),$server);
	$rhash{$server}=$reply;
	}
	else {
	my $reply=&reply("querysend:".&escape($query).':'.
	&escape($custom).':'.&escape($customshow),
	$server);
	$rhash{$server}=$reply;
	}
	}
	return \%rhash;
	}

# ------------------------------------------------------------------ Plain Text	# ------------------------------------------------------------------ Plain Text

sub plaintext {	sub plaintext {
Line 1173 sub assignrole {	Line 1325 sub assignrole {
my ($udom,$uname,$url,$role,$end,$start)=@_;	my ($udom,$uname,$url,$role,$end,$start)=@_;
my $mrole;	my $mrole;
if ($role =~ /^cr\//) {	if ($role =~ /^cr\//) {
unless (&allowed('ccr',$url)) { return 'refused'; }	unless (&allowed('ccr',$url)) {
	&logthis('Refused custom assignrole: '.
	$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
	$ENV{'user.name'}.' at '.$ENV{'user.domain'});
	return 'refused';
	}
$mrole='cr';	$mrole='cr';
} else {	} else {
my $cwosec=$url;	my $cwosec=$url;
$cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;	$cwosec=~s/^\/(\w+)\/(\w+)\/.*/$1\/$2/;
unless (&allowed('c'.$role,$cwosec)) { return 'refused'; }	unless (&allowed('c'.$role,$cwosec)) {
	&logthis('Refused assignrole: '.
	$udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
	$ENV{'user.name'}.' at '.$ENV{'user.domain'});
	return 'refused';
	}
$mrole=$role;	$mrole=$role;
}	}
my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".	my $command="encrypt:rolesput:$ENV{'user.domain'}:$ENV{'user.name'}:".
Line 1509 sub EXT {	Line 1671 sub EXT {
if ($realm eq 'user') {	if ($realm eq 'user') {
# --------------------------------------------------------------- user.resource	# --------------------------------------------------------------- user.resource
if ($space eq 'resource') {	if ($space eq 'resource') {
my %restored=&restore;	my %restored=&restore();
return $restored{$qualifierrest};	return $restored{$qualifierrest};
# ----------------------------------------------------------------- user.access	# ----------------------------------------------------------------- user.access
} elsif ($space eq 'access') {	} elsif ($space eq 'access') {
Line 1550 sub EXT {	Line 1712 sub EXT {
}	}
} elsif ($realm eq 'course') {	} elsif ($realm eq 'course') {
# ---------------------------------------------------------- course.description	# ---------------------------------------------------------- course.description
my $section='';	return $ENV{'course.'.$ENV{'request.course.id'}.'.'.
if ($ENV{'request.course.sec'}) {
$section='_'.$ENV{'request.course.sec'};
}
return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.
$spacequalifierrest};	$spacequalifierrest};
} elsif ($realm eq 'resource') {	} elsif ($realm eq 'resource') {
if ($ENV{'request.course.id'}) {	if ($ENV{'request.course.id'}) {
# ----------------------------------------------------- Cascading lookup scheme	# ----------------------------------------------------- Cascading lookup scheme
my $symbp=&symbread();	my $symbp=&symbread();
my $mapp=(split(/\_\_\_/,$symbp))[0];	my $mapp=(split(/\_\_\_/,$symbp))[0];

my $symbparm=$symbp.'.'.$spacequalifierrest;	my $symbparm=$symbp.'.'.$spacequalifierrest;
my $mapparm=$mapp.'___(all).'.$spacequalifierrest;	my $mapparm=$mapp.'___(all).'.$spacequalifierrest;

my $seclevel=	my $seclevel=
$ENV{'request.course.id'}.'.['.	$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$spacequalifierrest;	$ENV{'request.course.sec'}.'].'.$spacequalifierrest;
my $seclevelr=	my $seclevelr=
$ENV{'request.course.id'}.'.['.	$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$symbparm;	$ENV{'request.course.sec'}.'].'.$symbparm;
my $seclevelm=	my $seclevelm=
$ENV{'request.course.id'}.'.['.	$ENV{'request.course.id'}.'.['.
$ENV{'request.course.sec'}.'].'.$mapparm;	$ENV{'request.course.sec'}.'].'.$mapparm;

my $courselevel=	my $courselevel=
$ENV{'request.course.id'}.'.'.$spacequalifierrest;	$ENV{'request.course.id'}.'.'.$spacequalifierrest;
my $courselevelr=	my $courselevelr=
$ENV{'request.course.id'}.'.'.$symbparm;	$ENV{'request.course.id'}.'.'.$symbparm;
my $courselevelm=	my $courselevelm=
$ENV{'request.course.id'}.'.'.$mapparm;	$ENV{'request.course.id'}.'.'.$mapparm;


# ----------------------------------------------------------- first, check user	# ----------------------------------------------------------- first, check user
my %resourcedata=get('resourcedata',	my %resourcedata=get('resourcedata',
($courselevelr,$courselevelm,$courselevel));	($courselevelr,$courselevelm,$courselevel));
if ($resourcedata{$courselevelr}!~/^error\:/) {	if (($resourcedata{$courselevelr}!~/^error\:/) &&
	($resourcedata{$courselevelr}!~/^con_lost/)) {

if ($resourcedata{$courselevelr}) {	if ($resourcedata{$courselevelr}) {
return $resourcedata{$courselevelr}; }	return $resourcedata{$courselevelr}; }
if ($resourcedata{$courselevelm}) {	if ($resourcedata{$courselevelm}) {
return $resourcedata{$courselevelm}; }	return $resourcedata{$courselevelm}; }
if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }	if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; }

	} else {
	if ($resourcedata{$courselevelr}!~/No such file/) {
	&logthis("<font color=blue>WARNING:".
	" Trying to get resource data for ".$ENV{'user.name'}." at "
	.$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}.
	"</font>");
	}
}	}

# -------------------------------------------------------- second, check course	# -------------------------------------------------------- second, check course
my $section='';
if ($ENV{'request.course.sec'}) {
$section='_'.$ENV{'request.course.sec'};
}
my $reply=&reply('get:'.	my $reply=&reply('get:'.
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.domain'}.':'.	$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.num'}.	$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
':resourcedata:'.	':resourcedata:'.
&escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'.	&escape($seclevelr).'&'.&escape($seclevelm).'&'.&escape($seclevel).'&'.
&escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel),	&escape($courselevelr).'&'.&escape($courselevelm).'&'.&escape($courselevel),
$ENV{'course.'.$ENV{'request.course.id'}.$section.'.home'});	$ENV{'course.'.$ENV{'request.course.id'}.'.home'});
if ($reply!~/^error\:/) {	if ($reply!~/^error\:/) {
map {	map {
if ($_) { return &unescape($_); }	if ($_) { return &unescape($_); }
} split(/\&/,$reply);	} split(/\&/,$reply);
}	}
	if (($reply=~/^con_lost/) \|\| ($reply=~/^error\:/)) {
	&logthis("<font color=blue>WARNING:".
	" Getting ".$reply." asking for ".$varname." for ".
	$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
	' at '.
	$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
	' from '.
	$ENV{'course.'.$ENV{'request.course.id'}.'.home'}.
	"</font>");
	}
# ------------------------------------------------------ third, check map parms	# ------------------------------------------------------ third, check map parms
my %parmhash=();	my %parmhash=();
my $thisparm='';	my $thisparm='';
Line 1636 sub EXT {	Line 1808 sub EXT {
# ---------------------------------------------------- Any other user namespace	# ---------------------------------------------------- Any other user namespace
} elsif ($realm eq 'environment') {	} elsif ($realm eq 'environment') {
# ----------------------------------------------------------------- environment	# ----------------------------------------------------------------- environment
return $ENV{$spacequalifierrest};	return $ENV{'environment.'.$spacequalifierrest};
} elsif ($realm eq 'system') {	} elsif ($realm eq 'system') {
# ----------------------------------------------------------------- system.time	# ----------------------------------------------------------------- system.time
if ($space eq 'time') {	if ($space eq 'time') {
Line 1795 sub numval {	Line 1967 sub numval {
sub rndseed {	sub rndseed {
my $symb;	my $symb;
unless ($symb=&symbread()) { return time; }	unless ($symb=&symbread()) { return time; }
my $symbchck=unpack("%32C*",$symb);	{
my $symbseed=numval($symb)%$symbchck;	use integer;
my $namechck=unpack("%32C*",$ENV{'user.name'});	my $symbchck=unpack("%32C*",$symb) << 27;
my $nameseed=numval($ENV{'user.name'})%$namechck;	my $symbseed=numval($symb) << 22;
return int( $symbseed	my $namechck=unpack("%32C*",$ENV{'user.name'}) << 17;
.$nameseed	my $nameseed=numval($ENV{'user.name'}) << 12;
.unpack("%32C*",$ENV{'user.domain'})	my $domainseed=unpack("%32C*",$ENV{'user.domain'}) << 7;
.unpack("%32C*",$ENV{'request.course.id'})	my $courseseed=unpack("%32C*",$ENV{'request.course.id'});
.$namechck	my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
.$symbchck);	#uncommenting these lines can break things!
	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");
	#&Apache::lonxml::debug("rndseed :$num:$symb");
	return $num;
	}
}	}

sub ireceipt {	sub ireceipt {

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.87
changed lines
	Added in v.1.127