loncom/interface/loncommon.pm - diff

Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.116 and 1.1075.2.147

version 1.1075.2.116, 2016/10/30 18:04:58	version 1.1075.2.147, 2020/09/28 00:38:30
Line 71 use Apache::lonuserutils();	Line 71 use Apache::lonuserutils();
use Apache::lonuserstate();	use Apache::lonuserstate();
use Apache::courseclassifier();	use Apache::courseclassifier();
use LONCAPA qw(:DEFAULT :match);	use LONCAPA qw(:DEFAULT :match);
	use HTTP::Request;
use DateTime::TimeZone;	use DateTime::TimeZone;
use DateTime::Locale;	use DateTime::Locale;
use Encode();	use Encode();
Line 80 use JSON::DWIW;	Line 81 use JSON::DWIW;
use LWP::UserAgent;	use LWP::UserAgent;
use Crypt::DES;	use Crypt::DES;
use DynaLoader; # for Crypt::DES version	use DynaLoader; # for Crypt::DES version
	use File::Copy();
	use File::Path();

# ---------------------------------------------- Designs	# ---------------------------------------------- Designs
use vars qw(%defaultdesign);	use vars qw(%defaultdesign);
Line 194 BEGIN {	Line 197 BEGIN {
{	{
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab';	'/language.tab';
if ( open(my $fh,"<$langtabfile") ) {	if ( open(my $fh,'<',$langtabfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line=~/^\#/);	next if ($line=~/^\#/);
chomp($line);	chomp($line);
Line 215 BEGIN {	Line 218 BEGIN {
{	{
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.	my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/copyright.tab';	'/copyright.tab';
if ( open (my $fh,"<$copyrightfile") ) {	if ( open (my $fh,'<',$copyrightfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line=~/^\#/);	next if ($line=~/^\#/);
chomp($line);	chomp($line);
Line 229 BEGIN {	Line 232 BEGIN {
{	{
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.	my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/source_copyright.tab';	'/source_copyright.tab';
if ( open (my $fh,"<$sourcecopyrightfile") ) {	if ( open (my $fh,'<',$sourcecopyrightfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 243 BEGIN {	Line 246 BEGIN {
# -------------------------------------------------------------- default domain designs	# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/default.tab';	my $designfile = $designdir.'/default.tab';
if ( open (my $fh,"<$designfile") ) {	if ( open (my $fh,'<',$designfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 257 BEGIN {	Line 260 BEGIN {
{	{
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab';	'/filecategories.tab';
if ( open (my $fh,"<$categoryfile") ) {	if ( open (my $fh,'<',$categoryfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
my ($extension,$category)=(split(/\s+/,$line,2));	my ($extension,$category)=(split(/\s+/,$line,2));
push @{$category_extensions{lc($category)}},$extension;	push(@{$category_extensions{lc($category)}},$extension);
}	}
close($fh);	close($fh);
}	}
Line 272 BEGIN {	Line 275 BEGIN {
{	{
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filetypes.tab';	'/filetypes.tab';
if ( open (my $fh,"<$typesfile") ) {	if ( open (my $fh,'<',$typesfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 425 sub studentbrowser_javascript {	Line 428 sub studentbrowser_javascript {
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
// <![CDATA[	// <![CDATA[
var stdeditbrowser;	var stdeditbrowser;
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {	function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
var url = '/adm/pickstudent?';	var url = '/adm/pickstudent?';
var filter;	var filter;
if (!ignorefilter) {	if (!ignorefilter) {
Line 440 sub studentbrowser_javascript {	Line 443 sub studentbrowser_javascript {
'&udomelement='+udom+	'&udomelement='+udom+
'&clicker='+clicker;	'&clicker='+clicker;
if (roleflag) { url+="&roles=1"; }	if (roleflag) { url+="&roles=1"; }
if (courseadvonly) { url+="&courseadvonly=1"; }	if (courseadv == 'condition') {
	if (document.getElementById('courseadv')) {
	courseadv = document.getElementById('courseadv').value;
	}
	}
	if ((courseadv == 'only') \|\| (courseadv == 'none')) { url+="&courseadv="+courseadv; }
var title = 'Student_Browser';	var title = 'Student_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';	options += ',width=700,height=600';
Line 472 ENDRESBRW	Line 480 ENDRESBRW
}	}

sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;	my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".	my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
&Apache::lonhtmlcommon::entity_encode($unameele)."','".	&Apache::lonhtmlcommon::entity_encode($unameele)."','".
&Apache::lonhtmlcommon::entity_encode($udomele)."'";	&Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 483 sub selectstudent_link {	Line 491 sub selectstudent_link {
return '';	return '';
}	}
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";	$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
if ($courseadvonly) {	if ($courseadv eq 'only') {
$callargs .= ",'',1,1";	$callargs .= ",'',1,'$courseadv'";
	} elsif ($courseadv eq 'none') {
	$callargs .= ",'','','$courseadv'";
	} elsif ($courseadv eq 'condition') {
	$callargs .= ",'','','$courseadv'";
}	}
return '<span class="LC_nobreak">'.	return '<span class="LC_nobreak">'.
'<a href="javascript:openstdbrowser('.$callargs.');">'.	'<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 1138 sub linked_select_forms {	Line 1150 sub linked_select_forms {
$result.="select2data.d_$s1.texts = new Array(";	$result.="select2data.d_$s1.texts = new Array(";
my @s2texts;	my @s2texts;
foreach my $value (@s2values) {	foreach my $value (@s2values) {
push @s2texts, $hashref->{$s1}->{'select2'}->{$value};	push(@s2texts, $hashref->{$s1}->{'select2'}->{$value});
}	}
$result.="\"@s2texts\");\n";	$result.="\"@s2texts\");\n";
}	}
Line 1401 sub help_menu_js {	Line 1413 sub help_menu_js {
&Apache::loncommon::start_page('Help Menu', undef,	&Apache::loncommon::start_page('Help Menu', undef,
{'frameset' => 1,	{'frameset' => 1,
'js_ready' => 1,	'js_ready' => 1,
'use_absolute' => $httphost,	'use_absolute' => $httphost,
'add_entries' => {	'add_entries' => {
'border' => '0',	'border' => '0',
'rows' => "110,*",},});	'rows' => "110,*",},});
Line 2260 sub select_form {	Line 2272 sub select_form {
if ($onchange) {	if ($onchange) {
$onchange = ' onchange="'.$onchange.'"';	$onchange = ' onchange="'.$onchange.'"';
}	}
my $selectform = "<select name=\"$name\" size=\"1\"$onchange>\n";	my $disabled;
	if ($readonly) {
	$disabled = ' disabled="disabled"';
	}
	my $selectform = "<select name=\"$name\" size=\"1\"$onchange$disabled>\n";
my @keys;	my @keys;
if (exists($hashref->{'select_form_order'})) {	if (exists($hashref->{'select_form_order'})) {
@keys=@{$hashref->{'select_form_order'}};	@keys=@{$hashref->{'select_form_order'}};
Line 2845 sub authform_kerberos {	Line 2861 sub authform_kerberos {
@_,	@_,
);	);
my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,	my ($check4,$check5,$krbcheck,$krbarg,$krbver,$result,$authtype,
$autharg,$jscall);	$autharg,$jscall,$disabled);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
if ($in{'kerb_def_auth'} eq 'krb5') {	if ($in{'kerb_def_auth'} eq 'krb5') {
$check5 = ' checked="checked"';	$check5 = ' checked="checked"';
} else {	} else {
$check4 = ' checked="checked"';	$check4 = ' checked="checked"';
}	}
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
$krbarg = $in{'kerb_def_dom'};	$krbarg = $in{'kerb_def_dom'};
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'krb') {	if ($in{'curr_authtype'} eq 'krb') {
Line 2896 sub authform_kerberos {	Line 2915 sub authform_kerberos {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="radio" name="login" value="krb" />';	$authtype = '<input type="radio" name="login" value="krb"'.$disabled.' />';
}	}
}	}
}	}
Line 2905 sub authform_kerberos {	Line 2924 sub authform_kerberos {
if ($authtype eq '') {	if ($authtype eq '') {
$authtype = '<input type="radio" name="login" value="krb" '.	$authtype = '<input type="radio" name="login" value="krb" '.
'onclick="'.$jscall.'" onchange="'.$jscall.'"'.	'onclick="'.$jscall.'" onchange="'.$jscall.'"'.
$krbcheck.' />';	$krbcheck.$disabled.' />';
}	}
if (($can_assign{'krb4'} && $can_assign{'krb5'}) \|\|	if (($can_assign{'krb4'} && $can_assign{'krb5'}) \|\|
($can_assign{'krb4'} && !$can_assign{'krb5'} &&	($can_assign{'krb4'} && !$can_assign{'krb5'} &&
Line 2918 sub authform_kerberos {	Line 2937 sub authform_kerberos {
'<label>'.$authtype,	'<label>'.$authtype,
'</label><input type="text" size="10" name="krbarg" '.	'</label><input type="text" size="10" name="krbarg" '.
'value="'.$krbarg.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'"'.$disabled.' />',
'<label><input type="radio" name="krbver" value="4" '.$check4.' />',	'<label><input type="radio" name="krbver" value="4" '.$check4.$disabled.' />',
'</label><label><input type="radio" name="krbver" value="5" '.$check5.' />',	'</label><label><input type="radio" name="krbver" value="5" '.$check5.$disabled.' />',
'</label>');	'</label>');
} elsif ($can_assign{'krb4'}) {	} elsif ($can_assign{'krb4'}) {
$result .= &mt	$result .= &mt
Line 2929 sub authform_kerberos {	Line 2948 sub authform_kerberos {
'<label>'.$authtype,	'<label>'.$authtype,
'</label><input type="text" size="10" name="krbarg" '.	'</label><input type="text" size="10" name="krbarg" '.
'value="'.$krbarg.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'"'.$disabled.' />',
'<label><input type="hidden" name="krbver" value="4" />',	'<label><input type="hidden" name="krbver" value="4" />',
'</label>');	'</label>');
} elsif ($can_assign{'krb5'}) {	} elsif ($can_assign{'krb5'}) {
Line 2939 sub authform_kerberos {	Line 2958 sub authform_kerberos {
'<label>'.$authtype,	'<label>'.$authtype,
'</label><input type="text" size="10" name="krbarg" '.	'</label><input type="text" size="10" name="krbarg" '.
'value="'.$krbarg.'" '.	'value="'.$krbarg.'" '.
'onchange="'.$jscall.'" />',	'onchange="'.$jscall.'"'.$disabled.' />',
'<label><input type="hidden" name="krbver" value="5" />',	'<label><input type="hidden" name="krbver" value="5" />',
'</label>');	'</label>');
}	}
Line 2952 sub authform_internal {	Line 2971 sub authform_internal {
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall);	my ($intcheck,$intarg,$result,$authtype,$autharg,$jscall,$disabled);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'int') {	if ($in{'curr_authtype'} eq 'int') {
if ($can_assign{'int'}) {	if ($can_assign{'int'}) {
Line 2982 sub authform_internal {	Line 3004 sub authform_internal {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="radio" name="login" value="int" />';	$authtype = '<input type="radio" name="login" value="int"'.$disabled.' />';
}	}
}	}
}	}
Line 2990 sub authform_internal {	Line 3012 sub authform_internal {
$jscall = "javascript:changed_radio('int',$in{'formname'});";	$jscall = "javascript:changed_radio('int',$in{'formname'});";
if ($authtype eq '') {	if ($authtype eq '') {
$authtype = '<input type="radio" name="login" value="int" '.$intcheck.	$authtype = '<input type="radio" name="login" value="int" '.$intcheck.
' onchange="'.$jscall.'" onclick="'.$jscall.'" />';	' onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="password" size="10" name="intarg" value="'.	$autharg = '<input type="password" size="10" name="intarg" value="'.
$intarg.'" onchange="'.$jscall.'" />';	$intarg.'" onchange="'.$jscall.'"'.$disabled.' />';
$result = &mt	$result = &mt
('[_1] Internally authenticated (with initial password [_2])',	('[_1] Internally authenticated (with initial password [_2])',
'<label>'.$authtype,'</label>'.$autharg);	'<label>'.$authtype,'</label>'.$autharg);
$result.="<label><input type=\"checkbox\" name=\"visible\" onclick='if (this.checked) { this.form.intarg.type=\"text\" } else { this.form.intarg.type=\"password\" }' />".&mt('Visible input').'</label>';	$result.='<label><input type="checkbox" name="visible" onclick="if (this.checked) { this.form.intarg.type='."'text'".' } else { this.form.intarg.type='."'password'".' }"'.$disabled.' />'.&mt('Visible input').'</label>';
return $result;	return $result;
}	}

Line 3007 sub authform_local {	Line 3029 sub authform_local {
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall);	my ($loccheck,$locarg,$result,$authtype,$autharg,$jscall,$disabled);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'loc') {	if ($in{'curr_authtype'} eq 'loc') {
if ($can_assign{'loc'}) {	if ($can_assign{'loc'}) {
Line 3037 sub authform_local {	Line 3062 sub authform_local {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="radio" name="login" value="loc" />';	$authtype = '<input type="radio" name="login" value="loc"'.$disabled.' />';
}	}
}	}
}	}
Line 3046 sub authform_local {	Line 3071 sub authform_local {
if ($authtype eq '') {	if ($authtype eq '') {
$authtype = '<input type="radio" name="login" value="loc" '.	$authtype = '<input type="radio" name="login" value="loc" '.
$loccheck.' onchange="'.$jscall.'" onclick="'.	$loccheck.' onchange="'.$jscall.'" onclick="'.
$jscall.'" />';	$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="text" size="10" name="locarg" value="'.	$autharg = '<input type="text" size="10" name="locarg" value="'.
$locarg.'" onchange="'.$jscall.'" />';	$locarg.'" onchange="'.$jscall.'"'.$disabled.' />';
$result = &mt('[_1] Local Authentication with argument [_2]',	$result = &mt('[_1] Local Authentication with argument [_2]',
'<label>'.$authtype,'</label>'.$autharg);	'<label>'.$authtype,'</label>'.$autharg);
return $result;	return $result;
Line 3061 sub authform_filesystem {	Line 3086 sub authform_filesystem {
kerb_def_dom => 'MSU.EDU',	kerb_def_dom => 'MSU.EDU',
@_,	@_,
);	);
my ($fsyscheck,$result,$authtype,$autharg,$jscall);	my ($fsyscheck,$result,$authtype,$autharg,$jscall,$disabled);
my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
if (defined($in{'curr_authtype'})) {	if (defined($in{'curr_authtype'})) {
if ($in{'curr_authtype'} eq 'fsys') {	if ($in{'curr_authtype'} eq 'fsys') {
if ($can_assign{'fsys'}) {	if ($can_assign{'fsys'}) {
Line 3088 sub authform_filesystem {	Line 3116 sub authform_filesystem {
if (defined($in{'mode'})) {	if (defined($in{'mode'})) {
if ($in{'mode'} eq 'modifycourse') {	if ($in{'mode'} eq 'modifycourse') {
if ($authnum == 1) {	if ($authnum == 1) {
$authtype = '<input type="radio" name="login" value="fsys" />';	$authtype = '<input type="radio" name="login" value="fsys"'.$disabled.' />';
}	}
}	}
}	}
Line 3097 sub authform_filesystem {	Line 3125 sub authform_filesystem {
if ($authtype eq '') {	if ($authtype eq '') {
$authtype = '<input type="radio" name="login" value="fsys" '.	$authtype = '<input type="radio" name="login" value="fsys" '.
$fsyscheck.' onchange="'.$jscall.'" onclick="'.	$fsyscheck.' onchange="'.$jscall.'" onclick="'.
$jscall.'" />';	$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="text" size="10" name="fsysarg" value=""'.	$autharg = '<input type="text" size="10" name="fsysarg" value=""'.
' onchange="'.$jscall.'" />';	' onchange="'.$jscall.'"'.$disabled.' />';
$result = &mt	$result = &mt
('[_1] Filesystem Authenticated (with initial password [_2])',	('[_1] Filesystem Authenticated (with initial password [_2])',
'<label><input type="radio" name="login" value="fsys" '.	'<label><input type="radio" name="login" value="fsys" '.
$fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'" />',	$fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',
'</label><input type="password" size="10" name="fsysarg" value="" '.	'</label><input type="password" size="10" name="fsysarg" value="" '.
'onchange="'.$jscall.'" />');	'onchange="'.$jscall.'"'.$disabled.' />');
return $result;	return $result;
}	}

Line 3128 sub get_assignable_auth {	Line 3156 sub get_assignable_auth {
my $context;	my $context;
if ($env{'request.role'} =~ /^au/) {	if ($env{'request.role'} =~ /^au/) {
$context = 'author';	$context = 'author';
} elsif ($env{'request.role'} =~ /^dc/) {	} elsif ($env{'request.role'} =~ /^(dc\|dh)/) {
$context = 'domain';	$context = 'domain';
} elsif ($env{'request.course.id'}) {	} elsif ($env{'request.course.id'}) {
$context = 'course';	$context = 'course';
Line 3152 sub get_assignable_auth {	Line 3180 sub get_assignable_auth {
return ($authnum,%can_assign);	return ($authnum,%can_assign);
}	}

	sub check_passwd_rules {
	my ($domain,$plainpass) = @_;
	my %passwdconf = &Apache::lonnet::get_passwdconf($domain);
	my ($min,$max,@chars,@brokerule,$warning);
	$min = $Apache::lonnet::passwdmin;
	if (ref($passwdconf{'chars'}) eq 'ARRAY') {
	if ($passwdconf{'min'} =~ /^\d+$/) {
	if ($passwdconf{'min'} > $min) {
	$min = $passwdconf{'min'};
	}
	}
	if ($passwdconf{'max'} =~ /^\d+$/) {
	$max = $passwdconf{'max'};
	}
	@chars = @{$passwdconf{'chars'}};
	}
	if (($min) && (length($plainpass) < $min)) {
	push(@brokerule,'min');
	}
	if (($max) && (length($plainpass) > $max)) {
	push(@brokerule,'max');
	}
	if (@chars) {
	my %rules;
	map { $rules{$_} = 1; } @chars;
	if ($rules{'uc'}) {
	unless ($plainpass =~ /[A-Z]/) {
	push(@brokerule,'uc');
	}
	}
	if ($rules{'lc'}) {
	unless ($plainpass =~ /[a-z]/) {
	push(@brokerule,'lc');
	}
	}
	if ($rules{'num'}) {
	unless ($plainpass =~ /\d/) {
	push(@brokerule,'num');
	}
	}
	if ($rules{'spec'}) {
	unless ($plainpass =~ /[!"#$%&'()*+,\-.\/:;<=>?@[\\\]^_`{\|}~]/) {
	push(@brokerule,'spec');
	}
	}
	}
	if (@brokerule) {
	my %rulenames = &Apache::lonlocal::texthash(
	uc => 'At least one upper case letter',
	lc => 'At least one lower case letter',
	num => 'At least one number',
	spec => 'At least one non-alphanumeric',
	);
	$rulenames{'uc'} .= ': ABCDEFGHIJKLMNOPQRSTUVWXYZ';
	$rulenames{'lc'} .= ': abcdefghijklmnopqrstuvwxyz';
	$rulenames{'num'} .= ': 0123456789';
	$rulenames{'spec'} .= ': !"\#$%&\'()*+,-./:;<=>?@[\]^_\`{\|}~';
	$rulenames{'min'} = &mt('Minimum password length: [_1]',$min);
	$rulenames{'max'} = &mt('Maximum password length: [_1]',$max);
	$warning = &mt('Password did not satisfy the following:').'<ul>';
	foreach my $rule ('min','max','uc','lc','num','spec') {
	if (grep(/^$rule$/,@brokerule)) {
	$warning .= '<li>'.$rulenames{$rule}.'</li>';
	}
	}
	$warning .= '</ul>';
	}
	if (wantarray) {
	return @brokerule;
	}
	return $warning;
	}

###############################################################	###############################################################
## Get Kerberos Defaults for Domain ##	## Get Kerberos Defaults for Domain ##
###############################################################	###############################################################
Line 4577 sub findallcourses {	Line 4678 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 4684 sub blockcheck {	Line 4785 sub blockcheck {
$tdom,$spec,$trest,$area);	$tdom,$spec,$trest,$area);
}	}
}	}
my ($author,$adv) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);	my ($author,$adv,$rar) = &Apache::lonnet::set_userprivs(\%userroles,\%allroles);
if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {	if ($userroles{'user.priv.'.$checkrole} =~ /evb\&([^\:]*)/) {
if ($1) {	if ($1) {
$no_userblock = 1;	$no_userblock = 1;
Line 4706 sub blockcheck {	Line 4807 sub blockcheck {
($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));	($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
next if ($no_userblock);	next if ($no_userblock);

# Retrieve blocking times and identity of locker for course	# Retrieve blocking times and identity of blocker for course
# of specified user, unless user has 'evb' privilege.	# of specified user, unless user has 'evb' privilege.

my ($start,$end,$trigger) =	my ($start,$end,$trigger) =
&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 4730 sub blockcheck {	Line 4831 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 4743 sub get_blocks {	Line 4844 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);
	if (($caller eq 'blockedaccess') \|\| ($caller eq 'blockingstatus')) {
	$blocked = 1;
	$nosymbcache = 1;
	}
	@blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$blocked,\%commblocks);
foreach my $block (@blockers) {	foreach my $block (@blockers) {
if ($block =~ /^firstaccess____(.+)$/) {	if ($block =~ /^firstaccess____(.+)$/) {
my $item = $1;	my $item = $1;
Line 4865 sub parse_block_record {	Line 4971 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 4886 sub blocking_status {	Line 4992 sub blocking_status {
$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 4935 sub check_ip_acc {	Line 5046 sub check_ip_acc {
return 1;	return 1;
}	}
my $allowed=0;	my $allowed=0;
my $ip=$ENV{'REMOTE_ADDR'} \|\| $clientip \|\| $env{'request.host'};	my $ip;
	if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') \|\|
	($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
	$ip = $env{'request.host'} \|\| $ENV{'REMOTE_ADDR'} \|\| $clientip;
	} else {
	$ip = $ENV{'REMOTE_ADDR'} \|\| $env{'request.host'} \|\| $clientip;
	}

my $name;	my $name;
foreach my $pattern (split(',',$acc)) {	foreach my $pattern (split(',',$acc)) {
Line 5120 sub get_legacy_domconf {	Line 5237 sub get_legacy_domconf {
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/'.$udom.'.tab';	my $designfile = $designdir.'/'.$udom.'.tab';
if (-e $designfile) {	if (-e $designfile) {
if ( open (my $fh,"<$designfile") ) {	if ( open (my $fh,'<',$designfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 5376 Inputs:	Line 5493 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 5401 sub bodytag {	Line 5522 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 5429 sub bodytag {	Line 5551 sub bodytag {
if ($env{'request.role'} !~ /^cr/) {	if ($env{'request.role'} !~ /^cr/) {
$role = &Apache::lonnet::plaintext($role,&course_type());	$role = &Apache::lonnet::plaintext($role,&course_type());
} elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {	} elsif ($role =~ m{^cr/($match_domain)/\1-domainconfig/(\w+)$}) {
$role = &mt('Helpdesk[_1]',' '.$2);	if ($env{'request.role.desc'}) {
	$role = $env{'request.role.desc'};
	} else {
	$role = &mt('Helpdesk[_1]',' '.$2);
	}
} else {	} else {
$role = (split(/\//,$role,4))[-1];	$role = (split(/\//,$role,4))[-1];
}	}
Line 5485 sub bodytag {	Line 5611 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 5531 sub bodytag {	Line 5657 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 6055 td.LC_menubuttons_text {	Line 6183 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 6645 table.LC_prior_tries td {	Line 6778 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 6727 table.LC_data_table tr > td.LC_docs_entr	Line 6861 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 7635 ul.LC_funclist li {	Line 7770 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 7656 span.roman {font-family: serif; font-sty	Line 7799 span.roman {font-family: serif; font-sty
span.overacc2 {position: relative; left: .8em; top: -1.2ex;}	span.overacc2 {position: relative; left: .8em; top: -1.2ex;}
span.overacc1 {position: relative; left: .6em; 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	END
}	}

Line 7761 ADDMETA	Line 7937 ADDMETA
my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};	my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {	unless (&Apache::lonnet::allowed('mau',$dom_in_use)) {
my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);	my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use);
	my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
	my $offload;
if (ref($domdefs{'offloadnow'}) eq 'HASH') {	if (ref($domdefs{'offloadnow'}) eq 'HASH') {
my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
if ($domdefs{'offloadnow'}{$lonhost}) {	if ($domdefs{'offloadnow'}{$lonhost}) {
my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);	$offload = 1;
if (($newserver) && ($newserver ne $lonhost)) {	}
my $numsec = 5;	}
my $timeout = $numsec * 1000;	unless ($offload) {
my ($newurl,$locknum,%locks,$msg);	if (ref($domdefs{'offloadoth'}) eq 'HASH') {
if ($env{'request.role.adv'}) {	if ($domdefs{'offloadoth'}{$lonhost}) {
($locknum,%locks) = &Apache::lonnet::get_locks();	if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) &&
}	(!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) {
my $disable_submit = 0;	unless (&Apache::lonnet::shared_institution($env{'user.domain'})) {
if ($requrl =~ /$LONCAPA::assess_re/) {	$offload = 1;
$disable_submit = 1;	$dom_in_use = $env{'user.domain'};
	}
}	}
if ($locknum) {	}
my @lockinfo = sort(values(%locks));	}
$msg = &mt('Once the following tasks are complete: ')."\\n".	}
join(", ",sort(values(%locks)))."\\n".	if ($offload) {
&mt('your session will be transferred to a different server, after you click "Roles".');	my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use);
	if (($newserver) && ($newserver ne $lonhost)) {
	my $numsec = 5;
	my $timeout = $numsec * 1000;
	my ($newurl,$locknum,%locks,$msg);
	if ($env{'request.role.adv'}) {
	($locknum,%locks) = &Apache::lonnet::get_locks();
	}
	my $disable_submit = 0;
	if ($requrl =~ /$LONCAPA::assess_re/) {
	$disable_submit = 1;
	}
	if ($locknum) {
	my @lockinfo = sort(values(%locks));
	$msg = &mt('Once the following tasks are complete: ')."\n".
	join(", ",sort(values(%locks)))."\n";
	if (&show_course()) {
	$msg .= &mt('your session will be transferred to a different server, after you click "Courses".');
} else {	} else {
if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) {	$msg .= &mt('your session will be transferred to a different server, after you click "Roles".');
$msg = &mt('Your LON-CAPA submission has been recorded')."\\n";	}
}	} else {
$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 7818 function LC_Offload_Now() {	Line 8036 function LC_Offload_Now() {
// ]]>	// ]]>
</script>	</script>
OFFLOAD	OFFLOAD
}
}	}
}	}
}	}
Line 7848 OFFLOAD	Line 8065 OFFLOAD
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">	<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=0, minimum-scale=1.0, maximum-scale=1.0">
<meta name="apple-mobile-web-app-capable" content="yes" />';	<meta name="apple-mobile-web-app-capable" content="yes" />';
}	}
	$result .= '<meta name="google" content="notranslate" />'."\n";
return $result.'</head>';	return $result.'</head>';
}	}

Line 8029 $args - additional optional args support	Line 8247 $args - additional optional args support
no_auto_mt_title -> prevent &mt()ing the title arg	no_auto_mt_title -> prevent &mt()ing the title arg
bread_crumbs -> Array containing breadcrumbs	bread_crumbs -> Array containing breadcrumbs
bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs	bread_crumbs_component -> if exists show it as headline else show only the breadcrumbs
	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	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 8094 sub start_page {	Line 8318 sub start_page {
if (@advtools > 0) {	if (@advtools > 0) {
&Apache::lonmenu::advtools_crumbs(@advtools);	&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 bread_crumbs_component exists show it as headline else show only the breadcrumbs
if(exists($args->{'bread_crumbs_component'})){	if(exists($args->{'bread_crumbs_component'})){
$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'});	$result .= &Apache::lonhtmlcommon::breadcrumbs($args->{'bread_crumbs_component'},'',$menulink);
}else{	}else{
$result .= &Apache::lonhtmlcommon::breadcrumbs();	$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
}	}
} elsif (($env{'environment.remote'} eq 'on') &&	} elsif (($env{'environment.remote'} eq 'on') &&
($env{'form.inhibitmenu'} ne 'yes') &&	($env{'form.inhibitmenu'} ne 'yes') &&
Line 8201 var modalWindow = {	Line 8431 var modalWindow = {
};	};
var openMyModal = function(source,width,height,scrolling,transparency,style)	var openMyModal = function(source,width,height,scrolling,transparency,style)
{	{
source = source.replace("'","'");	source = source.replace(/'/g,"'");
modalWindow.windowId = "myModal";	modalWindow.windowId = "myModal";
modalWindow.width = width;	modalWindow.width = width;
modalWindow.height = height;	modalWindow.height = height;
Line 8226 sub modal_link {	Line 8456 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 8330 sub end_togglebox {	Line 8559 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 8344 sub LCprogressbar_script {	Line 8574 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 8370 my $LCidcnt;	Line 8622 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 9517 sub get_secgrprole_info {	Line 9786 sub get_secgrprole_info {
}	}

sub user_picker {	sub user_picker {
my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom) = @_;	my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_;
my $currdom = $dom;	my $currdom = $dom;
my @alldoms = &Apache::lonnet::all_domains();	my @alldoms = &Apache::lonnet::all_domains();
if (@alldoms == 1) {	if (@alldoms == 1) {
Line 9582 sub user_picker {	Line 9851 sub user_picker {
&html_escape(\%html_lt);	&html_escape(\%html_lt);
&js_escape(\%js_lt);	&js_escape(\%js_lt);
my $domform;	my $domform;
	my $allow_blank = 1;
if ($fixeddom) {	if ($fixeddom) {
$domform = &select_dom_form($currdom,'srchdomain',1,1,undef,[$currdom]);	$allow_blank = 0;
	$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]);
} else {	} else {
$domform = &select_dom_form($currdom,'srchdomain',1,1);	$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1);
}	}
my $srchinsel = ' <select name="srchin">';	my $srchinsel = ' <select name="srchin">';

Line 9598 sub user_picker {	Line 9869 sub user_picker {
next if ($option eq 'alc');	next if ($option eq 'alc');
next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));	next if (($option eq 'crs') && ($env{'form.form'} eq 'requestcrs'));
next if ($option eq 'crs' && !$env{'request.course.id'});	next if ($option eq 'crs' && !$env{'request.course.id'});
	next if (($option eq 'instd') && ($noinstd));
if ($curr_selected{'srchin'} eq $option) {	if ($curr_selected{'srchin'} eq $option) {
$srchinsel .= '	$srchinsel .= '
<option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';	<option value="'.$option.'" selected="selected">'.$html_lt{$option}.'</option>';
Line 10095 sub get_institutional_codes {	Line 10367 sub get_institutional_codes {
foreach (@currxlists) {	foreach (@currxlists) {
if (m/^([^:]+):(\w*)$/) {	if (m/^([^:]+):(\w*)$/) {
unless (grep/^$1$/,@{$allcourses}) {	unless (grep/^$1$/,@{$allcourses}) {
push @{$allcourses},$1;	push(@{$allcourses},$1);
$$LC_code{$1} = $2;	$$LC_code{$1} = $2;
}	}
}	}
Line 10108 sub get_institutional_codes {	Line 10380 sub get_institutional_codes {
my $sec = $coursecode.$1;	my $sec = $coursecode.$1;
my $lc_sec = $2;	my $lc_sec = $2;
unless (grep/^$sec$/,@{$allcourses}) {	unless (grep/^$sec$/,@{$allcourses}) {
push @{$allcourses},$sec;	push(@{$allcourses},$sec);
$$LC_code{$sec} = $lc_sec;	$$LC_code{$sec} = $lc_sec;
}	}
}	}
Line 11359 sub modify_html_refs {	Line 11631 sub modify_html_refs {
return;	return;
}	}
}	}
if (open(my $fh,"<$container")) {	if (open(my $fh,'<',$container)) {
$content = join('', <$fh>);	$content = join('', <$fh>);
close($fh);	close($fh);
} else {	} else {
Line 11424 sub modify_html_refs {	Line 11696 sub modify_html_refs {
}	}
}	}
} else {	} else {
if (open(my $fh,">$container")) {	if (open(my $fh,'>',$container)) {
print $fh $content;	print $fh $content;
close($fh);	close($fh);
$output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',	$output = '<p>'.&mt('Updated [quant,_1,reference] in [_2].',
Line 11941 sub decompress_uploaded_file {	Line 12213 sub decompress_uploaded_file {

sub process_decompression {	sub process_decompression {
my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;	my ($docudom,$docuname,$file,$destination,$dir_root,$hiddenelem) = @_;
	unless (($dir_root eq '/userfiles') && ($destination =~ m{^(docs\|supplemental)/(default\|\d+)/\d+$})) {
	return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
	&mt('Unexpected file path.').'</p>'."\n";
	}
	unless (($docudom =~ /^$match_domain$/) && ($docuname =~ /^$match_courseid$/)) {
	return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
	&mt('Unexpected course context.').'</p>'."\n";
	}
	unless ($file eq &Apache::lonnet::clean_filename($file)) {
	return '<p class="LC_error">'.&mt('Not extracted.').'<br />'.
	&mt('Filename contained unexpected characters.').'</p>'."\n";
	}
my ($dir,$error,$warning,$output);	my ($dir,$error,$warning,$output);
if ($file !~ /\.(zip\|tar\|bz2\|gz\|tar.gz\|tar.bz2\|tgz)$/i) {	if ($file !~ /\.(zip\|tar\|bz2\|gz\|tar.gz\|tar.bz2\|tgz)$/i) {
$error = &mt('Filename not a supported archive file type.').	$error = &mt('Filename not a supported archive file type.').
Line 11975 sub process_decompression {	Line 12259 sub process_decompression {
}	}
}	}
my $numskip = scalar(@to_skip);	my $numskip = scalar(@to_skip);
if (($numskip > 0) &&	my $numoverwrite = scalar(@to_overwrite);
($numskip == $env{'form.archive_itemcount'})) {	if (($numskip) && (!$numoverwrite)) {
$warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');	$warning = &mt('All items in the archive file already exist, and no overwriting of existing files has been requested.');
} elsif ($dir eq '') {	} elsif ($dir eq '') {
$error = &mt('Directory containing archive file unavailable.');	$error = &mt('Directory containing archive file unavailable.');
} elsif (!$error) {	} elsif (!$error) {
my ($decompressed,$display);	my ($decompressed,$display);
if ($numskip > 0) {	if (($numskip) \|\| ($numoverwrite)) {
my $tempdir = time.'_'.$$.int(rand(10000));	my $tempdir = time.'_'.$$.int(rand(10000));
mkdir("$dir/$tempdir",0755);	mkdir("$dir/$tempdir",0755);
system("mv $dir/$file $dir/$tempdir/$file");	if (&File::Copy::move("$dir/$file","$dir/$tempdir/$file")) {
($decompressed,$display) =	($decompressed,$display) =
&decompress_uploaded_file($file,"$dir/$tempdir");	&decompress_uploaded_file($file,"$dir/$tempdir");
foreach my $item (@to_skip) {	foreach my $item (@to_skip) {
if (($item ne '') && ($item !~ /\.\./)) {	if (($item ne '') && ($item !~ /\.\./)) {
if (-f "$dir/$tempdir/$item") {	if (-f "$dir/$tempdir/$item") {
unlink("$dir/$tempdir/$item");	unlink("$dir/$tempdir/$item");
} elsif (-d "$dir/$tempdir/$item") {	} elsif (-d "$dir/$tempdir/$item") {
system("rm -rf $dir/$tempdir/$item");	&File::Path::remove_tree("$dir/$tempdir/$item",{ safe => 1 });
	}
	}
	}
	foreach my $item (@to_overwrite) {
	if ((-e "$dir/$tempdir/$item") && (-e "$dir/$item")) {
	if (($item ne '') && ($item !~ /\.\./)) {
	if (-f "$dir/$item") {
	unlink("$dir/$item");
	} elsif (-d "$dir/$item") {
	&File::Path::remove_tree("$dir/$item",{ safe => 1 });
	}
	&File::Copy::move("$dir/$tempdir/$item","$dir/$item");
	}
}	}
}	}
	if (&File::Copy::move("$dir/$tempdir/$file","$dir/$file")) {
	&File::Path::remove_tree("$dir/$tempdir",{ safe => 1 });
	}
}	}
system("mv $dir/$tempdir/* $dir");
rmdir("$dir/$tempdir");
} else {	} else {
($decompressed,$display) =	($decompressed,$display) =
&decompress_uploaded_file($file,$dir);	&decompress_uploaded_file($file,$dir);
Line 12016 sub process_decompression {	Line 12314 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 12502 END	Line 12799 END
sub process_extracted_files {	sub process_extracted_files {
my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;	my ($context,$docudom,$docuname,$destination,$dir_root,$hiddenelem) = @_;
my $numitems = $env{'form.archive_count'};	my $numitems = $env{'form.archive_count'};
return unless ($numitems);	return if ((!$numitems) \|\| ($numitems =~ /\D/));
my @ids=&Apache::lonnet::current_machine_ids();	my @ids=&Apache::lonnet::current_machine_ids();
my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,	my ($prefix,$pathtocheck,$dir,$ishome,$error,$warning,%toplevelitems,%is_dir,
%folders,%containers,%mapinner,%prompttofetch);	%folders,%containers,%mapinner,%prompttofetch);
Line 12515 sub process_extracted_files {	Line 12812 sub process_extracted_files {
} else {	} else {
$prefix = $Apache::lonnet::perlvar{'lonDocRoot'};	$prefix = $Apache::lonnet::perlvar{'lonDocRoot'};
$pathtocheck = "$dir_root/$docudom/$docuname/$destination";	$pathtocheck = "$dir_root/$docudom/$docuname/$destination";
$dir = "$dir_root/$docudom/$docuname";	$dir = "$dir_root/$docudom/$docuname";
}	}
my $currdir = "$dir_root/$destination";	my $currdir = "$dir_root/$destination";
(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs\|supplemental)/(\w+)/});	(my $docstype,$mapinner{'0'}) = ($destination =~ m{^(docs\|supplemental)/(\w+)/});
Line 12604 sub process_extracted_files {	Line 12901 sub process_extracted_files {
'.'.$containers{$outer},1,1);	'.'.$containers{$outer},1,1);
$newseqid{$i} = $newidx;	$newseqid{$i} = $newidx;
unless ($errtext) {	unless ($errtext) {
$result .= '<li>'.&mt('Folder: [_1] added to course',$docstitle).'</li>'."\n";	$result .= '<li>'.&mt('Folder: [_1] added to course',
	&HTML::Entities::encode($docstitle,'<>&"'))..
	'</li>'."\n";
}	}
}	}
} else {	} else {
Line 12613 sub process_extracted_files {	Line 12912 sub process_extracted_files {
my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.	my $url = '/uploaded/'.$docudom.'/'.$docuname.'/'.
$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.	$docstype.'/'.$mapinner{$outer}.'/'.$newidx.'/'.
$title;	$title;
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {	if (($outer !~ /\D/) && ($mapinner{$outer} !~ /\D/) && ($newidx !~ /\D/)) {
mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);	if (!-e "$prefix$dir/$docstype/$mapinner{$outer}") {
}	mkdir("$prefix$dir/$docstype/$mapinner{$outer}",0755);
if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
}
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
system("mv $prefix$path $prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title");
$newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
unless ($ishome) {
my $fetch = "$newdest{$i}/$title";
$fetch =~ s/^\Q$prefix$dir\E//;
$prompttofetch{$fetch} = 1;
}	}
}	if (!-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
$LONCAPA::map::resources[$newidx]=	mkdir("$prefix$dir/$docstype/$mapinner{$outer}/$newidx");
$docstitle.':'.$url.':false:normal:res';
push(@LONCAPA::map::order, $newidx);
my ($outtext,$errtext)=
&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
$docuname.'/'.$folders{$outer}.
'.'.$containers{$outer},1,1);
unless ($errtext) {
if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
$result .= '<li>'.&mt('File: [_1] added to course',$docstitle).'</li>'."\n";
}	}
	if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx") {
	if (rename("$prefix$path","$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title")) {
	$newdest{$i} = "$prefix$dir/$docstype/$mapinner{$outer}/$newidx";
	unless ($ishome) {
	my $fetch = "$newdest{$i}/$title";
	$fetch =~ s/^\Q$prefix$dir\E//;
	$prompttofetch{$fetch} = 1;
	}
	}
	}
	$LONCAPA::map::resources[$newidx]=
	$docstitle.':'.$url.':false:normal:res';
	push(@LONCAPA::map::order, $newidx);
	my ($outtext,$errtext)=
	&LONCAPA::map::storemap('/uploaded/'.$docudom.'/'.
	$docuname.'/'.$folders{$outer}.
	'.'.$containers{$outer},1,1);
	unless ($errtext) {
	if (-e "$prefix$dir/$docstype/$mapinner{$outer}/$newidx/$title") {
	$result .= '<li>'.&mt('File: [_1] added to course',
	&HTML::Entities::encode($docstitle,'<>&"')).
	'</li>'."\n";
	}
	}
	} else {
	$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
	&HTML::Entities::encode($path,'<>&"')).'<br />';
}	}
}	}
}	}
}	}
} else {	} else {
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';	$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
	&HTML::Entities::encode($path,'<>&"')).'<br />';
}	}
}	}
for (my $i=1; $i<=$numitems; $i++) {	for (my $i=1; $i<=$numitems; $i++) {
Line 12705 sub process_extracted_files {	Line 13013 sub process_extracted_files {
}	}
if ($fullpath ne '') {	if ($fullpath ne '') {
if (-e "$prefix$path") {	if (-e "$prefix$path") {
system("mv $prefix$path $fullpath/$title");	unless (rename("$prefix$path","$fullpath/$title")) {
	$warning .= &mt('Failed to rename dependency').'<br />';
	}
}	}
if (-e "$fullpath/$title") {	if (-e "$fullpath/$title") {
my $showpath;	my $showpath;
Line 12714 sub process_extracted_files {	Line 13024 sub process_extracted_files {
} else {	} else {
$showpath = "/$title";	$showpath = "/$title";
}	}
$result .= '<li>'.&mt('[_1] included as a dependency',$showpath).'</li>'."\n";	$result .= '<li>'.&mt('[_1] included as a dependency',
}	&HTML::Entities::encode($showpath,'<>&"')).
unless ($ishome) {	'</li>'."\n";
my $fetch = "$fullpath/$title";	unless ($ishome) {
$fetch =~ s/^\Q$prefix$dir\E//;	my $fetch = "$fullpath/$title";
$prompttofetch{$fetch} = 1;	$fetch =~ s/^\Q$prefix$dir\E//;
	$prompttofetch{$fetch} = 1;
	}
}	}
}	}
}	}
} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {	} elsif ($env{'form.archive_'.$referrer{$i}} eq 'discard') {
$warning .= &mt('[_1] is a dependency of [_2], which was discarded.',	$warning .= &mt('[_1] is a dependency of [_2], which was discarded.',
$path,$env{'form.archive_content_'.$referrer{$i}}).'<br />';	&HTML::Entities::encode($path,'<>&"'),
	&HTML::Entities::encode($env{'form.archive_content_'.$referrer{$i}},'<>&"')).
	'<br />';
}	}
} else {	} else {
$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',$path).'<br />';	$warning .= &mt('Item extracted from archive: [_1] has unexpected path.',
	&HTML::Entities::encode($path)).'<br />';
}	}
}	}
if (keys(%todelete)) {	if (keys(%todelete)) {
Line 13002 sub upfile_store {	Line 13317 sub upfile_store {
$env{'form.upfile'}=~s/\n+/\n/gs;	$env{'form.upfile'}=~s/\n+/\n/gs;
$env{'form.upfile'}=~s/\n+$//gs;	$env{'form.upfile'}=~s/\n+$//gs;

my $datatoken=$env{'user.name'}.'_'.$env{'user.domain'}.	my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
'_enroll_'.$env{'request.course.id'}.'_'.time.'_'.$$;	'_enroll_'.$env{'request.course.id'}.'_'.
	time.'_'.$$);
	return if ($datatoken eq '');

{	{
my $datafile = $r->dir_config('lonDaemons').	my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';	'/tmp/'.$datatoken.'.tmp';
if ( open(my $fh,">$datafile") ) {	if ( open(my $fh,'>',$datafile) ) {
print $fh $env{'form.upfile'};	print $fh $env{'form.upfile'};
close($fh);	close($fh);
}	}
Line 13017 sub upfile_store {	Line 13335 sub upfile_store {

=pod	=pod

=item * &load_tmp_file($r)	=item * &load_tmp_file($r,$datatoken)

Load uploaded file from tmp, $r should be the HTTP Request object,	Load uploaded file from tmp, $r should be the HTTP Request object,
needs $env{'form.datatoken'},	$datatoken is the name to assign to the temporary file.
sets $env{'form.upfile'} to the contents of the file	sets $env{'form.upfile'} to the contents of the file

=cut	=cut

sub load_tmp_file {	sub load_tmp_file {
my $r=shift;	my ($r,$datatoken) = @_;
	return if ($datatoken eq '');
my @studentdata=();	my @studentdata=();
{	{
my $studentfile = $r->dir_config('lonDaemons').	my $studentfile = $r->dir_config('lonDaemons').
'/tmp/'.$env{'form.datatoken'}.'.tmp';	'/tmp/'.$datatoken.'.tmp';
if ( open(my $fh,"<$studentfile") ) {	if ( open(my $fh,'<',$studentfile) ) {
@studentdata=<$fh>;	@studentdata=<$fh>;
close($fh);	close($fh);
}	}
Line 13039 sub load_tmp_file {	Line 13358 sub load_tmp_file {
$env{'form.upfile'}=join('',@studentdata);	$env{'form.upfile'}=join('',@studentdata);
}	}

	sub valid_datatoken {
	my ($datatoken) = @_;
	if ($datatoken =~ /^$match_username\_$match_domain\_enroll_(\|$match_domain\_$match_courseid)\_\d+_\d+$/) {
	return $datatoken;
	}
	return;
	}

=pod	=pod

=item * &upfile_record_sep()	=item * &upfile_record_sep()
Line 13479 sub DrawBarGraph {	Line 13806 sub DrawBarGraph {
@Labels = @$labels;	@Labels = @$labels;
} else {	} else {
for (my $i=0;$i<@{$Values[0]};$i++) {	for (my $i=0;$i<@{$Values[0]};$i++) {
push (@Labels,$i+1);	push(@Labels,$i+1);
}	}
}	}
#	#
Line 13927 defdom (domain for which to retrieve con	Line 14254 defdom (domain for which to retrieve con
origmail (scalar - email address of recipient from loncapa.conf,	origmail (scalar - email address of recipient from loncapa.conf,
i.e., predates configuration by DC via domainprefs.pm	i.e., predates configuration by DC via domainprefs.pm

	$requname username of requester (if mailing type is helpdeskmail)

	$requdom domain of requester (if mailing type is helpdeskmail)

	$reqemail e-mail address of requester (if mailing type is helpdeskmail)

Returns: comma separated list of addresses to which to send e-mail.	Returns: comma separated list of addresses to which to send e-mail.

=back	=back
Line 13936 Returns: comma separated list of address	Line 14269 Returns: comma separated list of address
############################################################	############################################################
############################################################	############################################################
sub build_recipient_list {	sub build_recipient_list {
my ($defmail,$mailing,$defdom,$origmail) = @_;	my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
my @recipients;	my @recipients;
my $otheremails;	my ($otheremails,$lastresort,$allbcc,$addtext);
my %domconfig =	my %domconfig =
&Apache::lonnet::get_dom('configuration',['contacts'],$defdom);	&Apache::lonnet::get_dom('configuration',['contacts'],$defdom);
if (ref($domconfig{'contacts'}) eq 'HASH') {	if (ref($domconfig{'contacts'}) eq 'HASH') {
if (exists($domconfig{'contacts'}{$mailing})) {	if (exists($domconfig{'contacts'}{$mailing})) {
if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {	if (ref($domconfig{'contacts'}{$mailing}) eq 'HASH') {
Line 13952 sub build_recipient_list {	Line 14285 sub build_recipient_list {
push(@recipients,$addr);	push(@recipients,$addr);
}	}
}	}
$otheremails = $domconfig{'contacts'}{$mailing}{'others'};	}
	$otheremails = $domconfig{'contacts'}{$mailing}{'others'};
	if ($mailing eq 'helpdeskmail') {
	if ($domconfig{'contacts'}{$mailing}{'bcc'}) {
	my @bccs = split(/,/,$domconfig{'contacts'}{$mailing}{'bcc'});
	my @ok_bccs;
	foreach my $bcc (@bccs) {
	$bcc =~ s/^\s+//g;
	$bcc =~ s/\s+$//g;
	if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
	if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
	push(@ok_bccs,$bcc);
	}
	}
	}
	if (@ok_bccs > 0) {
	$allbcc = join(', ',@ok_bccs);
	}
	}
	$addtext = $domconfig{'contacts'}{$mailing}{'include'};
}	}
}	}
} elsif ($origmail ne '') {	} elsif ($origmail ne '') {
push(@recipients,$origmail);	$lastresort = $origmail;
	}
	if ($mailing eq 'helpdeskmail') {
	if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&
	(keys(%{$domconfig{'contacts'}{'overrides'}}))) {
	my ($inststatus,$inststatus_checked);
	if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&
	($env{'user.domain'} ne 'public')) {
	$inststatus_checked = 1;
	$inststatus = $env{'environment.inststatus'};
	}
	unless ($inststatus_checked) {
	if (($requname ne '') && ($requdom ne '')) {
	if (($requname =~ /^$match_username$/) &&
	($requdom =~ /^$match_domain$/) &&
	(&Apache::lonnet::domain($requdom))) {
	my $requhome = &Apache::lonnet::homeserver($requname,
	$requdom);
	unless ($requhome eq 'no_host') {
	my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');
	$inststatus = $userenv{'inststatus'};
	$inststatus_checked = 1;
	}
	}
	}
	}
	unless ($inststatus_checked) {
	if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {
	my %srch = (srchby => 'email',
	srchdomain => $defdom,
	srchterm => $reqemail,
	srchtype => 'exact');
	my %srch_results = &Apache::lonnet::usersearch(\%srch);
	foreach my $uname (keys(%srch_results)) {
	if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
	$inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
	$inststatus_checked = 1;
	last;
	}
	}
	unless ($inststatus_checked) {
	my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);
	if ($dirsrchres eq 'ok') {
	foreach my $uname (keys(%srch_results)) {
	if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {
	$inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});
	$inststatus_checked = 1;
	last;
	}
	}
	}
	}
	}
	}
	if ($inststatus ne '') {
	foreach my $status (split(/\:/,$inststatus)) {
	if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {
	my @contacts = ('adminemail','supportemail');
	foreach my $item (@contacts) {
	if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {
	my $addr = $domconfig{'contacts'}{'overrides'}{$status};
	if (!grep(/^\Q$addr\E$/,@recipients)) {
	push(@recipients,$addr);
	}
	}
	}
	$otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};
	if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {
	my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});
	my @ok_bccs;
	foreach my $bcc (@bccs) {
	$bcc =~ s/^\s+//g;
	$bcc =~ s/\s+$//g;
	if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
	if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
	push(@ok_bccs,$bcc);
	}
	}
	}
	if (@ok_bccs > 0) {
	$allbcc = join(', ',@ok_bccs);
	}
	}
	$addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};
	last;
	}
	}
	}
	}
}	}
} elsif ($origmail ne '') {	} elsif ($origmail ne '') {
push(@recipients,$origmail);	$lastresort = $origmail;
	}
	if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {
	unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
	my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
	my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
	my %what = (
	perlvar => 1,
	);
	my $primary = &Apache::lonnet::domain($defdom,'primary');
	if ($primary) {
	my $gotaddr;
	my ($result,$returnhash) =
	&Apache::lonnet::get_remote_globals($primary,{ perlvar => 1 });
	if (($result eq 'ok') && (ref($returnhash) eq 'HASH')) {
	if ($returnhash->{'lonSupportEMail'} =~ /^[^\@]+\@[^\@]+$/) {
	$lastresort = $returnhash->{'lonSupportEMail'};
	$gotaddr = 1;
	}
	}
	unless ($gotaddr) {
	my $uintdom = &Apache::lonnet::internet_dom($primary);
	my $intdom = &Apache::lonnet::internet_dom($lonhost);
	unless ($uintdom eq $intdom) {
	my %domconfig =
	&Apache::lonnet::get_dom('configuration',['contacts'],$machinedom);
	if (ref($domconfig{'contacts'}) eq 'HASH') {
	if (ref($domconfig{'contacts'}{'otherdomsmail'}) eq 'HASH') {
	my @contacts = ('adminemail','supportemail');
	foreach my $item (@contacts) {
	if ($domconfig{'contacts'}{'otherdomsmail'}{$item}) {
	my $addr = $domconfig{'contacts'}{$item};
	if (!grep(/^\Q$addr\E$/,@recipients)) {
	push(@recipients,$addr);
	}
	}
	}
	if ($domconfig{'contacts'}{'otherdomsmail'}{'others'}) {
	$otheremails = $domconfig{'contacts'}{'otherdomsmail'}{'others'};
	}
	if ($domconfig{'contacts'}{'otherdomsmail'}{'bcc'}) {
	my @bccs = split(/,/,$domconfig{'contacts'}{'otherdomsmail'}{'bcc'});
	my @ok_bccs;
	foreach my $bcc (@bccs) {
	$bcc =~ s/^\s+//g;
	$bcc =~ s/\s+$//g;
	if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {
	if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {
	push(@ok_bccs,$bcc);
	}
	}
	}
	if (@ok_bccs > 0) {
	$allbcc = join(', ',@ok_bccs);
	}
	}
	$addtext = $domconfig{'contacts'}{'otherdomsmail'}{'include'};
	}
	}
	}
	}
	}
	}
}	}
if (defined($defmail)) {	if (defined($defmail)) {
if ($defmail ne '') {	if ($defmail ne '') {
Line 13979 sub build_recipient_list {	Line 14481 sub build_recipient_list {
}	}
}	}
}	}
my $recipientlist = join(',',@recipients);	if ($mailing eq 'helpdeskmail') {
return $recipientlist;	if ((!@recipients) && ($lastresort ne '')) {
	push(@recipients,$lastresort);
	}
	} elsif ($lastresort ne '') {
	if (!grep(/^\Q$lastresort\E$/,@recipients)) {
	push(@recipients,$lastresort);
	}
	}
	my $recipientlist = join(',',@recipients);
	if (wantarray) {
	return ($recipientlist,$allbcc,$addtext);
	} else {
	return $recipientlist;
	}
}	}

############################################################	############################################################
Line 14071 jsarray (reference to array of categorie	Line 14586 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 14078 Side effects: populates trails and allit	Line 14595 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 14104 sub extract_categories {	Line 14621 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 14147 Side effects: populates trails and allit	Line 14667 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 14174 sub recurse_categories {	Line 14694 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 14204 currcat - scalar with an & separated lis	Line 14729 currcat - scalar with an & separated lis

type - scalar contains course type (Course or Community).	type - scalar contains course type (Course or Community).

	disabled - scalar (optional) contains disabled="disabled" if input elements are
	to be readonly (e.g., Domain Helpdesk role viewing course settings).

Returns: $output (markup to be displayed)	Returns: $output (markup to be displayed)

=cut	=cut

sub assign_categories_table {	sub assign_categories_table {
my ($cathash,$currcat,$type) = @_;	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 14245 sub assign_categories_table {	Line 14773 sub assign_categories_table {
}	}
$table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.	$table .= '<tr '.$css_class.'><td><span class="LC_nobreak">'.
'<input type="checkbox" name="usecategory" value="'.	'<input type="checkbox" name="usecategory" value="'.
$item.'"'.$checked.' />'.$parent_title.'</span>'.	$item.'"'.$checked.$disabled.' />'.$parent_title.'</span>'.
'<input type="hidden" name="catname" value="'.$parent.'" /></td>';	'<input type="hidden" name="catname" value="'.$parent.'" /></td>';
my $depth = 1;	my $depth = 1;
push(@path,$parent);	push(@path,$parent);
$table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories);	$table .= &assign_category_rows($itemcount,\@cats,$depth,$parent,\@path,\@currcategories,$disabled);
pop(@path);	pop(@path);
$table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';	$table .= '</tr><tr><td colspan="'.$maxdepth.'" class="LC_row_separator"></td></tr>';
$itemcount ++;	$itemcount ++;
Line 14288 path - Array containing all categories b	Line 14816 path - Array containing all categories b

currcategories - reference to array of current categories assigned to the course	currcategories - reference to array of current categories assigned to the course

	disabled - scalar (optional) contains disabled="disabled" if input elements are
	to be readonly (e.g., Domain Helpdesk role viewing course settings).

Returns: $output (markup to be displayed).	Returns: $output (markup to be displayed).

=cut	=cut

sub assign_category_rows {	sub assign_category_rows {
my ($itemcount,$cats,$depth,$parent,$path,$currcategories) = @_;	my ($itemcount,$cats,$depth,$parent,$path,$currcategories,$disabled) = @_;
my ($text,$name,$item,$chgstr);	my ($text,$name,$item,$chgstr);
if (ref($cats) eq 'ARRAY') {	if (ref($cats) eq 'ARRAY') {
my $maxdepth = scalar(@{$cats});	my $maxdepth = scalar(@{$cats});
Line 14316 sub assign_category_rows {	Line 14847 sub assign_category_rows {
}	}
$text .= '<tr><td><span class="LC_nobreak"><label>'.	$text .= '<tr><td><span class="LC_nobreak"><label>'.
'<input type="checkbox" name="usecategory" value="'.	'<input type="checkbox" name="usecategory" value="'.
$item.'"'.$checked.' />'.$name.'</label></span>'.	$item.'"'.$checked.$disabled.' />'.$name.'</label></span>'.
'<input type="hidden" name="catname" value="'.$name.'" />'.	'<input type="hidden" name="catname" value="'.$name.'" />'.
'</td><td>';	'</td><td>';
if (ref($path) eq 'ARRAY') {	if (ref($path) eq 'ARRAY') {
push(@{$path},$name);	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});	pop(@{$path});
}	}
$text .= '</td></tr>';	$text .= '</td></tr>';
Line 14552 sub check_clone {	Line 15083 sub check_clone {
return ($can_clone, $clonemsg, $cloneid, $clonehome);	return ($can_clone, $clonemsg, $cloneid, $clonehome);
}	}
}	}
if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&	if (($env{'request.role.domain'} eq $args->{'clonedomain'}) &&
(&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {	(&Apache::lonnet::allowed('ccc',$env{'request.role.domain'}))) {
$can_clone = 1;	$can_clone = 1;
} else {	} else {
Line 14649 sub check_clone {	Line 15180 sub check_clone {
}	}

sub construct_course {	sub construct_course {
my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,$cnum,$category,$coderef) = @_;	my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context,
	$cnum,$category,$coderef) = @_;
my $outcome;	my $outcome;
my $linefeed = '<br />'."\n";	my $linefeed = '<br />'."\n";
if ($context eq 'auto') {	if ($context eq 'auto') {
Line 14797 sub construct_course {	Line 15329 sub construct_course {
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});	my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$class,$cenv{'internal.courseowner'});
$cenv{'internal.sectionnums'} .= $item.',';	$cenv{'internal.sectionnums'} .= $item.',';
unless ($addcheck eq 'ok') {	unless ($addcheck eq 'ok') {
push @badclasses, $class;	push(@badclasses,$class);
}	}
}	}
$cenv{'internal.sectionnums'} =~ s/,$//;	$cenv{'internal.sectionnums'} =~ s/,$//;
Line 14825 sub construct_course {	Line 15357 sub construct_course {
my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});	my $addcheck = &Apache::lonnet::auto_new_course($$crsunum,$$crsudom,$xl,$cenv{'internal.courseowner'});
$cenv{'internal.crosslistings'} .= $item.',';	$cenv{'internal.crosslistings'} .= $item.',';
unless ($addcheck eq 'ok') {	unless ($addcheck eq 'ok') {
push @badclasses, $xl;	push(@badclasses,$xl);
}	}
}	}
$cenv{'internal.crosslistings'} =~ s/,$//;	$cenv{'internal.crosslistings'} =~ s/,$//;
Line 14860 sub construct_course {	Line 15392 sub construct_course {
}	}
if (@badclasses > 0) {	if (@badclasses > 0) {
my %lt=&Apache::lonlocal::texthash(	my %lt=&Apache::lonlocal::texthash(
'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course. However, if automated course roster updates are enabled for this class, these particular sections/crosslistings will not contribute towards enrollment, because the user identified as the course owner for this LON-CAPA course',	'tclb' => 'The courses listed below were included as sections or crosslistings affiliated with your new LON-CAPA course.',
'dnhr' => 'does not have rights to access enrollment in these classes',	'howi' => 'However, if automated course roster updates are enabled for this class, these particular sections/crosslistings are not guaranteed to contribute towards enrollment.',
'adby' => 'as determined by the policies of your institution on access to official classlists'	'itis' => 'It is possible that rights to access enrollment for these classes will be available through assignment of co-owners.',
);	);
my $badclass_msg = $cenv{'internal.courseowner'}.') - '.$lt{'dnhr'}.	my $badclass_msg = $lt{'tclb'}.$linefeed.$lt{'howi'}.$linefeed.
' ('.$lt{'adby'}.')';	&mt('That is because the user identified as the course owner ([_1]) does not have rights to access enrollment in these classes, as determined by the policies of your institution on access to official classlists',$cenv{'internal.courseowner'}).$linefeed.$lt{'itis'};
if ($context eq 'auto') {	if ($context eq 'auto') {
$outcome .= $badclass_msg.$linefeed;	$outcome .= $badclass_msg.$linefeed;
	} else {
$outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";	$outcome .= '<div class="LC_warning">'.$badclass_msg.$linefeed.'<ul>'."\n";
foreach my $item (@badclasses) {	}
if ($context eq 'auto') {	foreach my $item (@badclasses) {
$outcome .= " - $item\n";
} else {
$outcome .= "<li>$item</li>\n";
}
}
if ($context eq 'auto') {	if ($context eq 'auto') {
$outcome .= $linefeed;	$outcome .= " - $item\n";
} else {	} else {
$outcome .= "</ul><br /><br /></div>\n";	$outcome .= "<li>$item</li>\n";
}	}
}	}
	if ($context eq 'auto') {
	$outcome .= $linefeed;
	} else {
	$outcome .= "</ul><br /><br /></div>\n";
	}
}	}
if ($args->{'no_end_date'}) {	if ($args->{'no_end_date'}) {
$args->{'endaccess'} = 0;	$args->{'endaccess'} = 0;
Line 14987 sub construct_course {	Line 15520 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 15226 sub init_user_environment {	Line 15764 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 15314 sub init_user_environment {	Line 15868 sub init_user_environment {
$env{'user.noloadbalance'} = $lonhost;	$env{'user.noloadbalance'} = $lonhost;
}	}

my %is_adv = ( is_adv => $env{'user.adv'} );	if ($form->{'noloadbalance'}) {
my %domdef;	my @hosts = &Apache::lonnet::current_machine_ids();
unless ($domain eq 'public') {	my $hosthere = $form->{'noloadbalance'};
%domdef = &Apache::lonnet::get_domain_defaults($domain);	if (grep(/^\Q$hosthere\E$/,@hosts)) {
	$initial_env{"user.noloadbalance"} = $hosthere;
	$env{'user.noloadbalance'} = $hosthere;
	}
}	}

foreach my $tool ('aboutme','blog','webdav','portfolio') {	unless ($domain eq 'public') {
$userenv{'availabletools.'.$tool} =	my %is_adv = ( is_adv => $env{'user.adv'} );
&Apache::lonnet::usertools_access($username,$domain,$tool,'reload',	my %domdef = &Apache::lonnet::get_domain_defaults($domain);
undef,\%userenv,\%domdef,\%is_adv);
}

foreach my $crstype ('official','unofficial','community','textbook') {	foreach my $tool ('aboutme','blog','webdav','portfolio') {
$userenv{'canrequest.'.$crstype} =	$userenv{'availabletools.'.$tool} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,	&Apache::lonnet::usertools_access($username,$domain,$tool,'reload',
'reload','requestcourses',	undef,\%userenv,\%domdef,\%is_adv);
\%userenv,\%domdef,\%is_adv);	}
}
	foreach my $crstype ('official','unofficial','community','textbook') {
	$userenv{'canrequest.'.$crstype} =
	&Apache::lonnet::usertools_access($username,$domain,$crstype,
	'reload','requestcourses',
	\%userenv,\%domdef,\%is_adv);
	}

$userenv{'canrequest.author'} =	$userenv{'canrequest.author'} =
&Apache::lonnet::usertools_access($username,$domain,'requestauthor',	&Apache::lonnet::usertools_access($username,$domain,'requestauthor',
'reload','requestauthor',	'reload','requestauthor',
\%userenv,\%domdef,\%is_adv);	\%userenv,\%domdef,\%is_adv);
my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],	my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
$domain,$username);	$domain,$username);
my $reqstatus = $reqauthor{'author_status'};	my $reqstatus = $reqauthor{'author_status'};
if ($reqstatus eq 'approval' \|\| $reqstatus eq 'approved') {	if ($reqstatus eq 'approval' \|\| $reqstatus eq 'approved') {
if (ref($reqauthor{'author'}) eq 'HASH') {	if (ref($reqauthor{'author'}) eq 'HASH') {
$userenv{'requestauthorqueued'} = $reqstatus.':'.	$userenv{'requestauthorqueued'} = $reqstatus.':'.
$reqauthor{'author'}{'timestamp'};	$reqauthor{'author'}{'timestamp'};
	}
}	}
}	}

Line 15951 sub search_courses {	Line 16513 sub search_courses {
if (ref($courses{$cid}) eq 'HASH') {	if (ref($courses{$cid}) eq 'HASH') {
if (ref($courses{$cid}{roles}) eq 'ARRAY') {	if (ref($courses{$cid}{roles}) eq 'ARRAY') {
if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {	if (!grep(/^\Q$courserole\E$/,@{$courses{$cid}{roles}})) {
push (@{$courses{$cid}{roles}},$courserole);	push(@{$courses{$cid}{roles}},$courserole);
}	}
} else {	} else {
$courses{$cid}{roles} = [$courserole];	$courses{$cid}{roles} = [$courserole];
Line 16281 sub recurse_supplemental {	Line 16843 sub recurse_supplemental {
}	}

sub symb_to_docspath {	sub symb_to_docspath {
my ($symb) = @_;	my ($symb,$navmapref) = @_;
return unless ($symb);	return unless ($symb && ref($navmapref));
my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);	my ($mapurl,$id,$resurl) = &Apache::lonnet::decode_symb($symb);
if ($resurl=~/\.(sequence\|page)$/) {	if ($resurl=~/\.(sequence\|page)$/) {
$mapurl=$resurl;	$mapurl=$resurl;
Line 16290 sub symb_to_docspath {	Line 16852 sub symb_to_docspath {
$mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};	$mapurl=$env{'course.'.$env{'request.course.id'}.'.url'};
}	}
my $mapresobj;	my $mapresobj;
my $navmap = Apache::lonnavmaps::navmap->new();	unless (ref($$navmapref)) {
if (ref($navmap)) {	$$navmapref = Apache::lonnavmaps::navmap->new();
$mapresobj = $navmap->getResourceByUrl($mapurl);	}
	if (ref($$navmapref)) {
	$mapresobj = $$navmapref->getResourceByUrl($mapurl);
}	}
$mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};	$mapurl=~s{^.*/([^/]+)\.(\w+)$}{$1};
my $type=$2;	my $type=$2;
Line 16302 sub symb_to_docspath {	Line 16866 sub symb_to_docspath {
if ($pcslist ne '') {	if ($pcslist ne '') {
foreach my $pc (split(/,/,$pcslist)) {	foreach my $pc (split(/,/,$pcslist)) {
next if ($pc <= 1);	next if ($pc <= 1);
my $res = $navmap->getByMapPc($pc);	my $res = $$navmapref->getByMapPc($pc);
if (ref($res)) {	if (ref($res)) {
my $thisurl = $res->src();	my $thisurl = $res->src();
$thisurl=~s{^.*/([^/]+)\.\w+$}{$1};	$thisurl=~s{^.*/([^/]+)\.\w+$}{$1};
Line 16349 sub symb_to_docspath {	Line 16913 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 16368 sub captcha_display {	Line 16932 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 16382 sub captcha_response {	Line 16946 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 16430 sub get_captcha_config {	Line 16994 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 16649 sub des_decrypt {	Line 17234 sub des_decrypt {
return $plaintext;	return $plaintext;
}	}

	sub is_nonframeable {
	my ($url,$absolute,$hostname,$ip,$nocache) = @_;
	my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);
	return if (($remprotocol eq '') \|\| ($remhost eq ''));

	$remprotocol = lc($remprotocol);
	$remhost = lc($remhost);
	my $remport = 80;
	if ($remprotocol eq 'https') {
	$remport = 443;
	}
	my ($result,$cached) = &Apache::lonnet::is_cached_new('noiframe',$remhost.':'.$remport);
	if ($cached) {
	unless ($nocache) {
	if ($result) {
	return 1;
	} else {
	return 0;
	}
	}
	}
	my $uselink;
	my $request = new HTTP::Request('HEAD',$url);
	my $ua = LWP::UserAgent->new;
	$ua->timeout(5);
	my $response=$ua->request($request);
	if ($response->is_success()) {
	my $secpolicy = lc($response->header('content-security-policy'));
	my $xframeop = lc($response->header('x-frame-options'));
	$secpolicy =~ s/^\s+\|\s+$//g;
	$xframeop =~ s/^\s+\|\s+$//g;
	if (($secpolicy ne '') \|\| ($xframeop ne '')) {
	my $remotehost = $remprotocol.'://'.$remhost;
	my ($origin,$protocol,$port);
	if ($ENV{'SERVER_PORT'} =~/^\d+$/) {
	$port = $ENV{'SERVER_PORT'};
	} else {
	$port = 80;
	}
	if ($absolute eq '') {
	$protocol = 'http:';
	if ($port == 443) {
	$protocol = 'https:';
	}
	$origin = $protocol.'//'.lc($hostname);
	} else {
	$origin = lc($absolute);
	($protocol,$hostname) = ($absolute =~ m{^(https?:)//([^/]+)$});
	}
	if (($secpolicy) && ($secpolicy =~ /\Qframe-ancestors\E([^;]*)(;\|$)/)) {
	my $framepolicy = $1;
	$framepolicy =~ s/^\s+\|\s+$//g;
	my @policies = split(/\s+/,$framepolicy);
	if (@policies) {
	if (grep(/^\Q'none'\E$/,@policies)) {
	$uselink = 1;
	} else {
	$uselink = 1;
	if ((grep(/^\Q*\E$/,@policies)) \|\| (grep(/^\Q$protocol\E$/,@policies)) \|\|
	(($origin ne '') && (grep(/^\Q$origin\E$/,@policies))) \|\|
	(($ip ne '') && (grep(/^\Q$ip\E$/,@policies)))) {
	undef($uselink);
	}
	if ($uselink) {
	if (grep(/^\Q'self'\E$/,@policies)) {
	if (($origin ne '') && ($remotehost eq $origin)) {
	undef($uselink);
	}
	}
	}
	if ($uselink) {
	my @possok;
	if ($ip ne '') {
	push(@possok,$ip);
	}
	my $hoststr = '';
	foreach my $part (reverse(split(/\./,$hostname))) {
	if ($hoststr eq '') {
	$hoststr = $part;
	} else {
	$hoststr = "$part.$hoststr";
	}
	if ($hoststr eq $hostname) {
	push(@possok,$hostname);
	} else {
	push(@possok,"*.$hoststr");
	}
	}
	if (@possok) {
	foreach my $poss (@possok) {
	last if (!$uselink);
	foreach my $policy (@policies) {
	if ($policy =~ m{^(\Q$protocol\E//\|)\Q$poss\E(\Q:$port\E\|)$}) {
	undef($uselink);
	last;
	}
	}
	}
	}
	}
	}
	}
	} elsif ($xframeop ne '') {
	$uselink = 1;
	my @policies = split(/\s,\s/,$xframeop);
	if (@policies) {
	unless (grep(/^deny$/,@policies)) {
	if ($origin ne '') {
	if (grep(/^sameorigin$/,@policies)) {
	if ($remotehost eq $origin) {
	undef($uselink);
	}
	}
	if ($uselink) {
	foreach my $policy (@policies) {
	if ($policy =~ /^allow-from\s*(.+)$/) {
	my $allowfrom = $1;
	if (($allowfrom ne '') && ($allowfrom eq $origin)) {
	undef($uselink);
	last;
	}
	}
	}
	}
	}
	}
	}
	}
	}
	}
	if ($nocache) {
	if ($cached) {
	my $devalidate;
	if ($uselink && !$result) {
	$devalidate = 1;
	} elsif (!$uselink && $result) {
	$devalidate = 1;
	}
	if ($devalidate) {
	&Apache::lonnet::devalidate_cache_new('noiframe',$remhost.':'.$remport);
	}
	}
	} else {
	if ($uselink) {
	$result = 1;
	} else {
	$result = 0;
	}
	&Apache::lonnet::do_cache_new('noiframe',$remhost.':'.$remport,$result,3600);
	}
	return $uselink;
	}

1;	1;
__END__;	__END__;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.1075.2.116
changed lines
	Added in v.1.1075.2.147