--- loncom/lond 1999/11/04 20:12:47 1.3 +++ loncom/lond 2000/01/12 19:30:43 1.7 @@ -3,7 +3,8 @@ # lond "LON Daemon" Server (port "LOND" 5663) # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30, # 7/8,7/9,7/10,7/12,7/17,7/19,9/21, -# 10/7,10/8,10/9,10/11,10/13,10/15 Gerd Kortemeyer +# 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16, +# 12/7,12/15,01/06,01/11,01/12 Gerd Kortemeyer # based on "Perl Cookbook" ISBN 1-56592-243-3 # preforker - server who forks first # runs as a daemon @@ -27,6 +28,7 @@ open (CONFIG,"/etc/httpd/conf/access.con while ($configline=) { if ($configline =~ /PerlSetVar/) { my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); $perlvar{$varname}=$varvalue; } } @@ -494,9 +496,10 @@ sub make_new_child { } # ------------------------------------------------------------------------- put } elsif ($userinput =~ /^put/) { - my ($cmd,$udom,$uname,$namespace,$what) + my ($cmd,$udom,$uname,$namespace,$what) =split(/:/,$userinput); - $namespace=~s/\W//g; + $namespace=~s/\W//g; + if ($namespace ne 'roles') { chomp($what); my $proname=propath($udom,$uname); my $now=time; @@ -507,12 +510,46 @@ sub make_new_child { ) { print $hfh "P:$now:$what\n"; } } my @pairs=split(/\&/,$what); - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + foreach $pair (@pairs) { + ($key,$value)=split(/=/,$pair); + $hash{$key}=$value; + } + if (untie(%hash)) { + print $client "ok\n"; + } else { + print $client "error:$!\n"; + } + } else { + print $client "error:$!\n"; + } + } else { + print $client "refused\n"; + } +# -------------------------------------------------------------------- rolesput + } elsif ($userinput =~ /^rolesput/) { + if ($wasenc==1) { + my ($cmd,$exedom,$exeuser,$udom,$uname,$what) + =split(/:/,$userinput); + my $namespace='roles'; + chomp($what); + my $proname=propath($udom,$uname); + my $now=time; + { + my $hfh; + if ( + $hfh=IO::File->new(">>$proname/$namespace.hist") + ) { + print $hfh "P:$now:$exedom:$exeuser:$what\n"; + } + } + my @pairs=split(/\&/,$what); + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $pair (@pairs) { ($key,$value)=split(/=/,$pair); $hash{$key}=$value; } - if (dbmclose(%hash)) { + if (untie(%hash)) { print $client "ok\n"; } else { print $client "error:$!\n"; @@ -520,6 +557,9 @@ sub make_new_child { } else { print $client "error:$!\n"; } + } else { + print $client "refused\n"; + } # ------------------------------------------------------------------------- get } elsif ($userinput =~ /^get/) { my ($cmd,$udom,$uname,$namespace,$what) @@ -529,11 +569,11 @@ sub make_new_child { my @queries=split(/\&/,$what); my $proname=propath($udom,$uname); my $qresult=''; - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -551,11 +591,11 @@ sub make_new_child { my @queries=split(/\&/,$what); my $proname=propath($udom,$uname); my $qresult=''; - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; if ($cipher) { my $cmdlength=length($qresult); @@ -592,11 +632,11 @@ sub make_new_child { ) { print $hfh "D:$now:$what\n"; } } my @keys=split(/\&/,$what); - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $key (@keys) { delete($hash{$key}); } - if (dbmclose(%hash)) { + if (untie(%hash)) { print $client "ok\n"; } else { print $client "error:$!\n"; @@ -612,11 +652,11 @@ sub make_new_child { chomp($namespace); my $proname=propath($udom,$uname); my $qresult=''; - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $key (keys %hash) { $qresult.="$key&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -633,11 +673,82 @@ sub make_new_child { chomp($namespace); my $proname=propath($udom,$uname); my $qresult=''; - if (dbmopen(%hash,"$proname/$namespace.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $key (keys %hash) { $qresult.="$key=$hash{$key}&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { + $qresult=~s/\&$//; + print $client "$qresult\n"; + } else { + print $client "error:$!\n"; + } + } else { + print $client "error:$!\n"; + } +# ----------------------------------------------------------------------- store + } elsif ($userinput =~ /^store/) { + my ($cmd,$udom,$uname,$namespace,$rid,$what) + =split(/:/,$userinput); + $namespace=~s/\W//g; + if ($namespace ne 'roles') { + chomp($what); + my $proname=propath($udom,$uname); + my $now=time; + { + my $hfh; + if ( + $hfh=IO::File->new(">>$proname/$namespace.hist") + ) { print $hfh "P:$now:$rid:$what\n"; } + } + my @pairs=split(/\&/,$what); + + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + my @previouskeys=split(/&/,$hash{"keys:$rid"}); + my $key; + $hash{"version:$rid"}++; + my $version=$hash{"version:$rid"}; + my $allkeys=''; + foreach $pair (@pairs) { + ($key,$value)=split(/=/,$pair); + $allkeys.=$key.':'; + $hash{"$version:$rid:$key"}=$value; + } + $allkeys=~s/:$//; + $hash{"$version:keys:$rid"}=$allkeys; + if (untie(%hash)) { + print $client "ok\n"; + } else { + print $client "error:$!\n"; + } + } else { + print $client "error:$!\n"; + } + } else { + print $client "refused\n"; + } +# --------------------------------------------------------------------- restore + } elsif ($userinput =~ /^restore/) { + my ($cmd,$udom,$uname,$namespace,$rid) + =split(/:/,$userinput); + $namespace=~s/\W//g; + chomp($rid); + my $proname=propath($udom,$uname); + my $qresult=''; + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { + my $version=$hash{"version:$rid"}; + $qresult.="version=$version&"; + my $scope; + for ($scope=1;$scope<=$version;$scope++) { + my $vkeys=$hash{"$scope:keys:$rid"}; + my @keys=split(/:/,$vkeys); + my $key; + $qresult.="$scope:keys=$vkeys&"; + foreach $key (@keys) { + $qresult.="$version:$key=".$hash{"$scope:$rid:$key"}."&"; + } + } + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -660,12 +771,12 @@ sub make_new_child { ) { print $hfh "P:$now:$what\n"; } } my @pairs=split(/\&/,$what); - if (dbmopen(%hash,"$proname.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { foreach $pair (@pairs) { ($key,$value)=split(/=/,$pair); $hash{$key}=$value; } - if (dbmclose(%hash)) { + if (untie(%hash)) { print $client "ok\n"; } else { print $client "error:$!\n"; @@ -681,11 +792,11 @@ sub make_new_child { my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; my @queries=split(/\&/,$what); my $qresult=''; - if (dbmopen(%hash,"$proname.db",0644)) { + if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { for ($i=0;$i<=$#queries;$i++) { $qresult.="$hash{$queries[$i]}&"; } - if (dbmclose(%hash)) { + if (untie(%hash)) { $qresult=~s/\&$//; print $client "$qresult\n"; } else { @@ -694,6 +805,20 @@ sub make_new_child { } else { print $client "error:$!\n"; } +# -------------------------------------------------------------------------- ls + } elsif ($userinput =~ /^ls/) { + my ($cmd,$ulsdir)=split(/:/,$userinput); + my $ulsout=''; + my $ulsfn; + if (-e $ulsdir) { + while ($ulsfn=<$ulsdir/*>) { + my @ulsstats=stat($ulsfn); + $ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; + } + } else { + $ulsout='no_such_dir'; + } + print $client "$ulsout\n"; # ------------------------------------------------------------- unknown command } else { # unknown command