--- loncom/lonnet/perl/lonnet.pm 2013/01/03 19:59:47 1.1172.2.16
+++ loncom/lonnet/perl/lonnet.pm 2013/03/18 00:30:46 1.1172.2.21
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.16 2013/01/03 19:59:47 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.21 2013/03/18 00:30:46 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
+use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $apache
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
%managerstab);
@@ -629,6 +629,15 @@ 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;
}
@@ -1995,8 +2004,9 @@ 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'};
}
}
if (ref($domconfig{'usersessions'}) eq 'HASH') {
@@ -3174,7 +3184,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);
@@ -5041,9 +5053,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);
}
@@ -5312,7 +5326,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);
@@ -7390,8 +7404,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 {
@@ -8331,7 +8345,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';
@@ -8346,12 +8360,13 @@ 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'}) {
@@ -8398,7 +8413,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);
@@ -9883,7 +9898,7 @@ 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;
}
@@ -11513,12 +11528,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;
}
}
@@ -11543,8 +11558,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);
@@ -11552,9 +11569,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;
@@ -12092,6 +12162,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;
+ }
+ }
+
}
}
@@ -12527,7 +12608,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
@@ -12572,6 +12655,8 @@ Inputs:
=item $context
+=item $credits, number of credits student will earn from this class
+
=back
@@ -12737,7 +12822,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