--- loncom/lonnet/perl/lonnet.pm 2012/11/27 23:45:22 1.1199
+++ loncom/lonnet/perl/lonnet.pm 2013/02/02 03:29:33 1.1211
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1199 2012/11/27 23:45:22 raeburn Exp $
+# $Id: lonnet.pm,v 1.1211 2013/02/02 03:29:33 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2716,10 +2716,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;
}
}
@@ -2732,7 +2736,11 @@ sub can_edit_resource {
$incourse = 1;
if ($file =~/\.(htm|html|css|js|txt)$/) {
$cfile = &hreflocation('',$file);
- $forceedit = 1;
+ if ($env{'form.forceedit'}) {
+ $forceview = 1;
+ } else {
+ $forceedit = 1;
+ }
}
} elsif ($resurl =~ m{^/public/$cdom/$cnum/syllabus}) {
$incourse = 1;
@@ -2762,6 +2770,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';
@@ -2794,7 +2810,7 @@ sub can_edit_resource {
}
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
@@ -2820,8 +2836,8 @@ sub is_course_upload {
my ($file,$cnum,$cdom) = @_;
my $uploadpath = &LONCAPA::propath($cdom,$cnum);
$uploadpath =~ s{^\/}{};
- if (($file =~ m{^\Q$uploadpath\E/userfiles/docs/}) ||
- ($file =~ m{^userfiles/\Q$cdom\E/\Q$cnum\E/docs/})) {
+ if (($file =~ m{^\Q$uploadpath\E/userfiles/(docs|supplemental)/}) ||
+ ($file =~ m{^userfiles/\Q$cdom\E/\Q$cnum\E/(docs|supplemental)/})) {
return 1;
}
return;
@@ -6877,7 +6893,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; }
@@ -8039,16 +8055,16 @@ sub assignrole {
# log new user role if status is ok
if ($answer eq 'ok') {
&userrolelog($role,$uname,$udom,$url,$start,$end);
-# for course roles, perform group memberships changes triggered by role change.
- unless ($role =~ /^gr/) {
- &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,
- $origstart,$selfenroll,$context);
- }
if (($role eq 'cc') || ($role eq 'in') ||
($role eq 'ep') || ($role eq 'ad') ||
($role eq 'ta') || ($role eq 'st') ||
($role=~/^cr/) || ($role eq 'gr') ||
($role eq 'co')) {
+# for course roles, perform group memberships changes triggered by role change.
+ unless ($role =~ /^gr/) {
+ &Apache::longroup::group_changes($udom,$uname,$url,$role,$origend,
+ $origstart,$selfenroll,$context);
+ }
&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$selfenroll,$context);
} elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
@@ -10320,7 +10336,8 @@ sub getdocspath {
':'.$res->randompick().
':'.$res->randomout().
':'.$res->encrypted().
- ':'.$res->randomorder();
+ ':'.$res->randomorder().
+ ':'.$res->is_page();
}
}
}
@@ -10335,19 +10352,24 @@ sub getdocspath {
':'.$mapresobj->randompick().
':'.$mapresobj->randomout().
':'.$mapresobj->encrypted().
- ':'.$mapresobj->randomorder();
+ ':'.$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).'::::';
+ &Apache::lonhtmlcommon::entity_encode($maptitle).':::::'.$ispage;
}
unless ($mapurl eq 'default') {
$path = 'default&'.
&Apache::lonhtmlcommon::entity_encode('Main Course Documents').
- '::::&'.$path;
+ ':::::&'.$path;
}
}
return $path;
@@ -10500,21 +10522,32 @@ sub symbverify {
if (tie(%bighash,'GDBM_File',$env{'request.course.fn'}.'.db',
&GDBM_READER(),0640)) {
+ my $noclutter;
if (($thisurl =~ m{^/adm/wrapper/ext/}) || ($thisurl =~ m{^ext/})) {
$thisurl =~ s/\?.+$//;
+ if ($map =~ m{^uploaded/.+\.page$}) {
+ $thisurl =~ s{^(/adm/wrapper|)/ext/}{http://};
+ $thisurl =~ s{^\Qhttp://https://\E}{https://};
+ $noclutter = 1;
+ }
+ }
+ my $ids;
+ if ($noclutter) {
+ $ids=$bighash{'ids_'.$thisurl};
+ } else {
+ $ids=$bighash{'ids_'.&clutter($thisurl)};
}
- my $ids=$bighash{'ids_'.&clutter($thisurl)};
unless ($ids) {
my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;
$ids=$bighash{$idkey};
}
if ($ids) {
# ------------------------------------------------------------------- Has ID(s)
+ if ($thisfn =~ m{^/adm/wrapper/ext/}) {
+ $symb =~ s/\?.+$//;
+ }
foreach my $id (split(/\,/,$ids)) {
my ($mapid,$resid)=split(/\./,$id);
- if ($thisfn =~ m{^/adm/wrapper/ext/}) {
- $symb =~ s/\?.+$//;
- }
if (
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
eq $symb) {
@@ -10525,6 +10558,7 @@ sub symbverify {
($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
($thisurl eq '/adm/navmaps')) {
$okay=1;
+ last;
}
}
}
@@ -10600,14 +10634,14 @@ sub deversion {
sub symbread {
my ($thisfn,$donotrecurse)=@_;
- my $cache_str='request.symbread.cached.'.$thisfn;
- if (defined($env{$cache_str})) {
- if (($thisfn) || ($env{$cache_str} ne '')) {
+ my $cache_str;
+ if ($thisfn ne '') {
+ $cache_str='request.symbread.cached.'.$thisfn;
+ if ($env{$cache_str} ne '') {
return $env{$cache_str};
}
- }
+ } else {
# no filename provided? try from environment
- unless ($thisfn) {
if ($env{'request.symb'}) {
return $env{$cache_str}=&symbclean($env{'request.symb'});
}
@@ -11522,12 +11556,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;
}
}
@@ -11552,8 +11586,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);
@@ -11561,9 +11597,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;