version 1.1075.2.127.2.5, 2018/05/02 19:12:31
|
version 1.1075.2.141.2.15, 2021/03/04 14:13:41
|
Line 71 use Apache::lonuserutils();
|
Line 71 use Apache::lonuserutils();
|
use Apache::lonuserstate(); |
use Apache::lonuserstate(); |
use Apache::courseclassifier(); |
use Apache::courseclassifier(); |
use LONCAPA qw(:DEFAULT :match); |
use LONCAPA qw(:DEFAULT :match); |
|
use HTTP::Request; |
use DateTime::TimeZone; |
use DateTime::TimeZone; |
use DateTime::Locale; |
use DateTime::Locale; |
use Encode(); |
use Encode(); |
Line 82 use Crypt::DES;
|
Line 83 use Crypt::DES;
|
use DynaLoader; # for Crypt::DES version |
use DynaLoader; # for Crypt::DES version |
use File::Copy(); |
use File::Copy(); |
use File::Path(); |
use File::Path(); |
|
use String::CRC32(); |
|
use Short::URL(); |
|
|
# ---------------------------------------------- Designs |
# ---------------------------------------------- Designs |
use vars qw(%defaultdesign); |
use vars qw(%defaultdesign); |
Line 427 sub studentbrowser_javascript {
|
Line 430 sub studentbrowser_javascript {
|
<script type="text/javascript" language="Javascript"> |
<script type="text/javascript" language="Javascript"> |
// <![CDATA[ |
// <![CDATA[ |
var stdeditbrowser; |
var stdeditbrowser; |
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) { |
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) { |
var url = '/adm/pickstudent?'; |
var url = '/adm/pickstudent?'; |
var filter; |
var filter; |
if (!ignorefilter) { |
if (!ignorefilter) { |
Line 442 sub studentbrowser_javascript {
|
Line 445 sub studentbrowser_javascript {
|
'&udomelement='+udom+ |
'&udomelement='+udom+ |
'&clicker='+clicker; |
'&clicker='+clicker; |
if (roleflag) { url+="&roles=1"; } |
if (roleflag) { url+="&roles=1"; } |
if (courseadvonly) { url+="&courseadvonly=1"; } |
if (courseadv == 'condition') { |
|
if (document.getElementById('courseadv')) { |
|
courseadv = document.getElementById('courseadv').value; |
|
} |
|
} |
|
if ((courseadv == 'only') || (courseadv == 'none')) { url+="&courseadv="+courseadv; } |
var title = 'Student_Browser'; |
var title = 'Student_Browser'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
var options = 'scrollbars=1,resizable=1,menubar=0'; |
options += ',width=700,height=600'; |
options += ',width=700,height=600'; |
Line 474 ENDRESBRW
|
Line 482 ENDRESBRW
|
} |
} |
|
|
sub selectstudent_link { |
sub selectstudent_link { |
my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_; |
my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_; |
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". |
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','". |
&Apache::lonhtmlcommon::entity_encode($unameele)."','". |
&Apache::lonhtmlcommon::entity_encode($unameele)."','". |
&Apache::lonhtmlcommon::entity_encode($udomele)."'"; |
&Apache::lonhtmlcommon::entity_encode($udomele)."'"; |
Line 485 sub selectstudent_link {
|
Line 493 sub selectstudent_link {
|
return ''; |
return ''; |
} |
} |
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; |
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'"; |
if ($courseadvonly) { |
if ($courseadv eq 'only') { |
$callargs .= ",'',1,1"; |
$callargs .= ",'',1,'$courseadv'"; |
|
} elsif ($courseadv eq 'none') { |
|
$callargs .= ",'','','$courseadv'"; |
|
} elsif ($courseadv eq 'condition') { |
|
$callargs .= ",'','','$courseadv'"; |
} |
} |
return '<span class="LC_nobreak">'. |
return '<span class="LC_nobreak">'. |
'<a href="javascript:openstdbrowser('.$callargs.');">'. |
'<a href="javascript:openstdbrowser('.$callargs.');">'. |
Line 1403 sub help_menu_js {
|
Line 1415 sub help_menu_js {
|
&Apache::loncommon::start_page('Help Menu', undef, |
&Apache::loncommon::start_page('Help Menu', undef, |
{'frameset' => 1, |
{'frameset' => 1, |
'js_ready' => 1, |
'js_ready' => 1, |
'use_absolute' => $httphost, |
'use_absolute' => $httphost, |
'add_entries' => { |
'add_entries' => { |
'border' => '0', |
'border' => '0', |
'rows' => "110,*",},}); |
'rows' => "110,*",},}); |
Line 2262 sub select_form {
|
Line 2274 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 3166 sub get_assignable_auth {
|
Line 3182 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 4336 sub get_student_view_with_retries {
|
Line 4425 sub get_student_view_with_retries {
|
} |
} |
} |
} |
|
|
|
sub css_links { |
|
my ($currsymb,$level) = @_; |
|
my ($links,@symbs,%cssrefs,%httpref); |
|
if ($level eq 'map') { |
|
my $navmap = Apache::lonnavmaps::navmap->new(); |
|
if (ref($navmap)) { |
|
my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb); |
|
my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0); |
|
foreach my $res (@resources) { |
|
if (ref($res) && $res->symb()) { |
|
push(@symbs,$res->symb()); |
|
} |
|
} |
|
} |
|
} else { |
|
@symbs = ($currsymb); |
|
} |
|
foreach my $symb (@symbs) { |
|
my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb); |
|
if ($css_href =~ /\S/) { |
|
unless ($css_href =~ m{https?://}) { |
|
my $url = (&Apache::lonnet::decode_symb($symb))[-1]; |
|
my $proburl = &Apache::lonnet::clutter($url); |
|
my ($probdir) = ($proburl =~ m{(.+)/[^/]+$}); |
|
unless ($css_href =~ m{^/}) { |
|
$css_href = &Apache::lonnet::hreflocation($probdir,$css_href); |
|
} |
|
if ($css_href =~ m{^/(res|uploaded)/}) { |
|
unless (($httpref{'httpref.'.$css_href}) || |
|
(&Apache::lonnet::is_on_map($css_href))) { |
|
my $thisurl = $proburl; |
|
if ($env{'httpref.'.$proburl}) { |
|
$thisurl = $env{'httpref.'.$proburl}; |
|
} |
|
$httpref{'httpref.'.$css_href} = $thisurl; |
|
} |
|
} |
|
} |
|
$cssrefs{$css_href} = 1; |
|
} |
|
} |
|
if (keys(%httpref)) { |
|
&Apache::lonnet::appenv(\%httpref); |
|
} |
|
if (keys(%cssrefs)) { |
|
foreach my $css_href (keys(%cssrefs)) { |
|
next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)}); |
|
$links .= '<link rel="stylesheet" type="text/css" href="'.$css_href.'" />'."\n"; |
|
} |
|
} |
|
return $links; |
|
} |
|
|
=pod |
=pod |
|
|
=item * &get_student_answers() |
=item * &get_student_answers() |
Line 4591 sub findallcourses {
|
Line 4733 sub findallcourses {
|
############################################### |
############################################### |
|
|
sub blockcheck { |
sub blockcheck { |
my ($setters,$activity,$uname,$udom,$url,$is_course) = @_; |
my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_; |
|
|
if (defined($udom) && defined($uname)) { |
if (defined($udom) && defined($uname)) { |
# If uname and udom are for a course, check for blocks in the course. |
# If uname and udom are for a course, check for blocks in the course. |
if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) { |
if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) { |
my ($startblock,$endblock,$triggerblock) = |
my ($startblock,$endblock,$triggerblock) = |
&get_blocks($setters,$activity,$udom,$uname,$url); |
&get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller); |
return ($startblock,$endblock,$triggerblock); |
return ($startblock,$endblock,$triggerblock); |
} |
} |
} else { |
} else { |
Line 4614 sub blockcheck {
|
Line 4756 sub blockcheck {
|
# boards, chat or groups, check for blocking in current course only. |
# boards, chat or groups, check for blocking in current course only. |
|
|
if (($activity eq 'boards' || $activity eq 'chat' || |
if (($activity eq 'boards' || $activity eq 'chat' || |
$activity eq 'groups' || $activity eq 'printout') && |
$activity eq 'groups' || $activity eq 'printout' || |
|
$activity eq 'search' || $activity eq 'reinit' || |
|
$activity eq 'alert') && |
($env{'request.course.id'})) { |
($env{'request.course.id'})) { |
foreach my $key (keys(%live_courses)) { |
foreach my $key (keys(%live_courses)) { |
if ($key ne $env{'request.course.id'}) { |
if ($key ne $env{'request.course.id'}) { |
Line 4720 sub blockcheck {
|
Line 4864 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) = |
&get_blocks($setters,$activity,$cdom,$cnum,$url); |
&get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller); |
if (($start != 0) && |
if (($start != 0) && |
(($startblock == 0) || ($startblock > $start))) { |
(($startblock == 0) || ($startblock > $start))) { |
$startblock = $start; |
$startblock = $start; |
Line 4744 sub blockcheck {
|
Line 4888 sub blockcheck {
|
} |
} |
|
|
sub get_blocks { |
sub get_blocks { |
my ($setters,$activity,$cdom,$cnum,$url) = @_; |
my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_; |
my $startblock = 0; |
my $startblock = 0; |
my $endblock = 0; |
my $endblock = 0; |
my $triggerblock = ''; |
my $triggerblock = ''; |
Line 4757 sub get_blocks {
|
Line 4901 sub get_blocks {
|
my $now = time; |
my $now = time; |
my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum); |
my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum); |
if ($activity eq 'docs') { |
if ($activity eq 'docs') { |
@blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks); |
my ($blocked,$nosymbcache,$noenccheck); |
|
if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) { |
|
$blocked = 1; |
|
$nosymbcache = 1; |
|
$noenccheck = 1; |
|
} |
|
@blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks); |
foreach my $block (@blockers) { |
foreach my $block (@blockers) { |
if ($block =~ /^firstaccess____(.+)$/) { |
if ($block =~ /^firstaccess____(.+)$/) { |
my $item = $1; |
my $item = $1; |
Line 4879 sub parse_block_record {
|
Line 5029 sub parse_block_record {
|
} |
} |
|
|
sub blocking_status { |
sub blocking_status { |
my ($activity,$uname,$udom,$url,$is_course) = @_; |
my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_; |
my %setters; |
my %setters; |
|
|
# check for active blocking |
# check for active blocking |
my ($startblock,$endblock,$triggerblock) = |
my ($startblock,$endblock,$triggerblock) = |
&blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course); |
&blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller); |
my $blocked = 0; |
my $blocked = 0; |
if ($startblock && $endblock) { |
if ($startblock && $endblock) { |
$blocked = 1; |
$blocked = 1; |
Line 4895 sub blocking_status {
|
Line 5045 sub blocking_status {
|
|
|
# build a link to a popup window containing the details |
# build a link to a popup window containing the details |
my $querystring = "?activity=$activity"; |
my $querystring = "?activity=$activity"; |
# $uname and $udom decide whose portfolio the user is trying to look at |
# $uname and $udom decide whose portfolio (or information page) the user is trying to look at |
if (($activity eq 'port') || ($activity eq 'passwd')) { |
if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) { |
$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); |
$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); |
$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/); |
$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/); |
} elsif ($activity eq 'docs') { |
} elsif ($activity eq 'docs') { |
$querystring .= '&url='.&HTML::Entities::encode($url,'&"'); |
my $showurl = &Apache::lonenc::check_encrypt($url); |
|
$querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>'); |
|
if ($symb) { |
|
my $showsymb = &Apache::lonenc::check_encrypt($symb); |
|
$querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>'); |
|
} |
} |
} |
|
|
my $output .= <<'END_MYBLOCK'; |
my $output .= <<'END_MYBLOCK'; |
Line 4925 END_MYBLOCK
|
Line 5080 END_MYBLOCK
|
$text = &mt('Printing Blocked'); |
$text = &mt('Printing Blocked'); |
} elsif ($activity eq 'passwd') { |
} elsif ($activity eq 'passwd') { |
$text = &mt('Password Changing Blocked'); |
$text = &mt('Password Changing Blocked'); |
|
} elsif ($activity eq 'grades') { |
|
$text = &mt('Gradebook Blocked'); |
|
} elsif ($activity eq 'search') { |
|
$text = &mt('Search Blocked'); |
|
} elsif ($activity eq 'alert') { |
|
$text = &mt('Checking Critical Messages Blocked'); |
|
} elsif ($activity eq 'reinit') { |
|
$text = &mt('Checking Course Update Blocked'); |
|
} elsif ($activity eq 'about') { |
|
$text = &mt('Access to User Information Pages Blocked'); |
} |
} |
$output .= <<"END_BLOCK"; |
$output .= <<"END_BLOCK"; |
<div class='$class'> |
<div class='$class'> |
Line 4948 sub check_ip_acc {
|
Line 5113 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=0; |
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'}))) { |
my $name; |
$ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip; |
foreach my $pattern (split(',',$acc)) { |
} else { |
$pattern =~ s/^\s*//; |
my $remote_ip = &Apache::lonnet::get_requestor_ip(); |
$pattern =~ s/\s*$//; |
$ip = $remote_ip || $env{'request.host'} || $clientip; |
if ($pattern =~ /\*$/) { |
|
#35.8.* |
|
$pattern=~s/\*//; |
|
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
|
} 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=1; } |
|
} |
|
} 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=1; } |
|
} elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { |
|
#127.0.0.1 |
|
if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } |
|
} 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=1; } |
|
} |
|
if ($allowed) { last; } |
|
} |
|
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 $name; |
my %access = ( |
my %access = ( |
Line 5013 sub check_slotip_acc {
|
Line 5132 sub check_slotip_acc {
|
foreach my $item (split(',',$acc)) { |
foreach my $item (split(',',$acc)) { |
$item =~ s/^\s*//; |
$item =~ s/^\s*//; |
$item =~ s/\s*$//; |
$item =~ s/\s*$//; |
my $pattern; |
|
if ($item =~ /^\!(.+)$/) { |
if ($item =~ /^\!(.+)$/) { |
push(@denies,$1); |
push(@denies,$1); |
} else { |
} else { |
push(@allows,$item); |
push(@allows,$item); |
} |
} |
} |
} |
my $numdenies = scalar(@denies); |
my $numdenies = scalar(@denies); |
my $numallows = scalar(@allows); |
my $numallows = scalar(@allows); |
my $count = 0; |
my $count = 0; |
foreach my $pattern (@denies,@allows) { |
foreach my $pattern (@denies,@allows) { |
$count ++; |
$count ++; |
my $acctype = 'allowfrom'; |
my $acctype = 'allowfrom'; |
if ($count <= $numdenies) { |
if ($count <= $numdenies) { |
Line 5471 Inputs:
|
Line 5589 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 5496 sub bodytag {
|
Line 5618 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 5584 sub bodytag {
|
Line 5707 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 5630 sub bodytag {
|
Line 5753 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 6154 td.LC_menubuttons_text {
|
Line 6279 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 6744 table.LC_prior_tries td {
|
Line 6874 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 6826 table.LC_data_table tr > td.LC_docs_entr
|
Line 6957 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 7734 ul.LC_funclist li {
|
Line 7866 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 7893 ADDMETA
|
Line 8033 ADDMETA
|
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; |
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; |
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { |
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { |
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use); |
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use); |
|
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
|
my ($offload,$offloadoth); |
if (ref($domdefs{'offloadnow'}) eq 'HASH') { |
if (ref($domdefs{'offloadnow'}) eq 'HASH') { |
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; |
|
if ($domdefs{'offloadnow'}{$lonhost}) { |
if ($domdefs{'offloadnow'}{$lonhost}) { |
my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); |
$offload = 1; |
if (($newserver) && ($newserver ne $lonhost)) { |
if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && |
my $numsec = 5; |
(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { |
my $timeout = $numsec * 1000; |
unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { |
my ($newurl,$locknum,%locks,$msg); |
$offloadoth = 1; |
if ($env{'request.role.adv'}) { |
$dom_in_use = $env{'user.domain'}; |
($locknum,%locks) = &Apache::lonnet::get_locks(); |
|
} |
} |
my $disable_submit = 0; |
} |
if ($requrl =~ /$LONCAPA::assess_re/) { |
} |
$disable_submit = 1; |
} |
|
unless ($offload) { |
|
if (ref($domdefs{'offloadoth'}) eq 'HASH') { |
|
if ($domdefs{'offloadoth'}{$lonhost}) { |
|
if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && |
|
(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { |
|
unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { |
|
$offload = 1; |
|
$offloadoth = 1; |
|
$dom_in_use = $env{'user.domain'}; |
|
} |
} |
} |
if ($locknum) { |
} |
my @lockinfo = sort(values(%locks)); |
} |
$msg = &mt('Once the following tasks are complete: ')."\\n". |
} |
join(", ",sort(values(%locks)))."\\n". |
if ($offload) { |
&mt('your session will be transferred to a different server, after you click "Roles".'); |
my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); |
|
if (($newserver eq '') && ($offloadoth)) { |
|
my @domains = &Apache::lonnet::current_machine_domains(); |
|
if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { |
|
($newserver) = &Apache::lonnet::choose_server($dom_in_use); |
|
} |
|
} |
|
if (($newserver) && ($newserver ne $lonhost)) { |
|
my $numsec = 5; |
|
my $timeout = $numsec * 1000; |
|
my ($newurl,$locknum,%locks,$msg); |
|
if ($env{'request.role.adv'}) { |
|
($locknum,%locks) = &Apache::lonnet::get_locks(); |
|
} |
|
my $disable_submit = 0; |
|
if ($requrl =~ /$LONCAPA::assess_re/) { |
|
$disable_submit = 1; |
|
} |
|
if ($locknum) { |
|
my @lockinfo = sort(values(%locks)); |
|
$msg = &mt('Once the following tasks are complete:')." \n". |
|
join(", ",sort(values(%locks)))."\n"; |
|
if (&show_course()) { |
|
$msg .= &mt('your session will be transferred to a different server, after you click "Courses".'); |
} else { |
} else { |
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { |
$msg .= &mt('your session will be transferred to a different server, after you click "Roles".'); |
$msg = &mt('Your LON-CAPA submission has been recorded')."\\n"; |
} |
} |
} else { |
$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); |
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { |
$newurl = '/adm/switchserver?otherserver='.$newserver; |
$msg = &mt('Your LON-CAPA submission has been recorded')."\n"; |
if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { |
} |
$newurl .= '&role='.$env{'request.role'}; |
$msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); |
|
$newurl = '/adm/switchserver?otherserver='.$newserver; |
|
if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { |
|
$newurl .= '&role='.$env{'request.role'}; |
|
} |
|
if ($env{'request.symb'}) { |
|
my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'}); |
|
if ($shownsymb =~ m{^/enc/}) { |
|
my $reqdmajor = 2; |
|
my $reqdminor = 11; |
|
my $reqdsubminor = 3; |
|
my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver); |
|
my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver); |
|
my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/); |
|
if (($major eq '' && $minor eq '') || |
|
(($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) || |
|
(($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') || |
|
($reqdsubminor > $subminor))))) { |
|
undef($shownsymb); |
|
} |
} |
} |
if ($env{'request.symb'}) { |
if ($shownsymb) { |
$newurl .= '&symb='.$env{'request.symb'}; |
&js_escape(\$shownsymb); |
} else { |
$newurl .= '&symb='.$shownsymb; |
$newurl .= '&origurl='.$requrl; |
|
} |
} |
|
} else { |
|
my $shownurl = &Apache::lonenc::check_encrypt($requrl); |
|
&js_escape(\$shownurl); |
|
$newurl .= '&origurl='.$shownurl; |
} |
} |
&js_escape(\$msg); |
} |
$result.=<<OFFLOAD |
&js_escape(\$msg); |
|
$result.=<<OFFLOAD |
<meta http-equiv="pragma" content="no-cache" /> |
<meta http-equiv="pragma" content="no-cache" /> |
<script type="text/javascript"> |
<script type="text/javascript"> |
// <![CDATA[ |
// <![CDATA[ |
Line 7950 function LC_Offload_Now() {
|
Line 8146 function LC_Offload_Now() {
|
// ]]> |
// ]]> |
</script> |
</script> |
OFFLOAD |
OFFLOAD |
} |
|
} |
} |
} |
} |
} |
} |
Line 8166 $args - additional optional args support
|
Line 8361 $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 8367 sub modal_link {
|
Line 8566 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 8471 sub end_togglebox {
|
Line 8669 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 8485 sub LCprogressbar_script {
|
Line 8684 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 8511 my $LCidcnt;
|
Line 8732 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 12186 sub process_decompression {
|
Line 12424 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 12775 sub process_extracted_files {
|
Line 13012 sub process_extracted_files {
|
$newseqid{$i} = $newidx; |
$newseqid{$i} = $newidx; |
unless ($errtext) { |
unless ($errtext) { |
$result .= '<li>'.&mt('Folder: [_1] added to course', |
$result .= '<li>'.&mt('Folder: [_1] added to course', |
&HTML::Entities::encode($docstitle,'<>&"')). |
&HTML::Entities::encode($docstitle,'<>&"')).. |
'</li>'."\n"; |
'</li>'."\n"; |
} |
} |
} |
} |
Line 12800 sub process_extracted_files {
|
Line 13037 sub process_extracted_files {
|
$fetch =~ s/^\Q$prefix$dir\E//; |
$fetch =~ s/^\Q$prefix$dir\E//; |
$prompttofetch{$fetch} = 1; |
$prompttofetch{$fetch} = 1; |
} |
} |
} |
} |
} |
} |
$LONCAPA::map::resources[$newidx]= |
$LONCAPA::map::resources[$newidx]= |
$docstitle.':'.$url.':false:normal:res'; |
$docstitle.':'.$url.':false:normal:res'; |
Line 12900 sub process_extracted_files {
|
Line 13137 sub process_extracted_files {
|
$result .= '<li>'.&mt('[_1] included as a dependency', |
$result .= '<li>'.&mt('[_1] included as a dependency', |
&HTML::Entities::encode($showpath,'<>&"')). |
&HTML::Entities::encode($showpath,'<>&"')). |
'</li>'."\n"; |
'</li>'."\n"; |
} |
unless ($ishome) { |
unless ($ishome) { |
my $fetch = "$fullpath/$title"; |
my $fetch = "$fullpath/$title"; |
$fetch =~ s/^\Q$prefix$dir\E//; |
$fetch =~ s/^\Q$prefix$dir\E//; |
$prompttofetch{$fetch} = 1; |
$prompttofetch{$fetch} = 1; |
} |
} |
} |
} |
} |
} |
} |
Line 13191 sub upfile_store {
|
Line 13428 sub upfile_store {
|
$env{'form.upfile'}=~s/\n+$//gs; |
$env{'form.upfile'}=~s/\n+$//gs; |
|
|
my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}. |
my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}. |
'_enroll_'.$env{'request.course.id'}.'_'. |
'_enroll_'.$env{'request.course.id'}.'_'. |
time.'_'.$$); |
time.'_'.$$); |
return if ($datatoken eq ''); |
return if ($datatoken eq ''); |
|
|
{ |
{ |
my $datafile = $r->dir_config('lonDaemons'). |
my $datafile = $r->dir_config('lonDaemons'). |
'/tmp/'.$datatoken.'.tmp'; |
'/tmp/'.$datatoken.'.tmp'; |
Line 13232 sub load_tmp_file {
|
Line 13470 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 14132 $requdom domain of requester (if mailing
|
Line 14370 $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 14274 sub build_recipient_list {
|
Line 14511 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 14460 jsarray (reference to array of categorie
|
Line 14696 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 14467 Side effects: populates trails and allit
|
Line 14705 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 14493 sub extract_categories {
|
Line 14731 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 14536 Side effects: populates trails and allit
|
Line 14777 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 14563 sub recurse_categories {
|
Line 14804 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 14604 sub assign_categories_table {
|
Line 14850 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 14927 sub check_clone {
|
Line 15173 sub check_clone {
|
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; |
my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; |
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); |
my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); |
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); |
my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); |
my $clonemsg; |
my $clonetitle; |
|
my @clonemsg; |
my $can_clone = 0; |
my $can_clone = 0; |
my $lctype = lc($args->{'crstype'}); |
my $lctype = lc($args->{'crstype'}); |
if ($lctype ne 'community') { |
if ($lctype ne 'community') { |
Line 14935 sub check_clone {
|
Line 15182 sub check_clone {
|
} |
} |
if ($clonehome eq 'no_host') { |
if ($clonehome eq 'no_host') { |
if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
push(@clonemsg,({ |
|
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.', |
|
args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}], |
|
})); |
} else { |
} else { |
$clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
push(@clonemsg,({ |
} |
mt => 'No new course created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.', |
|
args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], |
|
})); |
|
} |
} else { |
} else { |
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); |
|
$clonetitle = $clonedesc{'description'}; |
if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
if ($clonedesc{'type'} ne 'Community') { |
if ($clonedesc{'type'} ne 'Community') { |
$clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); |
push(@clonemsg,({ |
return ($can_clone, $clonemsg, $cloneid, $clonehome); |
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.', |
|
args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], |
|
})); |
|
return ($can_clone,\@clonemsg,$cloneid,$clonehome); |
} |
} |
} |
} |
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && |
Line 15033 sub check_clone {
|
Line 15302 sub check_clone {
|
} |
} |
unless ($can_clone) { |
unless ($can_clone) { |
if ($args->{'crstype'} eq 'Community') { |
if ($args->{'crstype'} eq 'Community') { |
$clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); |
push(@clonemsg,({ |
|
mt => 'No new community created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).', |
|
args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], |
|
})); |
} else { |
} else { |
$clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); |
push(@clonemsg,({ |
} |
mt => 'No new course created.', |
|
args => [], |
|
}, |
|
{ |
|
mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).', |
|
args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], |
|
})); |
|
} |
} |
} |
} |
} |
} |
} |
return ($can_clone, $clonemsg, $cloneid, $clonehome); |
return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle); |
} |
} |
|
|
sub construct_course { |
sub construct_course { |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, |
$cnum,$category,$coderef) = @_; |
$cnum,$category,$coderef,$callercontext,$user_lh) = @_; |
my $outcome; |
my ($outcome,$msgref,$clonemsgref); |
my $linefeed = '<br />'."\n"; |
my $linefeed = '<br />'."\n"; |
if ($context eq 'auto') { |
if ($context eq 'auto') { |
$linefeed = "\n"; |
$linefeed = "\n"; |
Line 15055 sub construct_course {
|
Line 15338 sub construct_course {
|
# |
# |
# Are we cloning? |
# Are we cloning? |
# |
# |
my ($can_clone, $clonemsg, $cloneid, $clonehome); |
my ($can_clone,$cloneid,$clonehome,$clonetitle); |
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { |
if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { |
($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed); |
($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed); |
if ($context ne 'auto') { |
|
if ($clonemsg ne '') { |
|
$clonemsg = '<span class="LC_error">'.$clonemsg.'</span>'; |
|
} |
|
} |
|
$outcome .= $clonemsg.$linefeed; |
|
|
|
if (!$can_clone) { |
if (!$can_clone) { |
return (0,$outcome); |
return (0,$outcome,$clonemsgref); |
} |
} |
} |
} |
|
|
Line 15084 sub construct_course {
|
Line 15360 sub construct_course {
|
$args->{'ccuname'}.':'. |
$args->{'ccuname'}.':'. |
$args->{'ccdomain'}, |
$args->{'ccdomain'}, |
$args->{'crstype'}, |
$args->{'crstype'}, |
$cnum,$context,$category); |
$cnum,$context,$category, |
|
$callercontext); |
|
|
# Note: The testing routines depend on this being output; see |
# Note: The testing routines depend on this being output; see |
# Utils::Course. This needs to at least be output as a comment |
# Utils::Course. This needs to at least be output as a comment |
# if anyone ever decides to not show this, and Utils::Course::new |
# if anyone ever decides to not show this, and Utils::Course::new |
# will need to be suitably modified. |
# will need to be suitably modified. |
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; |
if (($callercontext eq 'auto') && ($user_lh ne '')) { |
|
$outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; |
|
} else { |
|
$outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$crstype,$$courseid).$linefeed; |
|
} |
if ($$courseid =~ /^error:/) { |
if ($$courseid =~ /^error:/) { |
return (0,$outcome); |
return (0,$outcome,$clonemsgref); |
} |
} |
|
|
# |
# |
Line 15101 sub construct_course {
|
Line 15382 sub construct_course {
|
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); |
($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); |
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); |
my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); |
if ($crsuhome eq 'no_host') { |
if ($crsuhome eq 'no_host') { |
$outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed; |
if (($callercontext eq 'auto') && ($user_lh ne '')) { |
return (0,$outcome); |
$outcome .= &mt_user($user_lh, |
|
'Course creation failed, unrecognized course home server.'); |
|
} else { |
|
$outcome .= &mt('Course creation failed, unrecognized course home server.'); |
|
} |
|
$outcome .= $linefeed; |
|
return (0,$outcome,$clonemsgref); |
} |
} |
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed; |
$outcome .= &mt('Created on').': '.$crsuhome.$linefeed; |
|
|
# |
# |
# Do the cloning |
# Do the cloning |
# |
# |
|
my @clonemsg; |
if ($can_clone && $cloneid) { |
if ($can_clone && $cloneid) { |
$clonemsg = &mt('Cloning [_1] from [_2]',$crstype,$clonehome); |
push(@clonemsg, |
if ($context ne 'auto') { |
{ |
$clonemsg = '<span class="LC_success">'.$clonemsg.'</span>'; |
mt => 'Created [_1] by cloning from [_2]', |
} |
args => [$crstype,$clonetitle], |
$outcome .= $clonemsg.$linefeed; |
}); |
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); |
# Copy all files |
# Copy all files |
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); |
my @info = |
|
&Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'}, |
|
$args->{'dateshift'},$args->{'crscode'}, |
|
$args->{'ccuname'}.':'.$args->{'ccdomain'}, |
|
$args->{'tinyurls'}); |
|
if (@info) { |
|
push(@clonemsg,@info); |
|
} |
# Restore URL |
# Restore URL |
$cenv{'url'}=$oldcenv{'url'}; |
$cenv{'url'}=$oldcenv{'url'}; |
# Restore title |
# Restore title |
Line 15384 sub construct_course {
|
Line 15679 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 15419 sub construct_course {
|
Line 15719 sub construct_course {
|
$outcome .= ($fatal?$errtext:'write ok').$linefeed; |
$outcome .= ($fatal?$errtext:'write ok').$linefeed; |
} |
} |
|
|
return (1,$outcome); |
return (1,$outcome,\@clonemsg); |
} |
} |
|
|
sub make_unique_code { |
sub make_unique_code { |
Line 15588 sub compare_arrays {
|
Line 15888 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 15623 sub init_user_environment {
|
Line 15941 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 15658 sub init_user_environment {
|
Line 15992 sub init_user_environment {
|
|
|
my %userenv = &Apache::lonnet::dump('environment',$domain,$username); |
my %userenv = &Apache::lonnet::dump('environment',$domain,$username); |
my ($tmp) = keys(%userenv); |
my ($tmp) = keys(%userenv); |
if ($tmp =~ /^(con_lost|error|no_such_host)/i) { |
if ($tmp !~ /^(con_lost|error|no_such_host)/i) { |
|
} else { |
undef(%userenv); |
undef(%userenv); |
} |
} |
if (($userenv{'interface'}) && (!$form->{'interface'})) { |
if (($userenv{'interface'}) && (!$form->{'interface'})) { |
Line 15673 sub init_user_environment {
|
Line 16008 sub init_user_environment {
|
# --------------------------------------------------------- Write first profile |
# --------------------------------------------------------- Write first profile |
|
|
{ |
{ |
|
my $ip = &Apache::lonnet::get_requestor_ip(); |
my %initial_env = |
my %initial_env = |
("user.name" => $username, |
("user.name" => $username, |
"user.domain" => $domain, |
"user.domain" => $domain, |
Line 15691 sub init_user_environment {
|
Line 16027 sub init_user_environment {
|
"request.course.sec" => '', |
"request.course.sec" => '', |
"request.role" => 'cm', |
"request.role" => 'cm', |
"request.role.adv" => $env{'user.adv'}, |
"request.role.adv" => $env{'user.adv'}, |
"request.host" => $ENV{'REMOTE_ADDR'},); |
"request.host" => $ip,); |
|
|
if ($form->{'localpath'}) { |
if ($form->{'localpath'}) { |
$initial_env{"browser.localpath"} = $form->{'localpath'}; |
$initial_env{"browser.localpath"} = $form->{'localpath'}; |
Line 16551 sub needs_coursereinit {
|
Line 16887 sub needs_coursereinit {
|
$interval = 600; |
$interval = 600; |
} |
} |
if (($now-$env{'request.course.timechecked'})>$interval) { |
if (($now-$env{'request.course.timechecked'})>$interval) { |
my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); |
|
&Apache::lonnet::appenv({'request.course.timechecked'=>$now}); |
&Apache::lonnet::appenv({'request.course.timechecked'=>$now}); |
|
my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1); |
|
if ($blocked) { |
|
return (); |
|
} |
|
my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); |
if ($lastchange > $env{'request.course.tied'}) { |
if ($lastchange > $env{'request.course.tied'}) { |
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); |
if ($curr_reqd_hash{'internal.releaserequired'} ne '') { |
if ($curr_reqd_hash{'internal.releaserequired'} ne '') { |
Line 16755 sub symb_to_docspath {
|
Line 17095 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 16774 sub captcha_display {
|
Line 17114 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 16788 sub captcha_response {
|
Line 17128 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 16836 sub get_captcha_config {
|
Line 17176 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 16916 sub create_recaptcha {
|
Line 17277 sub create_recaptcha {
|
sub check_recaptcha { |
sub check_recaptcha { |
my ($privkey,$version) = @_; |
my ($privkey,$version) = @_; |
my $captcha_chk; |
my $captcha_chk; |
|
my $ip = &Apache::lonnet::get_requestor_ip(); |
if ($version >= 2) { |
if ($version >= 2) { |
my $ua = LWP::UserAgent->new; |
my $ua = LWP::UserAgent->new; |
$ua->timeout(10); |
$ua->timeout(10); |
my %info = ( |
my %info = ( |
secret => $privkey, |
secret => $privkey, |
response => $env{'form.g-recaptcha-response'}, |
response => $env{'form.g-recaptcha-response'}, |
remoteip => $ENV{'REMOTE_ADDR'}, |
remoteip => $ip, |
); |
); |
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); |
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); |
if ($response->is_success) { |
if ($response->is_success) { |
Line 16938 sub check_recaptcha {
|
Line 17300 sub check_recaptcha {
|
my $captcha_result = |
my $captcha_result = |
$captcha->check_answer( |
$captcha->check_answer( |
$privkey, |
$privkey, |
$ENV{'REMOTE_ADDR'}, |
$ip, |
$env{'form.recaptcha_challenge_field'}, |
$env{'form.recaptcha_challenge_field'}, |
$env{'form.recaptcha_response_field'}, |
$env{'form.recaptcha_response_field'}, |
); |
); |
Line 16987 sub cleanup_html {
|
Line 17349 sub cleanup_html {
|
|
|
# Checks for critical messages and returns a redirect url if one exists. |
# Checks for critical messages and returns a redirect url if one exists. |
# $interval indicates how often to check for messages. |
# $interval indicates how often to check for messages. |
|
# $context is the calling context -- roles, grades, contents, menu or flip. |
sub critical_redirect { |
sub critical_redirect { |
my ($interval) = @_; |
my ($interval,$context) = @_; |
if ((time-$env{'user.criticalcheck.time'})>$interval) { |
if ((time-$env{'user.criticalcheck.time'})>$interval) { |
|
if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) { |
|
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; |
|
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; |
|
my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1); |
|
if ($blocked) { |
|
my $checkrole = "cm./$cdom/$cnum"; |
|
if ($env{'request.course.sec'} ne '') { |
|
$checkrole .= "/$env{'request.course.sec'}"; |
|
} |
|
unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) && |
|
($env{'request.role'} !~ m{^st\./$cdom/$cnum})) { |
|
return; |
|
} |
|
} |
|
} |
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, |
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, |
$env{'user.name'}); |
$env{'user.name'}); |
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); |
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time}); |
Line 17055 sub des_decrypt {
|
Line 17433 sub des_decrypt {
|
return $plaintext; |
return $plaintext; |
} |
} |
|
|
|
sub get_requested_shorturls { |
|
my ($cdom,$cnum,$navmap) = @_; |
|
return unless (ref($navmap)); |
|
my ($numnew,$errors); |
|
my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny'); |
|
if (@toshorten) { |
|
my (%maps,%resources,%titles); |
|
&Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles, |
|
'shorturls',$cdom,$cnum); |
|
if (keys(%resources)) { |
|
my %tocreate; |
|
foreach my $item (sort {$a <=> $b} (@toshorten)) { |
|
my $symb = $resources{$item}; |
|
if ($symb) { |
|
$tocreate{$cnum.'&'.$symb} = 1; |
|
} |
|
} |
|
if (keys(%tocreate)) { |
|
($numnew,$errors) = &make_short_symbs($cdom,$cnum, |
|
\%tocreate); |
|
} |
|
} |
|
} |
|
return ($numnew,$errors); |
|
} |
|
|
|
sub make_short_symbs { |
|
my ($cdom,$cnum,$tocreateref,$lockuser) = @_; |
|
my ($numnew,@errors); |
|
if (ref($tocreateref) eq 'HASH') { |
|
my %tocreate = %{$tocreateref}; |
|
if (keys(%tocreate)) { |
|
my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum); |
|
my $su = Short::URL->new(no_vowels => 1); |
|
my $init = ''; |
|
my (%newunique,%addcourse,%courseonly,%failed); |
|
# get lock on tiny db |
|
my $now = time; |
|
if ($lockuser eq '') { |
|
$lockuser = $env{'user.name'}.':'.$env{'user.domain'}; |
|
} |
|
my $lockhash = { |
|
"lock\0$now" => $lockuser, |
|
}; |
|
my $tries = 0; |
|
my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); |
|
my ($code,$error); |
|
while (($gotlock ne 'ok') && ($tries<3)) { |
|
$tries ++; |
|
sleep 1; |
|
$gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); |
|
} |
|
if ($gotlock eq 'ok') { |
|
$init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique, |
|
\%addcourse,\%courseonly,\%failed); |
|
if (keys(%failed)) { |
|
my $numfailed = scalar(keys(%failed)); |
|
push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed)); |
|
} |
|
if (keys(%newunique)) { |
|
my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom); |
|
if ($putres eq 'ok') { |
|
$numnew = scalar(keys(%newunique)); |
|
my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum); |
|
unless ($newputres eq 'ok') { |
|
push(@errors,&mt('error: could not store course look-up of short URLs')); |
|
} |
|
} else { |
|
push(@errors,&mt('error: could not store unique six character URLs')); |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return ($numnew,\@errors); |
|
} |
|
|
|
sub shorten_symbs { |
|
my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_; |
|
return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') && |
|
(ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') && |
|
(ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH')); |
|
my (%possibles,%collisions); |
|
foreach my $key (keys(%{$tocreate})) { |
|
my $num = String::CRC32::crc32($key); |
|
my $tiny = $su->encode($num,$init); |
|
if ($tiny) { |
|
$possibles{$tiny} = $key; |
|
} |
|
} |
|
if (!$init) { |
|
$init = 1; |
|
} else { |
|
$init ++; |
|
} |
|
if (keys(%possibles)) { |
|
my @posstiny = keys(%possibles); |
|
my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); |
|
my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname); |
|
if (keys(%currtiny)) { |
|
foreach my $key (keys(%currtiny)) { |
|
next if ($currtiny{$key} eq ''); |
|
if ($currtiny{$key} eq $possibles{$key}) { |
|
my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key}); |
|
unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { |
|
$courseonly->{$tsymb} = $key; |
|
} |
|
} else { |
|
$collisions{$possibles{$key}} = 1; |
|
} |
|
delete($possibles{$key}); |
|
} |
|
} |
|
foreach my $key (keys(%possibles)) { |
|
$newunique->{$key} = $possibles{$key}; |
|
my ($tcnum,$tsymb) = split(/\&/,$possibles{$key}); |
|
unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { |
|
$addcourse->{$tsymb} = $key; |
|
} |
|
} |
|
} |
|
if (keys(%collisions)) { |
|
if ($init <5) { |
|
if (!$init) { |
|
$init = 1; |
|
} else { |
|
$init ++; |
|
} |
|
$init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions, |
|
$newunique,$addcourse,$courseonly,$failed); |
|
} else { |
|
foreach my $key (keys(%collisions)) { |
|
$failed->{$key} = 1; |
|
$failed->{$key} = 1; |
|
} |
|
} |
|
} |
|
return $init; |
|
} |
|
|
|
sub is_nonframeable { |
|
my ($url,$absolute,$hostname,$ip,$nocache) = @_; |
|
my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i); |
|
return if (($remprotocol eq '') || ($remhost eq '')); |
|
|
|
$remprotocol = lc($remprotocol); |
|
$remhost = lc($remhost); |
|
my $remport = 80; |
|
if ($remprotocol eq 'https') { |
|
$remport = 443; |
|
} |
|
my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport); |
|
if ($cached) { |
|
unless ($nocache) { |
|
if ($result) { |
|
return 1; |
|
} else { |
|
return 0; |
|
} |
|
} |
|
} |
|
my $uselink; |
|
my $request = new HTTP::Request('HEAD',$url); |
|
my $ua = LWP::UserAgent->new; |
|
$ua->timeout(5); |
|
my $response=$ua->request($request); |
|
if ($response->is_success()) { |
|
my $secpolicy = lc($response->header('content-security-policy')); |
|
my $xframeop = lc($response->header('x-frame-options')); |
|
$secpolicy =~ s/^\s+|\s+$//g; |
|
$xframeop =~ s/^\s+|\s+$//g; |
|
if (($secpolicy ne '') || ($xframeop ne '')) { |
|
my $remotehost = $remprotocol.'://'.$remhost; |
|
my ($origin,$protocol,$port); |
|
if ($ENV{'SERVER_PORT'} =~/^\d+$/) { |
|
$port = $ENV{'SERVER_PORT'}; |
|
} else { |
|
$port = 80; |
|
} |
|
if ($absolute eq '') { |
|
$protocol = 'http:'; |
|
if ($port == 443) { |
|
$protocol = 'https:'; |
|
} |
|
$origin = $protocol.'//'.lc($hostname); |
|
} else { |
|
$origin = lc($absolute); |
|
($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$}); |
|
} |
|
if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;|$)/)) { |
|
my $framepolicy = $1; |
|
$framepolicy =~ s/^\s+|\s+$//g; |
|
my @policies = split(/\s+/,$framepolicy); |
|
if (@policies) { |
|
if (grep(/^\Q'none'\E$/,@policies)) { |
|
$uselink = 1; |
|
} else { |
|
$uselink = 1; |
|
if ((grep(/^\Q*\E$/,@policies)) || (grep(/^\Q$protocol\E$/,@policies)) || |
|
(($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) || |
|
(($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) { |
|
undef($uselink); |
|
} |
|
if ($uselink) { |
|
if (grep(/^\Q'self'\E$/,@policies)) { |
|
if (($origin ne '') && ($remotehost eq $origin)) { |
|
undef($uselink); |
|
} |
|
} |
|
} |
|
if ($uselink) { |
|
my @possok; |
|
if ($ip ne '') { |
|
push(@possok,$ip); |
|
} |
|
my $hoststr = ''; |
|
foreach my $part (reverse(split(/\./,$hostname))) { |
|
if ($hoststr eq '') { |
|
$hoststr = $part; |
|
} else { |
|
$hoststr = "$part.$hoststr"; |
|
} |
|
if ($hoststr eq $hostname) { |
|
push(@possok,$hostname); |
|
} else { |
|
push(@possok,"*.$hoststr"); |
|
} |
|
} |
|
if (@possok) { |
|
foreach my $poss (@possok) { |
|
last if (!$uselink); |
|
foreach my $policy (@policies) { |
|
if ($policy =~ m{^(\Q$protocol\E//|)\Q$poss\E(\Q:$port\E|)$}) { |
|
undef($uselink); |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} elsif ($xframeop ne '') { |
|
$uselink = 1; |
|
my @policies = split(/\s*,\s*/,$xframeop); |
|
if (@policies) { |
|
unless (grep(/^deny$/,@policies)) { |
|
if ($origin ne '') { |
|
if (grep(/^sameorigin$/,@policies)) { |
|
if ($remotehost eq $origin) { |
|
undef($uselink); |
|
} |
|
} |
|
if ($uselink) { |
|
foreach my $policy (@policies) { |
|
if ($policy =~ /^allow-from\s*(.+)$/) { |
|
my $allowfrom = $1; |
|
if (($allowfrom ne '') && ($allowfrom eq $origin)) { |
|
undef($uselink); |
|
last; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
if ($nocache) { |
|
if ($cached) { |
|
my $devalidate; |
|
if ($uselink && !$result) { |
|
$devalidate = 1; |
|
} elsif (!$uselink && $result) { |
|
$devalidate = 1; |
|
} |
|
if ($devalidate) { |
|
&Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport); |
|
} |
|
} |
|
} else { |
|
if ($uselink) { |
|
$result = 1; |
|
} else { |
|
$result = 0; |
|
} |
|
&Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600); |
|
} |
|
return $uselink; |
|
} |
|
|
1; |
1; |
__END__; |
__END__; |
|
|