--- loncom/lonnet/perl/lonnet.pm 2013/09/02 14:41:53 1.1172.2.34
+++ loncom/lonnet/perl/lonnet.pm 2014/10/26 13:02:42 1.1172.2.57
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.34 2013/09/02 14:41:53 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.57 2014/10/26 13:02:42 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -75,7 +75,7 @@ use LWP::UserAgent();
use HTTP::Date;
use Image::Magick;
-use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $apache
+use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
%managerstab);
@@ -352,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
@@ -599,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';
@@ -631,12 +633,9 @@ sub check_for_valid_session {
return undef;
}
- if (($r->user() eq '') && ($apache >= 2.4)) {
- if ($disk_env{'user.domain'} eq $r->dir_config('lonDefDomain')) {
- $r->user($disk_env{'user.name'});
- } else {
- $r->user($disk_env{'user.name'}.':'.$disk_env{'user.domain'});
- }
+ if (ref($userhashref) eq 'HASH') {
+ $userhashref->{'name'} = $disk_env{'user.name'};
+ $userhashref->{'domain'} = $disk_env{'user.domain'};
}
return $handle;
@@ -672,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;
}
@@ -886,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);
@@ -947,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 = '';
@@ -974,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 '') {
@@ -1321,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);
@@ -1621,6 +1647,7 @@ sub dump_dom {
sub get_dom {
my ($namespace,$storearr,$udom,$uhome)=@_;
+ return if ($udom eq 'public');
my $items='';
foreach my $item (@$storearr) {
$items.=&escape($item).'&';
@@ -1628,6 +1655,7 @@ sub get_dom {
$items=~s/\&$//;
if (!$udom) {
$udom=$env{'user.domain'};
+ return if ($udom eq 'public');
if (defined(&domain($udom,'primary'))) {
$uhome=&domain($udom,'primary');
} else {
@@ -1731,14 +1759,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);
@@ -1754,10 +1781,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 {
@@ -1982,12 +2009,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;
@@ -1995,7 +2025,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'};
@@ -2025,7 +2057,7 @@ sub get_domain_defaults {
}
}
if (ref($domconfig{'requestcourses'}) eq 'HASH') {
- foreach my $item ('official','unofficial','community') {
+ foreach my $item ('official','unofficial','community','textbook') {
$domdefaults{$item} = $domconfig{'requestcourses'}{$item};
}
}
@@ -2033,19 +2065,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') {
- if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
- $domdefaults{'officialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'official'};
- $domdefaults{'unofficialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'unofficial'};
- }
- if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
- $domdefaults{'officialquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'official'};
- $domdefaults{'unofficialquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'unofficial'};
- $domdefaults{'communityquota'} = $domconfig{'coursedefaults'}{'uploadquota'}{'community'};
+ 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') {
@@ -2056,6 +2089,44 @@ sub get_domain_defaults {
$domdefaults{'hostedsessions'} = $domconfig{'usersessions'}{'hosted'};
}
}
+ 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;
}
@@ -3490,8 +3561,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]);
@@ -4148,7 +4237,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=''; }
@@ -4171,7 +4261,7 @@ sub courseiddump {
&escape($catfilter), $showhidden, $caller,
&escape($cloner), &escape($cc_clone), $cloneonly,
&escape($createdbefore), &escape($createdafter),
- &escape($creationcontext), $domcloner)));
+ &escape($creationcontext), $domcloner, $hasuniquecode)));
} else {
$rep = &reply('courseiddump:'.&host_domain($tryserver).':'.
$sincefilter.':'.&escape($descfilter).':'.
@@ -4182,7 +4272,7 @@ sub courseiddump {
$showhidden.':'.$caller.':'.&escape($cloner).':'.
&escape($cc_clone).':'.$cloneonly.':'.
&escape($createdbefore).':'.&escape($createdafter).':'.
- &escape($creationcontext).':'.$domcloner,
+ &escape($creationcontext).':'.$domcloner.':'.$hasuniquecode,
$tryserver);
}
@@ -5268,7 +5358,7 @@ sub set_arearole {
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);
@@ -5389,11 +5479,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';
@@ -5616,18 +5706,17 @@ sub dump {
if (!$uname) { $uname=$env{'user.name'}; }
my $uhome=&homeserver($uname,$udomain);
- my $reply;
+ if ($regexp) {
+ $regexp=&escape($regexp);
+ } else {
+ $regexp='.';
+ }
if (grep { $_ eq $uhome } ¤t_machine_ids()) {
# user is hosted on this machine
- $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain,
+ my $reply = LONCAPA::Lond::dump_with_regexp(join(':', ($udomain,
$uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
return %{&unserialize($reply, $escapedkeys)};
}
- if ($regexp) {
- $regexp=&escape($regexp);
- } else {
- $regexp='.';
- }
my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
my @pairs=split(/\&/,$rep);
my %returnhash=();
@@ -5675,7 +5764,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=();
@@ -5968,10 +6065,15 @@ sub get_timebased_id {
my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix);
my $id = time;
$newid = $id;
+ if ($idtype eq 'addcode') {
+ $newid .= &sixnum_code();
+ }
my $idtries = 0;
while (exists($inuse{$prefix."\0".$newid}) && $idtries < $maxtries) {
if ($idtype eq 'concat') {
$newid = $id.$idtries;
+ } elsif ($idtype eq 'addcode') {
+ $newid = $newid.&sixnum_code();
} else {
$newid ++;
}
@@ -5988,6 +6090,7 @@ sub get_timebased_id {
$error = 'error saving new item: '.$putresult;
}
} else {
+ undef($newid);
$error = ('error: no unique suffix available for the new item ');
}
# remove lock
@@ -6000,6 +6103,14 @@ sub get_timebased_id {
return ($newid,$dellock,$error);
}
+sub sixnum_code {
+ my $code;
+ for (0..6) {
+ $code .= int( rand(9) );
+ }
+ return $code;
+}
+
# -------------------------------------------------- portfolio access checking
sub portfolio_access {
@@ -6254,6 +6365,7 @@ sub usertools_access {
official => 1,
unofficial => 1,
community => 1,
+ textbook => 1,
);
} elsif ($context eq 'requestauthor') {
%tools = (
@@ -6269,7 +6381,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'};
}
@@ -7865,17 +7977,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;
}
@@ -7894,6 +8009,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 {
@@ -10169,7 +10312,7 @@ sub metadata {
($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;
}
@@ -10802,14 +10945,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'});
}
@@ -11226,8 +11365,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);
}
@@ -11618,7 +11761,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/||;
@@ -11745,7 +11890,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");
@@ -11771,8 +11916,22 @@ sub get_dns {
# ------------------------------------------------------Get DNS checksums file
sub parse_dns_checksums_tab {
my ($lines,$hashref) = @_;
- my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
+ 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') {
@@ -11781,6 +11940,11 @@ sub parse_dns_checksums_tab {
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;
}
@@ -11798,7 +11962,7 @@ sub parse_dns_checksums_tab {
sub fetch_dns_checksums {
my %checksums;
my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
- my $loncaparev = &get_server_loncaparev($machine_dom);
+ 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);
@@ -12178,7 +12342,7 @@ sub fetch_dns_checksums {
}
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
@@ -12356,17 +12520,6 @@ $readit=1;
if ($test != 0) { $_64bit=1; } else { $_64bit=0; }
&logthis(" Detected 64bit platform ($_64bit)");
}
-
- {
- eval {
- ($apache) =
- (Apache2::ServerUtil::get_server_version() =~ m{Apache/(\d+\.\d+)});
- };
- if ($@) {
- $apache = 1.3;
- }
- }
-
}
}
@@ -13289,15 +13442,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
@@ -13522,7 +13750,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