--- loncom/lonnet/perl/lonnet.pm 2012/12/21 16:58:41 1.1207
+++ loncom/lonnet/perl/lonnet.pm 2013/03/01 04:17:31 1.1216
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1207 2012/12/21 16:58:41 raeburn Exp $
+# $Id: lonnet.pm,v 1.1216 2013/03/01 04:17:31 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
+use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $apache
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
%managerstab);
@@ -634,6 +634,13 @@ 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'});
+ }
+ }
return $handle;
}
@@ -2003,6 +2010,10 @@ sub get_domain_defaults {
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'};
+ }
}
if (ref($domconfig{'usersessions'}) eq 'HASH') {
if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
@@ -2716,10 +2727,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;
}
}
@@ -2766,6 +2781,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';
@@ -5051,9 +5074,11 @@ 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);
}
@@ -5322,7 +5347,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);
@@ -6881,7 +6906,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; }
@@ -7420,8 +7445,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 {
@@ -8361,7 +8386,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';
@@ -8376,12 +8401,14 @@ sub modifystudent {
# students 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'}) {
@@ -8428,7 +8455,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);
@@ -11544,12 +11571,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;
}
}
@@ -11574,8 +11601,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) {
+ &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60);
+ }
+ &$func(\@content,$hashref);
return;
}
close($config);
@@ -11583,9 +11612,62 @@ 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 $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
+ my $loncaparev = &get_server_loncaparev($machine_dom);
+ my ($release,$timestamp) = split(/\-/,$loncaparev);
+ 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;
+ 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;
+ }
+ }
+ if (ref($hashref) eq 'HASH') {
+ %{$hashref} = (
+ sums => \%chksum,
+ versions => \%revnum,
+ );
+ }
+ }
+ }
+ return;
+}
+
+sub fetch_dns_checksums {
+ my %checksums;
+ &get_dns('/adm/dns/checksums',\&parse_dns_checksums_tab,1,1,
+ \%checksums);
+ return \%checksums;
+}
+
# ------------------------------------------------------------ Read domain file
{
my $loaded;
@@ -12123,6 +12205,17 @@ $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;
+ }
+ }
+
}
}
@@ -12558,7 +12651,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
@@ -12603,6 +12698,8 @@ Inputs:
=item $context
+=item $credits, number of credits student will earn from this class
+
=back