version 1.96, 2001/01/11 11:08:37
|
version 1.108, 2001/03/19 16:46:24
|
Line 3
|
Line 3
|
# |
# |
# Functions for use by content handlers: |
# Functions for use by content handlers: |
# |
# |
|
# metadata_query(sql-query-string) : returns file handle of where sql |
|
# 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 15
|
# 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 86
|
Line 88
|
# 05/01,06/01,09/01 Gerd Kortemeyer |
# 05/01,06/01,09/01 Gerd Kortemeyer |
# 09/01 Guy Albertelli |
# 09/01 Guy Albertelli |
# 09/01,10/01,11/01 Gerd Kortemeyer |
# 09/01,10/01,11/01 Gerd Kortemeyer |
|
# 02/27/01 Scott Harrison |
|
# 3/2 Gerd Kortemeyer |
|
# 3/15 Scott Harrison |
|
|
package Apache::lonnet; |
package Apache::lonnet; |
|
|
Line 248 sub appenv {
|
Line 253 sub appenv {
|
|
|
my $lockfh; |
my $lockfh; |
unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) { |
unless ($lockfh=Apache::File->new("$ENV{'user.environment'}")) { |
return 'error'; |
return 'error: '.$!; |
} |
} |
unless (flock($lockfh,LOCK_EX)) { |
unless (flock($lockfh,LOCK_EX)) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=blue>WARNING: ". |
Line 261 sub appenv {
|
Line 266 sub appenv {
|
{ |
{ |
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(); |
$fh->close(); |
Line 719 sub coursedescription {
|
Line 724 sub coursedescription {
|
return (); |
return (); |
} |
} |
|
|
# -------------------------------------------------------- Get user priviledges |
# -------------------------------------------------------- Get user privileges |
|
|
sub rolesinit { |
sub rolesinit { |
my ($domain,$username,$authhost)=@_; |
my ($domain,$username,$authhost)=@_; |
Line 793 sub rolesinit {
|
Line 798 sub rolesinit {
|
%thesepriv=(); |
%thesepriv=(); |
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 908 sub eget {
|
Line 913 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 959 sub allowed {
|
Line 964 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 1010 sub allowed {
|
Line 1015 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 1180 sub definerole {
|
Line 1185 sub definerole {
|
} |
} |
} |
} |
|
|
|
# ---------------- Make a metadata query against the network of library servers |
|
|
|
sub metadata_query { |
|
my ($query)=@_; |
|
my $reply=&reply("querysend:".&escape($query),'msul3'); |
|
} |
|
|
# ------------------------------------------------------------------ Plain Text |
# ------------------------------------------------------------------ Plain Text |
|
|
sub plaintext { |
sub plaintext { |
Line 1207 sub assignrole {
|
Line 1219 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 1843 sub numval {
|
Line 1865 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 { |