--- loncom/lonnet/perl/lonnet.pm 2012/08/27 15:03:52 1.1172.2.9
+++ loncom/lonnet/perl/lonnet.pm 2012/11/09 17:27:18 1.1195
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.9 2012/08/27 15:03:52 raeburn Exp $
+# $Id: lonnet.pm,v 1.1195 2012/11/09 17:27:18 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -75,6 +75,9 @@ use LWP::UserAgent();
use HTTP::Date;
use Image::Magick;
+
+use Encode;
+
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
%managerstab);
@@ -97,6 +100,7 @@ use File::MMagic;
use LONCAPA qw(:DEFAULT :match);
use LONCAPA::Configuration;
use LONCAPA::lonmetadata;
+use LONCAPA::Lond;
use File::Copy;
@@ -108,6 +112,7 @@ require Exporter;
our @ISA = qw (Exporter);
our @EXPORT = qw(%env);
+
# ------------------------------------ Logging (parameters, docs, slots, roles)
{
my $logid;
@@ -119,22 +124,22 @@ our @EXPORT = qw(%env);
$cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
}
}
- $logid++;
+ $logid ++;
my $now = time();
my $id=$now.'00000'.$$.'00000'.$logid;
- my $logentry = {
- $id => {
- 'exe_uname' => $env{'user.name'},
- 'exe_udom' => $env{'user.domain'},
- 'exe_time' => $now,
- 'exe_ip' => $ENV{'REMOTE_ADDR'},
- 'delflag' => $delflag,
- 'logentry' => $storehash,
- 'uname' => $uname,
- 'udom' => $udom,
- }
+ my $logentry = {
+ $id => {
+ 'exe_uname' => $env{'user.name'},
+ 'exe_udom' => $env{'user.domain'},
+ 'exe_time' => $now,
+ 'exe_ip' => $ENV{'REMOTE_ADDR'},
+ 'delflag' => $delflag,
+ 'logentry' => $storehash,
+ 'uname' => $uname,
+ 'udom' => $udom,
+ }
};
- return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum);
+ return &put('nohist_'.$hash_name,$logentry,$cdom,$cnum);
}
}
@@ -1235,8 +1240,8 @@ sub get_lonbalancer_config {
sub check_loadbalancing {
my ($uname,$udom) = @_;
- my ($is_balancer,$dom_in_use,$homeintdom,$rule_in_effect,
- $offloadto,$otherserver);
+ my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom,
+ $rule_in_effect,$offloadto,$otherserver);
my $lonhost = $perlvar{'lonHostID'};
my @hosts = ¤t_machine_ids();
my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
@@ -1261,14 +1266,8 @@ sub check_loadbalancing {
}
}
if (ref($result) eq 'HASH') {
- my $currbalancer = $result->{'lonhost'};
- my $currtargets = $result->{'targets'};
- my $currrules = $result->{'rules'};
- if ($currbalancer ne '') {
- if (grep(/^\Q$currbalancer\E$/,@hosts)) {
- $is_balancer = 1;
- }
- }
+ ($is_balancer,$currtargets,$currrules) =
+ &check_balancer_result($result,@hosts);
if ($is_balancer) {
if (ref($currrules) eq 'HASH') {
if ($homeintdom) {
@@ -1326,12 +1325,9 @@ sub check_loadbalancing {
}
}
if (ref($result) eq 'HASH') {
- my $currbalancer = $result->{'lonhost'};
- my $currtargets = $result->{'targets'};
- my $currrules = $result->{'rules'};
-
- if ($currbalancer eq $lonhost) {
- $is_balancer = 1;
+ ($is_balancer,$currtargets,$currrules) =
+ &check_balancer_result($result,@hosts);
+ if ($is_balancer) {
if (ref($currrules) eq 'HASH') {
if ($currrules->{'_LC_internetdom'} ne '') {
$rule_in_effect = $currrules->{'_LC_internetdom'};
@@ -1385,8 +1381,8 @@ sub check_loadbalancing {
$is_balancer = 0;
if ($uname ne '' && $udom ne '') {
if (($env{'user.name'} eq $uname) && ($env{'user.domain'} eq $udom)) {
-
- &appenv({'user.loadbalexempt' => $lonhost,
+
+ &appenv({'user.loadbalexempt' => $lonhost,
'user.loadbalcheck.time' => time});
}
}
@@ -1395,6 +1391,32 @@ sub check_loadbalancing {
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 {
my ($rule_in_effect,$currtargets,$uname,$udom) = @_;
my $offloadto;
@@ -2401,7 +2423,7 @@ sub chatsend {
sub getversion {
my $fname=&clutter(shift);
- unless ($fname=~/^\/res\//) { return -1; }
+ unless ($fname=~m{^(/adm/wrapper|)/res/}) { return -1; }
return ¤tversion(&filelocation('',$fname));
}
@@ -2588,10 +2610,13 @@ sub ssi {
$request->header(Cookie => $ENV{'HTTP_COOKIE'});
my $response= $ua->request($request);
+ my $content = $response->content;
+
+
if (wantarray) {
- return ($response->content, $response);
+ return ($content, $response);
} else {
- return $response->content;
+ return $content;
}
}
@@ -2620,6 +2645,209 @@ sub allowuploaded {
&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,$resurl,$symb,$group) = @_;
+ my ($cfile,$home,$switchserver,$forceedit,$forceview,$uploaded,$incourse);
+#
+# For aboutme pages user can only edit his/her own.
+#
+ if ($resurl =~ m{^/adm/($match_domain)/($match_username)/aboutme$}) {
+ my ($sdom,$sname) = ($1,$2);
+ if (($sdom eq $env{'user.domain'}) && ($sname eq $env{'user.name'})) {
+ $home = $env{'user.home'};
+ $cfile = $resurl;
+ if ($env{'form.forceedit'}) {
+ $forceview = 1;
+ } else {
+ $forceedit = 1;
+ }
+ return ($cfile,$home,$switchserver,$forceedit,$forceview);
+ } else {
+ return;
+ }
+ }
+
+ if ($env{'request.course.id'}) {
+ my $crsedit = &Apache::lonnet::allowed('mdc',$env{'request.course.id'});
+ if ($group ne '') {
+# if this is a group homepage or group bulletin board, check group privs
+ my $allowed = 0;
+ if ($resurl =~ m{^/adm/$cdom/$cnum/$group/smppg$}) {
+ if ((&Apache::lonnet::allowed('mdg',$env{'request.course.id'}.
+ ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))) ||
+ (&allowed('mgh',$env{'request.course.id'}.'/'.$group)) || $crsedit) {
+ $allowed = 1;
+ }
+ } elsif ($resurl =~ m{^/adm/$cdom/$cnum/\d+/bulletinboard$}) {
+ unless ((&allowed(&Apache::lonnet::allowed('mdg',$env{'request.course.id'}.($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) ||
+ (&allowed('cgb',$env{'request.course.id'}.$group)) || $crsedit) {
+ $allowed = 1;
+ }
+ }
+ if ($allowed) {
+ $home=&homeserver($cnum,$cdom);
+ if ($env{'form.forceedit'}) {
+ $forceview = 1;
+ } else {
+ $forceedit = 1;
+ }
+ $cfile = $resurl;
+ } else {
+ return;
+ }
+ } else {
+#
+# No edit allowed where CC has switched to student role.
+#
+ unless ($crsedit) {
+ return;
+ }
+ }
+ }
+
+ if ($file ne '') {
+ if (($cnum =~ /$match_courseid/) && ($cdom =~ /$match_domain/)) {
+ if (&is_course_upload($file,$cnum,$cdom)) {
+ $uploaded = 1;
+ $incourse = 1;
+ if ($file =~/\.(htm|html|css|js|txt)$/) {
+ $cfile = &hreflocation('',$file);
+ $forceedit = 1;
+ }
+ } elsif ($resurl =~ m{^/public/$cdom/$cnum/syllabus}) {
+ $incourse = 1;
+ if ($env{'form.forceedit'}) {
+ $forceview = 1;
+ } else {
+ $forceedit = 1;
+ }
+ $cfile = $resurl;
+ } elsif (($resurl ne '') && (&is_on_map($resurl))) {
+ if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg|bulletinboard$}) {
+ $incourse = 1;
+ if ($env{'form.forceedit'}) {
+ $forceview = 1;
+ } else {
+ $forceedit = 1;
+ }
+ $cfile = $resurl;
+ } elsif (($resurl eq '/res/lib/templates/simpleproblem.problem')) {
+ $incourse = 1;
+ $cfile = $resurl.'/smpedit';
+ } elsif ($resurl =~ /ext/) {
+ $incourse = 1;
+ # is external
+ }
+ } elsif ($resurl eq '/res/lib/templates/simpleproblem.problem/smpedit') {
+ my $template = '/res/lib/templates/simpleproblem.problem';
+ if (&is_on_map($template)) {
+ $incourse = 1;
+ $forceview = 1;
+ $cfile = $template;
+ }
+ }
+ }
+ if ($uploaded || $incourse) {
+ $home=&homeserver($cnum,$cdom);
+ } else {
+ $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 '') && (!$incourse || $uploaded) &&
+ (($home ne '') && ($home ne 'no_host'))) {
+ my @ids=¤t_machine_ids();
+ unless (grep(/^\Q$home\E$/,@ids)) {
+ $switchserver=1;
+ }
+ }
+ }
+ return ($cfile,$home,$switchserver,$forceedit,$forceview);
+}
+
+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;
+}
+
+sub in_course {
+ my ($udom,$uname,$cdom,$cnum,$type,$hideprivileged) = @_;
+ if ($hideprivileged) {
+ my $skipuser;
+ if (&privileged($uname,$udom)) {
+ $skipuser = 1;
+ my %coursehash = &coursedescription($cdom.'_'.$cnum);
+ if ($coursehash{'nothideprivileged'}) {
+ foreach my $item (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
+ my $user;
+ if ($item =~ /:/) {
+ $user = $item;
+ } else {
+ $user = join(':',split(/[\@]/,$item));
+ }
+ if ($user eq $uname.':'.$udom) {
+ undef($skipuser);
+ last;
+ }
+ }
+ }
+ if ($skipuser) {
+ return 0;
+ }
+ }
+ }
+ $type ||= 'any';
+ if (!defined($cdom) || !defined($cnum)) {
+ my $cid = $env{'request.course.id'};
+ $cdom = $env{'course.'.$cid.'.domain'};
+ $cnum = $env{'course.'.$cid.'.num'};
+ }
+ my $typesref;
+ if (($type eq 'any') || ($type eq 'all')) {
+ $typesref = ['active','previous','future'];
+ } elsif ($type eq 'previous' || $type eq 'future') {
+ $typesref = [$type];
+ }
+ my %roles = &get_my_roles($uname,$udom,'userroles',
+ $typesref,undef,[$cdom]);
+ my ($tmp) = keys(%roles);
+ return 0 if ($tmp =~ /^(con_lost|error|no_such_host)/i);
+ my @course_roles = grep(/^\Q$cnum\E:\Q$cdom\E:/, keys(%roles));
+ if (@course_roles > 0) {
+ return 1;
+ }
+ return 0;
+}
+
# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
# input: action, courseID, current domain, intended
# path to file, source of file, instruction to parse file for objects,
@@ -3856,18 +4084,32 @@ sub courseiddump {
if (($domfilter eq '') ||
(&host_domain($tryserver) eq $domfilter)) {
- my $rep =
- &reply('courseiddump:'.&host_domain($tryserver).':'.
- $sincefilter.':'.&escape($descfilter).':'.
- &escape($instcodefilter).':'.&escape($ownerfilter).
- ':'.&escape($coursefilter).':'.&escape($typefilter).
- ':'.&escape($regexp_ok).':'.$as_hash.':'.
- &escape($selfenrollonly).':'.&escape($catfilter).':'.
- $showhidden.':'.$caller.':'.&escape($cloner).':'.
- &escape($cc_clone).':'.$cloneonly.':'.
- &escape($createdbefore).':'.&escape($createdafter).':'.
- &escape($creationcontext).':'.$domcloner,
- $tryserver);
+ my $rep;
+ if (grep { $_ eq $tryserver } current_machine_ids()) {
+ $rep = LONCAPA::Lond::dump_course_id_handler(
+ join(":", (&host_domain($tryserver), $sincefilter,
+ &escape($descfilter), &escape($instcodefilter),
+ &escape($ownerfilter), &escape($coursefilter),
+ &escape($typefilter), &escape($regexp_ok),
+ $as_hash, &escape($selfenrollonly),
+ &escape($catfilter), $showhidden, $caller,
+ &escape($cloner), &escape($cc_clone), $cloneonly,
+ &escape($createdbefore), &escape($createdafter),
+ &escape($creationcontext), $domcloner)));
+ } else {
+ $rep = &reply('courseiddump:'.&host_domain($tryserver).':'.
+ $sincefilter.':'.&escape($descfilter).':'.
+ &escape($instcodefilter).':'.&escape($ownerfilter).
+ ':'.&escape($coursefilter).':'.&escape($typefilter).
+ ':'.&escape($regexp_ok).':'.$as_hash.':'.
+ &escape($selfenrollonly).':'.&escape($catfilter).':'.
+ $showhidden.':'.$caller.':'.&escape($cloner).':'.
+ &escape($cc_clone).':'.$cloneonly.':'.
+ &escape($createdbefore).':'.&escape($createdafter).':'.
+ &escape($creationcontext).':'.$domcloner,
+ $tryserver);
+ }
+
my @pairs=split(/\&/,$rep);
foreach my $item (@pairs) {
my ($key,$value)=split(/\=/,$item,2);
@@ -5111,12 +5353,37 @@ sub del {
# -------------------------------------------------------------- dump interface
+sub unserialize {
+ my ($rep, $escapedkeys) = @_;
+
+ return {} if $rep =~ /^error/;
+
+ my %returnhash=();
+ foreach my $item (split /\&/, $rep) {
+ my ($key, $value) = split(/=/, $item, 2);
+ $key = unescape($key) unless $escapedkeys;
+ next if $key =~ /^error: 2 /;
+ $returnhash{$key} = Apache::lonnet::thaw_unescape($value);
+ }
+ #return %returnhash;
+ return \%returnhash;
+}
+
+# see Lond::dump_with_regexp
+# if $escapedkeys hash keys won't get unescaped.
sub dump {
- my ($namespace,$udomain,$uname,$regexp,$range)=@_;
+ my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys)=@_;
if (!$udomain) { $udomain=$env{'user.domain'}; }
if (!$uname) { $uname=$env{'user.name'}; }
my $uhome=&homeserver($uname,$udomain);
+ my $reply;
+ if (grep { $_ eq $uhome } current_machine_ids()) {
+ # user is hosted on this machine
+ $reply = LONCAPA::Lond::dump_with_regexp(join(":", ($udomain,
+ $uname, $namespace, $regexp, $range)), $loncaparevs{$uhome});
+ return %{unserialize($reply, $escapedkeys)};
+ }
if ($regexp) {
$regexp=&escape($regexp);
} else {
@@ -5128,7 +5395,8 @@ sub dump {
if (!($rep =~ /^error/ )) {
foreach my $item (@pairs) {
my ($key,$value)=split(/=/,$item,2);
- $key = &unescape($key);
+ $key = unescape($key) unless $escapedkeys;
+ #$key = &unescape($key);
next if ($key =~ /^error: 2 /);
$returnhash{$key}=&thaw_unescape($value);
}
@@ -5141,23 +5409,9 @@ sub dump {
sub dumpstore {
my ($namespace,$udomain,$uname,$regexp,$range)=@_;
- if (!$udomain) { $udomain=$env{'user.domain'}; }
- if (!$uname) { $uname=$env{'user.name'}; }
- my $uhome=&homeserver($uname,$udomain);
- if ($regexp) {
- $regexp=&escape($regexp);
- } else {
- $regexp='.';
- }
- my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
- my @pairs=split(/\&/,$rep);
- my %returnhash=();
- foreach my $item (@pairs) {
- my ($key,$value)=split(/=/,$item,2);
- next if ($key =~ /^error: 2 /);
- $returnhash{$key}=&thaw_unescape($value);
- }
- return %returnhash;
+ # same as dump but keys must be escaped. They may contain colon separated
+ # lists of values that may themself contain colons (e.g. symbs).
+ return &dump($namespace, $udomain, $uname, $regexp, $range, 1);
}
# -------------------------------------------------------------- keys interface
@@ -5183,7 +5437,15 @@ sub currentdump {
$sdom = $env{'user.domain'} if (! defined($sdom));
$sname = $env{'user.name'} if (! defined($sname));
my $uhome = &homeserver($sname,$sdom);
- my $rep=reply('currentdump:'.$sdom.':'.$sname.':'.$courseid,$uhome);
+ my $rep;
+
+ if (grep { $_ eq $uhome } current_machine_ids()) {
+ $rep = LONCAPA::Lond::dump_profile_database(join(":", ($sdom, $sname,
+ $courseid)));
+ } else {
+ $rep = reply('currentdump:'.$sdom.':'.$sname.':'.$courseid,$uhome);
+ }
+
return if ($rep =~ /^(error:|no_such_host)/);
#
my %returnhash=();
@@ -5714,7 +5976,7 @@ sub usertools_access {
my ($toolstatus,$inststatus,$envkey);
if ($context eq 'requestauthor') {
- $envkey = $context;
+ $envkey = $context;
} else {
$envkey = $context.'.'.$tool;
}
@@ -6452,6 +6714,73 @@ sub allowed {
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 {
my ($cdom,$cnum) = @_;
if ($cdom eq '' || $cnum eq '') {
@@ -7517,7 +7846,7 @@ sub assignrole {
}
}
} elsif ($context eq 'requestauthor') {
- if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
+ if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'}) &&
($url eq '/'.$udom.'/') && ($role eq 'au')) {
if ($env{'environment.requestauthor'} eq 'automatic') {
$refused = '';
@@ -7525,13 +7854,13 @@ sub assignrole {
my %domdefaults = &get_domain_defaults($udom);
if (ref($domdefaults{'requestauthor'}) eq 'HASH') {
my $checkbystatus;
- if ($env{'user.adv'}) {
+ if ($env{'user.adv'}) {
my $disposition = $domdefaults{'requestauthor'}{'_LC_adv'};
if ($disposition eq 'automatic') {
$refused = '';
} elsif ($disposition eq '') {
$checkbystatus = 1;
- }
+ }
} else {
$checkbystatus = 1;
}
@@ -7618,7 +7947,7 @@ sub assignrole {
$context);
} elsif (($role eq 'ca') || ($role eq 'aa')) {
&coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
- $context);
+ $context);
}
if ($role eq 'cc') {
&autoupdate_coowners($url,$end,$start,$uname,$udom);
@@ -9976,7 +10305,7 @@ sub symblist {
# --------------------------------------------------------------- Verify a symb
sub symbverify {
- my ($symb,$thisurl)=@_;
+ my ($symb,$thisurl,$encstate)=@_;
my $thisfn=$thisurl;
$thisfn=&declutter($thisfn);
# direct jump to resource in page or to a sequence - will construct own symbs
@@ -10012,11 +10341,14 @@ sub symbverify {
}
if (
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
- eq $symb) {
+ eq $symb) {
+ if (ref($encstate)) {
+ $$encstate = $bighash{'encrypted_'.$id};
+ }
if (($env{'request.role.adv'}) ||
($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
($thisurl eq '/adm/navmaps')) {
- $okay=1;
+ $okay=1;
}
}
}
@@ -11880,6 +12212,21 @@ allowed($priv,$uri,$symb,$role) : check
=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
role rolename set privileges in format of lonTabs/roles.tab for system, domain,
and course level
@@ -11910,6 +12257,16 @@ of role statuses (active, future or prev
to restrict the list of roles reported. If no array ref is
provided for types, will default to return only active roles.
+=item *
+
+in_course($udom,$uname,$cdom,$cnum,$type,$hideprivileged) : determine if
+user: $uname:$udom has a role in the course: $cdom_$cnum. Additional
+optional arguments are: $type (if role checking is to be restricted to
+certain user status types -- previous (expired roles), active (currently
+available roles) or future (roles available in the future), and
+$hideprivileged -- if true will not report course roles for users who
+have active Domain Coordinator or Super User roles.
+
=back
=head2 User Modification
@@ -12112,7 +12469,6 @@ data base, returning a hash that is keye
values that are the resource value. I believe that the timestamps and
versions are also returned.
-
=back
=head2 Course Modification
@@ -12213,12 +12569,14 @@ returns the data handle
=item *
-symbverify($symb,$thisfn) : verifies that $symb actually exists and is
-a possible symb for the URL in $thisfn, and if is an encryypted
+symbverify($symb,$thisfn,$encstate) : verifies that $symb actually exists
+and is a possible symb for the URL in $thisfn, and if is an encrypted
resource that the user accessed using /enc/ returns a 1 on success, 0
-on failure, user must be in a course, as it assumes the existance of
-the course initial hash, and uses $env('request.course.id'}
-
+on failure, user must be in a course, as it assumes the existence of
+the course initial hash, and uses $env('request.course.id'}. The third
+arg is an optional reference to a scalar. If this arg is passed in the
+call to symbverify, it will be set to 1 if the symb has been set to be
+encrypted; otherwise it will be null.
=item *
@@ -12271,6 +12629,36 @@ expirespread($uname,$udom,$stype,$usymb)
devalidate($symb) : devalidate temporary spreadsheet calculations,
forcing spreadsheet to reevaluate the resource scores next time.
+=item *
+
+can_edit_resource($file,$cnum,$cdom,$resurl,$symb,$group)
+
+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.
+
+=item *
+
+is_course_upload($file,$cnum,$cdom)
+
+Used in course context to determine if current file was uploaded to
+the course (i.e., would be found in /userfiles/docs on the course's
+homeserver.
+
+ input: 3 args -- filename (decluttered), course number and course domain.
+ output: boolean -- 1 if file was uploaded.
+
=back
=head2 Storing/Retreiving Data