@@ -4691,7 +5225,14 @@ sub check_ip_acc {
return 1;
}
my $allowed=0;
- my $ip=$env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
+ my $ip;
+ if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
+ ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
+ $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
+ } else {
+ my $remote_ip = &Apache::lonnet::get_requestor_ip();
+ $ip = $remote_ip || $env{'request.host'} || $clientip;
+ }
my $name;
foreach my $pattern (split(',',$acc)) {
@@ -4812,6 +5353,17 @@ sub get_domainconf {
}
}
}
+ } elsif ($key eq 'saml') {
+ if (ref($domconfig{'login'}{$key}) eq 'HASH') {
+ foreach my $host (keys(%{$domconfig{'login'}{$key}})) {
+ if (ref($domconfig{'login'}{$key}{$host}) eq 'HASH') {
+ $designhash{$udom.'.login.'.$key.'_'.$host} = 1;
+ foreach my $item ('text','img','alt','url','title','notsso') {
+ $designhash{$udom.'.login.'.$key.'_'.$item.'_'.$host} = $domconfig{'login'}{$key}{$host}{$item};
+ }
+ }
+ }
+ }
} else {
foreach my $img (keys(%{$domconfig{'login'}{$key}})) {
$designhash{$udom.'.login.'.$key.'_'.$img} =
@@ -4876,7 +5428,7 @@ sub get_legacy_domconf {
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/'.$udom.'.tab';
if (-e $designfile) {
- if ( open (my $fh,"<$designfile") ) {
+ if ( open (my $fh,'<',$designfile) ) {
while (my $line = <$fh>) {
next if ($line =~ /^\#/);
chomp($line);
@@ -4916,8 +5468,12 @@ sub domainlogo {
&Apache::lonnet::repcopy($local_name);
}
$imgsrc = &lonhttpdurl($imgsrc);
- }
- return '
';
+ }
+ my $alttext = $domain;
+ if ($designhash{$domain.'.login.alttext_domlogo'} ne '') {
+ $alttext = $designhash{$domain.'.login.alttext_domlogo'};
+ }
+ return '
';
} elsif (defined(&Apache::lonnet::domain($domain,'description'))) {
return &Apache::lonnet::domain($domain,'description');
} else {
@@ -5132,6 +5688,10 @@ Inputs:
=item * $args, optional argument valid values are
no_auto_mt_title -> prevents &mt()ing the title arg
+ use_absolute -> for external resource or syllabus, this will
+ contain https://
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
inlineremote items to be added in "Functions" menu below
@@ -5157,6 +5717,7 @@ sub bodytag {
}
if (!$args->{'no_auto_mt_title'}) { $title = &mt($title); }
my $httphost = $args->{'use_absolute'};
+ my $hostname = $args->{'hostname'};
$function = &get_users_function() if (!$function);
my $img = &designparm($function.'.img',$domain);
@@ -5176,19 +5737,39 @@ sub bodytag {
if ($realm) {
$realm = '/'.$realm;
}
- if ($role eq 'ca') {
+ if ($role eq 'ca') {
my ($rdom,$rname) = ($realm =~ m{^/($match_domain)/($match_username)$});
$realm = &plainname($rname,$rdom);
}
# realm
+ my ($cid,$sec);
if ($env{'request.course.id'}) {
+ $cid = $env{'request.course.id'};
+ if ($env{'request.course.sec'}) {
+ $sec = $env{'request.course.sec'};
+ }
+ } elsif ($realm =~ m{^/($match_domain)/($match_courseid)(?:|/(\w+))$}) {
+ if (&Apache::lonnet::is_course($1,$2)) {
+ $cid = $1.'_'.$2;
+ $sec = $3;
+ }
+ }
+ if ($cid) {
if ($env{'request.role'} !~ /^cr/) {
$role = &Apache::lonnet::plaintext($role,&course_type());
+ } elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
+ if ($env{'request.role.desc'}) {
+ $role = $env{'request.role.desc'};
+ } else {
+ $role = &mt('Helpdesk[_1]',' '.$2);
+ }
+ } else {
+ $role = (split(/\//,$role,4))[-1];
}
- if ($env{'request.course.sec'}) {
- $role .= (' 'x2).'- '.&mt('section:').' '.$env{'request.course.sec'};
+ if ($sec) {
+ $role .= (' 'x2).'- '.&mt('section:').' '.$sec;
}
- $realm = $env{'course.'.$env{'request.course.id'}.'.description'};
+ $realm = $env{'course.'.$cid.'.description'};
} else {
$role = &Apache::lonnet::plaintext($role);
}
@@ -5210,15 +5791,13 @@ sub bodytag {
if ($public) {
undef($role);
}
-
+
my $titleinfo = ''.$title.' ';
#
# Extra info if you are the DC
my $dc_info = '';
- if ($env{'user.adv'} && exists($env{'user.role.dc./'.
- $env{'course.'.$env{'request.course.id'}.
- '.domain'}.'/'})) {
- my $cid = $env{'request.course.id'};
+ if (($env{'user.adv'}) && ($env{'request.course.id'}) &&
+ (exists($env{'user.role.dc./'.$env{'course.'.$cid.'.domain'}.'/'}))) {
$dc_info = $cid.' '.$env{'course.'.$cid.'.internal.coursecode'};
$dc_info =~ s/\s+$//;
}
@@ -5231,15 +5810,18 @@ sub bodytag {
my $funclist;
if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} ne 'construct')) {
- $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
- Apache::lonmenu::serverform();
- my $forbodytag;
- &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
- $forcereg,$args->{'group'},
- $args->{'bread_crumbs'},
- $advtoolsref,'',\$forbodytag);
- unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
- $funclist = $forbodytag;
+ unless ($args->{'switchserver'}) {
+ $bodytag .= Apache::lonhtmlcommon::scripttag(Apache::lonmenu::utilityfunctions($httphost), 'start')."\n".
+ Apache::lonmenu::serverform();
+ my $forbodytag;
+ &Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
+ $forcereg,$args->{'group'},
+ $args->{'bread_crumbs'},
+ $advtoolsref,'','',\$forbodytag);
+ unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
+ $funclist = $forbodytag;
+ }
+ $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
}
} else {
@@ -5247,61 +5829,87 @@ sub bodytag {
# $titleinfo = &CSTR_pageheader(); #FIXME: Will be removed once all scripts have their own calls
# }
- $bodytag .= Apache::lonhtmlcommon::scripttag(
- Apache::lonmenu::utilityfunctions($httphost), 'start');
+ my $need_endlcint;
+ unless ($args->{'switchserver'}) {
+ $bodytag .= Apache::lonhtmlcommon::scripttag(
+ Apache::lonmenu::utilityfunctions($httphost), 'start');
+ $need_endlcint = 1;
+ }
- my ($left,$right) = Apache::lonmenu::primary_menu();
+ if (($env{'environment.remote'} eq 'on') && ($env{'request.state'} eq 'construct')) {
+ unless ($env{'form.inhibitmenu'}) {
+ $bodytag .= &inline_for_remote($public,$role,$realm,$dc_info,$no_inline_link);
+ }
+ } else {
+ my ($left,$right) = Apache::lonmenu::primary_menu($args->{'links_disabled'});
- if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
- if ($dc_info) {
- $dc_info = qq|$dc_info |;
+ if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
+ if ($dc_info) {
+ $dc_info = qq|$dc_info |;
+ }
+ $bodytag .= qq|$left $role$realm $dc_info
|;
+ if ($need_endlcint) {
+ $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
+ }
+ return $bodytag;
}
- $bodytag .= qq|$left $role$realm $dc_info
|;
- return $bodytag;
- }
- unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
- $bodytag .= qq|$left $role
|;
- }
+ unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
+ $bodytag .= qq|$left $role
|;
+ }
- $bodytag .= $right;
+ $bodytag .= $right;
- if ($dc_info) {
- $dc_info = &dc_courseid_toggle($dc_info);
+ if ($dc_info) {
+ $dc_info = &dc_courseid_toggle($dc_info);
+ }
+ $bodytag .= qq|$realm $dc_info
|;
}
- $bodytag .= qq|$realm $dc_info
|;
#if directed to not display the secondary menu, don't.
if ($args->{'no_secondary_menu'}) {
+ if ($need_endlcint) {
+ $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
+ }
return $bodytag;
}
#don't show menus for public users
if (!$public){
- $bodytag .= Apache::lonmenu::secondary_menu($httphost);
+ unless (($env{'environment.remote'} eq 'on') &&
+ ($env{'request.state'} eq 'construct')) {
+ $bodytag .= Apache::lonmenu::secondary_menu($httphost,$args->{'links_disabled'});
+ }
$bodytag .= Apache::lonmenu::serverform();
- $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
+ if ($need_endlcint) {
+ $bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
+ }
if ($env{'request.state'} eq 'construct') {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,
- $args->{'bread_crumbs'});
- } elsif ($forcereg) {
+ $args->{'bread_crumbs'},'','',$hostname);
+ } elsif ($forcereg) {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
- $args->{'group'});
+ $args->{'group'},
+ $args->{'hide_buttons'},
+ $hostname);
} else {
my $forbodytag;
&Apache::lonmenu::prepare_functions($env{'request.noversionuri'},
$forcereg,$args->{'group'},
$args->{'bread_crumbs'},
- $advtoolsref,'',\$forbodytag);
+ $advtoolsref,'',$hostname,
+ \$forbodytag);
unless (ref($args->{'bread_crumbs'}) eq 'ARRAY') {
$bodytag .= $forbodytag;
}
}
- }else{
- # this is to seperate menu from content when there's no secondary
+ } else {
+ # this is to separate menu from content when there's no secondary
# menu. Especially needed for public accessible ressources.
$bodytag .= ''.&mt('Switch to Inline Menu Mode').' ');
+ :''.&mt('Switch to Inline Menu Mode').' ');
if ($dc_info) {
$dc_info = qq|($dc_info) |;
@@ -5330,31 +5937,46 @@ sub bodytag {
my $name = &plainname($env{'user.name'},$env{'user.domain'});
unless ($public) {
+ my $class = 'LC_menubuttons_link';
+ if ($args->{'links_disabled'}) {
+ $class .= ' LCisDisabled';
+ }
$name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
- undef,'LC_menubuttons_link');
+ undef,$class);
}
unless ($env{'form.inhibitmenu'}) {
- $bodytag .= qq|$name $role
- $realm $dc_info
|;
- }
- if ($env{'request.state'} eq 'construct') {
- if (!$public){
- if ($env{'request.state'} eq 'construct') {
- $funclist = &Apache::lonhtmlcommon::scripttag(
- &Apache::lonmenu::utilityfunctions($httphost), 'start').
- &Apache::lonhtmlcommon::scripttag('','end').
- &Apache::lonmenu::innerregister($forcereg,
- $args->{'bread_crumbs'});
- }
- }
+ $bodytag .= &inline_for_remote($public,$role,$realm,$dc_info,$no_inline_link);
}
return $bodytag."\n".$funclist;
}
+sub inline_for_remote {
+ my ($public,$role,$realm,$dc_info,$no_inline_link) = @_;
+ my $help=($no_inline_link?''
+ :&Apache::loncommon::top_nav_help('Help'));
+
+ # Explicit link to get inline menu
+ my $menu= ($no_inline_link?''
+ :''.&mt('Switch to Inline Menu Mode').' ');
+
+ if ($dc_info) {
+ $dc_info = qq|($dc_info) |;
+ }
+
+ my $name = &plainname($env{'user.name'},$env{'user.domain'});
+ unless ($public) {
+ $name = &aboutmewrapper($name,$env{'user.name'},$env{'user.domain'},
+ undef,'LC_menubuttons_link');
+ }
+
+ return qq|$name $role
+ $realm $dc_info
|;
+}
+
sub dc_courseid_toggle {
my ($dc_info) = @_;
return ' '.
@@ -5434,6 +6056,9 @@ sub endbodytag {
$endbodytag;
}
}
+ if ((ref($args) eq 'HASH') && ($args->{'dashjs'})) {
+ $endbodytag = &Apache::lonhtmlcommon::dash_to_minus_js().$endbodytag;
+ }
return $endbodytag;
}
@@ -5806,6 +6431,11 @@ td.LC_menubuttons_text {
background: $tabbg;
}
+td.LC_zero_height {
+ line-height: 0;
+ cellpadding: 0;
+}
+
table.LC_data_table {
border: 1px solid #000000;
border-collapse: separate;
@@ -6396,7 +7026,8 @@ table.LC_prior_tries td {
padding: 6px;
}
-.LC_answer_unknown {
+.LC_answer_unknown,
+.LC_answer_warning {
background: orange;
color: black;
padding: 6px;
@@ -6478,6 +7109,7 @@ table.LC_data_table tr > td.LC_docs_entr
color: #990000;
}
+.LC_domprefs_email,
.LC_docs_reinit_warn,
.LC_docs_ext_edit {
font-size: x-small;
@@ -6593,7 +7225,7 @@ div.LC_edit_problem_footer,
div.LC_edit_problem_footer div,
div.LC_edit_problem_editxml_header,
div.LC_edit_problem_editxml_header div {
- margin-top: 5px;
+ z-index: 100;
}
div.LC_edit_problem_header_title {
@@ -6609,14 +7241,17 @@ table.LC_edit_problem_header_title {
background: $tabbg;
}
-div.LC_edit_problem_discards {
- float: left;
- padding-bottom: 5px;
+div.LC_edit_actionbar {
+ background-color: $sidebg;
+ margin: 0;
+ padding: 0;
+ line-height: 200%;
}
-div.LC_edit_problem_saves {
- float: right;
- padding-bottom: 5px;
+div.LC_edit_actionbar div{
+ padding: 0;
+ margin: 0;
+ display: inline-block;
}
.LC_edit_opt {
@@ -6632,6 +7267,10 @@ div.LC_edit_problem_saves {
margin-left: 40px;
}
+#LC_edit_problem_codemirror div{
+ margin-left: 0px;
+}
+
img.stift {
border-width: 0;
vertical-align: middle;
@@ -6750,7 +7389,6 @@ fieldset > legend {
ol.LC_primary_menu {
margin: 0;
padding: 0;
- background-color: $pgbg_or_bgcolor;
}
ol#LC_PathBreadcrumbs {
@@ -6762,23 +7400,48 @@ ol.LC_primary_menu li {
vertical-align: middle;
text-align: left;
list-style: none;
+ position: relative;
float: left;
+ z-index: 100; /* will be displayed above codemirror and underneath the help-layer */
+ line-height: 1.5em;
}
-ol.LC_primary_menu li a {
+ol.LC_primary_menu li a,
+ol.LC_primary_menu li p {
display: block;
margin: 0;
padding: 0 5px 0 10px;
text-decoration: none;
}
-ol.LC_primary_menu li ul {
+ol.LC_primary_menu li p span.LC_primary_menu_innertitle {
+ display: inline-block;
+ width: 95%;
+ text-align: left;
+}
+
+ol.LC_primary_menu li p span.LC_primary_menu_innerarrow {
+ display: inline-block;
+ width: 5%;
+ float: right;
+ text-align: right;
+ font-size: 70%;
+}
+
+ol.LC_primary_menu ul {
display: none;
- width: 10em;
+ width: 15em;
background-color: $data_table_light;
+ position: absolute;
+ top: 100%;
}
-ol.LC_primary_menu li:hover ul, ol.LC_primary_menu li.hover ul {
+ol.LC_primary_menu ul ul {
+ left: 100%;
+ top: 0;
+}
+
+ol.LC_primary_menu li:hover > ul, ol.LC_primary_menu li.hover > ul {
display: block;
position: absolute;
margin: 0;
@@ -6787,15 +7450,21 @@ ol.LC_primary_menu li:hover ul, ol.LC_pr
}
ol.LC_primary_menu li:hover li, ol.LC_primary_menu li.hover li {
+/* First Submenu -> size should be smaller than the menu title of the whole menu */
font-size: 90%;
vertical-align: top;
float: none;
border-left: 1px solid black;
border-right: 1px solid black;
+/* A dark bottom border to visualize different menu options;
+overwritten in the create_submenu routine for the last border-bottom of the menu */
+ border-bottom: 1px solid $data_table_dark;
}
-ol.LC_primary_menu li:hover li a, ol.LC_primary_menu li.hover li a {
- background-color:$data_table_light;
+ol.LC_primary_menu li li p:hover {
+ color:$button_hover;
+ text-decoration:none;
+ background-color:$data_table_dark;
}
ol.LC_primary_menu li li a:hover {
@@ -6803,6 +7472,11 @@ ol.LC_primary_menu li li a:hover {
background-color:$data_table_dark;
}
+/* Font-size equal to the size of the predecessors*/
+ol.LC_primary_menu li:hover li li {
+ font-size: 100%;
+}
+
ol.LC_primary_menu li img {
vertical-align: bottom;
height: 1.1em;
@@ -6859,7 +7533,6 @@ ul#LC_secondary_menu li {
font-weight: bold;
line-height: 1.8em;
border-right: 1px solid black;
- vertical-align: middle;
float: left;
}
@@ -7345,6 +8018,26 @@ ul.LC_funclist li {
cursor:pointer;
}
+.LCisDisabled {
+ cursor: not-allowed;
+ opacity: 0.5;
+}
+
+a[aria-disabled="true"] {
+ color: currentColor;
+ display: inline-block; /* For IE11/ MS Edge bug */
+ pointer-events: none;
+ text-decoration: none;
+}
+
+pre.LC_wordwrap {
+ white-space: pre-wrap;
+ white-space: -moz-pre-wrap;
+ 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
when converting TeX" in course settings has been set
@@ -7366,6 +8059,39 @@ span.roman {font-family: serif; font-sty
span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
span.overacc1 {position: relative; left: .6em; top: -1.2ex;}
+#LC_minitab_header {
+ float:left;
+ width:100%;
+ background:#DAE0D2 url("/res/adm/pages/minitabmenu_bg.gif") repeat-x bottom;
+ font-size:93%;
+ line-height:normal;
+ margin: 0.5em 0 0.5em 0;
+}
+#LC_minitab_header ul {
+ margin:0;
+ padding:10px 10px 0;
+ list-style:none;
+}
+#LC_minitab_header li {
+ float:left;
+ background:url("/res/adm/pages/minitabmenu_left.gif") no-repeat left top;
+ margin:0;
+ padding:0 0 0 9px;
+}
+#LC_minitab_header a {
+ display:block;
+ background:url("/res/adm/pages/minitabmenu_right.gif") no-repeat right top;
+ padding:5px 15px 4px 6px;
+}
+#LC_minitab_header #LC_current_minitab {
+ background-image:url("/res/adm/pages/minitabmenu_left_on.gif");
+}
+#LC_minitab_header #LC_current_minitab a {
+ background-image:url("/res/adm/pages/minitabmenu_right_on.gif");
+ padding-bottom:5px;
+}
+
+
END
}
@@ -7387,6 +8113,7 @@ Inputs: $title - optional title for the
(side effect of setting
$env{'internal.head.redirect'} to the url
redirected too)
+ 4- whether encrypt check should be skipped
domain -> force to color decorate a page for a specific
domain
function -> force usage of a specific rolish color scheme
@@ -7420,7 +8147,7 @@ sub headtag {
$inhibitprint = &print_suppression();
}
- if (!$args->{'frameset'}) {
+ if (!$args->{'frameset'} && !$args->{'switchserver'}) {
$result .= &Apache::lonhtmlcommon::htmlareaheaders();
}
if ($args->{'force_register'}) {
@@ -7428,7 +8155,8 @@ sub headtag {
}
if (!$args->{'no_nav_bar'}
&& !$args->{'only_body'}
- && !$args->{'frameset'}) {
+ && !$args->{'frameset'}
+ && !$args->{'switchserver'}) {
$result .= &help_menu_js($httphost);
$result.=&modal_window();
$result.=&togglebox_script();
@@ -7449,8 +8177,10 @@ sub headtag {
}
}
if (ref($args->{'redirect'})) {
- my ($time,$url,$inhibit_continue) = @{$args->{'redirect'}};
- $url = &Apache::lonenc::check_encrypt($url);
+ my ($time,$url,$inhibit_continue,$skip_enc_check) = @{$args->{'redirect'}};
+ if (!$skip_enc_check) {
+ $url = &Apache::lonenc::check_encrypt($url);
+ }
if (!$inhibit_continue) {
$env{'internal.head.redirect'} = $url;
}
@@ -7471,43 +8201,99 @@ ADDMETA
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
+ my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+ my ($offload,$offloadoth);
if (ref($domdefs{'offloadnow'}) eq 'HASH') {
- my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
if ($domdefs{'offloadnow'}{$lonhost}) {
- my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
- if (($newserver) && ($newserver ne $lonhost)) {
- my $numsec = 5;
- my $timeout = $numsec * 1000;
- my ($newurl,$locknum,%locks,$msg);
- if ($env{'request.role.adv'}) {
- ($locknum,%locks) = &Apache::lonnet::get_locks();
- }
- my $disable_submit = 0;
- if ($requrl =~ /$LONCAPA::assess_re/) {
- $disable_submit = 1;
- }
- if ($locknum) {
- my @lockinfo = sort(values(%locks));
- $msg = &mt('Once the following tasks are complete: ')."\\n".
- join(", ",sort(values(%locks)))."\\n".
- &mt('your session will be transferred to a different server, after you click "Roles".');
- } else {
- if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
- $msg = &mt('Your LON-CAPA submission has been recorded')."\\n";
+ $offload = 1;
+ if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
+ (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
+ unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
+ $offloadoth = 1;
+ $dom_in_use = $env{'user.domain'};
+ }
+ }
+ }
+ }
+ unless ($offload) {
+ 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'};
}
- $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 ($offload) {
+ my $newserver = &Apache::lonnet::spareserver(undef,30000,undef,1,$dom_in_use);
+ if (($newserver eq '') && ($offloadoth)) {
+ my @domains = &Apache::lonnet::current_machine_domains();
+ if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) {
+ ($newserver) = &Apache::lonnet::choose_server($dom_in_use);
+ }
+ }
+ if (($newserver) && ($newserver ne $lonhost)) {
+ my $numsec = 5;
+ my $timeout = $numsec * 1000;
+ my ($newurl,$locknum,%locks,$msg);
+ if ($env{'request.role.adv'}) {
+ ($locknum,%locks) = &Apache::lonnet::get_locks();
+ }
+ my $disable_submit = 0;
+ if ($requrl =~ /$LONCAPA::assess_re/) {
+ $disable_submit = 1;
+ }
+ if ($locknum) {
+ my @lockinfo = sort(values(%locks));
+ $msg = &mt('Once the following tasks are complete:')." \n".
+ join(", ",sort(values(%locks)))."\n";
+ if (&show_course()) {
+ $msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
+ } else {
+ $msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
+ }
+ } else {
+ if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {
+ $msg = &mt('Your LON-CAPA submission has been recorded')."\n";
+ }
+ $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec);
+ $newurl = '/adm/switchserver?otherserver='.$newserver;
+ if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) {
+ $newurl .= '&role='.$env{'request.role'};
+ }
+ if ($env{'request.symb'}) {
+ my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'});
+ if ($shownsymb =~ m{^/enc/}) {
+ my $reqdmajor = 2;
+ my $reqdminor = 11;
+ my $reqdsubminor = 3;
+ my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver);
+ my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver);
+ my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/);
+ if (($major eq '' && $minor eq '') ||
+ (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) ||
+ (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') ||
+ ($reqdsubminor > $subminor))))) {
+ undef($shownsymb);
+ }
}
- if ($env{'request.symb'}) {
- $newurl .= '&symb='.$env{'request.symb'};
- } else {
- $newurl .= '&origurl='.$requrl;
+ if ($shownsymb) {
+ &js_escape(\$shownsymb);
+ $newurl .= '&symb='.$shownsymb;
}
+ } else {
+ my $shownurl = &Apache::lonenc::check_encrypt($requrl);
+ &js_escape(\$shownurl);
+ $newurl .= '&origurl='.$shownurl;
}
- &js_escape(\$msg);
- $result.=< LON-CAPA '.$title.' '
- .' LON-CAPA '.$title.' ';
+ }
+ $result .= "\n".',
+ and &standard_css() contains CSS for #LC_breadcrumbs, if you want
+ to override those values, or add to them, specify the value to
+ include in the style attribute to include in the div tag by using
+ bread_crumbs_style (e.g., overflow: visible)
+ bread_crumbs_nomenu -> if true will pass false as the value of $menulink
+ to lonhtmlcommon::breadcrumbs
group -> includes the current group, if page is for a
specific group
+ use_absolute -> for request for external resource or syllabus, this
+ will contain https://
if server uses
+ https (as per hosts.tab), but request is for http
+ hostname -> hostname, originally from $r->hostname(), (optional).
+ links_disabled -> Links in primary and secondary menus are disabled
+ (Can enable them once page has loaded - see lonroles.pm
+ for an example).
=back
@@ -7804,12 +8609,21 @@ sub start_page {
if (@advtools > 0) {
&Apache::lonmenu::advtools_crumbs(@advtools);
}
-
+ my $menulink;
+ # if arg: bread_crumbs_nomenu is true pass 0 as $menulink item.
+ if (exists($args->{'bread_crumbs_nomenu'})) {
+ $menulink = 0;
+ } else {
+ undef($menulink);
+ }
#if bread_crumbs_component exists show it as headline else show only the breadcrumbs
if(exists($args->{'bread_crumbs_component'})){
- $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});
+ $result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},
+ '',$menulink,'',
+ $args->{'bread_crumbs_style'});
}else{
- $result .= &Apache::lonhtmlcommon::breadcrumbs();
+ $result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink,'',
+ $args->{'bread_crumbs_style'});
}
} elsif (($env{'environment.remote'} eq 'on') &&
($env{'form.inhibitmenu'} ne 'yes') &&
@@ -7911,7 +8725,7 @@ var modalWindow = {
};
var openMyModal = function(source,width,height,scrolling,transparency,style)
{
- source = source.replace("'","'");
+ source = source.replace(/'/g,"'");
modalWindow.windowId = "myModal";
modalWindow.width = width;
modalWindow.height = height;
@@ -7936,13 +8750,20 @@ sub modal_link {
$target_attr = 'target="'.$target.'"';
}
return <<"ENDLINK";
-
- $linktext
+$linktext
ENDLINK
}
sub modal_adhoc_script {
- my ($funcname,$width,$height,$content)=@_;
+ my ($funcname,$width,$height,$content,$possmathjax)=@_;
+ my $mathjax;
+ if ($possmathjax) {
+ $mathjax = <<'ENDJAX';
+ if (typeof MathJax == 'object') {
+ MathJax.Hub.Queue(["Typeset",MathJax.Hub]);
+ }
+ENDJAX
+ }
return (<
//
@@ -7960,7 +8782,7 @@ ENDADHOC
}
sub modal_adhoc_inner {
- my ($funcname,$width,$height,$content)=@_;
+ my ($funcname,$width,$height,$content,$possmathjax)=@_;
my $innerwidth=$width-20;
$content=&js_ready(
&start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}).
@@ -7969,12 +8791,12 @@ sub modal_adhoc_inner {
&end_scrollbox().
&end_page()
);
- return &modal_adhoc_script($funcname,$width,$height,$content);
+ return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax);
}
sub modal_adhoc_window {
- my ($funcname,$width,$height,$content,$linktext)=@_;
- return &modal_adhoc_inner($funcname,$width,$height,$content).
+ my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_;
+ return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax).
"".$linktext." ";
}
@@ -8040,8 +8862,9 @@ sub end_togglebox {
}
sub LCprogressbar_script {
- my ($id)=@_;
- return(<
//
ENDPROGRESS
+ } else {
+ return(<
+//
+
+ENDPROGRESS
+ }
}
sub LCprogressbarUpdate_script {
return(<
.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; }
@@ -8080,37 +8925,54 @@ my $LCidcnt;
my $LCcurrentid;
sub LCprogressbar {
- my ($r)=(@_);
+ my ($r,$number_to_do,$preamble)=@_;
$LClastpercent=0;
$LCidcnt++;
$LCcurrentid=$$.'_'.$LCidcnt;
- my $starting=&mt('Starting');
- my $content=(<
$starting
+ $starting
+
//
ENDUPDATE
@@ -9227,8 +10089,24 @@ sub get_secgrprole_info {
}
sub user_picker {
- my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context) = @_;
+ my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
my $currdom = $dom;
+ my @alldoms = &Apache::lonnet::all_domains();
+ if (@alldoms == 1) {
+ my %domsrch = &Apache::lonnet::get_dom('configuration',
+ ['directorysrch'],$alldoms[0]);
+ my $domdesc = &Apache::lonnet::domain($alldoms[0],'description');
+ my $showdom = $domdesc;
+ if ($showdom eq '') {
+ $showdom = $dom;
+ }
+ if (ref($domsrch{'directorysrch'}) eq 'HASH') {
+ if ((!$domsrch{'directorysrch'}{'available'}) &&
+ ($domsrch{'directorysrch'}{'lcavailable'} eq '0')) {
+ return (&mt('LON-CAPA directory search is not available in domain: [_1]',$showdom),0);
+ }
+ }
+ }
my %curr_selected = (
srchin => 'dom',
srchby => 'lastname',
@@ -9275,7 +10153,14 @@ sub user_picker {
);
&html_escape(\%html_lt);
&js_escape(\%js_lt);
- my $domform = &select_dom_form($currdom,'srchdomain',1,1);
+ my $domform;
+ my $allow_blank = 1;
+ if ($fixeddom) {
+ $allow_blank = 0;
+ $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
+ } else {
+ $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
+ }
my $srchinsel = ' ';
my @srchins = ('crs','dom','alc','instd');
@@ -9287,6 +10172,7 @@ sub user_picker {
next if ($option eq 'alc');
next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
next if ($option eq 'crs' && !$env{'request.course.id'});
+ next if (($option eq 'instd') && ($noinstd));
if ($curr_selected{'srchin'} eq $option) {
$srchinsel .= '
'.$html_lt{$option}.' ';
@@ -9469,7 +10355,7 @@ END_BLOCK
&Apache::lonhtmlcommon::row_closure(1).
&Apache::lonhtmlcommon::end_pick_box().
''.&mt('Updated [quant,_1,reference] in [_2].',
@@ -11630,6 +12533,18 @@ sub decompress_uploaded_file {
sub process_decompression {
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
+ unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs|supplemental)/(default|\d+)/\d+$})) {
+ return '
'.&mt('Not extracted.').'
'."\n";
+ }
+ unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
+ return ''.&mt('Not extracted.').'
'."\n";
+ }
+ unless ($file eq &Apache::lonnet::clean_filename($file)) {
+ return ''.&mt('Not extracted.').'
'."\n";
+ }
my ($dir,$error,$warning,$output);
if ($file !~ /\.(zip|tar|bz2|gz|tar.gz|tar.bz2|tgz)$/i) {
$error = &mt('Filename not a supported archive file type.').
@@ -11664,30 +12579,44 @@ sub process_decompression {
}
}
my $numskip = scalar(@to_skip);
- if (($numskip > 0) &&
- ($numskip == $env{'form.archive_itemcount'})) {
+ my $numoverwrite = scalar(@to_overwrite);
+ if (($numskip) && (!$numoverwrite)) {
$warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
} elsif ($dir eq '') {
$error = &mt('Directory containing archive file unavailable.');
} elsif (!$error) {
my ($decompressed,$display);
- if ($numskip > 0) {
+ if (($numskip) || ($numoverwrite)) {
my $tempdir = time.'_'.$$.int(rand(10000));
mkdir("$dir/$tempdir",0755);
- system("mv $dir/$file $dir/$tempdir/$file");
- ($decompressed,$display) =
- &decompress_uploaded_file($file,"$dir/$tempdir");
- foreach my $item (@to_skip) {
- if (($item ne '') && ($item !~ /\.\./)) {
- if (-f "$dir/$tempdir/$item") {
- unlink("$dir/$tempdir/$item");
- } elsif (-d "$dir/$tempdir/$item") {
- system("rm -rf $dir/$tempdir/$item");
+ if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
+ ($decompressed,$display) =
+ &decompress_uploaded_file($file,"$dir/$tempdir");
+ foreach my $item (@to_skip) {
+ if (($item ne '') && ($item !~ /\.\./)) {
+ if (-f "$dir/$tempdir/$item") {
+ unlink("$dir/$tempdir/$item");
+ } elsif (-d "$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 {
($decompressed,$display) =
&decompress_uploaded_file($file,$dir);
@@ -11705,8 +12634,7 @@ sub process_decompression {
if (ref($newdirlistref) eq 'ARRAY') {
foreach my $dir_line (@{$newdirlistref}) {
my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
- unless (($item =~ /^\.+$/) || ($item eq $file) ||
- ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
+ unless (($item =~ /^\.+$/) || ($item eq $file)) {
push(@newitems,$item);
if ($dirptr&$testdir) {
$is_dir{$item} = 1;
@@ -12191,7 +13119,7 @@ END
sub process_extracted_files {
my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
my $numitems = $env{'form.archive_count'};
- return unless ($numitems);
+ return if ((!$numitems) || ($numitems =~ /\D/));
my @ids=&Apache::lonnet::current_machine_ids();
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
%folders,%containers,%mapinner,%prompttofetch);
@@ -12204,7 +13132,7 @@ sub process_extracted_files {
} else {
$prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
$pathtocheck = "$dir_root/$docudom/$docuname/$destination";
- $dir = "$dir_root/$docudom/$docuname";
+ $dir = "$dir_root/$docudom/$docuname";
}
my $currdir = "$dir_root/$destination";
(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs|supplemental)/(\w+)/});
@@ -12293,7 +13221,9 @@ sub process_extracted_files {
'.'.$containers{$outer},1,1);
$newseqid{$i} = $newidx;
unless ($errtext) {
- $result .= ''.&mt('Folder: [_1] added to course',$docstitle).' '."\n";
+ $result .= ''.&mt('Folder: [_1] added to course',
+ &HTML::Entities::encode($docstitle,'<>&"'))..
+ ' '."\n";
}
}
} else {
@@ -12302,38 +13232,49 @@ sub process_extracted_files {
my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
$title;
- 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 (($outer !~ /\D/) &&
+ (($mapinner{$outer} eq 'default') || ($mapinner{$outer} !~ /\D/)) &&
+ ($newidx !~ /\D/)) {
+ if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
+ mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
}
- }
- $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 .= ''.&mt('File: [_1] added to course',$docstitle).' '."\n";
+ if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
+ mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
+ }
+ 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 .= ''.&mt('File: [_1] added to course',
+ &HTML::Entities::encode($docstitle,'<>&"')).
+ ' '."\n";
+ }
+ }
+ } else {
+ $warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
+ &HTML::Entities::encode($path,'<>&"')).''.&mt('[_1] included as a dependency',$showpath).' '."\n";
- }
- unless ($ishome) {
- my $fetch = "$fullpath/$title";
- $fetch =~ s/^\Q$prefix$dir\E//;
- $prompttofetch{$fetch} = 1;
+ $result .= ''.&mt('[_1] included as a dependency',
+ &HTML::Entities::encode($showpath,'<>&"')).
+ ' '."\n";
+ unless ($ishome) {
+ my $fetch = "$fullpath/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
+ }
}
}
}
} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
$warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
- $path,$env{'form.archive_content_'.$referrer{$i}}).''.
' '.
+ $item.'"'.$checked.$disabled.' />'.$parent_title.''.
''.
' ';
if (ref($path) eq 'ARRAY') {
push(@{$path},$name);
- $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories);
+ $text .= &assign_category_rows($itemcount,$cats,$deeper,$name,$path,$currcategories,$disabled);
pop(@{$path});
}
$text .= ' '.$badclass_msg.$linefeed.'
'."\n";
- foreach my $item (@badclasses) {
- if ($context eq 'auto') {
- $outcome .= " - $item\n";
- } else {
- $outcome .= "$item \n";
- }
- }
+ }
+ foreach my $item (@badclasses) {
if ($context eq 'auto') {
- $outcome .= $linefeed;
+ $outcome .= " - $item\n";
} else {
- $outcome .= " $item \n";
}
- }
+ }
+ if ($context eq 'auto') {
+ $outcome .= $linefeed;
+ } else {
+ $outcome .= "'.
&mt('Type in the letters/numbers shown below').' '.
- '
';
+ return '
'.
+ '
';
} else {
my $use_ssl;
if ($ENV{'SERVER_PORT'} == 443) {
@@ -16196,13 +17483,14 @@ sub create_recaptcha {
sub check_recaptcha {
my ($privkey,$version) = @_;
my $captcha_chk;
+ my $ip = &Apache::lonnet::get_requestor_ip();
if ($version >= 2) {
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
my %info = (
secret => $privkey,
response => $env{'form.g-recaptcha-response'},
- remoteip => $ENV{'REMOTE_ADDR'},
+ remoteip => $ip,
);
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
if ($response->is_success) {
@@ -16218,7 +17506,7 @@ sub check_recaptcha {
my $captcha_result =
$captcha->check_answer(
$privkey,
- $ENV{'REMOTE_ADDR'},
+ $ip,
$env{'form.recaptcha_challenge_field'},
$env{'form.recaptcha_response_field'},
);
@@ -16269,13 +17557,16 @@ sub cleanup_html {
# $interval indicates how often to check for messages.
sub critical_redirect {
my ($interval) = @_;
+ unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
+ return ();
+ }
if ((time-$env{'user.criticalcheck.time'})>$interval) {
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
$env{'user.name'});
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
my $redirecturl;
if ($what[0]) {
- if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
+ if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
$redirecturl='/adm/email?critical=display';
my $url=&Apache::lonnet::absolute_url().$redirecturl;
return (1, $url);
@@ -16335,6 +17626,159 @@ sub des_decrypt {
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;
__END__;