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.1268 and 1.1338

version 1.1268, 2017/01/01 16:32:01	version 1.1338, 2020/02/15 03:57:54
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 LONCAPA::LWPReq;
	use HTTP::Request;
use DateTime::TimeZone;	use DateTime::TimeZone;
use DateTime::Locale;	use DateTime::Locale;
use Encode();	use Encode();
Line 78 use Text::Aspell;	Line 80 use Text::Aspell;
use Authen::Captcha;	use Authen::Captcha;
use Captcha::reCAPTCHA;	use Captcha::reCAPTCHA;
use JSON::DWIW;	use JSON::DWIW;
use LWP::UserAgent;
use Crypt::DES;	use Crypt::DES;
use DynaLoader; # for Crypt::DES version	use DynaLoader; # for Crypt::DES version
use MIME::Lite;	use MIME::Lite;
use MIME::Types;	use MIME::Types;
	use File::Copy();
	use File::Path();
	use String::CRC32();
	use Short::URL();

# ---------------------------------------------- Designs	# ---------------------------------------------- Designs
use vars qw(%defaultdesign);	use vars qw(%defaultdesign);
Line 198 BEGIN {	Line 203 BEGIN {
{	{
my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/language.tab';	'/language.tab';
if ( open(my $fh,"<$langtabfile") ) {	if ( open(my $fh,'<',$langtabfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line=~/^\#/);	next if ($line=~/^\#/);
chomp($line);	chomp($line);
Line 220 BEGIN {	Line 225 BEGIN {
{	{
my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.	my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/copyright.tab';	'/copyright.tab';
if ( open (my $fh,"<$copyrightfile") ) {	if ( open (my $fh,'<',$copyrightfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line=~/^\#/);	next if ($line=~/^\#/);
chomp($line);	chomp($line);
Line 234 BEGIN {	Line 239 BEGIN {
{	{
my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.	my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}.
'/source_copyright.tab';	'/source_copyright.tab';
if ( open (my $fh,"<$sourcecopyrightfile") ) {	if ( open (my $fh,'<',$sourcecopyrightfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 248 BEGIN {	Line 253 BEGIN {
# -------------------------------------------------------------- default domain designs	# -------------------------------------------------------------- default domain designs
my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';	my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors';
my $designfile = $designdir.'/default.tab';	my $designfile = $designdir.'/default.tab';
if ( open (my $fh,"<$designfile") ) {	if ( open (my $fh,'<',$designfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 262 BEGIN {	Line 267 BEGIN {
{	{
my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filecategories.tab';	'/filecategories.tab';
if ( open (my $fh,"<$categoryfile") ) {	if ( open (my $fh,'<',$categoryfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 277 BEGIN {	Line 282 BEGIN {
{	{
my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.	my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}.
'/filetypes.tab';	'/filetypes.tab';
if ( open (my $fh,"<$typesfile") ) {	if ( open (my $fh,'<',$typesfile) ) {
while (my $line = <$fh>) {	while (my $line = <$fh>) {
next if ($line =~ /^\#/);	next if ($line =~ /^\#/);
chomp($line);	chomp($line);
Line 430 sub studentbrowser_javascript {	Line 435 sub studentbrowser_javascript {
<script type="text/javascript" language="Javascript">	<script type="text/javascript" language="Javascript">
// <![CDATA[	// <![CDATA[
var stdeditbrowser;	var stdeditbrowser;
function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadvonly) {	function openstdbrowser(formname,uname,udom,clicker,roleflag,ignorefilter,courseadv) {
var url = '/adm/pickstudent?';	var url = '/adm/pickstudent?';
var filter;	var filter;
if (!ignorefilter) {	if (!ignorefilter) {
Line 445 sub studentbrowser_javascript {	Line 450 sub studentbrowser_javascript {
'&udomelement='+udom+	'&udomelement='+udom+
'&clicker='+clicker;	'&clicker='+clicker;
if (roleflag) { url+="&roles=1"; }	if (roleflag) { url+="&roles=1"; }
if (courseadvonly) { url+="&courseadvonly=1"; }	if (courseadv == 'condition') {
	if (document.getElementById('courseadv')) {
	courseadv = document.getElementById('courseadv').value;
	}
	}
	if ((courseadv == 'only') \|\| (courseadv == 'none')) { url+="&courseadv="+courseadv; }
var title = 'Student_Browser';	var title = 'Student_Browser';
var options = 'scrollbars=1,resizable=1,menubar=0';	var options = 'scrollbars=1,resizable=1,menubar=0';
options += ',width=700,height=600';	options += ',width=700,height=600';
Line 477 ENDRESBRW	Line 487 ENDRESBRW
}	}

sub selectstudent_link {	sub selectstudent_link {
my ($form,$unameele,$udomele,$courseadvonly,$clickerid)=@_;	my ($form,$unameele,$udomele,$courseadv,$clickerid)=@_;
my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".	my $callargs = "'".&Apache::lonhtmlcommon::entity_encode($form)."','".
&Apache::lonhtmlcommon::entity_encode($unameele)."','".	&Apache::lonhtmlcommon::entity_encode($unameele)."','".
&Apache::lonhtmlcommon::entity_encode($udomele)."'";	&Apache::lonhtmlcommon::entity_encode($udomele)."'";
Line 488 sub selectstudent_link {	Line 498 sub selectstudent_link {
return '';	return '';
}	}
$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";	$callargs.=",'".&Apache::lonhtmlcommon::entity_encode($clickerid)."'";
if ($courseadvonly) {	if ($courseadv eq 'only') {
$callargs .= ",'',1,1";	$callargs .= ",'',1,'$courseadv'";
	} elsif ($courseadv eq 'none') {
	$callargs .= ",'','','$courseadv'";
	} elsif ($courseadv eq 'condition') {
	$callargs .= ",'','','$courseadv'";
}	}
return '<span class="LC_nobreak">'.	return '<span class="LC_nobreak">'.
'<a href="javascript:openstdbrowser('.$callargs.');">'.	'<a href="javascript:openstdbrowser('.$callargs.');">'.
Line 1292 sub help_open_topic {	Line 1306 sub help_open_topic {
}	}

# Add the text	# Add the text
	my $target = ' target="_top"';
	if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
	$target = '';
	}
if ($text ne "") {	if ($text ne "") {
$template.='<span class="LC_help_open_topic">'	$template.='<span class="LC_help_open_topic">'
.'<a target="_top" href="'.$link.'">'	.'<a'.$target.' href="'.$link.'">'
.$text.'</a>';	.$text.'</a>';
}	}

Line 1304 sub help_open_topic {	Line 1322 sub help_open_topic {
if ($imgid ne '') {	if ($imgid ne '') {
$imgid = ' id="'.$imgid.'"';	$imgid = ' id="'.$imgid.'"';
}	}
$template.=' <a target="_top" href="'.$link.'" title="'.$title.'">'	$template.=' <a'.$target.' href="'.$link.'" title="'.$title.'">'
.'<img src="'.$helpicon.'" border="0"'	.'<img src="'.$helpicon.'" border="0"'
.' alt="'.&mt('Help: [_1]',$topic).'"'	.' alt="'.&mt('Help: [_1]',$topic).'"'
.' title="'.$title.'" style="vertical-align:middle;"'.$imgid	.' title="'.$title.'" style="vertical-align:middle;"'.$imgid
Line 1497 sub help_open_bug {	Line 1515 sub help_open_bug {
{	{
$link = $url;	$link = $url;
}	}

	my $target = ' target="_top"';
	if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
	$target = '';
	}
# Add the text	# Add the text
if ($text ne "")	if ($text ne "")
{	{
$template .=	$template .=
"<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".	"<table bgcolor='#AA3333' cellspacing='1' cellpadding='1' border='0'><tr>".
"<td bgcolor='#FF5555'><a target=\"_top\" href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";	"<td bgcolor='#FF5555'><a".$target." href=\"$link\"><span style=\"color:#FFFFFF;font-size:10pt;\">$text</span></a>";
}	}

# Add the graphic	# Add the graphic
my $title = &mt('Report a Bug');	my $title = &mt('Report a Bug');
my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");	my $bugicon=&lonhttpdurl("/adm/lonMisc/smallBug.gif");
$template .= <<"ENDTEMPLATE";	$template .= <<"ENDTEMPLATE";
<a target="_top" href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>	<a$target href="$link" title="$title"><img src="$bugicon" border="0" alt="(Bug: $topic)" /></a>
ENDTEMPLATE	ENDTEMPLATE
if ($text ne '') { $template.='</td></tr></table>' };	if ($text ne '') { $template.='</td></tr></table>' };
return $template;	return $template;
Line 2220 sub import_crsauthor_form {	Line 2243 sub import_crsauthor_form {
}	}
my @ordered = ();	my @ordered = ();
foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {	foreach my $file (sort { lc($a) cmp lc($b) } (keys(%{$files{$key}}))) {
	next if ($file =~ /\.rights$/);
if ($only) {	if ($only) {
my ($ext) = ($file =~ /\.([^.]+)$/);	my ($ext) = ($file =~ /\.([^.]+)$/);
unless ($possexts{lc($ext)}) {	unless ($possexts{lc($ext)}) {
Line 2263 sub import_crsauthor_form {	Line 2287 sub import_crsauthor_form {
unless ($possexts{lc($ext)}) {	unless ($possexts{lc($ext)}) {
next;	next;
}	}
	} else {
	next if ($file =~ /\.rights$/);
}	}
push(@singledirfiles,$file);	push(@singledirfiles,$file);
}	}
if (@singledirfiles) {	if (@singledirfiles) {
$possdirs == 1;	$possdirs = 1;
}	}
}	}
if (($possdirs == 1) && (@singledirfiles)) {	if (($possdirs == 1) && (@singledirfiles)) {
Line 2476 sub create_text_file {	Line 2502 sub create_text_file {
# ------------------------------------------	# ------------------------------------------

sub domain_select {	sub domain_select {
my ($name,$value,$multiple)=@_;	my ($name,$value,$multiple,$incdoms,$excdoms)=@_;
	my @possdoms;
	if (ref($incdoms) eq 'ARRAY') {
	@possdoms = @{$incdoms};
	} else {
	@possdoms = &Apache::lonnet::all_domains();
	}

my %domains=map {	my %domains=map {
$_ => $_.' '. &Apache::lonnet::domain($_,'description')	$_ => $_.' '. &Apache::lonnet::domain($_,'description')
} &Apache::lonnet::all_domains();	} @possdoms;

	if ((ref($excdoms) eq 'ARRAY') && (@{$excdoms} > 0)) {
	foreach my $dom (@{$excdoms}) {
	delete($domains{$dom});
	}
	}

if ($multiple) {	if ($multiple) {
$domains{''}=&mt('Any domain');	$domains{''}=&mt('Any domain');
$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];	$domains{'select_form_order'} = [sort {lc($a) cmp lc($b) } (keys(%domains))];
Line 3008 This is not an optimal method, but it wo	Line 3048 This is not an optimal method, but it wo

=item * authform_filesystem	=item * authform_filesystem

	=item * authform_lti

=back	=back

See loncreateuser.pm for invocation and use examples.	See loncreateuser.pm for invocation and use examples.
Line 3424 sub authform_filesystem {	Line 3466 sub authform_filesystem {
$fsyscheck.' onchange="'.$jscall.'" onclick="'.	$fsyscheck.' onchange="'.$jscall.'" onclick="'.
$jscall.'"'.$disabled.' />';	$jscall.'"'.$disabled.' />';
}	}
$autharg = '<input type="text" size="10" name="fsysarg" value=""'.	$autharg = '<input type="password" size="10" name="fsysarg" value=""'.
' onchange="'.$jscall.'"'.$disabled.' />';	' onchange="'.$jscall.'"'.$disabled.' />';
$result = &mt	$result = &mt
('[_1] Filesystem Authenticated (with initial password [_2])',	('[_1] Filesystem Authenticated (with initial password [_2])',
'<label><input type="radio" name="login" value="fsys" '.	'<label>'.$authtype,'</label>'.$autharg);
$fsyscheck.'onchange="'.$jscall.'" onclick="'.$jscall.'"'.$disabled.' />',	return $result;
'</label><input type="password" size="10" name="fsysarg" value="" '.	}
'onchange="'.$jscall.'"'.$disabled.' />');
	sub authform_lti {
	my %in = (
	formname => 'document.cu',
	kerb_def_dom => 'MSU.EDU',
	@_,
	);
	my ($lticheck,$result,$authtype,$autharg,$jscall,$disabled);
	my ($authnum,%can_assign) = &get_assignable_auth($in{'domain'});
	if ($in{'readonly'}) {
	$disabled = ' disabled="disabled"';
	}
	if (defined($in{'curr_authtype'})) {
	if ($in{'curr_authtype'} eq 'lti') {
	if ($can_assign{'lti'}) {
	$lticheck = 'checked="checked" ';
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifyuser') {
	$lticheck = '';
	}
	}
	} else {
	$result = &mt('Currently LTI Authenticated.');
	return $result;
	}
	}
	} else {
	if ($authnum == 1) {
	$authtype = '<input type="hidden" name="login" value="lti" />';
	}
	}
	if (!$can_assign{'lti'}) {
	return;
	} elsif ($authtype eq '') {
	if (defined($in{'mode'})) {
	if ($in{'mode'} eq 'modifycourse') {
	if ($authnum == 1) {
	$authtype = '<input type="radio" name="login" value="lti"'.$disabled.' />';
	}
	}
	}
	}
	$jscall = "javascript:changed_radio('lti',$in{'formname'});";
	if (($authtype eq '') && (($in{'mode'} eq 'modifycourse') \|\| ($in{'curr_authtype'} ne 'lti'))) {
	$authtype = '<input type="radio" name="login" value="lti" '.
	$lticheck.' onchange="'.$jscall.'" onclick="'.
	$jscall.'"'.$disabled.' />';
	}
	$autharg = '<input type="hidden" name="ltiarg" value="" />';
	if ($authtype) {
	$result = &mt('[_1] LTI Authenticated',
	'<label>'.$authtype.'</label>'.$autharg);
	} else {
	$result = '<b>'.&mt('LTI Authenticated').'</b>'.
	$autharg;
	}
return $result;	return $result;
}	}

Line 3445 sub get_assignable_auth {	Line 3542 sub get_assignable_auth {
krb5 => 1,	krb5 => 1,
int => 1,	int => 1,
loc => 1,	loc => 1,
	lti => 1,
);	);
my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);	my %domconfig = &Apache::lonnet::get_dom('configuration',['usercreation'],$dom);
if (ref($domconfig{'usercreation'}) eq 'HASH') {	if (ref($domconfig{'usercreation'}) eq 'HASH') {
Line 3477 sub get_assignable_auth {	Line 3575 sub get_assignable_auth {
return ($authnum,%can_assign);	return ($authnum,%can_assign);
}	}

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

###############################################################	###############################################################
## Get Kerberos Defaults for Domain ##	## Get Kerberos Defaults for Domain ##
###############################################################	###############################################################
Line 4562 sub get_previous_attempt {	Line 4733 sub get_previous_attempt {
}	}
$prevattempts.= &end_data_table_row().&end_data_table();	$prevattempts.= &end_data_table_row().&end_data_table();
} else {	} else {
	my $msg;
	if ($symb =~ /ext\.tool$/) {
	$msg = &mt('No grade passed back.');
	} else {
	$msg = &mt('Nothing submitted - no attempts.');
	}
$prevattempts=	$prevattempts=
&start_data_table().&start_data_table_row().	&start_data_table().&start_data_table_row().
'<td>'.&mt('Nothing submitted - no attempts.').'</td>'.	'<td>'.$msg.'</td>'.
&end_data_table_row().&end_data_table();	&end_data_table_row().&end_data_table();
}	}
} else {	} else {
Line 4669 sub get_student_view {	Line 4846 sub get_student_view {
}	}
if (defined($target)) { $form{'grade_target'} = $target; }	if (defined($target)) { $form{'grade_target'} = $target; }
$feedurl=&Apache::lonnet::clutter($feedurl);	$feedurl=&Apache::lonnet::clutter($feedurl);
	if (($feedurl =~ /ext\.tool$/) && ($target eq 'tex')) {
	$feedurl =~ s{^/adm/wrapper}{};
	}
my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);	my ($userview,$response)=&Apache::lonnet::ssi_body($feedurl,%form);
$userview=~s/\<body[^\>]*\>//gi;	$userview=~s/\<body[^\>]*\>//gi;
$userview=~s/\<\/body\>//gi;	$userview=~s/\<\/body\>//gi;
Line 4991 sub blockcheck {	Line 5171 sub blockcheck {
# boards, chat or groups, check for blocking in current course only.	# boards, chat or groups, check for blocking in current course only.

if (($activity eq 'boards' \|\| $activity eq 'chat' \|\|	if (($activity eq 'boards' \|\| $activity eq 'chat' \|\|
$activity eq 'groups' \|\| $activity eq 'printout') &&	$activity eq 'groups' \|\| $activity eq 'printout' \|\|
	$activity eq 'reinit' \|\| $activity eq 'alert') &&
($env{'request.course.id'})) {	($env{'request.course.id'})) {
foreach my $key (keys(%live_courses)) {	foreach my $key (keys(%live_courses)) {
if ($key ne $env{'request.course.id'}) {	if ($key ne $env{'request.course.id'}) {
Line 5075 sub blockcheck {	Line 5256 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 5097 sub blockcheck {	Line 5278 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);
if (($start != 0) &&	if (($start != 0) &&
Line 5186 sub get_blocks {	Line 5367 sub get_blocks {
my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};	my $end = $start + $env{'course.'.$cdom.'_'.$cnum.'.timerinterval.'.$timersymb};
if ($start && $end) {	if ($start && $end) {
if (($start <= time) && ($end >= time)) {	if (($start <= time) && ($end >= time)) {
unless (grep(/^\Q$block\E$/,@blockers)) {	if (ref($commblocks{$block}) eq 'HASH') {
push(@blockers,$block);	if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
$triggered{$block} = {	if ($commblocks{$block}{'blocks'}{$activity} eq 'on') {
start => $start,	unless(grep(/^\Q$block\E$/,@blockers)) {
end => $end,	push(@blockers,$block);
type => $type,	$triggered{$block} = {
};	start => $start,
	end => $end,
	type => $type,
	};
	}
	}
	}
}	}
}	}
}	}
Line 5302 END_MYBLOCK	Line 5489 END_MYBLOCK
$text = &mt('Printing Blocked');	$text = &mt('Printing Blocked');
} elsif ($activity eq 'passwd') {	} elsif ($activity eq 'passwd') {
$text = &mt('Password Changing Blocked');	$text = &mt('Password Changing Blocked');
	} elsif ($activity eq 'alert') {
	$text = &mt('Checking Critical Messages Blocked');
	} elsif ($activity eq 'reinit') {
	$text = &mt('Checking Course Update Blocked');
}	}
$output .= <<"END_BLOCK";	$output .= <<"END_BLOCK";
<div class='$class'>	<div class='$class'>
Line 5541 sub get_legacy_domconf {	Line 5732 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 5740 sub CSTR_pageheader {	Line 5931 sub CSTR_pageheader {
$title = &mt('Authoring Space');	$title = &mt('Authoring Space');
}	}

	my ($target,$crumbtarget) = (' target="_top"','_top'); #FIXME lonpubdir: target="_parent"
	if (($env{'request.lti.login'}) && ($env{'request.lti.target'} eq 'iframe')) {
	$target = '';
	$crumbtarget = '';
	}

my $output =	my $output =
'<div>'	'<div>'
.&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?	.&Apache::loncommon::help_open_menu('','',3,'Authoring') #FIXME: Broken? Where is it?
.'<b>'.$title.'</b> '	.'<b>'.$title.'</b> '
.'<form name="dirs" method="post" action="'.$formaction	.'<form name="dirs" method="post" action="'.$formaction.'"'.$target.'>'
.'" target="_top">' #FIXME lonpubdir: target="_parent"	.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,$crumbtarget,'/priv/'.$udom,undef,undef);
.&Apache::lonhtmlcommon::crumbs($uname.'/'.$parentpath,'_top','/priv/'.$udom,undef,undef);

if ($lastitem) {	if ($lastitem) {
$output .=	$output .=
Line 5760 sub CSTR_pageheader {	Line 5956 sub CSTR_pageheader {
} else {	} else {
$output .=	$output .=
'<br />'	'<br />'
#FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/','_top','/priv','','+1',1)."</b></tt><br />"	#FIXME lonpubdir: &Apache::lonhtmlcommon::crumbs($uname.$thisdisfn.'/',$crumbtarget,'/priv','','+1',1)."</b></tt><br />"
.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')	.&Apache::lonhtmlcommon::select_recent('construct','recent','this.form.action=this.form.recent.value;this.form.submit()')
.'</form>'	.'</form>'
.&Apache::lonmenu::constspaceform();	.&Apache::lonmenu::constspaceform();
Line 5809 Inputs:	Line 6005 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
breadcrumbs.	breadcrumbs.

	=item * $ltiscope, optional argument, will be one of: resource, map or
	course, if LON-CAPA is in LTI Provider context. Value is
	the scope of use, i.e., launch was for access to a single, a map
	or the entire course.

	=item * $ltiuri, optional argument, if LON-CAPA is in LTI Provider
	context, this will contain the URL for the landing item in
	the course, after launch from an LTI Consumer

	=item * $ltimenu, optional argument, if LON-CAPA is in LTI Provider
	context, this will contain a reference to hash of items
	to be included in the page header and/or inline menu.

=back	=back

Returns: A uniform header for LON-CAPA web pages.	Returns: A uniform header for LON-CAPA web pages.
Line 5825 other decorations will be returned.	Line 6038 other decorations will be returned.

sub bodytag {	sub bodytag {
my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,	my ($title,$function,$addentries,$bodyonly,$domain,$forcereg,
$no_nav_bar,$bgcolor,$args,$advtoolsref)=@_;	$no_nav_bar,$bgcolor,$args,$advtoolsref,$ltiscope,$ltiuri,$ltimenu)=@_;

my $public;	my $public;
if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))	if ((($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public'))
Line 5834 sub bodytag {	Line 6047 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 5862 sub bodytag {	Line 6076 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 5891 sub bodytag {	Line 6109 sub bodytag {
if ($public) {	if ($public) {
undef($role);	undef($role);
}	}

	if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
	if (ref($ltimenu) eq 'HASH') {
	unless ($ltimenu->{'role'}) {
	undef($role);
	}
	unless ($ltimenu->{'coursetitle'}) {
	$realm=' ';
	}
	}
	}

my $titleinfo = '<h1>'.$title.'</h1>';	my $titleinfo = '<h1>'.$title.'</h1>';
#	#
# Extra info if you are the DC	# Extra info if you are the DC
Line 5925 sub bodytag {	Line 6154 sub bodytag {
$bodytag .= Apache::lonhtmlcommon::scripttag(	$bodytag .= Apache::lonhtmlcommon::scripttag(
Apache::lonmenu::utilityfunctions($httphost), 'start');	Apache::lonmenu::utilityfunctions($httphost), 'start');

my ($left,$right) = Apache::lonmenu::primary_menu($crstype);	unless ($args->{'no_primary_menu'}) {
	my ($left,$right) = Apache::lonmenu::primary_menu($crstype,$ltimenu);

if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {	if ($env{'request.noversionuri'} =~ m{^/res/adm/pages/}) {
if ($dc_info) {	if ($dc_info) {
$dc_info = qq\|<span class="LC_cusr_subheading">$dc_info</span>\|;	$dc_info = qq\|<span class="LC_cusr_subheading">$dc_info</span>\|;
}	}
$bodytag .= qq\|<div id="LC_nav_bar">$left $role<br />	$bodytag .= qq\|<div id="LC_nav_bar">$left $role<br />
<em>$realm</em> $dc_info</div>\|;	<em>$realm</em> $dc_info</div>\|;
return $bodytag;	return $bodytag;
}	}

unless ($env{'request.symb'} =~ m/\.page___\d+___/) {	unless ($env{'request.symb'} =~ m/\.page___\d+___/) {
$bodytag .= qq\|<div id="LC_nav_bar">$left $role</div>\|;	$bodytag .= qq\|<div id="LC_nav_bar">$left $role</div>\|;
}	}

$bodytag .= $right;	$bodytag .= $right;

if ($dc_info) {	if ($dc_info) {
$dc_info = &dc_courseid_toggle($dc_info);	$dc_info = &dc_courseid_toggle($dc_info);
	}
	$bodytag .= qq\|<div id="LC_realm">$realm $dc_info</div>\|;
}	}
$bodytag .= qq\|<div id="LC_realm">$realm $dc_info</div>\|;

#if directed to not display the secondary menu, don't.	#if directed to not display the secondary menu, don't.
if ($args->{'no_secondary_menu'}) {	if ($args->{'no_secondary_menu'}) {
Line 5953 sub bodytag {	Line 6184 sub bodytag {
}	}
#don't show menus for public users	#don't show menus for public users
if (!$public){	if (!$public){
$bodytag .= Apache::lonmenu::secondary_menu($httphost);	unless ($args->{'no_inline_menu'}) {
	$bodytag .= Apache::lonmenu::secondary_menu($httphost,$ltiscope,$ltimenu,
	$args->{'no_primary_menu'});
	}
$bodytag .= Apache::lonmenu::serverform();	$bodytag .= Apache::lonmenu::serverform();
$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');	$bodytag .= Apache::lonhtmlcommon::scripttag('', 'end');
if ($env{'request.state'} eq 'construct') {	if ($env{'request.state'} eq 'construct') {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,	$bodytag .= &Apache::lonmenu::innerregister($forcereg,
$args->{'bread_crumbs'});	$args->{'bread_crumbs'},'','',$hostname,$ltiscope,$ltiuri);
} elsif ($forcereg) {	} elsif ($forcereg) {
$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,	$bodytag .= &Apache::lonmenu::innerregister($forcereg,undef,
$args->{'group'},	$args->{'group'},
$args->{'hide_buttons'});	$args->{'hide_buttons'},
	$hostname,$ltiscope,$ltiuri);
} else {	} else {
$bodytag .=	$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);	$advtoolsref,'',$hostname);
}	}
}else{	}else{
# this is to seperate menu from content when there's no secondary	# this is to seperate menu from content when there's no secondary
Line 6430 td.LC_menubuttons_text {	Line 6665 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 6751 td.LC_parm_overview_restrictions {	Line 6991 td.LC_parm_overview_restrictions {
border-collapse: collapse;	border-collapse: collapse;
}	}

	span.LC_parm_recursive,
	td.LC_parm_recursive {
	font-weight: bold;
	font-size: smaller;
	}

table.LC_parm_overview_restrictions td {	table.LC_parm_overview_restrictions td {
border-width: 1px 4px 1px 4px;	border-width: 1px 4px 1px 4px;
border-style: solid;	border-style: solid;
Line 7020 table.LC_prior_tries td {	Line 7266 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 7102 table.LC_data_table tr > td.LC_docs_entr	Line 7349 table.LC_data_table tr > td.LC_docs_entr
color: #990000;	color: #990000;
}	}

	.LC_docs_alias {
	color: #440055;
	}

	.LC_domprefs_email,
	.LC_docs_alias_name,
.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 8010 ul.LC_funclist li {	Line 8263 ul.LC_funclist li {
cursor:pointer;	cursor:pointer;
}	}

	pre.LC_wordwrap {
	white-space: pre-wrap;
	white-space: -moz-pre-wrap;
	white-space: -pre-wrap;
	white-space: -o-pre-wrap;
	word-wrap: break-word;
	}

/*	/*
styles used for response display	styles used for response display
*/	*/
Line 8122 section.role-warning>h1:before {	Line 8383 section.role-warning>h1:before {
content:url('/adm/daxe/images/section_icons/warning.png');	content:url('/adm/daxe/images/section_icons/warning.png');
}	}

	#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 8314 OFFLOAD	Line 8608 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 8493 $args - additional optional args support	Line 8788 $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 8507 sub start_page {	Line 8808 sub start_page {
#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));	#&Apache::lonnet::logthis("start_page ".join(':',caller(0)));

$env{'internal.start_page'}++;	$env{'internal.start_page'}++;
my ($result,@advtools);	my ($result,@advtools,$ltiscope,$ltiuri,%ltimenu);

if (! exists($args->{'skip_phases'}{'head'}) ) {	if (! exists($args->{'skip_phases'}{'head'}) ) {
$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);	$result .= &xml_begin($args->{'frameset'}) . &headtag($title, $head_extra, $args);
}	}

	if (($env{'request.course.id'}) && ($env{'request.lti.login'})) {
	if ($env{'course.'.$env{'request.course.id'}.'.lti.override'}) {
	unless ($env{'course.'.$env{'request.course.id'}.'.lti.topmenu'}) {
	$args->{'no_primary_menu'} = 1;
	}
	unless ($env{'course.'.$env{'request.course.id'}.'.lti.inlinemenu'}) {
	$args->{'no_inline_menu'} = 1;
	}
	if ($env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'}) {
	map { $ltimenu{$_} = 1; } split(/,/,$env{'course.'.$env{'request.course.id'}.'.lti.lcmenu'});
	}
	} else {
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my %lti = &Apache::lonnet::get_domain_lti($cdom,'provider');
	if (ref($lti{$env{'request.lti.login'}}) eq 'HASH') {
	unless ($lti{$env{'request.lti.login'}}{'topmenu'}) {
	$args->{'no_primary_menu'} = 1;
	}
	unless ($lti{$env{'request.lti.login'}}{'inlinemenu'}) {
	$args->{'no_inline_menu'} = 1;
	}
	if (ref($lti{$env{'request.lti.login'}}{'lcmenu'}) eq 'ARRAY') {
	map { $ltimenu{$_} = 1; } @{$lti{$env{'request.lti.login'}}{'lcmenu'}};
	}
	}
	}
	($ltiscope,$ltiuri) = &LONCAPA::ltiutils::lti_provider_scope($env{'request.lti.uri'},
	$env{'course.'.$env{'request.course.id'}.'.domain'},
	$env{'course.'.$env{'request.course.id'}.'.num'});
	}

if (! exists($args->{'skip_phases'}{'body'}) ) {	if (! exists($args->{'skip_phases'}{'body'}) ) {
if ($args->{'frameset'}) {	if ($args->{'frameset'}) {
Line 8525 sub start_page {	Line 8857 sub start_page {
$args->{'only_body'}, $args->{'domain'},	$args->{'only_body'}, $args->{'domain'},
$args->{'force_register'}, $args->{'no_nav_bar'},	$args->{'force_register'}, $args->{'no_nav_bar'},
$args->{'bgcolor'}, $args,	$args->{'bgcolor'}, $args,
\@advtools);	\@advtools,$ltiscope,$ltiuri,\%ltimenu);
}	}
}	}

Line 8558 sub start_page {	Line 8890 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'})) \|\|
	($ltiscope eq 'map') \|\| ($ltiscope eq 'resource') \|\|
	((($args->{'crstype'} eq 'Placement') \|\| (($env{'request.course.id'}) &&
	($env{'course.'.$env{'request.course.id'}.'.type'} eq 'Placement'))) &&
	(!$env{'request.role.adv'}))) {
	$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);
} elsif ($args->{'crstype'} eq 'Placement') {
$result .= &Apache::lonhtmlcommon::breadcrumbs('','','','','','','','','',
$args->{'crstype'});
} else {	} else {
$result .= &Apache::lonhtmlcommon::breadcrumbs();	$result .= &Apache::lonhtmlcommon::breadcrumbs('','',$menulink);
}	}
}	}
return $result;	return $result;
Line 8688 sub modal_link {	Line 9027 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 8792 sub end_togglebox {	Line 9130 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 8806 sub LCprogressbar_script {	Line 9145 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 8832 my $LCidcnt;	Line 9193 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 9047 function expand_div(caller) {	Line 9425 function expand_div(caller) {

sub simple_error_page {	sub simple_error_page {
my ($r,$title,$msg,$args) = @_;	my ($r,$title,$msg,$args) = @_;
	my %displayargs;
if (ref($args) eq 'HASH') {	if (ref($args) eq 'HASH') {
if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }	if (!$args->{'no_auto_mt_msg'}) { $msg = &mt($msg); }
	if ($args->{'only_body'}) {
	$displayargs{'only_body'} = 1;
	}
	if ($args->{'no_nav_bar'}) {
	$displayargs{'no_nav_bar'} = 1;
	}
} else {	} else {
$msg = &mt($msg);	$msg = &mt($msg);
}	}

my $page =	my $page =
&Apache::loncommon::start_page($title).	&Apache::loncommon::start_page($title,'',\%displayargs).
'<p class="LC_error">'.$msg.'</p>'.	'<p class="LC_error">'.$msg.'</p>'.
&Apache::loncommon::end_page();	&Apache::loncommon::end_page();
if (ref($r)) {	if (ref($r)) {
Line 9982 sub get_secgrprole_info {	Line 10367 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 10047 sub user_picker {	Line 10432 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);	my $defdom = $env{'request.role.domain'};
	my ($trusted,$untrusted);
	if (($context eq 'requestcrs') \|\| ($context eq 'course')) {
	($trusted,$untrusted) = &Apache::lonnet::trusted_domains('enroll',$defdom);
	} elsif ($context eq 'author') {
	($trusted,$untrusted) = &Apache::lonnet::trusted_domains('othcoau',$defdom);
	} elsif ($context eq 'domain') {
	($trusted,$untrusted) = &Apache::lonnet::trusted_domains('domroles',$defdom);
	}
	$domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,$trusted,$untrusted);
}	}
my $srchinsel = ' <select name="srchin">';	my $srchinsel = ' <select name="srchin">';

Line 10063 sub user_picker {	Line 10459 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 11901 sub modify_html_refs {	Line 12298 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 11966 sub modify_html_refs {	Line 12363 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 12483 sub decompress_uploaded_file {	Line 12880 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 12517 sub process_decompression {	Line 12926 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 12558 sub process_decompression {	Line 12981 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 13044 END	Line 13466 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 13057 sub process_extracted_files {	Line 13479 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 13146 sub process_extracted_files {	Line 13568 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 13155 sub process_extracted_files {	Line 13579 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 13247 sub process_extracted_files {	Line 13680 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 13256 sub process_extracted_files {	Line 13691 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 13544 sub upfile_store {	Line 13984 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 13559 sub upfile_store {	Line 14002 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 13581 sub load_tmp_file {	Line 14025 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 14467 requestsmail, updatesmail, or idconflict	Line 14919 requestsmail, updatesmail, or idconflict
defdom (domain for which to retrieve configuration settings),	defdom (domain for which to retrieve configuration settings),

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.

Line 14478 Returns: comma separated list of address	Line 14937 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 14494 sub build_recipient_list {	Line 14953 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 14521 sub build_recipient_list {	Line 15149 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 14694 jsarray (reference to array of categorie	Line 15335 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 14701 Side effects: populates trails and allit	Line 15344 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 14729 sub extract_categories {	Line 15372 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 14772 Side effects: populates trails and allit	Line 15418 Side effects: populates trails and allit
=cut	=cut

sub recurse_categories {	sub recurse_categories {
my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats) = @_;	my ($cats,$depth,$category,$trails,$allitems,$parents,$subcats,$maxd) = @_;
my $shallower = $depth - 1;	my $shallower = $depth - 1;
if (ref($cats->[$depth]{$category}) eq 'ARRAY') {	if (ref($cats->[$depth]{$category}) eq 'ARRAY') {
for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {	for (my $k=0; $k<@{$cats->[$depth]{$category}}; $k++) {
my $name = $cats->[$depth]{$category}[$k];	my $name = $cats->[$depth]{$category}[$k];
my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;	my $item = &escape($category).':'.&escape($parents->[-1]).':'.$shallower;
my $trailstr = join(' -> ',(@{$parents},$category));	my $trailstr = join(' » ',(@{$parents},$category));
if ($allitems->{$item} eq '') {	if ($allitems->{$item} eq '') {
push(@{$trails},$trailstr);	push(@{$trails},$trailstr);
$allitems->{$item} = scalar(@{$trails})-1;	$allitems->{$item} = scalar(@{$trails})-1;
Line 14799 sub recurse_categories {	Line 15445 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 14840 sub assign_categories_table {	Line 15491 sub assign_categories_table {
my ($cathash,$currcat,$type,$disabled) = @_;	my ($cathash,$currcat,$type,$disabled) = @_;
my $output;	my $output;
if (ref($cathash) eq 'HASH') {	if (ref($cathash) eq 'HASH') {
my (@cats,@trails,%allitems,%idx,@jsarray,@path,$maxdepth);	my (@cats,@trails,%allitems,%idx,@jsarray,%maxd,@path,$maxdepth);
&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray);	&extract_categories($cathash,\@cats,\@trails,\%allitems,\%idx,\@jsarray,\%maxd);
$maxdepth = scalar(@cats);	$maxdepth = scalar(@cats);
if (@cats > 0) {	if (@cats > 0) {
my $itemcount = 0;	my $itemcount = 0;
Line 15772 sub group_term {	Line 16423 sub group_term {
}	}

sub course_types {	sub course_types {
my @types = ('official','unofficial','community','textbook','placement');	my @types = ('official','unofficial','community','textbook','placement','lti');
my %typename = (	my %typename = (
official => 'Official course',	official => 'Official course',
unofficial => 'Unofficial course',	unofficial => 'Unofficial course',
community => 'Community',	community => 'Community',
textbook => 'Textbook course',	textbook => 'Textbook course',
placement => 'Placement test',	placement => 'Placement test',
	lti => 'LTI provider',
);	);
return (\@types,\%typename);	return (\@types,\%typename);
}	}
Line 15858 sub compare_arrays {	Line 16510 sub compare_arrays {
return @difference;	return @difference;
}	}

	sub lon_status_items {
	my %defaults = (
	E => 100,
	W => 4,
	N => 1,
	U => 5,
	threshold => 200,
	sysmail => 2500,
	);
	my %names = (
	E => 'Errors',
	W => 'Warnings',
	N => 'Notices',
	U => 'Unsent',
	);
	return (\%defaults,\%names);
	}

# -------------------------------------------------------- Initialize user login	# -------------------------------------------------------- Initialize user login
sub init_user_environment {	sub init_user_environment {
my ($r, $username, $domain, $authhost, $form, $args) = @_;	my ($r, $username, $domain, $authhost, $form, $args) = @_;
Line 15865 sub init_user_environment {	Line 16535 sub init_user_environment {

my $public=($username eq 'public' && $domain eq 'public');	my $public=($username eq 'public' && $domain eq 'public');

# See if old ID present, if so, remove

my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);	my ($filename,$cookie,$userroles,$firstaccenv,$timerintenv);
my $now=time;	my $now=time;

Line 15888 sub init_user_environment {	Line 16556 sub init_user_environment {
}	}
if (!$cookie) { $cookie="publicuser_$oldest"; }	if (!$cookie) { $cookie="publicuser_$oldest"; }
} else {	} else {
# if this isn't a robot, kill any existing non-robot sessions	# See if old ID present, if so, remove if this isn't a robot,
	# killing any existing non-robot sessions
if (!$args->{'robot'}) {	if (!$args->{'robot'}) {
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 15928 sub init_user_environment {	Line 16613 sub init_user_environment {

my %userenv = &Apache::lonnet::dump('environment',$domain,$username);	my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
my ($tmp) = keys(%userenv);	my ($tmp) = keys(%userenv);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if ($tmp =~ /^(con_lost\|error\|no_such_host)/i) {
} else {
undef(%userenv);	undef(%userenv);
}	}
if (($userenv{'interface'}) && (!$form->{'interface'})) {	if (($userenv{'interface'}) && (!$form->{'interface'})) {
Line 15990 sub init_user_environment {	Line 16674 sub init_user_environment {
}	}
}	}

my %is_adv = ( is_adv => $env{'user.adv'} );
my %domdef;
unless ($domain eq 'public') {	unless ($domain eq 'public') {
%domdef = &Apache::lonnet::get_domain_defaults($domain);	my %is_adv = ( is_adv => $env{'user.adv'} );
}	my %domdef = &Apache::lonnet::get_domain_defaults($domain);

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

foreach my $crstype ('official','unofficial','community','textbook','placement') {	foreach my $crstype ('official','unofficial','community','textbook','placement','lti') {
$userenv{'canrequest.'.$crstype} =	$userenv{'canrequest.'.$crstype} =
&Apache::lonnet::usertools_access($username,$domain,$crstype,	&Apache::lonnet::usertools_access($username,$domain,$crstype,
'reload','requestcourses',	'reload','requestcourses',
\%userenv,\%domdef,\%is_adv);	\%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'};
	}
	}
	my ($types,$typename) = &course_types();
	if (ref($types) eq 'ARRAY') {
	my @options = ('approval','validate','autolimit');
	my $optregex = join('\|',@options);
	my (%willtrust,%trustchecked);
	foreach my $type (@{$types}) {
	my $dom_str = $env{'environment.reqcrsotherdom.'.$type};
	if ($dom_str ne '') {
	my $updatedstr = '';
	my @possdomains = split(',',$dom_str);
	foreach my $entry (@possdomains) {
	my ($extdom,$extopt) = split(':',$entry);
	unless ($trustchecked{$extdom}) {
	$willtrust{$extdom} = &Apache::lonnet::will_trust('reqcrs',$domain,$extdom);
	$trustchecked{$extdom} = 1;
	}
	if ($willtrust{$extdom}) {
	$updatedstr .= $entry.',';
	}
	}
	$updatedstr =~ s/,$//;
	if ($updatedstr) {
	$userenv{'reqcrsotherdom.'.$type} = $updatedstr;
	} else {
	delete($userenv{'reqcrsotherdom.'.$type});
	}
	}
	}
}	}
}	}

$env{'user.environment'} = "$lonids/$cookie.id";	$env{'user.environment'} = "$lonids/$cookie.id";

if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",	if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
Line 16835 sub needs_coursereinit {	Line 17546 sub needs_coursereinit {
$interval = 600;	$interval = 600;
}	}
if (($now-$env{'request.course.timechecked'})>$interval) {	if (($now-$env{'request.course.timechecked'})>$interval) {
my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
&Apache::lonnet::appenv({'request.course.timechecked'=>$now});	&Apache::lonnet::appenv({'request.course.timechecked'=>$now});
	my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
	if ($blocked) {
	return ();
	}
	my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum);
if ($lastchange > $env{'request.course.tied'}) {	if ($lastchange > $env{'request.course.tied'}) {
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');	my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
if ($curr_reqd_hash{'internal.releaserequired'} ne '') {	if ($curr_reqd_hash{'internal.releaserequired'} ne '') {
Line 16859 sub needs_coursereinit {	Line 17574 sub needs_coursereinit {
}	}

sub update_content_constraints {	sub update_content_constraints {
my ($cdom,$cnum,$chome,$cid) = @_;	my ($cdom,$cnum,$chome,$cid,$keeporder) = @_;
my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');	my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired');
my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});	my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'});
my %checkresponsetypes;	my (%checkresponsetypes,%checkcrsrestypes);
foreach my $key (keys(%Apache::lonnet::needsrelease)) {	foreach my $key (keys(%Apache::lonnet::needsrelease)) {
my ($item,$name,$value) = split(/:/,$key);	my ($item,$name,$value) = split(/:/,$key);
if ($item eq 'resourcetag') {	if ($item eq 'resourcetag') {
if ($name eq 'responsetype') {	if ($name eq 'responsetype') {
$checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}	$checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key}
}	}
	} elsif ($item eq 'course') {
	if ($name eq 'courserestype') {
	$checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key};
	}
}	}
}	}
my $navmap = Apache::lonnavmaps::navmap->new();	my $navmap = Apache::lonnavmaps::navmap->new();
if (defined($navmap)) {	if (defined($navmap)) {
my %allresponses;	my (%allresponses,%allcrsrestypes);
foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) {	foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() \|\| $_[0]->is_tool() },1,0)) {
	if ($res->is_tool()) {
	if ($allcrsrestypes{'exttool'}) {
	$allcrsrestypes{'exttool'} ++;
	} else {
	$allcrsrestypes{'exttool'} = 1;
	}
	next;
	}
my %responses = $res->responseTypes();	my %responses = $res->responseTypes();
foreach my $key (keys(%responses)) {	foreach my $key (keys(%responses)) {
next unless(exists($checkresponsetypes{$key}));	next unless(exists($checkresponsetypes{$key}));
Line 16887 sub update_content_constraints {	Line 17614 sub update_content_constraints {
($reqdmajor,$reqdminor) = ($major,$minor);	($reqdmajor,$reqdminor) = ($major,$minor);
}	}
}	}
	foreach my $key (keys(%allcrsrestypes)) {
	my ($major,$minor) = split(/\./,$checkcrsrestypes{$key});
	if (($major > $reqdmajor) \|\| ($major == $reqdmajor && $minor > $reqdminor)) {
	($reqdmajor,$reqdminor) = ($major,$minor);
	}
	}
undef($navmap);	undef($navmap);
}	}
	my (@resources,@order,@resparms,@zombies);
	if ($keeporder) {
	use LONCAPA::map;
	@resources = @LONCAPA::map::resources;
	@order = @LONCAPA::map::order;
	@resparms = @LONCAPA::map::resparms;
	@zombies = @LONCAPA::map::zombies;
	}
	my $suppmap = 'supplemental.sequence';
	my ($suppcount,$supptools,$errors) = (0,0,0);
	($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap,
	$suppcount,$supptools,$errors);
	if ($keeporder) {
	@LONCAPA::map::resources = @resources;
	@LONCAPA::map::order = @order;
	@LONCAPA::map::resparms = @resparms;
	@LONCAPA::map::zombies = @zombies;
	}
	if ($supptools) {
	my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'});
	if (($major > $reqdmajor) \|\| ($major == $reqdmajor && $minor > $reqdminor)) {
	($reqdmajor,$reqdminor) = ($major,$minor);
	}
	}
unless (($reqdmajor eq '') && ($reqdminor eq '')) {	unless (($reqdmajor eq '') && ($reqdminor eq '')) {
&Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);	&Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid);
}	}
Line 16909 sub allmaps_incourse {	Line 17666 sub allmaps_incourse {
if ($lastchange > $env{'request.course.tied'}) {	if ($lastchange > $env{'request.course.tied'}) {
my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");	my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum");
unless ($ferr) {	unless ($ferr) {
&update_content_constraints($cdom,$cnum,$chome,$cid);	&update_content_constraints($cdom,$cnum,$chome,$cid,1);
}	}
}	}
my $navmap = Apache::lonnavmaps::navmap->new();	my $navmap = Apache::lonnavmaps::navmap->new();
Line 16945 sub parse_supplemental_title {	Line 17702 sub parse_supplemental_title {
}	}

sub recurse_supplemental {	sub recurse_supplemental {
my ($cnum,$cdom,$suppmap,$numfiles,$errors) = @_;	my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_;
if ($suppmap) {	if ($suppmap) {
my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);	my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap);
if ($fatal) {	if ($fatal) {
Line 16956 sub recurse_supplemental {	Line 17713 sub recurse_supplemental {
my ($title,$src,$ext,$type,$status)=split(/\:/,$res);	my ($title,$src,$ext,$type,$status)=split(/\:/,$res);
if (($src ne '') && ($status eq 'res')) {	if (($src ne '') && ($status eq 'res')) {
if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {	if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) {
($numfiles,$errors) = &recurse_supplemental($cnum,$cdom,$1,$numfiles,$errors);	($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1,
	$numfiles,$numexttools,$errors);
} else {	} else {
	if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
	$numexttools ++;
	}
$numfiles ++;	$numfiles ++;
}	}
}	}
Line 16965 sub recurse_supplemental {	Line 17726 sub recurse_supplemental {
}	}
}	}
}	}
return ($numfiles,$errors);	return ($numfiles,$numexttools,$errors);
}	}

sub symb_to_docspath {	sub symb_to_docspath {
Line 17039 sub symb_to_docspath {	Line 17800 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 17058 sub captcha_display {	Line 17819 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 17072 sub captcha_response {	Line 17833 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 17120 sub get_captcha_config {	Line 17881 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 17144 sub create_captcha {	Line 17926 sub create_captcha {
last;	last;
}	}
}	}
	if ($output eq '') {
	&Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
	}
return $output;	return $output;
}	}

Line 17201 sub check_recaptcha {	Line 17986 sub check_recaptcha {
my ($privkey,$version) = @_;	my ($privkey,$version) = @_;
my $captcha_chk;	my $captcha_chk;
if ($version >= 2) {	if ($version >= 2) {
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
my %info = (	my %info = (
secret => $privkey,	secret => $privkey,
response => $env{'form.g-recaptcha-response'},	response => $env{'form.g-recaptcha-response'},
remoteip => $ENV{'REMOTE_ADDR'},	remoteip => $ENV{'REMOTE_ADDR'},
);	);
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);	my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify');
	$request->content(join('&',map {
	my $name = escape($_);
	"$name=" . ( ref($info{$_}) eq 'ARRAY'
	? join("&$name=", map {escape($_) } @{$info{$_}})
	: &escape($info{$_}) );
	} keys(%info)));
	my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1);
if ($response->is_success) {	if ($response->is_success) {
my $data = JSON::DWIW->from_json($response->decoded_content);	my $data = JSON::DWIW->from_json($response->decoded_content);
if (ref($data) eq 'HASH') {	if (ref($data) eq 'HASH') {
Line 17271 sub cleanup_html {	Line 18061 sub cleanup_html {

# Checks for critical messages and returns a redirect url if one exists.	# Checks for critical messages and returns a redirect url if one exists.
# $interval indicates how often to check for messages.	# $interval indicates how often to check for messages.
	# $context is the calling context -- roles, grades, contents, menu or flip.
sub critical_redirect {	sub critical_redirect {
my ($interval) = @_;	my ($interval,$context) = @_;
if ((time-$env{'user.criticalcheck.time'})>$interval) {	if ((time-$env{'user.criticalcheck.time'})>$interval) {
	if (($env{'request.course.id'}) && (($context eq 'flip') \|\| ($context eq 'contents'))) {
	my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
	my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
	my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
	if ($blocked) {
	my $checkrole = "cm./$cdom/$cnum";
	if ($env{'request.course.sec'} ne '') {
	$checkrole .= "/$env{'request.course.sec'}";
	}
	unless ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
	($env{'request.role'} !~ m{^st\./$cdom/$cnum})) {
	return;
	}
	}
	}
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},	my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
$env{'user.name'});	$env{'user.name'});
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time});	&Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
Line 17339 sub des_decrypt {	Line 18145 sub des_decrypt {
return $plaintext;	return $plaintext;
}	}

	sub make_short_symbs {
	my ($cdom,$cnum,$navmap) = @_;
	return unless (ref($navmap));
	my ($numnew,@errors);
	my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
	if (@toshorten) {
	my (%maps,%resources,%titles);
	&Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
	'shorturls',$cdom,$cnum);
	my %tocreate;
	if (keys(%resources)) {
	foreach my $item (sort {$a <=> $b} (@toshorten)) {
	my $symb = $resources{$item};
	if ($symb) {
	$tocreate{$cnum.'&'.$symb} = 1;
	}
	}
	}
	if (keys(%tocreate)) {
	my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
	my $su = Short::URL->new(no_vowels => 1);
	my $init = '';
	my (%newunique,%addcourse,%courseonly,%failed);
	# get lock on tiny db
	my $now = time;
	my $lockhash = {
	"lock\0$now" => $env{'user.name'}.
	':'.$env{'user.domain'},
	};
	my $tries = 0;
	my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
	my ($code,$error);
	while (($gotlock ne 'ok') && ($tries<3)) {
	$tries ++;
	sleep 1;
	$gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
	}
	if ($gotlock eq 'ok') {
	$init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
	\%addcourse,\%courseonly,\%failed);
	if (keys(%failed)) {
	my $numfailed = scalar(keys(%failed));
	push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
	}
	if (keys(%newunique)) {
	my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
	if ($putres eq 'ok') {
	$numnew = scalar(keys(%newunique));
	my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
	unless ($newputres eq 'ok') {
	push(@errors,&mt('error: could not store course look-up of short URLs'));
	}
	} else {
	push(@errors,&mt('error: could not store unique six character URLs'));
	}
	}
	my $dellockres = &Apache::lonnet::del_dom('tiny',["lock\0$now"],$cdom);
	unless ($dellockres eq 'ok') {
	push(@errors,&mt('error: could not release lockfile'));
	}
	} else {
	push(@errors,&mt('error: could not obtain lockfile'));
	}
	if (keys(%courseonly)) {
	my $result = &Apache::lonnet::newput('tiny',\%courseonly,$cdom,$cnum);
	if ($result ne 'ok') {
	push(@errors,&mt('error: could not update course look-up of short URLs'));
	}
	}
	}
	}
	return ($numnew,\@errors);
	}

	sub shorten_symbs {
	my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
	return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
	(ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
	(ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
	my (%possibles,%collisions);
	foreach my $key (keys(%{$tocreate})) {
	my $num = String::CRC32::crc32($key);
	my $tiny = $su->encode($num,$init);
	if ($tiny) {
	$possibles{$tiny} = $key;
	}
	}
	if (!$init) {
	$init = 1;
	} else {
	$init ++;
	}
	if (keys(%possibles)) {
	my @posstiny = keys(%possibles);
	my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
	my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
	if (keys(%currtiny)) {
	foreach my $key (keys(%currtiny)) {
	next if ($currtiny{$key} eq '');
	if ($currtiny{$key} eq $possibles{$key}) {
	my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
	unless (($coursetiny->{$tsymb} eq $key) \|\| ($addcourse->{$tsymb} eq $key) \|\| ($courseonly->{$tsymb} eq $key)) {
	$courseonly->{$tsymb} = $key;
	}
	} else {
	$collisions{$possibles{$key}} = 1;
	}
	delete($possibles{$key});
	}
	}
	foreach my $key (keys(%possibles)) {
	$newunique->{$key} = $possibles{$key};
	my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
	unless (($coursetiny->{$tsymb} eq $key) \|\| ($addcourse->{$tsymb} eq $key) \|\| ($courseonly->{$tsymb} eq $key)) {
	$addcourse->{$tsymb} = $key;
	}
	}
	}
	if (keys(%collisions)) {
	if ($init <5) {
	if (!$init) {
	$init = 1;
	} else {
	$init ++;
	}
	$init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
	$newunique,$addcourse,$courseonly,$failed);
	} else {
	foreach my $key (keys(%collisions)) {
	$failed->{$key} = 1;
	}
	}
	}
	return $init;
	}

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

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

1;	1;
__END__;	__END__;

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

Removed from v.1.1268
changed lines
	Added in v.1.1338