loncom/lonnet/perl/lonnet.pm - diff

Return to lonnet.pm CVS log

Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.621 and 1.675

version 1.621, 2005/04/07 08:15:41	version 1.675, 2005/11/01 21:34:04
Line 37 use HTTP::Date;	Line 37 use HTTP::Date;
use vars	use vars
qw(%perlvar %hostname %badServerCache %iphost %spareid %hostdom	qw(%perlvar %hostname %badServerCache %iphost %spareid %hostdom
%libserv %pr %prp $memcache %packagetab	%libserv %pr %prp $memcache %packagetab
%courselogs %accesshash %userrolehash $processmarker $dumpcount	%courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf	%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
%domaindescription %domain_auth_def %domain_auth_arg_def	%domaindescription %domain_auth_def %domain_auth_arg_def
%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit	%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit
Line 47 use IO::Socket;	Line 47 use IO::Socket;
use GDBM_File;	use GDBM_File;
use Apache::Constants qw(:common :http);	use Apache::Constants qw(:common :http);
use HTML::LCParser;	use HTML::LCParser;
	use HTML::Parser;
use Fcntl qw(:flock);	use Fcntl qw(:flock);
use Apache::lonlocal;	use Apache::lonlocal;
use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);	use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
Line 165 sub reply {	Line 166 sub reply {
unless (defined($hostname{$server})) { return 'no_such_host'; }	unless (defined($hostname{$server})) { return 'no_such_host'; }
my $answer=subreply($cmd,$server);	my $answer=subreply($cmd,$server);
if (($answer=~/^refused/) \|\| ($answer=~/^rejected/)) {	if (($answer=~/^refused/) \|\| ($answer=~/^rejected/)) {
&logthis("<font color=blue>WARNING:".	&logthis("<font color=\"blue\">WARNING:".
" $cmd to $server returned $answer</font>");	" $cmd to $server returned $answer</font>");
}	}
return $answer;	return $answer;
Line 189 sub reconlonc {	Line 190 sub reconlonc {
sleep 5;	sleep 5;
if (-e "$peerfile") { return; }	if (-e "$peerfile") { return; }
&logthis(	&logthis(
"<font color=blue>WARNING: $peerfile still not there, giving up</font>");	"<font color=\"blue\">WARNING: $peerfile still not there, giving up</font>");
} else {	} else {
&logthis(	&logthis(
"<font color=blue>WARNING:".	"<font color=\"blue\">WARNING:".
" lonc at pid $loncpid not responding, giving up</font>");	" lonc at pid $loncpid not responding, giving up</font>");
}	}
} else {	} else {
&logthis('<font color=blue>WARNING: lonc not running, giving up</font>');	&logthis('<font color="blue">WARNING: lonc not running, giving up</font>');
}	}
}	}

Line 205 sub reconlonc {	Line 206 sub reconlonc {
sub critical {	sub critical {
my ($cmd,$server)=@_;	my ($cmd,$server)=@_;
unless ($hostname{$server}) {	unless ($hostname{$server}) {
&logthis("<font color=blue>WARNING:".	&logthis("<font color=\"blue\">WARNING:".
" Critical message to unknown server ($server)</font>");	" Critical message to unknown server ($server)</font>");
return 'no_such_host';	return 'no_such_host';
}	}
Line 239 sub critical {	Line 240 sub critical {
}	}
chomp($wcmd);	chomp($wcmd);
if ($wcmd eq $cmd) {	if ($wcmd eq $cmd) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
"Connection buffer $dfilename: $cmd</font>");	"Connection buffer $dfilename: $cmd</font>");
&logperm("D:$server:$cmd");	&logperm("D:$server:$cmd");
return 'con_delayed';	return 'con_delayed';
} else {	} else {
&logthis("<font color=red>CRITICAL:"	&logthis("<font color=\"red\">CRITICAL:"
." Critical connection failed: $server $cmd</font>");	." Critical connection failed: $server $cmd</font>");
&logperm("F:$server:$cmd");	&logperm("F:$server:$cmd");
return 'con_failed';	return 'con_failed';
Line 289 sub appenv {	Line 290 sub appenv {
my %newenv=@_;	my %newenv=@_;
foreach (keys %newenv) {	foreach (keys %newenv) {
if (($newenv{$_}=~/^user\.role/) \|\| ($newenv{$_}=~/^user\.priv/)) {	if (($newenv{$_}=~/^user\.role/) \|\| ($newenv{$_}=~/^user\.priv/)) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
"Attempt to modify environment ".$_." to ".$newenv{$_}	"Attempt to modify environment ".$_." to ".$newenv{$_}
.'</font>');	.'</font>');
delete($newenv{$_});	delete($newenv{$_});
Line 303 sub appenv {	Line 304 sub appenv {
return 'error: '.$!;	return 'error: '.$!;
}	}
unless (flock($lockfh,LOCK_EX)) {	unless (flock($lockfh,LOCK_EX)) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
'Could not obtain exclusive lock in appenv: '.$!);	'Could not obtain exclusive lock in appenv: '.$!);
close($lockfh);	close($lockfh);
return 'error: '.$!;	return 'error: '.$!;
Line 348 sub delenv {	Line 349 sub delenv {
my $delthis=shift;	my $delthis=shift;
my %newenv=();	my %newenv=();
if (($delthis=~/user\.role/) \|\| ($delthis=~/user\.priv/)) {	if (($delthis=~/user\.role/) \|\| ($delthis=~/user\.priv/)) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
"Attempt to delete from environment ".$delthis);	"Attempt to delete from environment ".$delthis);
return 'error';	return 'error';
}	}
Line 359 sub delenv {	Line 360 sub delenv {
return 'error';	return 'error';
}	}
unless (flock($fh,LOCK_SH)) {	unless (flock($fh,LOCK_SH)) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
'Could not obtain shared lock in delenv: '.$!);	'Could not obtain shared lock in delenv: '.$!);
close($fh);	close($fh);
return 'error: '.$!;	return 'error: '.$!;
Line 373 sub delenv {	Line 374 sub delenv {
return 'error';	return 'error';
}	}
unless (flock($fh,LOCK_EX)) {	unless (flock($fh,LOCK_EX)) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
'Could not obtain exclusive lock in delenv: '.$!);	'Could not obtain exclusive lock in delenv: '.$!);
close($fh);	close($fh);
return 'error: '.$!;	return 'error: '.$!;
Line 442 sub overloaderror {	Line 443 sub overloaderror {
# ------------------------------ Find server with least workload from spare.tab	# ------------------------------ Find server with least workload from spare.tab

sub spareserver {	sub spareserver {
my ($loadpercent,$userloadpercent) = @_;	my ($loadpercent,$userloadpercent,$want_server_name) = @_;
my $tryserver;	my $tryserver;
my $spareserver='';	my $spareserver='';
if ($userloadpercent !~ /\d/) { $userloadpercent=0; }	if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
my $lowestserver=$loadpercent > $userloadpercent?	my $lowestserver=$loadpercent > $userloadpercent?
$loadpercent : $userloadpercent;	$loadpercent : $userloadpercent;
foreach $tryserver (keys %spareid) {	foreach $tryserver (keys(%spareid)) {
my $loadans=reply('load',$tryserver);	my $loadans=&reply('load',$tryserver);
my $userloadans=reply('userload',$tryserver);	my $userloadans=&reply('userload',$tryserver);
if ($loadans !~ /\d/ && $userloadans !~ /\d/) {	if ($loadans !~ /\d/ && $userloadans !~ /\d/) {
next; #didn't get a number from the server	next; #didn't get a number from the server
}	}
Line 467 sub spareserver {	Line 468 sub spareserver {
$answer = $userloadans;	$answer = $userloadans;
}	}
if (($answer =~ /\d/) && ($answer<$lowestserver)) {	if (($answer =~ /\d/) && ($answer<$lowestserver)) {
$spareserver="http://$hostname{$tryserver}";	if ($want_server_name) {
	$spareserver=$tryserver;
	} else {
	$spareserver="http://$hostname{$tryserver}";
	}
$lowestserver=$answer;	$lowestserver=$answer;
}	}
}	}
Line 766 sub validate_access_key {	Line 771 sub validate_access_key {
}	}

# ------------------------------------- Find the section of student in a course	# ------------------------------------- Find the section of student in a course
	sub devalidate_getsection_cache {
	my ($udom,$unam,$courseid)=@_;
	$courseid=~s/\_/\//g;
	$courseid=~s/^(\w)/\/$1/;
	my $hashid="$udom:$unam:$courseid";
	&devalidate_cache_new('getsection',$hashid);
	}

sub getsection {	sub getsection {
my ($udom,$unam,$courseid)=@_;	my ($udom,$unam,$courseid)=@_;
Line 827 sub getsection {	Line 839 sub getsection {
}	}

sub save_cache {	sub save_cache {
	my ($r)=@_;
	if (! $r->is_initial_req()) { return DECLINED; }
&purge_remembered();	&purge_remembered();
undef(%env);	undef(%env);
	return OK;
}	}

my $to_remember=-1;	my $to_remember=-1;
Line 875 sub do_cache_new {	Line 890 sub do_cache_new {
if (!defined($setvalue)) {	if (!defined($setvalue)) {
$setvalue='__undef__';	$setvalue='__undef__';
}	}
	if (!defined($time) ) {
	$time=600;
	}
if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }	if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
$memcache->set($id,$setvalue,$time);	$memcache->set($id,$setvalue,$time);
# need to make a copy of $value	# need to make a copy of $value
Line 1046 sub repcopy {	Line 1064 sub repcopy {
if ($response->is_error()) {	if ($response->is_error()) {
unlink($transname);	unlink($transname);
my $message=$response->status_line;	my $message=$response->status_line;
&logthis("<font color=blue>WARNING:"	&logthis("<font color=\"blue\">WARNING:"
." LWP get: $message: $filename</font>");	." LWP get: $message: $filename</font>");
return 'unavailable';	return 'unavailable';
} else {	} else {
Line 1056 sub repcopy {	Line 1074 sub repcopy {
if ($mresponse->is_error()) {	if ($mresponse->is_error()) {
unlink($filename.'.meta');	unlink($filename.'.meta');
&logthis(	&logthis(
"<font color=yellow>INFO: No metadata: $filename</font>");	"<font color=\"yellow\">INFO: No metadata: $filename</font>");
}	}
}	}
rename($transname,$filename);	rename($transname,$filename);
Line 1125 sub allowuploaded {	Line 1143 sub allowuploaded {
}	}

# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course	# --------- File operations in /home/httpd/html/userfiles/$domain/1/2/3/$course
# input: action, courseID, current domain, home server for course, intended	# input: action, courseID, current domain, intended
# path to file, source of file.	# path to file, source of file, instruction to parse file for objects,
	# ref to hash for embedded objects,
	# ref to hash for codebase of java objects.
	#
# output: url to file (if action was uploaddoc),	# output: url to file (if action was uploaddoc),
# ok if successful, or diagnostic message otherwise (if action was propagate or copy)	# ok if successful, or diagnostic message otherwise (if action was propagate or copy)
#	#
Line 1149 sub allowuploaded {	Line 1170 sub allowuploaded {
# /home/httpd/html/userfiles/$domain/1/2/3/$course/$file	# /home/httpd/html/userfiles/$domain/1/2/3/$course/$file
# and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file	# and will then be copied to /home/httpd/lonUsers/1/2/3/$course/userfiles/$file
# in course's home server.	# in course's home server.
	#

sub process_coursefile {	sub process_coursefile {
my ($action,$docuname,$docudom,$docuhome,$file,$source)=@_;	my ($action,$docuname,$docudom,$file,$source,$parser,$allfiles,$codebase)=@_;
my $fetchresult;	my $fetchresult;
	my $home=&homeserver($docuname,$docudom);
if ($action eq 'propagate') {	if ($action eq 'propagate') {
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file	$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
,$docuhome);	$home);
} else {	} else {
my $fetchresult = '';
my $fpath = '';	my $fpath = '';
my $fname = $file;	my $fname = $file;
($fpath,$fname) = ($file =~ m\|^(.*)/([^/]+)$\|);	($fpath,$fname) = ($file =~ m\|^(.*)/([^/]+)$\|);
$fpath=$docudom.'/'.$docuname.'/'.$fpath;	$fpath=$docudom.'/'.$docuname.'/'.$fpath;
my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';	my $filepath = &build_filepath($fpath);
unless ($fpath eq '') {
my @parts=split('/',$fpath);
foreach my $part (@parts) {
$filepath.= '/'.$part;
if ((-e $filepath)!=1) {
mkdir($filepath,0777);
}
}
}
if ($action eq 'copy') {	if ($action eq 'copy') {
if ($source eq '') {	if ($source eq '') {
$fetchresult = 'no source file';	$fetchresult = 'no source file';
Line 1181 sub process_coursefile {	Line 1193 sub process_coursefile {
my $destination = $filepath.'/'.$fname;	my $destination = $filepath.'/'.$fname;
rename($source,$destination);	rename($source,$destination);
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,	$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
$docuhome);	$home);
}	}
} elsif ($action eq 'uploaddoc') {	} elsif ($action eq 'uploaddoc') {
open(my $fh,'>'.$filepath.'/'.$fname);	open(my $fh,'>'.$filepath.'/'.$fname);
print $fh $env{'form.'.$source};	print $fh $env{'form.'.$source};
close($fh);	close($fh);
	if ($parser eq 'parse') {
	my $parse_result = &extract_embedded_items($filepath,$fname,$allfiles,$codebase);
	unless ($parse_result eq 'ok') {
	&logthis('Failed to parse '.$filepath.'/'.$fname.' for embedded media: '.$parse_result);
	}
	}
$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,	$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
$docuhome);	$home);
if ($fetchresult eq 'ok') {	if ($fetchresult eq 'ok') {
return '/uploaded/'.$fpath.'/'.$fname;	return '/uploaded/'.$fpath.'/'.$fname;
} else {	} else {
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.	&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
' to host '.$docuhome.': '.$fetchresult);	' to host '.$home.': '.$fetchresult);
return '/adm/notfound.html';	return '/adm/notfound.html';
}	}
}	}
}	}
unless ( $fetchresult eq 'ok') {	unless ( $fetchresult eq 'ok') {
&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.	&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
' to host '.$docuhome.': '.$fetchresult);	' to host '.$home.': '.$fetchresult);
}	}
return $fetchresult;	return $fetchresult;
}	}

	sub build_filepath {
	my ($fpath) = @_;
	my $filepath=$perlvar{'lonDocRoot'}.'/userfiles';
	unless ($fpath eq '') {
	my @parts=split('/',$fpath);
	foreach my $part (@parts) {
	$filepath.= '/'.$part;
	if ((-e $filepath)!=1) {
	mkdir($filepath,0777);
	}
	}
	}
	return $filepath;
	}

	sub store_edited_file {
	my ($primary_url,$content,$docudom,$docuname,$fetchresult) = @_;
	my $file = $primary_url;
	$file =~ s#^/uploaded/$docudom/$docuname/##;
	my $fpath = '';
	my $fname = $file;
	($fpath,$fname) = ($file =~ m\|^(.*)/([^/]+)$\|);
	$fpath=$docudom.'/'.$docuname.'/'.$fpath;
	my $filepath = &build_filepath($fpath);
	open(my $fh,'>'.$filepath.'/'.$fname);
	print $fh $content;
	close($fh);
	my $home=&homeserver($docuname,$docudom);
	$$fetchresult= &reply('fetchuserfile:'.$docudom.'/'.$docuname.'/'.$file,
	$home);
	if ($$fetchresult eq 'ok') {
	return '/uploaded/'.$fpath.'/'.$fname;
	} else {
	&logthis('Failed to transfer '.$docudom.'/'.$docuname.'/'.$file.
	' to host '.$home.': '.$$fetchresult);
	return '/adm/notfound.html';
	}
	}

sub clean_filename {	sub clean_filename {
my ($fname)=@_;	my ($fname)=@_;
# Replace Windows backslashes by forward slashes	# Replace Windows backslashes by forward slashes
Line 1227 sub clean_filename {	Line 1284 sub clean_filename {


sub userfileupload {	sub userfileupload {
my ($formname,$coursedoc,$subdir)=@_;	my ($formname,$coursedoc,$subdir,$parser,$allfiles,$codebase)=@_;
if (!defined($subdir)) { $subdir='unknown'; }	if (!defined($subdir)) { $subdir='unknown'; }
my $fname=$env{'form.'.$formname.'.filename'};	my $fname=$env{'form.'.$formname.'.filename'};
$fname=&clean_filename($fname);	$fname=&clean_filename($fname);
Line 1251 sub userfileupload {	Line 1308 sub userfileupload {
return $fullpath.'/'.$fname;	return $fullpath.'/'.$fname;
}	}
# Create the directory if not present	# Create the directory if not present
my $docuname='';
my $docudom='';
my $docuhome='';
$fname="$subdir/$fname";	$fname="$subdir/$fname";
if ($coursedoc) {	if ($coursedoc) {
$docuname=$env{'course.'.$env{'request.course.id'}.'.num'};	my $docuname=$env{'course.'.$env{'request.course.id'}.'.num'};
$docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};	my $docudom=$env{'course.'.$env{'request.course.id'}.'.domain'};
$docuhome=$env{'course.'.$env{'request.course.id'}.'.home'};	if ($env{'form.folder'} =~ m/^(default\|supplemental)/) {
if ($env{'form.folder'} =~ m/^default/) {	return &finishuserfileupload($docuname,$docudom,
return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);	$formname,$fname,$parser,$allfiles,
	$codebase);
} else {	} else {
$fname=$env{'form.folder'}.'/'.$fname;	$fname=$env{'form.folder'}.'/'.$fname;
return &process_coursefile('uploaddoc',$docuname,$docudom,$docuhome,$fname,$formname);	return &process_coursefile('uploaddoc',$docuname,$docudom,
	$fname,$formname,$parser,
	$allfiles,$codebase);
}	}
} else {	} else {
$docuname=$env{'user.name'};	my $docuname=$env{'user.name'};
$docudom=$env{'user.domain'};	my $docudom=$env{'user.domain'};
$docuhome=$env{'user.home'};	return &finishuserfileupload($docuname,$docudom,$formname,
return &finishuserfileupload($docuname,$docudom,$docuhome,$formname,$fname);	$fname,$parser,$allfiles,$codebase);
}	}
}	}

sub finishuserfileupload {	sub finishuserfileupload {
my ($docuname,$docudom,$docuhome,$formname,$fname)=@_;	my ($docuname,$docudom,$formname,$fname,$parser,$allfiles,$codebase) = @_;
my $path=$docudom.'/'.$docuname.'/';	my $path=$docudom.'/'.$docuname.'/';
my $filepath=$perlvar{'lonDocRoot'};	my $filepath=$perlvar{'lonDocRoot'};
my ($fnamepath,$file);	my ($fnamepath,$file);
Line 1297 sub finishuserfileupload {	Line 1354 sub finishuserfileupload {
print FH $env{'form.'.$formname};	print FH $env{'form.'.$formname};
close(FH);	close(FH);
}	}
	if ($parser eq 'parse') {
	my $parse_result = &extract_embedded_items($filepath,$file,$allfiles,
	$codebase);
	unless ($parse_result eq 'ok') {
	&logthis('Failed to parse '.$filepath.$file.
	' for embedded media: '.$parse_result);
	}
	}
# Notify homeserver to grep it	# Notify homeserver to grep it
#	#
	my $docuhome=&homeserver($docuname,$docudom);
my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);	my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
if ($fetchresult eq 'ok') {	if ($fetchresult eq 'ok') {
#	#
Line 1311 sub finishuserfileupload {	Line 1377 sub finishuserfileupload {
}	}
}	}

	sub extract_embedded_items {
	my ($filepath,$file,$allfiles,$codebase,$content) = @_;
	my @state = ();
	my %javafiles = (
	codebase => '',
	code => '',
	archive => ''
	);
	my %mediafiles = (
	src => '',
	movie => '',
	);
	my $p;
	if ($content) {
	$p = HTML::LCParser->new($content);
	} else {
	$p = HTML::LCParser->new($filepath.'/'.$file);
	}
	while (my $t=$p->get_token()) {
	if ($t->[0] eq 'S') {
	my ($tagname, $attr) = ($t->[1],$t->[2]);
	push (@state, $tagname);
	if (lc($tagname) eq 'allow') {
	&add_filetype($allfiles,$attr->{'src'},'src');
	}
	if (lc($tagname) eq 'img') {
	&add_filetype($allfiles,$attr->{'src'},'src');
	}
	if (lc($tagname) eq 'script') {
	if ($attr->{'archive'} =~ /\.jar$/i) {
	&add_filetype($allfiles,$attr->{'archive'},'archive');
	} else {
	&add_filetype($allfiles,$attr->{'src'},'src');
	}
	}
	if (lc($tagname) eq 'link') {
	if (lc($attr->{'rel'}) eq 'stylesheet') {
	&add_filetype($allfiles,$attr->{'href'},'href');
	}
	}
	if (lc($tagname) eq 'object' \|\|
	(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')) {
	foreach my $item (keys(%javafiles)) {
	$javafiles{$item} = '';
	}
	}
	if (lc($state[-2]) eq 'object' && lc($tagname) eq 'param') {
	my $name = lc($attr->{'name'});
	foreach my $item (keys(%javafiles)) {
	if ($name eq $item) {
	$javafiles{$item} = $attr->{'value'};
	last;
	}
	}
	foreach my $item (keys(%mediafiles)) {
	if ($name eq $item) {
	&add_filetype($allfiles, $attr->{'value'}, 'value');
	last;
	}
	}
	}
	if (lc($tagname) eq 'embed' \|\| lc($tagname) eq 'applet') {
	foreach my $item (keys(%javafiles)) {
	if ($attr->{$item}) {
	$javafiles{$item} = $attr->{$item};
	last;
	}
	}
	foreach my $item (keys(%mediafiles)) {
	if ($attr->{$item}) {
	&add_filetype($allfiles,$attr->{$item},$item);
	last;
	}
	}
	}
	} elsif ($t->[0] eq 'E') {
	my ($tagname) = ($t->[1]);
	if ($javafiles{'codebase'} ne '') {
	$javafiles{'codebase'} .= '/';
	}
	if (lc($tagname) eq 'applet' \|\|
	lc($tagname) eq 'object' \|\|
	(lc($tagname) eq 'embed' && lc($state[-2]) ne 'object')
	) {
	foreach my $item (keys(%javafiles)) {
	if ($item ne 'codebase' && $javafiles{$item} ne '') {
	my $file=$javafiles{'codebase'}.$javafiles{$item};
	&add_filetype($allfiles,$file,$item);
	}
	}
	}
	pop @state;
	}
	}
	return 'ok';
	}

	sub add_filetype {
	my ($allfiles,$file,$type)=@_;
	if (exists($allfiles->{$file})) {
	unless (grep/^\Q$type\E$/, @{$allfiles->{$file}}) {
	push(@{$allfiles->{$file}}, &escape($type));
	}
	} else {
	@{$allfiles->{$file}} = (&escape($type));
	}
	}

sub removeuploadedurl {	sub removeuploadedurl {
my ($url)=@_;	my ($url)=@_;
my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);	my (undef,undef,$udom,$uname,$fname)=split('/',$url,5);
Line 1368 sub flushcourselogs {	Line 1542 sub flushcourselogs {
} else {	} else {
&logthis('Failed to flush log buffer for '.$crsid);	&logthis('Failed to flush log buffer for '.$crsid);
if (length($courselogs{$crsid})>40000) {	if (length($courselogs{$crsid})>40000) {
&logthis("<font color=blue>WARNING: Buffer for ".$crsid.	&logthis("<font color=\"blue\">WARNING: Buffer for ".$crsid.
" exceeded maximum size, deleting.</font>");	" exceeded maximum size, deleting.</font>");
delete $courselogs{$crsid};	delete $courselogs{$crsid};
}	}
Line 1439 sub flushcourselogs {	Line 1613 sub flushcourselogs {
delete $userrolehash{$entry};	delete $userrolehash{$entry};
}	}
}	}
	#
	# Reverse lookup of domain roles (dc, ad, li, sc, au)
	#
	my %domrolebuffer = ();
	foreach my $entry (keys %domainrolehash) {
	my ($role,$uname,$udom,$runame,$rudom,$rsec)=split/:/,$entry;
	if ($domrolebuffer{$rudom}) {
	$domrolebuffer{$rudom}.='&'.&escape($entry).
	'='.&escape($domainrolehash{$entry});
	} else {
	$domrolebuffer{$rudom}.=&escape($entry).
	'='.&escape($domainrolehash{$entry});
	}
	delete $domainrolehash{$entry};
	}
	foreach my $dom (keys(%domrolebuffer)) {
	foreach my $tryserver (keys %libserv) {
	if ($hostdom{$tryserver} eq $dom) {
	unless (&reply('domroleput:'.$dom.':'.
	$domrolebuffer{$dom},$tryserver) eq 'ok') {
	&logthis('Put of domain roles failed for '.$dom.' and '.$tryserver);
	}
	}
	}
	}
$dumpcount++;	$dumpcount++;
}	}

Line 1472 sub courseacclog {	Line 1671 sub courseacclog {
my $fnsymb=shift;	my $fnsymb=shift;
unless ($env{'request.course.id'}) { return ''; }	unless ($env{'request.course.id'}) { return ''; }
my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'};	my $what=$fnsymb.':'.$env{'user.name'}.':'.$env{'user.domain'};
if ($fnsymb=~/(problem\|exam\|quiz\|assess\|survey\|form\|page)$/) {	if ($fnsymb=~/(problem\|exam\|quiz\|assess\|survey\|form\|task\|page)$/) {
$what.=':POST';	$what.=':POST';
# FIXME: Probably ought to escape things....	# FIXME: Probably ought to escape things....
foreach (keys %env) {	foreach (keys %env) {
Line 1514 sub linklog {	Line 1713 sub linklog {

sub userrolelog {	sub userrolelog {
my ($trole,$username,$domain,$area,$tstart,$tend)=@_;	my ($trole,$username,$domain,$area,$tstart,$tend)=@_;
if (($trole=~/^ca/) \|\| ($trole=~/^in/) \|\|	if (($trole=~/^ca/) \|\| ($trole=~/^aa/) \|\|
($trole=~/^cc/) \|\| ($trole=~/^ep/) \|\|	($trole=~/^in/) \|\| ($trole=~/^cc/) \|\|
($trole=~/^cr/) \|\| ($trole=~/^ta/)) {	($trole=~/^ep/) \|\| ($trole=~/^cr/) \|\|
	($trole=~/^ta/)) {
my (undef,$rudom,$runame,$rsec)=split(/\//,$area);	my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
$userrolehash	$userrolehash
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}	{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
=$tend.':'.$tstart;	=$tend.':'.$tstart;
}	}
	if (($trole=~/^dc/) \|\| ($trole=~/^ad/) \|\|
	($trole=~/^li/) \|\| ($trole=~/^li/) \|\|
	($trole=~/^au/) \|\| ($trole=~/^dg/) \|\|
	($trole=~/^sc/)) {
	my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
	$domainrolehash
	{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
	= $tend.':'.$tstart;
	}
}	}

sub get_course_adv_roles {	sub get_course_adv_roles {
Line 1545 sub get_course_adv_roles {	Line 1754 sub get_course_adv_roles {
if ($username eq '' \|\| $domain eq '') { next; }	if ($username eq '' \|\| $domain eq '') { next; }
if ((&privileged($username,$domain)) &&	if ((&privileged($username,$domain)) &&
(!$nothide{$username.':'.$domain})) { next; }	(!$nothide{$username.':'.$domain})) { next; }
	if ($role eq 'cr') { next; }
my $key=&plaintext($role);	my $key=&plaintext($role);
	if ($role =~ /^cr/) {
	$key=(split('/',$role))[3];
	}
if ($section) { $key.=' (Sec/Grp '.$section.')'; }	if ($section) { $key.=' (Sec/Grp '.$section.')'; }
if ($returnhash{$key}) {	if ($returnhash{$key}) {
$returnhash{$key}.=','.$username.':'.$domain;	$returnhash{$key}.=','.$username.':'.$domain;
Line 1614 sub courseidput {	Line 1827 sub courseidput {
}	}

sub courseiddump {	sub courseiddump {
my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$hostidflag,$hostidref)=@_;	my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$coursefilter,$hostidflag,$hostidref)=@_;
my %returnhash=();	my %returnhash=();
unless ($domfilter) { $domfilter=''; }	unless ($domfilter) { $domfilter=''; }
foreach my $tryserver (keys %libserv) {	foreach my $tryserver (keys %libserv) {
Line 1623 sub courseiddump {	Line 1836 sub courseiddump {
foreach (	foreach (
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.	split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
$sincefilter.':'.&escape($descfilter).':'.	$sincefilter.':'.&escape($descfilter).':'.
&escape($instcodefilter).':'.&escape($ownerfilter),	&escape($instcodefilter).':'.&escape($ownerfilter).':'.&escape($coursefilter),
$tryserver))) {	$tryserver))) {
my ($key,$value)=split(/\=/,$_);	my ($key,$value)=split(/\=/,$_);
if (($key) && ($value)) {	if (($key) && ($value)) {
Line 1636 sub courseiddump {	Line 1849 sub courseiddump {
return %returnhash;	return %returnhash;
}	}

#	# ---------------------------------------------------------- DC e-mail

	sub dcmailput {
	my ($domain,$msgid,$contents,$server)=@_;
	my $status = &Apache::lonnet::critical(
	'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='.
	&Apache::lonnet::escape($$contents{$server}),$server);
	return $status;
	}

	sub dcmaildump {
	my ($dom,$startdate,$enddate,$senders) = @_;
	my %returnhash=();
	foreach my $tryserver (keys(%libserv)) {
	if ($hostdom{$tryserver} eq $dom) {
	%{$returnhash{$tryserver}}=();
	my $cmd='dcmaildump:'.$dom.':'.
	&escape($startdate).':'.&escape($enddate).':';
	my @esc_senders=map { &escape($_)} @$senders;
	$cmd.=&escape(join('&',@esc_senders));
	foreach (split(/\&/,&reply($cmd,$tryserver))) {
	my ($key,$value) = split(/\=/,$_);
	if (($key) && ($value)) {
	$returnhash{$tryserver}{&unescape($key)} = &unescape($value);
	}
	}
	}
	}
	return %returnhash;
	}
	# ---------------------------------------------------------- Domain roles

	sub get_domain_roles {
	my ($dom,$roles,$startdate,$enddate)=@_;
	if (undef($startdate) \|\| $startdate eq '') {
	$startdate = '.';
	}
	if (undef($enddate) \|\| $enddate eq '') {
	$enddate = '.';
	}
	my $rolelist = join(':',@{$roles});
	my %personnel = ();
	foreach my $tryserver (keys(%libserv)) {
	if ($hostdom{$tryserver} eq $dom) {
	%{$personnel{$tryserver}}=();
	foreach (
	split(/\&/,&reply('domrolesdump:'.$dom.':'.
	&escape($startdate).':'.&escape($enddate).':'.
	&escape($rolelist), $tryserver))) {
	my($key,$value) = split(/\=/,$_);
	if (($key) && ($value)) {
	$personnel{$tryserver}{&unescape($key)} = &unescape($value);
	}
	}
	}
	}
	return %personnel;
	}

# ----------------------------------------------------------- Check out an item	# ----------------------------------------------------------- Check out an item

sub get_first_access {	sub get_first_access {
Line 1682 sub checkout {	Line 1953 sub checkout {
$now.'&'.$ENV{'REMOTE_ADDR'});	$now.'&'.$ENV{'REMOTE_ADDR'});
my $token=&reply('tmpput:'.$infostr,$lonhost);	my $token=&reply('tmpput:'.$infostr,$lonhost);
if ($token=~/^error\:/) {	if ($token=~/^error\:/) {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
"Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.	"Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb.
"</font>");	"</font>");
return '';	return '';
Line 1698 sub checkout {	Line 1969 sub checkout {
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {	unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
return '';	return '';
} else {	} else {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
"Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.	"Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb.
"</font>");	"</font>");
}	}
Line 1708 sub checkout {	Line 1979 sub checkout {
$token)) ne 'ok') {	$token)) ne 'ok') {
return '';	return '';
} else {	} else {
&logthis("<font color=blue>WARNING: ".	&logthis("<font color=\"blue\">WARNING: ".
"Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.	"Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb.
"</font>");	"</font>");
}	}
Line 2311 sub rolesinit {	Line 2582 sub rolesinit {
if ($_!~/^rolesdef_/) {	if ($_!~/^rolesdef_/) {
my ($area,$role)=split(/=/,$_);	my ($area,$role)=split(/=/,$_);
$area=~s/\_\w\w$//;	$area=~s/\_\w\w$//;

my ($trole,$tend,$tstart);	my ($trole,$tend,$tstart);
if ($role=~/^cr/) {	if ($role=~/^cr/) {
($trole,my $trest)=($role=~m\|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$\|);	if ($role=~m\|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$\|) {
($tend,$tstart)=split('_',$trest);	($trole,my $trest)=($role=~m\|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$\|);
	($tend,$tstart)=split('_',$trest);
	} else {
	$trole=$role;
	}
} else {	} else {
($trole,$tend,$tstart)=split(/_/,$role);	($trole,$tend,$tstart)=split(/_/,$role);
}	}
Line 2331 sub rolesinit {	Line 2605 sub rolesinit {
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);	&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
}	}
}	}
}	}
}	}
my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);	my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
$userroles.='user.adv='.$adv."\n".	$userroles.='user.adv='.$adv."\n".
Line 2558 sub convert_dump_to_currentdump{	Line 2832 sub convert_dump_to_currentdump{
return \%returnhash;	return \%returnhash;
}	}

	# ------------------------------------------------------ critical inc interface

	sub cinc {
	return &inc(@_,'critical');
	}

# --------------------------------------------------------------- inc interface	# --------------------------------------------------------------- inc interface

sub inc {	sub inc {
my ($namespace,$store,$udomain,$uname) = @_;	my ($namespace,$store,$udomain,$uname,$critical) = @_;
if (!$udomain) { $udomain=$env{'user.domain'}; }	if (!$udomain) { $udomain=$env{'user.domain'}; }
if (!$uname) { $uname=$env{'user.name'}; }	if (!$uname) { $uname=$env{'user.name'}; }
my $uhome=&homeserver($uname,$udomain);	my $uhome=&homeserver($uname,$udomain);
Line 2579 sub inc {	Line 2859 sub inc {
}	}
}	}
$items=~s/\&$//;	$items=~s/\&$//;
return &reply("inc:$udomain:$uname:$namespace:$items",$uhome);	if ($critical) {
	return &critical("inc:$udomain:$uname:$namespace:$items",$uhome);
	} else {
	return &reply("inc:$udomain:$uname:$namespace:$items",$uhome);
	}
}	}

# --------------------------------------------------------------- put interface	# --------------------------------------------------------------- put interface
Line 2597 sub put {	Line 2881 sub put {
return &reply("put:$udomain:$uname:$namespace:$items",$uhome);	return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
}	}

# ---------------------------------------------------------- putstore interface	# ------------------------------------------------------------ newput interface

	sub newput {
	my ($namespace,$storehash,$udomain,$uname)=@_;
	if (!$udomain) { $udomain=$env{'user.domain'}; }
	if (!$uname) { $uname=$env{'user.name'}; }
	my $uhome=&homeserver($uname,$udomain);
	my $items='';
	foreach my $key (keys(%$storehash)) {
	$items.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
	}
	$items=~s/\&$//;
	return &reply("newput:$udomain:$uname:$namespace:$items",$uhome);
	}

	# --------------------------------------------------------- putstore interface

sub putstore {	sub putstore {
my ($namespace,$storehash,$udomain,$uname)=@_;	my ($namespace,$storehash,$udomain,$uname)=@_;
if (!$udomain) { $udomain=$env{'user.domain'}; }	if (!$udomain) { $udomain=$env{'user.domain'}; }
Line 2659 sub eget {	Line 2958 sub eget {
return %returnhash;	return %returnhash;
}	}

	# ------------------------------------------------------------ tmpput interface
	sub tmpput {
	my ($storehash,$server)=@_;
	my $items='';
	foreach (keys(%$storehash)) {
	$items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
	}
	$items=~s/\&$//;
	return &reply("tmpput:$items",$server);
	}

	# ------------------------------------------------------------ tmpget interface
	sub tmpget {
	my ($token)=@_;
	my $rep=&reply("tmpget:$token",$perlvar{'lonHostID'});
	my %returnhash;
	foreach my $item (split(/\&/,$rep)) {
	my ($key,$value)=split(/=/,$item);
	$returnhash{&unescape($key)}=&thaw_unescape($value);
	}
	return %returnhash;
	}

# ---------------------------------------------- Custom access rule evaluation	# ---------------------------------------------- Custom access rule evaluation

sub customaccess {	sub customaccess {
Line 2712 sub allowed {	Line 3034 sub allowed {

# Free bre access to user's own portfolio contents	# Free bre access to user's own portfolio contents
my ($space,$domain,$name,$dir)=split('/',$uri);	my ($space,$domain,$name,$dir)=split('/',$uri);
if (($space=~/^(uploaded\|ediupload)$/) && ($env{'user.name'} eq $name) &&	if (($space=~/^(uploaded\|editupload)$/) && ($env{'user.name'} eq $name) &&
($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir)) {
return 'F';	return 'F';
}	}
Line 2780 sub allowed {	Line 3102 sub allowed {
$thisallowed.=$1;	$thisallowed.=$1;
}	}

# URI is an uploaded document for this course	# URI is an uploaded document for this course, default permissions don't matter
# not allowing 'edit' access (editupload) to uploaded course docs	# not allowing 'edit' access (editupload) to uploaded course docs
if (($priv eq 'bre') && ($uri=~m\|^uploaded/\|)) {	if (($priv eq 'bre') && ($uri=~m\|^uploaded/\|)) {
my $refuri=$env{'httpref.'.$orguri};	$thisallowed='';
if ($refuri) {	my ($match)=&is_on_map($uri);
if ($refuri =~ m\|^/adm/\|) {	if ($match) {
$thisallowed='F';	if ($env{'user.priv.'.$env{'request.role'}.'./'}
}	=~/\Q$priv\E\&([^\:]*)/) {
}	$thisallowed.=$1;
	}
	} else {
	my $refuri=$env{'httpref.'.$orguri};
	if ($refuri) {
	if ($refuri =~ m\|^/adm/\|) {
	$thisallowed='F';
	} else {
	$refuri=&declutter($refuri);
	my ($match) = &is_on_map($refuri);
	if ($match) {
	$thisallowed='F';
	}
	}
	}
	}
}	}

# Full access at system, domain or course-wide level? Exit.	# Full access at system, domain or course-wide level? Exit.
Line 2799 sub allowed {	Line 3136 sub allowed {

# If this is generating or modifying users, exit with special codes	# If this is generating or modifying users, exit with special codes

if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:\Q$priv\E\:/) {	if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:'=~/\:\Q$priv\E\:/) {
	if (($priv eq 'cca') \|\| ($priv eq 'caa')) {
	my ($audom,$auname)=split('/',$uri);
	# no author name given, so this just checks on the general right to make a co-author in this domain
	unless ($auname) { return $thisallowed; }
	# an author name is given, so we are about to actually make a co-author for a certain account
	if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) \|\|
	(($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) &&
	($audom ne $env{'request.role.domain'}))) { return ''; }
	}
return $thisallowed;	return $thisallowed;
}	}
#	#
Line 2947 sub allowed {	Line 3293 sub allowed {
my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};	my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}	if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
=~/\Q$rolecode\E/) {	=~/\Q$rolecode\E/) {
&log($env{'user.domain'},$env{'user.name'},$env{'user.host'},	&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.	'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
$env{'request.course.id'});	$env{'request.course.id'});
return '';	return '';
Line 2955 sub allowed {	Line 3301 sub allowed {

if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}	if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
=~/\Q$unamedom\E/) {	=~/\Q$unamedom\E/) {
&log($env{'user.domain'},$env{'user.name'},$env{'user.host'},	&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.	'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
$env{'request.course.id'});	$env{'request.course.id'});
return '';	return '';
Line 2967 sub allowed {	Line 3313 sub allowed {
if ($thisallowed=~/R/) {	if ($thisallowed=~/R/) {
my $rolecode=(split(/\./,$env{'request.role'}))[0];	my $rolecode=(split(/\./,$env{'request.role'}))[0];
if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {	if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
&log($env{'user.domain'},$env{'user.name'},$env{'user.host'},	&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);	'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
return '';	return '';
}	}
}	}
Line 2995 sub allowed {	Line 3341 sub allowed {
# --------------------------------------------------- Is a resource on the map?	# --------------------------------------------------- Is a resource on the map?

sub is_on_map {	sub is_on_map {
my $uri=&declutter(shift);	my $uri=&deversion(&declutter(shift));
$uri=~s/\.\d+\.(\w+)$/\.$1/;
my @uriparts=split(/\//,$uri);	my @uriparts=split(/\//,$uri);
my $filename=$uriparts[$#uriparts];	my $filename=$uriparts[$#uriparts];
my $pathname=$uri;	my $pathname=$uri;
Line 3366 sub assignrole {	Line 3711 sub assignrole {
my $answer=&reply($command,&homeserver($uname,$udom));	my $answer=&reply($command,&homeserver($uname,$udom));
# log new user role if status is ok	# log new user role if status is ok
if ($answer eq 'ok') {	if ($answer eq 'ok') {
&userrolelog($mrole,$uname,$udom,$url,$start,$end);	&userrolelog($role,$uname,$udom,$url,$start,$end);
}	}
return $answer;	return $answer;
}	}
Line 3569 sub modify_student_enrollment {	Line 3914 sub modify_student_enrollment {
$cdom,$cnum);	$cdom,$cnum);
unless (($reply eq 'ok') \|\| ($reply eq 'delayed')) {	unless (($reply eq 'ok') \|\| ($reply eq 'delayed')) {
return 'error: '.$reply;	return 'error: '.$reply;
	} else {
	&devalidate_getsection_cache($udom,$uname,$cid);
}	}
# Add student role to user	# Add student role to user
my $uurl='/'.$cid;	my $uurl='/'.$cid;
Line 3627 sub createcourse {	Line 3974 sub createcourse {
return 'refused';	return 'refused';
}	}
# ------------------------------------------------------------------- Create ID	# ------------------------------------------------------------------- Create ID
my $uname=substr($$.time,0,5).unpack("H8",pack("I32",time)).	my $uname=int(1+rand(9)).
	('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
	substr($$.time,0,5).unpack("H8",pack("I32",time)).
unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};	unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
# ----------------------------------------------- Make sure that does not exist	# ----------------------------------------------- Make sure that does not exist
my $uhome=&homeserver($uname,$udom,'true');	my $uhome=&homeserver($uname,$udom,'true');
Line 3673 sub createcourse {	Line 4022 sub createcourse {
</map>	</map>
ENDINITMAP	ENDINITMAP
$topurl=&declutter(	$topurl=&declutter(
&finishuserfileupload($uname,$udom,$uhome,'initmap','default.sequence')	&finishuserfileupload($uname,$udom,'initmap','default.sequence')
);	);
}	}
# ----------------------------------------------------------- Write preferences	# ----------------------------------------------------------- Write preferences
Line 3740 sub mark_as_readonly {	Line 4089 sub mark_as_readonly {
my %current_permissions = &dump('file_permissions',$domain,$user);	my %current_permissions = &dump('file_permissions',$domain,$user);
my ($tmp)=keys(%current_permissions);	my ($tmp)=keys(%current_permissions);
if ($tmp=~/^error:/) { undef(%current_permissions); }	if ($tmp=~/^error:/) { undef(%current_permissions); }

foreach my $file (@{$files}) {	foreach my $file (@{$files}) {
push(@{$current_permissions{$file}},$what);	push(@{$current_permissions{$file}},$what);
}	}
Line 3819 sub files_not_in_path {	Line 4167 sub files_not_in_path {

#--------------------------------------------------------------Get Marked as Read Only	#--------------------------------------------------------------Get Marked as Read Only


sub get_marked_as_readonly {	sub get_marked_as_readonly {
my ($domain,$user,$what) = @_;	my ($domain,$user,$what) = @_;
my %current_permissions = &dump('file_permissions',$domain,$user);	my %current_permissions = &dump('file_permissions',$domain,$user);
my ($tmp)=keys(%current_permissions);	my ($tmp)=keys(%current_permissions);
if ($tmp=~/^error:/) { undef(%current_permissions); }	if ($tmp=~/^error:/) { undef(%current_permissions); }

my @readonly_files;	my @readonly_files;
	my $cmp1=$what;
	if (ref($what)) { $cmp1=join('',@{$what}) };
while (my ($file_name,$value) = each(%current_permissions)) {	while (my ($file_name,$value) = each(%current_permissions)) {
if (ref($value) eq "ARRAY"){	if (ref($value) eq "ARRAY"){
foreach my $stored_what (@{$value}) {	foreach my $stored_what (@{$value}) {
if ($stored_what eq $what) {	my $cmp2=$stored_what;
	if (ref($stored_what)) { $cmp2=join('',@{$stored_what}) };
	if ($cmp1 eq $cmp2) {
push(@readonly_files, $file_name);	push(@readonly_files, $file_name);
} elsif (!defined($what)) {	} elsif (!defined($what)) {
push(@readonly_files, $file_name);	push(@readonly_files, $file_name);
Line 3864 sub get_marked_as_readonly_hash {	Line 4216 sub get_marked_as_readonly_hash {
# ------------------------------------------------------------ Unmark as Read Only	# ------------------------------------------------------------ Unmark as Read Only

sub unmark_as_readonly {	sub unmark_as_readonly {
# unmarks all files locked by $what	# unmarks $file_name (if $file_name is defined), or all files locked by $what
# for portfolio submissions, $what contains $crsid and $symb	# for portfolio submissions, $what contains [$symb,$crsid]
my ($domain,$user,$what) = @_;	my ($domain,$user,$what,$file_name) = @_;
	my $symb_crs = $what;
	if (ref($what)) { $symb_crs=join('',@$what); }
my %current_permissions = &dump('file_permissions',$domain,$user);	my %current_permissions = &dump('file_permissions',$domain,$user);
my ($tmp)=keys(%current_permissions);	my ($tmp)=keys(%current_permissions);
if ($tmp=~/^error:/) { undef(%current_permissions); }	if ($tmp=~/^error:/) { undef(%current_permissions); }

my @readonly_files = &get_marked_as_readonly($domain,$user,$what);	my @readonly_files = &get_marked_as_readonly($domain,$user,$what);
foreach my $file(@readonly_files){	foreach my $file (@readonly_files) {
my $current_locks = $current_permissions{$file};	if (defined($file_name) && ($file_name ne $file)) { next; }
	my $current_locks = $current_permissions{$file};
my @new_locks;	my @new_locks;
my @del_keys;	my @del_keys;
if (ref($current_locks) eq "ARRAY"){	if (ref($current_locks) eq "ARRAY"){
foreach my $locker (@{$current_locks}) {	foreach my $locker (@{$current_locks}) {
unless ($locker eq $what) {	my $compare=$locker;
push(@new_locks, $what);	if (ref($locker)) { $compare=join('',@{$locker}) };
	if ($compare ne $symb_crs) {
	push(@new_locks, $locker);
}	}
}	}
if (@new_locks > 0) {	if (scalar(@new_locks) > 0) {
$current_permissions{$file} = \@new_locks;	$current_permissions{$file} = \@new_locks;
} else {	} else {
push(@del_keys, $file);	push(@del_keys, $file);
&del('file_permissions',\@del_keys, $domain, $user);	&del('file_permissions',\@del_keys, $domain, $user);
delete $current_permissions{$file};	delete($current_permissions{$file});
}	}
}	}
}	}
Line 4082 sub devalidatecourseresdata {	Line 4438 sub devalidatecourseresdata {

# --------------------------------------------------- Course Resourcedata Query	# --------------------------------------------------- Course Resourcedata Query

sub courseresdata {	sub get_courseresdata {
my ($coursenum,$coursedomain,@which)=@_;	my ($coursenum,$coursedomain)=@_;
my $coursehom=&homeserver($coursenum,$coursedomain);	my $coursehom=&homeserver($coursenum,$coursedomain);
my $hashid=$coursenum.':'.$coursedomain;	my $hashid=$coursenum.':'.$coursedomain;
my ($result,$cached)=&is_cached_new('courseres',$hashid);	my ($result,$cached)=&is_cached_new('courseres',$hashid);
	my %dumpreply;
unless (defined($cached)) {	unless (defined($cached)) {
my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);	%dumpreply=&dump('resourcedata',$coursedomain,$coursenum);
$result=\%dumpreply;	$result=\%dumpreply;
my ($tmp) = keys(%dumpreply);	my ($tmp) = keys(%dumpreply);
if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {	if ($tmp !~ /^(con_lost\|error\|no_such_host)/i) {
Line 4100 sub courseresdata {	Line 4457 sub courseresdata {
&do_cache_new('courseres',$hashid,$result,600);	&do_cache_new('courseres',$hashid,$result,600);
}	}
}	}
	return $result;
	}

	sub devalidateuserresdata {
	my ($uname,$udom)=@_;
	my $hashid="$udom:$uname";
	&devalidate_cache_new('userres',$hashid);
	}

	sub get_userresdata {
	my ($uname,$udom)=@_;
	#most student don\'t have any data set, check if there is some data
	if (&EXT_cache_status($udom,$uname)) { return undef; }

	my $hashid="$udom:$uname";
	my ($result,$cached)=&is_cached_new('userres',$hashid);
	if (!defined($cached)) {
	my %resourcedata=&dump('resourcedata',$udom,$uname);
	$result=\%resourcedata;
	&do_cache_new('userres',$hashid,$result,600);
	}
	my ($tmp)=keys(%$result);
	if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
	return $result;
	}
	#error 2 occurs when the .db doesn't exist
	if ($tmp!~/error: 2 /) {
	&logthis("<font color=\"blue\">WARNING:".
	" Trying to get resource data for ".
	$uname." at ".$udom.": ".
	$tmp."</font>");
	} elsif ($tmp=~/error: 2 /) {
	#&EXT_cache_set($udom,$uname);
	&do_cache_new('userres',$hashid,undef,600);
	undef($tmp); # not really an error so don't send it back
	}
	return $tmp;
	}

	sub resdata {
	my ($name,$domain,$type,@which)=@_;
	my $result;
	if ($type eq 'course') {
	$result=&get_courseresdata($name,$domain);
	} elsif ($type eq 'user') {
	$result=&get_userresdata($name,$domain);
	}
	if (!ref($result)) { return $result; }
foreach my $item (@which) {	foreach my $item (@which) {
if (defined($result->{$item})) {	if (defined($result->{$item})) {
return $result->{$item};	return $result->{$item};
Line 4130 sub EXT_cache_status {	Line 4535 sub EXT_cache_status {
sub EXT_cache_set {	sub EXT_cache_set {
my ($target_domain,$target_user) = @_;	my ($target_domain,$target_user) = @_;
my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;	my $cachename = 'cache.EXT.'.$target_user.'.'.$target_domain;
&appenv($cachename => time);	#&appenv($cachename => time);
}	}

# --------------------------------------------------------- Value of a Variable	# --------------------------------------------------------- Value of a Variable
Line 4166 sub EXT {	Line 4571 sub EXT {
if ($realm eq 'user') {	if ($realm eq 'user') {
# --------------------------------------------------------------- user.resource	# --------------------------------------------------------------- user.resource
if ($space eq 'resource') {	if ($space eq 'resource') {
if (defined($Apache::lonhomework::parsing_a_problem) \|\|	if ( (defined($Apache::lonhomework::parsing_a_problem)
defined($Apache::lonhomework::parsing_a_task)) {	\|\| defined($Apache::lonhomework::parsing_a_task))
	&&
	($symbparm eq &symbread()) ) {
return $Apache::lonhomework::history{$qualifierrest};	return $Apache::lonhomework::history{$qualifierrest};
} else {	} else {
my %restored;	my %restored;
Line 4285 sub EXT {	Line 4692 sub EXT {
$courselevelm=$courseid.'.'.$mapparm;	$courselevelm=$courseid.'.'.$mapparm;

# ----------------------------------------------------------- first, check user	# ----------------------------------------------------------- first, check user
#most student don\'t have any data set, check if there is some data
if (! &EXT_cache_status($udom,$uname)) {	my $userreply=&resdata($uname,$udom,'user',
my $hashid="$udom:$uname";	($courselevelr,$courselevelm,
my ($result,$cached)=&is_cached_new('userres',$hashid);	$courselevel));
if (!defined($cached)) {
my %resourcedata=&dump('resourcedata',$udom,$uname);	if (defined($userreply)) { return $userreply; }
$result=\%resourcedata;
&do_cache_new('userres',$hashid,$result);
}
my ($tmp)=keys(%$result);
if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
if ($$result{$courselevelr}) {
return $$result{$courselevelr}; }
if ($$result{$courselevelm}) {
return $$result{$courselevelm}; }
if ($$result{$courselevel}) {
return $$result{$courselevel}; }
} else {
#error 2 occurs when the .db doesn't exist
if ($tmp!~/error: 2 /) {
&logthis("<font color=blue>WARNING:".
" Trying to get resource data for ".
$uname." at ".$udom.": ".
$tmp."</font>");
} elsif ($tmp=~/error: 2 /) {
&EXT_cache_set($udom,$uname);
} elsif ($tmp =~ /^(con_lost\|no_such_host)/) {
return $tmp;
}
}
}

# ------------------------------------------------ second, check some of course	# ------------------------------------------------ second, check some of course

my $coursereply=&courseresdata($env{'course.'.$courseid.'.num'},	my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
$env{'course.'.$courseid.'.domain'},	$env{'course.'.$courseid.'.domain'},
($seclevelr,$seclevelm,$seclevel,	'course',
$courselevelr));	($seclevelr,$seclevelm,$seclevel,
	$courselevelr));
if (defined($coursereply)) { return $coursereply; }	if (defined($coursereply)) { return $coursereply; }

# ------------------------------------------------------ third, check map parms	# ------------------------------------------------------ third, check map parms
Line 4354 sub EXT {	Line 4737 sub EXT {
# ---------------------------------------------- fourth, look in rest pf course	# ---------------------------------------------- fourth, look in rest pf course
if ($symbparm && defined($courseid) &&	if ($symbparm && defined($courseid) &&
$courseid eq $env{'request.course.id'}) {	$courseid eq $env{'request.course.id'}) {
my $coursereply=&courseresdata($env{'course.'.$courseid.'.num'},	my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
$env{'course.'.$courseid.'.domain'},	$env{'course.'.$courseid.'.domain'},
($courselevelm,$courselevel));	'course',
	($courselevelm,$courselevel));
if (defined($coursereply)) { return $coursereply; }	if (defined($coursereply)) { return $coursereply; }
}	}
# ------------------------------------------------------------------ Cascade up	# ------------------------------------------------------------------ Cascade up
Line 4584 sub metadata {	Line 4968 sub metadata {
}	}
my ($extension) = ($uri =~ /\.(\w+)$/);	my ($extension) = ($uri =~ /\.(\w+)$/);
foreach my $key (sort(keys(%packagetab))) {	foreach my $key (sort(keys(%packagetab))) {
#&logthis("extsion1 $extension $key !!");
#no specific packages #how's our extension	#no specific packages #how's our extension
if ($key!~/^extension_\Q$extension\E&/) { next; }	if ($key!~/^extension_\Q$extension\E&/) { next; }
&metadata_create_package_def($uri,$key,'extension_'.$extension,	&metadata_create_package_def($uri,$key,'extension_'.$extension,
Line 4620 sub metadata {	Line 5003 sub metadata {
$metaentry{':keys'}=join(',',keys %metathesekeys);	$metaentry{':keys'}=join(',',keys %metathesekeys);
&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
&do_cache_new('meta',$uri,\%metaentry);	&do_cache_new('meta',$uri,\%metaentry,606024);
# this is the end of "was not already recently cached	# this is the end of "was not already recently cached
}	}
return $metaentry{':'.$what};	return $metaentry{':'.$what};
Line 4672 sub metadata_generate_part0 {	Line 5055 sub metadata_generate_part0 {
'.type'};	'.type'};
my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name.	my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name.
'.display'};	'.display'};
my $expr='\\[Part: '.$allnames{$name}.'\\]';	my $expr='[Part: '.$allnames{$name}.']';
$olddis=~s/\Q$expr\E/\[Part: 0\]/;	$olddis=~s/\Q$expr\E/\[Part: 0\]/;
$$metacache{"$key.display"}=$olddis;	$$metacache{"$key.display"}=$olddis;
}	}
Line 4777 sub symbverify {	Line 5160 sub symbverify {
if ($ids) {	if ($ids) {
# ------------------------------------------------------------------- Has ID(s)	# ------------------------------------------------------------------- Has ID(s)
foreach (split(/\,/,$ids)) {	foreach (split(/\,/,$ids)) {
my ($mapid,$resid)=split(/\./,$_);	my ($mapid,$resid)=split(/\./,$_);
if (	if (
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)	&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
eq $symb) {	eq $symb) {
Line 4916 sub symbread {	Line 5299 sub symbread {
if ($#possibilities==0) {	if ($#possibilities==0) {
# ----------------------------------------------- There is only one possibility	# ----------------------------------------------- There is only one possibility
my ($mapid,$resid)=split(/\./,$ids);	my ($mapid,$resid)=split(/\./,$ids);
$syval=declutter($bighash{'map_id_'.$mapid}).'___'.$resid;	$syval=&encode_symb($bighash{'map_id_'.$mapid},
	$resid,$thisfn);
} elsif (!$donotrecurse) {	} elsif (!$donotrecurse) {
# ------------------------------------------ There is more than one possibility	# ------------------------------------------ There is more than one possibility
my $realpossible=0;	my $realpossible=0;
Line 4926 sub symbread {	Line 5310 sub symbread {
my ($mapid,$resid)=split(/\./,$_);	my ($mapid,$resid)=split(/\./,$_);
if ($bighash{'map_type_'.$mapid} ne 'page') {	if ($bighash{'map_type_'.$mapid} ne 'page') {
$realpossible++;	$realpossible++;
$syval=declutter($bighash{'map_id_'.$mapid}).	$syval=&encode_symb($bighash{'map_id_'.$mapid},
'___'.$resid;	$resid,$thisfn);
}	}
}	}
}	}
Line 4941 sub symbread {	Line 5325 sub symbread {
}	}
if ($syval) {	if ($syval) {
return $env{$cache_str}=$syval;	return $env{$cache_str}=$syval;
#return $env{$cache_str}=&symbclean($syval.'___'.$thisfn);
}	}
}	}
&appenv('request.ambiguous' => $thisfn);	&appenv('request.ambiguous' => $thisfn);
Line 4996 sub numval3 {	Line 5379 sub numval3 {
return $total;	return $total;
}	}

	sub digest {
	my ($data)=@_;
	my $digest=&Digest::MD5::md5($data);
	my ($a,$b,$c,$d)=unpack("iiii",$digest);
	my ($e,$f);
	{
	use integer;
	$e=($a+$b);
	$f=($c+$d);
	if ($_64bit) {
	$e=(($e<<32)>>32);
	$f=(($f<<32)>>32);
	}
	}
	if (wantarray) {
	return ($e,$f);
	} else {
	my $g;
	{
	use integer;
	$g=($e+$f);
	if ($_64bit) {
	$g=(($g<<32)>>32);
	}
	}
	return $g;
	}
	}

sub latest_rnd_algorithm_id {	sub latest_rnd_algorithm_id {
return '64bit4';	return '64bit5';
}	}

sub get_rand_alg {	sub get_rand_alg {
Line 5037 sub rndseed {	Line 5449 sub rndseed {
if (!$username) { $username=$wusername }	if (!$username) { $username=$wusername }
my $which=&get_rand_alg();	my $which=&get_rand_alg();
if (defined(&getCODE())) {	if (defined(&getCODE())) {
if ($which eq '64bit4') {	if ($which eq '64bit5') {
	return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username);
	} elsif ($which eq '64bit4') {
return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username);	return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username);
} else {	} else {
return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);	return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
}	}
	} elsif ($which eq '64bit5') {
	return &rndseed_64bit5($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit4') {	} elsif ($which eq '64bit4') {
return &rndseed_64bit4($symb,$courseid,$domain,$username);	return &rndseed_64bit4($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit3') {	} elsif ($which eq '64bit3') {
Line 5164 sub rndseed_64bit4 {	Line 5580 sub rndseed_64bit4 {
}	}
}	}

	sub rndseed_64bit5 {
	my ($symb,$courseid,$domain,$username)=@_;
	my ($num1,$num2)=&digest("$symb,$courseid,$domain,$username");
	return "$num1:$num2";
	}

sub rndseed_CODE_64bit {	sub rndseed_CODE_64bit {
my ($symb,$courseid,$domain,$username)=@_;	my ($symb,$courseid,$domain,$username)=@_;
{	{
Line 5202 sub rndseed_CODE_64bit4 {	Line 5624 sub rndseed_CODE_64bit4 {
}	}
}	}

	sub rndseed_CODE_64bit5 {
	my ($symb,$courseid,$domain,$username)=@_;
	my $code = &getCODE();
	my ($num1,$num2)=&digest("$symb,$courseid,$code");
	return "$num1:$num2";
	}

sub setup_random_from_rndseed {	sub setup_random_from_rndseed {
my ($rndseed)=@_;	my ($rndseed)=@_;
if ($rndseed =~/([,:])/) {	if ($rndseed =~/([,:])/) {
Line 5411 sub filelocation {	Line 5840 sub filelocation {
if ($file=~m:^/~:) { # is a contruction space reference	if ($file=~m:^/~:) { # is a contruction space reference
$location = $file;	$location = $file;
$location =~ s:/~(.?)/(.):/home/$1/public_html/$2:;	$location =~ s:/~(.?)/(.):/home/$1/public_html/$2:;
	} elsif ($file=~m:^/home/[^/]*/public_html/:) {
	# is a correct contruction space reference
	$location = $file;
} elsif ($file=~/^\/*(uploaded\|editupload)/) { # is an uploaded file	} elsif ($file=~/^\/*(uploaded\|editupload)/) { # is an uploaded file
my ($udom,$uname,$filename)=	my ($udom,$uname,$filename)=
($file=~m -^/+(?:uploaded\|editupload)/+([^/]+)/+([^/]+)/+(.*)$-);	($file=~m -^/+(?:uploaded\|editupload)/+([^/]+)/+([^/]+)/+(.*)$-);
Line 5443 sub filelocation {	Line 5875 sub filelocation {
sub hreflocation {	sub hreflocation {
my ($dir,$file)=@_;	my ($dir,$file)=@_;
unless (($file=~m-^http://-i) \|\| ($file=~m-^/-)) {	unless (($file=~m-^http://-i) \|\| ($file=~m-^/-)) {
my $finalpath=filelocation($dir,$file);	$file=filelocation($dir,$file);
$finalpath=~s-^/home/httpd/html--;	}
$finalpath=~s-^/home/(\w+)/public_html/-/~$1/-;	if ($file=~m-^\Q$perlvar{'lonDocRoot'}\E-) {
return $finalpath;	$file=~s-^\Q$perlvar{'lonDocRoot'}\E--;
} elsif ($file=~m-^/home-) {	} elsif ($file=~m-/home/(\w+)/public_html/-) {
$file=~s-^/home/httpd/html--;
$file=~s-^/home/(\w+)/public_html/-/~$1/-;	$file=~s-^/home/(\w+)/public_html/-/~$1/-;
return $file;	} elsif ($file=~m-^\Q$perlvar{'lonUsersDir'}\E-) {
	$file=~s-^/home/httpd/lonUsers/([^/])/./././([^/])/userfiles/
	-/uploaded/$1/$2/-x;
}	}
return $file;	return $file;
}	}
Line 5652 BEGIN {	Line 6085 BEGIN {

sub get_iphost {	sub get_iphost {
if (%iphost) { return %iphost; }	if (%iphost) { return %iphost; }
	my %name_to_ip;
foreach my $id (keys(%hostname)) {	foreach my $id (keys(%hostname)) {
my $name=$hostname{$id};	my $name=$hostname{$id};
my $ip = gethostbyname($name);	my $ip;
if (!$ip \|\| length($ip) ne 4) {	if (!exists($name_to_ip{$name})) {
&logthis("Skipping host $id name $name no IP found\n");	$ip = gethostbyname($name);
next;	if (!$ip \|\| length($ip) ne 4) {
	&logthis("Skipping host $id name $name no IP found\n");
	next;
	}
	$ip=inet_ntoa($ip);
	$name_to_ip{$name} = $ip;
	} else {
	$ip = $name_to_ip{$name};
}	}
$ip=inet_ntoa($ip);
push(@{$iphost{$ip}},$id);	push(@{$iphost{$ip}},$id);
}	}
return %iphost;	return %iphost;
Line 5734 $processmarker='_'.time.'_'.$perlvar{'lo	Line 6174 $processmarker='_'.time.'_'.$perlvar{'lo
$dumpcount=0;	$dumpcount=0;

&logtouch();	&logtouch();
&logthis('<font color=yellow>INFO: Read configuration</font>');	&logthis('<font color="yellow">INFO: Read configuration</font>');
$readit=1;	$readit=1;
{	{
use integer;	use integer;
Line 6136 revokecustomrole($udom,$uname,$url,$role	Line 6576 revokecustomrole($udom,$uname,$url,$role

=item *	=item *

coursedescription($courseid) : course description	coursedescription($courseid) : returns a hash of information about the
	specified course id, including all environment settings for the
	course, the description of the course will be in the hash under the
	key 'description'

=item *	=item *

courseresdata($coursenum,$coursedomain,@which) : request for current	resdata($name,$domain,$type,@which) : request for current parameter
parameter setting for a specific course, @what should be a list of	setting for a specific $type, where $type is either 'course' or 'user',
parameters to ask about. This routine caches answers for 5 minutes.	@what should be a list of parameters to ask about. This routine caches
	answers for 5 minutes.

=back	=back

Line 6557 userspace, probably shouldn't be called	Line 7001 userspace, probably shouldn't be called

docuname: username or courseid of destination for the file	docuname: username or courseid of destination for the file
docudom: domain of user/course of destination for the file	docudom: domain of user/course of destination for the file
docuhome: loncapa id of the library server that is getting the file
formname: same as for userfileupload()	formname: same as for userfileupload()
fname: filename (inculding subdirectories) for the file	fname: filename (inculding subdirectories) for the file

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

Removed from v.1.621
changed lines
	Added in v.1.675