|
version 1.1075.2.134, 2019/07/30 11:10:55
|
version 1.1075.2.161.2.5, 2022/02/18 00:41:09
|
|
Line 71 use Apache::lonuserutils();
|
Line 71 use Apache::lonuserutils();
|
| use Apache::lonuserstate(); |
use Apache::lonuserstate(); |
| use Apache::courseclassifier(); |
use Apache::courseclassifier(); |
| use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
| |
use HTTP::Request; |
| use DateTime::TimeZone; |
use DateTime::TimeZone; |
| use DateTime::Locale; |
use DateTime::Locale; |
| use Encode(); |
use Encode(); |
|
Line 82 use Crypt::DES;
|
Line 83 use Crypt::DES;
|
| use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
| use File::Copy(); |
use File::Copy(); |
| use File::Path(); |
use File::Path(); |
| |
use String::CRC32(); |
| |
use Short::URL(); |
| |
|
| # ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
| use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
|
Line 427 sub studentbrowser_javascript {
|
Line 430 sub studentbrowser_javascript {
|
| <script type="text/javascript" language="Javascript"> |
<script type="text/javascript" language="Javascript"> |
| // <![CDATA[ |
// <![CDATA[ |
| var stdeditbrowser; |
var stdeditbrowser; |
| function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) { |
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) { |
| var url = '/adm/pickstudent?'; |
var url = '/adm/pickstudent?'; |
| var filter; |
var filter; |
| if (!ignorefilter) { |
if (!ignorefilter) { |
|
Line 442 sub studentbrowser_javascript {
|
Line 445 sub studentbrowser_javascript {
|
| '&udomelement='+udom+ |
'&udomelement='+udom+ |
| '&clicker='+clicker; |
'&clicker='+clicker; |
| if (roleflag) { url+="&roles=1"; } |
if (roleflag) { url+="&roles=1"; } |
| if (courseadvonly) { url+="&courseadvonly=1"; } |
if (courseadv == 'condition') { |
| |
if (document.getElementById('courseadv')) { |
| |
courseadv = document.getElementById('courseadv').value; |
| |
} |
| |
} |
| |
if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; } |
| var title = 'Student_Browser'; |
var title = 'Student_Browser'; |
| var options = 'scrollbars=1,resizable=1,menubar=0'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
| options += ',width=700,height=600'; |
options += ',width=700,height=600'; |
|
Line 474 ENDRESBRW
|
Line 482 ENDRESBRW
|
| } |
} |
| |
|
| sub selectstudent_link { |
sub selectstudent_link { |
| my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_; |
my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_; |
| my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". |
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". |
| &Apache::lonhtmlcommon::entity_encode($unameele)."','". |
&Apache::lonhtmlcommon::entity_encode($unameele)."','". |
| &Apache::lonhtmlcommon::entity_encode($udomele)."'"; |
&Apache::lonhtmlcommon::entity_encode($udomele)."'"; |
|
Line 485 sub selectstudent_link {
|
Line 493 sub selectstudent_link {
|
| return ''; |
return ''; |
| } |
} |
| $callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; |
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; |
| if ($courseadvonly) { |
if ($courseadv eq 'only') { |
| $callargs .= ",'',1,1"; |
$callargs .= ",'',1,'$courseadv'"; |
| |
} elsif ($courseadv eq 'none') { |
| |
$callargs .= ",'','','$courseadv'"; |
| |
} elsif ($courseadv eq 'condition') { |
| |
$callargs .= ",'','','$courseadv'"; |
| } |
} |
| return '<span class="LC_nobreak">'. |
return '<span class="LC_nobreak">'. |
| '<a href="javascript:openstdbrowser('.$callargs.');">'. |
'<a href="javascript:openstdbrowser('.$callargs.');">'. |
|
Line 1368 sub help_open_menu {
|
Line 1380 sub help_open_menu {
|
| } |
} |
| |
|
| sub top_nav_help { |
sub top_nav_help { |
| my ($text) = @_; |
my ($text,$linkattr) = @_; |
| $text = &mt($text); |
$text = &mt($text); |
| my $stay_on_page; |
my $stay_on_page; |
| unless ($env{'environment.remote'} eq 'on') { |
unless ($env{'environment.remote'} eq 'on') { |
|
Line 1384 sub top_nav_help {
|
Line 1396 sub top_nav_help {
|
| if ($link) { |
if ($link) { |
| return <<"END"; |
return <<"END"; |
| $banner_link |
$banner_link |
| <a href="$link" title="$title">$text</a> |
<a href="$link" title="$title" $linkattr>$text</a> |
| END |
END |
| } else { |
} else { |
| return ' '.$text.' '; |
return ' '.$text.' '; |
|
Line 1403 sub help_menu_js {
|
Line 1415 sub help_menu_js {
|
| &Apache::loncommon::start_page('Help Menu', undef, |
&Apache::loncommon::start_page('Help Menu', undef, |
| {'frameset' => 1, |
{'frameset' => 1, |
| 'js_ready' => 1, |
'js_ready' => 1, |
| 'use_absolute' => $httphost, |
'use_absolute' => $httphost, |
| 'add_entries' => { |
'add_entries' => { |
| 'border' => '0', |
'border' => '0', |
| 'rows' => "110,*",},}); |
'rows' => "110,*",},}); |
|
Line 3117 sub authform_filesystem {
|
Line 3129 sub authform_filesystem {
|
| $fsyscheck.' onchange="'.$jscall.'" onclick="'. |
$fsyscheck.' onchange="'.$jscall.'" onclick="'. |
| $jscall.'"'.$disabled.' />'; |
$jscall.'"'.$disabled.' />'; |
| } |
} |
| $autharg = '<input type="text" size="10" name="fsysarg" value=""'. |
$autharg = '<input type="password" size="10" name="fsysarg" value=""'. |
| ' onchange="'.$jscall.'"'.$disabled.' />'; |
' onchange="'.$jscall.'"'.$disabled.' />'; |
| $result = &mt |
$result = &mt |
| ('[_1] Filesystem Authenticated (with initial password [_2])', |
('[_1] Filesystem Authenticated (with initial password [_2])', |
| '<label><input type="radio" name="login" value="fsys" '. |
'<label>'.$authtype,'</label>'.$autharg); |
| $fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />', |
|
| '</label><input type="password" size="10" name="fsysarg" value="" '. |
|
| 'onchange="'.$jscall.'"'.$disabled.' />'); |
|
| return $result; |
return $result; |
| } |
} |
| |
|
|
Line 3170 sub get_assignable_auth {
|
Line 3179 sub get_assignable_auth {
|
| return ($authnum,%can_assign); |
return ($authnum,%can_assign); |
| } |
} |
| |
|
| |
sub check_passwd_rules { |
| |
my ($domain,$plainpass) = @_; |
| |
my %passwdconf = &Apache::lonnet::get_passwdconf($domain); |
| |
my ($min,$max,@chars,@brokerule,$warning); |
| |
$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'}; |
| |
} |
| |
@chars = @{$passwdconf{'chars'}}; |
| |
} |
| |
if (($min) && (length($plainpass) < $min)) { |
| |
push(@brokerule,'min'); |
| |
} |
| |
if (($max) && (length($plainpass) > $max)) { |
| |
push(@brokerule,'max'); |
| |
} |
| |
if (@chars) { |
| |
my %rules; |
| |
map { $rules{$_} = 1; } @chars; |
| |
if ($rules{'uc'}) { |
| |
unless ($plainpass =~ /[A-Z]/) { |
| |
push(@brokerule,'uc'); |
| |
} |
| |
} |
| |
if ($rules{'lc'}) { |
| |
unless ($plainpass =~ /[a-z]/) { |
| |
push(@brokerule,'lc'); |
| |
} |
| |
} |
| |
if ($rules{'num'}) { |
| |
unless ($plainpass =~ /\d/) { |
| |
push(@brokerule,'num'); |
| |
} |
| |
} |
| |
if ($rules{'spec'}) { |
| |
unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{|}~]/) { |
| |
push(@brokerule,'spec'); |
| |
} |
| |
} |
| |
} |
| |
if (@brokerule) { |
| |
my %rulenames = &Apache::lonlocal::texthash( |
| |
uc => 'At least one upper case letter', |
| |
lc => 'At least one lower case letter', |
| |
num => 'At least one number', |
| |
spec => 'At least one non-alphanumeric', |
| |
); |
| |
$rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ'; |
| |
$rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz'; |
| |
$rulenames{'num'} .= ': 0123456789'; |
| |
$rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{|}~'; |
| |
$rulenames{'min'} = &mt('Minimum password length: [_1]',$min); |
| |
$rulenames{'max'} = &mt('Maximum password length: [_1]',$max); |
| |
$warning = &mt('Password did not satisfy the following:').'<ul>'; |
| |
foreach my $rule ('min','max','uc','lc','num','spec') { |
| |
if (grep(/^$rule$/,@brokerule)) { |
| |
$warning .= '<li>'.$rulenames{$rule}.'</li>'; |
| |
} |
| |
} |
| |
$warning .= '</ul>'; |
| |
} |
| |
if (wantarray) { |
| |
return @brokerule; |
| |
} |
| |
return $warning; |
| |
} |
| |
|
| |
sub passwd_validation_js { |
| |
my ($currpasswdval,$domain,$context,$id) = @_; |
| |
my (%passwdconf,$alertmsg); |
| |
if ($context eq 'linkprot') { |
| |
my %domconfig = &Apache::lonnet::get_dom('configuration',['ltisec'],$domain); |
| |
if (ref($domconfig{'ltisec'}) eq 'HASH') { |
| |
if (ref($domconfig{'ltisec'}{'rules'}) eq 'HASH') { |
| |
%passwdconf = %{$domconfig{'ltisec'}{'rules'}}; |
| |
} |
| |
} |
| |
if ($id eq 'add') { |
| |
$alertmsg = &mt('Secret for added launcher did not satisfy requirement(s):').'\n\n'; |
| |
} elsif ($id =~ /^\d+$/) { |
| |
my $pos = $id+1; |
| |
$alertmsg = &mt('Secret for launcher [_1] did not satisfy requirement(s):','#'.$pos).'\n\n'; |
| |
} else { |
| |
$alertmsg = &mt('A secret did not satisfy requirement(s):').'\n\n'; |
| |
} |
| |
} else { |
| |
%passwdconf = &Apache::lonnet::get_passwdconf($domain); |
| |
$alertmsg = &mt('Initial password did not satisfy requirement(s):').'\n\n'; |
| |
} |
| |
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)) { |
| |
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 ## |
## Get Kerberos Defaults for Domain ## |
| ############################################################### |
############################################################### |
|
Line 4340 sub get_student_view_with_retries {
|
Line 4571 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 |
=pod |
| |
|
| =item * &get_student_answers() |
=item * &get_student_answers() |
|
Line 4595 sub findallcourses {
|
Line 4879 sub findallcourses {
|
| ############################################### |
############################################### |
| |
|
| sub blockcheck { |
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 (defined($udom) && defined($uname)) { |
| # If uname and udom are for a course, check for blocks in the course. |
# If uname and udom are for a course, check for blocks in the course. |
| if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) { |
if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) { |
| my ($startblock,$endblock,$triggerblock) = |
my ($startblock,$endblock,$triggerblock) = |
| &get_blocks($setters,$activity,$udom,$uname,$url); |
&get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller); |
| return ($startblock,$endblock,$triggerblock); |
return ($startblock,$endblock,$triggerblock); |
| } |
} |
| } else { |
} else { |
|
Line 4612 sub blockcheck {
|
Line 4979 sub blockcheck {
|
| my $startblock = 0; |
my $startblock = 0; |
| my $endblock = 0; |
my $endblock = 0; |
| my $triggerblock = ''; |
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., |
# If uname is for a user, and activity is course-specific, i.e., |
| # boards, chat or groups, check for blocking in current course only. |
# boards, chat or groups, check for blocking in current course only. |
| |
|
| if (($activity eq 'boards' || $activity eq 'chat' || |
if (($activity eq 'boards' || $activity eq 'chat' || |
| $activity eq 'groups' || $activity eq 'printout') && |
$activity eq 'groups' || $activity eq 'printout' || |
| ($env{'request.course.id'})) { |
$activity eq 'search' || $activity eq 'reinit' || |
| |
$activity eq 'alert') && ($env{'request.course.id'})) { |
| foreach my $key (keys(%live_courses)) { |
foreach my $key (keys(%live_courses)) { |
| if ($key ne $env{'request.course.id'}) { |
if ($key ne $env{'request.course.id'}) { |
| delete($live_courses{$key}); |
delete($live_courses{$key}); |
|
Line 4728 sub blockcheck {
|
Line 5099 sub blockcheck {
|
| # of specified user, unless user has 'evb' privilege. |
# of specified user, unless user has 'evb' privilege. |
| |
|
| my ($start,$end,$trigger) = |
my ($start,$end,$trigger) = |
| &get_blocks($setters,$activity,$cdom,$cnum,$url); |
&get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller); |
| if (($start != 0) && |
if (($start != 0) && |
| (($startblock == 0) || ($startblock > $start))) { |
(($startblock == 0) || ($startblock > $start))) { |
| $startblock = $start; |
$startblock = $start; |
|
Line 4748 sub blockcheck {
|
Line 5119 sub blockcheck {
|
| } |
} |
| |
|
| sub get_blocks { |
sub get_blocks { |
| my ($setters,$activity,$cdom,$cnum,$url) = @_; |
my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_; |
| my $startblock = 0; |
my $startblock = 0; |
| my $endblock = 0; |
my $endblock = 0; |
| my $triggerblock = ''; |
my $triggerblock = ''; |
|
Line 4761 sub get_blocks {
|
Line 5132 sub get_blocks {
|
| my $now = time; |
my $now = time; |
| my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum); |
my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum); |
| if ($activity eq 'docs') { |
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) { |
foreach my $block (@blockers) { |
| if ($block =~ /^firstaccess____(.+)$/) { |
if ($block =~ /^firstaccess____(.+)$/) { |
| my $item = $1; |
my $item = $1; |
|
Line 4813 sub get_blocks {
|
Line 5190 sub get_blocks {
|
| my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; |
my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb}; |
| if ($start && $end) { |
if ($start && $end) { |
| if (($start <= time) && ($end >= time)) { |
if (($start <= time) && ($end >= time)) { |
| unless (grep(/^\Q$block\E$/,@blockers)) { |
if (ref($commblocks{$block}) eq 'HASH') { |
| push(@blockers,$block); |
if (ref($commblocks{$block}{'blocks'}) eq 'HASH') { |
| $triggered{$block} = { |
if ($commblocks{$block}{'blocks'}{$activity} eq 'on') { |
| start => $start, |
unless(grep(/^\Q$block\E$/,@blockers)) { |
| end => $end, |
push(@blockers,$block); |
| type => $type, |
$triggered{$block} = { |
| }; |
start => $start, |
| |
end => $end, |
| |
type => $type, |
| |
}; |
| |
} |
| |
} |
| |
} |
| } |
} |
| } |
} |
| } |
} |
|
Line 4883 sub parse_block_record {
|
Line 5266 sub parse_block_record {
|
| } |
} |
| |
|
| sub blocking_status { |
sub blocking_status { |
| my ($activity,$uname,$udom,$url,$is_course) = @_; |
my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_; |
| my %setters; |
my %setters; |
| |
|
| # check for active blocking |
# check for active blocking |
| my ($startblock,$endblock,$triggerblock) = |
if ($clientip eq '') { |
| &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course); |
$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; |
my $blocked = 0; |
| if ($startblock && $endblock) { |
if (($startblock && $endblock) || ($by_ip)) { |
| $blocked = 1; |
$blocked = 1; |
| } |
} |
| |
|
|
Line 4899 sub blocking_status {
|
Line 5285 sub blocking_status {
|
| |
|
| # build a link to a popup window containing the details |
# build a link to a popup window containing the details |
| my $querystring = "?activity=$activity"; |
my $querystring = "?activity=$activity"; |
| # $uname and $udom decide whose portfolio the user is trying to look at |
# $uname and $udom decide whose portfolio (or information page) the user is trying to look at |
| if (($activity eq 'port') || ($activity eq 'passwd')) { |
if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) { |
| $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); |
$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); |
| $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/); |
$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/); |
| } elsif ($activity eq 'docs') { |
} 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'; |
my $output .= <<'END_MYBLOCK'; |
|
Line 4929 END_MYBLOCK
|
Line 5320 END_MYBLOCK
|
| $text = &mt('Printing Blocked'); |
$text = &mt('Printing Blocked'); |
| } elsif ($activity eq 'passwd') { |
} elsif ($activity eq 'passwd') { |
| $text = &mt('Password Changing Blocked'); |
$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"; |
$output .= <<"END_BLOCK"; |
| <div class='$class'> |
<div class='$class'> |
|
Line 4953 sub check_ip_acc {
|
Line 5358 sub check_ip_acc {
|
| return 1; |
return 1; |
| } |
} |
| my $allowed=0; |
my $allowed=0; |
| my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; |
my $ip; |
| |
if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') || |
| |
($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) { |
| |
$ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip; |
| |
} else { |
| |
my $remote_ip = &Apache::lonnet::get_requestor_ip(); |
| |
$ip = $remote_ip || $env{'request.host'} || $clientip; |
| |
} |
| |
|
| my $name; |
my $name; |
| foreach my $pattern (split(',',$acc)) { |
my %access = ( |
| $pattern =~ s/^\s*//; |
allowfrom => 1, |
| $pattern =~ s/\s*$//; |
denyfrom => 0, |
| |
); |
| |
my @allows; |
| |
my @denies; |
| |
foreach my $item (split(',',$acc)) { |
| |
$item =~ s/^\s*//; |
| |
$item =~ s/\s*$//; |
| |
if ($item =~ /^\!(.+)$/) { |
| |
push(@denies,$1); |
| |
} else { |
| |
push(@allows,$item); |
| |
} |
| |
} |
| |
my $numdenies = scalar(@denies); |
| |
my $numallows = scalar(@allows); |
| |
my $count = 0; |
| |
foreach my $pattern (@denies,@allows) { |
| |
$count ++; |
| |
my $acctype = 'allowfrom'; |
| |
if ($count <= $numdenies) { |
| |
$acctype = 'denyfrom'; |
| |
} |
| if ($pattern =~ /\*$/) { |
if ($pattern =~ /\*$/) { |
| #35.8.* |
#35.8.* |
| $pattern=~s/\*//; |
$pattern=~s/\*//; |
| if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } |
| } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { |
} elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { |
| #35.8.3.[34-56] |
#35.8.3.[34-56] |
| my $low=$2; |
my $low=$2; |
|
Line 4970 sub check_ip_acc {
|
Line 5403 sub check_ip_acc {
|
| $pattern=$1; |
$pattern=$1; |
| if ($ip =~ /^\Q$pattern\E/) { |
if ($ip =~ /^\Q$pattern\E/) { |
| my $last=(split(/\./,$ip))[3]; |
my $last=(split(/\./,$ip))[3]; |
| if ($last <=$high && $last >=$low) { $allowed=1; } |
if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } |
| } |
} |
| } elsif ($pattern =~ /^\*/) { |
} elsif ($pattern =~ /^\*/) { |
| #*.msu.edu |
#*.msu.edu |
|
Line 4980 sub check_ip_acc {
|
Line 5413 sub check_ip_acc {
|
| my $netaddr=inet_aton($ip); |
my $netaddr=inet_aton($ip); |
| ($name)=gethostbyaddr($netaddr,AF_INET); |
($name)=gethostbyaddr($netaddr,AF_INET); |
| } |
} |
| if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } |
if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } |
| } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { |
} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { |
| #127.0.0.1 |
#127.0.0.1 |
| if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } |
| } else { |
} else { |
| #some.name.com |
#some.name.com |
| if (!defined($name)) { |
if (!defined($name)) { |
|
Line 4991 sub check_ip_acc {
|
Line 5424 sub check_ip_acc {
|
| my $netaddr=inet_aton($ip); |
my $netaddr=inet_aton($ip); |
| ($name)=gethostbyaddr($netaddr,AF_INET); |
($name)=gethostbyaddr($netaddr,AF_INET); |
| } |
} |
| if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } |
if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } |
| |
} |
| |
if ($allowed =~ /^(0|1)$/) { last; } |
| |
} |
| |
if ($allowed eq '') { |
| |
if ($numdenies && !$numallows) { |
| |
$allowed = 1; |
| |
} else { |
| |
$allowed = 0; |
| } |
} |
| if ($allowed) { last; } |
|
| } |
} |
| return $allowed; |
return $allowed; |
| } |
} |
|
Line 5074 sub get_domainconf {
|
Line 5514 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 { |
} else { |
| foreach my $img (keys(%{$domconfig{'login'}{$key}})) { |
foreach my $img (keys(%{$domconfig{'login'}{$key}})) { |
| $designhash{$udom.'.login.'.$key.'_'.$img} = |
$designhash{$udom.'.login.'.$key.'_'.$img} = |
|
Line 5178 sub domainlogo {
|
Line 5629 sub domainlogo {
|
| &Apache::lonnet::repcopy($local_name); |
&Apache::lonnet::repcopy($local_name); |
| } |
} |
| $imgsrc = &lonhttpdurl($imgsrc); |
$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'))) { |
} elsif (defined(&Apache::lonnet::domain($domain,'description'))) { |
| return &Apache::lonnet::domain($domain,'description'); |
return &Apache::lonnet::domain($domain,'description'); |
| } else { |
} else { |
|
Line 5403 Inputs:
|
Line 5858 Inputs:
|
| inlineremote items to be added in "Functions" menu below |
inlineremote items to be added in "Functions" menu below |
| breadcrumbs. |
breadcrumbs. |
| |
|
| |
=item * $ltiscope, optional argument, will be one of: resource, map or |
| |
course, if LON-CAPA is in LTI Provider context. Value is |
| |
the scope of use, i.e., launch was for access to a single, a map |
| |
or the entire course. |
| |
|
| |
=item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider |
| |
context, this will contain the URL for the landing item in |
| |
the course, after launch from an LTI Consumer |
| |
|
| |
=item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider |
| |
context, this will contain a reference to hash of items |
| |
to be included in the page header and/or inline menu. |
| |
|
| =back |
=back |
| |
|
| Returns: A uniform header for LON-CAPA web pages. |
Returns: A uniform header for LON-CAPA web pages. |
|
Line 5414 other decorations will be returned.
|
Line 5882 other decorations will be returned.
|
| |
|
| sub bodytag { |
sub bodytag { |
| my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, |
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg, |
| $no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref)=@_; |
$no_nav_bar,$bgcolor,$no_inline_link,$args,$advtoolsref, |
| |
$ltiscope,$ltiuri,$ltimenu,$menucoll,$menuref)=@_; |
| |
|
| my $public; |
my $public; |
| if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) |
if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')) |
|
Line 5443 sub bodytag {
|
Line 5912 sub bodytag {
|
| if ($realm) { |
if ($realm) { |
| $realm = '/'.$realm; |
$realm = '/'.$realm; |
| } |
} |
| if ($role eq 'ca') { |
if ($role eq 'ca') { |
| my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); |
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$}); |
| $realm = &plainname($rname,$rdom); |
$realm = &plainname($rname,$rdom); |
| } |
} |
| # realm |
# realm |
| |
my ($cid,$sec); |
| if ($env{'request.course.id'}) { |
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/) { |
if ($env{'request.role'} !~ /^cr/) { |
| $role = &Apache::lonnet::plaintext($role,&course_type()); |
$role = &Apache::lonnet::plaintext($role,&course_type()); |
| } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) { |
} elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) { |
|
Line 5460 sub bodytag {
|
Line 5941 sub bodytag {
|
| } else { |
} else { |
| $role = (split(/\//,$role,4))[-1]; |
$role = (split(/\//,$role,4))[-1]; |
| } |
} |
| if ($env{'request.course.sec'}) { |
if ($sec) { |
| $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'}; |
$role .= (' 'x2).'- '.&mt('section:').' '.$sec; |
| } |
} |
| $realm = $env{'course.'.$env{'request.course.id'}.'.description'}; |
$realm = $env{'course.'.$cid.'.description'}; |
| } else { |
} else { |
| $role = &Apache::lonnet::plaintext($role); |
$role = &Apache::lonnet::plaintext($role); |
| } |
} |
|
Line 5485 sub bodytag {
|
Line 5966 sub bodytag {
|
| if ($public) { |
if ($public) { |
| undef($role); |
undef($role); |
| } |
} |
| |
|
| |
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; |
| |
} |
| |
} |
| |
} |
| |
|
| my $titleinfo = '<h1>'.$title.'</h1>'; |
my $titleinfo = '<h1>'.$title.'</h1>'; |
| # |
# |
| # Extra info if you are the DC |
# Extra info if you are the DC |
| my $dc_info = ''; |
my $dc_info = ''; |
| if ($env{'user.adv'} && exists($env{'user.role.dc./'. |
if (($env{'user.adv'}) && ($env{'request.course.id'}) && $showcrstitle && |
| $env{'course.'.$env{'request.course.id'}. |
(exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) { |
| '.domain'}.'/'})) { |
|
| my $cid = $env{'request.course.id'}; |
|
| $dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; |
$dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'}; |
| $dc_info =~ s/\s+$//; |
$dc_info =~ s/\s+$//; |
| } |
} |
| |
|
| |
my $crstype; |
| |
if ($cid) { |
| |
$crstype = $env{'course.'.$cid.'.type'}; |
| |
} elsif ($args->{'crstype'}) { |
| |
$crstype = $args->{'crstype'}; |
| |
} |
| |
|
| $role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'}); |
$role = '<span class="LC_nobreak">('.$role.')</span>' if ($role && !$env{'browser.mobile'}); |
| |
|
| if ($env{'request.state'} eq 'construct') { $forcereg=1; } |
if ($env{'request.state'} eq 'construct') { $forcereg=1; } |
|
Line 5525 sub bodytag {
|
Line 6034 sub bodytag {
|
| $bodytag .= Apache::lonhtmlcommon::scripttag( |
$bodytag .= Apache::lonhtmlcommon::scripttag( |
| Apache::lonmenu::utilityfunctions($httphost), 'start'); |
Apache::lonmenu::utilityfunctions($httphost), 'start'); |
| |
|
| my ($left,$right) = Apache::lonmenu::primary_menu(); |
unless ($args->{'no_primary_menu'}) { |
| |
my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu,$menucoll,$menuref, |
| if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { |
$args->{'links_disabled'}); |
| if ($dc_info) { |
if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { |
| $dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|; |
if ($dc_info) { |
| |
$dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|; |
| |
} |
| |
$bodytag .= qq|<div id="LC_nav_bar">$left $role<br /> |
| |
<em>$realm</em> $dc_info</div>|; |
| |
return $bodytag; |
| } |
} |
| $bodytag .= qq|<div id="LC_nav_bar">$left $role<br /> |
|
| <em>$realm</em> $dc_info</div>|; |
|
| return $bodytag; |
|
| } |
|
| |
|
| unless ($env{'request.symb'} =~ m/\.page___\d+___/) { |
unless ($env{'request.symb'} =~ m/\.page___\d+___/) { |
| $bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|; |
$bodytag .= qq|<div id="LC_nav_bar">$left $role</div>|; |
| } |
} |
| |
|
| $bodytag .= $right; |
$bodytag .= $right; |
| |
|
| if ($dc_info) { |
if ($dc_info) { |
| $dc_info = &dc_courseid_toggle($dc_info); |
$dc_info = &dc_courseid_toggle($dc_info); |
| |
} |
| |
$bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|; |
| } |
} |
| $bodytag .= qq|<div id="LC_realm">$realm $dc_info</div>|; |
|
| |
|
| #if directed to not display the secondary menu, don't. |
#if directed to not display the secondary menu, don't. |
| if ($args->{'no_secondary_menu'}) { |
if ($args->{'no_secondary_menu'}) { |
|
Line 5553 sub bodytag {
|
Line 6064 sub bodytag {
|
| } |
} |
| #don't show menus for public users |
#don't show menus for public users |
| if (!$public){ |
if (!$public){ |
| $bodytag .= Apache::lonmenu::secondary_menu($httphost); |
unless ($args->{'no_inline_menu'}) { |
| |
$bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu, |
| |
$args->{'no_primary_menu'}, |
| |
$menucoll,$menuref, |
| |
$args->{'links_disabled'}); |
| |
} |
| $bodytag .= Apache::lonmenu::serverform(); |
$bodytag .= Apache::lonmenu::serverform(); |
| $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); |
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end'); |
| if ($env{'request.state'} eq 'construct') { |
if ($env{'request.state'} eq 'construct') { |
| $bodytag .= &Apache::lonmenu::innerregister($forcereg, |
$bodytag .= &Apache::lonmenu::innerregister($forcereg, |
| $args->{'bread_crumbs'},'','',$hostname); |
$args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri); |
| } elsif ($forcereg) { |
} elsif ($forcereg) { |
| $bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, |
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef, |
| $args->{'group'}, |
$args->{'group'}, |
| $args->{'hide_buttons', |
$args->{'hide_buttons'}, |
| $hostname}); |
$hostname,$ltiscope,$ltiuri); |
| } else { |
} else { |
| my $forbodytag; |
my $forbodytag; |
| &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
|
Line 6679 table.LC_prior_tries td {
|
Line 7195 table.LC_prior_tries td {
|
| padding: 6px; |
padding: 6px; |
| } |
} |
| |
|
| .LC_answer_unknown { |
.LC_answer_unknown, |
| |
.LC_answer_warning { |
| background: orange; |
background: orange; |
| color: black; |
color: black; |
| padding: 6px; |
padding: 6px; |
|
Line 7670 ul.LC_funclist li {
|
Line 8187 ul.LC_funclist li {
|
| cursor:pointer; |
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 by TTH when "Default set of options to pass to tth/m |
styles used by TTH when "Default set of options to pass to tth/m |
| when converting TeX" in course settings has been set |
when converting TeX" in course settings has been set |
|
Line 7829 ADDMETA
|
Line 8366 ADDMETA
|
| my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; |
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; |
| unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { |
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { |
| my %domdefs = &Apache::lonnet::get_domain_defaults($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') { |
if (ref($domdefs{'offloadnow'}) eq 'HASH') { |
| my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
|
| if ($domdefs{'offloadnow'}{$lonhost}) { |
if ($domdefs{'offloadnow'}{$lonhost}) { |
| my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); |
$offload = 1; |
| if (($newserver) && ($newserver ne $lonhost)) { |
if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && |
| my $numsec = 5; |
(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { |
| my $timeout = $numsec * 1000; |
unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { |
| my ($newurl,$locknum,%locks,$msg); |
$offloadoth = 1; |
| if ($env{'request.role.adv'}) { |
$dom_in_use = $env{'user.domain'}; |
| ($locknum,%locks) = &Apache::lonnet::get_locks(); |
|
| } |
} |
| 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". |
if ($offload) { |
| &mt('your session will be transferred to a different server, after you click "Roles".'); |
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 { |
} else { |
| if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { |
$msg .= &mt('your session will be transferred to a different server, after you click "Roles".'); |
| $msg = &mt('Your LON-CAPA submission has been recorded')."\\n"; |
} |
| } |
} else { |
| $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); |
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { |
| $newurl = '/adm/switchserver?otherserver='.$newserver; |
$msg = &mt('Your LON-CAPA submission has been recorded')."\n"; |
| if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { |
} |
| $newurl .= '&role='.$env{'request.role'}; |
$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'}) { |
if ($shownsymb) { |
| $newurl .= '&symb='.$env{'request.symb'}; |
&js_escape(\$shownsymb); |
| } else { |
$newurl .= '&symb='.$shownsymb; |
| $newurl .= '&origurl='.$requrl; |
|
| } |
} |
| |
} else { |
| |
my $shownurl = &Apache::lonenc::check_encrypt($requrl); |
| |
&js_escape(\$shownurl); |
| |
$newurl .= '&origurl='.$shownurl; |
| } |
} |
| &js_escape(\$msg); |
} |
| $result.=<<OFFLOAD |
&js_escape(\$msg); |
| |
$result.=<<OFFLOAD |
| <meta http-equiv="pragma" content="no-cache" /> |
<meta http-equiv="pragma" content="no-cache" /> |
| <script type="text/javascript"> |
<script type="text/javascript"> |
| // <![CDATA[ |
// <![CDATA[ |
|
Line 7886 function LC_Offload_Now() {
|
Line 8479 function LC_Offload_Now() {
|
| // ]]> |
// ]]> |
| </script> |
</script> |
| OFFLOAD |
OFFLOAD |
| } |
|
| } |
} |
| } |
} |
| } |
} |
|
Line 7985 sub print_suppression {
|
Line 8577 sub print_suppression {
|
| } |
} |
| my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
| my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
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) { |
if ($blocked) { |
| my $checkrole = "cm./$cdom/$cnum"; |
my $checkrole = "cm./$cdom/$cnum"; |
| if ($env{'request.course.sec'} ne '') { |
if ($env{'request.course.sec'} ne '') { |
|
Line 8106 $args - additional optional args support
|
Line 8699 $args - additional optional args support
|
| will contain https://<hostname> if server uses |
will contain https://<hostname> if server uses |
| https (as per hosts.tab), but request is for http |
https (as per hosts.tab), but request is for http |
| hostname -> hostname, originally from $r->hostname(), (optional). |
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 |
=back |
| |
|
|
Line 8118 sub start_page {
|
Line 8714 sub start_page {
|
| #&Apache::lonnet::logthis("start_page ".join(':',caller(0))); |
#&Apache::lonnet::logthis("start_page ".join(':',caller(0))); |
| |
|
| $env{'internal.start_page'}++; |
$env{'internal.start_page'}++; |
| my ($result,@advtools); |
my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu,$menucoll,%menu); |
| |
|
| if (! exists($args->{'skip_phases'}{'head'}) ) { |
if (! exists($args->{'skip_phases'}{'head'}) ) { |
| $result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args); |
$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; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
} |
| |
|
| if (! exists($args->{'skip_phases'}{'body'}) ) { |
if (! exists($args->{'skip_phases'}{'body'}) ) { |
| if ($args->{'frameset'}) { |
if ($args->{'frameset'}) { |
| my $attr_string = &make_attr_string($args->{'force_register'}, |
my $attr_string = &make_attr_string($args->{'force_register'}, |
|
Line 8136 sub start_page {
|
Line 8802 sub start_page {
|
| $args->{'only_body'}, $args->{'domain'}, |
$args->{'only_body'}, $args->{'domain'}, |
| $args->{'force_register'}, $args->{'no_nav_bar'}, |
$args->{'force_register'}, $args->{'no_nav_bar'}, |
| $args->{'bgcolor'}, $args->{'no_inline_link'}, |
$args->{'bgcolor'}, $args->{'no_inline_link'}, |
| $args, \@advtools); |
$args, \@advtools, |
| |
$ltiscope,$ltiuri,\%ltimenu,$menucoll,\%menu); |
| } |
} |
| } |
} |
| |
|
|
Line 8171 sub start_page {
|
Line 8838 sub start_page {
|
| } |
} |
| my $menulink; |
my $menulink; |
| # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item. |
# 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; |
$menulink = 0; |
| } else { |
} else { |
| undef($menulink); |
undef($menulink); |
|
Line 8179 sub start_page {
|
Line 8847 sub start_page {
|
| #if bread_crumbs_component exists show it as headline else show only the breadcrumbs |
#if bread_crumbs_component exists show it as headline else show only the breadcrumbs |
| if(exists($args->{'bread_crumbs_component'})){ |
if(exists($args->{'bread_crumbs_component'})){ |
| $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink); |
$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink); |
| }else{ |
} else { |
| $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink); |
$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink); |
| } |
} |
| } elsif (($env{'environment.remote'} eq 'on') && |
} elsif (($env{'environment.remote'} eq 'on') && |
|
Line 8223 sub end_page {
|
Line 8891 sub end_page {
|
| return $result; |
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 { |
sub wishlist_window { |
| return(<<'ENDWISHLIST'); |
return(<<'ENDWISHLIST'); |
| <script type="text/javascript"> |
<script type="text/javascript"> |
|
Line 8307 sub modal_link {
|
Line 9072 sub modal_link {
|
| $target_attr = 'target="'.$target.'"'; |
$target_attr = 'target="'.$target.'"'; |
| } |
} |
| return <<"ENDLINK"; |
return <<"ENDLINK"; |
| <a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;"> |
<a href="$link" $target_attr title="$title" onclick="javascript:openMyModal('$link',$width,$height,'$scrolling','$transparency','$style'); return false;">$linktext</a> |
| $linktext</a> |
|
| ENDLINK |
ENDLINK |
| } |
} |
| |
|
| sub modal_adhoc_script { |
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); |
return (<<ENDADHOC); |
| <script type="text/javascript"> |
<script type="text/javascript"> |
| // <![CDATA[ |
// <![CDATA[ |
|
Line 8324 sub modal_adhoc_script {
|
Line 9096 sub modal_adhoc_script {
|
| modalWindow.height = $height; |
modalWindow.height = $height; |
| modalWindow.content = '$content'; |
modalWindow.content = '$content'; |
| modalWindow.open(); |
modalWindow.open(); |
| |
$mathjax |
| }; |
}; |
| // ]]> |
// ]]> |
| </script> |
</script> |
|
Line 8331 ENDADHOC
|
Line 9104 ENDADHOC
|
| } |
} |
| |
|
| sub modal_adhoc_inner { |
sub modal_adhoc_inner { |
| my ($funcname,$width,$height,$content)=@_; |
my ($funcname,$width,$height,$content,$possmathjax)=@_; |
| my $innerwidth=$width-20; |
my $innerwidth=$width-20; |
| $content=&js_ready( |
$content=&js_ready( |
| &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). |
&start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). |
|
Line 8340 sub modal_adhoc_inner {
|
Line 9113 sub modal_adhoc_inner {
|
| &end_scrollbox(). |
&end_scrollbox(). |
| &end_page() |
&end_page() |
| ); |
); |
| return &modal_adhoc_script($funcname,$width,$height,$content); |
return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax); |
| } |
} |
| |
|
| sub modal_adhoc_window { |
sub modal_adhoc_window { |
| my ($funcname,$width,$height,$content,$linktext)=@_; |
my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_; |
| return &modal_adhoc_inner($funcname,$width,$height,$content). |
return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax). |
| "<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>"; |
"<a href=\"javascript:$funcname();void(0);\">".$linktext."</a>"; |
| } |
} |
| |
|
|
Line 8706 function expand_div(caller) {
|
Line 9479 function expand_div(caller) {
|
| |
|
| sub simple_error_page { |
sub simple_error_page { |
| my ($r,$title,$msg,$args) = @_; |
my ($r,$title,$msg,$args) = @_; |
| |
my %displayargs; |
| if (ref($args) eq 'HASH') { |
if (ref($args) eq 'HASH') { |
| if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); } |
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 { |
} else { |
| $msg = &mt($msg); |
$msg = &mt($msg); |
| } |
} |
| |
|
| my $page = |
my $page = |
| &Apache::loncommon::start_page($title). |
&Apache::loncommon::start_page($title,'',\%displayargs). |
| '<p class="LC_error">'.$msg.'</p>'. |
'<p class="LC_error">'.$msg.'</p>'. |
| &Apache::loncommon::end_page(); |
&Apache::loncommon::end_page(); |
| if (ref($r)) { |
if (ref($r)) { |
|
Line 10201 sub sorted_inst_types {
|
Line 10981 sub sorted_inst_types {
|
| } |
} |
| |
|
| sub get_institutional_codes { |
sub get_institutional_codes { |
| my ($settings,$allcourses,$LC_code) = @_; |
my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_; |
| # Get complete list of course sections to update |
# Get complete list of course sections to update |
| my @currsections = (); |
my @currsections = (); |
| my @currxlists = (); |
my @currxlists = (); |
| |
my (%unclutteredsec,%unclutteredlcsec); |
| my $coursecode = $$settings{'internal.coursecode'}; |
my $coursecode = $$settings{'internal.coursecode'}; |
| |
my $crskey = $crs.':'.$coursecode; |
| |
@{$unclutteredsec{$crskey}} = (); |
| |
@{$unclutteredlcsec{$crskey}} = (); |
| |
|
| if ($$settings{'internal.sectionnums'} ne '') { |
if ($$settings{'internal.sectionnums'} ne '') { |
| @currsections = split(/,/,$$settings{'internal.sectionnums'}); |
@currsections = split(/,/,$$settings{'internal.sectionnums'}); |
|
Line 10216 sub get_institutional_codes {
|
Line 11000 sub get_institutional_codes {
|
| } |
} |
| |
|
| if (@currxlists > 0) { |
if (@currxlists > 0) { |
| foreach (@currxlists) { |
foreach my $xl (@currxlists) { |
| if (m/^([^:]+):(\w*)$/) { |
if ($xl =~ /^([^:]+):(\w*)$/) { |
| unless (grep/^$1$/,@{$allcourses}) { |
unless (grep/^$1$/,@{$allcourses}) { |
| push(@{$allcourses},$1); |
push(@{$allcourses},$1); |
| $$LC_code{$1} = $2; |
$$LC_code{$1} = $2; |
|
Line 10225 sub get_institutional_codes {
|
Line 11009 sub get_institutional_codes {
|
| } |
} |
| } |
} |
| } |
} |
| |
|
| if (@currsections > 0) { |
if (@currsections > 0) { |
| foreach (@currsections) { |
foreach my $sec (@currsections) { |
| if (m/^(\w+):(\w*)$/) { |
if ($sec =~ m/^(\w+):(\w*)$/ ) { |
| my $sec = $coursecode.$1; |
my $instsec = $1; |
| my $lc_sec = $2; |
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); |
push(@{$allcourses},$sec); |
| $$LC_code{$sec} = $lc_sec; |
$$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i]; |
| } |
} |
| } |
} |
| } |
} |
|
Line 14106 defdom (domain for which to retrieve con
|
Line 14903 defdom (domain for which to retrieve con
|
| origmail (scalar - email address of recipient from loncapa.conf, |
origmail (scalar - email address of recipient from loncapa.conf, |
| i.e., predates configuration by DC via domainprefs.pm |
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. |
Returns: comma separated list of addresses to which to send e-mail. |
| |
|
| =back |
=back |
|
Line 14115 Returns: comma separated list of address
|
Line 14918 Returns: comma separated list of address
|
| ############################################################ |
############################################################ |
| ############################################################ |
############################################################ |
| sub build_recipient_list { |
sub build_recipient_list { |
| my ($defmail,$mailing,$defdom,$origmail) = @_; |
my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_; |
| my @recipients; |
my @recipients; |
| my ($otheremails,$lastresort,$allbcc,$addtext); |
my ($otheremails,$lastresort,$allbcc,$addtext); |
| my %domconfig = |
my %domconfig = |
|
Line 14156 sub build_recipient_list {
|
Line 14959 sub build_recipient_list {
|
| } elsif ($origmail ne '') { |
} elsif ($origmail ne '') { |
| $lastresort = $origmail; |
$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 '') { |
} elsif ($origmail ne '') { |
| $lastresort = $origmail; |
$lastresort = $origmail; |
| } |
} |
| |
|
| if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) { |
if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) { |
| unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { |
unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { |
| my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
|
Line 14432 sub recurse_categories {
|
Line 15322 sub recurse_categories {
|
| for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { |
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) { |
| my $name = $cats->[$depth]{$category}[$k]; |
my $name = $cats->[$depth]{$category}[$k]; |
| my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; |
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower; |
| my $trailstr = join(' -> ',(@{$parents},$category)); |
my $trailstr = join(' » ',(@{$parents},$category)); |
| if ($allitems->{$item} eq '') { |
if ($allitems->{$item} eq '') { |
| push(@{$trails},$trailstr); |
push(@{$trails},$trailstr); |
| $allitems->{$item} = scalar(@{$trails})-1; |
$allitems->{$item} = scalar(@{$trails})-1; |
|
Line 14822 sub check_clone {
|
Line 15712 sub check_clone {
|
| my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; |
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; |
| my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); |
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); |
| my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); |
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); |
| my $clonemsg; |
my $clonetitle; |
| |
my @clonemsg; |
| my $can_clone = 0; |
my $can_clone = 0; |
| my $lctype = lc($args->{'crstype'}); |
my $lctype = lc($args->{'crstype'}); |
| if ($lctype ne 'community') { |
if ($lctype ne 'community') { |
|
Line 14830 sub check_clone {
|
Line 15721 sub check_clone {
|
| } |
} |
| if ($clonehome eq 'no_host') { |
if ($clonehome eq 'no_host') { |
| if ($args->{'crstype'} eq 'Community') { |
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 { |
} 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 { |
} else { |
| my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
| |
$clonetitle = $clonedesc{'description'}; |
| if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
| if ($clonedesc{'type'} ne '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'}); |
push(@clonemsg,({ |
| return ($can_clone, $clonemsg, $cloneid, $clonehome); |
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'}) && |
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
|
Line 14928 sub check_clone {
|
Line 15841 sub check_clone {
|
| } |
} |
| unless ($can_clone) { |
unless ($can_clone) { |
| if ($args->{'crstype'} eq 'Community') { |
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 { |
} 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 { |
sub construct_course { |
| my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
| $cnum,$category,$coderef) = @_; |
$cnum,$category,$coderef,$callercontext,$user_lh) = @_; |
| my $outcome; |
my ($outcome,$msgref,$clonemsgref); |
| my $linefeed = '<br />'."\n"; |
my $linefeed = '<br />'."\n"; |
| if ($context eq 'auto') { |
if ($context eq 'auto') { |
| $linefeed = "\n"; |
$linefeed = "\n"; |
|
Line 14950 sub construct_course {
|
Line 15877 sub construct_course {
|
| # |
# |
| # Are we cloning? |
# Are we cloning? |
| # |
# |
| my ($can_clone, $clonemsg, $cloneid, $clonehome); |
my ($can_clone,$cloneid,$clonehome,$clonetitle); |
| if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { |
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { |
| ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed); |
($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed); |
| if ($context ne 'auto') { |
|
| if ($clonemsg ne '') { |
|
| $clonemsg = '<span class="LC_error">'.$clonemsg.'</span>'; |
|
| } |
|
| } |
|
| $outcome .= $clonemsg.$linefeed; |
|
| |
|
| if (!$can_clone) { |
if (!$can_clone) { |
| return (0,$outcome); |
return (0,$outcome,$clonemsgref); |
| } |
} |
| } |
} |
| |
|
|
Line 14979 sub construct_course {
|
Line 15899 sub construct_course {
|
| $args->{'ccuname'}.':'. |
$args->{'ccuname'}.':'. |
| $args->{'ccdomain'}, |
$args->{'ccdomain'}, |
| $args->{'crstype'}, |
$args->{'crstype'}, |
| $cnum,$context,$category); |
$cnum,$context,$category, |
| |
$callercontext); |
| |
|
| # Note: The testing routines depend on this being output; see |
# Note: The testing routines depend on this being output; see |
| # Utils::Course. This needs to at least be output as a comment |
# Utils::Course. This needs to at least be output as a comment |
| # if anyone ever decides to not show this, and Utils::Course::new |
# if anyone ever decides to not show this, and Utils::Course::new |
| # will need to be suitably modified. |
# 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:/) { |
if ($$courseid =~ /^error:/) { |
| return (0,$outcome); |
return (0,$outcome,$clonemsgref); |
| } |
} |
| |
|
| # |
# |
|
Line 14996 sub construct_course {
|
Line 15921 sub construct_course {
|
| ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); |
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); |
| my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); |
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); |
| if ($crsuhome eq 'no_host') { |
if ($crsuhome eq 'no_host') { |
| $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed; |
if (($callercontext eq 'auto') && ($user_lh ne '')) { |
| return (0,$outcome); |
$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; |
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed; |
| |
|
| # |
# |
| # Do the cloning |
# Do the cloning |
| # |
# |
| |
my @clonemsg; |
| if ($can_clone && $cloneid) { |
if ($can_clone && $cloneid) { |
| $clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome); |
push(@clonemsg, |
| if ($context ne 'auto') { |
{ |
| $clonemsg = '<span class="LC_success">'.$clonemsg.'</span>'; |
mt => 'Created [_1] by cloning from [_2]', |
| } |
args => [$crstype,$clonetitle], |
| $outcome .= $clonemsg.$linefeed; |
}); |
| my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
| # Copy all files |
# 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 |
# Restore URL |
| $cenv{'url'}=$oldcenv{'url'}; |
$cenv{'url'}=$oldcenv{'url'}; |
| # Restore title |
# Restore title |
|
Line 15037 sub construct_course {
|
Line 15976 sub construct_course {
|
| 'plc.users.denied', |
'plc.users.denied', |
| 'hidefromcat', |
'hidefromcat', |
| 'checkforpriv', |
'checkforpriv', |
| 'categories', |
'categories'], |
| 'internal.uniquecode'], |
|
| $$crsudom,$$crsunum); |
$$crsudom,$$crsunum); |
| if ($args->{'textbook'}) { |
if ($args->{'textbook'}) { |
| $cenv{'internal.textbook'} = $args->{'textbook'}; |
$cenv{'internal.textbook'} = $args->{'textbook'}; |
|
Line 15279 sub construct_course {
|
Line 16217 sub construct_course {
|
| # Open all assignments |
# Open all assignments |
| # |
# |
| if ($args->{'openall'}) { |
if ($args->{'openall'}) { |
| |
my $opendate = time; |
| |
if ($args->{'openallfrom'} =~ /^\d+$/) { |
| |
$opendate = $args->{'openallfrom'}; |
| |
} |
| my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate'; |
my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate'; |
| my %storecontent = ($storeunder => time, |
my %storecontent = ($storeunder => $opendate, |
| $storeunder.'.type' => 'date_start'); |
$storeunder.'.type' => 'date_start'); |
| |
$outcome .= &mt('All assignments open starting [_1]', |
| $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput |
&Apache::lonlocal::locallocaltime($opendate)).': '. |
| ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; |
&Apache::lonnet::cput |
| |
('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; |
| } |
} |
| # |
# |
| # Set first page |
# Set first page |
|
Line 15314 sub construct_course {
|
Line 16257 sub construct_course {
|
| $outcome .= ($fatal?$errtext:'write ok').$linefeed; |
$outcome .= ($fatal?$errtext:'write ok').$linefeed; |
| } |
} |
| |
|
| return (1,$outcome); |
return (1,$outcome,\@clonemsg); |
| } |
} |
| |
|
| sub make_unique_code { |
sub make_unique_code { |
|
Line 15483 sub compare_arrays {
|
Line 16426 sub compare_arrays {
|
| return @difference; |
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 |
# -------------------------------------------------------- Initialize user login |
| sub init_user_environment { |
sub init_user_environment { |
| my ($r, $username, $domain, $authhost, $form, $args) = @_; |
my ($r, $username, $domain, $authhost, $form, $args) = @_; |
|
Line 15518 sub init_user_environment {
|
Line 16479 sub init_user_environment {
|
| opendir(DIR,$lonids); |
opendir(DIR,$lonids); |
| while ($filename=readdir(DIR)) { |
while ($filename=readdir(DIR)) { |
| if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) { |
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); |
closedir(DIR); |
|
Line 15569 sub init_user_environment {
|
Line 16546 sub init_user_environment {
|
| # --------------------------------------------------------- Write first profile |
# --------------------------------------------------------- Write first profile |
| |
|
| { |
{ |
| |
my $ip = &Apache::lonnet::get_requestor_ip(); |
| my %initial_env = |
my %initial_env = |
| ("user.name" => $username, |
("user.name" => $username, |
| "user.domain" => $domain, |
"user.domain" => $domain, |
|
Line 15587 sub init_user_environment {
|
Line 16565 sub init_user_environment {
|
| "request.course.sec" => '', |
"request.course.sec" => '', |
| "request.role" => 'cm', |
"request.role" => 'cm', |
| "request.role.adv" => $env{'user.adv'}, |
"request.role.adv" => $env{'user.adv'}, |
| "request.host" => $ENV{'REMOTE_ADDR'},); |
"request.host" => $ip,); |
| |
|
| if ($form->{'localpath'}) { |
if ($form->{'localpath'}) { |
| $initial_env{"browser.localpath"} = $form->{'localpath'}; |
$initial_env{"browser.localpath"} = $form->{'localpath'}; |
|
Line 16447 sub needs_coursereinit {
|
Line 17425 sub needs_coursereinit {
|
| $interval = 600; |
$interval = 600; |
| } |
} |
| if (($now-$env{'request.course.timechecked'})>$interval) { |
if (($now-$env{'request.course.timechecked'})>$interval) { |
| my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); |
|
| &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); |
&Apache::lonnet::appenv({'request.course.timechecked'=>$now}); |
| |
my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1); |
| |
if ($blocked) { |
| |
return (); |
| |
} |
| |
my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); |
| if ($lastchange > $env{'request.course.tied'}) { |
if ($lastchange > $env{'request.course.tied'}) { |
| my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
| if ($curr_reqd_hash{'internal.releaserequired'} ne '') { |
if ($curr_reqd_hash{'internal.releaserequired'} ne '') { |
|
Line 16651 sub symb_to_docspath {
|
Line 17633 sub symb_to_docspath {
|
| } |
} |
| |
|
| sub captcha_display { |
sub captcha_display { |
| my ($context,$lonhost) = @_; |
my ($context,$lonhost,$defdom) = @_; |
| my ($output,$error); |
my ($output,$error); |
| my ($captcha,$pubkey,$privkey,$version) = |
my ($captcha,$pubkey,$privkey,$version) = |
| &get_captcha_config($context,$lonhost); |
&get_captcha_config($context,$lonhost,$defdom); |
| if ($captcha eq 'original') { |
if ($captcha eq 'original') { |
| $output = &create_captcha(); |
$output = &create_captcha(); |
| unless ($output) { |
unless ($output) { |
|
Line 16670 sub captcha_display {
|
Line 17652 sub captcha_display {
|
| } |
} |
| |
|
| sub captcha_response { |
sub captcha_response { |
| my ($context,$lonhost) = @_; |
my ($context,$lonhost,$defdom) = @_; |
| my ($captcha_chk,$captcha_error); |
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') { |
if ($captcha eq 'original') { |
| ($captcha_chk,$captcha_error) = &check_captcha(); |
($captcha_chk,$captcha_error) = &check_captcha(); |
| } elsif ($captcha eq 'recaptcha') { |
} elsif ($captcha eq 'recaptcha') { |
|
Line 16684 sub captcha_response {
|
Line 17666 sub captcha_response {
|
| } |
} |
| |
|
| sub get_captcha_config { |
sub get_captcha_config { |
| my ($context,$lonhost) = @_; |
my ($context,$lonhost,$dom_in_effect) = @_; |
| my ($captcha,$pubkey,$privkey,$version,$hashtocheck); |
my ($captcha,$pubkey,$privkey,$version,$hashtocheck); |
| my $hostname = &Apache::lonnet::hostname($lonhost); |
my $hostname = &Apache::lonnet::hostname($lonhost); |
| my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); |
my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); |
|
Line 16732 sub get_captcha_config {
|
Line 17714 sub get_captcha_config {
|
| } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') { |
} elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') { |
| $captcha = '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); |
return ($captcha,$pubkey,$privkey,$version); |
| } |
} |
|
Line 16749 sub create_captcha {
|
Line 17752 sub create_captcha {
|
| |
|
| if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { |
if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { |
| $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n". |
$output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n". |
| |
'<span class="LC_nobreak">'. |
| &mt('Type in the letters/numbers shown below').' '. |
&mt('Type in the letters/numbers shown below').' '. |
| '<input type="text" size="5" name="code" value="" autocomplete="off" />'. |
'<input type="text" size="5" name="code" value="" autocomplete="off" />'. |
| '<br />'. |
'</span><br />'. |
| '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />'; |
'<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" alt="captcha" />'; |
| last; |
last; |
| } |
} |
| } |
} |
| |
if ($output eq '') { |
| |
&Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts."); |
| |
} |
| return $output; |
return $output; |
| } |
} |
| |
|
|
Line 16794 sub check_captcha {
|
Line 17801 sub check_captcha {
|
| sub create_recaptcha { |
sub create_recaptcha { |
| my ($pubkey,$version) = @_; |
my ($pubkey,$version) = @_; |
| if ($version >= 2) { |
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 { |
} else { |
| my $use_ssl; |
my $use_ssl; |
| if ($ENV{'SERVER_PORT'} == 443) { |
if ($ENV{'SERVER_PORT'} == 443) { |
|
Line 16812 sub create_recaptcha {
|
Line 17820 sub create_recaptcha {
|
| sub check_recaptcha { |
sub check_recaptcha { |
| my ($privkey,$version) = @_; |
my ($privkey,$version) = @_; |
| my $captcha_chk; |
my $captcha_chk; |
| |
my $ip = &Apache::lonnet::get_requestor_ip(); |
| if ($version >= 2) { |
if ($version >= 2) { |
| my $ua = LWP::UserAgent->new; |
my $ua = LWP::UserAgent->new; |
| $ua->timeout(10); |
$ua->timeout(10); |
| my %info = ( |
my %info = ( |
| secret => $privkey, |
secret => $privkey, |
| response => $env{'form.g-recaptcha-response'}, |
response => $env{'form.g-recaptcha-response'}, |
| remoteip => $ENV{'REMOTE_ADDR'}, |
remoteip => $ip, |
| ); |
); |
| my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); |
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); |
| if ($response->is_success) { |
if ($response->is_success) { |
|
Line 16834 sub check_recaptcha {
|
Line 17843 sub check_recaptcha {
|
| my $captcha_result = |
my $captcha_result = |
| $captcha->check_answer( |
$captcha->check_answer( |
| $privkey, |
$privkey, |
| $ENV{'REMOTE_ADDR'}, |
$ip, |
| $env{'form.recaptcha_challenge_field'}, |
$env{'form.recaptcha_challenge_field'}, |
| $env{'form.recaptcha_response_field'}, |
$env{'form.recaptcha_response_field'}, |
| ); |
); |
|
Line 16883 sub cleanup_html {
|
Line 17892 sub cleanup_html {
|
| |
|
| # Checks for critical messages and returns a redirect url if one exists. |
# Checks for critical messages and returns a redirect url if one exists. |
| # $interval indicates how often to check for messages. |
# $interval indicates how often to check for messages. |
| |
# $context is the calling context -- roles, grades, contents, menu or flip. |
| sub critical_redirect { |
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 ((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'}, |
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, |
| $env{'user.name'}); |
$env{'user.name'}); |
| &Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); |
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); |
| my $redirecturl; |
my $redirecturl; |
| if ($what[0]) { |
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'; |
$redirecturl='/adm/email?critical=display'; |
| my $url=&Apache::lonnet::absolute_url().$redirecturl; |
my $url=&Apache::lonnet::absolute_url().$redirecturl; |
| return (1, $url); |
return (1, $url); |
|
Line 16951 sub des_decrypt {
|
Line 17979 sub des_decrypt {
|
| return $plaintext; |
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; |
1; |
| __END__; |
__END__; |
| |
|
![[BACK]](/icons/back.gif){kind=icon}
Return to loncommon.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface