version 1.162, 2001/10/06 20:57:45
|
version 1.168, 2001/11/05 22:48:19
|
Line 130
|
Line 130
|
# July Guy Albertelli |
# July Guy Albertelli |
# 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26, |
# 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18,8/20,8/23,9/20,9/21,9/26, |
# 10/2 Gerd Kortemeyer |
# 10/2 Gerd Kortemeyer |
# 10/5 Scott Harrison |
# 10/5,10/10 Scott Harrison |
|
|
package Apache::lonnet; |
package Apache::lonnet; |
|
|
Line 148 use Fcntl qw(:flock);
|
Line 148 use Fcntl qw(:flock);
|
|
|
# --------------------------------------------------------------------- Logging |
# --------------------------------------------------------------------- Logging |
|
|
|
sub logtouch { |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
unless (-e "$execdir/logs/lonnet.log") { |
|
my $fh=Apache::File->new(">>$execdir/logs/lonnet.log"); |
|
close $fh; |
|
} |
|
my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3]; |
|
chown($wwwuid,$wwwgid,$execdir.'/logs/lonnet.log'); |
|
} |
|
|
sub logthis { |
sub logthis { |
my $message=shift; |
my $message=shift; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
Line 844 sub devalidate {
|
Line 854 sub devalidate {
|
} |
} |
} |
} |
|
|
|
sub hash2str { |
|
my (%hash)=@_; |
|
my $result=''; |
|
map { $result.=escape($_).'='.escape($hash{$_}).'&'; } keys %hash; |
|
$result=~s/\&$//; |
|
return $result; |
|
} |
|
|
|
sub str2hash { |
|
my ($string) = @_; |
|
my %returnhash; |
|
map { |
|
my ($name,$value)=split(/\=/,$_); |
|
$returnhash{&unescape($name)}=&unescape($value); |
|
} split(/\&/,$string); |
|
return %returnhash; |
|
} |
|
|
|
# -------------------------------------------------------------------Temp Store |
|
|
|
sub tmpreset { |
|
my ($symb,$namespace,$domain,$stuname) = @_; |
|
if (!$symb) { |
|
$symb=&symbread(); |
|
if (!$symb) { $symb= $ENV{'REQUEST_URI'}; } |
|
} |
|
$symb=escape($symb); |
|
|
|
if (!$namespace) { $namespace=$ENV{'request.state'}; } |
|
$namespace=~s/\//\_/g; |
|
$namespace=~s/\W//g; |
|
|
|
#FIXME needs to do something for /pub resources |
|
if (!$domain) { $domain=$ENV{'user.domain'}; } |
|
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
my $path=$perlvar{'lonDaemons'}.'/tmp'; |
|
my %hash; |
|
if (tie(%hash,'GDBM_File', |
|
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', |
|
&GDBM_WRCREAT,0640)) { |
|
foreach my $key (keys %hash) { |
|
if ($key=~ /:$symb:/) { |
|
delete($hash{$key}); |
|
} |
|
} |
|
} |
|
} |
|
|
|
sub tmpstore { |
|
my ($storehash,$symb,$namespace,$domain,$stuname) = @_; |
|
|
|
if (!$symb) { |
|
$symb=&symbread(); |
|
if (!$symb) { $symb= $ENV{'request.url'}; } |
|
} |
|
$symb=escape($symb); |
|
|
|
if (!$namespace) { |
|
# I don't think we would ever want to store this for a course. |
|
# it seems this will only be used if we don't have a course. |
|
#$namespace=$ENV{'request.course.id'}; |
|
#if (!$namespace) { |
|
$namespace=$ENV{'request.state'}; |
|
#} |
|
} |
|
$namespace=~s/\//\_/g; |
|
$namespace=~s/\W//g; |
|
#FIXME needs to do something for /pub resources |
|
if (!$domain) { $domain=$ENV{'user.domain'}; } |
|
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
my $now=time; |
|
my %hash; |
|
my $path=$perlvar{'lonDaemons'}.'/tmp'; |
|
if (tie(%hash,'GDBM_File', |
|
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', |
|
&GDBM_WRCREAT,0640)) { |
|
$hash{"version:$symb"}++; |
|
my $version=$hash{"version:$symb"}; |
|
my $allkeys=''; |
|
foreach my $key (keys(%$storehash)) { |
|
$allkeys.=$key.':'; |
|
$hash{"$version:$symb:$key"}=$$storehash{$key}; |
|
} |
|
$hash{"$version:$symb:timestamp"}=$now; |
|
$allkeys.='timestamp'; |
|
$hash{"$version:keys:$symb"}=$allkeys; |
|
if (untie(%hash)) { |
|
return 'ok'; |
|
} else { |
|
return "error:$!"; |
|
} |
|
} else { |
|
return "error:$!"; |
|
} |
|
} |
|
|
|
# -----------------------------------------------------------------Temp Restore |
|
|
|
sub tmprestore { |
|
my ($symb,$namespace,$domain,$stuname) = @_; |
|
|
|
if (!$symb) { |
|
$symb=&symbread(); |
|
if (!$symb) { $symb= $ENV{'request.url'}; } |
|
} |
|
$symb=escape($symb); |
|
|
|
if (!$namespace) { $namespace=$ENV{'request.state'}; } |
|
#FIXME needs to do something for /pub resources |
|
if (!$domain) { $domain=$ENV{'user.domain'}; } |
|
if (!$stuname) { $stuname=$ENV{'user.name'}; } |
|
|
|
my %returnhash; |
|
$namespace=~s/\//\_/g; |
|
$namespace=~s/\W//g; |
|
my %hash; |
|
my $path=$perlvar{'lonDaemons'}.'/tmp'; |
|
if (tie(%hash,'GDBM_File', |
|
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db', |
|
&GDBM_READER,0640)) { |
|
my $version=$hash{"version:$symb"}; |
|
$returnhash{'version'}=$version; |
|
my $scope; |
|
for ($scope=1;$scope<=$version;$scope++) { |
|
my $vkeys=$hash{"$scope:keys:$symb"}; |
|
my @keys=split(/:/,$vkeys); |
|
my $key; |
|
$returnhash{"$scope:keys"}=$vkeys; |
|
foreach $key (@keys) { |
|
$returnhash{"$scope:$key"}=$hash{"$scope:$symb:$key"}; |
|
$returnhash{"$key"}=$hash{"$scope:$symb:$key"}; |
|
} |
|
} |
|
if (!(untie(%hash))) { |
|
return "error:$!"; |
|
} |
|
} else { |
|
return "error:$!"; |
|
} |
|
return %returnhash; |
|
} |
|
|
# ----------------------------------------------------------------------- Store |
# ----------------------------------------------------------------------- Store |
|
|
sub store { |
sub store { |
my ($storehash,$symb,$namespace,$domain,$stuname) = @_; |
my ($storehash,$symb,$namespace,$domain,$stuname) = @_; |
my $home=''; |
my $home=''; |
|
|
if ($stuname) { |
if ($stuname) { $home=&homeserver($stuname,$domain); } |
$home=&homeserver($stuname,$domain); |
|
} |
|
|
|
if (!$symb) { unless ($symb=&symbread()) { return ''; } } |
if (!$symb) { unless ($symb=&symbread()) { return ''; } } |
|
|
Line 877 sub cstore {
|
Line 1027 sub cstore {
|
my ($storehash,$symb,$namespace,$domain,$stuname) = @_; |
my ($storehash,$symb,$namespace,$domain,$stuname) = @_; |
my $home=''; |
my $home=''; |
|
|
if ($stuname) { |
if ($stuname) { $home=&homeserver($stuname,$domain); } |
$home=&homeserver($stuname,$domain); |
|
} |
|
|
|
if (!$symb) { unless ($symb=&symbread()) { return ''; } } |
if (!$symb) { unless ($symb=&symbread()) { return ''; } } |
|
|
Line 905 sub restore {
|
Line 1053 sub restore {
|
my ($symb,$namespace,$domain,$stuname) = @_; |
my ($symb,$namespace,$domain,$stuname) = @_; |
my $home=''; |
my $home=''; |
|
|
if ($stuname) { |
if ($stuname) { $home=&homeserver($stuname,$domain); } |
$home=&homeserver($stuname,$domain); |
|
} |
|
|
|
if (!$symb) { |
if (!$symb) { |
unless ($symb=escape(&symbread())) { return ''; } |
unless ($symb=escape(&symbread())) { return ''; } |
Line 1231 sub allowed {
|
Line 1377 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:'=~/\:$priv\:/) { |
if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:$priv\:/) { |
return $thisallowed; |
return $thisallowed; |
} |
} |
# |
# |
Line 2423 unless ($readit) {
|
Line 2569 unless ($readit) {
|
%metacache=(); |
%metacache=(); |
|
|
$readit='done'; |
$readit='done'; |
|
&logtouch(); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |
} |
} |
} |
} |