version 1.2, 1999/10/26 20:24:47
|
version 1.4, 1999/11/04 20:53:04
|
Line 3
|
Line 3
|
# lond "LON Daemon" Server (port "LOND" 5663) |
# 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, |
# 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, |
# 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 Gerd Kortemeyer |
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
# preforker - server who forks first |
# preforker - server who forks first |
# runs as a daemon |
# runs as a daemon |
Line 17 use Symbol;
|
Line 17 use Symbol;
|
use POSIX; |
use POSIX; |
use Crypt::IDEA; |
use Crypt::IDEA; |
use LWP::UserAgent(); |
use LWP::UserAgent(); |
|
use GDBM_File; |
|
use Authen::Krb4; |
|
|
# ------------------------------------ Read httpd access.conf and get variables |
# ------------------------------------ Read httpd access.conf and get variables |
|
|
Line 355 sub make_new_child {
|
Line 357 sub make_new_child {
|
$contentpwd=(getpwnam($uname))[1]; |
$contentpwd=(getpwnam($uname))[1]; |
$pwdcorrect= |
$pwdcorrect= |
(crypt($upass,$contentpwd) eq $contentpwd); |
(crypt($upass,$contentpwd) eq $contentpwd); |
|
} elsif ($howpwd eq 'krb4') { |
|
$pwdcorrect=( |
|
Authen::Krb4::get_pw_in_tkt($uname,"", |
|
$contentpwd,'krbtgt',$contentpwd,1, |
|
$upass) == 0); |
} |
} |
if ($pwdcorrect) { |
if ($pwdcorrect) { |
print $client "authorized\n"; |
print $client "authorized\n"; |
Line 500 sub make_new_child {
|
Line 507 sub make_new_child {
|
) { print $hfh "P:$now:$what\n"; } |
) { print $hfh "P:$now:$what\n"; } |
} |
} |
my @pairs=split(/\&/,$what); |
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) { |
foreach $pair (@pairs) { |
($key,$value)=split(/=/,$pair); |
($key,$value)=split(/=/,$pair); |
$hash{$key}=$value; |
$hash{$key}=$value; |
} |
} |
if (dbmclose(%hash)) { |
if (untie(%hash)) { |
print $client "ok\n"; |
print $client "ok\n"; |
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
Line 522 sub make_new_child {
|
Line 529 sub make_new_child {
|
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
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++) { |
for ($i=0;$i<=$#queries;$i++) { |
$qresult.="$hash{$queries[$i]}&"; |
$qresult.="$hash{$queries[$i]}&"; |
} |
} |
if (dbmclose(%hash)) { |
if (untie(%hash)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
print $client "$qresult\n"; |
print $client "$qresult\n"; |
} else { |
} else { |
Line 544 sub make_new_child {
|
Line 551 sub make_new_child {
|
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
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++) { |
for ($i=0;$i<=$#queries;$i++) { |
$qresult.="$hash{$queries[$i]}&"; |
$qresult.="$hash{$queries[$i]}&"; |
} |
} |
if (dbmclose(%hash)) { |
if (untie(%hash)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
if ($cipher) { |
if ($cipher) { |
my $cmdlength=length($qresult); |
my $cmdlength=length($qresult); |
Line 585 sub make_new_child {
|
Line 592 sub make_new_child {
|
) { print $hfh "D:$now:$what\n"; } |
) { print $hfh "D:$now:$what\n"; } |
} |
} |
my @keys=split(/\&/,$what); |
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) { |
foreach $key (@keys) { |
delete($hash{$key}); |
delete($hash{$key}); |
} |
} |
if (dbmclose(%hash)) { |
if (untie(%hash)) { |
print $client "ok\n"; |
print $client "ok\n"; |
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
Line 605 sub make_new_child {
|
Line 612 sub make_new_child {
|
chomp($namespace); |
chomp($namespace); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
my $qresult=''; |
if (dbmopen(%hash,"$proname/$namespace.db",0644)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
foreach $key (keys %hash) { |
foreach $key (keys %hash) { |
$qresult.="$key&"; |
$qresult.="$key&"; |
} |
} |
if (dbmclose(%hash)) { |
if (untie(%hash)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
print $client "$qresult\n"; |
print $client "$qresult\n"; |
} else { |
} else { |
Line 626 sub make_new_child {
|
Line 633 sub make_new_child {
|
chomp($namespace); |
chomp($namespace); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $qresult=''; |
my $qresult=''; |
if (dbmopen(%hash,"$proname/$namespace.db",0644)) { |
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
foreach $key (keys %hash) { |
foreach $key (keys %hash) { |
$qresult.="$key=$hash{$key}&"; |
$qresult.="$key=$hash{$key}&"; |
} |
} |
if (dbmclose(%hash)) { |
if (untie(%hash)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
print $client "$qresult\n"; |
print $client "$qresult\n"; |
} else { |
} else { |
Line 653 sub make_new_child {
|
Line 660 sub make_new_child {
|
) { print $hfh "P:$now:$what\n"; } |
) { print $hfh "P:$now:$what\n"; } |
} |
} |
my @pairs=split(/\&/,$what); |
my @pairs=split(/\&/,$what); |
if (dbmopen(%hash,"$proname.db",0644)) { |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { |
foreach $pair (@pairs) { |
foreach $pair (@pairs) { |
($key,$value)=split(/=/,$pair); |
($key,$value)=split(/=/,$pair); |
$hash{$key}=$value; |
$hash{$key}=$value; |
} |
} |
if (dbmclose(%hash)) { |
if (untie(%hash)) { |
print $client "ok\n"; |
print $client "ok\n"; |
} else { |
} else { |
print $client "error:$!\n"; |
print $client "error:$!\n"; |
Line 674 sub make_new_child {
|
Line 681 sub make_new_child {
|
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
my $proname="$perlvar{'lonUsersDir'}/$udom/ids"; |
my @queries=split(/\&/,$what); |
my @queries=split(/\&/,$what); |
my $qresult=''; |
my $qresult=''; |
if (dbmopen(%hash,"$proname.db",0644)) { |
if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT,0640)) { |
for ($i=0;$i<=$#queries;$i++) { |
for ($i=0;$i<=$#queries;$i++) { |
$qresult.="$hash{$queries[$i]}&"; |
$qresult.="$hash{$queries[$i]}&"; |
} |
} |
if (dbmclose(%hash)) { |
if (untie(%hash)) { |
$qresult=~s/\&$//; |
$qresult=~s/\&$//; |
print $client "$qresult\n"; |
print $client "$qresult\n"; |
} else { |
} else { |