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.556 and 1.587.2.3.2.12

version 1.556, 2004/11/02 20:48:02	version 1.587.2.3.2.12, 2005/02/14 04:31:59
Line 35 use HTTP::Headers;	Line 35 use HTTP::Headers;
use HTTP::Date;	use HTTP::Date;
# use Date::Parse;	# use Date::Parse;
use vars	use vars
qw(%perlvar %hostname %homecache %badServerCache %hostip %iphost %spareid %hostdom	qw(%perlvar %hostname %badServerCache %hostip %iphost %spareid %hostdom
%libserv %pr %prp %metacache %packagetab %titlecache %courseresversioncache %resversioncache	%libserv %pr %prp $memcache %packagetab
%courselogs %accesshash %userrolehash $processmarker $dumpcount	%courselogs %accesshash %userrolehash $processmarker $dumpcount
%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseresdatacache	%coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf
%userresdatacache %getsectioncache %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);	%domain_lang_def %domain_city %domain_longi %domain_lati $tmpdir $_64bit);

use IO::Socket;	use IO::Socket;
use GDBM_File;	use GDBM_File;
Line 48 use Apache::Constants qw(:common :http);	Line 48 use Apache::Constants qw(:common :http);
use HTML::LCParser;	use HTML::LCParser;
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);	use Storable qw(lock_store lock_nstore lock_retrieve freeze thaw nfreeze);
use Time::HiRes qw( gettimeofday tv_interval );	use Time::HiRes qw( gettimeofday tv_interval );
	use Cache::Memcached;
my $readit;	my $readit;
my $max_connection_retries = 10; # Or some such value.	my $max_connection_retries = 10; # Or some such value.

Line 157 sub reply {	Line 158 sub reply {
my ($cmd,$server)=@_;	my ($cmd,$server)=@_;
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 eq 'con_lost') {
#sleep 5;
#$answer=subreply($cmd,$server);
#if ($answer eq 'con_lost') {
# &logthis("Second attempt con_lost on $server");
# my $peerfile="$perlvar{'lonSockDir'}/$server";
# my $client=IO::Socket::UNIX->new(Peer =>"$peerfile",
# Type => SOCK_STREAM,
# Timeout => 10)
# or return "con_lost";
# &logthis("Killing socket");
# print $client "close_connection_exit\n";
#sleep 5;
# $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>");
Line 220 sub critical {	Line 205 sub critical {
}	}
my $answer=reply($cmd,$server);	my $answer=reply($cmd,$server);
if ($answer eq 'con_lost') {	if ($answer eq 'con_lost') {
my $pingreply=reply('ping',$server);
&reconlonc("$perlvar{'lonSockDir'}/$server");	&reconlonc("$perlvar{'lonSockDir'}/$server");
my $pongreply=reply('pong',$server);	my $answer=reply($cmd,$server);
&logthis("Ping/Pong for $server: $pingreply/$pongreply");
$answer=reply($cmd,$server);
if ($answer eq 'con_lost') {	if ($answer eq 'con_lost') {
my $now=time;	my $now=time;
my $middlename=$cmd;	my $middlename=$cmd;
Line 581 sub homeserver {	Line 563 sub homeserver {
my ($uname,$udom,$ignoreBadCache)=@_;	my ($uname,$udom,$ignoreBadCache)=@_;
my $index="$uname:$udom";	my $index="$uname:$udom";

my ($result,$cached)=&is_cached(\%homecache,$index,'home',86400);	my ($result,$cached)=&is_cached_new('home',$index);
if (defined($cached)) { return $result; }	if (defined($cached)) { return $result; }
my $tryserver;	my $tryserver;
foreach $tryserver (keys %libserv) {	foreach $tryserver (keys %libserv) {
Line 590 sub homeserver {	Line 572 sub homeserver {
if ($hostdom{$tryserver} eq $udom) {	if ($hostdom{$tryserver} eq $udom) {
my $answer=reply("home:$udom:$uname",$tryserver);	my $answer=reply("home:$udom:$uname",$tryserver);
if ($answer eq 'found') {	if ($answer eq 'found') {
return &do_cache(\%homecache,$index,$tryserver,'home');	return &do_cache_new('home',$index,$tryserver,86400);
} elsif ($answer eq 'no_host') {	} elsif ($answer eq 'no_host') {
$badServerCache{$tryserver}=1;	$badServerCache{$tryserver}=1;
}	}
Line 795 sub validate_access_key {	Line 777 sub validate_access_key {

sub getsection {	sub getsection {
my ($udom,$unam,$courseid)=@_;	my ($udom,$unam,$courseid)=@_;
	my $cachetime=1800;
$courseid=~s/\_/\//g;	$courseid=~s/\_/\//g;
$courseid=~s/^(\w)/\/$1/;	$courseid=~s/^(\w)/\/$1/;

my $hashid="$udom:$unam:$courseid";	my $hashid="$udom:$unam:$courseid";
my ($result,$cached)=&is_cached(\%getsectioncache,$hashid,'getsection');	my ($result,$cached)=&is_cached_new('getsection',$hashid);
if (defined($cached)) { return $result; }	if (defined($cached)) { return $result; }

my %Pending;	my %Pending;
Line 834 sub getsection {	Line 817 sub getsection {
$Pending{$start}=$section;	$Pending{$start}=$section;
next;	next;
}	}
return &do_cache(\%getsectioncache,$hashid,$section,'getsection');	return &do_cache_new('getsection',$hashid,$section,$cachetime);
}	}
#	#
# Presumedly there will be few matching roles from the above	# Presumedly there will be few matching roles from the above
# loop and the sorting time will be negligible.	# loop and the sorting time will be negligible.
if (scalar(keys(%Pending))) {	if (scalar(keys(%Pending))) {
my ($time) = sort {$a <=> $b} keys(%Pending);	my ($time) = sort {$a <=> $b} keys(%Pending);
return &do_cache(\%getsectioncache,$hashid,$Pending{$time},'getsection');	return &do_cache_new('getsection',$hashid,$Pending{$time},$cachetime);
}	}
if (scalar(keys(%Expired))) {	if (scalar(keys(%Expired))) {
my @sorted = sort {$a <=> $b} keys(%Expired);	my @sorted = sort {$a <=> $b} keys(%Expired);
my $time = pop(@sorted);	my $time = pop(@sorted);
return &do_cache(\%getsectioncache,$hashid,$Expired{$time},'getsection');	return &do_cache_new('getsection',$hashid,$Expired{$time},$cachetime);
}	}
return &do_cache(\%getsectioncache,$hashid,'-1','getsection');	return &do_cache_new('getsection',$hashid,'-1',$cachetime);
}	}


Line 942 sub save_cache_item {	Line 925 sub save_cache_item {
}	}

sub save_cache {	sub save_cache {
	&purge_remembered();
if ($disk_caching_disabled) { return; }	if ($disk_caching_disabled) { return; }
my ($cache,$name,$id);	my ($cache,$name,$id);
foreach $name (keys(%do_save)) {	foreach $name (keys(%do_save)) {
Line 1039 EVALBLOCK	Line 1023 EVALBLOCK
# &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));	# &logthis("load_cache_item $name took ".(&Time::HiRes::time()-$starttime));
}	}

	my $to_remember=20;
	my %remembered;
	my %accessed;
	my $kicks=0;
	my $hits=0;
	sub devalidate_cache_new {
	my ($name,$id,$debug) = @_;
	if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); }
	$id=&escape($name.':'.$id);
	$memcache->delete($id);
	delete($remembered{$id});
	delete($accessed{$id});
	}

	sub is_cached_new {
	my ($name,$id,$debug) = @_;
	$id=&escape($name.':'.$id);
	if (exists($remembered{$id})) {
	if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); }
	$accessed{$id}=[&gettimeofday()];
	$hits++;
	return ($remembered{$id},1);
	}
	my $value = $memcache->get($id);
	if (!(defined($value))) {
	if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); }
	return (undef,undef);
	}
	&make_room($id,$value,$debug);
	if ($value eq '__undef__') {
	if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); }
	return (undef,1);
	}
	if ($debug) { &Apache::lonnet::logthis("getting $id is $value"); }
	return ($value,1);
	}

	sub do_cache_new {
	my ($name,$id,$value,$time,$debug) = @_;
	$id=&escape($name.':'.$id);
	my $setvalue=$value;
	if (!defined($setvalue)) {
	$setvalue='__undef__';
	}
	if ($debug) { &Apache::lonnet::logthis("Setting $id to $value"); }
	$memcache->set($id,$setvalue,300);
	&make_room($id,$value,$debug);
	return $value;
	}

	sub make_room {
	my ($id,$value,$debug)=@_;
	$remembered{$id}=$value;
	$accessed{$id}=[&gettimeofday()];
	if (scalar(keys(%remembered)) <= $to_remember) { return; }
	my $to_kick;
	my $max_time=0;
	foreach my $other (keys(%accessed)) {
	if (&tv_interval($accessed{$other}) > $max_time) {
	$to_kick=$other;
	$max_time=&tv_interval($accessed{$other});
	}
	}
	delete($remembered{$to_kick});
	delete($accessed{$to_kick});
	$kicks++;
	if ($debug) { &logthis("kicking $max_time $kicks\n"); }
	return;
	}

	sub purge_remembered {
	&logthis("Tossing ".scalar(keys(%remembered)));
	undef(%remembered);
	undef(%accessed);
	}
# ------------------------------------- Read an entry from a user's environment	# ------------------------------------- Read an entry from a user's environment

sub userenvironment {	sub userenvironment {
Line 1076 sub getversion {	Line 1135 sub getversion {

sub currentversion {	sub currentversion {
my $fname=shift;	my $fname=shift;
my ($result,$cached)=&is_cached(\%resversioncache,$fname,'resversion',600);	my ($result,$cached)=&is_cached_new('resversion',$fname);
if (defined($cached)) { return $result; }	if (defined($cached)) { return $result; }
my $author=$fname;	my $author=$fname;
$author=~s/\/home\/httpd\/html\/res\/([^\/])\/([^\/]).*/$1\/$2/;	$author=~s/\/home\/httpd\/html\/res\/([^\/])\/([^\/]).*/$1\/$2/;
Line 1089 sub currentversion {	Line 1148 sub currentversion {
if (($answer eq 'con_lost') \|\| ($answer eq 'rejected')) {	if (($answer eq 'con_lost') \|\| ($answer eq 'rejected')) {
return -1;	return -1;
}	}
return &do_cache(\%resversioncache,$fname,$answer,'resversion');	return &do_cache_new('resversion',$fname,$answer,600);
}	}

# ----------------------------- Subscribe to a resource, return URL if possible	# ----------------------------- Subscribe to a resource, return URL if possible
Line 1188 sub ssi_body {	Line 1247 sub ssi_body {
my ($filelink,%form)=@_;	my ($filelink,%form)=@_;
my $output=($filelink=~/^http\:/?&externalssi($filelink):	my $output=($filelink=~/^http\:/?&externalssi($filelink):
&ssi($filelink,%form));	&ssi($filelink,%form));
$output=~	$output=~s\|//(\s<!--)? BEGIN LON-CAPA Internal.+// END LON-CAPA Internal\s(-->)?\s\|\|gs;
s/\/\/ BEGIN LON\-CAPA Internal.+\/\/ END LON\-CAPA Internal\s//gs;
$output=~s/^.?\<body[^\>]\>//si;	$output=~s/^.?\<body[^\>]\>//si;
$output=~s/(.)\<\/body\s\>.*?$/$1/si;	$output=~s/(.)\<\/body\s\>.*?$/$1/si;
return $output;	return $output;
Line 1407 sub finishuserfileupload {	Line 1465 sub finishuserfileupload {
}	}
# Save the file	# Save the file
{	{
#&Apache::lonnet::logthis("Saving to $filepath $file");	open(FH,'>'.$filepath.'/'.$file);
open(my $fh,'>'.$filepath.'/'.$file);	print FH $ENV{'form.'.$formname};
print $fh $ENV{'form.'.$formname};	close(FH);
close($fh);
}	}
# Notify homeserver to grep it	# Notify homeserver to grep it
#	#
	&Apache::lonnet::logthis("fetching ".$path.$file);
my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);	my $fetchresult= &reply('fetchuserfile:'.$path.$file,$docuhome);
if ($fetchresult eq 'ok') {	if ($fetchresult eq 'ok') {
#	#
Line 1491 sub flushcourselogs {	Line 1549 sub flushcourselogs {
if ($courseidbuffer{$coursehombuf{$crsid}}) {	if ($courseidbuffer{$coursehombuf{$crsid}}) {
$courseidbuffer{$coursehombuf{$crsid}}.='&'.	$courseidbuffer{$coursehombuf{$crsid}}.='&'.
&escape($crsid).'='.&escape($coursedescrbuf{$crsid}).	&escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
'='.&escape($courseinstcodebuf{$crsid});	':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid});
} else {	} else {
$courseidbuffer{$coursehombuf{$crsid}}=	$courseidbuffer{$coursehombuf{$crsid}}=
&escape($crsid).'='.&escape($coursedescrbuf{$crsid}).	&escape($crsid).'='.&escape($coursedescrbuf{$crsid}).
'='.&escape($courseinstcodebuf{$crsid});	':'.&escape($courseinstcodebuf{$crsid}).':'.&escape($courseownerbuf{$crsid});
}	}
}	}
#	#
# Write course id database (reverse lookup) to homeserver of courses	# Write course id database (reverse lookup) to homeserver of courses
Line 1571 sub courselog {	Line 1629 sub courselog {
$ENV{'course.'.$ENV{'request.course.id'}.'.description'};	$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
$courseinstcodebuf{$ENV{'request.course.id'}}=	$courseinstcodebuf{$ENV{'request.course.id'}}=
$ENV{'course.'.$ENV{'request.course.id'}.'.internal.coursecode'};	$ENV{'course.'.$ENV{'request.course.id'}.'.internal.coursecode'};
	$courseownerbuf{$ENV{'request.course.id'}}=
	$ENV{'course.'.$ENV{'request.course.id'}.'.internal.courseowner'};
if (defined $courselogs{$ENV{'request.course.id'}}) {	if (defined $courselogs{$ENV{'request.course.id'}}) {
$courselogs{$ENV{'request.course.id'}}.='&'.$what;	$courselogs{$ENV{'request.course.id'}}.='&'.$what;
} else {	} else {
Line 1587 sub courseacclog {	Line 1647 sub courseacclog {
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\|page)$/) {
$what.=':POST';	$what.=':POST';
	# FIXME: Probably ought to escape things....
foreach (keys %ENV) {	foreach (keys %ENV) {
if ($_=~/^form\.(.*)/) {	if ($_=~/^form\.(.*)/) {
$what.=':'.$1.'='.$ENV{$_};	$what.=':'.$1.'='.$ENV{$_};
}	}
}	}
	} elsif ($fnsymb =~ m:^/adm/searchcat:) {
	# FIXME: We should not be depending on a form parameter that someone
	# editing lonsearchcat.pm might change in the future.
	if ($ENV{'form.phase'} eq 'course_search') {
	$what.= ':POST';
	# FIXME: Probably ought to escape things....
	foreach my $element ('courseexp','crsfulltext','crsrelated',
	'crsdiscuss') {
	$what.=':'.$element.'='.$ENV{'form.'.$element};
	}
	}
}	}
&courselog($what);	&courselog($what);
}	}
Line 1643 sub get_course_adv_roles {	Line 1715 sub get_course_adv_roles {
if (($tend) && ($tend<$now)) { next; }	if (($tend) && ($tend<$now)) { next; }
if (($tstart) && ($now<$tstart)) { next; }	if (($tstart) && ($now<$tstart)) { next; }
my ($role,$username,$domain,$section)=split(/\:/,$_);	my ($role,$username,$domain,$section)=split(/\:/,$_);
	if ($username eq '' \|\| $domain eq '') { next; }
if ((&privileged($username,$domain)) &&	if ((&privileged($username,$domain)) &&
(!$nothide{$username.':'.$domain})) { next; }	(!$nothide{$username.':'.$domain})) { next; }
my $key=&plaintext($role);	my $key=&plaintext($role);
Line 1714 sub courseidput {	Line 1787 sub courseidput {
}	}

sub courseiddump {	sub courseiddump {
my ($domfilter,$descfilter,$sincefilter,$hostidflag,$hostidref)=@_;	my ($domfilter,$descfilter,$sincefilter,$instcodefilter,$ownerfilter,$hostidflag,$hostidref)=@_;
my %returnhash=();	my %returnhash=();
unless ($domfilter) { $domfilter=''; }	unless ($domfilter) { $domfilter=''; }
foreach my $tryserver (keys %libserv) {	foreach my $tryserver (keys %libserv) {
Line 1722 sub courseiddump {	Line 1795 sub courseiddump {
if ((!$domfilter) \|\| ($hostdom{$tryserver} eq $domfilter)) {	if ((!$domfilter) \|\| ($hostdom{$tryserver} eq $domfilter)) {
foreach (	foreach (
split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.	split(/\&/,&reply('courseiddump:'.$hostdom{$tryserver}.':'.
$sincefilter.':'.&escape($descfilter),	$sincefilter.':'.&escape($descfilter).':'.
	&escape($instcodefilter).':'.&escape($ownerfilter),
$tryserver))) {	$tryserver))) {
my ($key,$value)=split(/\=/,$_);	my ($key,$value)=split(/\=/,$_);
if (($key) && ($value)) {	if (($key) && ($value)) {
Line 2361 sub privileged {	Line 2435 sub privileged {
my $now=time;	my $now=time;
if ($rolesdump ne '') {	if ($rolesdump ne '') {
foreach (split(/&/,$rolesdump)) {	foreach (split(/&/,$rolesdump)) {
if ($_!~/^rolesdef\&/) {	if ($_!~/^rolesdef_/) {
my ($area,$role)=split(/=/,$_);	my ($area,$role)=split(/=/,$_);
$area=~s/\_\w\w$//;	$area=~s/\_\w\w$//;
my ($trole,$tend,$tstart)=split(/_/,$role);	my ($trole,$tend,$tstart)=split(/_/,$role);
Line 2388 sub rolesinit {	Line 2462 sub rolesinit {
my $rolesdump=reply("dump:$domain:$username:roles",$authhost);	my $rolesdump=reply("dump:$domain:$username:roles",$authhost);
if (($rolesdump eq 'con_lost') \|\| ($rolesdump eq '')) { return ''; }	if (($rolesdump eq 'con_lost') \|\| ($rolesdump eq '')) { return ''; }
my %allroles=();	my %allroles=();
my %thesepriv=();
my $now=time;	my $now=time;
my $userroles="user.login.time=$now\n";	my $userroles="user.login.time=$now\n";
my $thesestr;

if ($rolesdump ne '') {	if ($rolesdump ne '') {
foreach (split(/&/,$rolesdump)) {	foreach (split(/&/,$rolesdump)) {
if ($_!~/^rolesdef\&/) {	if ($_!~/^rolesdef_/) {
my ($area,$role)=split(/=/,$_);	my ($area,$role)=split(/=/,$_);
$area=~s/\_\w\w$//;	$area=~s/\_\w\w$//;
my ($trole,$tend,$tstart)=split(/_/,$role);
$userroles.='user.role.'.$trole.'.'.$area.'='.	my ($trole,$tend,$tstart);
$tstart.'.'.$tend."\n";	if ($role=~/^cr/) {
# log the associated role with the area	($trole,my $trest)=($role=~m\|^(cr/\w+/\w+/[a-zA-Z0-9]+)_(.*)$\|);
&userrolelog($trole,$username,$domain,$area,$tstart,$tend);	($tend,$tstart)=split('_',$trest);
if ($tend!=0) {	} else {
if ($tend<$now) {	($trole,$tend,$tstart)=split(/_/,$role);
$trole='';	}
}	$userroles.=&set_arearole($trole,$area,$tstart,$tend,$domain,$username);
}	if (($tend!=0) && ($tend<$now)) { $trole=''; }
if ($tstart!=0) {	if (($tstart!=0) && ($tstart>$now)) { $trole=''; }
if ($tstart>$now) {
$trole='';
}
}
if (($area ne '') && ($trole ne '')) {	if (($area ne '') && ($trole ne '')) {
my $spec=$trole.'.'.$area;	my $spec=$trole.'.'.$area;
my ($tdummy,$tdomain,$trest)=split(/\//,$area);	my ($tdummy,$tdomain,$trest)=split(/\//,$area);
if ($trole =~ /^cr\//) {	if ($trole =~ /^cr\//) {
my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);	&custom_roleprivs(\%allroles,$trole,$tdomain,$trest,$spec,$area);
my $homsvr=homeserver($rauthor,$rdomain);
if ($hostname{$homsvr} ne '') {
my ($rdummy,$roledef)=
&get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);

if (($rdummy ne 'con_lost') && ($roledef ne '')) {
my ($syspriv,$dompriv,$coursepriv)=
split(/\_/,$roledef);
if (defined($syspriv)) {
$allroles{'cm./'}.=':'.$syspriv;
$allroles{$spec.'./'}.=':'.$syspriv;
}
if ($tdomain ne '') {
if (defined($dompriv)) {
$allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
$allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
}
if ($trest ne '') {
if (defined($coursepriv)) {
$allroles{'cm.'.$area}.=':'.$coursepriv;
$allroles{$spec.'.'.$area}.=':'.$coursepriv;
}
}
}
}
}
} else {	} else {
if (defined($pr{$trole.':s'})) {	&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
$allroles{'cm./'}.=':'.$pr{$trole.':s'};
$allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
}
if ($tdomain ne '') {
if (defined($pr{$trole.':d'})) {
$allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
$allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
}
if ($trest ne '') {
if (defined($pr{$trole.':c'})) {
$allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
$allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
}
}
}
}	}
}	}
}	}
}	}
my $adv=0;	my ($author,$adv) = &set_userprivs(\$userroles,\%allroles);
my $author=0;
foreach (keys %allroles) {
%thesepriv=();
if (($_!~/^st/) && ($_!~/^ta/) && ($_!~/^cm/)) { $adv=1; }
if (($_=~/^au/) \|\| ($_=~/^ca/)) { $author=1; }
foreach (split(/:/,$allroles{$_})) {
if ($_ ne '') {
my ($privilege,$restrictions)=split(/&/,$_);
if ($restrictions eq '') {
$thesepriv{$privilege}='F';
} else {
if ($thesepriv{$privilege} ne 'F') {
$thesepriv{$privilege}.=$restrictions;
}
}
}
}
$thesestr='';
foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }
$userroles.='user.priv.'.$_.'='.$thesestr."\n";
}
$userroles.='user.adv='.$adv."\n".	$userroles.='user.adv='.$adv."\n".
'user.author='.$author."\n";	'user.author='.$author."\n";
$ENV{'user.adv'}=$adv;	$ENV{'user.adv'}=$adv;
Line 2494 sub rolesinit {	Line 2500 sub rolesinit {
return $userroles;	return $userroles;
}	}

	sub set_arearole {
	my ($trole,$area,$tstart,$tend,$domain,$username) = @_;
	# log the associated role with the area
	&userrolelog($trole,$username,$domain,$area,$tstart,$tend);
	return 'user.role.'.$trole.'.'.$area.'='.$tstart.'.'.$tend."\n";
	}

	sub custom_roleprivs {
	my ($allroles,$trole,$tdomain,$trest,$spec,$area) = @_;
	my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
	my $homsvr=homeserver($rauthor,$rdomain);
	if ($hostname{$homsvr} ne '') {
	my ($rdummy,$roledef)=
	&get('roles',["rolesdef_$rrole"],$rdomain,$rauthor);
	if (($rdummy ne 'con_lost') && ($roledef ne '')) {
	my ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
	if (defined($syspriv)) {
	$$allroles{'cm./'}.=':'.$syspriv;
	$$allroles{$spec.'./'}.=':'.$syspriv;
	}
	if ($tdomain ne '') {
	if (defined($dompriv)) {
	$$allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
	$$allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
	}
	if (($trest ne '') && (defined($coursepriv))) {
	$$allroles{'cm.'.$area}.=':'.$coursepriv;
	$$allroles{$spec.'.'.$area}.=':'.$coursepriv;
	}
	}
	}
	}
	}


	sub standard_roleprivs {
	my ($allroles,$trole,$tdomain,$spec,$trest,$area) = @_;
	if (defined($pr{$trole.':s'})) {
	$$allroles{'cm./'}.=':'.$pr{$trole.':s'};
	$$allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
	}
	if ($tdomain ne '') {
	if (defined($pr{$trole.':d'})) {
	$$allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
	$$allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
	}
	if (($trest ne '') && (defined($pr{$trole.':c'}))) {
	$$allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
	$$allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
	}
	}
	}

	sub set_userprivs {
	my ($userroles,$allroles) = @_;
	my $author=0;
	my $adv=0;
	foreach (keys %{$allroles}) {
	my %thesepriv=();
	if (($_=~/^au/) \|\| ($_=~/^ca/)) { $author=1; }
	foreach (split(/:/,$$allroles{$_})) {
	if ($_ ne '') {
	my ($privilege,$restrictions)=split(/&/,$_);
	if ($restrictions eq '') {
	$thesepriv{$privilege}='F';
	} elsif ($thesepriv{$privilege} ne 'F') {
	$thesepriv{$privilege}.=$restrictions;
	}
	if ($thesepriv{'adv'} eq 'F') { $adv=1; }
	}
	}
	my $thesestr='';
	foreach (keys %thesepriv) { $thesestr.=':'.$_.'&'.$thesepriv{$_}; }
	$$userroles.='user.priv.'.$_.'='.$thesestr."\n";
	}
	return ($author,$adv);
	}

# --------------------------------------------------------------- get interface	# --------------------------------------------------------------- get interface

sub get {	sub get {
Line 2515 sub get {	Line 2599 sub get {
my %returnhash=();	my %returnhash=();
my $i=0;	my $i=0;
foreach (@$storearr) {	foreach (@$storearr) {
$returnhash{$_}=unescape($pairs[$i]);	$returnhash{$_}=&thaw_unescape($pairs[$i]);
$i++;	$i++;
}	}
return %returnhash;	return %returnhash;
Line 2554 sub dump {	Line 2638 sub dump {
my %returnhash=();	my %returnhash=();
foreach (@pairs) {	foreach (@pairs) {
my ($key,$value)=split(/=/,$_);	my ($key,$value)=split(/=/,$_);
$returnhash{unescape($key)}=unescape($value);	$returnhash{unescape($key)}=&thaw_unescape($value);
}	}
return %returnhash;	return %returnhash;
}	}
Line 2600 sub currentdump {	Line 2684 sub currentdump {
my ($key,$value)=split(/=/,$_);	my ($key,$value)=split(/=/,$_);
my ($symb,$param) = split(/:/,$key);	my ($symb,$param) = split(/:/,$key);
$returnhash{&unescape($symb)}->{&unescape($param)} =	$returnhash{&unescape($symb)}->{&unescape($param)} =
&unescape($value);	&thaw_unescape($value);
}	}
}	}
return %returnhash;	return %returnhash;
Line 2666 sub put {	Line 2750 sub put {
my $uhome=&homeserver($uname,$udomain);	my $uhome=&homeserver($uname,$udomain);
my $items='';	my $items='';
foreach (keys %$storehash) {	foreach (keys %$storehash) {
$items.=&escape($_).'='.&escape($$storehash{$_}).'&';	$items.=&escape($_).'='.&freeze_escape($$storehash{$_}).'&';
}	}
$items=~s/\&$//;	$items=~s/\&$//;
return &reply("put:$udomain:$uname:$namespace:$items",$uhome);	return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
Line 2705 sub cput {	Line 2789 sub cput {
my $uhome=&homeserver($uname,$udomain);	my $uhome=&homeserver($uname,$udomain);
my $items='';	my $items='';
foreach (keys %$storehash) {	foreach (keys %$storehash) {
$items.=escape($_).'='.escape($$storehash{$_}).'&';	$items.=escape($_).'='.&freeze_escape($$storehash{$_}).'&';
}	}
$items=~s/\&$//;	$items=~s/\&$//;
return &critical("put:$udomain:$uname:$namespace:$items",$uhome);	return &critical("put:$udomain:$uname:$namespace:$items",$uhome);
Line 2728 sub eget {	Line 2812 sub eget {
my %returnhash=();	my %returnhash=();
my $i=0;	my $i=0;
foreach (@$storearr) {	foreach (@$storearr) {
$returnhash{$_}=unescape($pairs[$i]);	$returnhash{$_}=&thaw_unescape($pairs[$i]);
$i++;	$i++;
}	}
return %returnhash;	return %returnhash;
Line 2771 sub customaccess {	Line 2855 sub customaccess {
# ------------------------------------------------- Check for a user privilege	# ------------------------------------------------- Check for a user privilege

sub allowed {	sub allowed {
my ($priv,$uri)=@_;	my ($priv,$uri,$symb)=@_;
$uri=&deversion($uri);	$uri=&deversion($uri);
my $orguri=$uri;	my $orguri=$uri;
$uri=&declutter($uri);	$uri=&declutter($uri);
Line 3052 sub allowed {	Line 3136 sub allowed {

if ($thisallowed=~/X/) {	if ($thisallowed=~/X/) {
if ($ENV{'acc.randomout'}) {	if ($ENV{'acc.randomout'}) {
my $symb=&symbread($uri,1);	if (!$symb) { $symb=&symbread($uri,1); }
if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) {	if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) {
return '';	return '';
}	}
Line 3354 sub auto_instcode_format {	Line 3438 sub auto_instcode_format {
my $courses = '';	my $courses = '';
my $homeserver;	my $homeserver;
if ($caller eq 'global') {	if ($caller eq 'global') {
$homeserver = $perlvar{'lonHostID'};	foreach my $tryserver (keys %libserv) {
	if ($hostdom{$tryserver} eq $codedom) {
	$homeserver = $tryserver;
	last;
	}
	}
	if (($ENV{'user.name'}) && ($ENV{'user.domain'} eq $codedom)) {
	$homeserver = &homeserver($ENV{'user.name'},$codedom);
	}
} else {	} else {
$homeserver = &homeserver($caller,$codedom);	$homeserver = &homeserver($caller,$codedom);
}	}
my $host=$hostname{$homeserver};
foreach (keys %{$instcodes}) {	foreach (keys %{$instcodes}) {
$courses .= &escape($_).'='.&escape($$instcodes{$_}).'&';	$courses .= &escape($_).'='.&escape($$instcodes{$_}).'&';
}	}
Line 3685 sub writecoursepref {	Line 3776 sub writecoursepref {
# ---------------------------------------------------------- Make/modify course	# ---------------------------------------------------------- Make/modify course

sub createcourse {	sub createcourse {
my ($udom,$description,$url,$course_server,$nonstandard,$inst_code)=@_;	my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,$course_owner)=@_;
$url=&declutter($url);	$url=&declutter($url);
my $cid='';	my $cid='';
unless (&allowed('ccc',$udom)) {	unless (&allowed('ccc',$udom)) {
Line 3720 sub createcourse {	Line 3811 sub createcourse {
# ----------------------------------------------------------------- Course made	# ----------------------------------------------------------------- Course made
# log existence	# log existence
&courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description).	&courseidput($udom,&escape($udom.'_'.$uname).'='.&escape($description).
'='.&escape($inst_code),$uhome);	':'.&escape($inst_code).':'.&escape($course_owner),$uhome);
&flushcourselogs();	&flushcourselogs();
# set toplevel url	# set toplevel url
my $topurl=$url;	my $topurl=$url;
Line 3781 sub diskusage {	Line 3872 sub diskusage {
return $listing;	return $listing;
}	}

	sub is_locked {
	my ($file_name, $domain, $user) = @_;
	my @check;
	my $is_locked;
	push @check, $file_name;
	my %locked = &Apache::lonnet::get('file_permissions',\@check,
	$ENV{'user.domain'},$ENV{'user.name'});
	if (ref($locked{$file_name}) eq 'ARRAY') {
	$is_locked = 'true';
	} else {
	$is_locked = 'false';
	}
	}

	# ------------------------------------------------------------- Mark as Read Only

	sub mark_as_readonly {
	my ($domain,$user,$files,$what) = @_;
	my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
	foreach my $file (@{$files}) {
	push(@{$current_permissions{$file}},$what);
	}
	&Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);
	return;
	}

	# ------------------------------------------------------------Save Selected Files

	sub save_selected_files {
	my ($user, $path, @files) = @_;
	my $filename = $user."savedfiles";
	my @other_files = &files_not_in_path($user, $path);
	open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
	foreach my $file (@files) {
	print (OUT $ENV{'form.currentpath'}.$file."\n");
	}
	foreach my $file (@other_files) {
	print (OUT $file."\n");
	}
	close (OUT);
	return 'ok';
	}

	sub clear_selected_files {
	my ($user) = @_;
	my $filename = $user."savedfiles";
	open (OUT, '>'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
	print (OUT undef);
	close (OUT);
	return ("ok");
	}

	sub files_in_path {
	my ($user, $path) = @_;
	my $filename = $user."savedfiles";
	my %return_files;
	open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
	while (my $line_in = <IN>) {
	chomp ($line_in);
	my @paths_and_file = split (m!/!, $line_in);
	my $file_part = pop (@paths_and_file);
	my $path_part = join ('/', @paths_and_file);
	$path_part.='/';
	my $path_and_file = $path_part.$file_part;
	if ($path_part eq $path) {
	$return_files{$file_part}= 'selected';
	}
	}
	close (IN);
	return (\%return_files);
	}

	# called in portfolio select mode, to show files selected NOT in current directory
	sub files_not_in_path {
	my ($user, $path) = @_;
	my $filename = $user."savedfiles";
	my @return_files;
	my $path_part;
	open (IN, '<'.$Apache::lonnet::perlvar{'lonDaemons'}.'/tmp/'.$filename);
	while (<IN>) {
	#ok, I know it's clunky, but I want it to work
	my @paths_and_file = split m!/!, $_;
	my $file_part = pop (@paths_and_file);
	chomp ($file_part);
	my $path_part = join ('/', @paths_and_file);
	$path_part .= '/';
	my $path_and_file = $path_part.$file_part;
	if ($path_part ne $path) {
	push (@return_files, ($path_and_file));
	}
	}
	close (OUT);
	return (@return_files);
	}

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

	sub get_marked_as_readonly {
	my ($domain,$user,$what) = @_;
	my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
	my @readonly_files;
	while (my ($file_name,$value) = each(%current_permissions)) {
	if (ref($value) eq "ARRAY"){
	foreach my $stored_what (@{$value}) {
	if ($stored_what eq $what) {
	push(@readonly_files, $file_name);
	} elsif (!defined($what)) {
	push(@readonly_files, $file_name);
	}
	}
	}
	}
	return @readonly_files;
	}
	#-----------------------------------------------------------Get Marked as Read Only Hash

	sub get_marked_as_readonly_hash {
	my ($domain,$user,$what) = @_;
	my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
	my %readonly_files;
	while (my ($file_name,$value) = each(%current_permissions)) {
	if (ref($value) eq "ARRAY"){
	foreach my $stored_what (@{$value}) {
	if ($stored_what eq $what) {
	$readonly_files{$file_name} = 'locked';
	} elsif (!defined($what)) {
	$readonly_files{$file_name} = 'locked';
	}
	}
	}
	}
	return %readonly_files;
	}
	# ------------------------------------------------------------ Unmark as Read Only

	sub unmark_as_readonly {
	# unmarks all files locked by $what
	# for portfolio submissions, $what contains $crsid and $symb
	my ($domain,$user,$what) = @_;
	my %current_permissions = &Apache::lonnet::dump('file_permissions',$domain,$user);
	my @readonly_files = &Apache::lonnet::get_marked_as_readonly($domain,$user,$what);
	foreach my $file(@readonly_files){
	my $current_locks = $current_permissions{$file};
	my @new_locks;
	my @del_keys;
	if (ref($current_locks) eq "ARRAY"){
	foreach my $locker (@{$current_locks}) {
	unless ($locker eq $what) {
	push(@new_locks, $what);
	}
	}
	if (@new_locks > 0) {
	$current_permissions{$file} = \@new_locks;
	} else {
	push(@del_keys, $file);
	&Apache::lonnet::del('file_permissions',\@del_keys, $domain, $user);
	delete $current_permissions{$file};
	}
	}
	}
	&Apache::lonnet::put('file_permissions',\%current_permissions,$domain,$user);
	return;
	}

# ------------------------------------------------------------ Directory lister	# ------------------------------------------------------------ Directory lister

Line 3946 sub condval {	Line 4200 sub condval {
sub devalidatecourseresdata {	sub devalidatecourseresdata {
my ($coursenum,$coursedomain)=@_;	my ($coursenum,$coursedomain)=@_;
my $hashid=$coursenum.':'.$coursedomain;	my $hashid=$coursenum.':'.$coursedomain;
&devalidate_cache(\%courseresdatacache,$hashid,'courseres');	&devalidate_cache_new('courseres',$hashid);
}	}

# --------------------------------------------------- Course Resourcedata Query	# --------------------------------------------------- Course Resourcedata Query
Line 3955 sub courseresdata {	Line 4209 sub courseresdata {
my ($coursenum,$coursedomain,@which)=@_;	my ($coursenum,$coursedomain,@which)=@_;
my $coursehom=&homeserver($coursenum,$coursedomain);	my $coursehom=&homeserver($coursenum,$coursedomain);
my $hashid=$coursenum.':'.$coursedomain;	my $hashid=$coursenum.':'.$coursedomain;
my ($result,$cached)=&is_cached(\%courseresdatacache,$hashid,'courseres');	my ($result,$cached)=&is_cached_new('courseres',$hashid);
unless (defined($cached)) {	unless (defined($cached)) {
my %dumpreply=&dump('resourcedata',$coursedomain,$coursenum);	my %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) {
&do_cache(\%courseresdatacache,$hashid,$result,'courseres');	&do_cache_new('courseres',$hashid,$result,600);
} elsif ($tmp =~ /^(con_lost\|no_such_host)/) {	} elsif ($tmp =~ /^(con_lost\|no_such_host)/) {
return $tmp;	return $tmp;
} elsif ($tmp =~ /^(error)/) {	} elsif ($tmp =~ /^(error)/) {
$result=undef;	$result=undef;
&do_cache(\%courseresdatacache,$hashid,$result,'courseres');	&do_cache_new('courseres',$hashid,$result,600);
}	}
}	}
foreach my $item (@which) {	foreach my $item (@which) {
Line 4155 sub EXT {	Line 4409 sub EXT {
#most student don\'t have any data set, check if there is some data	#most student don\'t have any data set, check if there is some data
if (! &EXT_cache_status($udom,$uname)) {	if (! &EXT_cache_status($udom,$uname)) {
my $hashid="$udom:$uname";	my $hashid="$udom:$uname";
my ($result,$cached)=&is_cached(\%userresdatacache,$hashid,	my ($result,$cached)=&is_cached_new('userres',$hashid);
'userres');
if (!defined($cached)) {	if (!defined($cached)) {
my %resourcedata=&dump('resourcedata',$udom,$uname);	my %resourcedata=&dump('resourcedata',$udom,$uname);
$result=\%resourcedata;	$result=\%resourcedata;
&do_cache(\%userresdatacache,$hashid,$result,'userres');	&do_cache_new('userres',$hashid,$result);
}	}
my ($tmp)=keys(%$result);	my ($tmp)=keys(%$result);
if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {	if (($tmp!~/^error\:/) && ($tmp!~/^con_lost/)) {
Line 4262 sub packages_tab_default {	Line 4515 sub packages_tab_default {
if (defined($packagetab{"$pack_type&$name&default"})) {	if (defined($packagetab{"$pack_type&$name&default"})) {
return $packagetab{"$pack_type&$name&default"};	return $packagetab{"$pack_type&$name&default"};
}	}
	if ($pack_type eq 'part') { $pack_part='0'; }
if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) {	if (defined($packagetab{$pack_type."_".$pack_part."&$name&default"})) {
return $packagetab{$pack_type."_".$pack_part."&$name&default"};	return $packagetab{$pack_type."_".$pack_part."&$name&default"};
}	}
Line 4287 sub add_prefix_and_part {	Line 4541 sub add_prefix_and_part {

# ---------------------------------------------------------------- Get metadata	# ---------------------------------------------------------------- Get metadata

	my %metaentry;
sub metadata {	sub metadata {
my ($uri,$what,$liburi,$prefix,$depthcount)=@_;	my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
$uri=&declutter($uri);	$uri=&declutter($uri);
Line 4306 sub metadata {	Line 4561 sub metadata {
# Everything is cached by the main uri, libraries are never directly cached	# Everything is cached by the main uri, libraries are never directly cached
#	#
if (!defined($liburi)) {	if (!defined($liburi)) {
my ($result,$cached)=&is_cached(\%metacache,$uri,'meta');	my ($result,$cached)=&is_cached_new('meta',$uri);
if (defined($cached)) { return $result->{':'.$what}; }	if (defined($cached)) { return $result->{':'.$what}; }
}	}
{	{
#	#
# Is this a recursive call for a library?	# Is this a recursive call for a library?
#	#
if (! exists($metacache{$uri})) {	# if (! exists($metacache{$uri})) {
$metacache{$uri}={};	# $metacache{$uri}={};
}	# }
if ($liburi) {	if ($liburi) {
$liburi=&declutter($liburi);	$liburi=&declutter($liburi);
$filename=$liburi;	$filename=$liburi;
} else {	} else {
&devalidate_cache(\%metacache,$uri,'meta');	&devalidate_cache_new('meta',$uri);
	undef(%metaentry);
}	}
my %metathesekeys=();	my %metathesekeys=();
unless ($filename=~/\.meta$/) { $filename.='.meta'; }	unless ($filename=~/\.meta$/) { $filename.='.meta'; }
my $metastring;	my $metastring;
if ($uri !~ m\|^uploaded/\|) {	if ($uri !~ m\|^uploaded/\|) {
my $file=&filelocation('',&clutter($filename));	my $file=&filelocation('',&clutter($filename));
push(@{$metacache{$uri.'.file'}},$file);	#push(@{$metaentry{$uri.'.file'}},$file);
$metastring=&getfile($file);	$metastring=&getfile($file);
}	}
my $parser=HTML::LCParser->new(\$metastring);	my $parser=HTML::LCParser->new(\$metastring);
Line 4344 sub metadata {	Line 4600 sub metadata {
if (defined($token->[2]->{'id'})) {	if (defined($token->[2]->{'id'})) {
$keyroot.='_'.$token->[2]->{'id'};	$keyroot.='_'.$token->[2]->{'id'};
}	}
if ($metacache{$uri}->{':packages'}) {	if ($metaentry{':packages'}) {
$metacache{$uri}->{':packages'}.=','.$package.$keyroot;	$metaentry{':packages'}.=','.$package.$keyroot;
} else {	} else {
$metacache{$uri}->{':packages'}=$package.$keyroot;	$metaentry{':packages'}=$package.$keyroot;
}	}
foreach (keys %packagetab) {	foreach (keys %packagetab) {
my $part=$keyroot;	my $part=$keyroot;
Line 4369 sub metadata {	Line 4625 sub metadata {
if ($subp eq 'display') {	if ($subp eq 'display') {
$value.=' [Part: '.$part.']';	$value.=' [Part: '.$part.']';
}	}
$metacache{$uri}->{':'.$unikey.'.part'}=$part;	$metaentry{':'.$unikey.'.part'}=$part;
$metathesekeys{$unikey}=1;	$metathesekeys{$unikey}=1;
unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {	unless (defined($metaentry{':'.$unikey.'.'.$subp})) {
$metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;	$metaentry{':'.$unikey.'.'.$subp}=$value;
}	}
if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {	if (defined($metaentry{':'.$unikey.'.default'})) {
$metacache{$uri}->{':'.$unikey}=	$metaentry{':'.$unikey}=
$metacache{$uri}->{':'.$unikey.'.default'};	$metaentry{':'.$unikey.'.default'};
}	}
}	}
}	}
Line 4409 sub metadata {	Line 4665 sub metadata {
foreach (sort(split(/\,/,&metadata($uri,'keys',	foreach (sort(split(/\,/,&metadata($uri,'keys',
$location,$unikey,	$location,$unikey,
$depthcount+1)))) {	$depthcount+1)))) {
$metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};	$metaentry{':'.$_}=$metaentry{':'.$_};
$metathesekeys{$_}=1;	$metathesekeys{$_}=1;
}	}
}	}
Line 4420 sub metadata {	Line 4676 sub metadata {
}	}
$metathesekeys{$unikey}=1;	$metathesekeys{$unikey}=1;
foreach (@{$token->[3]}) {	foreach (@{$token->[3]}) {
$metacache{$uri}->{':'.$unikey.'.'.$_}=$token->[2]->{$_};	$metaentry{':'.$unikey.'.'.$_}=$token->[2]->{$_};
}	}
my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));	my $internaltext=&HTML::Entities::decode($parser->get_text('/'.$entry));
my $default=$metacache{$uri}->{':'.$unikey.'.default'};	my $default=$metaentry{':'.$unikey.'.default'};
if ( $internaltext =~ /^\s$/ && $default !~ /^\s$/) {	if ( $internaltext =~ /^\s$/ && $default !~ /^\s$/) {
# only ws inside the tag, and not in default, so use default	# only ws inside the tag, and not in default, so use default
# as value	# as value
$metacache{$uri}->{':'.$unikey}=$default;	$metaentry{':'.$unikey}=$default;
} else {	} else {
# either something interesting inside the tag or default	# either something interesting inside the tag or default
# uninteresting	# uninteresting
$metacache{$uri}->{':'.$unikey}=$internaltext;	$metaentry{':'.$unikey}=$internaltext;
}	}
# end of not-a-package not-a-library import	# end of not-a-package not-a-library import
}	}
Line 4448 sub metadata {	Line 4704 sub metadata {
&metadata_create_package_def($uri,$key,'extension_'.$extension,	&metadata_create_package_def($uri,$key,'extension_'.$extension,
\%metathesekeys);	\%metathesekeys);
}	}
if (!exists($metacache{$uri}->{':packages'})) {	if (!exists($metaentry{':packages'})) {
foreach my $key (sort(keys(%packagetab))) {	foreach my $key (sort(keys(%packagetab))) {
#no specific packages well let's get default then	#no specific packages well let's get default then
if ($key!~/^default&/) { next; }	if ($key!~/^default&/) { next; }
Line 4457 sub metadata {	Line 4713 sub metadata {
}	}
}	}
# are there custom rights to evaluate	# are there custom rights to evaluate
if ($metacache{$uri}->{':copyright'} eq 'custom') {	if ($metaentry{':copyright'} eq 'custom') {

#	#
# Importing a rights file here	# Importing a rights file here
#	#
unless ($depthcount) {	unless ($depthcount) {
my $location=$metacache{$uri}->{':customdistributionfile'};	my $location=$metaentry{':customdistributionfile'};
my $dir=$filename;	my $dir=$filename;
$dir=~s\|[^/]*$\|\|;	$dir=~s\|[^/]*$\|\|;
$location=&filelocation($dir,$location);	$location=&filelocation($dir,$location);
foreach (sort(split(/\,/,&metadata($uri,'keys',	foreach (sort(split(/\,/,&metadata($uri,'keys',
$location,'_rights',	$location,'_rights',
$depthcount+1)))) {	$depthcount+1)))) {
$metacache{$uri}->{':'.$_}=$metacache{$uri}->{':'.$_};	#$metaentry{':'.$_}=$metacache{$uri}->{':'.$_};
$metathesekeys{$_}=1;	$metathesekeys{$_}=1;
}	}
}	}
}	}
$metacache{$uri}->{':keys'}=join(',',keys %metathesekeys);	$metaentry{':keys'}=join(',',keys %metathesekeys);
&metadata_generate_part0(\%metathesekeys,$metacache{$uri},$uri);	&metadata_generate_part0(\%metathesekeys,\%metaentry,$uri);
$metacache{$uri}->{':allpossiblekeys'}=join(',',keys %metathesekeys);	$metaentry{':allpossiblekeys'}=join(',',keys %metathesekeys);
&do_cache(\%metacache,$uri,$metacache{$uri},'meta');	&do_cache_new('meta',$uri,\%metaentry);
# this is the end of "was not already recently cached	# this is the end of "was not already recently cached
}	}
return $metacache{$uri}->{':'.$what};	return $metaentry{':'.$what};
}	}

sub metadata_create_package_def {	sub metadata_create_package_def {
Line 4489 sub metadata_create_package_def {	Line 4745 sub metadata_create_package_def {
my ($pack,$name,$subp)=split(/\&/,$key);	my ($pack,$name,$subp)=split(/\&/,$key);
if ($subp eq 'default') { next; }	if ($subp eq 'default') { next; }

if (defined($metacache{$uri}->{':packages'})) {	if (defined($metaentry{':packages'})) {
$metacache{$uri}->{':packages'}.=','.$package;	$metaentry{':packages'}.=','.$package;
} else {	} else {
$metacache{$uri}->{':packages'}=$package;	$metaentry{':packages'}=$package;
}	}
my $value=$packagetab{$key};	my $value=$packagetab{$key};
my $unikey;	my $unikey;
$unikey='parameter_0_'.$name;	$unikey='parameter_0_'.$name;
$metacache{$uri}->{':'.$unikey.'.part'}=0;	$metaentry{':'.$unikey.'.part'}=0;
$$metathesekeys{$unikey}=1;	$$metathesekeys{$unikey}=1;
unless (defined($metacache{$uri}->{':'.$unikey.'.'.$subp})) {	unless (defined($metaentry{':'.$unikey.'.'.$subp})) {
$metacache{$uri}->{':'.$unikey.'.'.$subp}=$value;	$metaentry{':'.$unikey.'.'.$subp}=$value;
}	}
if (defined($metacache{$uri}->{':'.$unikey.'.default'})) {	if (defined($metaentry{':'.$unikey.'.default'})) {
$metacache{$uri}->{':'.$unikey}=	$metaentry{':'.$unikey}=
$metacache{$uri}->{':'.$unikey.'.default'};	$metaentry{':'.$unikey.'.default'};
}	}
}	}

Line 4542 sub gettitle {	Line 4798 sub gettitle {
my $urlsymb=shift;	my $urlsymb=shift;
my $symb=&symbread($urlsymb);	my $symb=&symbread($urlsymb);
if ($symb) {	if ($symb) {
my ($result,$cached)=&is_cached(\%titlecache,$symb,'title',600);	my $key=$ENV{'request.course.id'}."\0".$symb;
if (defined($cached)) { return $result; }	my ($result,$cached)=&is_cached_new('title',$key);
	if (defined($cached)) {
	return $result;
	}
my ($map,$resid,$url)=&decode_symb($symb);	my ($map,$resid,$url)=&decode_symb($symb);
my $title='';	my $title='';
my %bighash;	my %bighash;
Line 4555 sub gettitle {	Line 4814 sub gettitle {
}	}
$title=~s/\&colon\;/\:/gs;	$title=~s/\&colon\;/\:/gs;
if ($title) {	if ($title) {
return &do_cache(\%titlecache,$symb,$title,'title');	return &do_cache_new('title',$key,$title,600);
}	}
$urlsymb=$url;	$urlsymb=$url;
}	}
Line 4619 sub symbverify {	Line 4878 sub symbverify {
if (	if (
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)	&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
eq $symb) {	eq $symb) {
$okay=1;	if (($ENV{'request.role.adv'}) \|\|
}	$bighash{'encrypted_'.$_} eq $ENV{'request.enc'}) {
	$okay=1;
	}
	}
}	}
}	}
untie(%bighash);	untie(%bighash);
Line 4632 sub symbverify {	Line 4894 sub symbverify {

sub symbclean {	sub symbclean {
my $symb=shift;	my $symb=shift;
	if ($symb=~m\|^/enc/\|) { $symb=&Apache::lonenc::unencrypted($symb); }
# remove version from map	# remove version from map
$symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/;	$symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/;

Line 4653 sub encode_symb {	Line 4915 sub encode_symb {
}	}

sub decode_symb {	sub decode_symb {
my ($map,$resid,$url)=split(/\_\_\_/,shift);	my $symb=shift;
	if ($symb=~m\|^/enc/\|) { $symb=&Apache::lonenc::unencrypted($symb); }
	my ($map,$resid,$url)=split(/___/,$symb);
return (&fixversion($map),$resid,&fixversion($url));	return (&fixversion($map),$resid,&fixversion($url));
}	}

Line 4664 sub fixversion {	Line 4928 sub fixversion {
my $uri=&clutter($fn);	my $uri=&clutter($fn);
my $key=$ENV{'request.course.id'}.'_'.$uri;	my $key=$ENV{'request.course.id'}.'_'.$uri;
# is this cached?	# is this cached?
my ($result,$cached)=&is_cached(\%courseresversioncache,$key,	my ($result,$cached)=&is_cached_new('courseresversion',$key);
'courseresversion',600);
if (defined($cached)) { return $result; }	if (defined($cached)) { return $result; }
# unfortunately not cached, or expired	# unfortunately not cached, or expired
if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',	if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
Line 4679 sub fixversion {	Line 4942 sub fixversion {
}	}
untie %bighash;	untie %bighash;
}	}
return &do_cache	return &do_cache_new('courseresversion',$key,&declutter($uri),600);
(\%courseresversioncache,$key,&declutter($uri),'courseresversion');
}	}

sub deversion {	sub deversion {
Line 4702 sub symbread {	Line 4964 sub symbread {
}	}
$thisfn=$ENV{'request.filename'};	$thisfn=$ENV{'request.filename'};
}	}
	if ($thisfn=~m\|^/enc/\|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
# is that filename actually a symb? Verify, clean, and return	# is that filename actually a symb? Verify, clean, and return
if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {	if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
if (&symbverify($thisfn,$1)) {	if (&symbverify($thisfn,$1)) {
Line 4792 sub numval {	Line 5055 sub numval {
$txt=~tr/U-Z/0-5/;	$txt=~tr/U-Z/0-5/;
$txt=~tr/u-z/0-5/;	$txt=~tr/u-z/0-5/;
$txt=~s/\D//g;	$txt=~s/\D//g;
	if ($_64bit) { if ($txt > 2**32) { return -1; } }
return int($txt);	return int($txt);
}	}

Line 4807 sub numval2 {	Line 5071 sub numval2 {
my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt);	my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt);
my $total;	my $total;
foreach my $val (@txts) { $total+=$val; }	foreach my $val (@txts) { $total+=$val; }
	if ($_64bit) { if ($total > 2**32) { return -1; } }
return int($total);	return int($total);
}	}

	sub numval3 {
	use integer;
	my $txt=shift;
	$txt=~tr/A-J/0-9/;
	$txt=~tr/a-j/0-9/;
	$txt=~tr/K-T/0-9/;
	$txt=~tr/k-t/0-9/;
	$txt=~tr/U-Z/0-5/;
	$txt=~tr/u-z/0-5/;
	$txt=~s/\D//g;
	my @txts=split(/(\d\d\d\d\d\d\d\d\d)/,$txt);
	my $total;
	foreach my $val (@txts) { $total+=$val; }
	if ($_64bit) { $total=(($total<<32)>>32); }
	return $total;
	}

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

sub get_rand_alg {	sub get_rand_alg {
Line 4823 sub get_rand_alg {	Line 5105 sub get_rand_alg {
return &latest_rnd_algorithm_id();	return &latest_rnd_algorithm_id();
}	}

	sub validCODE {
	my ($CODE)=@_;
	if (defined($CODE) && $CODE ne '' && $CODE =~ /^\w+$/) { return 1; }
	return 0;
	}

sub getCODE {	sub getCODE {
if (defined($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }	if (&validCODE($ENV{'form.CODE'})) { return $ENV{'form.CODE'}; }
if (defined($Apache::lonhomework::parsing_a_problem) &&	if (defined($Apache::lonhomework::parsing_a_problem) &&
defined($Apache::lonhomework::history{'resource.CODE'})) {	&validCODE($Apache::lonhomework::history{'resource.CODE'})) {
return $Apache::lonhomework::history{'resource.CODE'};	return $Apache::lonhomework::history{'resource.CODE'};
}	}
return undef;	return undef;
Line 4844 sub rndseed {	Line 5132 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())) {
return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);	if ($which eq '64bit4') {
	return &rndseed_CODE_64bit4($symb,$courseid,$domain,$username);
	} else {
	return &rndseed_CODE_64bit($symb,$courseid,$domain,$username);
	}
	} elsif ($which eq '64bit4') {
	return &rndseed_64bit4($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit3') {	} elsif ($which eq '64bit3') {
return &rndseed_64bit3($symb,$courseid,$domain,$username);	return &rndseed_64bit3($symb,$courseid,$domain,$username);
} elsif ($which eq '64bit2') {	} elsif ($which eq '64bit2') {
Line 4868 sub rndseed_32bit {	Line 5162 sub rndseed_32bit {
my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;	my $num=$symbseed+$nameseed+$domainseed+$courseseed+$namechck+$symbchck;
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");
#&Apache::lonxml::debug("rndseed :$num:$symb");	#&Apache::lonxml::debug("rndseed :$num:$symb");
	if ($_64bit) { $num=(($num<<32)>>32); }
return $num;	return $num;
}	}
}	}
Line 4888 sub rndseed_64bit {	Line 5183 sub rndseed_64bit {
my $num2=$nameseed+$domainseed+$courseseed;	my $num2=$nameseed+$domainseed+$courseseed;
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");
#&Apache::lonxml::debug("rndseed :$num:$symb");	#&Apache::lonxml::debug("rndseed :$num:$symb");
	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }
return "$num1,$num2";	return "$num1,$num2";
}	}
}	}
Line 4931 sub rndseed_64bit3 {	Line 5228 sub rndseed_64bit3 {
my $num1=$symbchck+$symbseed+$namechck;	my $num1=$symbchck+$symbseed+$namechck;
my $num2=$nameseed+$domainseed+$courseseed;	my $num2=$nameseed+$domainseed+$courseseed;
#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");
#&Apache::lonxml::debug("rndseed :$num:$symb");	#&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit");
	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }

	return "$num1:$num2";
	}
	}

	sub rndseed_64bit4 {
	my ($symb,$courseid,$domain,$username)=@_;
	{
	use integer;
	# strings need to be an even # of cahracters long, it it is odd the
	# last characters gets thrown away
	my $symbchck=unpack("%32S*",$symb.' ') << 21;
	my $symbseed=numval3($symb) << 10;
	my $namechck=unpack("%32S*",$username.' ');

	my $nameseed=numval3($username) << 21;
	my $domainseed=unpack("%32S*",$domain.' ') << 10;
	my $courseseed=unpack("%32S*",$courseid.' ');

	my $num1=$symbchck+$symbseed+$namechck;
	my $num2=$nameseed+$domainseed+$courseseed;
	#&Apache::lonxml::debug("$symbseed:$nameseed;$domainseed\|$courseseed;$namechck:$symbchck");
	#&Apache::lonxml::debug("rndseed :$num1:$num2:$_64bit");
	if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); }

return "$num1:$num2";	return "$num1:$num2";
}	}
}	}
Line 4949 sub rndseed_CODE_64bit {	Line 5272 sub rndseed_CODE_64bit {
my $num2=$CODEseed+$courseseed+$symbchck;	my $num2=$CODEseed+$courseseed+$symbchck;
#&Apache::lonxml::debug("$symbseed:$CODEchck\|$CODEseed:$courseseed:$symbchck");	#&Apache::lonxml::debug("$symbseed:$CODEchck\|$CODEseed:$courseseed:$symbchck");
#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");	#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
	if ($_64bit) { $num1=(($num1<<32)>>32); }
	if ($_64bit) { $num2=(($num2<<32)>>32); }
	return "$num1:$num2";
	}
	}

	sub rndseed_CODE_64bit4 {
	my ($symb,$courseid,$domain,$username)=@_;
	{
	use integer;
	my $symbchck=unpack("%32S*",$symb.' ') << 16;
	my $symbseed=numval3($symb);
	my $CODEchck=unpack("%32S*",&getCODE().' ') << 16;
	my $CODEseed=numval3(&getCODE());
	my $courseseed=unpack("%32S*",$courseid.' ');
	my $num1=$symbseed+$CODEchck;
	my $num2=$CODEseed+$courseseed+$symbchck;
	#&Apache::lonxml::debug("$symbseed:$CODEchck\|$CODEseed:$courseseed:$symbchck");
	#&Apache::lonxml::debug("rndseed :$num1:$num2:$symb");
	if ($_64bit) { $num1=(($num1<<32)>>32); }
	if ($_64bit) { $num2=(($num2<<32)>>32); }
return "$num1:$num2";	return "$num1:$num2";
}	}
}	}
Line 5237 sub current_machine_ids {	Line 5581 sub current_machine_ids {

sub declutter {	sub declutter {
my $thisfn=shift;	my $thisfn=shift;
	if ($thisfn=~m\|^/enc/\|) { $thisfn=&Apache::lonenc::unencrypted($thisfn); }
$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;	$thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
$thisfn=~s/^\///;	$thisfn=~s/^\///;
$thisfn=~s/^res\///;	$thisfn=~s/^res\///;
Line 5254 sub clutter {	Line 5599 sub clutter {
return $thisfn;	return $thisfn;
}	}

	sub freeze_escape {
	my ($value)=@_;
	if (ref($value)) {
	$value=&nfreeze($value);
	return '__FROZEN__'.&escape($value);
	}
	return &escape($value);
	}

# -------------------------------------------------------- Escape Special Chars	# -------------------------------------------------------- Escape Special Chars

sub escape {	sub escape {
Line 5270 sub unescape {	Line 5624 sub unescape {
return $str;	return $str;
}	}

	sub thaw_unescape {
	my ($value)=@_;
	if ($value =~ /^__FROZEN__/) {
	substr($value,0,10,undef);
	$value=&unescape($value);
	return &thaw($value);
	}
	return &unescape($value);
	}

sub mod_perl_version {	sub mod_perl_version {
	return 1;
if (defined($perlvar{'MODPERL2'})) {	if (defined($perlvar{'MODPERL2'})) {
return 2;	return 2;
}	}
return 1;
}	}

sub correct_line_ends {	sub correct_line_ends {
Line 5287 sub correct_line_ends {	Line 5651 sub correct_line_ends {
sub goodbye {	sub goodbye {
&logthis("Starting Shut down");	&logthis("Starting Shut down");
#not converted to using infrastruture and probably shouldn't be	#not converted to using infrastruture and probably shouldn't be
&logthis(sprintf("%-20s is %s",'%badServerCache',scalar(%badServerCache)));	&logthis(sprintf("%-20s is %s",'%badServerCache',length(&freeze(\%badServerCache))));
#converted	#converted
&logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));	# &logthis(sprintf("%-20s is %s",'%metacache',scalar(%metacache)));
&logthis(sprintf("%-20s is %s",'%homecache',scalar(%homecache)));	# &logthis(sprintf("%-20s is %s",'%homecache',length(&freeze(\%homecache))));
&logthis(sprintf("%-20s is %s",'%titlecache',scalar(%titlecache)));	# &logthis(sprintf("%-20s is %s",'%titlecache',length(&freeze(\%titlecache))));
&logthis(sprintf("%-20s is %s",'%courseresdatacache',scalar(%courseresdatacache)));	# &logthis(sprintf("%-20s is %s",'%courseresdatacache',length(&freeze(\%courseresdatacache))));
#1.1 only	#1.1 only
&logthis(sprintf("%-20s is %s",'%userresdatacache',scalar(%userresdatacache)));	# &logthis(sprintf("%-20s is %s",'%userresdatacache',length(&freeze(\%userresdatacache))));
&logthis(sprintf("%-20s is %s",'%getsectioncache',scalar(%getsectioncache)));	# &logthis(sprintf("%-20s is %s",'%getsectioncache',length(&freeze(\%getsectioncache))));
&logthis(sprintf("%-20s is %s",'%courseresversioncache',scalar(%courseresversioncache)));	# &logthis(sprintf("%-20s is %s",'%courseresversioncache',length(&freeze(\%courseresversioncache))));
&logthis(sprintf("%-20s is %s",'%resversioncache',scalar(%resversioncache)));	# &logthis(sprintf("%-20s is %s",'%resversioncache',length(&freeze(\%resversioncache))));
	&logthis(sprintf("%-20s is %s",'%remembered',length(&freeze(\%remembered))));
	&logthis(sprintf("%-20s is %s",'kicks',$kicks));
	&logthis(sprintf("%-20s is %s",'hits',$hits));
&flushcourselogs();	&flushcourselogs();
&logthis("Shutting down");	&logthis("Shutting down");
return DONE;	return DONE;
Line 5307 BEGIN {	Line 5674 BEGIN {
# ----------------------------------- Read loncapa.conf and loncapa_apache.conf	# ----------------------------------- Read loncapa.conf and loncapa_apache.conf
unless ($readit) {	unless ($readit) {
{	{
	# FIXME: Use LONCAPA::Configuration::read_conf here and omit next block
open(my $config,"</etc/httpd/conf/loncapa.conf");	open(my $config,"</etc/httpd/conf/loncapa.conf");

while (my $configline=<$config>) {	while (my $configline=<$config>) {
Line 5442 BEGIN {	Line 5810 BEGIN {

}	}

%metacache=();	$memcache=new Cache::Memcached({'servers'=>['127.0.0.1:11211']});

$processmarker='_'.time.'_'.$perlvar{'lonHostID'};	$processmarker='_'.time.'_'.$perlvar{'lonHostID'};
$dumpcount=0;	$dumpcount=0;
Line 5450 $dumpcount=0;	Line 5818 $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;
	my $test=(2**32)+1;
	if ($test != 0) { $_64bit=1; } else { $_64bit=0; }
	&logthis(" Detected 64bit platform ($_64bit)");
	}
}	}
}	}

Line 5936 returns the data handle	Line 6310 returns the data handle
=item *	=item *

symbverify($symb,$thisfn) : verifies that $symb actually exists and is	symbverify($symb,$thisfn) : verifies that $symb actually exists and is
a possible symb for the URL in $thisfn, returns a 1 on success, 0 on	a possible symb for the URL in $thisfn, and if is an encryypted
failure, user must be in a course, as it assumes the existance of the	resource that the user accessed using /enc/ returns a 1 on success, 0
course initi hash, and uses $ENV('request.course.id'}	on failure, user must be in a course, as it assumes the existance of
	the course initial hash, and uses $ENV('request.course.id'}


=item *	=item *

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

Removed from v.1.556
changed lines
	Added in v.1.587.2.3.2.12