version 1.1306, 2017/12/30 19:51:30
|
version 1.1341, 2020/05/22 15:05:30
|
Line 72 use Apache::lonuserstate();
|
Line 72 use Apache::lonuserstate();
|
use Apache::courseclassifier(); |
use Apache::courseclassifier(); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA::LWPReq; |
use LONCAPA::LWPReq; |
|
use HTTP::Request; |
use DateTime::TimeZone; |
use DateTime::TimeZone; |
use DateTime::Locale; |
use DateTime::Locale; |
use Encode(); |
use Encode(); |
Line 79 use Text::Aspell;
|
Line 80 use Text::Aspell;
|
use Authen::Captcha; |
use Authen::Captcha; |
use Captcha::reCAPTCHA; |
use Captcha::reCAPTCHA; |
use JSON::DWIW; |
use JSON::DWIW; |
use LWP::UserAgent; |
|
use Crypt::DES; |
use Crypt::DES; |
use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
use MIME::Lite; |
use MIME::Lite; |
use MIME::Types; |
use MIME::Types; |
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 201 BEGIN {
|
Line 203 BEGIN {
|
{ |
{ |
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
'/language.tab'; |
'/language.tab'; |
if ( open(my $fh,"<$langtabfile") ) { |
if ( open(my $fh,'<',$langtabfile) ) { |
while (my $line = <$fh>) { |
while (my $line = <$fh>) { |
next if ($line=~/^\#/); |
next if ($line=~/^\#/); |
chomp($line); |
chomp($line); |
Line 223 BEGIN {
|
Line 225 BEGIN {
|
{ |
{ |
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. |
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. |
'/copyright.tab'; |
'/copyright.tab'; |
if ( open (my $fh,"<$copyrightfile") ) { |
if ( open (my $fh,'<',$copyrightfile) ) { |
while (my $line = <$fh>) { |
while (my $line = <$fh>) { |
next if ($line=~/^\#/); |
next if ($line=~/^\#/); |
chomp($line); |
chomp($line); |
Line 237 BEGIN {
|
Line 239 BEGIN {
|
{ |
{ |
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. |
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. |
'/source_copyright.tab'; |
'/source_copyright.tab'; |
if ( open (my $fh,"<$sourcecopyrightfile") ) { |
if ( open (my $fh,'<',$sourcecopyrightfile) ) { |
while (my $line = <$fh>) { |
while (my $line = <$fh>) { |
next if ($line =~ /^\#/); |
next if ($line =~ /^\#/); |
chomp($line); |
chomp($line); |
Line 251 BEGIN {
|
Line 253 BEGIN {
|
# -------------------------------------------------------------- default domain designs |
# -------------------------------------------------------------- default domain designs |
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
my $designfile = $designdir.'/default.tab'; |
my $designfile = $designdir.'/default.tab'; |
if ( open (my $fh,"<$designfile") ) { |
if ( open (my $fh,'<',$designfile) ) { |
while (my $line = <$fh>) { |
while (my $line = <$fh>) { |
next if ($line =~ /^\#/); |
next if ($line =~ /^\#/); |
chomp($line); |
chomp($line); |
Line 265 BEGIN {
|
Line 267 BEGIN {
|
{ |
{ |
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
'/filecategories.tab'; |
'/filecategories.tab'; |
if ( open (my $fh,"<$categoryfile") ) { |
if ( open (my $fh,'<',$categoryfile) ) { |
while (my $line = <$fh>) { |
while (my $line = <$fh>) { |
next if ($line =~ /^\#/); |
next if ($line =~ /^\#/); |
chomp($line); |
chomp($line); |
Line 280 BEGIN {
|
Line 282 BEGIN {
|
{ |
{ |
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. |
'/filetypes.tab'; |
'/filetypes.tab'; |
if ( open (my $fh,"<$typesfile") ) { |
if ( open (my $fh,'<',$typesfile) ) { |
while (my $line = <$fh>) { |
while (my $line = <$fh>) { |
next if ($line =~ /^\#/); |
next if ($line =~ /^\#/); |
chomp($line); |
chomp($line); |
Line 433 sub studentbrowser_javascript {
|
Line 435 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 448 sub studentbrowser_javascript {
|
Line 450 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 480 ENDRESBRW
|
Line 487 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 491 sub selectstudent_link {
|
Line 498 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 1295 sub help_open_topic {
|
Line 1306 sub help_open_topic {
|
} |
} |
|
|
# Add the text |
# Add the text |
|
my $target = ' target="_top"'; |
|
if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) { |
|
$target = ''; |
|
} |
if ($text ne "") { |
if ($text ne "") { |
$template.='<span class="LC_help_open_topic">' |
$template.='<span class="LC_help_open_topic">' |
.'<a target="_top" href="'.$link.'">' |
.'<a'.$target.' href="'.$link.'">' |
.$text.'</a>'; |
.$text.'</a>'; |
} |
} |
|
|
Line 1307 sub help_open_topic {
|
Line 1322 sub help_open_topic {
|
if ($imgid ne '') { |
if ($imgid ne '') { |
$imgid = ' id="'.$imgid.'"'; |
$imgid = ' id="'.$imgid.'"'; |
} |
} |
$template.=' <a target="_top" href="'.$link.'" title="'.$title.'">' |
$template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">' |
.'<img src="'.$helpicon.'" border="0"' |
.'<img src="'.$helpicon.'" border="0"' |
.' alt="'.&mt('Help: [_1]',$topic).'"' |
.' alt="'.&mt('Help: [_1]',$topic).'"' |
.' title="'.$title.'" style="vertical-align:middle;"'.$imgid |
.' title="'.$title.'" style="vertical-align:middle;"'.$imgid |
Line 1500 sub help_open_bug {
|
Line 1515 sub help_open_bug {
|
{ |
{ |
$link = $url; |
$link = $url; |
} |
} |
|
|
|
my $target = ' target="_top"'; |
|
if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) { |
|
$target = ''; |
|
} |
# Add the text |
# Add the text |
if ($text ne "") |
if ($text ne "") |
{ |
{ |
$template .= |
$template .= |
"<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>". |
"<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>". |
"<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>"; |
"<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>"; |
} |
} |
|
|
# Add the graphic |
# Add the graphic |
my $title = &mt('Report a Bug'); |
my $title = &mt('Report a Bug'); |
my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif"); |
my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif"); |
$template .= <<"ENDTEMPLATE"; |
$template .= <<"ENDTEMPLATE"; |
<a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a> |
<a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a> |
ENDTEMPLATE |
ENDTEMPLATE |
if ($text ne '') { $template.='</td></tr></table>' }; |
if ($text ne '') { $template.='</td></tr></table>' }; |
return $template; |
return $template; |
Line 2223 sub import_crsauthor_form {
|
Line 2243 sub import_crsauthor_form {
|
} |
} |
my @ordered = (); |
my @ordered = (); |
foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) { |
foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) { |
|
next if ($file =~ /\.rights$/); |
if ($only) { |
if ($only) { |
my ($ext) = ($file =~ /\.([^.]+)$/); |
my ($ext) = ($file =~ /\.([^.]+)$/); |
unless ($possexts{lc($ext)}) { |
unless ($possexts{lc($ext)}) { |
Line 2266 sub import_crsauthor_form {
|
Line 2287 sub import_crsauthor_form {
|
unless ($possexts{lc($ext)}) { |
unless ($possexts{lc($ext)}) { |
next; |
next; |
} |
} |
|
} else { |
|
next if ($file =~ /\.rights$/); |
} |
} |
push(@singledirfiles,$file); |
push(@singledirfiles,$file); |
} |
} |
if (@singledirfiles) { |
if (@singledirfiles) { |
$possdirs == 1; |
$possdirs = 1; |
} |
} |
} |
} |
if (($possdirs == 1) && (@singledirfiles)) { |
if (($possdirs == 1) && (@singledirfiles)) { |
Line 3025 This is not an optimal method, but it wo
|
Line 3048 This is not an optimal method, but it wo
|
|
|
=item * authform_filesystem |
=item * authform_filesystem |
|
|
|
=item * authform_lti |
|
|
=back |
=back |
|
|
See loncreateuser.pm for invocation and use examples. |
See loncreateuser.pm for invocation and use examples. |
Line 3441 sub authform_filesystem {
|
Line 3466 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.' />', |
return $result; |
'</label><input type="password" size="10" name="fsysarg" value="" '. |
} |
'onchange="'.$jscall.'"'.$disabled.' />'); |
|
|
sub authform_lti { |
|
my %in = ( |
|
formname => 'document.cu', |
|
kerb_def_dom => 'MSU.EDU', |
|
@_, |
|
); |
|
my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled); |
|
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'}); |
|
if ($in{'readonly'}) { |
|
$disabled = ' disabled="disabled"'; |
|
} |
|
if (defined($in{'curr_authtype'})) { |
|
if ($in{'curr_authtype'} eq 'lti') { |
|
if ($can_assign{'lti'}) { |
|
$lticheck = 'checked="checked" '; |
|
if (defined($in{'mode'})) { |
|
if ($in{'mode'} eq 'modifyuser') { |
|
$lticheck = ''; |
|
} |
|
} |
|
} else { |
|
$result = &mt('Currently LTI Authenticated.'); |
|
return $result; |
|
} |
|
} |
|
} else { |
|
if ($authnum == 1) { |
|
$authtype = '<input type="hidden" name="login" value="lti" />'; |
|
} |
|
} |
|
if (!$can_assign{'lti'}) { |
|
return; |
|
} elsif ($authtype eq '') { |
|
if (defined($in{'mode'})) { |
|
if ($in{'mode'} eq 'modifycourse') { |
|
if ($authnum == 1) { |
|
$authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />'; |
|
} |
|
} |
|
} |
|
} |
|
$jscall = "javascript:changed_radio('lti',$in{'formname'});"; |
|
if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') || ($in{'curr_authtype'} ne 'lti'))) { |
|
$authtype = '<input type="radio" name="login" value="lti" '. |
|
$lticheck.' onchange="'.$jscall.'" onclick="'. |
|
$jscall.'"'.$disabled.' />'; |
|
} |
|
$autharg = '<input type="hidden" name="ltiarg" value="" />'; |
|
if ($authtype) { |
|
$result = &mt('[_1] LTI Authenticated', |
|
'<label>'.$authtype.'</label>'.$autharg); |
|
} else { |
|
$result = '<b>'.&mt('LTI Authenticated').'</b>'. |
|
$autharg; |
|
} |
return $result; |
return $result; |
} |
} |
|
|
Line 3462 sub get_assignable_auth {
|
Line 3542 sub get_assignable_auth {
|
krb5 => 1, |
krb5 => 1, |
int => 1, |
int => 1, |
loc => 1, |
loc => 1, |
|
lti => 1, |
); |
); |
my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom); |
my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom); |
if (ref($domconfig{'usercreation'}) eq 'HASH') { |
if (ref($domconfig{'usercreation'}) eq 'HASH') { |
Line 3494 sub get_assignable_auth {
|
Line 3575 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; |
|
} |
|
|
############################################################### |
############################################################### |
## Get Kerberos Defaults for Domain ## |
## Get Kerberos Defaults for Domain ## |
############################################################### |
############################################################### |
Line 5362 sub check_ip_acc {
|
Line 5516 sub check_ip_acc {
|
if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { |
if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { |
return 1; |
return 1; |
} |
} |
my $allowed; |
my ($ip,$allowed); |
my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; |
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 { |
|
$ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip; |
|
} |
|
|
my $name; |
my $name; |
my %access = ( |
my %access = ( |
Line 5578 sub get_legacy_domconf {
|
Line 5737 sub get_legacy_domconf {
|
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; |
my $designfile = $designdir.'/'.$udom.'.tab'; |
my $designfile = $designdir.'/'.$udom.'.tab'; |
if (-e $designfile) { |
if (-e $designfile) { |
if ( open (my $fh,"<$designfile") ) { |
if ( open (my $fh,'<',$designfile) ) { |
while (my $line = <$fh>) { |
while (my $line = <$fh>) { |
next if ($line =~ /^\#/); |
next if ($line =~ /^\#/); |
chomp($line); |
chomp($line); |
Line 5777 sub CSTR_pageheader {
|
Line 5936 sub CSTR_pageheader {
|
$title = &mt('Authoring Space'); |
$title = &mt('Authoring Space'); |
} |
} |
|
|
|
my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent" |
|
if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) { |
|
$target = ''; |
|
$crumbtarget = ''; |
|
} |
|
|
my $output = |
my $output = |
'<div>' |
'<div>' |
.&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it? |
.&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it? |
.'<b>'.$title.'</b> ' |
.'<b>'.$title.'</b> ' |
.'<form name="dirs" method="post" action="'.$formaction |
.'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>' |
.'" target="_top">' #FIXME lonpubdir: target="_parent" |
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef); |
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef); |
|
|
|
if ($lastitem) { |
if ($lastitem) { |
$output .= |
$output .= |
Line 5797 sub CSTR_pageheader {
|
Line 5961 sub CSTR_pageheader {
|
} else { |
} else { |
$output .= |
$output .= |
'<br />' |
'<br />' |
#FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />" |
#FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />" |
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') |
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()') |
.'</form>' |
.'</form>' |
.&Apache::lonmenu::constspaceform(); |
.&Apache::lonmenu::constspaceform(); |
Line 5855 Inputs:
|
Line 6019 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 5866 other decorations will be returned.
|
Line 6043 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,$args,$advtoolsref)=@_; |
$no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_; |
|
|
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 5937 sub bodytag {
|
Line 6114 sub bodytag {
|
if ($public) { |
if ($public) { |
undef($role); |
undef($role); |
} |
} |
|
|
|
if (($env{'request.course.id'}) && ($env{'request.lti.login'})) { |
|
if (ref($ltimenu) eq 'HASH') { |
|
unless ($ltimenu->{'role'}) { |
|
undef($role); |
|
} |
|
unless ($ltimenu->{'coursetitle'}) { |
|
$realm=' '; |
|
} |
|
} |
|
} |
|
|
my $titleinfo = '<h1>'.$title.'</h1>'; |
my $titleinfo = '<h1>'.$title.'</h1>'; |
# |
# |
# Extra info if you are the DC |
# Extra info if you are the DC |
Line 5971 sub bodytag {
|
Line 6159 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($crstype); |
unless ($args->{'no_primary_menu'}) { |
|
my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu); |
|
|
if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { |
if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) { |
if ($dc_info) { |
if ($dc_info) { |
$dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|; |
$dc_info = qq|<span class="LC_cusr_subheading">$dc_info</span>|; |
} |
} |
$bodytag .= qq|<div id="LC_nav_bar">$left $role<br /> |
$bodytag .= qq|<div id="LC_nav_bar">$left $role<br /> |
<em>$realm</em> $dc_info</div>|; |
<em>$realm</em> $dc_info</div>|; |
return $bodytag; |
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 5999 sub bodytag {
|
Line 6189 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'}); |
|
} |
$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 { |
$bodytag .= |
$bodytag .= |
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
Line 7078 table.LC_prior_tries td {
|
Line 7271 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 8074 ul.LC_funclist li {
|
Line 8268 ul.LC_funclist li {
|
cursor:pointer; |
cursor:pointer; |
} |
} |
|
|
|
pre.LC_wordwrap { |
|
white-space: pre-wrap; |
|
white-space: -moz-pre-wrap; |
|
white-space: -pre-wrap; |
|
white-space: -o-pre-wrap; |
|
word-wrap: break-word; |
|
} |
|
|
/* |
/* |
styles used for response display |
styles used for response display |
*/ |
*/ |
Line 8324 ADDMETA
|
Line 8526 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; |
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)) { |
} |
my $numsec = 5; |
} |
my $timeout = $numsec * 1000; |
unless ($offload) { |
my ($newurl,$locknum,%locks,$msg); |
if (ref($domdefs{'offloadoth'}) eq 'HASH') { |
if ($env{'request.role.adv'}) { |
if ($domdefs{'offloadoth'}{$lonhost}) { |
($locknum,%locks) = &Apache::lonnet::get_locks(); |
if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && |
} |
(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { |
my $disable_submit = 0; |
unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { |
if ($requrl =~ /$LONCAPA::assess_re/) { |
$offload = 1; |
$disable_submit = 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(30000,undef,1,$dom_in_use); |
|
if (($newserver) && ($newserver ne $lonhost)) { |
|
my $numsec = 5; |
|
my $timeout = $numsec * 1000; |
|
my ($newurl,$locknum,%locks,$msg); |
|
if ($env{'request.role.adv'}) { |
|
($locknum,%locks) = &Apache::lonnet::get_locks(); |
|
} |
|
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 { |
|
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { |
|
$msg = &mt('Your LON-CAPA submission has been recorded')."\n"; |
|
} |
|
$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); |
|
$newurl = '/adm/switchserver?otherserver='.$newserver; |
|
if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { |
|
$newurl .= '&role='.$env{'request.role'}; |
|
} |
|
if ($env{'request.symb'}) { |
|
my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'}); |
|
if ($shownsymb =~ m{^/enc/}) { |
|
my $reqdmajor = 2; |
|
my $reqdminor = 11; |
|
my $reqdsubminor = 3; |
|
my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver); |
|
my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver); |
|
my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/); |
|
if (($major eq '' && $minor eq '') || |
|
(($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) || |
|
(($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') || |
|
($reqdsubminor > $subminor))))) { |
|
undef($shownsymb); |
|
} |
} |
} |
$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); |
if ($shownsymb) { |
$newurl = '/adm/switchserver?otherserver='.$newserver; |
&js_escape(\$shownsymb); |
if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { |
$newurl .= '&symb='.$shownsymb; |
$newurl .= '&role='.$env{'request.role'}; |
|
} |
|
if ($env{'request.symb'}) { |
|
$newurl .= '&symb='.$env{'request.symb'}; |
|
} else { |
|
$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 8381 function LC_Offload_Now() {
|
Line 8625 function LC_Offload_Now() {
|
// ]]> |
// ]]> |
</script> |
</script> |
OFFLOAD |
OFFLOAD |
} |
|
} |
} |
} |
} |
} |
} |
Line 8611 sub start_page {
|
Line 8854 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); |
|
|
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'}); |
|
} |
|
|
if (! exists($args->{'skip_phases'}{'body'}) ) { |
if (! exists($args->{'skip_phases'}{'body'}) ) { |
if ($args->{'frameset'}) { |
if ($args->{'frameset'}) { |
Line 8629 sub start_page {
|
Line 8903 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, |
$args->{'bgcolor'}, $args, |
\@advtools); |
\@advtools,$ltiscope,$ltiuri,\%ltimenu); |
} |
} |
} |
} |
|
|
Line 8665 sub start_page {
|
Line 8939 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') || |
((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) && |
((($args->{'crstype'} eq 'Placement') || (($env{'request.course.id'}) && |
($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) && |
($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) && |
(!$env{'request.role.adv'}))) { |
(!$env{'request.role.adv'}))) { |
Line 8798 sub modal_link {
|
Line 9073 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 |
} |
} |
|
|
Line 12070 sub modify_html_refs {
|
Line 12344 sub modify_html_refs {
|
return; |
return; |
} |
} |
} |
} |
if (open(my $fh,"<$container")) { |
if (open(my $fh,'<',$container)) { |
$content = join('', <$fh>); |
$content = join('', <$fh>); |
close($fh); |
close($fh); |
} else { |
} else { |
Line 12135 sub modify_html_refs {
|
Line 12409 sub modify_html_refs {
|
} |
} |
} |
} |
} else { |
} else { |
if (open(my $fh,">$container")) { |
if (open(my $fh,'>',$container)) { |
print $fh $content; |
print $fh $content; |
close($fh); |
close($fh); |
$output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].', |
$output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].', |
Line 13764 sub upfile_store {
|
Line 14038 sub upfile_store {
|
{ |
{ |
my $datafile = $r->dir_config('lonDaemons'). |
my $datafile = $r->dir_config('lonDaemons'). |
'/tmp/'.$datatoken.'.tmp'; |
'/tmp/'.$datatoken.'.tmp'; |
if ( open(my $fh,">$datafile") ) { |
if ( open(my $fh,'>',$datafile) ) { |
print $fh $env{'form.upfile'}; |
print $fh $env{'form.upfile'}; |
close($fh); |
close($fh); |
} |
} |
Line 13789 sub load_tmp_file {
|
Line 14063 sub load_tmp_file {
|
{ |
{ |
my $studentfile = $r->dir_config('lonDaemons'). |
my $studentfile = $r->dir_config('lonDaemons'). |
'/tmp/'.$datatoken.'.tmp'; |
'/tmp/'.$datatoken.'.tmp'; |
if ( open(my $fh,"<$studentfile") ) { |
if ( open(my $fh,'<',$studentfile) ) { |
@studentdata=<$fh>; |
@studentdata=<$fh>; |
close($fh); |
close($fh); |
} |
} |
Line 13799 sub load_tmp_file {
|
Line 14073 sub load_tmp_file {
|
|
|
sub valid_datatoken { |
sub valid_datatoken { |
my ($datatoken) = @_; |
my ($datatoken) = @_; |
if ($datatoken =~ /^$match_username\_$match_domain\_enroll_$match_domain\_$match_courseid\_\d+_\d+$/) { |
if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) { |
return $datatoken; |
return $datatoken; |
} |
} |
return; |
return; |
Line 15107 jsarray (reference to array of categorie
|
Line 15381 jsarray (reference to array of categorie
|
subcats (reference to hash of arrays containing all subcategories within each |
subcats (reference to hash of arrays containing all subcategories within each |
category, -recursive) |
category, -recursive) |
|
|
|
maxd (reference to hash used to hold max depth for all top-level categories). |
|
|
Returns: nothing |
Returns: nothing |
|
|
Side effects: populates trails and allitems hash references. |
Side effects: populates trails and allitems hash references. |
Line 15114 Side effects: populates trails and allit
|
Line 15390 Side effects: populates trails and allit
|
=cut |
=cut |
|
|
sub extract_categories { |
sub extract_categories { |
my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats) = @_; |
my ($categories,$cats,$trails,$allitems,$idx,$jsarray,$subcats,$maxd) = @_; |
if (ref($categories) eq 'HASH') { |
if (ref($categories) eq 'HASH') { |
&gather_categories($categories,$cats,$idx,$jsarray); |
&gather_categories($categories,$cats,$idx,$jsarray); |
if (ref($cats->[0]) eq 'ARRAY') { |
if (ref($cats->[0]) eq 'ARRAY') { |
Line 15142 sub extract_categories {
|
Line 15418 sub extract_categories {
|
if (ref($subcats) eq 'HASH') { |
if (ref($subcats) eq 'HASH') { |
push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1'); |
push(@{$subcats->{$item}},&escape($category).':'.&escape($name).':1'); |
} |
} |
&recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats); |
&recurse_categories($cats,2,$category,$trails,$allitems,\@parents,$subcats,$maxd); |
} |
} |
} else { |
} else { |
if (ref($subcats) eq 'HASH') { |
if (ref($subcats) eq 'HASH') { |
$subcats->{$item} = []; |
$subcats->{$item} = []; |
} |
} |
|
if (ref($maxd) eq 'HASH') { |
|
$maxd->{$name} = 1; |
|
} |
} |
} |
} |
} |
} |
} |
Line 15185 Side effects: populates trails and allit
|
Line 15464 Side effects: populates trails and allit
|
=cut |
=cut |
|
|
sub recurse_categories { |
sub recurse_categories { |
my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_; |
my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_; |
my $shallower = $depth - 1; |
my $shallower = $depth - 1; |
if (ref($cats->[$depth]{$category}) eq 'ARRAY') { |
if (ref($cats->[$depth]{$category}) eq 'ARRAY') { |
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 15212 sub recurse_categories {
|
Line 15491 sub recurse_categories {
|
} |
} |
} |
} |
&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents, |
&recurse_categories($cats,$deeper,$name,$trails,$allitems,$parents, |
$subcats); |
$subcats,$maxd); |
pop(@{$parents}); |
pop(@{$parents}); |
} |
} |
} else { |
} else { |
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; |
} |
} |
|
if (ref($maxd) eq 'HASH') { |
|
if ($depth > $maxd->{$parents->[0]}) { |
|
$maxd->{$parents->[0]} = $depth; |
|
} |
|
} |
} |
} |
return; |
return; |
} |
} |
Line 15253 sub assign_categories_table {
|
Line 15537 sub assign_categories_table {
|
my ($cathash,$currcat,$type,$disabled) = @_; |
my ($cathash,$currcat,$type,$disabled) = @_; |
my $output; |
my $output; |
if (ref($cathash) eq 'HASH') { |
if (ref($cathash) eq 'HASH') { |
my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth); |
my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth); |
&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray); |
&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd); |
$maxdepth = scalar(@cats); |
$maxdepth = scalar(@cats); |
if (@cats > 0) { |
if (@cats > 0) { |
my $itemcount = 0; |
my $itemcount = 0; |
Line 16042 sub construct_course {
|
Line 16326 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 16185 sub group_term {
|
Line 16474 sub group_term {
|
} |
} |
|
|
sub course_types { |
sub course_types { |
my @types = ('official','unofficial','community','textbook','placement'); |
my @types = ('official','unofficial','community','textbook','placement','lti'); |
my %typename = ( |
my %typename = ( |
official => 'Official course', |
official => 'Official course', |
unofficial => 'Unofficial course', |
unofficial => 'Unofficial course', |
community => 'Community', |
community => 'Community', |
textbook => 'Textbook course', |
textbook => 'Textbook course', |
placement => 'Placement test', |
placement => 'Placement test', |
|
lti => 'LTI provider', |
); |
); |
return (\@types,\%typename); |
return (\@types,\%typename); |
} |
} |
Line 16271 sub compare_arrays {
|
Line 16561 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 16305 sub init_user_environment {
|
Line 16613 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$/) { |
if ($ENV{'SERVER_PORT'} == 443) { |
if (tie(my %oldenv,'GDBM_File',"$lonids/$filename", |
|
&GDBM_READER(),0640)) { |
my $linkedfile; |
my $linkedfile; |
if (tie(my %oldenv,'GDBM_File',"$lonids/$cookie.id", |
if (exists($oldenv{'user.linkedenv'})) { |
&GDBM_READER(),0640)) { |
$linkedfile = $oldenv{'user.linkedenv'}; |
if (exists($oldenv{'user.linkedenv'})) { |
|
$linkedfile = $oldenv{'user.linkedenv'}; |
|
} |
|
untie(%oldenv); |
|
} |
} |
if (unlink($lonids.'/'.$filename)) { |
untie(%oldenv); |
if ($linkedfile =~ /^[a-f0-9]+_linked\.id$/) { |
if (unlink("$lonids/$filename")) { |
unlink($lonids.'/'.$linkedfile); |
if ($linkedfile =~ /^[a-f0-9]+_linked$/) { |
|
if (-l "$lonids/$linkedfile.id") { |
|
unlink("$lonids/$linkedfile.id"); |
|
} |
} |
} |
} |
} |
} else { |
} else { |
Line 16427 sub init_user_environment {
|
Line 16735 sub init_user_environment {
|
undef,\%userenv,\%domdef,\%is_adv); |
undef,\%userenv,\%domdef,\%is_adv); |
} |
} |
|
|
foreach my $crstype ('official','unofficial','community','textbook','placement') { |
foreach my $crstype ('official','unofficial','community','textbook','placement','lti') { |
$userenv{'canrequest.'.$crstype} = |
$userenv{'canrequest.'.$crstype} = |
&Apache::lonnet::usertools_access($username,$domain,$crstype, |
&Apache::lonnet::usertools_access($username,$domain,$crstype, |
'reload','requestcourses', |
'reload','requestcourses', |
Line 17317 sub needs_coursereinit {
|
Line 17625 sub needs_coursereinit {
|
} |
} |
|
|
sub update_content_constraints { |
sub update_content_constraints { |
my ($cdom,$cnum,$chome,$cid) = @_; |
my ($cdom,$cnum,$chome,$cid,$keeporder) = @_; |
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'}); |
my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'}); |
my %checkresponsetypes; |
my (%checkresponsetypes,%checkcrsrestypes); |
foreach my $key (keys(%Apache::lonnet::needsrelease)) { |
foreach my $key (keys(%Apache::lonnet::needsrelease)) { |
my ($item,$name,$value) = split(/:/,$key); |
my ($item,$name,$value) = split(/:/,$key); |
if ($item eq 'resourcetag') { |
if ($item eq 'resourcetag') { |
if ($name eq 'responsetype') { |
if ($name eq 'responsetype') { |
$checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key} |
$checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key} |
} |
} |
|
} elsif ($item eq 'course') { |
|
if ($name eq 'courserestype') { |
|
$checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key}; |
|
} |
} |
} |
} |
} |
my $navmap = Apache::lonnavmaps::navmap->new(); |
my $navmap = Apache::lonnavmaps::navmap->new(); |
if (defined($navmap)) { |
if (defined($navmap)) { |
my %allresponses; |
my (%allresponses,%allcrsrestypes); |
foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) { |
foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) { |
|
if ($res->is_tool()) { |
|
if ($allcrsrestypes{'exttool'}) { |
|
$allcrsrestypes{'exttool'} ++; |
|
} else { |
|
$allcrsrestypes{'exttool'} = 1; |
|
} |
|
next; |
|
} |
my %responses = $res->responseTypes(); |
my %responses = $res->responseTypes(); |
foreach my $key (keys(%responses)) { |
foreach my $key (keys(%responses)) { |
next unless(exists($checkresponsetypes{$key})); |
next unless(exists($checkresponsetypes{$key})); |
Line 17345 sub update_content_constraints {
|
Line 17665 sub update_content_constraints {
|
($reqdmajor,$reqdminor) = ($major,$minor); |
($reqdmajor,$reqdminor) = ($major,$minor); |
} |
} |
} |
} |
|
foreach my $key (keys(%allcrsrestypes)) { |
|
my ($major,$minor) = split(/\./,$checkcrsrestypes{$key}); |
|
if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { |
|
($reqdmajor,$reqdminor) = ($major,$minor); |
|
} |
|
} |
undef($navmap); |
undef($navmap); |
} |
} |
|
my (@resources,@order,@resparms,@zombies); |
|
if ($keeporder) { |
|
use LONCAPA::map; |
|
@resources = @LONCAPA::map::resources; |
|
@order = @LONCAPA::map::order; |
|
@resparms = @LONCAPA::map::resparms; |
|
@zombies = @LONCAPA::map::zombies; |
|
} |
|
my $suppmap = 'supplemental.sequence'; |
|
my ($suppcount,$supptools,$errors) = (0,0,0); |
|
($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap, |
|
$suppcount,$supptools,$errors); |
|
if ($keeporder) { |
|
@LONCAPA::map::resources = @resources; |
|
@LONCAPA::map::order = @order; |
|
@LONCAPA::map::resparms = @resparms; |
|
@LONCAPA::map::zombies = @zombies; |
|
} |
|
if ($supptools) { |
|
my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'}); |
|
if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { |
|
($reqdmajor,$reqdminor) = ($major,$minor); |
|
} |
|
} |
unless (($reqdmajor eq '') && ($reqdminor eq '')) { |
unless (($reqdmajor eq '') && ($reqdminor eq '')) { |
&Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid); |
&Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid); |
} |
} |
Line 17367 sub allmaps_incourse {
|
Line 17717 sub allmaps_incourse {
|
if ($lastchange > $env{'request.course.tied'}) { |
if ($lastchange > $env{'request.course.tied'}) { |
my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); |
my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); |
unless ($ferr) { |
unless ($ferr) { |
&update_content_constraints($cdom,$cnum,$chome,$cid); |
&update_content_constraints($cdom,$cnum,$chome,$cid,1); |
} |
} |
} |
} |
my $navmap = Apache::lonnavmaps::navmap->new(); |
my $navmap = Apache::lonnavmaps::navmap->new(); |
Line 17403 sub parse_supplemental_title {
|
Line 17753 sub parse_supplemental_title {
|
} |
} |
|
|
sub recurse_supplemental { |
sub recurse_supplemental { |
my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_; |
my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_; |
if ($suppmap) { |
if ($suppmap) { |
my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); |
my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); |
if ($fatal) { |
if ($fatal) { |
Line 17414 sub recurse_supplemental {
|
Line 17764 sub recurse_supplemental {
|
my ($title,$src,$ext,$type,$status)=split(/\:/,$res); |
my ($title,$src,$ext,$type,$status)=split(/\:/,$res); |
if (($src ne '') && ($status eq 'res')) { |
if (($src ne '') && ($status eq 'res')) { |
if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { |
if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { |
($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors); |
($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1, |
|
$numfiles,$numexttools,$errors); |
} else { |
} else { |
|
if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { |
|
$numexttools ++; |
|
} |
$numfiles ++; |
$numfiles ++; |
} |
} |
} |
} |
Line 17423 sub recurse_supplemental {
|
Line 17777 sub recurse_supplemental {
|
} |
} |
} |
} |
} |
} |
return ($numfiles,$errors); |
return ($numfiles,$numexttools,$errors); |
} |
} |
|
|
sub symb_to_docspath { |
sub symb_to_docspath { |
Line 17497 sub symb_to_docspath {
|
Line 17851 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 17516 sub captcha_display {
|
Line 17870 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 17530 sub captcha_response {
|
Line 17884 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 17578 sub get_captcha_config {
|
Line 17932 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 17602 sub create_captcha {
|
Line 17977 sub create_captcha {
|
last; |
last; |
} |
} |
} |
} |
|
if ($output eq '') { |
|
&Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts."); |
|
} |
return $output; |
return $output; |
} |
} |
|
|
Line 17818 sub des_decrypt {
|
Line 18196 sub des_decrypt {
|
return $plaintext; |
return $plaintext; |
} |
} |
|
|
|
sub make_short_symbs { |
|
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); |
|
my %tocreate; |
|
if (keys(%resources)) { |
|
foreach my $item (sort {$a <=> $b} (@toshorten)) { |
|
my $symb = $resources{$item}; |
|
if ($symb) { |
|
$tocreate{$cnum.'&'.$symb} = 1; |
|
} |
|
} |
|
} |
|
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; |
|
my $lockhash = { |
|
"lock\0$now" => $env{'user.name'}. |
|
':'.$env{'user.domain'}, |
|
}; |
|
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; |
|
} |
|
} |
|
} |
|
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 $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5); |
|
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; |
|
} |
|
|
1; |
1; |
__END__; |
__END__; |
|
|