version 1.84, 2000/12/29 21:52:19
|
version 1.125, 2001/05/28 16:38:14
|
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 82
|
Line 94
|
# 10/30,10/31, |
# 10/30,10/31, |
# 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,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 |
|
# |
package Apache::lonnet; |
package Apache::lonnet; |
|
|
use strict; |
use strict; |
Line 95 use IO::Socket;
|
Line 117 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 177 sub reconlonc {
|
Line 200 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 235 sub appenv {
|
Line 263 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 261 sub appenv {
|
Line 302 sub appenv {
|
foreach $newname (keys %newenv) { |
foreach $newname (keys %newenv) { |
print $fh "$newname=$newenv{$newname}\n"; |
print $fh "$newname=$newenv{$newname}\n"; |
} |
} |
|
$fh->close(); |
} |
} |
|
|
|
$lockfh->close(); |
return 'ok'; |
return 'ok'; |
} |
} |
# ----------------------------------------------------- Delete from Environment |
# ----------------------------------------------------- Delete from Environment |
Line 280 sub delenv {
|
Line 324 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'; |
} |
} |
|
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; |
|
$fh->close(); |
} |
} |
return 'ok'; |
return 'ok'; |
} |
} |
Line 582 sub log {
|
Line 640 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 653 sub coursedescription {
|
Line 785 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 680 sub coursedescription {
|
Line 811 sub coursedescription {
|
return (); |
return (); |
} |
} |
|
|
# -------------------------------------------------------- Get user priviledges |
# -------------------------------------------------------- Get user privileges |
|
|
sub rolesinit { |
sub rolesinit { |
my ($domain,$username,$authhost)=@_; |
my ($domain,$username,$authhost)=@_; |
Line 750 sub rolesinit {
|
Line 881 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 768 sub rolesinit {
|
Line 901 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"; |
} |
} |
return $userroles; |
return $userroles; |
} |
} |
Line 869 sub eget {
|
Line 1003 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 920 sub allowed {
|
Line 1054 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 971 sub allowed {
|
Line 1105 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 1003 sub allowed {
|
Line 1137 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 1140 sub definerole {
|
Line 1275 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 1167 sub assignrole {
|
Line 1323 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 1325 sub createcourse {
|
Line 1491 sub createcourse {
|
my ($udom,$description,$url)=@_; |
my ($udom,$description,$url)=@_; |
$url=&declutter($url); |
$url=&declutter($url); |
my $cid=''; |
my $cid=''; |
unless ($cid=$ENV{'request.course.id'}) { |
|
return 'not_in_class'; |
|
} |
|
unless (&allowed('ccc',$ENV{'user.domain'})) { |
unless (&allowed('ccc',$ENV{'user.domain'})) { |
return 'refused'; |
return 'refused'; |
} |
} |
Line 1506 sub EXT {
|
Line 1669 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 1579 sub EXT {
|
Line 1742 sub EXT {
|
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}; } |
Line 1591 sub EXT {
|
Line 1754 sub EXT {
|
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 1792 sub numval {
|
Line 1969 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 { |