--- loncom/interface/loncommon.pm 2017/03/26 23:47:28 1.1075.2.126
+++ loncom/interface/loncommon.pm 2024/08/17 23:31:37 1.1075.2.161.2.25
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1075.2.126 2017/03/26 23:47:28 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.161.2.25 2024/08/17 23:31:37 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,7 +61,7 @@ use POSIX qw(strftime mktime);
use Apache::lonmenu();
use Apache::lonenc();
use Apache::lonlocal;
-use Apache::lonnet();
+use Apache::lonnavmaps();
use HTML::Entities;
use Apache::lonhtmlcommon();
use Apache::loncoursedata();
@@ -71,6 +71,8 @@ use Apache::lonuserutils();
use Apache::lonuserstate();
use Apache::courseclassifier();
use LONCAPA qw(:DEFAULT :match);
+use LONCAPA::map();
+use HTTP::Request;
use DateTime::TimeZone;
use DateTime::Locale;
use Encode();
@@ -80,6 +82,10 @@ use JSON::DWIW;
use LWP::UserAgent;
use Crypt::DES;
use DynaLoader; # for Crypt::DES version
+use File::Copy();
+use File::Path();
+use String::CRC32();
+use Short::URL();
# ---------------------------------------------- Designs
use vars qw(%defaultdesign);
@@ -194,7 +200,7 @@ BEGIN {
{
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab';
- if ( open(my $fh,"<$langtabfile") ) {
+ if ( open(my $fh,'<',$langtabfile) ) {
while (my $line = <$fh>) {
next if ($line=~/^\#/);
chomp($line);
@@ -215,7 +221,7 @@ BEGIN {
{
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/copyright.tab';
- if ( open (my $fh,"<$copyrightfile") ) {
+ if ( open (my $fh,'<',$copyrightfile) ) {
while (my $line = <$fh>) {
next if ($line=~/^\#/);
chomp($line);
@@ -229,7 +235,7 @@ BEGIN {
{
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/source_copyright.tab';
- if ( open (my $fh,"<$sourcecopyrightfile") ) {
+ if ( open (my $fh,'<',$sourcecopyrightfile) ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -243,7 +249,7 @@ BEGIN {
# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/default.tab';
- if ( open (my $fh,"<$designfile") ) {
+ if ( open (my $fh,'<',$designfile) ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -257,7 +263,7 @@ BEGIN {
{
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab';
- if ( open (my $fh,"<$categoryfile") ) {
+ if ( open (my $fh,'<',$categoryfile) ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -272,7 +278,7 @@ BEGIN {
{
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filetypes.tab';
- if ( open (my $fh,"<$typesfile") ) {
+ if ( open (my $fh,'<',$typesfile) ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -425,7 +431,7 @@ sub studentbrowser_javascript {
+
+ENDJS
+
+}
+
+=pod
+
+=item * &iframe_wrapper_resizejs()
+
+emits javascript used to handle resizing for a page containing
+an iframe, to ensure that the iframe does not obscure any
+standard LON-CAPA menu items.
+
+=back
+
+=cut
+
+#
+# jQuery to use when iframe is in use and a page resize occurs.
+# This script will ensure that the iframe does not obscure any
+# standard LON-CAPA inline menus (primary, secondary, and/or
+# breadcrumbs and Functions menus. Expects javascript from
+# &iframe_wrapper_headjs() to be in head portion of the web page,
+# e.g., by inclusion in second arg passed to &start_page().
+#
+
+sub iframe_wrapper_resizejs {
+ my $offset = 5;
+ &get_unprocessed_cgi($ENV{'QUERY_STRING'},['inhibitmenu']);
+ if (($env{'form.inhibitmenu'} eq 'yes') || ($env{'form.only_body'})) {
+ $offset = 0;
+ }
+ return &Apache::lonhtmlcommon::scripttag(<
+ENDJS
+ }
$endbodytag=
- "
".
+ "$endbodyjs
".
&mt('Continue').''.
$endbodytag;
}
}
+ if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
+ $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
+ }
return $endbodytag;
}
@@ -5783,6 +6757,14 @@ form, .inline {
display: inline;
}
+.LC_menus_content.shown{
+ display: block;
+}
+
+.LC_menus_content.hidden {
+ display: none;
+}
+
.LC_right {
text-align:right;
}
@@ -5803,6 +6785,12 @@ form, .inline {
width:400px;
}
+#LC_collapsible_separator {
+ border: 1px solid black;
+ width: 99.9%;
+ height: 0px;
+}
+
.LC_iframecontainer {
width: 98%;
margin: 0;
@@ -6071,6 +7059,11 @@ td.LC_menubuttons_text {
background: $tabbg;
}
+td.LC_zero_height {
+ line-height: 0;
+ cellpadding: 0;
+}
+
table.LC_data_table {
border: 1px solid #000000;
border-collapse: separate;
@@ -6661,7 +7654,8 @@ table.LC_prior_tries td {
padding: 6px;
}
-.LC_answer_unknown {
+.LC_answer_unknown,
+.LC_answer_warning {
background: orange;
color: black;
padding: 6px;
@@ -6743,6 +7737,7 @@ table.LC_data_table tr > td.LC_docs_entr
color: #990000;
}
+.LC_domprefs_email,
.LC_docs_reinit_warn,
.LC_docs_ext_edit {
font-size: x-small;
@@ -6991,6 +7986,11 @@ fieldset {
/* overflow: hidden; */
}
+fieldset#LC_selectuser {
+ margin: 0;
+ padding: 0;
+}
+
article.geogebraweb div {
margin: 0;
}
@@ -7534,6 +8534,10 @@ a#LC_content_toolbar_edittoplevel {
background-image:url(/res/adm/pages/edittoplevel.gif);
}
+a#LC_content_toolbar_printout {
+ background-image:url(/res/adm/pages/printout.gif);
+}
+
ul#LC_toolbar li a:hover {
background-position: bottom center;
}
@@ -7651,6 +8655,36 @@ ul.LC_funclist li {
cursor:pointer;
}
+.LCisDisabled {
+ cursor: not-allowed;
+ opacity: 0.5;
+}
+
+a[aria-disabled="true"] {
+ color: currentColor;
+ display: inline-block; /* For IE11/ MS Edge bug */
+ pointer-events: none;
+ text-decoration: none;
+}
+
+pre.LC_wordwrap {
+ white-space: pre-wrap;
+ white-space: -moz-pre-wrap;
+ white-space: -pre-wrap;
+ white-space: -o-pre-wrap;
+ word-wrap: break-word;
+}
+
+/*
+ styles used for response display
+*/
+div.LC_radiofoil, div.LC_rankfoil {
+ margin: .5em 0em .5em 0em;
+}
+table.LC_itemgroup {
+ margin-top: 1em;
+}
+
/*
styles used by TTH when "Default set of options to pass to tth/m
when converting TeX" in course settings has been set
@@ -7672,6 +8706,87 @@ span.roman {font-family: serif; font-sty
span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
+/*
+ sections with roles, for content only
+*/
+section[class^="role-"] {
+ padding-left: 10px;
+ padding-right: 5px;
+ margin-top: 8px;
+ margin-bottom: 8px;
+ border: 1px solid #2A4;
+ border-radius: 5px;
+ box-shadow: 0px 1px 1px #BBB;
+}
+section[class^="role-"]>h1 {
+ position: relative;
+ margin: 0px;
+ padding-top: 10px;
+ padding-left: 40px;
+}
+section[class^="role-"]>h1:before {
+ position: absolute;
+ left: -5px;
+ top: 5px;
+}
+section.role-activity>h1:before {
+ content:url('/adm/daxe/images/section_icons/activity.png');
+}
+section.role-advice>h1:before {
+ content:url('/adm/daxe/images/section_icons/advice.png');
+}
+section.role-bibliography>h1:before {
+ content:url('/adm/daxe/images/section_icons/bibliography.png');
+}
+section.role-citation>h1:before {
+ content:url('/adm/daxe/images/section_icons/citation.png');
+}
+section.role-conclusion>h1:before {
+ content:url('/adm/daxe/images/section_icons/conclusion.png');
+}
+section.role-definition>h1:before {
+ content:url('/adm/daxe/images/section_icons/definition.png');
+}
+section.role-demonstration>h1:before {
+ content:url('/adm/daxe/images/section_icons/demonstration.png');
+}
+section.role-example>h1:before {
+ content:url('/adm/daxe/images/section_icons/example.png');
+}
+section.role-explanation>h1:before {
+ content:url('/adm/daxe/images/section_icons/explanation.png');
+}
+section.role-introduction>h1:before {
+ content:url('/adm/daxe/images/section_icons/introduction.png');
+}
+section.role-method>h1:before {
+ content:url('/adm/daxe/images/section_icons/method.png');
+}
+section.role-more_information>h1:before {
+ content:url('/adm/daxe/images/section_icons/more_information.png');
+}
+section.role-objectives>h1:before {
+ content:url('/adm/daxe/images/section_icons/objectives.png');
+}
+section.role-prerequisites>h1:before {
+ content:url('/adm/daxe/images/section_icons/prerequisites.png');
+}
+section.role-remark>h1:before {
+ content:url('/adm/daxe/images/section_icons/remark.png');
+}
+section.role-reminder>h1:before {
+ content:url('/adm/daxe/images/section_icons/reminder.png');
+}
+section.role-summary>h1:before {
+ content:url('/adm/daxe/images/section_icons/summary.png');
+}
+section.role-syntax>h1:before {
+ content:url('/adm/daxe/images/section_icons/syntax.png');
+}
+section.role-warning>h1:before {
+ content:url('/adm/daxe/images/section_icons/warning.png');
+}
+
#LC_minitab_header {
float:left;
width:100%;
@@ -7725,7 +8840,13 @@ Inputs: $title - optional title for the
3- whether the side effect should occur
(side effect of setting
$env{'internal.head.redirect'} to the url
- redirected too)
+ redirected to)
+ 4- whether the redirect target should be
+ the opener of the current (pop-up)
+ window (side effect of setting
+ $env{'internal.head.to_opener'} to
+ 1, if true.
+ 5- whether encrypt check should be skipped
domain -> force to color decorate a page for a specific
domain
function -> force usage of a specific rolish color scheme
@@ -7788,15 +8909,45 @@ sub headtag {
}
}
if (ref($args->{'redirect'})) {
- my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
- $url = &Apache::lonenc::check_encrypt($url);
+ my ($time,$url,$inhibit_continue,$to_opener,$skip_enc_check) = @{$args->{'redirect'}};
+ if (!$skip_enc_check) {
+ $url = &Apache::lonenc::check_encrypt($url);
+ }
if (!$inhibit_continue) {
$env{'internal.head.redirect'} = $url;
}
- $result.=<
+ADDMETA
+ if ($to_opener) {
+ $env{'internal.head.to_opener'} = 1;
+ my $dest = &js_escape($url);
+ my $timeout = int($time * 1000);
+ $result .=<<"ENDJS";
+
+ENDJS
+ } else {
+ $result.=<<"ADDMETA";
ADDMETA
+ }
} else {
unless (($args->{'frameset'}) || ($args->{'js_ready'}) || ($args->{'only_body'}) || ($args->{'no_nav_bar'})) {
my $requrl = $env{'request.uri'};
@@ -7810,43 +8961,99 @@ ADDMETA
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
+ my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+ my ($offload,$offloadoth);
if (ref($domdefs{'offloadnow'}) eq 'HASH') {
- my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
if ($domdefs{'offloadnow'}{$lonhost}) {
- my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
- if (($newserver) && ($newserver ne $lonhost)) {
- my $numsec = 5;
- my $timeout = $numsec * 1000;
- my ($newurl,$locknum,%locks,$msg);
- if ($env{'request.role.adv'}) {
- ($locknum,%locks) = &Apache::lonnet::get_locks();
+ $offload = 1;
+ if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
+ (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
+ unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
+ $offloadoth = 1;
+ $dom_in_use = $env{'user.domain'};
}
- my $disable_submit = 0;
- if ($requrl =~ /$LONCAPA::assess_re/) {
- $disable_submit = 1;
+ }
+ }
+ }
+ unless ($offload) {
+ if (ref($domdefs{'offloadoth'}) eq 'HASH') {
+ if ($domdefs{'offloadoth'}{$lonhost}) {
+ if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
+ (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
+ unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
+ $offload = 1;
+ $offloadoth = 1;
+ $dom_in_use = $env{'user.domain'};
+ }
}
- if ($locknum) {
- my @lockinfo = sort(values(%locks));
- $msg = &mt('Once the following tasks are complete: ')."\\n".
- join(", ",sort(values(%locks)))."\\n".
- &mt('your session will be transferred to a different server, after you click "Roles".');
+ }
+ }
+ }
+ if ($offload) {
+ my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
+ if (($newserver eq '') && ($offloadoth)) {
+ my @domains = &Apache::lonnet::current_machine_domains();
+ if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
+ ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
+ }
+ }
+ if (($newserver) && ($newserver ne $lonhost)) {
+ my $numsec = 5;
+ my $timeout = $numsec * 1000;
+ my ($newurl,$locknum,%locks,$msg);
+ if ($env{'request.role.adv'}) {
+ ($locknum,%locks) = &Apache::lonnet::get_locks();
+ }
+ my $disable_submit = 0;
+ if ($requrl =~ /$LONCAPA::assess_re/) {
+ $disable_submit = 1;
+ }
+ if ($locknum) {
+ my @lockinfo = sort(values(%locks));
+ $msg = &mt('Once the following tasks are complete:')." \n".
+ join(", ",sort(values(%locks)))."\n";
+ if (&show_course()) {
+ $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
} else {
- if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
- $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
- }
- $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
- $newurl = '/adm/switchserver?otherserver='.$newserver;
- if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
- $newurl .= '&role='.$env{'request.role'};
+ $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
+ }
+ } else {
+ if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
+ $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
+ }
+ $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
+ $newurl = '/adm/switchserver?otherserver='.$newserver;
+ if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
+ $newurl .= '&role='.$env{'request.role'};
+ }
+ if ($env{'request.symb'}) {
+ my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
+ if ($shownsymb =~ m{^/enc/}) {
+ my $reqdmajor = 2;
+ my $reqdminor = 11;
+ my $reqdsubminor = 3;
+ my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
+ my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
+ my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
+ if (($major eq '' && $minor eq '') ||
+ (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
+ (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
+ ($reqdsubminor > $subminor))))) {
+ undef($shownsymb);
+ }
}
- if ($env{'request.symb'}) {
- $newurl .= '&symb='.$env{'request.symb'};
- } else {
- $newurl .= '&origurl='.$requrl;
+ if ($shownsymb) {
+ &js_escape(\$shownsymb);
+ $newurl .= '&symb='.$shownsymb;
}
+ } else {
+ my $shownurl = &Apache::lonenc::check_encrypt($requrl);
+ &js_escape(\$shownurl);
+ $newurl .= '&origurl='.$shownurl;
}
- &js_escape(\$msg);
- $result.=<
OFFLOAD
- }
}
}
}
@@ -7878,8 +9084,12 @@ OFFLOAD
$title = 'The LearningOnline Network with CAPA';
}
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
- $result .= '
LON-CAPA '.$title.''
- .'';
+ } else {
+ $result .= ' LON-CAPA '.$title.'';
+ }
+ $result .= "\n".'{'frameset'}) {
$result .= ' /';
}
@@ -7966,7 +9176,8 @@ sub print_suppression {
}
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
- my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
+ my $clientip = &Apache::lonnet::get_requestor_ip();
+ my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
if ($blocked) {
my $checkrole = "cm./$cdom/$cnum";
if ($env{'request.course.sec'} ne '') {
@@ -8083,6 +9294,14 @@ $args - additional optional args support
to lonhtmlcommon::breadcrumbs
group -> includes the current group, if page is for a
specific group
+ use_absolute -> for request for external resource or syllabus, this
+ will contain https:// if server uses
+ https (as per hosts.tab), but request is for http
+ hostname -> hostname, originally from $r->hostname(), (optional).
+ links_disabled -> Links in primary and secondary menus are disabled
+ (Can enable them once page has loaded - see lonroles.pm
+ for an example).
+ links_target -> Target for links, e.g., _parent (optional).
=back
@@ -8095,12 +9314,83 @@ sub start_page {
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
$env{'internal.start_page'}++;
- my ($result,@advtools);
+ my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
if (! exists($args->{'skip_phases'}{'head'}) ) {
$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
}
-
+
+ if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
+ if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
+ unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
+ $args->{'no_primary_menu'} = 1;
+ }
+ unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
+ $args->{'no_inline_menu'} = 1;
+ }
+ if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
+ map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
+ }
+ } else {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
+ if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
+ unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
+ $args->{'no_primary_menu'} = 1;
+ }
+ unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
+ $args->{'no_inline_menu'} = 1;
+ }
+ if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
+ map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
+ }
+ }
+ }
+ ($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ } elsif ($env{'request.course.id'}) {
+ my $expiretime=600;
+ if ((time-$env{'course.'.$env{'request.course.id'}.'.last_cache'}) > $expiretime) {
+ &Apache::lonnet::coursedescription($env{'request.course.id'},{'freshen_cache' => 1});
+ }
+ my ($deeplinkmenu,$menuref);
+ ($menucoll,$deeplinkmenu,$menuref) = &menucoll_in_effect();
+ if ($menucoll) {
+ if (ref($menuref) eq 'HASH') {
+ %menu = %{$menuref};
+ }
+ if ($menu{'top'} eq 'n') {
+ $args->{'no_primary_menu'} = 1;
+ }
+ if ($menu{'inline'} eq 'n') {
+ unless (&Apache::lonnet::allowed('opa')) {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $crstype = &course_type();
+ my $now = time;
+ my $ccrole;
+ if ($crstype eq 'Community') {
+ $ccrole = 'co';
+ } else {
+ $ccrole = 'cc';
+ }
+ if ($env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum}) {
+ my ($start,$end) = split(/\./,$env{'user.role.'.$ccrole.'./'.$cdom.'/'.$cnum});
+ if ((($start) && ($start<0)) ||
+ (($end) && ($end<$now)) ||
+ (($start) && ($now<$start))) {
+ $args->{'no_inline_menu'} = 1;
+ }
+ } else {
+ $args->{'no_inline_menu'} = 1;
+ }
+ }
+ }
+ }
+ }
+
+ my $showncrumbs;
if (! exists($args->{'skip_phases'}{'body'}) ) {
if ($args->{'frameset'}) {
my $attr_string = &make_attr_string($args->{'force_register'},
@@ -8113,7 +9403,8 @@ sub start_page {
$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'no_nav_bar'},
$args->{'bgcolor'}, $args->{'no_inline_link'},
- $args, \@advtools);
+ $args, \@advtools,
+ $ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu,\$showncrumbs);
}
}
@@ -8135,6 +9426,7 @@ sub start_page {
#Breadcrumbs
if (exists($args->{'bread_crumbs'}) or exists($args->{'bread_crumbs_component'})) {
+ unless ($showncrumbs) {
&Apache::lonhtmlcommon::clear_breadcrumbs();
#if any br links exists, add them to the breadcrumbs
if (exists($args->{'bread_crumbs'}) and ref($args->{'bread_crumbs'}) eq 'ARRAY') {
@@ -8148,17 +9440,26 @@ sub start_page {
}
my $menulink;
# if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
- if (exists($args->{'bread_crumbs_nomenu'})) {
+ if ((exists($args->{'bread_crumbs_nomenu'})) ||
+ ($ltiscope eq 'map') || ($ltiscope eq 'resource')) {
$menulink = 0;
} else {
undef($menulink);
}
+ my $linkprotout;
+ if ($env{'request.deeplink.login'}) {
+ my $linkprotout = &Apache::lonmenu::linkprot_exit();
+ if ($linkprotout) {
+ &Apache::lonhtmlcommon::add_breadcrumb_tool('tools',$linkprotout);
+ }
+ }
#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
if(exists($args->{'bread_crumbs_component'})){
$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
- }else{
+ } else {
$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
}
+ }
} elsif (($env{'environment.remote'} eq 'on') &&
($env{'form.inhibitmenu'} ne 'yes') &&
($env{'request.noversionuri'} =~ m{^/res/}) &&
@@ -8200,6 +9501,147 @@ sub end_page {
return $result;
}
+sub menucoll_in_effect {
+ my ($menucoll,$deeplinkmenu,%menu);
+ if ($env{'request.course.id'}) {
+ $menucoll = $env{'course.'.$env{'request.course.id'}.'.menudefault'};
+ if ($env{'request.deeplink.login'}) {
+ my ($deeplink_symb,$deeplink,$check_login_symb);
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ if ($env{'request.noversionuri'} =~ m{^/(res|uploaded)/}) {
+ if ($env{'request.noversionuri'} =~ /\.(page|sequence)$/) {
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (ref($navmap)) {
+ $deeplink = $navmap->get_mapparam(undef,
+ &Apache::lonnet::declutter($env{'request.noversionuri'}),
+ '0.deeplink');
+ } else {
+ $check_login_symb = 1;
+ }
+ } else {
+ my $symb=&Apache::lonnet::symbread();
+ if ($symb) {
+ $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$symb);
+ } else {
+ $check_login_symb = 1;
+ }
+ }
+ } else {
+ $check_login_symb = 1;
+ }
+ if ($check_login_symb) {
+ $deeplink_symb = &deeplink_login_symb($cnum,$cdom);
+ if ($deeplink_symb =~ /\.(page|sequence)$/) {
+ my $mapname = &Apache::lonnet::deversion((&Apache::lonnet::decode_symb($deeplink_symb))[2]);
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (ref($navmap)) {
+ $deeplink = $navmap->get_mapparam(undef,$mapname,'0.deeplink');
+ }
+ } else {
+ $deeplink = &Apache::lonnet::EXT('resource.0.deeplink',$deeplink_symb);
+ }
+ }
+ if ($deeplink ne '') {
+ my ($state,$others,$listed,$scope,$protect,$display,$target) = split(/,/,$deeplink);
+ if ($display =~ /^\d+$/) {
+ $deeplinkmenu = 1;
+ $menucoll = $display;
+ }
+ }
+ }
+ if ($menucoll) {
+ %menu = &page_menu($env{'course.'.$env{'request.course.id'}.'.menucollections'},$menucoll);
+ }
+ }
+ return ($menucoll,$deeplinkmenu,\%menu);
+}
+
+sub deeplink_login_symb {
+ my ($cnum,$cdom) = @_;
+ my $login_symb;
+ if ($env{'request.deeplink.login'}) {
+ $login_symb = &symb_from_tinyurl($env{'request.deeplink.login'},$cnum,$cdom);
+ }
+ return $login_symb;
+}
+
+sub symb_from_tinyurl {
+ my ($url,$cnum,$cdom) = @_;
+ if ($url =~ m{^\Q/tiny/$cdom/\E(\w+)$}) {
+ my $key = $1;
+ my ($tinyurl,$login);
+ my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
+ if (defined($cached)) {
+ $tinyurl = $result;
+ } else {
+ my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
+ my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
+ if ($currtiny{$key} ne '') {
+ $tinyurl = $currtiny{$key};
+ &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
+ }
+ }
+ if ($tinyurl ne '') {
+ my ($cnumreq,$symb) = split(/\&/,$tinyurl);
+ if (wantarray) {
+ return ($cnumreq,$symb);
+ } elsif ($cnumreq eq $cnum) {
+ return $symb;
+ }
+ }
+ }
+ if (wantarray) {
+ return ();
+ } else {
+ return;
+ }
+}
+
+sub usable_exttools {
+ my %tooltypes;
+ if ($env{'request.course.id'}) {
+ if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'}) {
+ if ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'both') {
+ %tooltypes = (
+ crs => 1,
+ dom => 1,
+ );
+ } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'crs') {
+ $tooltypes{'crs'} = 1;
+ } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.exttool'} eq 'dom') {
+ $tooltypes{'dom'} = 1;
+ }
+ } else {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $crstype = lc($env{'course.'.$env{'request.course.id'}.'.type'});
+ if ($crstype eq '') {
+ $crstype = 'course';
+ }
+ if ($crstype eq 'course') {
+ if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'}) {
+ $crstype = 'official';
+ } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.textbook'}) {
+ $crstype = 'textbook';
+ } elsif ($env{'course.'.$env{'request.course.id'}.'.internal.lti'}) {
+ $crstype = 'lti';
+ } else {
+ $crstype = 'unofficial';
+ }
+ }
+ my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
+ if ($domdefaults{$crstype.'domexttool'}) {
+ $tooltypes{'dom'} = 1;
+ }
+ if ($domdefaults{$crstype.'exttool'}) {
+ $tooltypes{'crs'} = 1;
+ }
+ }
+ }
+ return %tooltypes;
+}
+
sub wishlist_window {
return(<<'ENDWISHLIST');
@@ -8308,7 +9758,7 @@ ENDADHOC
}
sub modal_adhoc_inner {
- my ($funcname,$width,$height,$content)=@_;
+ my ($funcname,$width,$height,$content,$possmathjax)=@_;
my $innerwidth=$width-20;
$content=&js_ready(
&start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
@@ -8317,12 +9767,12 @@ sub modal_adhoc_inner {
&end_scrollbox().
&end_page()
);
- return &modal_adhoc_script($funcname,$width,$height,$content);
+ return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
}
sub modal_adhoc_window {
- my ($funcname,$width,$height,$content,$linktext)=@_;
- return &modal_adhoc_inner($funcname,$width,$height,$content).
+ my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
+ return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
"".$linktext."";
}
@@ -8388,8 +9838,9 @@ sub end_togglebox {
}
sub LCprogressbar_script {
- my ($id)=@_;
- return(<
//
ENDPROGRESS
+ } else {
+ return(<
+//
+
+ENDPROGRESS
+ }
}
sub LCprogressbarUpdate_script {
return(<
.ui-progressbar { position:relative; }
+.progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; }
.pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; }
@@ -8428,37 +9901,54 @@ my $LCidcnt;
my $LCcurrentid;
sub LCprogressbar {
- my ($r)=(@_);
+ my ($r,$number_to_do,$preamble)=@_;
$LClastpercent=0;
$LCidcnt++;
$LCcurrentid=$$.'_'.$LCidcnt;
- my $starting=&mt('Starting');
- my $content=(<
$starting
ENDPROGBAR
- &r_print($r,$content.&LCprogressbar_script($LCcurrentid));
+ } else {
+ $starting=&mt('Loading...');
+ $LClastpercent='false';
+ $content=(<
+ $starting
+
+ENDPROGBAR
+ }
+ &r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do));
}
sub LCprogressbarUpdate {
- my ($r,$val,$text)=@_;
- unless ($val) {
- if ($LClastpercent) {
- $val=$LClastpercent;
- } else {
- $val=0;
- }
+ my ($r,$val,$text,$number_to_do)=@_;
+ if ($number_to_do) {
+ unless ($val) {
+ if ($LClastpercent) {
+ $val=$LClastpercent;
+ } else {
+ $val=0;
+ }
+ }
+ if ($val<0) { $val=0; }
+ if ($val>100) { $val=0; }
+ $LClastpercent=$val;
+ unless ($text) { $text=$val.'%'; }
+ } else {
+ $val = 'false';
}
- if ($val<0) { $val=0; }
- if ($val>100) { $val=0; }
- $LClastpercent=$val;
- unless ($text) { $text=$val.'%'; }
$text=&js_ready($text);
&r_print($r,<
//
ENDUPDATE
@@ -8643,14 +10133,21 @@ function expand_div(caller) {
sub simple_error_page {
my ($r,$title,$msg,$args) = @_;
+ my %displayargs;
if (ref($args) eq 'HASH') {
if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
+ if ($args->{'only_body'}) {
+ $displayargs{'only_body'} = 1;
+ }
+ if ($args->{'no_nav_bar'}) {
+ $displayargs{'no_nav_bar'} = 1;
+ }
} else {
$msg = &mt($msg);
}
my $page =
- &Apache::loncommon::start_page($title).
+ &Apache::loncommon::start_page($title,'',\%displayargs).
''.$msg.'
'.
&Apache::loncommon::end_page();
if (ref($r)) {
@@ -9575,7 +11072,7 @@ sub get_secgrprole_info {
}
sub user_picker {
- my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom) = @_;
+ my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
my $currdom = $dom;
my @alldoms = &Apache::lonnet::all_domains();
if (@alldoms == 1) {
@@ -9658,6 +11155,7 @@ sub user_picker {
next if ($option eq 'alc');
next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
next if ($option eq 'crs' && !$env{'request.course.id'});
+ next if (($option eq 'instd') && ($noinstd));
if ($curr_selected{'srchin'} eq $option) {
$srchinsel .= '
';
@@ -10137,11 +11635,15 @@ sub sorted_inst_types {
}
sub get_institutional_codes {
- my ($settings,$allcourses,$LC_code) = @_;
+ my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_;
# Get complete list of course sections to update
my @currsections = ();
my @currxlists = ();
+ my (%unclutteredsec,%unclutteredlcsec);
my $coursecode = $$settings{'internal.coursecode'};
+ my $crskey = $crs.':'.$coursecode;
+ @{$unclutteredsec{$crskey}} = ();
+ @{$unclutteredlcsec{$crskey}} = ();
if ($$settings{'internal.sectionnums'} ne '') {
@currsections = split(/,/,$$settings{'internal.sectionnums'});
@@ -10152,8 +11654,8 @@ sub get_institutional_codes {
}
if (@currxlists > 0) {
- foreach (@currxlists) {
- if (m/^([^:]+):(\w*)$/) {
+ foreach my $xl (@currxlists) {
+ if ($xl =~ /^([^:]+):(\w*)$/) {
unless (grep/^$1$/,@{$allcourses}) {
push(@{$allcourses},$1);
$$LC_code{$1} = $2;
@@ -10161,15 +11663,28 @@ sub get_institutional_codes {
}
}
}
-
+
if (@currsections > 0) {
- foreach (@currsections) {
- if (m/^(\w+):(\w*)$/) {
- my $sec = $coursecode.$1;
+ foreach my $sec (@currsections) {
+ if ($sec =~ m/^(\w+):(\w*)$/ ) {
+ my $instsec = $1;
my $lc_sec = $2;
- unless (grep/^$sec$/,@{$allcourses}) {
+ unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) {
+ push(@{$unclutteredsec{$crskey}},$instsec);
+ push(@{$unclutteredlcsec{$crskey}},$lc_sec);
+ }
+ }
+ }
+ }
+
+ if (@{$unclutteredsec{$crskey}} > 0) {
+ my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec);
+ if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) {
+ for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) {
+ my $sec = $coursecode.$formattedsec{$crskey}[$i];
+ unless (grep/^\Q$sec\E$/,@{$allcourses}) {
push(@{$allcourses},$sec);
- $$LC_code{$sec} = $lc_sec;
+ $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i];
}
}
}
@@ -11419,7 +12934,7 @@ sub modify_html_refs {
return;
}
}
- if (open(my $fh,"<$container")) {
+ if (open(my $fh,'<',$container)) {
$content = join('', <$fh>);
close($fh);
} else {
@@ -11484,7 +12999,7 @@ sub modify_html_refs {
}
}
} else {
- if (open(my $fh,">$container")) {
+ if (open(my $fh,'>',$container)) {
print $fh $content;
close($fh);
$output = ''.&mt('Updated [quant,_1,reference] in [_2].',
@@ -12001,6 +13516,18 @@ sub decompress_uploaded_file {
sub process_decompression {
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
+ unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
+ return '
'.&mt('Not extracted.').'
'.
+ &mt('Unexpected file path.').'
'."\n";
+ }
+ unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
+ return ''.&mt('Not extracted.').'
'.
+ &mt('Unexpected course context.').'
'."\n";
+ }
+ unless ($file eq &Apache::lonnet::clean_filename($file)) {
+ return ''.&mt('Not extracted.').'
'.
+ &mt('Filename contained unexpected characters.').'
'."\n";
+ }
my ($dir,$error,$warning,$output);
if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
$error = &mt('Filename not a supported archive file type.').
@@ -12035,30 +13562,44 @@ sub process_decompression {
}
}
my $numskip = scalar(@to_skip);
- if (($numskip > 0) &&
- ($numskip == $env{'form.archive_itemcount'})) {
+ my $numoverwrite = scalar(@to_overwrite);
+ if (($numskip) && (!$numoverwrite)) {
$warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
} elsif ($dir eq '') {
$error = &mt('Directory containing archive file unavailable.');
} elsif (!$error) {
my ($decompressed,$display);
- if ($numskip > 0) {
+ if (($numskip) || ($numoverwrite)) {
my $tempdir = time.'_'.$$.int(rand(10000));
mkdir("$dir/$tempdir",0755);
- system("mv $dir/$file $dir/$tempdir/$file");
- ($decompressed,$display) =
- &decompress_uploaded_file($file,"$dir/$tempdir");
- foreach my $item (@to_skip) {
- if (($item ne '') && ($item !~ /\.\./)) {
- if (-f "$dir/$tempdir/$item") {
- unlink("$dir/$tempdir/$item");
- } elsif (-d "$dir/$tempdir/$item") {
- system("rm -rf $dir/$tempdir/$item");
+ if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
+ ($decompressed,$display) =
+ &decompress_uploaded_file($file,"$dir/$tempdir");
+ foreach my $item (@to_skip) {
+ if (($item ne '') && ($item !~ /\.\./)) {
+ if (-f "$dir/$tempdir/$item") {
+ unlink("$dir/$tempdir/$item");
+ } elsif (-d "$dir/$tempdir/$item") {
+ &File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
+ }
}
}
+ foreach my $item (@to_overwrite) {
+ if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
+ if (($item ne '') && ($item !~ /\.\./)) {
+ if (-f "$dir/$item") {
+ unlink("$dir/$item");
+ } elsif (-d "$dir/$item") {
+ &File::Path::remove_tree("$dir/$item",{ safe => 1 });
+ }
+ &File::Copy::move("$dir/$tempdir/$item","$dir/$item");
+ }
+ }
+ }
+ if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
+ &File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
+ }
}
- system("mv $dir/$tempdir/* $dir");
- rmdir("$dir/$tempdir");
} else {
($decompressed,$display) =
&decompress_uploaded_file($file,$dir);
@@ -12076,8 +13617,7 @@ sub process_decompression {
if (ref($newdirlistref) eq 'ARRAY') {
foreach my $dir_line (@{$newdirlistref}) {
my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
- unless (($item =~ /^\.+$/) || ($item eq $file) ||
- ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
+ unless (($item =~ /^\.+$/) || ($item eq $file)) {
push(@newitems,$item);
if ($dirptr&$testdir) {
$is_dir{$item} = 1;
@@ -12562,7 +14102,7 @@ END
sub process_extracted_files {
my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
my $numitems = $env{'form.archive_count'};
- return unless ($numitems);
+ return if ((!$numitems) || ($numitems =~ /\D/));
my @ids=&Apache::lonnet::current_machine_ids();
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
%folders,%containers,%mapinner,%prompttofetch);
@@ -12575,7 +14115,7 @@ sub process_extracted_files {
} else {
$prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
$pathtocheck = "$dir_root/$docudom/$docuname/$destination";
- $dir = "$dir_root/$docudom/$docuname";
+ $dir = "$dir_root/$docudom/$docuname";
}
my $currdir = "$dir_root/$destination";
(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
@@ -12664,7 +14204,9 @@ sub process_extracted_files {
'.'.$containers{$outer},1,1);
$newseqid{$i} = $newidx;
unless ($errtext) {
- $result .= ''.&mt('Folder: [_1] added to course',$docstitle).''."\n";
+ $result .= ''.&mt('Folder: [_1] added to course',
+ &HTML::Entities::encode($docstitle,'<>&"'))..
+ ''."\n";
}
}
} else {
@@ -12673,38 +14215,49 @@ sub process_extracted_files {
my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
$title;
- if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
- mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
- }
- if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
- mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
- }
- if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
- system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
- $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
- unless ($ishome) {
- my $fetch = "$newdest{$i}/$title";
- $fetch =~ s/^\Q$prefix$dir\E//;
- $prompttofetch{$fetch} = 1;
+ if (($outer !~ /\D/) &&
+ (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
+ ($newidx !~ /\D/)) {
+ if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
+ mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
}
- }
- $LONCAPA::map::resources[$newidx]=
- $docstitle.':'.$url.':false:normal:res';
- push(@LONCAPA::map::order, $newidx);
- my ($outtext,$errtext)=
- &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
- $docuname.'/'.$folders{$outer}.
- '.'.$containers{$outer},1,1);
- unless ($errtext) {
- if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
- $result .= ''.&mt('File: [_1] added to course',$docstitle).''."\n";
+ if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+ mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
+ }
+ if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+ if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
+ $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
+ unless ($ishome) {
+ my $fetch = "$newdest{$i}/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
+ }
+ }
}
+ $LONCAPA::map::resources[$newidx]=
+ $docstitle.':'.$url.':false:normal:res';
+ push(@LONCAPA::map::order, $newidx);
+ my ($outtext,$errtext)=
+ &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
+ $docuname.'/'.$folders{$outer}.
+ '.'.$containers{$outer},1,1);
+ unless ($errtext) {
+ if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
+ $result .= ''.&mt('File: [_1] added to course',
+ &HTML::Entities::encode($docstitle,'<>&"')).
+ ''."\n";
+ }
+ }
+ } else {
+ $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
+ &HTML::Entities::encode($path,'<>&"')).'
';
}
}
}
}
} else {
- $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
';
+ $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
+ &HTML::Entities::encode($path,'<>&"')).'
';
}
}
for (my $i=1; $i<=$numitems; $i++) {
@@ -12765,7 +14318,9 @@ sub process_extracted_files {
}
if ($fullpath ne '') {
if (-e "$prefix$path") {
- system("mv $prefix$path $fullpath/$title");
+ unless (rename("$prefix$path","$fullpath/$title")) {
+ $warning .= &mt('Failed to rename dependency').'
';
+ }
}
if (-e "$fullpath/$title") {
my $showpath;
@@ -12774,21 +14329,26 @@ sub process_extracted_files {
} else {
$showpath = "/$title";
}
- $result .= ''.&mt('[_1] included as a dependency',$showpath).''."\n";
- }
- unless ($ishome) {
- my $fetch = "$fullpath/$title";
- $fetch =~ s/^\Q$prefix$dir\E//;
- $prompttofetch{$fetch} = 1;
+ $result .= ''.&mt('[_1] included as a dependency',
+ &HTML::Entities::encode($showpath,'<>&"')).
+ ''."\n";
+ unless ($ishome) {
+ my $fetch = "$fullpath/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
+ }
}
}
}
} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
$warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
- $path,$env{'form.archive_content_'.$referrer{$i}}).'
';
+ &HTML::Entities::encode($path,'<>&"'),
+ &HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
+ '
';
}
} else {
- $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'
';
+ $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
+ &HTML::Entities::encode($path)).'
';
}
}
if (keys(%todelete)) {
@@ -13062,12 +14622,15 @@ sub upfile_store {
$env{'form.upfile'}=~s/\n+/\n/gs;
$env{'form.upfile'}=~s/\n+$//gs;
- my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.
- '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;
+ my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
+ '_enroll_'.$env{'request.course.id'}.'_'.
+ time.'_'.$$);
+ return if ($datatoken eq '');
+
{
my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';
- if ( open(my $fh,">$datafile") ) {
+ if ( open(my $fh,'>',$datafile) ) {
print $fh $env{'form.upfile'};
close($fh);
}
@@ -13077,21 +14640,22 @@ sub upfile_store {
=pod
-=item * &load_tmp_file($r)
+=item * &load_tmp_file($r,$datatoken)
Load uploaded file from tmp, $r should be the HTTP Request object,
-needs $env{'form.datatoken'},
+$datatoken is the name to assign to the temporary file.
sets $env{'form.upfile'} to the contents of the file
=cut
sub load_tmp_file {
- my $r=shift;
+ my ($r,$datatoken) = @_;
+ return if ($datatoken eq '');
my @studentdata=();
{
my $studentfile = $r->dir_config('lonDaemons').
- '/tmp/'.$env{'form.datatoken'}.'.tmp';
- if ( open(my $fh,"<$studentfile") ) {
+ '/tmp/'.$datatoken.'.tmp';
+ if ( open(my $fh,'<',$studentfile) ) {
@studentdata=<$fh>;
close($fh);
}
@@ -13099,6 +14663,14 @@ sub load_tmp_file {
$env{'form.upfile'}=join('',@studentdata);
}
+sub valid_datatoken {
+ my ($datatoken) = @_;
+ if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) {
+ return $datatoken;
+ }
+ return;
+}
+
=pod
=item * &upfile_record_sep()
@@ -13987,6 +15559,12 @@ defdom (domain for which to retrieve con
origmail (scalar - email address of recipient from loncapa.conf,
i.e., predates configuration by DC via domainprefs.pm
+$requname username of requester (if mailing type is helpdeskmail)
+
+$requdom domain of requester (if mailing type is helpdeskmail)
+
+$reqemail e-mail address of requester (if mailing type is helpdeskmail)
+
Returns: comma separated list of addresses to which to send e-mail.
=back
@@ -13996,7 +15574,7 @@ Returns: comma separated list of address
############################################################
############################################################
sub build_recipient_list {
- my ($defmail,$mailing,$defdom,$origmail) = @_;
+ my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
my @recipients;
my ($otheremails,$lastresort,$allbcc,$addtext);
my %domconfig =
@@ -14037,11 +15615,98 @@ sub build_recipient_list {
} elsif ($origmail ne '') {
$lastresort = $origmail;
}
+ if ($mailing eq 'helpdeskmail') {
+ if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
+ (keys(%{$domconfig{'contacts'}{'overrides'}}))) {
+ my ($inststatus,$inststatus_checked);
+ if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
+ ($env{'user.domain'} ne 'public')) {
+ $inststatus_checked = 1;
+ $inststatus = $env{'environment.inststatus'};
+ }
+ unless ($inststatus_checked) {
+ if (($requname ne '') && ($requdom ne '')) {
+ if (($requname =~ /^$match_username$/) &&
+ ($requdom =~ /^$match_domain$/) &&
+ (&Apache::lonnet::domain($requdom))) {
+ my $requhome = &Apache::lonnet::homeserver($requname,
+ $requdom);
+ unless ($requhome eq 'no_host') {
+ my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
+ $inststatus = $userenv{'inststatus'};
+ $inststatus_checked = 1;
+ }
+ }
+ }
+ }
+ unless ($inststatus_checked) {
+ if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
+ my %srch = (srchby => 'email',
+ srchdomain => $defdom,
+ srchterm => $reqemail,
+ srchtype => 'exact');
+ my %srch_results = &Apache::lonnet::usersearch(\%srch);
+ foreach my $uname (keys(%srch_results)) {
+ if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
+ $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
+ $inststatus_checked = 1;
+ last;
+ }
+ }
+ unless ($inststatus_checked) {
+ my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
+ if ($dirsrchres eq 'ok') {
+ foreach my $uname (keys(%srch_results)) {
+ if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
+ $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
+ $inststatus_checked = 1;
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ if ($inststatus ne '') {
+ foreach my $status (split(/\:/,$inststatus)) {
+ if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
+ my @contacts = ('adminemail','supportemail');
+ foreach my $item (@contacts) {
+ if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
+ my $addr = $domconfig{'contacts'}{'overrides'}{$status};
+ if (!grep(/^\Q$addr\E$/,@recipients)) {
+ push(@recipients,$addr);
+ }
+ }
+ }
+ $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
+ if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
+ my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
+ my @ok_bccs;
+ foreach my $bcc (@bccs) {
+ $bcc =~ s/^\s+//g;
+ $bcc =~ s/\s+$//g;
+ if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
+ if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
+ push(@ok_bccs,$bcc);
+ }
+ }
+ }
+ if (@ok_bccs > 0) {
+ $allbcc = join(', ',@ok_bccs);
+ }
+ }
+ $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
+ last;
+ }
+ }
+ }
+ }
+ }
} elsif ($origmail ne '') {
$lastresort = $origmail;
}
-
- if (($mailing eq 'helpdesk') && ($lastresort ne '')) {
+ if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
@@ -14121,7 +15786,7 @@ sub build_recipient_list {
}
}
}
- if ($mailing eq 'helpdesk') {
+ if ($mailing eq 'helpdeskmail') {
if ((!@recipients) && ($lastresort ne '')) {
push(@recipients,$lastresort);
}
@@ -14226,6 +15891,8 @@ jsarray (reference to array of categorie
subcats (reference to hash of arrays containing all subcategories within each
category, -recursive)
+maxd (reference to hash used to hold max depth for all top-level categories).
+
Returns: nothing
Side effects: populates trails and allitems hash references.
@@ -14233,7 +15900,7 @@ Side effects: populates trails and allit
=cut
sub extract_categories {
- my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_;
+ my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_;
if (ref($categories) eq 'HASH') {
&gather_categories($categories,$cats,$idx,$jsarray);
if (ref($cats->[0]) eq 'ARRAY') {
@@ -14259,12 +15926,15 @@ sub extract_categories {
if (ref($subcats) eq 'HASH') {
push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1');
}
- &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats);
+ &recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd);
}
} else {
if (ref($subcats) eq 'HASH') {
$subcats->{$item} = [];
}
+ if (ref($maxd) eq 'HASH') {
+ $maxd->{$name} = 1;
+ }
}
}
}
@@ -14302,13 +15972,13 @@ Side effects: populates trails and allit
=cut
sub recurse_categories {
- my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;
+ my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
my $shallower = $depth - 1;
if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
my $name = $cats->[$depth]{$category}[$k];
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
- my $trailstr = join(' -> ',(@{$parents},$category));
+ my $trailstr = join(' » ',(@{$parents},$category));
if ($allitems->{$item} eq '') {
push(@{$trails},$trailstr);
$allitems->{$item} = scalar(@{$trails})-1;
@@ -14329,16 +15999,21 @@ sub recurse_categories {
}
}
&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents,
- $subcats);
+ $subcats,$maxd);
pop(@{$parents});
}
} else {
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
- my $trailstr = join(' -> ',(@{$parents},$category));
+ my $trailstr = join(' » ',(@{$parents},$category));
if ($allitems->{$item} eq '') {
push(@{$trails},$trailstr);
$allitems->{$item} = scalar(@{$trails})-1;
}
+ if (ref($maxd) eq 'HASH') {
+ if ($depth > $maxd->{$parents->[0]}) {
+ $maxd->{$parents->[0]} = $depth;
+ }
+ }
}
return;
}
@@ -14370,8 +16045,8 @@ sub assign_categories_table {
my ($cathash,$currcat,$type,$disabled) = @_;
my $output;
if (ref($cathash) eq 'HASH') {
- my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);
- &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);
+ my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
+ &extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
$maxdepth = scalar(@cats);
if (@cats > 0) {
my $itemcount = 0;
@@ -14581,7 +16256,7 @@ sub commit_studentrole {
}
$oldsecurl = $uurl;
$expire_role_result =
- &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','',$context);
+ &Apache::lonnet::assignrole($udom,$uname,$uurl,'st',$now,'','','',$context);
if ($env{'request.course.sec'} ne '') {
if ($expire_role_result eq 'refused') {
my @roles = ('st');
@@ -14693,7 +16368,8 @@ sub check_clone {
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'};
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid);
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom);
- my $clonemsg;
+ my $clonetitle;
+ my @clonemsg;
my $can_clone = 0;
my $lctype = lc($args->{'crstype'});
if ($lctype ne 'community') {
@@ -14701,16 +16377,38 @@ sub check_clone {
}
if ($clonehome eq 'no_host') {
if ($args->{'crstype'} eq 'Community') {
- $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
+ push(@clonemsg,({
+ mt => 'No new community created.',
+ args => [],
+ },
+ {
+ mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',
+ args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}],
+ }));
} else {
- $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
- }
+ push(@clonemsg,({
+ mt => 'No new course created.',
+ args => [],
+ },
+ {
+ mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',
+ args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
+ }));
+ }
} else {
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1});
+ $clonetitle = $clonedesc{'description'};
if ($args->{'crstype'} eq 'Community') {
if ($clonedesc{'type'} ne 'Community') {
- $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'});
- return ($can_clone, $clonemsg, $cloneid, $clonehome);
+ push(@clonemsg,({
+ mt => 'No new community created.',
+ args => [],
+ },
+ {
+ mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',
+ args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}],
+ }));
+ return ($can_clone,\@clonemsg,$cloneid,$clonehome);
}
}
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
@@ -14799,20 +16497,34 @@ sub check_clone {
}
unless ($can_clone) {
if ($args->{'crstype'} eq 'Community') {
- $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ push(@clonemsg,({
+ mt => 'No new community created.',
+ args => [],
+ },
+ {
+ mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',
+ args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
+ }));
} else {
- $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'});
+ push(@clonemsg,({
+ mt => 'No new course created.',
+ args => [],
+ },
+ {
+ mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',
+ args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}],
+ }));
}
}
}
}
- return ($can_clone, $clonemsg, $cloneid, $clonehome);
+ return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle);
}
sub construct_course {
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
- $cnum,$category,$coderef) = @_;
- my $outcome;
+ $cnum,$category,$coderef,$callercontext,$user_lh) = @_;
+ my ($outcome,$msgref,$clonemsgref);
my $linefeed = '
'."\n";
if ($context eq 'auto') {
$linefeed = "\n";
@@ -14821,18 +16533,11 @@ sub construct_course {
#
# Are we cloning?
#
- my ($can_clone, $clonemsg, $cloneid, $clonehome);
+ my ($can_clone,$cloneid,$clonehome,$clonetitle);
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) {
- ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed);
- if ($context ne 'auto') {
- if ($clonemsg ne '') {
- $clonemsg = ''.$clonemsg.'';
- }
- }
- $outcome .= $clonemsg.$linefeed;
-
+ ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
if (!$can_clone) {
- return (0,$outcome);
+ return (0,$outcome,$clonemsgref);
}
}
@@ -14850,15 +16555,20 @@ sub construct_course {
$args->{'ccuname'}.':'.
$args->{'ccdomain'},
$args->{'crstype'},
- $cnum,$context,$category);
+ $cnum,$context,$category,
+ $callercontext);
# Note: The testing routines depend on this being output; see
# Utils::Course. This needs to at least be output as a comment
# if anyone ever decides to not show this, and Utils::Course::new
# will need to be suitably modified.
- $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
+ if (($callercontext eq 'auto') && ($user_lh ne '')) {
+ $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
+ } else {
+ $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed;
+ }
if ($$courseid =~ /^error:/) {
- return (0,$outcome);
+ return (0,$outcome,$clonemsgref);
}
#
@@ -14867,23 +16577,37 @@ sub construct_course {
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid);
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom);
if ($crsuhome eq 'no_host') {
- $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed;
- return (0,$outcome);
+ if (($callercontext eq 'auto') && ($user_lh ne '')) {
+ $outcome .= &mt_user($user_lh,
+ 'Course creation failed, unrecognized course home server.');
+ } else {
+ $outcome .= &mt('Course creation failed, unrecognized course home server.');
+ }
+ $outcome .= $linefeed;
+ return (0,$outcome,$clonemsgref);
}
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed;
#
# Do the cloning
-#
+#
+ my @clonemsg;
if ($can_clone && $cloneid) {
- $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome);
- if ($context ne 'auto') {
- $clonemsg = ''.$clonemsg.'';
- }
- $outcome .= $clonemsg.$linefeed;
+ push(@clonemsg,
+ {
+ mt => 'Created [_1] by cloning from [_2]',
+ args => [$crstype,$clonetitle],
+ });
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum);
# Copy all files
- &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'});
+ my @info =
+ &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},
+ $args->{'dateshift'},$args->{'crscode'},
+ $args->{'ccuname'}.':'.$args->{'ccdomain'},
+ $args->{'tinyurls'});
+ if (@info) {
+ push(@clonemsg,@info);
+ }
# Restore URL
$cenv{'url'}=$oldcenv{'url'};
# Restore title
@@ -14908,8 +16632,7 @@ sub construct_course {
'plc.users.denied',
'hidefromcat',
'checkforpriv',
- 'categories',
- 'internal.uniquecode'],
+ 'categories'],
$$crsudom,$$crsunum);
if ($args->{'textbook'}) {
$cenv{'internal.textbook'} = $args->{'textbook'};
@@ -14924,6 +16647,9 @@ sub construct_course {
if ($args->{'crstype'}) {
$cenv{'type'}=$args->{'crstype'};
}
+ if ($args->{'lti'}) {
+ $cenv{'internal.lti'}=$args->{'lti'};
+ }
if ($args->{'crsid'}) {
$cenv{'courseid'}=$args->{'crsid'};
}
@@ -14945,6 +16671,7 @@ sub construct_course {
$cenv{'internal.defaultcredits'} = $args->{'defaultcredits'};
}
my @badclasses = (); # Used to accumulate sections/crosslistings that did not pass classlist access check for course owner.
+ my @oklcsecs = (); # Used to accumulate LON-CAPA sections for validated institutional sections.
if ($args->{'crssections'}) {
$cenv{'internal.sectionnums'} = '';
if ($args->{'crssections'} =~ m/,/) {
@@ -14958,7 +16685,11 @@ sub construct_course {
my $class = $args->{'crscode'}.$sec;
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
$cenv{'internal.sectionnums'} .= $item.',';
- unless ($addcheck eq 'ok') {
+ if ($addcheck eq 'ok') {
+ unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
+ push(@oklcsecs,$gp);
+ }
+ } else {
push(@badclasses,$class);
}
}
@@ -14986,7 +16717,11 @@ sub construct_course {
my ($xl,$gp) = split/:/,$item;
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
$cenv{'internal.crosslistings'} .= $item.',';
- unless ($addcheck eq 'ok') {
+ if ($addcheck eq 'ok') {
+ unless (grep(/^\Q$gp\E$/,@oklcsecs)) {
+ push(@oklcsecs,$gp);
+ }
+ } else {
push(@badclasses,$xl);
}
}
@@ -15049,6 +16784,36 @@ sub construct_course {
if ($args->{'no_end_date'}) {
$args->{'endaccess'} = 0;
}
+# If an official course with institutional sections is created by cloning
+# an existing course, section-specific hiding of course totals in student's
+# view of grades as copied from cloned course, will be checked for valid
+# sections.
+ if (($can_clone && $cloneid) &&
+ ($cenv{'internal.coursecode'} ne '') &&
+ ($cenv{'grading'} eq 'standard') &&
+ ($cenv{'hidetotals'} ne '') &&
+ ($cenv{'hidetotals'} ne 'all')) {
+ my @hidesecs;
+ my $deletehidetotals;
+ if (@oklcsecs) {
+ foreach my $sec (split(/,/,$cenv{'hidetotals'})) {
+ if (grep(/^\Q$sec$/,@oklcsecs)) {
+ push(@hidesecs,$sec);
+ }
+ }
+ if (@hidesecs) {
+ $cenv{'hidetotals'} = join(',',@hidesecs);
+ } else {
+ $deletehidetotals = 1;
+ }
+ } else {
+ $deletehidetotals = 1;
+ }
+ if ($deletehidetotals) {
+ delete($cenv{'hidetotals'});
+ &Apache::lonnet::del('environment',['hidetotals'],$$crsudom,$$crsunum);
+ }
+ }
$cenv{'internal.autostart'}=$args->{'enrollstart'};
$cenv{'internal.autoend'}=$args->{'enrollend'};
$cenv{'default_enrollment_start_date'}=$args->{'startaccess'};
@@ -15150,19 +16915,23 @@ sub construct_course {
# Open all assignments
#
if ($args->{'openall'}) {
+ my $opendate = time;
+ if ($args->{'openallfrom'} =~ /^\d+$/) {
+ $opendate = $args->{'openallfrom'};
+ }
my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate';
- my %storecontent = ($storeunder => time,
+ my %storecontent = ($storeunder => $opendate,
$storeunder.'.type' => 'date_start');
-
- $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput
- ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
+ $outcome .= &mt('All assignments open starting [_1]',
+ &Apache::lonlocal::locallocaltime($opendate)).': '.
+ &Apache::lonnet::cput
+ ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed;
}
#
# Set first page
#
unless (($args->{'nonstandard'}) || ($args->{'firstres'} eq 'blank')
|| ($cloneid)) {
- use LONCAPA::map;
$outcome .= &mt('Setting first resource').': ';
my $map = '/uploaded/'.$$crsudom.'/'.$$crsunum.'/default.sequence';
@@ -15185,7 +16954,7 @@ sub construct_course {
$outcome .= ($fatal?$errtext:'write ok').$linefeed;
}
- return (1,$outcome);
+ return (1,$outcome,\@clonemsg);
}
sub make_unique_code {
@@ -15269,12 +17038,13 @@ sub group_term {
}
sub course_types {
- my @types = ('official','unofficial','community','textbook');
+ my @types = ('official','unofficial','community','textbook','lti');
my %typename = (
official => 'Official course',
unofficial => 'Unofficial course',
community => 'Community',
textbook => 'Textbook course',
+ lti => 'LTI provider',
);
return (\@types,\%typename);
}
@@ -15354,6 +17124,24 @@ sub compare_arrays {
return @difference;
}
+sub lon_status_items {
+ my %defaults = (
+ E => 100,
+ W => 4,
+ N => 1,
+ U => 5,
+ threshold => 200,
+ sysmail => 2500,
+ );
+ my %names = (
+ E => 'Errors',
+ W => 'Warnings',
+ N => 'Notices',
+ U => 'Unsent',
+ );
+ return (\%defaults,\%names);
+}
+
# -------------------------------------------------------- Initialize user login
sub init_user_environment {
my ($r, $username, $domain, $authhost, $form, $args) = @_;
@@ -15363,7 +17151,8 @@ sub init_user_environment {
# See if old ID present, if so, remove
- my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
+ my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv,
+ $coauthorenv);
my $now=time;
if ($public) {
@@ -15389,7 +17178,23 @@ sub init_user_environment {
opendir(DIR,$lonids);
while ($filename=readdir(DIR)) {
if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) {
- unlink($lonids.'/'.$filename);
+ if (tie(my %oldenv,'GDBM_File',"$lonids/$filename",
+ &GDBM_READER(),0640)) {
+ my $linkedfile;
+ if (exists($oldenv{'user.linkedenv'})) {
+ $linkedfile = $oldenv{'user.linkedenv'};
+ }
+ untie(%oldenv);
+ if (unlink("$lonids/$filename")) {
+ if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
+ if (-l "$lonids/$linkedfile.id") {
+ unlink("$lonids/$linkedfile.id");
+ }
+ }
+ }
+ } else {
+ unlink($lonids.'/'.$filename);
+ }
}
}
closedir(DIR);
@@ -15412,7 +17217,7 @@ sub init_user_environment {
# Initialize roles
- ($userroles,$firstaccenv,$timerintenv) =
+ ($userroles,$firstaccenv,$timerintenv,$coauthorenv) =
&Apache::lonnet::rolesinit($domain,$username,$authhost);
}
# ------------------------------------ Check browser type and MathML capability
@@ -15440,6 +17245,7 @@ sub init_user_environment {
# --------------------------------------------------------- Write first profile
{
+ my $ip = &Apache::lonnet::get_requestor_ip();
my %initial_env =
("user.name" => $username,
"user.domain" => $domain,
@@ -15458,7 +17264,7 @@ sub init_user_environment {
"request.course.sec" => '',
"request.role" => 'cm',
"request.role.adv" => $env{'user.adv'},
- "request.host" => $ENV{'REMOTE_ADDR'},);
+ "request.host" => $ip,);
if ($form->{'localpath'}) {
$initial_env{"browser.localpath"} = $form->{'localpath'};
@@ -15490,19 +17296,36 @@ sub init_user_environment {
my %is_adv = ( is_adv => $env{'user.adv'} );
my %domdef = &Apache::lonnet::get_domain_defaults($domain);
- foreach my $tool ('aboutme','blog','webdav','portfolio') {
+ foreach my $tool ('aboutme','blog','webdav','portfolio','timezone') {
$userenv{'availabletools.'.$tool} =
&Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
undef,\%userenv,\%domdef,\%is_adv);
}
- foreach my $crstype ('official','unofficial','community','textbook') {
+ foreach my $crstype ('official','unofficial','community','textbook','lti') {
$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,
'reload','requestcourses',
\%userenv,\%domdef,\%is_adv);
}
+ if ((ref($userroles) eq 'HASH') && ($userroles->{'user.author'}) &&
+ (exists($userroles->{"user.role.au./$domain/"}))) {
+ if ($userenv{'authoreditors'}) {
+ $userenv{'editors'} = $userenv{'authoreditors'};
+ } elsif ($domdef{'editors'} ne '') {
+ $userenv{'editors'} = $domdef{'editors'};
+ } else {
+ $userenv{'editors'} = 'edit,xml';
+ }
+ if ($userenv{'authorarchive'}) {
+ $userenv{'canarchive'} = 1;
+ } elsif (($userenv{'authorarchive'} eq '') &&
+ ($domdef{'archive'})) {
+ $userenv{'canarchive'} = 1;
+ }
+ }
+
$userenv{'canrequest.author'} =
&Apache::lonnet::usertools_access($username,$domain,'requestauthor',
'reload','requestauthor',
@@ -15531,6 +17354,11 @@ sub init_user_environment {
if (ref($timerintenv) eq 'HASH') {
&_add_to_env(\%disk_env,$timerintenv);
}
+ if (ref($coauthorenv) eq 'HASH') {
+ if (keys(%{$coauthorenv})) {
+ &_add_to_env(\%disk_env,$coauthorenv);
+ }
+ }
if (ref($args->{'extra_env'})) {
&_add_to_env(\%disk_env,$args->{'extra_env'});
}
@@ -16318,24 +18146,52 @@ sub needs_coursereinit {
$interval = 600;
}
if (($now-$env{'request.course.timechecked'})>$interval) {
- my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
&Apache::lonnet::appenv({'request.course.timechecked'=>$now});
- if ($lastchange > $env{'request.course.tied'}) {
- my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
- if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
- my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
- if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
- &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
- $curr_reqd_hash{'internal.releaserequired'}});
- my ($switchserver,$switchwarning) =
- &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
- $curr_reqd_hash{'internal.releaserequired'});
- if ($switchwarning ne '' || $switchserver ne '') {
- return ('switch',$switchwarning,$switchserver);
- }
+ my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
+ if ($blocked) {
+ return ();
+ }
+ my $update;
+ my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
+ my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum);
+ if ($lastmainchange > $env{'request.course.tied'}) {
+ my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
+ if ($needswitch) {
+ return ('switch',$switchwarning,$switchserver);
+ }
+ $update = 'main';
+ }
+ if ($lastsuppchange > $env{'request.course.suppupdated'}) {
+ if ($update) {
+ $update = 'both';
+ } else {
+ my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum);
+ if ($needswitch) {
+ return ('switch',$switchwarning,$switchserver);
+ } else {
+ $update = 'supp';
}
}
- return ('update');
+ return ($update);
+ }
+ }
+ return ();
+}
+
+sub switch_for_update {
+ my ($loncaparev,$cdom,$cnum) = @_;
+ my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
+ if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
+ my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'};
+ if ($curr_reqd_hash{'internal.releaserequired'} ne $required) {
+ &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' =>
+ $curr_reqd_hash{'internal.releaserequired'}});
+ my ($switchserver,$switchwarning) =
+ &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'},
+ $curr_reqd_hash{'internal.releaserequired'});
+ if ($switchwarning ne '' || $switchserver ne '') {
+ return ('switch',$switchwarning,$switchserver);
+ }
}
}
return ();
@@ -16418,8 +18274,10 @@ sub parse_supplemental_title {
my $name = &plainname($uname,$udom);
$name = &HTML::Entities::encode($name,'"<>&\'');
$renametitle = &HTML::Entities::encode($renametitle,'"<>&\'');
- $title=''.&Apache::lonlocal::locallocaltime($time).' '.
- $name.':
'.$foldertitle;
+ $title=''.&Apache::lonlocal::locallocaltime($time).' '.$name;
+ if ($foldertitle ne '') {
+ $title .= ':
'.$foldertitle;
+ }
}
if (wantarray) {
return ($title,$foldertitle,$renametitle);
@@ -16427,28 +18285,147 @@ sub parse_supplemental_title {
return $title;
}
+sub get_supplemental {
+ my ($cnum,$cdom,$ignorecache,$possdel)=@_;
+ my $hashid=$cnum.':'.$cdom;
+ my ($supplemental,$cached,$set_httprefs);
+ unless ($ignorecache) {
+ ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid);
+ }
+ unless (defined($cached)) {
+ my $chome=&Apache::lonnet::homeserver($cnum,$cdom);
+ unless ($chome eq 'no_host') {
+ my @order = @LONCAPA::map::order;
+ my @resources = @LONCAPA::map::resources;
+ my @resparms = @LONCAPA::map::resparms;
+ my @zombies = @LONCAPA::map::zombies;
+ my ($errors,%ids,%hidden);
+ $errors =
+ &recurse_supplemental($cnum,$cdom,'supplemental.sequence',
+ $errors,$possdel,\%ids,\%hidden);
+ @LONCAPA::map::order = @order;
+ @LONCAPA::map::resources = @resources;
+ @LONCAPA::map::resparms = @resparms;
+ @LONCAPA::map::zombies = @zombies;
+ $set_httprefs = 1;
+ if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+ &Apache::lonnet::appenv({'request.course.suppupdated' => time});
+ }
+ $supplemental = {
+ ids => \%ids,
+ hidden => \%hidden,
+ };
+ &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600);
+ }
+ }
+ return ($supplemental,$set_httprefs);
+}
+
sub recurse_supplemental {
- my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;
- if ($suppmap) {
+ my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_;
+ if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) {
+ my $mapnum;
+ if ($suppmap eq 'supplemental.sequence') {
+ $mapnum = 0;
+ } else {
+ ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/);
+ }
my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
if ($fatal) {
$errors ++;
} else {
- if ($#LONCAPA::map::resources > 0) {
- foreach my $res (@LONCAPA::map::resources) {
- my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
+ my @order = @LONCAPA::map::order;
+ if (@order > 0) {
+ my @resources = @LONCAPA::map::resources;
+ my @resparms = @LONCAPA::map::resparms;
+ foreach my $idx (@order) {
+ my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]);
if (($src ne '') && ($status eq 'res')) {
+ my $id = $mapnum.':'.$idx;
+ push(@{$suppids->{$src}},$id);
+ if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) {
+ $hiddensupp->{$id} = 1;
+ }
if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
- ($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);
+ $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids,
+ $hiddensupp,$hiddensupp->{$id});
} else {
- $numfiles ++;
+ my $allowed;
+ if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) {
+ $allowed = 1;
+ } elsif ($possdel) {
+ foreach my $item (@{$suppids->{$src}}) {
+ next if ($item eq $id);
+ unless ($hiddensupp->{$item}) {
+ $allowed = 1;
+ last;
+ }
+ }
+ if ((!$allowed) && (exists($env{'httpref.'.$src}))) {
+ &Apache::lonnet::delenv('httpref.'.$src);
+ }
+ }
+ if ($allowed && (!exists($env{'httpref.'.$src}))) {
+ &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return $errors;
+}
+
+sub set_supp_httprefs {
+ my ($cnum,$cdom,$supplemental,$possdel) = @_;
+ if (ref($supplemental) eq 'HASH') {
+ if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
+ foreach my $src (keys(%{$supplemental->{'ids'}})) {
+ next if ($src =~ /\.sequence$/);
+ if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') {
+ my $allowed;
+ if ($env{'request.role.adv'}) {
+ $allowed = 1;
+ } else {
+ foreach my $id (@{$supplemental->{'ids'}->{$src}}) {
+ unless ($supplemental->{'hidden'}->{$id}) {
+ $allowed = 1;
+ last;
+ }
+ }
+ }
+ if (exists($env{'httpref.'.$src})) {
+ if ($possdel) {
+ unless ($allowed) {
+ &Apache::lonnet::delenv('httpref.'.$src);
+ }
}
+ } elsif ($allowed) {
+ &Apache::lonnet::allowuploaded('/adm/coursedoc',$src);
}
}
}
+ if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+ &Apache::lonnet::appenv({'request.course.suppupdated' => time});
+ }
}
}
- return ($numfiles,$errors);
+}
+
+sub get_supp_parameter {
+ my ($resparm,$name)=@_;
+ return if ($resparm eq '');
+ my $value=undef;
+ my $ptype=undef;
+ foreach (split('&&&',$resparm)) {
+ my ($thistype,$thisname,$thisvalue)=split('___',$_);
+ if ($thisname eq $name) {
+ $value=$thisvalue;
+ $ptype=$thistype;
+ }
+ }
+ return $value;
}
sub symb_to_docspath {
@@ -16521,11 +18498,72 @@ sub symb_to_docspath {
return $path;
}
+sub validate_folderpath {
+ my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_;
+ if ($env{'form.folderpath'} ne '') {
+ my @items = split(/\&/,$env{'form.folderpath'});
+ my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids);
+ for (my $i=0; $i<@items; $i++) {
+ my $odd = $i%2;
+ if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) {
+ $badpath = 1;
+ } elsif ($odd && $supplementalflag) {
+ my $idx = $i-1;
+ if ($items[$i] =~ /^([^:]*)::(|1):::$/) {
+ my $esc_name = $1;
+ if ((!$allowed) || ($items[$idx] eq 'supplemental')) {
+ $supppath .= '&'.$esc_name;
+ $changed = 1;
+ } else {
+ $supppath .= '&'.$items[$i];
+ }
+ } elsif (($allowed) && ($items[$idx] ne 'supplemental')) {
+ $changed = 1;
+ my $is_hidden;
+ unless ($got_supp) {
+ my ($supplemental) = &get_supplemental($coursenum,$coursedom);
+ if (ref($supplemental) eq 'HASH') {
+ if (ref($supplemental->{'hidden'}) eq 'HASH') {
+ %supphidden = %{$supplemental->{'hidden'}};
+ }
+ if (ref($supplemental->{'ids'}) eq 'HASH') {
+ %suppids = %{$supplemental->{'ids'}};
+ }
+ }
+ $got_supp = 1;
+ }
+ if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') {
+ my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0];
+ if ($supphidden{$mapid}) {
+ $is_hidden = 1;
+ }
+ }
+ $supppath .= '&'.$items[$i].'::'.$is_hidden.':::';
+ } else {
+ $supppath .= '&'.$items[$i];
+ }
+ } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) {
+ $badpath = 1;
+ } elsif ($supplementalflag) {
+ $supppath .= '&'.$items[$i];
+ }
+ last if ($badpath);
+ }
+ if ($badpath) {
+ delete($env{'form.folderpath'});
+ } elsif ($changed && $supplementalflag) {
+ $supppath =~ s/^\&//;
+ $env{'form.folderpath'} = $supppath;
+ }
+ }
+ return;
+}
+
sub captcha_display {
- my ($context,$lonhost) = @_;
+ my ($context,$lonhost,$defdom) = @_;
my ($output,$error);
my ($captcha,$pubkey,$privkey,$version) =
- &get_captcha_config($context,$lonhost);
+ &get_captcha_config($context,$lonhost,$defdom);
if ($captcha eq 'original') {
$output = &create_captcha();
unless ($output) {
@@ -16541,9 +18579,9 @@ sub captcha_display {
}
sub captcha_response {
- my ($context,$lonhost) = @_;
+ my ($context,$lonhost,$defdom) = @_;
my ($captcha_chk,$captcha_error);
- my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost);
+ my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom);
if ($captcha eq 'original') {
($captcha_chk,$captcha_error) = &check_captcha();
} elsif ($captcha eq 'recaptcha') {
@@ -16555,7 +18593,7 @@ sub captcha_response {
}
sub get_captcha_config {
- my ($context,$lonhost) = @_;
+ my ($context,$lonhost,$dom_in_effect) = @_;
my ($captcha,$pubkey,$privkey,$version,$hashtocheck);
my $hostname = &Apache::lonnet::hostname($lonhost);
my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
@@ -16603,6 +18641,27 @@ sub get_captcha_config {
} elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
$captcha = 'original';
}
+ } elsif ($context eq 'passwords') {
+ if ($dom_in_effect) {
+ my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect);
+ if ($passwdconf{'captcha'} eq 'recaptcha') {
+ if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') {
+ $pubkey = $passwdconf{'recaptchakeys'}{'public'};
+ $privkey = $passwdconf{'recaptchakeys'}{'private'};
+ }
+ if ($privkey && $pubkey) {
+ $captcha = 'recaptcha';
+ $version = $passwdconf{'recaptchaversion'};
+ if ($version ne '2') {
+ $version = 1;
+ }
+ } else {
+ $captcha = 'original';
+ }
+ } elsif ($passwdconf{'captcha'} ne 'notused') {
+ $captcha = 'original';
+ }
+ }
}
return ($captcha,$pubkey,$privkey,$version);
}
@@ -16620,13 +18679,17 @@ sub create_captcha {
if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
$output = ''."\n".
+ ''.
&mt('Type in the letters/numbers shown below').' '.
- ''.
- '
'.
+ ''.
+ '
'.
'';
last;
}
}
+ if ($output eq '') {
+ &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
+ }
return $output;
}
@@ -16665,7 +18728,8 @@ sub check_captcha {
sub create_recaptcha {
my ($pubkey,$version) = @_;
if ($version >= 2) {
- return '';
+ return ''.
+ '';
} else {
my $use_ssl;
if ($ENV{'SERVER_PORT'} == 443) {
@@ -16683,13 +18747,14 @@ sub create_recaptcha {
sub check_recaptcha {
my ($privkey,$version) = @_;
my $captcha_chk;
+ my $ip = &Apache::lonnet::get_requestor_ip();
if ($version >= 2) {
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
my %info = (
secret => $privkey,
response => $env{'form.g-recaptcha-response'},
- remoteip => $ENV{'REMOTE_ADDR'},
+ remoteip => $ip,
);
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
if ($response->is_success) {
@@ -16705,7 +18770,7 @@ sub check_recaptcha {
my $captcha_result =
$captcha->check_answer(
$privkey,
- $ENV{'REMOTE_ADDR'},
+ $ip,
$env{'form.recaptcha_challenge_field'},
$env{'form.recaptcha_response_field'},
);
@@ -16754,15 +18819,34 @@ sub cleanup_html {
# Checks for critical messages and returns a redirect url if one exists.
# $interval indicates how often to check for messages.
+# $context is the calling context -- roles, grades, contents, menu or flip.
sub critical_redirect {
- my ($interval) = @_;
+ my ($interval,$context) = @_;
+ unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
+ return ();
+ }
if ((time-$env{'user.criticalcheck.time'})>$interval) {
+ if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
+ if ($blocked) {
+ my $checkrole = "cm./$cdom/$cnum";
+ if ($env{'request.course.sec'} ne '') {
+ $checkrole .= "/$env{'request.course.sec'}";
+ }
+ unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
+ ($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
+ return;
+ }
+ }
+ }
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
$env{'user.name'});
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
my $redirecturl;
if ($what[0]) {
- if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
+ if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
$redirecturl='/adm/email?critical=display';
my $url=&Apache::lonnet::absolute_url().$redirecturl;
return (1, $url);
@@ -16822,6 +18906,342 @@ sub des_decrypt {
return $plaintext;
}
+sub get_requested_shorturls {
+ my ($cdom,$cnum,$navmap) = @_;
+ return unless (ref($navmap));
+ my ($numnew,$errors);
+ my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
+ if (@toshorten) {
+ my (%maps,%resources,%titles);
+ &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
+ 'shorturls',$cdom,$cnum);
+ if (keys(%resources)) {
+ my %tocreate;
+ foreach my $item (sort {$a <=> $b} (@toshorten)) {
+ my $symb = $resources{$item};
+ if ($symb) {
+ $tocreate{$cnum.'&'.$symb} = 1;
+ }
+ }
+ if (keys(%tocreate)) {
+ ($numnew,$errors) = &make_short_symbs($cdom,$cnum,
+ \%tocreate);
+ }
+ }
+ }
+ return ($numnew,$errors);
+}
+
+sub make_short_symbs {
+ my ($cdom,$cnum,$tocreateref,$lockuser) = @_;
+ my ($numnew,@errors);
+ if (ref($tocreateref) eq 'HASH') {
+ my %tocreate = %{$tocreateref};
+ if (keys(%tocreate)) {
+ my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
+ my $su = Short::URL->new(no_vowels => 1);
+ my $init = '';
+ my (%newunique,%addcourse,%courseonly,%failed);
+ # get lock on tiny db
+ my $now = time;
+ if ($lockuser eq '') {
+ $lockuser = $env{'user.name'}.':'.$env{'user.domain'};
+ }
+ my $lockhash = {
+ "lock\0$now" => $lockuser,
+ };
+ my $tries = 0;
+ my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
+ my ($code,$error);
+ while (($gotlock ne 'ok') && ($tries<3)) {
+ $tries ++;
+ sleep 1;
+ $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
+ }
+ if ($gotlock eq 'ok') {
+ $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
+ \%addcourse,\%courseonly,\%failed);
+ if (keys(%failed)) {
+ my $numfailed = scalar(keys(%failed));
+ push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
+ }
+ if (keys(%newunique)) {
+ my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
+ if ($putres eq 'ok') {
+ $numnew = scalar(keys(%newunique));
+ my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
+ unless ($newputres eq 'ok') {
+ push(@errors,&mt('error: could not store course look-up of short URLs'));
+ }
+ } else {
+ push(@errors,&mt('error: could not store unique six character URLs'));
+ }
+ }
+ my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
+ unless ($dellockres eq 'ok') {
+ push(@errors,&mt('error: could not release lockfile'));
+ }
+ } else {
+ push(@errors,&mt('error: could not obtain lockfile'));
+ }
+ if (keys(%courseonly)) {
+ my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
+ if ($result ne 'ok') {
+ push(@errors,&mt('error: could not update course look-up of short URLs'));
+ }
+ }
+ }
+ }
+ return ($numnew,\@errors);
+}
+
+sub shorten_symbs {
+ my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
+ return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
+ (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
+ (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
+ my (%possibles,%collisions);
+ foreach my $key (keys(%{$tocreate})) {
+ my $num = String::CRC32::crc32($key);
+ my $tiny = $su->encode($num,$init);
+ if ($tiny) {
+ $possibles{$tiny} = $key;
+ }
+ }
+ if (!$init) {
+ $init = 1;
+ } else {
+ $init ++;
+ }
+ if (keys(%possibles)) {
+ my @posstiny = keys(%possibles);
+ my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
+ my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
+ if (keys(%currtiny)) {
+ foreach my $key (keys(%currtiny)) {
+ next if ($currtiny{$key} eq '');
+ if ($currtiny{$key} eq $possibles{$key}) {
+ my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
+ unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
+ $courseonly->{$tsymb} = $key;
+ }
+ } else {
+ $collisions{$possibles{$key}} = 1;
+ }
+ delete($possibles{$key});
+ }
+ }
+ foreach my $key (keys(%possibles)) {
+ $newunique->{$key} = $possibles{$key};
+ my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
+ unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
+ $addcourse->{$tsymb} = $key;
+ }
+ }
+ }
+ if (keys(%collisions)) {
+ if ($init <5) {
+ if (!$init) {
+ $init = 1;
+ } else {
+ $init ++;
+ }
+ $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
+ $newunique,$addcourse,$courseonly,$failed);
+ } else {
+ foreach my $key (keys(%collisions)) {
+ $failed->{$key} = 1;
+ $failed->{$key} = 1;
+ }
+ }
+ }
+ return $init;
+}
+
+sub is_nonframeable {
+ my ($url,$absolute,$hostname,$ip,$nocache) = @_;
+ my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
+ return if (($remprotocol eq '') || ($remhost eq ''));
+
+ $remprotocol = lc($remprotocol);
+ $remhost = lc($remhost);
+ my $remport = 80;
+ if ($remprotocol eq 'https') {
+ $remport = 443;
+ }
+ my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
+ if ($cached) {
+ unless ($nocache) {
+ if ($result) {
+ return 1;
+ } else {
+ return 0;
+ }
+ }
+ }
+ my $uselink;
+ my $request = new HTTP::Request('HEAD',$url);
+ my $ua = LWP::UserAgent->new;
+ $ua->timeout(5);
+ my $response=$ua->request($request);
+ if ($response->is_success()) {
+ my $secpolicy = lc($response->header('content-security-policy'));
+ my $xframeop = lc($response->header('x-frame-options'));
+ $secpolicy =~ s/^\s+|\s+$//g;
+ $xframeop =~ s/^\s+|\s+$//g;
+ if (($secpolicy ne '') || ($xframeop ne '')) {
+ my $remotehost = $remprotocol.'://'.$remhost;
+ my ($origin,$protocol,$port);
+ if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
+ $port = $ENV{'SERVER_PORT'};
+ } else {
+ $port = 80;
+ }
+ if ($absolute eq '') {
+ $protocol = 'http:';
+ if ($port == 443) {
+ $protocol = 'https:';
+ }
+ $origin = $protocol.'//'.lc($hostname);
+ } else {
+ $origin = lc($absolute);
+ ($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
+ }
+ if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) {
+ my $framepolicy = $1;
+ $framepolicy =~ s/^\s+|\s+$//g;
+ my @policies = split(/\s+/,$framepolicy);
+ if (@policies) {
+ if (grep(/^\Q'none'\E$/,@policies)) {
+ $uselink = 1;
+ } else {
+ $uselink = 1;
+ if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) ||
+ (($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) ||
+ (($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
+ undef($uselink);
+ }
+ if ($uselink) {
+ if (grep(/^\Q'self'\E$/,@policies)) {
+ if (($origin ne '') && ($remotehost eq $origin)) {
+ undef($uselink);
+ }
+ }
+ }
+ if ($uselink) {
+ my @possok;
+ if ($ip ne '') {
+ push(@possok,$ip);
+ }
+ my $hoststr = '';
+ foreach my $part (reverse(split(/\./,$hostname))) {
+ if ($hoststr eq '') {
+ $hoststr = $part;
+ } else {
+ $hoststr = "$part.$hoststr";
+ }
+ if ($hoststr eq $hostname) {
+ push(@possok,$hostname);
+ } else {
+ push(@possok,"*.$hoststr");
+ }
+ }
+ if (@possok) {
+ foreach my $poss (@possok) {
+ last if (!$uselink);
+ foreach my $policy (@policies) {
+ if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) {
+ undef($uselink);
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ } elsif ($xframeop ne '') {
+ $uselink = 1;
+ my @policies = split(/\s*,\s*/,$xframeop);
+ if (@policies) {
+ unless (grep(/^deny$/,@policies)) {
+ if ($origin ne '') {
+ if (grep(/^sameorigin$/,@policies)) {
+ if ($remotehost eq $origin) {
+ undef($uselink);
+ }
+ }
+ if ($uselink) {
+ foreach my $policy (@policies) {
+ if ($policy =~ /^allow-from\s*(.+)$/) {
+ my $allowfrom = $1;
+ if (($allowfrom ne '') && ($allowfrom eq $origin)) {
+ undef($uselink);
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ if ($nocache) {
+ if ($cached) {
+ my $devalidate;
+ if ($uselink && !$result) {
+ $devalidate = 1;
+ } elsif (!$uselink && $result) {
+ $devalidate = 1;
+ }
+ if ($devalidate) {
+ &Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
+ }
+ }
+ } else {
+ if ($uselink) {
+ $result = 1;
+ } else {
+ $result = 0;
+ }
+ &Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
+ }
+ return $uselink;
+}
+
+sub page_menu {
+ my ($menucolls,$menunum) = @_;
+ my %menu;
+ foreach my $item (split(/;/,$menucolls)) {
+ my ($num,$value) = split(/\%/,$item);
+ if ($num eq $menunum) {
+ my @entries = split(/\&/,$value);
+ foreach my $entry (@entries) {
+ my ($name,$fields) = split(/=/,$entry);
+ if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) {
+ $menu{$name} = $fields;
+ } else {
+ my @shown;
+ if ($fields =~ /,/) {
+ @shown = split(/,/,$fields);
+ } else {
+ @shown = ($fields);
+ }
+ if (@shown) {
+ foreach my $field (@shown) {
+ next if ($field eq '');
+ $menu{$field} = 1;
+ }
+ }
+ }
+ }
+ }
+ }
+ return %menu;
+}
+
1;
__END__;