--- loncom/lonnet/perl/lonnet.pm 2001/09/26 15:03:20 1.159 +++ loncom/lonnet/perl/lonnet.pm 2001/11/05 22:48:19 1.168 @@ -118,6 +118,7 @@ # 05/01,06/01,09/01 Gerd Kortemeyer # 09/01 Guy Albertelli # 09/01,10/01,11/01 Gerd Kortemeyer +# YEAR=2001 # 02/27/01 Scott Harrison # 3/2 Gerd Kortemeyer # 3/15,3/19 Scott Harrison @@ -127,7 +128,9 @@ # 5/30 H. K. Ng # 6/1 Gerd Kortemeyer # 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 Gerd Kortemeyer +# 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/5,10/10 Scott Harrison package Apache::lonnet; @@ -145,6 +148,16 @@ use Fcntl qw(:flock); # --------------------------------------------------------------------- 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 { my $message=shift; my $execdir=$perlvar{'lonDaemons'}; @@ -841,15 +854,155 @@ 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 sub store { my ($storehash,$symb,$namespace,$domain,$stuname) = @_; my $home=''; - if ($stuname) { - $home=&homeserver($stuname,$domain); - } + if ($stuname) { $home=&homeserver($stuname,$domain); } if (!$symb) { unless ($symb=&symbread()) { return ''; } } @@ -874,9 +1027,7 @@ sub cstore { my ($storehash,$symb,$namespace,$domain,$stuname) = @_; my $home=''; - if ($stuname) { - $home=&homeserver($stuname,$domain); - } + if ($stuname) { $home=&homeserver($stuname,$domain); } if (!$symb) { unless ($symb=&symbread()) { return ''; } } @@ -902,9 +1053,7 @@ sub restore { my ($symb,$namespace,$domain,$stuname) = @_; my $home=''; - if ($stuname) { - $home=&homeserver($stuname,$domain); - } + if ($stuname) { $home=&homeserver($stuname,$domain); } if (!$symb) { unless ($symb=escape(&symbread())) { return ''; } @@ -1228,7 +1377,7 @@ sub allowed { # 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; } # @@ -1632,7 +1781,7 @@ sub modifystudent { return 'error: no such user'; } # -------------------------------------------------- Add student to course list - my $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'. + $reply=critical('put:'.$ENV{'course.'.$cid.'.domain'}.':'. $ENV{'course.'.$cid.'.num'}.':classlist:'. &escape($uname.':'.$udom).'='. &escape($end.':'.$start), @@ -1697,7 +1846,7 @@ sub createcourse { my $reply=&reply('encrypt:makeuser:'.$udom.':'.$uname.':none::', $ENV{'user.home'}); unless ($reply eq 'ok') { return 'error: '.$reply; } - my $uhome=&homeserver($uname,$udom); + $uhome=&homeserver($uname,$udom); if (($uhome eq '') || ($uhome eq 'no_host')) { return 'error: no such course'; } @@ -2323,7 +2472,7 @@ sub unescape { # ================================================================ Main Program sub BEGIN { -if ($readit ne 'done') { +unless ($readit) { # ------------------------------------------------------------ Read access.conf { my $config=Apache::File->new("/etc/httpd/conf/access.conf"); @@ -2368,8 +2517,10 @@ if ($readit ne 'done') { while (my $configline=<$config>) { chomp($configline); + if ($configline) { my ($role,$perm)=split(/ /,$configline); if ($perm ne '') { $pr{$role}=$perm; } + } } } @@ -2379,8 +2530,10 @@ if ($readit ne 'done') { while (my $configline=<$config>) { chomp($configline); + if ($configline) { my ($short,$plain)=split(/:/,$configline); if ($plain ne '') { $prp{$short}=$plain; } + } } } @@ -2416,6 +2569,7 @@ if ($readit ne 'done') { %metacache=(); $readit='done'; +&logtouch(); &logthis('INFO: Read configuration'); } }