version 1.1190, 2012/09/04 20:48:05
|
version 1.1193, 2012/10/31 12:54:23
|
Line 1240 sub get_lonbalancer_config {
|
Line 1240 sub get_lonbalancer_config {
|
|
|
sub check_loadbalancing { |
sub check_loadbalancing { |
my ($uname,$udom) = @_; |
my ($uname,$udom) = @_; |
my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect, |
my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom, |
$offloadto,$otherserver); |
$rule_in_effect,$offloadto,$otherserver); |
my $lonhost = $perlvar{'lonHostID'}; |
my $lonhost = $perlvar{'lonHostID'}; |
my @hosts = ¤t_machine_ids(); |
my @hosts = ¤t_machine_ids(); |
my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); |
my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); |
Line 1266 sub check_loadbalancing {
|
Line 1266 sub check_loadbalancing {
|
} |
} |
} |
} |
if (ref($result) eq 'HASH') { |
if (ref($result) eq 'HASH') { |
my $currbalancer = $result->{'lonhost'}; |
($is_balancer,$currtargets,$currrules) = |
my $currtargets = $result->{'targets'}; |
&check_balancer_result($result,@hosts); |
my $currrules = $result->{'rules'}; |
|
if ($currbalancer ne '') { |
|
if (grep(/^\Q$currbalancer\E$/,@hosts)) { |
|
$is_balancer = 1; |
|
} |
|
} |
|
if ($is_balancer) { |
if ($is_balancer) { |
if (ref($currrules) eq 'HASH') { |
if (ref($currrules) eq 'HASH') { |
if ($homeintdom) { |
if ($homeintdom) { |
Line 1331 sub check_loadbalancing {
|
Line 1325 sub check_loadbalancing {
|
} |
} |
} |
} |
if (ref($result) eq 'HASH') { |
if (ref($result) eq 'HASH') { |
my $currbalancer = $result->{'lonhost'}; |
($is_balancer,$currtargets,$currrules) = |
my $currtargets = $result->{'targets'}; |
&check_balancer_result($result,@hosts); |
my $currrules = $result->{'rules'}; |
if ($is_balancer) { |
|
|
if ($currbalancer eq $lonhost) { |
|
$is_balancer = 1; |
|
if (ref($currrules) eq 'HASH') { |
if (ref($currrules) eq 'HASH') { |
if ($currrules->{'_LC_internetdom'} ne '') { |
if ($currrules->{'_LC_internetdom'} ne '') { |
$rule_in_effect = $currrules->{'_LC_internetdom'}; |
$rule_in_effect = $currrules->{'_LC_internetdom'}; |
Line 1400 sub check_loadbalancing {
|
Line 1391 sub check_loadbalancing {
|
return ($is_balancer,$otherserver); |
return ($is_balancer,$otherserver); |
} |
} |
|
|
|
sub check_balancer_result { |
|
my ($result,@hosts) = @_; |
|
my ($is_balancer,$currtargets,$currrules); |
|
if (ref($result) eq 'HASH') { |
|
if ($result->{'lonhost'} ne '') { |
|
my $currbalancer = $result->{'lonhost'}; |
|
if (grep(/^\Q$currbalancer\E$/,@hosts)) { |
|
$is_balancer = 1; |
|
$currtargets = $result->{'targets'}; |
|
$currrules = $result->{'rules'}; |
|
} |
|
} else { |
|
foreach my $key (keys(%{$result})) { |
|
if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) && |
|
(ref($result->{$key}) eq 'HASH')) { |
|
$is_balancer = 1; |
|
$currrules = $result->{$key}{'rules'}; |
|
$currtargets = $result->{$key}{'targets'}; |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
return ($is_balancer,$currtargets,$currrules); |
|
} |
|
|
sub get_loadbalancer_targets { |
sub get_loadbalancer_targets { |
my ($rule_in_effect,$currtargets,$uname,$udom) = @_; |
my ($rule_in_effect,$currtargets,$uname,$udom) = @_; |
my $offloadto; |
my $offloadto; |
Line 2628 sub allowuploaded {
|
Line 2645 sub allowuploaded {
|
&Apache::lonnet::appenv(\%httpref); |
&Apache::lonnet::appenv(\%httpref); |
} |
} |
|
|
|
# |
|
# Determine if the current user should be able to edit a particular resource, |
|
# when viewing in course context. |
|
# (a) When viewing resource used to determine if "Edit" item is included in |
|
# Functions. |
|
# (b) When displaying folder contents in course editor, used to determine if |
|
# "Edit" link will be displayed alongside resource. |
|
# |
|
# input: 3 args -- filename (decluttered), course number and course domain. |
|
# output: array of four scalars -- |
|
# $cfile -- url for file editing if editable on current server |
|
# $home -- homeserver of resource (i.e., for author if published, |
|
# or course if uploaded.). |
|
# $switchserver -- 1 if server switch will be needed. |
|
# $uploaded -- 1 if resource is a file uploaded to a course. |
|
# |
|
|
|
sub can_edit_resource { |
|
my ($file,$cnum,$cdom) = @_; |
|
my ($cfile,$home,$switchserver,$uploaded); |
|
if ($file ne '') { |
|
if (($cnum =~ /$match_courseid/) && ($cdom =~ /$match_domain/)) { |
|
$uploaded = &is_course_upload($file,$cnum,$cdom); |
|
if ($uploaded) { |
|
$home=&homeserver($cnum,$cdom); |
|
if ($file =~/\.(htm|html|css|js|txt)$/) { |
|
$cfile = &hreflocation('',$file); |
|
} |
|
} |
|
} |
|
unless ($uploaded) { |
|
$file=~s{^(priv/$match_domain/$match_username)}{/$1}; |
|
$file=~s{^($match_domain/$match_username)}{/priv/$1}; |
|
# Check that the user has permission to edit this resource |
|
my $setpriv = 1; |
|
my ($cfuname,$cfudom)=&constructaccess($file,$setpriv); |
|
if (defined($cfudom)) { |
|
$home=&homeserver($cfuname,$cfudom); |
|
$cfile=$file; |
|
} |
|
} |
|
if (($cfile ne '') && (($home ne '') && ($home ne 'no_host'))) { |
|
my @ids=¤t_machine_ids(); |
|
unless (grep(/^\Q$home\E$/,@ids)) { |
|
$switchserver=1; |
|
} |
|
} |
|
} |
|
return ($cfile,$home,$switchserver,$uploaded); |
|
} |
|
|
|
sub is_course_upload { |
|
my ($file,$cnum,$cdom) = @_; |
|
my $uploadpath = &LONCAPA::propath($cdom,$cnum); |
|
$uploadpath =~ s{^\/}{}; |
|
if (($file =~ m{^\Q$uploadpath\E/userfiles/docs/}) || |
|
($file =~ m{^userfiles/\Q$cdom\E/\Q$cnum\E/docs/})) { |
|
return 1; |
|
} |
|
return; |
|
} |
|
|
# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course |
# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course |
# input: action, courseID, current domain, intended |
# input: action, courseID, current domain, intended |
# path to file, source of file, instruction to parse file for objects, |
# path to file, source of file, instruction to parse file for objects, |
Line 6494 sub allowed {
|
Line 6573 sub allowed {
|
return 'F'; |
return 'F'; |
} |
} |
|
|
|
# ------------------------------------------- Check construction space access |
|
|
|
sub constructaccess { |
|
my ($url,$setpriv)=@_; |
|
|
|
# We do not allow editing of previous versions of files |
|
if ($url=~/\.(\d+)\.(\w+)$/) { return ''; } |
|
|
|
# Get username and domain from URL |
|
my ($ownername,$ownerdomain,$ownerhome); |
|
|
|
($ownerdomain,$ownername) = |
|
($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)/priv/($match_domain)/($match_username)/}); |
|
|
|
# The URL does not really point to any authorspace, forget it |
|
unless (($ownername) && ($ownerdomain)) { return ''; } |
|
|
|
# Now we need to see if the user has access to the authorspace of |
|
# $ownername at $ownerdomain |
|
|
|
if (($ownername eq $env{'user.name'}) && ($ownerdomain eq $env{'user.domain'})) { |
|
# Real author for this? |
|
$ownerhome = $env{'user.home'}; |
|
if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) { |
|
return ($ownername,$ownerdomain,$ownerhome); |
|
} |
|
} else { |
|
# Co-author for this? |
|
if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) || |
|
exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) { |
|
$ownerhome = &homeserver($ownername,$ownerdomain); |
|
return ($ownername,$ownerdomain,$ownerhome); |
|
} |
|
} |
|
|
|
# We don't have any access right now. If we are not possibly going to do anything about this, |
|
# we might as well leave |
|
unless ($setpriv) { return ''; } |
|
|
|
# Backdoor access? |
|
my $allowed=&allowed('eco',$ownerdomain); |
|
# Nope |
|
unless ($allowed) { return ''; } |
|
# Looks like we may have access, but could be locked by the owner of the construction space |
|
if ($allowed eq 'U') { |
|
my %blocked=&get('environment',['domcoord.author'], |
|
$ownerdomain,$ownername); |
|
# Is blocked by owner |
|
if ($blocked{'domcoord.author'} eq 'blocked') { return ''; } |
|
} |
|
if (($allowed eq 'F') || ($allowed eq 'U')) { |
|
# Grant temporary access |
|
my $then=$env{'user.login.time'}; |
|
my $update==$env{'user.update.time'}; |
|
if (!$update) { $update = $then; } |
|
my $refresh=$env{'user.refresh.time'}; |
|
if (!$refresh) { $refresh = $update; } |
|
my $now = time; |
|
&check_adhoc_privs($ownerdomain,$ownername,$update,$refresh, |
|
$now,'ca','constructaccess'); |
|
$ownerhome = &homeserver($ownername,$ownerdomain); |
|
return($ownername,$ownerdomain,$ownerhome); |
|
} |
|
# No business here |
|
return ''; |
|
} |
|
|
sub get_comm_blocks { |
sub get_comm_blocks { |
my ($cdom,$cnum) = @_; |
my ($cdom,$cnum) = @_; |
if ($cdom eq '' || $cnum eq '') { |
if ($cdom eq '' || $cnum eq '') { |
Line 11925 allowed($priv,$uri,$symb,$role) : check
|
Line 12071 allowed($priv,$uri,$symb,$role) : check
|
|
|
=item * |
=item * |
|
|
|
constructaccess($url,$setpriv) : check for access to construction space URL |
|
|
|
See if the owner domain and name in the URL match those in the |
|
expected environment. If so, return three element list |
|
($ownername,$ownerdomain,$ownerhome). |
|
|
|
Otherwise return the null string. |
|
|
|
If second argument 'setpriv' is true, it assigns the privileges, |
|
and returns the same three element list, unless the owner has |
|
blocked "ad hoc" Domain Coordinator access to the Author Space, |
|
in which case the null string is returned. |
|
|
|
=item * |
|
|
definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom |
definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom |
role rolename set privileges in format of lonTabs/roles.tab for system, domain, |
role rolename set privileges in format of lonTabs/roles.tab for system, domain, |
and course level |
and course level |