--- loncom/lonnet/perl/lonnet.pm 2012/12/13 19:32:52 1.1172.2.13
+++ loncom/lonnet/perl/lonnet.pm 2014/10/13 15:47:14 1.1172.2.55
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.13 2012/12/13 19:32:52 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.55 2014/10/13 15:47:14 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -97,6 +97,7 @@ use File::MMagic;
use LONCAPA qw(:DEFAULT :match);
use LONCAPA::Configuration;
use LONCAPA::lonmetadata;
+use LONCAPA::Lond;
use File::Copy;
@@ -351,9 +352,11 @@ sub get_remote_globals {
}
sub remote_devalidate_cache {
- my ($lonhost,$name,$id) = @_;
- my $response = &reply('devalidatecache:'.&escape($name).':'.&escape($id),$lonhost);
- return $response;
+ my ($lonhost,$cachekeys) = @_;
+ my $items;
+ return unless (ref($cachekeys) eq 'ARRAY');
+ my $cachestr = join('&',@{$cachekeys});
+ return &reply('devalidatecache:'.&escape($cachestr),$lonhost);
}
# -------------------------------------------------- Non-critical communication
@@ -598,7 +601,7 @@ sub transfer_profile_to_env {
# ---------------------------------------------------- Check for valid session
sub check_for_valid_session {
- my ($r,$name) = @_;
+ my ($r,$name,$userhashref) = @_;
my %cookies=CGI::Cookie->parse($r->header_in('Cookie'));
if ($name eq '') {
$name = 'lonID';
@@ -629,6 +632,12 @@ sub check_for_valid_session {
|| !defined($disk_env{'user.domain'})) {
return undef;
}
+
+ if (ref($userhashref) eq 'HASH') {
+ $userhashref->{'name'} = $disk_env{'user.name'};
+ $userhashref->{'domain'} = $disk_env{'user.domain'};
+ }
+
return $handle;
}
@@ -662,7 +671,7 @@ sub appenv {
if (($key =~ /^user\.role/) || ($key =~ /^user\.priv/)) {
$refused = 1;
if (ref($roles) eq 'ARRAY') {
- my ($type,$role) = ($key =~ /^user\.(role|priv)\.([^.]+)\./);
+ my ($type,$role) = ($key =~ m{^user\.(role|priv)\.(.+?)\./});
if (grep(/^\Q$role\E$/,@{$roles})) {
$refused = 0;
}
@@ -876,7 +885,17 @@ sub spareserver {
}
sub compare_server_load {
- my ($try_server, $spare_server, $lowest_load) = @_;
+ my ($try_server, $spare_server, $lowest_load, $required) = @_;
+
+ if ($required) {
+ my ($reqdmajor,$reqdminor) = ($required =~ /^(\d+)\.(\d+)$/);
+ my $remoterev = &get_server_loncaparev(undef,$try_server);
+ my ($major,$minor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/);
+ if (($major eq '' && $minor eq '') ||
+ (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)))) {
+ return ($spare_server,$lowest_load);
+ }
+ }
my $loadans = &reply('load', $try_server);
my $userloadans = &reply('userload',$try_server);
@@ -937,26 +956,43 @@ sub has_user_session {
# --------- determine least loaded server in a user's domain which allows login
sub choose_server {
- my ($udom,$checkloginvia) = @_;
+ my ($udom,$checkloginvia,$required,$skiploadbal) = @_;
my %domconfhash = &Apache::loncommon::get_domainconf($udom);
my %servers = &get_servers($udom);
my $lowest_load = 30000;
- my ($login_host,$hostname,$portal_path,$isredirect);
+ my ($login_host,$hostname,$portal_path,$isredirect,$balancers);
+ if ($skiploadbal) {
+ ($balancers,my $cached)=&is_cached_new('loadbalancing',$udom);
+ unless (defined($cached)) {
+ my $cachetime = 60*60*24;
+ my %domconfig =
+ &Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom);
+ if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
+ $balancers = &do_cache_new('loadbalancing',$udom,$domconfig{'loadbalancing'},
+ $cachetime);
+ }
+ }
+ }
foreach my $lonhost (keys(%servers)) {
my $loginvia;
+ if ($skiploadbal) {
+ if (ref($balancers) eq 'HASH') {
+ next if (exists($balancers->{$lonhost}));
+ }
+ }
if ($checkloginvia) {
$loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost};
if ($loginvia) {
my ($server,$path) = split(/:/,$loginvia);
($login_host, $lowest_load) =
- &compare_server_load($server, $login_host, $lowest_load);
+ &compare_server_load($server, $login_host, $lowest_load, $required);
if ($login_host eq $server) {
$portal_path = $path;
$isredirect = 1;
}
} else {
($login_host, $lowest_load) =
- &compare_server_load($lonhost, $login_host, $lowest_load);
+ &compare_server_load($lonhost, $login_host, $lowest_load, $required);
if ($login_host eq $lonhost) {
$portal_path = '';
$isredirect = '';
@@ -964,7 +1000,7 @@ sub choose_server {
}
} else {
($login_host, $lowest_load) =
- &compare_server_load($lonhost, $login_host, $lowest_load);
+ &compare_server_load($lonhost, $login_host, $lowest_load, $required);
}
}
if ($login_host ne '') {
@@ -1311,7 +1347,7 @@ sub check_loadbalancing {
}
}
} elsif (($homeintdom) && ($udom ne $serverhomedom)) {
- my ($result,$cached)=&is_cached_new('loadbalancing',$serverhomedom);
+ ($result,$cached)=&is_cached_new('loadbalancing',$serverhomedom);
unless (defined($cached)) {
my %domconfig =
&Apache::lonnet::get_dom('configuration',['loadbalancing'],$serverhomedom);
@@ -1566,6 +1602,36 @@ sub idput {
}
}
+# ---------------------------------------- Delete unwanted IDs from ids.db file
+
+sub iddel {
+ my ($udom,$idshashref,$uhome)=@_;
+ my %result=();
+ unless (ref($idshashref) eq 'HASH') {
+ return %result;
+ }
+ my %servers=();
+ while (my ($id,$uname) = each(%{$idshashref})) {
+ my $uhom;
+ if ($uhome) {
+ $uhom = $uhome;
+ } else {
+ $uhom=&homeserver($uname,$udom);
+ }
+ if ($uhom ne 'no_host') {
+ if ($servers{$uhom}) {
+ $servers{$uhom}.='&'.&escape($id);
+ } else {
+ $servers{$uhom}=&escape($id);
+ }
+ }
+ }
+ foreach my $server (keys(%servers)) {
+ $result{$server} = &critical('iddel:'.$udom.':'.$servers{$server},$uhome);
+ }
+ return %result;
+}
+
# ------------------------------dump from db file owned by domainconfig user
sub dump_dom {
my ($namespace, $udom, $regexp) = @_;
@@ -1691,14 +1757,13 @@ sub retrieve_inst_usertypes {
my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
if ((ref($domdefs{'inststatustypes'}) eq 'HASH') &&
(ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
- %returnhash = %{$domdefs{'inststatustypes'}};
- @order = @{$domdefs{'inststatusorder'}};
+ return ($domdefs{'inststatustypes'},$domdefs{'inststatusorder'});
} else {
if (defined(&domain($udom,'primary'))) {
my $uhome=&domain($udom,'primary');
my $rep=&reply("inst_usertypes:$udom",$uhome);
if ($rep =~ /^(con_lost|error|no_such_host|refused)/) {
- &logthis("get_dom failed - $rep returned from $uhome in domain: $udom");
+ &logthis("retrieve_inst_usertypes failed - $rep returned from $uhome in domain: $udom");
return (\%returnhash,\@order);
}
my ($hashitems,$orderitems) = split(/:/,$rep);
@@ -1714,10 +1779,10 @@ sub retrieve_inst_usertypes {
push(@order,&unescape($item));
}
} else {
- &logthis("get_dom failed - no primary domain server for $udom");
+ &logthis("retrieve_inst_usertypes failed - no primary domain server for $udom");
}
+ return (\%returnhash,\@order);
}
- return (\%returnhash,\@order);
}
sub is_domainimage {
@@ -1942,12 +2007,15 @@ sub inst_userrules {
# ------------- Get Authentication, Language and User Tools Defaults for Domain
sub get_domain_defaults {
- my ($domain) = @_;
+ my ($domain,$ignore_cache) = @_;
+ return if (($domain eq '') || ($domain eq 'public'));
my $cachetime = 60*60*24;
- my ($result,$cached)=&is_cached_new('domdefaults',$domain);
- if (defined($cached)) {
- if (ref($result) eq 'HASH') {
- return %{$result};
+ unless ($ignore_cache) {
+ my ($result,$cached)=&is_cached_new('domdefaults',$domain);
+ if (defined($cached)) {
+ if (ref($result) eq 'HASH') {
+ return %{$result};
+ }
}
}
my %domdefaults;
@@ -1955,7 +2023,9 @@ sub get_domain_defaults {
&Apache::lonnet::get_dom('configuration',['defaults','quotas',
'requestcourses','inststatus',
'coursedefaults','usersessions',
- 'requestauthor'],$domain);
+ 'requestauthor','selfenrollment',
+ 'coursecategories'],$domain);
+ my @coursetypes = ('official','unofficial','community','textbook');
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
$domdefaults{'auth_def'} = $domconfig{'defaults'}{'auth_def'};
@@ -1973,16 +2043,19 @@ sub get_domain_defaults {
$domdefaults{'defaultquota'} = $domconfig{'quotas'}{'defaultquota'};
} else {
$domdefaults{'defaultquota'} = $domconfig{'quotas'};
- }
+ }
my @usertools = ('aboutme','blog','webdav','portfolio');
foreach my $item (@usertools) {
if (ref($domconfig{'quotas'}{$item}) eq 'HASH') {
$domdefaults{$item} = $domconfig{'quotas'}{$item};
}
}
+ if (ref($domconfig{'quotas'}{'authorquota'}) eq 'HASH') {
+ $domdefaults{'authorquota'} = $domconfig{'quotas'}{'authorquota'};
+ }
}
if (ref($domconfig{'requestcourses'}) eq 'HASH') {
- foreach my $item ('official','unofficial','community') {
+ foreach my $item ('official','unofficial','community','textbook') {
$domdefaults{$item} = $domconfig{'requestcourses'}{$item};
}
}
@@ -1990,13 +2063,20 @@ sub get_domain_defaults {
$domdefaults{'requestauthor'} = $domconfig{'requestauthor'};
}
if (ref($domconfig{'inststatus'}) eq 'HASH') {
- foreach my $item ('inststatustypes','inststatusorder') {
+ foreach my $item ('inststatustypes','inststatusorder','inststatusguest') {
$domdefaults{$item} = $domconfig{'inststatus'}{$item};
}
}
if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
- foreach my $item ('canuse_pdfforms') {
- $domdefaults{$item} = $domconfig{'coursedefaults'}{$item};
+ foreach my $type (@coursetypes) {
+ if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
+ unless ($type eq 'community') {
+ $domdefaults{$type.'credits'} = $domconfig{'coursedefaults'}{'coursecredits'}{$type};
+ }
+ }
+ if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
+ $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};
+ }
}
}
if (ref($domconfig{'usersessions'}) eq 'HASH') {
@@ -2007,8 +2087,45 @@ sub get_domain_defaults {
$domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'};
}
}
- &Apache::lonnet::do_cache_new('domdefaults',$domain,\%domdefaults,
- $cachetime);
+ if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
+ if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {
+ my @settings = ('types','registered','enroll_dates','access_dates','section',
+ 'approval','limit');
+ foreach my $type (@coursetypes) {
+ if (ref($domconfig{'selfenrollment'}{'admin'}{$type}) eq 'HASH') {
+ my @mgrdc = ();
+ foreach my $item (@settings) {
+ if ($domconfig{'selfenrollment'}{'admin'}{$type}{$item} eq '0') {
+ push(@mgrdc,$item);
+ }
+ }
+ if (@mgrdc) {
+ $domdefaults{$type.'selfenrolladmdc'} = join(',',@mgrdc);
+ }
+ }
+ }
+ }
+ if (ref($domconfig{'selfenrollment'}{'default'}) eq 'HASH') {
+ foreach my $type (@coursetypes) {
+ if (ref($domconfig{'selfenrollment'}{'default'}{$type}) eq 'HASH') {
+ foreach my $item (keys(%{$domconfig{'selfenrollment'}{'default'}{$type}})) {
+ $domdefaults{$type.'selfenroll'.$item} = $domconfig{'selfenrollment'}{'default'}{$type}{$item};
+ }
+ }
+ }
+ }
+ }
+ if (ref($domconfig{'coursecategories'}) eq 'HASH') {
+ $domdefaults{'catauth'} = 'std';
+ $domdefaults{'catunauth'} = 'std';
+ if ($domconfig{'coursecategories'}{'auth'}) {
+ $domdefaults{'catauth'} = $domconfig{'coursecategories'}{'auth'};
+ }
+ if ($domconfig{'coursecategories'}{'unauth'}) {
+ $domdefaults{'catunauth'} = $domconfig{'coursecategories'}{'unauth'};
+ }
+ }
+ &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
return %domdefaults;
}
@@ -2708,10 +2825,14 @@ sub can_edit_resource {
return;
}
} else {
+ if ($resurl =~ m{^/?adm/viewclasslist$}) {
+ unless (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
+ return;
+ }
+ } elsif (!$crsedit) {
#
# No edit allowed where CC has switched to student role.
#
- unless ($crsedit) {
return;
}
}
@@ -2758,6 +2879,14 @@ sub can_edit_resource {
$forceedit = 1;
}
$cfile = $resurl;
+ } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
+ $incourse = 1;
+ if ($env{'form.forceedit'}) {
+ $forceview = 1;
+ } else {
+ $forceedit = 1;
+ }
+ $cfile = ($resurl =~ m{^/} ? $resurl : "/$resurl");
}
} elsif ($resurl eq '/res/lib/templates/simpleproblem.problem/smpedit') {
my $template = '/res/lib/templates/simpleproblem.problem';
@@ -2786,11 +2915,18 @@ sub can_edit_resource {
$cfile =~ s{^http://}{};
$cfile = '/adm/wrapper/ext/'.$cfile;
}
+ } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
+ if ($env{'form.forceedit'}) {
+ $forceview = 1;
+ } else {
+ $forceedit = 1;
+ }
+ $cfile = ($resurl =~ m{^/} ? $resurl : "/$resurl");
}
}
if ($uploaded || $incourse) {
$home=&homeserver($cnum,$cdom);
- } else {
+ } elsif ($file !~ m{/$}) {
$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
@@ -2827,9 +2963,13 @@ sub in_course {
my ($udom,$uname,$cdom,$cnum,$type,$hideprivileged) = @_;
if ($hideprivileged) {
my $skipuser;
- if (&privileged($uname,$udom)) {
+ my %coursehash = &coursedescription($cdom.'_'.$cnum);
+ my @possdoms = ($cdom);
+ if ($coursehash{'checkforpriv'}) {
+ push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
+ }
+ if (&privileged($uname,$udom,\@possdoms)) {
$skipuser = 1;
- my %coursehash = &coursedescription($cdom.'_'.$cnum);
if ($coursehash{'nothideprivileged'}) {
foreach my $item (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
my $user;
@@ -3162,7 +3302,9 @@ sub userfileupload {
$codebase,$thumbwidth,$thumbheight,
$resizewidth,$resizeheight,$context,$mimetype);
} else {
- $fname=$env{'form.folder'}.'/'.$fname;
+ if ($env{'form.folder'}) {
+ $fname=$env{'form.folder'}.'/'.$fname;
+ }
return &process_coursefile('uploaddoc',$docuname,$docudom,
$fname,$formname,$parser,
$allfiles,$codebase,$mimetype);
@@ -3177,7 +3319,7 @@ sub userfileupload {
} else {
my $docuname=$env{'user.name'};
my $docudom=$env{'user.domain'};
- if (exists($env{'form.group'})) {
+ if ((exists($env{'form.group'})) || ($context eq 'syllabus')) {
$docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
$docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
}
@@ -3327,7 +3469,9 @@ sub extract_embedded_items {
&add_filetype($allfiles,$attr->{'src'},'src');
}
if (lc($tagname) eq 'a') {
- &add_filetype($allfiles,$attr->{'href'},'href');
+ unless (($attr->{'href'} =~ /^#/) || ($attr->{'href'} eq '')) {
+ &add_filetype($allfiles,$attr->{'href'},'href');
+ }
}
if (lc($tagname) eq 'script') {
my $src;
@@ -3415,8 +3559,26 @@ sub extract_embedded_items {
}
}
}
+ if (lc($tagname) eq 'iframe') {
+ my $src = $attr->{'src'} ;
+ if (($src ne '') && ($src !~ m{^(/|https?://)})) {
+ &add_filetype($allfiles,$src,'src');
+ } elsif ($src =~ m{^/}) {
+ if ($env{'request.course.id'}) {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $url = &hreflocation('',$fullpath);
+ if ($url =~ m{^/uploaded/$cdom/$cnum/docs/(\w+/\d+)/}) {
+ my $relpath = $1;
+ if ($src =~ m{^/uploaded/$cdom/$cnum/docs/\Q$relpath\E/(.+)$}) {
+ &add_filetype($allfiles,$1,'src');
+ }
+ }
+ }
+ }
+ }
if ($t->[4] =~ m{/>$}) {
- pop(@state);
+ pop(@state);
}
} elsif ($t->[0] eq 'E') {
my ($tagname) = ($t->[1]);
@@ -3858,6 +4020,10 @@ sub get_course_adv_roles {
$nothide{$user}=1;
}
}
+ my @possdoms = ($coursehash{'domain'});
+ if ($coursehash{'checkforpriv'}) {
+ push(@possdoms,split(/,/,$coursehash{'checkforpriv'}));
+ }
my %returnhash=();
my %dumphash=
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
@@ -3870,20 +4036,7 @@ sub get_course_adv_roles {
if (($tstart) && ($now<$tstart)) { next; }
my ($role,$username,$domain,$section)=split(/\:/,$entry);
if ($username eq '' || $domain eq '') { next; }
- unless (ref($privileged{$domain}) eq 'HASH') {
- my %dompersonnel =
- &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
- $privileged{$domain} = {};
- foreach my $server (keys(%dompersonnel)) {
- if (ref($dompersonnel{$server}) eq 'HASH') {
- foreach my $user (keys(%{$dompersonnel{$server}})) {
- my ($trole,$uname,$udom) = split(/:/,$user);
- $privileged{$udom}{$uname} = 1;
- }
- }
- }
- }
- if ((exists($privileged{$domain}{$username})) &&
+ if ((&privileged($username,$domain,\@possdoms)) &&
(!$nothide{$username.':'.$domain})) { next; }
if ($role eq 'cr') { next; }
if ($codes) {
@@ -3914,8 +4067,7 @@ sub get_my_roles {
if ($context eq 'userroles') {
%dumphash = &dump('roles',$udom,$uname);
} else {
- %dumphash=
- &dump('nohist_userroles',$udom,$uname);
+ %dumphash = &dump('nohist_userroles',$udom,$uname);
if ($hidepriv) {
my %coursehash=&coursedescription($udom.'_'.$uname);
foreach my $user (split(/\s*\,\s*/,$coursehash{'nothideprivileged'})) {
@@ -3983,28 +4135,15 @@ sub get_my_roles {
}
}
if ($hidepriv) {
+ my @privroles = ('dc','su');
if ($context eq 'userroles') {
- if ((&privileged($username,$domain)) &&
- (!$nothide{$username.':'.$domain})) {
- next;
- }
+ next if (grep(/^\Q$role\E$/,@privroles));
} else {
- unless (ref($privileged{$domain}) eq 'HASH') {
- my %dompersonnel =
- &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
- $privileged{$domain} = {};
- if (keys(%dompersonnel)) {
- foreach my $server (keys(%dompersonnel)) {
- if (ref($dompersonnel{$server}) eq 'HASH') {
- foreach my $user (keys(%{$dompersonnel{$server}})) {
- my ($trole,$uname,$udom) = split(/:/,$user);
- $privileged{$udom}{$uname} = $trole;
- }
- }
- }
- }
+ my $possdoms = [$domain];
+ if (ref($roledoms) eq 'ARRAY') {
+ push(@{$possdoms},@{$roledoms});
}
- if (exists($privileged{$domain}{$username})) {
+ if (&privileged($username,$domain,$possdoms,\@privroles)) {
if (!$nothide{$username.':'.$domain}) {
next;
}
@@ -4096,7 +4235,8 @@ sub courseiddump {
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,
$coursefilter,$hostidflag,$hostidref,$typefilter,$regexp_ok,
$selfenrollonly,$catfilter,$showhidden,$caller,$cloner,$cc_clone,
- $cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner)=@_;
+ $cloneonly,$createdbefore,$createdafter,$creationcontext,$domcloner,
+ $hasuniquecode)=@_;
my $as_hash = 1;
my %returnhash;
if (!$domfilter) { $domfilter=''; }
@@ -4108,18 +4248,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 } ¤t_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, $hasuniquecode)));
+ } 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.':'.$hasuniquecode,
+ $tryserver);
+ }
+
my @pairs=split(/\&/,$rep);
foreach my $item (@pairs) {
my ($key,$value)=split(/\=/,$item,2);
@@ -4225,7 +4379,7 @@ sub get_domain_roles {
}
my $rolelist;
if (ref($roles) eq 'ARRAY') {
- $rolelist = join(':',@{$roles});
+ $rolelist = join('&',@{$roles});
}
my %personnel = ();
@@ -4318,6 +4472,92 @@ sub set_first_access {
return 'already_set';
}
}
+
+sub checkout {
+ my ($symb,$tuname,$tudom,$tcrsid)=@_;
+ my $now=time;
+ my $lonhost=$perlvar{'lonHostID'};
+ my $infostr=&escape(
+ 'CHECKOUTTOKEN&'.
+ $tuname.'&'.
+ $tudom.'&'.
+ $tcrsid.'&'.
+ $symb.'&'.
+ $now.'&'.$ENV{'REMOTE_ADDR'});
+ my $token=&reply('tmpput:'.$infostr,$lonhost);
+ if ($token=~/^error\:/) {
+ &logthis("WARNING: ".
+ "Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
+ "");
+ return '';
+ }
+
+ $token=~s/^(\d+)\_.*\_(\d+)$/$1\*$2\*$lonhost/;
+ $token=~tr/a-z/A-Z/;
+
+ my %infohash=('resource.0.outtoken' => $token,
+ 'resource.0.checkouttime' => $now,
+ 'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
+
+ unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
+ return '';
+ } else {
+ &logthis("WARNING: ".
+ "Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
+ "");
+ }
+
+ if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
+ &escape('Checkout '.$infostr.' - '.
+ $token)) ne 'ok') {
+ return '';
+ } else {
+ &logthis("WARNING: ".
+ "Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
+ "");
+ }
+ return $token;
+}
+
+# ------------------------------------------------------------ Check in an item
+
+sub checkin {
+ my $token=shift;
+ my $now=time;
+ my ($ta,$tb,$lonhost)=split(/\*/,$token);
+ $lonhost=~tr/A-Z/a-z/;
+ my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
+ $dtoken=~s/\W/\_/g;
+ my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
+ split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
+
+ unless (($tuname) && ($tudom)) {
+ &logthis('Check in '.$token.' ('.$dtoken.') failed');
+ return '';
+ }
+
+ unless (&allowed('mgr',$tcrsid)) {
+ &logthis('Check in '.$token.' ('.$dtoken.') unauthorized: '.
+ $env{'user.name'}.' - '.$env{'user.domain'});
+ return '';
+ }
+
+ my %infohash=('resource.0.intoken' => $token,
+ 'resource.0.checkintime' => $now,
+ 'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
+
+ unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
+ return '';
+ }
+
+ if (&log($tudom,$tuname,&homeserver($tuname,$tudom),
+ &escape('Checkin - '.$token)) ne 'ok') {
+ return '';
+ }
+
+ return ($symb,$tuname,$tudom,$tcrsid);
+}
+
# --------------------------------------------- Set Expire Date for Spreadsheet
sub expirespread {
@@ -4767,9 +5007,12 @@ sub restore {
if ($stuname) { $home=&homeserver($stuname,$domain); }
if (!$symb) {
- unless ($symb=escape(&symbread())) { return ''; }
+ return if ($namespace eq 'courserequests');
+ unless ($symb=escape(&symbread())) { return ''; }
} else {
- $symb=&escape(&symbclean($symb));
+ unless ($namespace eq 'courserequests') {
+ $symb=&escape(&symbclean($symb));
+ }
}
if (!$namespace) {
unless ($namespace=$env{'request.course.id'}) {
@@ -4904,22 +5147,95 @@ sub update_released_required {
# -------------------------------------------------See if a user is privileged
sub privileged {
- my ($username,$domain)=@_;
-
- my %rolesdump = &dump("roles", $domain, $username) or return 0;
+ my ($username,$domain,$possdomains,$possroles)=@_;
my $now = time;
+ my $roles;
+ if (ref($possroles) eq 'ARRAY') {
+ $roles = $possroles;
+ } else {
+ $roles = ['dc','su'];
+ }
+ if (ref($possdomains) eq 'ARRAY') {
+ my %privileged = &privileged_by_domain($possdomains,$roles);
+ foreach my $dom (@{$possdomains}) {
+ if (($username =~ /^$match_username$/) && ($domain =~ /^$match_domain$/) &&
+ (ref($privileged{$dom}) eq 'HASH')) {
+ foreach my $role (@{$roles}) {
+ if (ref($privileged{$dom}{$role}) eq 'HASH') {
+ if (exists($privileged{$dom}{$role}{$username.':'.$domain})) {
+ my ($end,$start) = split(/:/,$privileged{$dom}{$role}{$username.':'.$domain});
+ return 1 unless (($end && $end < $now) ||
+ ($start && $start > $now));
+ }
+ }
+ }
+ }
+ }
+ } else {
+ my %rolesdump = &dump("roles", $domain, $username) or return 0;
+ my $now = time;
- for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) {
+ for my $role (@rolesdump{grep { ! /^rolesdef_/ } keys %rolesdump}) {
my ($trole, $tend, $tstart) = split(/_/, $role);
- if (($trole eq 'dc') || ($trole eq 'su')) {
- return 1 unless ($tend && $tend < $now)
- or ($tstart && $tstart > $now);
+ if (grep(/^\Q$trole\E$/,@{$roles})) {
+ return 1 unless ($tend && $tend < $now)
+ or ($tstart && $tstart > $now);
}
- }
-
+ }
+ }
return 0;
}
+sub privileged_by_domain {
+ my ($domains,$roles) = @_;
+ my %privileged = ();
+ my $cachetime = 60*60*24;
+ my $now = time;
+ unless ((ref($domains) eq 'ARRAY') && (ref($roles) eq 'ARRAY')) {
+ return %privileged;
+ }
+ foreach my $dom (@{$domains}) {
+ next if (ref($privileged{$dom}) eq 'HASH');
+ my $needroles;
+ foreach my $role (@{$roles}) {
+ my ($result,$cached)=&is_cached_new('priv_'.$role,$dom);
+ if (defined($cached)) {
+ if (ref($result) eq 'HASH') {
+ $privileged{$dom}{$role} = $result;
+ }
+ } else {
+ $needroles = 1;
+ }
+ }
+ if ($needroles) {
+ my %dompersonnel = &get_domain_roles($dom,$roles);
+ $privileged{$dom} = {};
+ foreach my $server (keys(%dompersonnel)) {
+ if (ref($dompersonnel{$server}) eq 'HASH') {
+ foreach my $item (keys(%{$dompersonnel{$server}})) {
+ my ($trole,$uname,$udom,$rest) = split(/:/,$item,4);
+ my ($end,$start) = split(/:/,$dompersonnel{$server}{$item});
+ next if ($end && $end < $now);
+ $privileged{$dom}{$trole}{$uname.':'.$udom} =
+ $dompersonnel{$server}{$item};
+ }
+ }
+ }
+ if (ref($privileged{$dom}) eq 'HASH') {
+ foreach my $role (@{$roles}) {
+ if (ref($privileged{$dom}{$role}) eq 'HASH') {
+ &do_cache_new('priv_'.$role,$dom,$privileged{$dom}{$role},$cachetime);
+ } else {
+ my %hash = ();
+ &do_cache_new('priv_'.$role,$dom,\%hash,$cachetime);
+ }
+ }
+ }
+ }
+ }
+ return %privileged;
+}
+
# -------------------------------------------------------- Get user privileges
sub rolesinit {
@@ -5029,16 +5345,18 @@ sub rolesinit {
}
sub set_arearole {
- my ($trole,$area,$tstart,$tend,$domain,$username) = @_;
+ my ($trole,$area,$tstart,$tend,$domain,$username,$nolog) = @_;
+ unless ($nolog) {
# log the associated role with the area
- &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
+ &userrolelog($trole,$username,$domain,$area,$tstart,$tend);
+ }
return ('user.role.'.$trole.'.'.$area => $tstart.'.'.$tend);
}
sub custom_roleprivs {
my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_;
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
- my $homsvr=homeserver($rauthor,$rdomain);
+ my $homsvr = &homeserver($rauthor,$rdomain);
if (&hostname($homsvr) ne '') {
my ($rdummy,$roledef)=
&get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
@@ -5159,11 +5477,11 @@ sub set_userprivs {
sub role_status {
my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
- my @pwhere = ();
if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
- (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
+ my ($one,$two) = split(m{\./},$rolekey,2);
+ (undef,undef,$$role) = split(/\./,$one,3);
unless (!defined($$role) || $$role eq '') {
- $$where=join('.',@pwhere);
+ $$where = '/'.$two;
$$trolecode=$$role.'.'.$$where;
($$tstart,$$tend)=split(/\./,$env{$rolekey});
$$tstatus='is';
@@ -5300,7 +5618,7 @@ sub set_adhoc_privileges {
my $area = '/'.$dcdom.'/'.$pickedcourse;
my $spec = $role.'.'.$area;
my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
- $env{'user.name'});
+ $env{'user.name'},1);
my %ccrole = ();
&standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area);
my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole);
@@ -5363,16 +5681,39 @@ 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} = &thaw_unescape($value);
+ }
+ 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);
if ($regexp) {
- $regexp=&escape($regexp);
+ $regexp=&escape($regexp);
} else {
- $regexp='.';
+ $regexp='.';
+ }
+ if (grep { $_ eq $uhome } ¤t_machine_ids()) {
+ # user is hosted on this machine
+ my $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain,
+ $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
+ return %{&unserialize($reply, $escapedkeys)};
}
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
my @pairs=split(/\&/,$rep);
@@ -5380,7 +5721,7 @@ sub dump {
if (!($rep =~ /^error/ )) {
foreach my $item (@pairs) {
my ($key,$value)=split(/=/,$item,2);
- $key = &unescape($key);
+ $key = &unescape($key) unless ($escapedkeys);
next if ($key =~ /^error: 2 /);
$returnhash{$key}=&thaw_unescape($value);
}
@@ -5393,23 +5734,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
@@ -5435,7 +5762,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=();
@@ -6014,6 +6349,7 @@ sub usertools_access {
official => 1,
unofficial => 1,
community => 1,
+ textbook => 1,
);
} elsif ($context eq 'requestauthor') {
%tools = (
@@ -6029,7 +6365,7 @@ sub usertools_access {
}
return if (!defined($tools{$tool}));
- if ((!defined($udom)) || (!defined($uname))) {
+ if (($udom eq '') || ($uname eq '')) {
$udom = $env{'user.domain'};
$uname = $env{'user.name'};
}
@@ -6839,7 +7175,7 @@ sub constructaccess {
if (($allowed eq 'F') || ($allowed eq 'U')) {
# Grant temporary access
my $then=$env{'user.login.time'};
- my $update==$env{'user.update.time'};
+ my $update=$env{'user.update.time'};
if (!$update) { $update = $then; }
my $refresh=$env{'user.refresh.time'};
if (!$refresh) { $refresh = $update; }
@@ -7120,19 +7456,23 @@ sub definerole {
# ---------------- Make a metadata query against the network of library servers
sub metadata_query {
- my ($query,$custom,$customshow,$server_array)=@_;
+ my ($query,$custom,$customshow,$server_array,$domains_hash)=@_;
my %rhash;
my %libserv = &all_library();
my @server_list = (defined($server_array) ? @$server_array
: keys(%libserv) );
for my $server (@server_list) {
+ my $domains = '';
+ if (ref($domains_hash) eq 'HASH') {
+ $domains = $domains_hash->{$server};
+ }
unless ($custom or $customshow) {
- my $reply=&reply("querysend:".&escape($query),$server);
+ my $reply=&reply("querysend:".&escape($query).':::'.&escape($domains),$server);
$rhash{$server}=$reply;
}
else {
my $reply=&reply("querysend:".&escape($query).':'.
- &escape($custom).':'.&escape($customshow),
+ &escape($custom).':'.&escape($customshow).':'.&escape($domains),
$server);
$rhash{$server}=$reply;
}
@@ -7378,8 +7718,8 @@ sub auto_validate_instcode {
}
$response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
&escape($instcode).':'.&escape($owner),$homeserver));
- my ($outcome,$description) = map { &unescape($_); } split('&',$response,2);
- return ($outcome,$description);
+ my ($outcome,$description,$defaultcredits) = map { &unescape($_); } split('&',$response,3);
+ return ($outcome,$description,$defaultcredits);
}
sub auto_create_password {
@@ -7621,17 +7961,20 @@ sub auto_courserequest_checks {
}
sub auto_courserequest_validation {
- my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist) = @_;
+ my ($dom,$owner,$crstype,$inststatuslist,$instcode,$instseclist,$custominfo) = @_;
my ($homeserver,$response);
if ($dom =~ /^$match_domain$/) {
$homeserver = &domain($dom,'primary');
}
- unless ($homeserver eq 'no_host') {
-
+ unless ($homeserver eq 'no_host') {
+ my $customdata;
+ if (ref($custominfo) eq 'HASH') {
+ $customdata = &freeze_escape($custominfo);
+ }
$response=&unescape(&reply('autocrsreqvalidation:'.$dom.':'.&escape($owner).
':'.&escape($crstype).':'.&escape($inststatuslist).
- ':'.&escape($instcode).':'.&escape($instseclist),
- $homeserver));
+ ':'.&escape($instcode).':'.&escape($instseclist).':'.
+ $customdata,$homeserver));
}
return $response;
}
@@ -7650,6 +7993,34 @@ sub auto_validate_class_sec {
return $response;
}
+sub auto_crsreq_update {
+ my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,
+ $code,$accessstart,$accessend,$inbound) = @_;
+ my ($homeserver,%crsreqresponse);
+ if ($cdom =~ /^$match_domain$/) {
+ $homeserver = &domain($cdom,'primary');
+ }
+ unless (($homeserver eq 'no_host') || ($homeserver eq '')) {
+ my $info;
+ if (ref($inbound) eq 'HASH') {
+ $info = &freeze_escape($inbound);
+ }
+ my $response=&reply('autocrsrequpdate:'.$cdom.':'.$cnum.':'.&escape($crstype).
+ ':'.&escape($action).':'.&escape($ownername).':'.
+ &escape($ownerdomain).':'.&escape($fullname).':'.
+ &escape($title).':'.&escape($code).':'.
+ &escape($accessstart).':'.&escape($accessend).':'.$info,$homeserver);
+ unless ($response =~ /(con_lost|error|no_such_host|refused)/) {
+ my @items = split(/&/,$response);
+ foreach my $item (@items) {
+ my ($key,$value) = split('=',$item);
+ $crsreqresponse{&unescape($key)} = &thaw_unescape($value);
+ }
+ }
+ }
+ return \%crsreqresponse;
+}
+
# ------------------------------------------------------- Course Group routines
sub get_coursegroups {
@@ -8319,7 +8690,7 @@ sub modifyuser {
sub modifystudent {
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec,
$end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid,
- $selfenroll,$context,$inststatus)=@_;
+ $selfenroll,$context,$inststatus,$credits)=@_;
if (!$cid) {
unless ($cid=$env{'request.course.id'}) {
return 'not_in_class';
@@ -8331,15 +8702,17 @@ sub modifystudent {
$desiredhome,$email,$inststatus);
unless ($reply eq 'ok') { return $reply; }
# This will cause &modify_student_enrollment to get the uid from the
- # students environment
+ # student's environment
$uid = undef if (!$forceid);
$reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last,
- $gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context);
+ $gene,$usec,$end,$start,$type,$locktype,
+ $cid,$selfenroll,$context,$credits);
return $reply;
}
sub modify_student_enrollment {
- my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,$locktype,$cid,$selfenroll,$context) = @_;
+ my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,
+ $locktype,$cid,$selfenroll,$context,$credits) = @_;
my ($cdom,$cnum,$chome);
if (!$cid) {
unless ($cid=$env{'request.course.id'}) {
@@ -8386,7 +8759,7 @@ sub modify_student_enrollment {
my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum);
my $reply=cput('classlist',
{$user =>
- join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype) },
+ join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits) },
$cdom,$cnum);
if (($reply eq 'ok') || ($reply eq 'delayed')) {
&devalidate_getsection_cache($udom,$uname,$cid);
@@ -8615,7 +8988,7 @@ sub is_course {
my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef,
'.');
- return unless exists($courses{$cdom.'_'.$cnum});
+ return unless(exists($courses{$cdom.'_'.$cnum}));
return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;
}
@@ -8640,6 +9013,9 @@ sub store_userdata {
$namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
}
$namevalue=~s/\&$//;
+ unless ($namespace eq 'courserequests') {
+ $datakey = &escape($datakey);
+ }
$result = &reply("store:$udom:$uname:$namespace:$datakey:".
$namevalue,$uhome);
}
@@ -9462,6 +9838,26 @@ sub resdata {
return undef;
}
+sub get_numsuppfiles {
+ my ($cnum,$cdom,$ignorecache)=@_;
+ my $hashid=$cnum.':'.$cdom;
+ my ($suppcount,$cached);
+ unless ($ignorecache) {
+ ($suppcount,$cached) = &is_cached_new('suppcount',$hashid);
+ }
+ unless (defined($cached)) {
+ my $chome=&homeserver($cnum,$cdom);
+ unless ($chome eq 'no_host') {
+ ($suppcount,my $errors) = (0,0);
+ my $suppmap = 'supplemental.sequence';
+ ($suppcount,$errors) =
+ &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors);
+ }
+ &do_cache_new('suppcount',$hashid,$suppcount,600);
+ }
+ return $suppcount;
+}
+
#
# EXT resource caching routines
#
@@ -9490,7 +9886,7 @@ sub EXT_cache_set {
# --------------------------------------------------------- Value of a Variable
sub EXT {
- my ($varname,$symbparm,$udom,$uname,$usection,$recurse)=@_;
+ my ($varname,$symbparm,$udom,$uname,$usection,$recurse,$cid)=@_;
unless ($varname) { return ''; }
#get real user name/domain, courseid and symb
my $courseid;
@@ -9605,26 +10001,51 @@ sub EXT {
if (!$symbparm) { $symbparm=&symbread(); }
}
- if ($space eq 'title') {
- if (!$symbparm) { $symbparm = $env{'request.filename'}; }
- return &gettitle($symbparm);
- }
+ if ($qualifier eq '') {
+ if ($space eq 'title') {
+ if (!$symbparm) { $symbparm = $env{'request.filename'}; }
+ return &gettitle($symbparm);
+ }
- if ($space eq 'map') {
- my ($map) = &decode_symb($symbparm);
- return &symbread($map);
- }
- if ($space eq 'filename') {
- if ($symbparm) {
- return &clutter((&decode_symb($symbparm))[2]);
+ if ($space eq 'map') {
+ my ($map) = &decode_symb($symbparm);
+ return &symbread($map);
+ }
+ if ($space eq 'maptitle') {
+ my ($map) = &decode_symb($symbparm);
+ return &gettitle($map);
+ }
+ if ($space eq 'filename') {
+ if ($symbparm) {
+ return &clutter((&decode_symb($symbparm))[2]);
+ }
+ return &hreflocation('',$env{'request.filename'});
}
- return &hreflocation('',$env{'request.filename'});
- }
+
+ if ((defined($courseid)) && ($courseid eq $env{'request.course.id'}) && $symbparm) {
+ if ($space eq 'visibleparts') {
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ my $item;
+ if (ref($navmap)) {
+ my $res = $navmap->getBySymb($symbparm);
+ my $parts = $res->parts();
+ if (ref($parts) eq 'ARRAY') {
+ $item = join(',',@{$parts});
+ }
+ undef($navmap);
+ }
+ return $item;
+ }
+ }
+ }
my ($section, $group, @groups);
my ($courselevelm,$courselevel);
- if ($symbparm && defined($courseid) &&
- $courseid eq $env{'request.course.id'}) {
+ if (($courseid eq '') && ($cid)) {
+ $courseid = $cid;
+ }
+ if (($symbparm && $courseid) &&
+ (($courseid eq $env{'request.course.id'}) || ($courseid eq $cid))) {
#print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
@@ -9871,11 +10292,11 @@ sub metadata {
# if it is a non metadata possible uri return quickly
if (($uri eq '') ||
(($uri =~ m|^/*adm/|) &&
- ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
+ ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
return undef;
}
- if (($uri =~ /^priv/ || $uri=~/home\/httpd\/html\/priv/)
+ if (($uri =~ /^priv/ || $uri=~m{^home/httpd/html/priv})
&& &Apache::lonxml::get_state('target') =~ /^(|meta)$/) {
return undef;
}
@@ -10249,78 +10670,6 @@ sub gettitle {
return $title;
}
-sub getdocspath {
- my ($symb) = @_;
- my $path;
- if ($symb) {
- my ($mapurl,$id,$resurl) = &decode_symb($symb);
- if ($resurl=~/\.(sequence|page)$/) {
- $mapurl=$resurl;
- } elsif ($resurl eq 'adm/navmaps') {
- $mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
- }
- my $mapresobj;
- my $navmap = Apache::lonnavmaps::navmap->new();
- if (ref($navmap)) {
- $mapresobj = $navmap->getResourceByUrl($mapurl);
- }
- $mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
- my $type=$2;
- if (ref($mapresobj)) {
- my $pcslist = $mapresobj->map_hierarchy();
- if ($pcslist ne '') {
- foreach my $pc (split(/,/,$pcslist)) {
- next if ($pc <= 1);
- my $res = $navmap->getByMapPc($pc);
- if (ref($res)) {
- my $thisurl = $res->src();
- $thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
- my $thistitle = $res->title();
- $path .= '&'.
- &Apache::lonhtmlcommon::entity_encode($thisurl).'&'.
- &Apache::lonhtmlcommon::entity_encode($thistitle).
- ':'.$res->randompick().
- ':'.$res->randomout().
- ':'.$res->encrypted().
- ':'.$res->randomorder().
- ':'.$res->is_page();
- }
- }
- }
- $path =~ s/^\&//;
- my $maptitle = $mapresobj->title();
- if ($mapurl eq 'default') {
- $maptitle = 'Main Course Documents';
- }
- $path .= ($path ne '')? '&' : ''.
- &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
- &Apache::lonhtmlcommon::entity_encode($maptitle).
- ':'.$mapresobj->randompick().
- ':'.$mapresobj->randomout().
- ':'.$mapresobj->encrypted().
- ':'.$mapresobj->randomorder().
- ':'.$mapresobj->is_page();
- } else {
- my $maptitle = &gettitle($mapurl);
- my $ispage;
- if ($mapurl =~ /\.page$/) {
- $ispage = 1;
- }
- if ($mapurl eq 'default') {
- $maptitle = 'Main Course Documents';
- }
- $path = &Apache::lonhtmlcommon::entity_encode($mapurl).'&'.
- &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
- }
- unless ($mapurl eq 'default') {
- $path = 'default&'.
- &Apache::lonhtmlcommon::entity_encode('Main Course Documents').
- ':::::&'.$path;
- }
- }
- return $path;
-}
-
sub get_slot {
my ($which,$cnum,$cdom)=@_;
if (!$cnum || !$cdom) {
@@ -10374,7 +10723,7 @@ sub get_course_slots {
my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
my ($tmp) = keys(%slots);
if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
- &Apache::lonnet::do_cache_new('allslots',$hashid,\%slots,600);
+ &do_cache_new('allslots',$hashid,\%slots,600);
return %slots;
}
}
@@ -10580,14 +10929,10 @@ sub deversion {
sub symbread {
my ($thisfn,$donotrecurse)=@_;
- my $cache_str;
- if ($thisfn ne '') {
- $cache_str='request.symbread.cached.'.$thisfn;
- if ($env{$cache_str} ne '') {
- return $env{$cache_str};
- }
- } else {
+ my $cache_str='request.symbread.cached.'.$thisfn;
+ if (defined($env{$cache_str})) { return $env{$cache_str}; }
# no filename provided? try from environment
+ unless ($thisfn) {
if ($env{'request.symb'}) {
return $env{$cache_str}=&symbclean($env{'request.symb'});
}
@@ -11004,8 +11349,12 @@ sub rndseed_CODE_64bit5 {
sub setup_random_from_rndseed {
my ($rndseed)=@_;
if ($rndseed =~/([,:])/) {
- my ($num1,$num2)=split(/[,:]/,$rndseed);
- &Math::Random::random_set_seed(abs($num1),abs($num2));
+ my ($num1,$num2) = map { abs($_); } (split(/[,:]/,$rndseed));
+ if ((!$num1) || (!$num2) || ($num1 > 2147483562) || ($num2 > 2147483398)) {
+ &Math::Random::random_set_seed_from_phrase($rndseed);
+ } else {
+ &Math::Random::random_set_seed($num1,$num2);
+ }
} else {
&Math::Random::random_set_seed_from_phrase($rndseed);
}
@@ -11396,7 +11745,9 @@ sub default_login_domain {
sub declutter {
my $thisfn=shift;
if ($thisfn=~m|^/enc/|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
- $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
+ unless ($thisfn=~m{^/home/httpd/html/priv/}) {
+ $thisfn=~s{^/home/httpd/html}{};
+ }
$thisfn=~s/^\///;
$thisfn=~s|^adm/wrapper/||;
$thisfn=~s|^adm/coursedocs/showdoc/||;
@@ -11501,12 +11852,12 @@ sub goodbye {
}
sub get_dns {
- my ($url,$func,$ignore_cache) = @_;
+ my ($url,$func,$ignore_cache,$nocache,$hashref) = @_;
if (!$ignore_cache) {
my ($content,$cached)=
&Apache::lonnet::is_cached_new('dns',$url);
if ($cached) {
- &$func($content);
+ &$func($content,$hashref);
return;
}
}
@@ -11523,7 +11874,7 @@ sub get_dns {
$alldns{$host} = $protocol;
}
while (%alldns) {
- my ($dns) = keys(%alldns);
+ my ($dns) = sort { $b cmp $a } keys(%alldns);
my $ua=new LWP::UserAgent;
$ua->timeout(30);
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
@@ -11531,8 +11882,10 @@ sub get_dns {
delete($alldns{$dns});
next if ($response->is_error());
my @content = split("\n",$response->content);
- &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
- &$func(\@content);
+ unless ($nocache) {
+ &do_cache_new('dns',$url,\@content,30*24*60*60);
+ }
+ &$func(\@content,$hashref);
return;
}
close($config);
@@ -11540,9 +11893,66 @@ sub get_dns {
&logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n");
open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab");
my @content = <$config>;
- &$func(\@content);
+ &$func(\@content,$hashref);
+ return;
+}
+
+# ------------------------------------------------------Get DNS checksums file
+sub parse_dns_checksums_tab {
+ my ($lines,$hashref) = @_;
+ my $lonhost = $perlvar{'lonHostID'};
+ my $machine_dom = &Apache::lonnet::host_domain($lonhost);
+ my $loncaparev = &get_server_loncaparev($machine_dom);
+ my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
+ my $webconfdir = '/etc/httpd/conf';
+ if ($distro =~ /^(ubuntu|debian)(\d+)$/) {
+ $webconfdir = '/etc/apache2';
+ } elsif ($distro =~ /^sles(\d+)$/) {
+ if ($1 >= 10) {
+ $webconfdir = '/etc/apache2';
+ }
+ } elsif ($distro =~ /^suse(\d+\.\d+)$/) {
+ if ($1 >= 10.0) {
+ $webconfdir = '/etc/apache2';
+ }
+ }
+ my ($release,$timestamp) = split(/\-/,$loncaparev);
+ my (%chksum,%revnum);
+ if (ref($lines) eq 'ARRAY') {
+ chomp(@{$lines});
+ my $version = shift(@{$lines});
+ if ($version eq $release) {
+ foreach my $line (@{$lines}) {
+ my ($file,$version,$shasum) = split(/,/,$line);
+ if ($file =~ m{^/etc/httpd/conf}) {
+ if ($webconfdir eq '/etc/apache2') {
+ $file =~ s{^\Q/etc/httpd/conf/\E}{$webconfdir/};
+ }
+ }
+ $chksum{$file} = $shasum;
+ $revnum{$file} = $version;
+ }
+ if (ref($hashref) eq 'HASH') {
+ %{$hashref} = (
+ sums => \%chksum,
+ versions => \%revnum,
+ );
+ }
+ }
+ }
return;
}
+
+sub fetch_dns_checksums {
+ my %checksums;
+ my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
+ my $loncaparev = &get_server_loncaparev($machine_dom,$perlvar{'lonHostID'});
+ my ($release,$timestamp) = split(/\-/,$loncaparev);
+ &get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1,
+ \%checksums);
+ return \%checksums;
+}
+
# ------------------------------------------------------------ Read domain file
{
my $loaded;
@@ -11852,9 +12262,9 @@ sub get_dns {
}
push(@{$iphost{$ip}},@{$name_to_host{$name}});
}
- &Apache::lonnet::do_cache_new('iphost','iphost',
- [\%iphost,\%name_to_ip,\%lonid_to_ip],
- 48*60*60);
+ &do_cache_new('iphost','iphost',
+ [\%iphost,\%name_to_ip,\%lonid_to_ip],
+ 48*60*60);
return %iphost;
}
@@ -11910,15 +12320,48 @@ sub get_dns {
}
$seen{$prim_ip} = 1;
}
- return &Apache::lonnet::do_cache_new('internetnames',$lonid,\@idns,12*60*60);
+ return &do_cache_new('internetnames',$lonid,\@idns,12*60*60);
}
}
sub all_loncaparevs {
- return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10);
+ return qw(1.1 1.2 1.3 2.0 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9 2.10 2.11);
}
+# ------------------------------------------------------- Read loncaparev table
+{
+ sub load_loncaparevs {
+ if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
+ if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
+ while (my $configline=<$config>) {
+ chomp($configline);
+ my ($hostid,$loncaparev)=split(/:/,$configline);
+ $loncaparevs{$hostid}=$loncaparev;
+ }
+ close($config);
+ }
+ }
+ }
+}
+
+# ----------------------------------------------------- Read serverhostID table
+{
+ sub load_serverhomeIDs {
+ if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
+ if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
+ while (my $configline=<$config>) {
+ chomp($configline);
+ my ($name,$id)=split(/:/,$configline);
+ $serverhomeIDs{$name}=$id;
+ }
+ close($config);
+ }
+ }
+ }
+}
+
+
BEGIN {
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
@@ -11994,34 +12437,15 @@ BEGIN {
close($config);
}
-# ---------------------------------------------------------- Read loncaparev table
-{
- if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") {
- if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) {
- while (my $configline=<$config>) {
- chomp($configline);
- my ($hostid,$loncaparev)=split(/:/,$configline);
- $loncaparevs{$hostid}=$loncaparev;
- }
- close($config);
- }
- }
-}
+# --------------------------------------------------------- Read loncaparev table
-# ---------------------------------------------------------- Read serverhostID table
-{
- if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") {
- if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) {
- while (my $configline=<$config>) {
- chomp($configline);
- my ($name,$id)=split(/:/,$configline);
- $serverhomeIDs{$name}=$id;
- }
- close($config);
- }
- }
-}
+&load_loncaparevs();
+
+# ------------------------------------------------------- Read serverhostID table
+
+&load_serverhomeIDs();
+# ---------------------------------------------------------- Read releaseslist XML
{
my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml';
if (-e $file) {
@@ -12220,8 +12644,8 @@ were new keys. I.E. 1:foo will become 1:
Calling convention:
- my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname,$home);
- &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$home);
+ my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname);
+ &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname);
For more detailed information, see lonnet specific documentation.
@@ -12398,7 +12822,7 @@ environment). If no custom name is defi
=item *
-get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec) :
+get_my_roles($uname,$udom,$context,$types,$roles,$roledoms,$withsec,$hidepriv) :
All arguments are optional. Returns a hash of a roles, either for
co-author/assistant author roles for a user's Construction Space
(default), or if $context is 'userroles', roles for the user himself,
@@ -12421,7 +12845,31 @@ Additional optional arguments are: $type
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.
+have active Domain Coordinator role in course's domain or in additional
+domains (specified in 'Domains to check for privileged users' in course
+environment -- set via: Course Settings -> Classlists and staff listing).
+
+=item *
+
+privileged($username,$domain,$possdomains,$possroles) : returns 1 if user
+$username:$domain is a privileged user (e.g., Domain Coordinator or Super User)
+$possdomains and $possroles are optional array refs -- to domains to check and
+roles to check. If $possdomains is not specified, a dump will be done of the
+users' roles.db to check for a dc or su role in any domain. This can be
+time consuming if &privileged is called repeatedly (e.g., when displaying a
+classlist), so in such cases, supplying a $possdomains array is preferred, as
+this then allows &privileged_by_domain() to be used, which caches the identity
+of privileged users, eliminating the need for repeated calls to &dump().
+
+=item *
+
+privileged_by_domain($possdomains,$roles) : returns a hash of a hash of a hash,
+where the outer hash keys are domains specified in the $possdomains array ref,
+next inner hash keys are privileged roles specified in the $roles array ref,
+and the innermost hash contains key = value pairs for username:domain = end:start
+for active or future "privileged" users with that role in that domain. To avoid
+repeated dumps of domain roles -- via &get_domain_roles() -- contents of the
+innerhash are cached using priv_$role and $dom as the identifiers.
=back
@@ -12464,8 +12912,8 @@ or when Autoupdate.pl is run by cron in
modifystudent
modify a student's enrollment and identification information.
-The course id is resolved based on the current users environment.
-This means the envoking user must be a course coordinator or otherwise
+The course id is resolved based on the current user's environment.
+This means the invoking user must be a course coordinator or otherwise
associated with a course.
This call is essentially a wrapper for lonnet::modifyuser and
@@ -12515,7 +12963,9 @@ Inputs:
=item B<$context> role change context (shown in User Management Logs display in a course)
-=item B<$inststatus> institutional status of user - : separated string of escaped status types
+=item B<$inststatus> institutional status of user - : separated string of escaped status types
+
+=item B<$credits> Number of credits student will earn from this class - only needs to be supplied if value needs to be different from default credits for class.
=back
@@ -12523,20 +12973,20 @@ Inputs:
modify_student_enrollment
-Change a students enrollment status in a class. The environment variable
+Change a student's enrollment status in a class. The environment variable
'role.request.course' must be defined for this function to proceed.
Inputs:
=over 4
-=item $udom, students domain
+=item $udom, student's domain
-=item $uname, students name
+=item $uname, student's name
-=item $uid, students user id
+=item $uid, student's user id
-=item $first, students first name
+=item $first, student's first name
=item $middle
@@ -12560,6 +13010,8 @@ Inputs:
=item $context
+=item $credits, number of credits student will earn from this class
+
=back
@@ -12616,7 +13068,7 @@ If defined, the supplied username is use
resdata($name,$domain,$type,@which) : request for current parameter
setting for a specific $type, where $type is either 'course' or 'user',
@what should be a list of parameters to ask about. This routine caches
-answers for 5 minutes.
+answers for 10 minutes.
=item *
@@ -12625,6 +13077,10 @@ data base, returning a hash that is keye
values that are the resource value. I believe that the timestamps and
versions are also returned.
+get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's
+supplemental content area. This routine caches the number of files for
+10 minutes.
+
=back
=head2 Course Modification
@@ -12684,10 +13140,15 @@ resource. Expects the local filesystem p
=item *
-EXT($varname,$symb,$udom,$uname) : evaluates and returns the value of
-a vairety of different possible values, $varname should be a request
-string, and the other parameters can be used to specify who and what
-one is asking about.
+EXT($varname,$symb,$udom,$uname,$usection,$recurse,$cid) : evaluates
+and returns the value of a variety of different possible values,
+$varname should be a request string, and the other parameters can be
+used to specify who and what one is asking about. Ordinarily, $cid
+does not need to be specified, as it is retrived from
+$env{'request.course.id'}, but &Apache::lonnet::EXT() is called
+within lonuserstate::loadmap() when initializing a course, before
+$env{'request.course.id'} has been set, so it needs to be provided
+in that one case.
Possible values for $varname are environment.lastname (or other item
from the envirnment hash), user.name (or someother aspect about the
@@ -12725,7 +13186,7 @@ returns the data handle
=item *
-symbverify($symb,$thisfn,$ecstate) : verifies that $symb actually exists
+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 existence of
@@ -12965,15 +13426,90 @@ server ($udom and $uhome are optional)
=item *
-get_domain_defaults($target_domain) : returns hash with defaults for
-authentication and language in the domain. Keys are: auth_def, auth_arg_def,
-lang_def; corresponsing values are authentication type (internal, krb4, krb5,
-or localauth), initial password or a kerberos realm, language (e.g., en-us).
-Values are retrieved from cache (if current), or from domain's configuration.db
-(if available), or lastly from values in lonTabs/dns_domain,tab,
-or lonTabs/domain.tab.
+get_domain_defaults($target_domain,$ignore_cache) : returns hash with defaults
+for: authentication, language, quotas, timezone, date locale, and portal URL in
+the target domain.
+
+May also include additional key => value pairs for the following groups:
+
+=over
+
+=item
+disk quotas (MB allocated by default to portfolios and authoring spaces).
+
+=over
+
+=item defaultquota, authorquota
+
+=back
+
+=item
+tools (availability of aboutme page, blog, webDAV access for authoring spaces,
+portfolio for users).
+
+=over
+
+=item
+aboutme, blog, webdav, portfolio
+
+=back
+
+=item
+requestcourses: ability to request courses, and how requests are processed.
+
+=over
+
+=item
+official, unofficial, community, textbook
+
+=back
+
+=item
+inststatus: types of institutional affiliation, and order in which they are displayed.
+
+=over
+
+=item
+inststatustypes, inststatusorder, inststatusguest
+
+=back
+
+=item
+coursedefaults: can PDF forms can be created, default credits for courses, default quotas (MB)
+for course's uploaded content.
+
+=over
+
+=item
+canuse_pdfforms, officialcredits, unofficialcredits, textbookcredits, officialquota, unofficialquota, communityquota, textbookquota
+
+=back
+
+=item
+usersessions: set options for hosting of your users in other domains, and hosting of users from other domains
+on your servers.
+
+=over
+
+=item
+remotesessions, hostedsessions
+
+=back
+
+=back
+
+In cases where a domain coordinator has never used the "Set Domain Configuration"
+utility to create a configuration.db file on a domain's primary library server
+only the following domain defaults: auth_def, auth_arg_def, lang_def
+-- corresponding values are authentication type (internal, krb4, krb5,
+or localauth), initial password or a kerberos realm, language (e.g., en-us) --
+will be available. Values are retrieved from cache (if current), unless the
+optional $ignore_cache arg is true, or from domain's configuration.db (if available),
+or lastly from values in lonTabs/dns_domain,tab, or lonTabs/domain.tab.
+
+Typical usage:
-%domdefaults = &get_auth_defaults($target_domain);
+%domdefaults = &get_domain_defaults($target_domain);
=back
@@ -13198,7 +13734,8 @@ filelocation except for hrefs
=item *
-declutter() : declutters URLs (remove docroot, beginning slashes, 'res' etc)
+declutter() : declutters URLs -- remove beginning slashes, 'res' etc.
+also removes beginning /home/httpd/html unless /priv/ follows it.
=back