--- loncom/interface/loncommon.pm 2020/03/15 23:04:15 1.1340
+++ loncom/interface/loncommon.pm 2022/02/14 01:15:24 1.1376
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1340 2020/03/15 23:04:15 raeburn Exp $
+# $Id: loncommon.pm,v 1.1376 2022/02/14 01:15:24 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1416,7 +1416,7 @@ sub help_open_menu {
}
sub top_nav_help {
- my ($text) = @_;
+ my ($text,$linkattr) = @_;
$text = &mt($text);
my $stay_on_page = 1;
@@ -1430,7 +1430,7 @@ sub top_nav_help {
if ($link) {
return <<"END";
$banner_link
-<a href="$link" title="$title">$text</a>
+<a href="$link" title="$title" $linkattr>$text</a>
END
} else {
return ' '.$text.' ';
@@ -3648,6 +3648,137 @@ sub check_passwd_rules {
return $warning;
}
+sub passwd_validation_js {
+ my ($currpasswdval,$domain) = @_;
+ my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
+ my ($min,$max,@chars,$numrules,$intargjs,%alert);
+ $numrules = 0;
+ $min = $Apache::lonnet::passwdmin;
+ if (ref($passwdconf{'chars'}) eq 'ARRAY') {
+ if ($passwdconf{'min'} =~ /^\d+$/) {
+ if ($passwdconf{'min'} > $min) {
+ $min = $passwdconf{'min'};
+ }
+ }
+ if ($passwdconf{'max'} =~ /^\d+$/) {
+ $max = $passwdconf{'max'};
+ $numrules ++;
+ }
+ @chars = @{$passwdconf{'chars'}};
+ if (@chars) {
+ $numrules ++;
+ }
+ }
+ if ($min > 0) {
+ $numrules ++;
+ }
+ if (($min > 0) || ($max ne '') || (@chars > 0)) {
+ my $alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n';
+ if ($min) {
+ $alert{'min'} = &mt('minimum [quant,_1,character]',$min).'\n';
+ }
+ if ($max) {
+ $alert{'max'} = &mt('maximum [quant,_1,character]',$max).'\n';
+ }
+ my (@charalerts,@charrules);
+ if (@chars) {
+ if (grep(/^uc$/,@chars)) {
+ push(@charalerts,&mt('contain at least one upper case letter'));
+ push(@charrules,'uc');
+ }
+ if (grep(/^lc$/,@chars)) {
+ push(@charalerts,&mt('contain at least one lower case letter'));
+ push(@charrules,'lc');
+ }
+ if (grep(/^num$/,@chars)) {
+ push(@charalerts,&mt('contain at least one number'));
+ push(@charrules,'num');
+ }
+ if (grep(/^spec$/,@chars)) {
+ push(@charalerts,&mt('contain at least one non-alphanumeric'));
+ push(@charrules,'spec');
+ }
+ }
+ $intargjs = qq| var rulesmsg = '';\n|.
+ qq| var currpwval = $currpasswdval;\n|;
+ if ($min) {
+ $intargjs .= qq|
+ if (currpwval.length < $min) {
+ rulesmsg += ' - $alert{min}';
+ }
+|;
+ }
+ if ($max) {
+ $intargjs .= qq|
+ if (currpwval.length > $max) {
+ rulesmsg += ' - $alert{max}';
+ }
+|;
+ }
+ if (@chars > 0) {
+ my $charrulestr = '"'.join('","',@charrules).'"';
+ my $charalertstr = '"'.join('","',@charalerts).'"';
+ $intargjs .= qq| var brokerules = new Array();\n|.
+ qq| var charrules = new Array($charrulestr);\n|.
+ qq| var charalerts = new Array($charalertstr);\n|;
+ my %rules;
+ map { $rules{$_} = 1; } @chars;
+ if ($rules{'uc'}) {
+ $intargjs .= qq|
+ var ucRegExp = /[A-Z]/;
+ if (!ucRegExp.test(currpwval)) {
+ brokerules.push('uc');
+ }
+|;
+ }
+ if ($rules{'lc'}) {
+ $intargjs .= qq|
+ var lcRegExp = /[a-z]/;
+ if (!lcRegExp.test(currpwval)) {
+ brokerules.push('lc');
+ }
+|;
+ }
+ if ($rules{'num'}) {
+ $intargjs .= qq|
+ var numRegExp = /[0-9]/;
+ if (!numRegExp.test(currpwval)) {
+ brokerules.push('num');
+ }
+|;
+ }
+ if ($rules{'spec'}) {
+ $intargjs .= q|
+ var specRegExp = /[!"#$%&'()*+,\-.\/:;<=>?@[\\^\]_`{\|}~]/;
+ if (!specRegExp.test(currpwval)) {
+ brokerules.push('spec');
+ }
+|;
+ }
+ $intargjs .= qq|
+ if (brokerules.length > 0) {
+ for (var i=0; i<brokerules.length; i++) {
+ for (var j=0; j<charrules.length; j++) {
+ if (brokerules[i] == charrules[j]) {
+ rulesmsg += ' - '+charalerts[j]+'\\n';
+ break;
+ }
+ }
+ }
+ }
+|;
+ }
+ $intargjs .= qq|
+ if (rulesmsg != '') {
+ rulesmsg = '$alertmsg'+rulesmsg;
+ alert(rulesmsg);
+ return false;
+ }
+|;
+ }
+ return ($numrules,$intargjs);
+}
+
###############################################################
## Get Kerberos Defaults for Domain ##
###############################################################
@@ -4893,6 +5024,59 @@ sub get_student_view_with_retries {
}
}
+sub css_links {
+ my ($currsymb,$level) = @_;
+ my ($links,@symbs,%cssrefs,%httpref);
+ if ($level eq 'map') {
+ my $navmap = Apache::lonnavmaps::navmap->new();
+ if (ref($navmap)) {
+ my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb);
+ my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0);
+ foreach my $res (@resources) {
+ if (ref($res) && $res->symb()) {
+ push(@symbs,$res->symb());
+ }
+ }
+ }
+ } else {
+ @symbs = ($currsymb);
+ }
+ foreach my $symb (@symbs) {
+ my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb);
+ if ($css_href =~ /\S/) {
+ unless ($css_href =~ m{https?://}) {
+ my $url = (&Apache::lonnet::decode_symb($symb))[-1];
+ my $proburl = &Apache::lonnet::clutter($url);
+ my ($probdir) = ($proburl =~ m{(.+)/[^/]+$});
+ unless ($css_href =~ m{^/}) {
+ $css_href = &Apache::lonnet::hreflocation($probdir,$css_href);
+ }
+ if ($css_href =~ m{^/(res|uploaded)/}) {
+ unless (($httpref{'httpref.'.$css_href}) ||
+ (&Apache::lonnet::is_on_map($css_href))) {
+ my $thisurl = $proburl;
+ if ($env{'httpref.'.$proburl}) {
+ $thisurl = $env{'httpref.'.$proburl};
+ }
+ $httpref{'httpref.'.$css_href} = $thisurl;
+ }
+ }
+ }
+ $cssrefs{$css_href} = 1;
+ }
+ }
+ if (keys(%httpref)) {
+ &Apache::lonnet::appenv(\%httpref);
+ }
+ if (keys(%cssrefs)) {
+ foreach my $css_href (keys(%cssrefs)) {
+ next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)});
+ $links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n";
+ }
+ }
+ return $links;
+}
+
=pod
=item * &get_student_answers()
@@ -5148,13 +5332,95 @@ sub findallcourses {
###############################################
sub blockcheck {
- my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
-
+ my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
+ unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
+ my ($has_evb,$check_ipaccess);
+ my $dom = $env{'user.domain'};
+ if ($env{'request.course.id'}) {
+ my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ my $checkrole = "cm./$cdom/$cnum";
+ my $sec = $env{'request.course.sec'};
+ if ($sec ne '') {
+ $checkrole .= "/$sec";
+ }
+ if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
+ ($env{'request.role'} !~ /^st/)) {
+ $has_evb = 1;
+ }
+ unless ($has_evb) {
+ if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
+ ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
+ if ($udom eq $cdom) {
+ $check_ipaccess = 1;
+ }
+ }
+ }
+ } elsif (($activity eq 'com') || ($activity eq 'port') || ($activity eq 'blogs') ||
+ ($activity eq 'about') || ($activity eq 'wishlist') || ($activity eq 'passwd')) {
+ my $checkrole;
+ if ($env{'request.role.domain'} eq '') {
+ $checkrole = "cm./$env{'user.domain'}/";
+ } else {
+ $checkrole = "cm./$env{'request.role.domain'}/";
+ }
+ if (($checkrole) && (&Apache::lonnet::allowed('evb',undef,undef,$checkrole))) {
+ $has_evb = 1;
+ }
+ }
+ unless ($has_evb || $check_ipaccess) {
+ my @machinedoms = &Apache::lonnet::current_machine_domains();
+ if (($dom eq 'public') && ($activity eq 'port')) {
+ $dom = $udom;
+ }
+ if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
+ $check_ipaccess = 1;
+ } else {
+ my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+ my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
+ my $prim = &Apache::lonnet::domain($dom,'primary');
+ my $intdom = &Apache::lonnet::internet_dom($prim);
+ if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
+ if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
+ $check_ipaccess = 1;
+ }
+ }
+ }
+ }
+ if ($check_ipaccess) {
+ my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
+ unless (defined($cached)) {
+ my %domconfig =
+ &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
+ $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
+ }
+ if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
+ foreach my $id (keys(%{$ipaccessref})) {
+ if (ref($ipaccessref->{$id}) eq 'HASH') {
+ my $range = $ipaccessref->{$id}->{'ip'};
+ if ($range) {
+ if (&Apache::lonnet::ip_match($clientip,$range)) {
+ if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
+ if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
+ return ('','','',$id,$dom);
+ last;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
+ return ();
+ }
+ }
if (defined($udom) && defined($uname)) {
# If uname and udom are for a course, check for blocks in the course.
if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
my ($startblock,$endblock,$triggerblock) =
- &get_blocks($setters,$activity,$udom,$uname,$url);
+ &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
return ($startblock,$endblock,$triggerblock);
}
} else {
@@ -5165,14 +5431,18 @@ sub blockcheck {
my $startblock = 0;
my $endblock = 0;
my $triggerblock = '';
- my %live_courses = &findallcourses(undef,$uname,$udom);
+ my %live_courses;
+ unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
+ %live_courses = &findallcourses(undef,$uname,$udom);
+ }
# If uname is for a user, and activity is course-specific, i.e.,
# boards, chat or groups, check for blocking in current course only.
if (($activity eq 'boards' || $activity eq 'chat' ||
$activity eq 'groups' || $activity eq 'printout' ||
- $activity eq 'reinit' || $activity eq 'alert') &&
+ $activity eq 'search' || $activity eq 'reinit' ||
+ $activity eq 'alert') &&
($env{'request.course.id'})) {
foreach my $key (keys(%live_courses)) {
if ($key ne $env{'request.course.id'}) {
@@ -5282,7 +5552,7 @@ sub blockcheck {
# of specified user, unless user has 'evb' privilege.
my ($start,$end,$trigger) =
- &get_blocks($setters,$activity,$cdom,$cnum,$url);
+ &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
if (($start != 0) &&
(($startblock == 0) || ($startblock > $start))) {
$startblock = $start;
@@ -5302,7 +5572,7 @@ sub blockcheck {
}
sub get_blocks {
- my ($setters,$activity,$cdom,$cnum,$url) = @_;
+ my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
my $startblock = 0;
my $endblock = 0;
my $triggerblock = '';
@@ -5315,7 +5585,13 @@ sub get_blocks {
my $now = time;
my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
if ($activity eq 'docs') {
- @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
+ my ($blocked,$nosymbcache,$noenccheck);
+ if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
+ $blocked = 1;
+ $nosymbcache = 1;
+ $noenccheck = 1;
+ }
+ @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks);
foreach my $block (@blockers) {
if ($block =~ /^firstaccess____(.+)$/) {
my $item = $1;
@@ -5443,14 +5719,17 @@ sub parse_block_record {
}
sub blocking_status {
- my ($activity,$uname,$udom,$url,$is_course) = @_;
+ my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
my %setters;
# check for active blocking
- my ($startblock,$endblock,$triggerblock) =
- &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
+ if ($clientip eq '') {
+ $clientip = &Apache::lonnet::get_requestor_ip();
+ }
+ my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
+ &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
my $blocked = 0;
- if ($startblock && $endblock) {
+ if (($startblock && $endblock) || ($by_ip)) {
$blocked = 1;
}
@@ -5459,12 +5738,17 @@ sub blocking_status {
# build a link to a popup window containing the details
my $querystring = "?activity=$activity";
-# $uname and $udom decide whose portfolio the user is trying to look at
- if (($activity eq 'port') || ($activity eq 'passwd')) {
+# $uname and $udom decide whose portfolio (or information page) the user is trying to look at
+ if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) {
$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
} elsif ($activity eq 'docs') {
- $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
+ my $showurl = &Apache::lonenc::check_encrypt($url);
+ $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
+ if ($symb) {
+ my $showsymb = &Apache::lonenc::check_encrypt($symb);
+ $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
+ }
}
my $output .= <<'END_MYBLOCK';
@@ -5489,10 +5773,20 @@ END_MYBLOCK
$text = &mt('Printing Blocked');
} elsif ($activity eq 'passwd') {
$text = &mt('Password Changing Blocked');
+ } elsif ($activity eq 'grades') {
+ $text = &mt('Gradebook Blocked');
+ } elsif ($activity eq 'search') {
+ $text = &mt('Search Blocked');
} elsif ($activity eq 'alert') {
$text = &mt('Checking Critical Messages Blocked');
} elsif ($activity eq 'reinit') {
$text = &mt('Checking Course Update Blocked');
+ } elsif ($activity eq 'about') {
+ $text = &mt('Access to User Information Pages Blocked');
+ } elsif ($activity eq 'wishlist') {
+ $text = &mt('Access to Stored Links Blocked');
+ } elsif ($activity eq 'annotate') {
+ $text = &mt('Access to Annotations Blocked');
}
$output .= <<"END_BLOCK";
<div class='$class'>
@@ -5521,7 +5815,8 @@ sub check_ip_acc {
($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
$ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
} else {
- $ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip;
+ my $remote_ip = &Apache::lonnet::get_requestor_ip();
+ $ip = $remote_ip || $env{'request.host'} || $clientip;
}
my $name;
@@ -5673,6 +5968,17 @@ sub get_domainconf {
}
}
}
+ } elsif ($key eq 'saml') {
+ if (ref($domconfig{'login'}{$key}) eq 'HASH') {
+ foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
+ if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
+ $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
+ foreach my $item ('text','img','alt','url','title','notsso') {
+ $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
+ }
+ }
+ }
+ }
} else {
foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
$designhash{$udom.'.login.'.$key.'_'.$img} =
@@ -5777,8 +6083,12 @@ sub domainlogo {
&Apache::lonnet::repcopy($local_name);
}
$imgsrc = &lonhttpdurl($imgsrc);
- }
- return '<img src="'.$imgsrc.'" alt="'.$domain.'" />';
+ }
+ my $alttext = $domain;
+ if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
+ $alttext = $designhash{$domain.'.login.alttext_domlogo'};
+ }
+ return '<img src="'.$imgsrc.'" alt="'.$alttext.'" id="lclogindomlogo" />';
} elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
return &Apache::lonnet::domain($domain,'description');
} else {
@@ -6043,7 +6353,8 @@ other decorations will be returned.
sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
- $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_;
+ $no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,
+ $ltimenu,$menucoll,$menuref)=@_;
my $public;
if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
@@ -6072,12 +6383,24 @@ sub bodytag {
if ($realm) {
$realm = '/'.$realm;
}
- if ($role eq 'ca') {
+ if ($role eq 'ca') {
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
$realm = &plainname($rname,$rdom);
}
# realm
+ my ($cid,$sec);
if ($env{'request.course.id'}) {
+ $cid = $env{'request.course.id'};
+ if ($env{'request.course.sec'}) {
+ $sec = $env{'request.course.sec'};
+ }
+ } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
+ if (&Apache::lonnet::is_course($1,$2)) {
+ $cid = $1.'_'.$2;
+ $sec = $3;
+ }
+ }
+ if ($cid) {
if ($env{'request.role'} !~ /^cr/) {
$role = &Apache::lonnet::plaintext($role,&course_type());
} elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
@@ -6089,10 +6412,10 @@ sub bodytag {
} else {
$role = (split(/\//,$role,4))[-1];
}
- if ($env{'request.course.sec'}) {
- $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
+ if ($sec) {
+ $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
}
- $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
+ $realm = $env{'course.'.$cid.'.description'};
} else {
$role = &Apache::lonnet::plaintext($role);
}
@@ -6115,13 +6438,25 @@ sub bodytag {
undef($role);
}
- if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
+ my $showcrstitle = 1;
+ if (($cid) && ($env{'request.lti.login'})) {
if (ref($ltimenu) eq 'HASH') {
unless ($ltimenu->{'role'}) {
undef($role);
}
unless ($ltimenu->{'coursetitle'}) {
$realm=' ';
+ $showcrstitle = 0;
+ }
+ }
+ } elsif (($cid) && ($menucoll)) {
+ if (ref($menuref) eq 'HASH') {
+ unless ($menuref->{'role'}) {
+ undef($role);
+ }
+ unless ($menuref->{'crs'}) {
+ $realm=' ';
+ $showcrstitle = 0;
}
}
}
@@ -6130,17 +6465,15 @@ sub bodytag {
#
# Extra info if you are the DC
my $dc_info = '';
- if ($env{'user.adv'} && exists($env{'user.role.dc./'.
- $env{'course.'.$env{'request.course.id'}.
- '.domain'}.'/'})) {
- my $cid = $env{'request.course.id'};
+ if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle &&
+ (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
$dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info =~ s/\s+$//;
}
my $crstype;
- if ($env{'request.course.id'}) {
- $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
+ if ($cid) {
+ $crstype = $env{'course.'.$cid.'.type'};
} elsif ($args->{'crstype'}) {
$crstype = $args->{'crstype'};
}
@@ -6160,7 +6493,8 @@ sub bodytag {
Apache::lonmenu::utilityfunctions($httphost), 'start');
unless ($args->{'no_primary_menu'}) {
- my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu);
+ my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref,
+ $args->{'links_disabled'});
if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
if ($dc_info) {
@@ -6191,7 +6525,9 @@ sub bodytag {
if (!$public){
unless ($args->{'no_inline_menu'}) {
$bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
- $args->{'no_primary_menu'});
+ $args->{'no_primary_menu'},
+ $menucoll,$menuref,
+ $args->{'links_disabled'});
}
$bodytag .= Apache::lonmenu::serverform();
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
@@ -8268,6 +8604,18 @@ 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;
@@ -8527,10 +8875,17 @@ ADDMETA
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;
+ my ($offload,$offloadoth);
if (ref($domdefs{'offloadnow'}) eq 'HASH') {
if ($domdefs{'offloadnow'}{$lonhost}) {
$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'};
+ }
+ }
}
}
unless ($offload) {
@@ -8540,6 +8895,7 @@ ADDMETA
(!(($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'};
}
}
@@ -8547,7 +8903,13 @@ ADDMETA
}
}
if ($offload) {
- my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
+ 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;
@@ -8561,7 +8923,7 @@ ADDMETA
}
if ($locknum) {
my @lockinfo = sort(values(%locks));
- $msg = &mt('Once the following tasks are complete: ')."\n".
+ $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".');
@@ -8723,7 +9085,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 '') {
@@ -8842,6 +9205,9 @@ $args - additional optional args support
will contain https://<hostname> 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).
=back
@@ -8854,7 +9220,7 @@ sub start_page {
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));
$env{'internal.start_page'}++;
- my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu);
+ my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu);
if (! exists($args->{'skip_phases'}{'head'}) ) {
$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
@@ -8889,8 +9255,47 @@ sub start_page {
($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;
+ }
+ }
+ }
+ }
}
-
+
if (! exists($args->{'skip_phases'}{'body'}) ) {
if ($args->{'frameset'}) {
my $attr_string = &make_attr_string($args->{'force_register'},
@@ -8903,7 +9308,7 @@ sub start_page {
$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'no_nav_bar'},
$args->{'bgcolor'}, $args,
- \@advtools,$ltiscope,$ltiuri,\%ltimenu);
+ \@advtools,$ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu);
}
}
@@ -8989,6 +9394,103 @@ 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) = 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 wishlist_window {
return(<<'ENDWISHLIST');
<script type="text/javascript">
@@ -9078,7 +9580,15 @@ ENDLINK
}
sub modal_adhoc_script {
- my ($funcname,$width,$height,$content)=@_;
+ my ($funcname,$width,$height,$content,$possmathjax)=@_;
+ my $mathjax;
+ if ($possmathjax) {
+ $mathjax = <<'ENDJAX';
+ if (typeof MathJax == 'object') {
+ MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
+ }
+ENDJAX
+ }
return (<<ENDADHOC);
<script type="text/javascript">
// <![CDATA[
@@ -9089,6 +9599,7 @@ sub modal_adhoc_script {
modalWindow.height = $height;
modalWindow.content = '$content';
modalWindow.open();
+ $mathjax
};
// ]]>
</script>
@@ -9096,7 +9607,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'}).
@@ -9105,12 +9616,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).
"<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>";
}
@@ -10985,11 +11496,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'});
@@ -11000,8 +11515,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;
@@ -11009,15 +11524,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];
}
}
}
@@ -15229,6 +15757,8 @@ Inputs:
from - Sender's email address
+replyto - Reply-To email address
+
to - Email address of recipient
subject - Subject of email
@@ -15239,8 +15769,6 @@ cc_string - Carbon copy email ad
bcc - Blind carbon copy email address
-type - File type of attachment
-
attachment_path - Path of file to be attached
file_name - Name of file to be attached
@@ -15257,8 +15785,9 @@ attachment_text - The body of an attac
############################################################
sub mime_email {
- my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path,
- $file_name, $attachment_text) = @_;
+ my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path,
+ $file_name,$attachment_text) = @_;
+
my $msg = MIME::Lite->new(
From => $from,
To => $to,
@@ -15266,6 +15795,9 @@ sub mime_email {
Type =>'TEXT',
Data => $body,
);
+ if ($replyto ne '') {
+ $msg->add("Reply-To" => $replyto);
+ }
if ($cc_string ne '') {
$msg->add("Cc" => $cc_string);
}
@@ -15864,7 +16396,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') {
@@ -15872,16 +16405,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'}) &&
@@ -15970,20 +16525,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 = '<br />'."\n";
if ($context eq 'auto') {
$linefeed = "\n";
@@ -15992,18 +16561,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 = '<span class="LC_error">'.$clonemsg.'</span>';
- }
- }
- $outcome .= $clonemsg.$linefeed;
-
+ ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed);
if (!$can_clone) {
- return (0,$outcome);
+ return (0,$outcome,$clonemsgref);
}
}
@@ -16026,15 +16588,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]',$showncrstype,$$courseid).$linefeed;
+ if (($callercontext eq 'auto') && ($user_lh ne '')) {
+ $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
+ } else {
+ $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed;
+ }
if ($$courseid =~ /^error:/) {
- return (0,$outcome);
+ return (0,$outcome,$clonemsgref);
}
#
@@ -16043,23 +16610,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]',$showncrstype,$clonehome);
- if ($context ne 'auto') {
- $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>';
- }
- $outcome .= $clonemsg.$linefeed;
+ push(@clonemsg,
+ {
+ mt => 'Created [_1] by cloning from [_2]',
+ args => [$showncrstype,$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
@@ -16084,8 +16665,7 @@ sub construct_course {
'plc.users.denied',
'hidefromcat',
'checkforpriv',
- 'categories',
- 'internal.uniquecode'],
+ 'categories'],
$$crsudom,$$crsunum);
if ($args->{'textbook'}) {
$cenv{'internal.textbook'} = $args->{'textbook'};
@@ -16100,6 +16680,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'};
}
@@ -16326,12 +16909,17 @@ 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
@@ -16385,7 +16973,7 @@ sub construct_course {
('resourcedata',\%storecontent,$$crsudom,$$crsunum);
}
- return (1,$outcome);
+ return (1,$outcome,\@clonemsg);
}
sub make_unique_code {
@@ -16674,6 +17262,7 @@ sub init_user_environment {
# --------------------------------------------------------- Write first profile
{
+ my $ip = &Apache::lonnet::get_requestor_ip($r);
my %initial_env =
("user.name" => $username,
"user.domain" => $domain,
@@ -16692,7 +17281,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'};
@@ -17593,7 +18182,7 @@ sub needs_coursereinit {
}
if (($now-$env{'request.course.timechecked'})>$interval) {
&Apache::lonnet::appenv({'request.course.timechecked'=>$now});
- my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
+ my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
if ($blocked) {
return ();
}
@@ -17965,9 +18554,10 @@ sub create_captcha {
if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
$output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
+ '<span class="LC_nobreak">'.
&mt('Type in the letters/numbers shown below').' '.
'<input type="text" size="5" name="code" value="" autocomplete="off" />'.
- '<br />'.
+ '</span><br />'.
'<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />';
last;
}
@@ -18013,7 +18603,8 @@ sub check_captcha {
sub create_recaptcha {
my ($pubkey,$version) = @_;
if ($version >= 2) {
- return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>';
+ return '<div class="g-recaptcha" data-sitekey="'.$pubkey.'"></div>'.
+ '<div style="padding:0;clear:both;margin:0;border:0"></div>';
} else {
my $use_ssl;
if ($ENV{'SERVER_PORT'} == 443) {
@@ -18031,11 +18622,12 @@ sub create_recaptcha {
sub check_recaptcha {
my ($privkey,$version) = @_;
my $captcha_chk;
+ my $ip = &Apache::lonnet::get_requestor_ip();
if ($version >= 2) {
my %info = (
secret => $privkey,
response => $env{'form.g-recaptcha-response'},
- remoteip => $ENV{'REMOTE_ADDR'},
+ remoteip => $ip,
);
my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
$request->content(join('&',map {
@@ -18058,7 +18650,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'},
);
@@ -18110,11 +18702,14 @@ sub cleanup_html {
# $context is the calling context -- roles, grades, contents, menu or flip.
sub critical_redirect {
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',$cnum,$cdom,undef,1);
+ my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
if ($blocked) {
my $checkrole = "cm./$cdom/$cnum";
if ($env{'request.course.sec'} ne '') {
@@ -18131,7 +18726,7 @@ sub critical_redirect {
&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);
@@ -18191,24 +18786,37 @@ sub des_decrypt {
return $plaintext;
}
-sub make_short_symbs {
+sub get_requested_shorturls {
my ($cdom,$cnum,$navmap) = @_;
return unless (ref($navmap));
- my ($numnew,@errors);
+ 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);
- my %tocreate;
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);
@@ -18216,9 +18824,11 @@ sub make_short_symbs {
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" => $env{'user.name'}.
- ':'.$env{'user.domain'},
+ "lock\0$now" => $lockuser,
};
my $tries = 0;
my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
@@ -18478,6 +19088,37 @@ sub is_nonframeable {
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__;