--- loncom/lonnet/perl/lonnet.pm 2013/05/29 17:53:50 1.1226
+++ loncom/lonnet/perl/lonnet.pm 2014/03/31 01:09:20 1.1254
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1226 2013/05/29 17:53:50 raeburn Exp $
+# $Id: lonnet.pm,v 1.1254 2014/03/31 01:09:20 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -78,7 +78,7 @@ use Image::Magick;
use Encode;
-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);
@@ -356,8 +356,11 @@ sub get_remote_globals {
}
sub remote_devalidate_cache {
- my ($lonhost,$name,$id) = @_;
- my $response = &reply('devalidatecache:'.&escape($name).':'.&escape($id),$lonhost);
+ my ($lonhost,$cachekeys) = @_;
+ my $items;
+ return unless (ref($cachekeys) eq 'ARRAY');
+ my $cachestr = join('&',@{$cachekeys});
+ my $response = &reply('devalidatecache:'.&escape($cachestr),$lonhost);
return $response;
}
@@ -603,7 +606,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';
@@ -634,13 +637,12 @@ sub check_for_valid_session {
|| !defined($disk_env{'user.domain'})) {
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;
}
@@ -674,7 +676,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;
}
@@ -888,7 +890,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);
@@ -949,7 +961,7 @@ 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) = @_;
my %domconfhash = &Apache::loncommon::get_domainconf($udom);
my %servers = &get_servers($udom);
my $lowest_load = 30000;
@@ -961,14 +973,14 @@ sub choose_server {
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 = '';
@@ -976,7 +988,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 '') {
@@ -1323,7 +1335,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);
@@ -1578,6 +1590,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) = @_;
@@ -1954,12 +1996,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;
@@ -1967,7 +2012,8 @@ sub get_domain_defaults {
&Apache::lonnet::get_dom('configuration',['defaults','quotas',
'requestcourses','inststatus',
'coursedefaults','usersessions',
- 'requestauthor'],$domain);
+ 'requestauthor','selfenrollment'],$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'};
@@ -1985,16 +2031,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};
}
}
@@ -2007,12 +2056,16 @@ sub get_domain_defaults {
}
}
if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
- foreach my $item ('canuse_pdfforms') {
- $domdefaults{$item} = $domconfig{'coursedefaults'}{$item};
- }
- if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
- $domdefaults{'officialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'official'};
- $domdefaults{'unofficialcredits'} = $domconfig{'coursedefaults'}{'coursecredits'}{'unofficial'};
+ $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};
+ 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') {
@@ -2023,6 +2076,34 @@ 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};
+ }
+ }
+ }
+ }
+ }
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
return %domdefaults;
}
@@ -2816,6 +2897,13 @@ 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) {
@@ -3453,8 +3541,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]);
@@ -4111,7 +4217,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=''; }
@@ -4134,7 +4241,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).':'.
@@ -4145,7 +4252,7 @@ sub courseiddump {
$showhidden.':'.$caller.':'.&escape($cloner).':'.
&escape($cc_clone).':'.$cloneonly.':'.
&escape($createdbefore).':'.&escape($createdafter).':'.
- &escape($creationcontext).':'.$domcloner,
+ &escape($creationcontext).':'.$domcloner.':'.$hasuniquecode,
$tryserver);
}
@@ -5145,7 +5252,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);
@@ -5266,11 +5373,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';
@@ -5476,11 +5583,11 @@ sub unserialize {
return {} if $rep =~ /^error/;
my %returnhash=();
- foreach my $item (split /\&/, $rep) {
+ 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);
+ $returnhash{$key} = &thaw_unescape($value);
}
#return %returnhash;
return \%returnhash;
@@ -6141,6 +6248,7 @@ sub usertools_access {
official => 1,
unofficial => 1,
community => 1,
+ textbook => 1,
);
} elsif ($context eq 'requestauthor') {
%tools = (
@@ -6156,7 +6264,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'};
}
@@ -6666,7 +6774,7 @@ sub allowed {
&& &is_portfolio_url($uri)) {
$thisallowed = &portfolio_access($uri);
}
-
+
# Full access at system, domain or course-wide level? Exit.
if ($thisallowed=~/F/) {
return 'F';
@@ -7247,19 +7355,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;
}
@@ -7777,6 +7889,33 @@ sub auto_validate_class_sec {
return $response;
}
+sub auto_crsreq_update {
+ my ($cdom,$cnum,$crstype,$action,$ownername,$ownerdomain,$fullname,$title,
+ $code,$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).':'.$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 {
@@ -8458,7 +8597,7 @@ 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,
@@ -9594,6 +9733,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
#
@@ -9622,7 +9781,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;
@@ -9737,26 +9896,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 '<br>'.$space.' - '.$qualifier.' - '.$spacequalifierrest;
@@ -11616,30 +11800,12 @@ sub parse_dns_checksums_tab {
my (%chksum,%revnum);
if (ref($lines) eq 'ARRAY') {
chomp(@{$lines});
- my $versions = shift(@{$lines});
- my %supported;
- if ($versions =~ /^VERSIONS\:([\w\.\,]+)$/) {
- my $releaseslist = $1;
- if ($releaseslist =~ /,/) {
- map { $supported{$_} = 1; } split(/,/,$releaseslist);
- } elsif ($releaseslist) {
- $supported{$releaseslist} = 1;
- }
- }
- if ($supported{$release}) {
- my $matchthis = 0;
+ my $version = shift(@{$lines});
+ if ($version eq $release) {
foreach my $line (@{$lines}) {
- if ($line =~ /^(\d[\w\.]+)$/) {
- if ($matchthis) {
- last;
- } elsif ($1 eq $release) {
- $matchthis = 1;
- }
- } elsif ($matchthis) {
- my ($file,$version,$shasum) = split(/,/,$line);
- $chksum{$file} = $shasum;
- $revnum{$file} = $version;
- }
+ my ($file,$version,$shasum) = split(/,/,$line);
+ $chksum{$file} = $shasum;
+ $revnum{$file} = $version;
}
if (ref($hashref) eq 'HASH') {
%{$hashref} = (
@@ -11653,8 +11819,11 @@ sub parse_dns_checksums_tab {
}
sub fetch_dns_checksums {
- my %checksums;
- &get_dns('/adm/dns/checksums',\&parse_dns_checksums_tab,1,1,
+ my %checksums;
+ my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
+ my $loncaparev = &get_server_loncaparev($machine_dom);
+ my ($release,$timestamp) = split(/\-/,$loncaparev);
+ &get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1,
\%checksums);
return \%checksums;
}
@@ -12032,9 +12201,42 @@ 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
+{
+ 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
@@ -12111,33 +12313,14 @@ BEGIN {
}
# ---------------------------------------------------------- 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);
- }
- }
-}
+
+&load_loncaparevs();
# ---------------------------------------------------------- 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_serverhomeIDs();
+
+# ---------------------------------------------------------- Read releaseslist XML
{
my $file = $Apache::lonnet::perlvar{'lonTabDir'}.'/releaseslist.xml';
if (-e $file) {
@@ -12196,17 +12379,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;
- }
- }
-
}
}
@@ -12615,8 +12787,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
@@ -12676,20 +12848,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
@@ -12771,7 +12943,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 *
@@ -12780,6 +12952,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
@@ -12839,10 +13015,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
@@ -13120,15 +13301,91 @@ 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
+
+=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