|
version 1.1075.2.127.2.2, 2017/10/15 14:10:08
|
version 1.1075.2.143, 2020/02/12 17:22:55
|
|
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 80 use JSON::DWIW;
|
Line 81 use JSON::DWIW;
|
| use LWP::UserAgent; |
use LWP::UserAgent; |
| use Crypt::DES; |
use Crypt::DES; |
| use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
| |
use File::Copy(); |
| |
use File::Path(); |
| |
|
| # ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
| use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
|
Line 194 BEGIN {
|
Line 197 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 215 BEGIN {
|
Line 218 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 229 BEGIN {
|
Line 232 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 243 BEGIN {
|
Line 246 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 257 BEGIN {
|
Line 260 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 272 BEGIN {
|
Line 275 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 425 sub studentbrowser_javascript {
|
Line 428 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 440 sub studentbrowser_javascript {
|
Line 443 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 472 ENDRESBRW
|
Line 480 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 483 sub selectstudent_link {
|
Line 491 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 1401 sub help_menu_js {
|
Line 1413 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 2260 sub select_form {
|
Line 2272 sub select_form {
|
| if ($onchange) { |
if ($onchange) { |
| $onchange = ' onchange="'.$onchange.'"'; |
$onchange = ' onchange="'.$onchange.'"'; |
| } |
} |
| my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n"; |
my $disabled; |
| |
if ($readonly) { |
| |
$disabled = ' disabled="disabled"'; |
| |
} |
| |
my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n"; |
| my @keys; |
my @keys; |
| if (exists($hashref->{'select_form_order'})) { |
if (exists($hashref->{'select_form_order'})) { |
| @keys=@{$hashref->{'select_form_order'}}; |
@keys=@{$hashref->{'select_form_order'}}; |
|
Line 3164 sub get_assignable_auth {
|
Line 3180 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 4718 sub blockcheck {
|
Line 4807 sub blockcheck {
|
| ($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E})); |
($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E})); |
| next if ($no_userblock); |
next if ($no_userblock); |
| |
|
| # Retrieve blocking times and identity of locker for course |
# Retrieve blocking times and identity of blocker for course |
| # of specified user, unless user has 'evb' privilege. |
# of specified user, unless user has 'evb' privilege. |
| |
|
| my ($start,$end,$trigger) = |
my ($start,$end,$trigger) = |
|
Line 4992 sub check_ip_acc {
|
Line 5081 sub check_ip_acc {
|
| return $allowed; |
return $allowed; |
| } |
} |
| |
|
| sub check_slotip_acc { |
|
| my ($acc,$clientip)=@_; |
|
| &Apache::lonxml::debug("acc is $acc"); |
|
| if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { |
|
| return 1; |
|
| } |
|
| my $allowed; |
|
| my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; |
|
| |
|
| my $name; |
|
| my %access = ( |
|
| allowfrom => 1, |
|
| denyfrom => 0, |
|
| ); |
|
| my @allows; |
|
| my @denies; |
|
| foreach my $item (split(',',$acc)) { |
|
| $item =~ s/^\s*//; |
|
| $item =~ s/\s*$//; |
|
| my $pattern; |
|
| 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 =~ /\*$/) { |
|
| #35.8.* |
|
| $pattern=~s/\*//; |
|
| if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } |
|
| } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { |
|
| #35.8.3.[34-56] |
|
| my $low=$2; |
|
| my $high=$3; |
|
| $pattern=$1; |
|
| if ($ip =~ /^\Q$pattern\E/) { |
|
| my $last=(split(/\./,$ip))[3]; |
|
| if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } |
|
| } |
|
| } elsif ($pattern =~ /^\*/) { |
|
| #*.msu.edu |
|
| $pattern=~s/\*//; |
|
| if (!defined($name)) { |
|
| use Socket; |
|
| my $netaddr=inet_aton($ip); |
|
| ($name)=gethostbyaddr($netaddr,AF_INET); |
|
| } |
|
| if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } |
|
| } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { |
|
| #127.0.0.1 |
|
| if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } |
|
| } else { |
|
| #some.name.com |
|
| if (!defined($name)) { |
|
| use Socket; |
|
| my $netaddr=inet_aton($ip); |
|
| ($name)=gethostbyaddr($netaddr,AF_INET); |
|
| } |
|
| 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; |
|
| } |
|
| } |
|
| return $allowed; |
|
| } |
|
| |
|
| ############################################### |
############################################### |
| |
|
| =pod |
=pod |
|
Line 5213 sub get_legacy_domconf {
|
Line 5221 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 5469 Inputs:
|
Line 5477 Inputs:
|
| |
|
| =item * $args, optional argument valid values are |
=item * $args, optional argument valid values are |
| no_auto_mt_title -> prevents &mt()ing the title arg |
no_auto_mt_title -> prevents &mt()ing the title arg |
| |
use_absolute -> for external resource or syllabus, this will |
| |
contain https://<hostname> if server uses |
| |
https (as per hosts.tab), but request is for http |
| |
hostname -> hostname, from $r->hostname(). |
| |
|
| =item * $advtoolsref, optional argument, ref to an array containing |
=item * $advtoolsref, optional argument, ref to an array containing |
| inlineremote items to be added in "Functions" menu below |
inlineremote items to be added in "Functions" menu below |
|
Line 5494 sub bodytag {
|
Line 5506 sub bodytag {
|
| } |
} |
| if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } |
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); } |
| my $httphost = $args->{'use_absolute'}; |
my $httphost = $args->{'use_absolute'}; |
| |
my $hostname = $args->{'hostname'}; |
| |
|
| $function = &get_users_function() if (!$function); |
$function = &get_users_function() if (!$function); |
| my $img = &designparm($function.'.img',$domain); |
my $img = &designparm($function.'.img',$domain); |
|
Line 5582 sub bodytag {
|
Line 5595 sub bodytag {
|
| &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
| $forcereg,$args->{'group'}, |
$forcereg,$args->{'group'}, |
| $args->{'bread_crumbs'}, |
$args->{'bread_crumbs'}, |
| $advtoolsref,'',\$forbodytag); |
$advtoolsref,'','',\$forbodytag); |
| unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { |
unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { |
| $funclist = $forbodytag; |
$funclist = $forbodytag; |
| } |
} |
|
Line 5628 sub bodytag {
|
Line 5641 sub bodytag {
|
| $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'}); |
$args->{'bread_crumbs'},'','',$hostname); |
| } 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}); |
| } else { |
} else { |
| my $forbodytag; |
my $forbodytag; |
| &Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'}, |
| $forcereg,$args->{'group'}, |
$forcereg,$args->{'group'}, |
| $args->{'bread_crumbs'}, |
$args->{'bread_crumbs'}, |
| $advtoolsref,'',\$forbodytag); |
$advtoolsref,'',$hostname, |
| |
\$forbodytag); |
| unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { |
unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') { |
| $bodytag .= $forbodytag; |
$bodytag .= $forbodytag; |
| } |
} |
|
Line 6152 td.LC_menubuttons_text {
|
Line 6167 td.LC_menubuttons_text {
|
| background: $tabbg; |
background: $tabbg; |
| } |
} |
| |
|
| |
td.LC_zero_height { |
| |
line-height: 0; |
| |
cellpadding: 0; |
| |
} |
| |
|
| table.LC_data_table { |
table.LC_data_table { |
| border: 1px solid #000000; |
border: 1px solid #000000; |
| border-collapse: separate; |
border-collapse: separate; |
|
Line 6742 table.LC_prior_tries td {
|
Line 6762 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 6824 table.LC_data_table tr > td.LC_docs_entr
|
Line 6845 table.LC_data_table tr > td.LC_docs_entr
|
| color: #990000; |
color: #990000; |
| } |
} |
| |
|
| |
.LC_domprefs_email, |
| .LC_docs_reinit_warn, |
.LC_docs_reinit_warn, |
| .LC_docs_ext_edit { |
.LC_docs_ext_edit { |
| font-size: x-small; |
font-size: x-small; |
|
Line 7732 ul.LC_funclist li {
|
Line 7754 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 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 8164 $args - additional optional args support
|
Line 8194 $args - additional optional args support
|
| to lonhtmlcommon::breadcrumbs |
to lonhtmlcommon::breadcrumbs |
| group -> includes the current group, if page is for a |
group -> includes the current group, if page is for a |
| specific group |
specific group |
| |
use_absolute -> for request for external resource or syllabus, this |
| |
will contain https://<hostname> if server uses |
| |
https (as per hosts.tab), but request is for http |
| |
hostname -> hostname, originally from $r->hostname(), (optional). |
| |
|
| =back |
=back |
| |
|
|
Line 8365 sub modal_link {
|
Line 8399 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 8469 sub end_togglebox {
|
Line 8502 sub end_togglebox {
|
| } |
} |
| |
|
| sub LCprogressbar_script { |
sub LCprogressbar_script { |
| my ($id)=@_; |
my ($id,$number_to_do)=@_; |
| return(<<ENDPROGRESS); |
if ($number_to_do) { |
| |
return(<<ENDPROGRESS); |
| <script type="text/javascript"> |
<script type="text/javascript"> |
| // <![CDATA[ |
// <![CDATA[ |
| \$('#progressbar$id').progressbar({ |
\$('#progressbar$id').progressbar({ |
|
Line 8483 sub LCprogressbar_script {
|
Line 8517 sub LCprogressbar_script {
|
| // ]]> |
// ]]> |
| </script> |
</script> |
| ENDPROGRESS |
ENDPROGRESS |
| |
} else { |
| |
return(<<ENDPROGRESS); |
| |
<script type="text/javascript"> |
| |
// <![CDATA[ |
| |
\$('#progressbar$id').progressbar({ |
| |
value: false, |
| |
create: function(event, ui) { |
| |
\$('.ui-widget-header', this).css({'background':'#F0F0F0'}); |
| |
\$('.ui-progressbar-overlay', this).css({'margin':'0'}); |
| |
} |
| |
}); |
| |
// ]]> |
| |
</script> |
| |
ENDPROGRESS |
| |
} |
| } |
} |
| |
|
| sub LCprogressbarUpdate_script { |
sub LCprogressbarUpdate_script { |
| return(<<ENDPROGRESSUPDATE); |
return(<<ENDPROGRESSUPDATE); |
| <style type="text/css"> |
<style type="text/css"> |
| .ui-progressbar { position:relative; } |
.ui-progressbar { position:relative; } |
| |
.progress-label {position: absolute; width: 100%; text-align: center; top: 1px; font-weight: bold; text-shadow: 1px 1px 0 #fff;margin: 0; line-height: 200%; } |
| .pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; } |
.pblabel { position: absolute; width: 100%; text-align: center; line-height: 1.9em; } |
| </style> |
</style> |
| <script type="text/javascript"> |
<script type="text/javascript"> |
| // <![CDATA[ |
// <![CDATA[ |
| var LCprogressTxt='---'; |
var LCprogressTxt='---'; |
| |
|
| function LCupdateProgress(percent,progresstext,id) { |
function LCupdateProgress(percent,progresstext,id,maxnum) { |
| LCprogressTxt=progresstext; |
LCprogressTxt=progresstext; |
| \$('#progressbar'+id).progressbar('value',percent); |
if ((maxnum == '') || (maxnum == undefined) || (maxnum == null)) { |
| |
\$('#progressbar'+id).find('.progress-label').text(LCprogressTxt); |
| |
} else if (percent === \$('#progressbar'+id).progressbar( "value" )) { |
| |
\$('#progressbar'+id).find('.pblabel').text(LCprogressTxt); |
| |
} else { |
| |
\$('#progressbar'+id).progressbar('value',percent); |
| |
} |
| } |
} |
| // ]]> |
// ]]> |
| </script> |
</script> |
|
Line 8509 my $LCidcnt;
|
Line 8565 my $LCidcnt;
|
| my $LCcurrentid; |
my $LCcurrentid; |
| |
|
| sub LCprogressbar { |
sub LCprogressbar { |
| my ($r)=(@_); |
my ($r,$number_to_do,$preamble)=@_; |
| $LClastpercent=0; |
$LClastpercent=0; |
| $LCidcnt++; |
$LCidcnt++; |
| $LCcurrentid=$$.'_'.$LCidcnt; |
$LCcurrentid=$$.'_'.$LCidcnt; |
| my $starting=&mt('Starting'); |
my ($starting,$content); |
| my $content=(<<ENDPROGBAR); |
if ($number_to_do) { |
| |
$starting=&mt('Starting'); |
| |
$content=(<<ENDPROGBAR); |
| |
$preamble |
| <div id="progressbar$LCcurrentid"> |
<div id="progressbar$LCcurrentid"> |
| <span class="pblabel">$starting</span> |
<span class="pblabel">$starting</span> |
| </div> |
</div> |
| ENDPROGBAR |
ENDPROGBAR |
| &r_print($r,$content.&LCprogressbar_script($LCcurrentid)); |
} else { |
| |
$starting=&mt('Loading...'); |
| |
$LClastpercent='false'; |
| |
$content=(<<ENDPROGBAR); |
| |
$preamble |
| |
<div id="progressbar$LCcurrentid"> |
| |
<div class="progress-label">$starting</div> |
| |
</div> |
| |
ENDPROGBAR |
| |
} |
| |
&r_print($r,$content.&LCprogressbar_script($LCcurrentid,$number_to_do)); |
| } |
} |
| |
|
| sub LCprogressbarUpdate { |
sub LCprogressbarUpdate { |
| my ($r,$val,$text)=@_; |
my ($r,$val,$text,$number_to_do)=@_; |
| unless ($val) { |
if ($number_to_do) { |
| if ($LClastpercent) { |
unless ($val) { |
| $val=$LClastpercent; |
if ($LClastpercent) { |
| } else { |
$val=$LClastpercent; |
| $val=0; |
} else { |
| } |
$val=0; |
| |
} |
| |
} |
| |
if ($val<0) { $val=0; } |
| |
if ($val>100) { $val=0; } |
| |
$LClastpercent=$val; |
| |
unless ($text) { $text=$val.'%'; } |
| |
} else { |
| |
$val = 'false'; |
| } |
} |
| if ($val<0) { $val=0; } |
|
| if ($val>100) { $val=0; } |
|
| $LClastpercent=$val; |
|
| unless ($text) { $text=$val.'%'; } |
|
| $text=&js_ready($text); |
$text=&js_ready($text); |
| &r_print($r,<<ENDUPDATE); |
&r_print($r,<<ENDUPDATE); |
| <script type="text/javascript"> |
<script type="text/javascript"> |
| // <![CDATA[ |
// <![CDATA[ |
| LCupdateProgress($val,'$text','$LCcurrentid'); |
LCupdateProgress($val,'$text','$LCcurrentid','$number_to_do'); |
| // ]]> |
// ]]> |
| </script> |
</script> |
| ENDUPDATE |
ENDUPDATE |
|
Line 11501 sub modify_html_refs {
|
Line 11574 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 11566 sub modify_html_refs {
|
Line 11639 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 12083 sub decompress_uploaded_file {
|
Line 12156 sub decompress_uploaded_file {
|
| |
|
| sub process_decompression { |
sub process_decompression { |
| my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; |
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_; |
| |
unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) { |
| |
return '<p class="LC_error">'.&mt('Not extracted.').'<br />'. |
| |
&mt('Unexpected file path.').'</p>'."\n"; |
| |
} |
| |
unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) { |
| |
return '<p class="LC_error">'.&mt('Not extracted.').'<br />'. |
| |
&mt('Unexpected course context.').'</p>'."\n"; |
| |
} |
| |
unless ($file eq &Apache::lonnet::clean_filename($file)) { |
| |
return '<p class="LC_error">'.&mt('Not extracted.').'<br />'. |
| |
&mt('Filename contained unexpected characters.').'</p>'."\n"; |
| |
} |
| my ($dir,$error,$warning,$output); |
my ($dir,$error,$warning,$output); |
| if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { |
if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) { |
| $error = &mt('Filename not a supported archive file type.'). |
$error = &mt('Filename not a supported archive file type.'). |
|
Line 12117 sub process_decompression {
|
Line 12202 sub process_decompression {
|
| } |
} |
| } |
} |
| my $numskip = scalar(@to_skip); |
my $numskip = scalar(@to_skip); |
| if (($numskip > 0) && |
my $numoverwrite = scalar(@to_overwrite); |
| ($numskip == $env{'form.archive_itemcount'})) { |
if (($numskip) && (!$numoverwrite)) { |
| $warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); |
$warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.'); |
| } elsif ($dir eq '') { |
} elsif ($dir eq '') { |
| $error = &mt('Directory containing archive file unavailable.'); |
$error = &mt('Directory containing archive file unavailable.'); |
| } elsif (!$error) { |
} elsif (!$error) { |
| my ($decompressed,$display); |
my ($decompressed,$display); |
| if ($numskip > 0) { |
if (($numskip) || ($numoverwrite)) { |
| my $tempdir = time.'_'.$$.int(rand(10000)); |
my $tempdir = time.'_'.$$.int(rand(10000)); |
| mkdir("$dir/$tempdir",0755); |
mkdir("$dir/$tempdir",0755); |
| system("mv $dir/$file $dir/$tempdir/$file"); |
if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) { |
| ($decompressed,$display) = |
($decompressed,$display) = |
| &decompress_uploaded_file($file,"$dir/$tempdir"); |
&decompress_uploaded_file($file,"$dir/$tempdir"); |
| foreach my $item (@to_skip) { |
foreach my $item (@to_skip) { |
| if (($item ne '') && ($item !~ /\.\./)) { |
if (($item ne '') && ($item !~ /\.\./)) { |
| if (-f "$dir/$tempdir/$item") { |
if (-f "$dir/$tempdir/$item") { |
| unlink("$dir/$tempdir/$item"); |
unlink("$dir/$tempdir/$item"); |
| } elsif (-d "$dir/$tempdir/$item") { |
} elsif (-d "$dir/$tempdir/$item") { |
| system("rm -rf $dir/$tempdir/$item"); |
&File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 }); |
| |
} |
| } |
} |
| } |
} |
| |
foreach my $item (@to_overwrite) { |
| |
if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) { |
| |
if (($item ne '') && ($item !~ /\.\./)) { |
| |
if (-f "$dir/$item") { |
| |
unlink("$dir/$item"); |
| |
} elsif (-d "$dir/$item") { |
| |
&File::Path::remove_tree("$dir/$item",{ safe => 1 }); |
| |
} |
| |
&File::Copy::move("$dir/$tempdir/$item","$dir/$item"); |
| |
} |
| |
} |
| |
} |
| |
if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) { |
| |
&File::Path::remove_tree("$dir/$tempdir",{ safe => 1 }); |
| |
} |
| } |
} |
| system("mv $dir/$tempdir/* $dir"); |
|
| rmdir("$dir/$tempdir"); |
|
| } else { |
} else { |
| ($decompressed,$display) = |
($decompressed,$display) = |
| &decompress_uploaded_file($file,$dir); |
&decompress_uploaded_file($file,$dir); |
|
Line 12158 sub process_decompression {
|
Line 12257 sub process_decompression {
|
| if (ref($newdirlistref) eq 'ARRAY') { |
if (ref($newdirlistref) eq 'ARRAY') { |
| foreach my $dir_line (@{$newdirlistref}) { |
foreach my $dir_line (@{$newdirlistref}) { |
| my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); |
my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5); |
| unless (($item =~ /^\.+$/) || ($item eq $file) || |
unless (($item =~ /^\.+$/) || ($item eq $file)) { |
| ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) { |
|
| push(@newitems,$item); |
push(@newitems,$item); |
| if ($dirptr&$testdir) { |
if ($dirptr&$testdir) { |
| $is_dir{$item} = 1; |
$is_dir{$item} = 1; |
|
Line 12644 END
|
Line 12742 END
|
| sub process_extracted_files { |
sub process_extracted_files { |
| my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; |
my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_; |
| my $numitems = $env{'form.archive_count'}; |
my $numitems = $env{'form.archive_count'}; |
| return unless ($numitems); |
return if ((!$numitems) || ($numitems =~ /\D/)); |
| my @ids=&Apache::lonnet::current_machine_ids(); |
my @ids=&Apache::lonnet::current_machine_ids(); |
| my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, |
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir, |
| %folders,%containers,%mapinner,%prompttofetch); |
%folders,%containers,%mapinner,%prompttofetch); |
|
Line 12657 sub process_extracted_files {
|
Line 12755 sub process_extracted_files {
|
| } else { |
} else { |
| $prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; |
$prefix = $Apache::lonnet::perlvar{'lonDocRoot'}; |
| $pathtocheck = "$dir_root/$docudom/$docuname/$destination"; |
$pathtocheck = "$dir_root/$docudom/$docuname/$destination"; |
| $dir = "$dir_root/$docudom/$docuname"; |
$dir = "$dir_root/$docudom/$docuname"; |
| } |
} |
| my $currdir = "$dir_root/$destination"; |
my $currdir = "$dir_root/$destination"; |
| (my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); |
(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/}); |
|
Line 12746 sub process_extracted_files {
|
Line 12844 sub process_extracted_files {
|
| '.'.$containers{$outer},1,1); |
'.'.$containers{$outer},1,1); |
| $newseqid{$i} = $newidx; |
$newseqid{$i} = $newidx; |
| unless ($errtext) { |
unless ($errtext) { |
| $result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n"; |
$result .= '<li>'.&mt('Folder: [_1] added to course', |
| |
&HTML::Entities::encode($docstitle,'<>&"')).. |
| |
'</li>'."\n"; |
| } |
} |
| } |
} |
| } else { |
} else { |
|
Line 12755 sub process_extracted_files {
|
Line 12855 sub process_extracted_files {
|
| my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. |
my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'. |
| $docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. |
$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'. |
| $title; |
$title; |
| if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { |
if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) { |
| mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); |
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") { |
| } |
mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755); |
| if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { |
|
| mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); |
|
| } |
|
| if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { |
|
| system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title"); |
|
| $newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; |
|
| unless ($ishome) { |
|
| my $fetch = "$newdest{$i}/$title"; |
|
| $fetch =~ s/^\Q$prefix$dir\E//; |
|
| $prompttofetch{$fetch} = 1; |
|
| } |
} |
| } |
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { |
| $LONCAPA::map::resources[$newidx]= |
mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx"); |
| $docstitle.':'.$url.':false:normal:res'; |
|
| push(@LONCAPA::map::order, $newidx); |
|
| my ($outtext,$errtext)= |
|
| &LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. |
|
| $docuname.'/'.$folders{$outer}. |
|
| '.'.$containers{$outer},1,1); |
|
| unless ($errtext) { |
|
| if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { |
|
| $result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n"; |
|
| } |
} |
| |
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") { |
| |
if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) { |
| |
$newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx"; |
| |
unless ($ishome) { |
| |
my $fetch = "$newdest{$i}/$title"; |
| |
$fetch =~ s/^\Q$prefix$dir\E//; |
| |
$prompttofetch{$fetch} = 1; |
| |
} |
| |
} |
| |
} |
| |
$LONCAPA::map::resources[$newidx]= |
| |
$docstitle.':'.$url.':false:normal:res'; |
| |
push(@LONCAPA::map::order, $newidx); |
| |
my ($outtext,$errtext)= |
| |
&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'. |
| |
$docuname.'/'.$folders{$outer}. |
| |
'.'.$containers{$outer},1,1); |
| |
unless ($errtext) { |
| |
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") { |
| |
$result .= '<li>'.&mt('File: [_1] added to course', |
| |
&HTML::Entities::encode($docstitle,'<>&"')). |
| |
'</li>'."\n"; |
| |
} |
| |
} |
| |
} else { |
| |
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.', |
| |
&HTML::Entities::encode($path,'<>&"')).'<br />'; |
| } |
} |
| } |
} |
| } |
} |
| } |
} |
| } else { |
} else { |
| $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; |
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.', |
| |
&HTML::Entities::encode($path,'<>&"')).'<br />'; |
| } |
} |
| } |
} |
| for (my $i=1; $i<=$numitems; $i++) { |
for (my $i=1; $i<=$numitems; $i++) { |
|
Line 12847 sub process_extracted_files {
|
Line 12956 sub process_extracted_files {
|
| } |
} |
| if ($fullpath ne '') { |
if ($fullpath ne '') { |
| if (-e "$prefix$path") { |
if (-e "$prefix$path") { |
| system("mv $prefix$path $fullpath/$title"); |
unless (rename("$prefix$path","$fullpath/$title")) { |
| |
$warning .= &mt('Failed to rename dependency').'<br />'; |
| |
} |
| } |
} |
| if (-e "$fullpath/$title") { |
if (-e "$fullpath/$title") { |
| my $showpath; |
my $showpath; |
|
Line 12856 sub process_extracted_files {
|
Line 12967 sub process_extracted_files {
|
| } else { |
} else { |
| $showpath = "/$title"; |
$showpath = "/$title"; |
| } |
} |
| $result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n"; |
$result .= '<li>'.&mt('[_1] included as a dependency', |
| } |
&HTML::Entities::encode($showpath,'<>&"')). |
| unless ($ishome) { |
'</li>'."\n"; |
| my $fetch = "$fullpath/$title"; |
unless ($ishome) { |
| $fetch =~ s/^\Q$prefix$dir\E//; |
my $fetch = "$fullpath/$title"; |
| $prompttofetch{$fetch} = 1; |
$fetch =~ s/^\Q$prefix$dir\E//; |
| |
$prompttofetch{$fetch} = 1; |
| |
} |
| } |
} |
| } |
} |
| } |
} |
| } elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { |
} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') { |
| $warning .= &mt('[_1] is a dependency of [_2], which was discarded.', |
$warning .= &mt('[_1] is a dependency of [_2], which was discarded.', |
| $path,$env{'form.archive_content_'.$referrer{$i}}).'<br />'; |
&HTML::Entities::encode($path,'<>&"'), |
| |
&HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')). |
| |
'<br />'; |
| } |
} |
| } else { |
} else { |
| $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />'; |
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.', |
| |
&HTML::Entities::encode($path)).'<br />'; |
| } |
} |
| } |
} |
| if (keys(%todelete)) { |
if (keys(%todelete)) { |
|
Line 13144 sub upfile_store {
|
Line 13260 sub upfile_store {
|
| $env{'form.upfile'}=~s/\n+/\n/gs; |
$env{'form.upfile'}=~s/\n+/\n/gs; |
| $env{'form.upfile'}=~s/\n+$//gs; |
$env{'form.upfile'}=~s/\n+$//gs; |
| |
|
| my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}. |
my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}. |
| '_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$; |
'_enroll_'.$env{'request.course.id'}.'_'. |
| |
time.'_'.$$); |
| |
return if ($datatoken eq ''); |
| |
|
| { |
{ |
| 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 13159 sub upfile_store {
|
Line 13278 sub upfile_store {
|
| |
|
| =pod |
=pod |
| |
|
| =item * &load_tmp_file($r) |
=item * &load_tmp_file($r,$datatoken) |
| |
|
| Load uploaded file from tmp, $r should be the HTTP Request object, |
Load uploaded file from tmp, $r should be the HTTP Request object, |
| needs $env{'form.datatoken'}, |
$datatoken is the name to assign to the temporary file. |
| sets $env{'form.upfile'} to the contents of the file |
sets $env{'form.upfile'} to the contents of the file |
| |
|
| =cut |
=cut |
| |
|
| sub load_tmp_file { |
sub load_tmp_file { |
| my $r=shift; |
my ($r,$datatoken) = @_; |
| |
return if ($datatoken eq ''); |
| my @studentdata=(); |
my @studentdata=(); |
| { |
{ |
| my $studentfile = $r->dir_config('lonDaemons'). |
my $studentfile = $r->dir_config('lonDaemons'). |
| '/tmp/'.$env{'form.datatoken'}.'.tmp'; |
'/tmp/'.$datatoken.'.tmp'; |
| if ( open(my $fh,"<$studentfile") ) { |
if ( open(my $fh,'<',$studentfile) ) { |
| @studentdata=<$fh>; |
@studentdata=<$fh>; |
| close($fh); |
close($fh); |
| } |
} |
|
Line 13181 sub load_tmp_file {
|
Line 13301 sub load_tmp_file {
|
| $env{'form.upfile'}=join('',@studentdata); |
$env{'form.upfile'}=join('',@studentdata); |
| } |
} |
| |
|
| |
sub valid_datatoken { |
| |
my ($datatoken) = @_; |
| |
if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(|$match_domain\_$match_courseid)\_\d+_\d+$/) { |
| |
return $datatoken; |
| |
} |
| |
return; |
| |
} |
| |
|
| =pod |
=pod |
| |
|
| =item * &upfile_record_sep() |
=item * &upfile_record_sep() |
|
Line 14075 $requdom domain of requester (if mailing
|
Line 14203 $requdom domain of requester (if mailing
|
| |
|
| $reqemail e-mail address 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 14217 sub build_recipient_list {
|
Line 14344 sub build_recipient_list {
|
| } 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 14403 jsarray (reference to array of categorie
|
Line 14529 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 14410 Side effects: populates trails and allit
|
Line 14538 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 14436 sub extract_categories {
|
Line 14564 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 14479 Side effects: populates trails and allit
|
Line 14610 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++) { |
|
Line 14506 sub recurse_categories {
|
Line 14637 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 14547 sub assign_categories_table {
|
Line 14683 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 15566 sub init_user_environment {
|
Line 15702 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 16699 sub symb_to_docspath {
|
Line 16851 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 16718 sub captcha_display {
|
Line 16870 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 16732 sub captcha_response {
|
Line 16884 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 16780 sub get_captcha_config {
|
Line 16932 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 16999 sub des_decrypt {
|
Line 17172 sub des_decrypt {
|
| return $plaintext; |
return $plaintext; |
| } |
} |
| |
|
| |
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; |
| |
} |
| |
|
| 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