version 1.39, 2001/03/22 15:06:01
|
version 1.55, 2001/11/16 06:19:33
|
Line 13
|
Line 13
|
# Jan 01 Scott Harrison |
# Jan 01 Scott Harrison |
# 02/12 Gerd Kortemeyer |
# 02/12 Gerd Kortemeyer |
# 03/15 Scott Harrison |
# 03/15 Scott Harrison |
|
# 03/24 Gerd Kortemeyer |
|
# 04/02 Scott Harrison |
|
# 05/11,05/28,08/30 Gerd Kortemeyer |
|
# 9/30,10/22,11/13,11/15 Scott Harrison |
# |
# |
|
# $Id$ |
|
### |
|
|
# 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 29 use Crypt::IDEA;
|
Line 36 use Crypt::IDEA;
|
use LWP::UserAgent(); |
use LWP::UserAgent(); |
use GDBM_File; |
use GDBM_File; |
use Authen::Krb4; |
use Authen::Krb4; |
|
use lib '/home/httpd/lib/perl/'; |
|
use localauth; |
|
|
# grabs exception and records it to log before exiting |
# grabs exception and records it to log before exiting |
sub catchexception { |
sub catchexception { |
Line 361 sub make_new_child {
|
Line 370 sub make_new_child {
|
my $clientip=inet_ntoa($iaddr); |
my $clientip=inet_ntoa($iaddr); |
my $clientrec=($hostid{$clientip} ne undef); |
my $clientrec=($hostid{$clientip} ne undef); |
&logthis( |
&logthis( |
"<font color=yellow>INFO: Connect from $clientip ($hostid{$clientip})</font>"); |
"<font color=yellow>INFO: Connection $i, $clientip ($hostid{$clientip})</font>" |
|
); |
my $clientok; |
my $clientok; |
if ($clientrec) { |
if ($clientrec) { |
my $remotereq=<$client>; |
my $remotereq=<$client>; |
Line 446 sub make_new_child {
|
Line 456 sub make_new_child {
|
$loadavg =~ s/\s.*//g; |
$loadavg =~ s/\s.*//g; |
my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'}; |
my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'}; |
print $client "$loadpercent\n"; |
print $client "$loadpercent\n"; |
|
# ----------------------------------------------------------------- currentauth |
|
} elsif ($userinput =~ /^currentauth/) { |
|
if ($wasenc==1) { |
|
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
|
my $proname=propath($udom,$uname); |
|
my $passfilename="$proname/passwd"; |
|
if (-e $passfilename) { |
|
my $pf = IO::File->new($passfilename); |
|
my $realpasswd=<$pf>; |
|
chomp($realpasswd); |
|
my ($howpwd,$contentpwd)=split(/:/,$realpasswd); |
|
my $availablecontent=''; |
|
if ($howpwd eq 'krb4') { |
|
$availablecontent=$contentpwd; |
|
} |
|
print $client "$howpwd:$availablecontent\n"; |
|
} else { |
|
print $client "unknown_user\n"; |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
# ------------------------------------------------------------------------ auth |
# ------------------------------------------------------------------------ auth |
} elsif ($userinput =~ /^auth/) { |
} elsif ($userinput =~ /^auth/) { |
if ($wasenc==1) { |
if ($wasenc==1) { |
Line 465 sub make_new_child {
|
Line 497 sub make_new_child {
|
(crypt($upass,$contentpwd) eq $contentpwd); |
(crypt($upass,$contentpwd) eq $contentpwd); |
} elsif ($howpwd eq 'unix') { |
} elsif ($howpwd eq 'unix') { |
$contentpwd=(getpwnam($uname))[1]; |
$contentpwd=(getpwnam($uname))[1]; |
$pwdcorrect= |
my $pwauth_path="/usr/local/sbin/pwauth"; |
(crypt($upass,$contentpwd) eq $contentpwd); |
unless ($contentpwd eq 'x') { |
|
$pwdcorrect= |
|
(crypt($upass,$contentpwd) eq $contentpwd); |
|
} |
|
elsif (-e $pwauth_path) { |
|
open PWAUTH, "|$pwauth_path" or |
|
die "Cannot invoke authentication"; |
|
print PWAUTH "$uname\n$upass\n"; |
|
close PWAUTH; |
|
$pwdcorrect=!$?; |
|
} |
} elsif ($howpwd eq 'krb4') { |
} elsif ($howpwd eq 'krb4') { |
$pwdcorrect=( |
$pwdcorrect=( |
Authen::Krb4::get_pw_in_tkt($uname,"", |
Authen::Krb4::get_pw_in_tkt($uname,"", |
$contentpwd,'krbtgt',$contentpwd,1, |
$contentpwd,'krbtgt',$contentpwd,1, |
$upass) == 0); |
$upass) == 0); |
} |
} elsif ($howpwd eq 'localauth') { |
|
$pwdcorrect=&localauth::localauth($uname,$upass, |
|
$contentpwd); |
|
} |
if ($pwdcorrect) { |
if ($pwdcorrect) { |
print $client "authorized\n"; |
print $client "authorized\n"; |
} else { |
} else { |
Line 559 sub make_new_child {
|
Line 604 sub make_new_child {
|
{ |
{ |
my $pf = IO::File->new(">$passfilename"); |
my $pf = IO::File->new(">$passfilename"); |
print $pf "internal:$ncpass\n"; |
print $pf "internal:$ncpass\n"; |
} |
} |
print $client "ok\n"; |
print $client "ok\n"; |
} elsif ($umode eq 'none') { |
} elsif ($umode eq 'localauth') { |
|
{ |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "localauth:$npass\n"; |
|
} |
|
print $client "ok\n"; |
|
} elsif ($umode eq 'unix') { |
|
{ |
|
my $execpath="$perlvar{'lonDaemons'}/". |
|
"lcuseradd"; |
|
{ |
|
my $se = IO::File->new("|$execpath"); |
|
print $se "$uname\n"; |
|
print $se "$npass\n"; |
|
print $se "$npass\n"; |
|
} |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "unix:\n"; |
|
} |
|
print $client "ok\n"; |
|
} elsif ($umode eq 'none') { |
{ |
{ |
my $pf = IO::File->new(">$passfilename"); |
my $pf = IO::File->new(">$passfilename"); |
print $pf "none:\n"; |
print $pf "none:\n"; |
Line 577 sub make_new_child {
|
Line 642 sub make_new_child {
|
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
} |
} |
|
# -------------------------------------------------------------- changeuserauth |
|
} elsif ($userinput =~ /^changeuserauth/) { |
|
if ($wasenc==1) { |
|
my |
|
($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); |
|
chomp($npass); |
|
$npass=&unescape($npass); |
|
my $proname=propath($udom,$uname); |
|
my $passfilename="$proname/passwd"; |
|
if ($udom ne $perlvar{'lonDefDomain'}) { |
|
print $client "not_right_domain\n"; |
|
} else { |
|
if ($umode eq 'krb4') { |
|
{ |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "krb4:$npass\n"; |
|
} |
|
print $client "ok\n"; |
|
} elsif ($umode eq 'internal') { |
|
my $salt=time; |
|
$salt=substr($salt,6,2); |
|
my $ncpass=crypt($npass,$salt); |
|
{ |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "internal:$ncpass\n"; |
|
} |
|
print $client "ok\n"; |
|
} elsif ($umode eq 'localauth') { |
|
{ |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "localauth:$npass\n"; |
|
} |
|
print $client "ok\n"; |
|
} elsif ($umode eq 'unix') { |
|
{ |
|
my $execpath="$perlvar{'lonDaemons'}/". |
|
"lcuseradd"; |
|
{ |
|
my $se = IO::File->new("|$execpath"); |
|
print $se "$uname\n"; |
|
print $se "$npass\n"; |
|
print $se "$npass\n"; |
|
} |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "unix:\n"; |
|
} |
|
print $client "ok\n"; |
|
} elsif ($umode eq 'none') { |
|
{ |
|
my $pf = IO::File->new(">$passfilename"); |
|
print $pf "none:\n"; |
|
} |
|
print $client "ok\n"; |
|
} else { |
|
print $client "auth_mode_error\n"; |
|
} |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
# ------------------------------------------------------------------------ home |
# ------------------------------------------------------------------------ home |
} elsif ($userinput =~ /^home/) { |
} elsif ($userinput =~ /^home/) { |
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
Line 668 sub make_new_child {
|
Line 793 sub make_new_child {
|
print $sh "$clientip:$now\n"; |
print $sh "$clientip:$now\n"; |
} |
} |
} |
} |
|
unless ($fname=~/\.meta$/) { |
|
unlink("$fname.meta.$hostid{$clientip}"); |
|
} |
$fname=~s/\/home\/httpd\/html\/res/raw/; |
$fname=~s/\/home\/httpd\/html\/res/raw/; |
$fname="http://$thisserver/".$fname; |
$fname="http://$thisserver/".$fname; |
print $client "$fname\n"; |
print $client "$fname\n"; |
Line 703 sub make_new_child {
|
Line 831 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
{ |
unless ($namespace=~/^nohist\_/) { |
my $hfh; |
my $hfh; |
if ( |
if ( |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
Line 828 sub make_new_child {
|
Line 956 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
{ |
unless ($namespace=~/^nohist\_/) { |
my $hfh; |
my $hfh; |
if ( |
if ( |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
Line 899 sub make_new_child {
|
Line 1027 sub make_new_child {
|
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $now=time; |
my $now=time; |
{ |
unless ($namespace=~/^nohist\_/) { |
my $hfh; |
my $hfh; |
if ( |
if ( |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
$hfh=IO::File->new(">>$proname/$namespace.hist") |
Line 965 sub make_new_child {
|
Line 1093 sub make_new_child {
|
} |
} |
# ------------------------------------------------------------------- querysend |
# ------------------------------------------------------------------- querysend |
} elsif ($userinput =~ /^querysend/) { |
} elsif ($userinput =~ /^querysend/) { |
my ($cmd,$query,$custom)=split(/:/,$userinput); |
my ($cmd,$query, |
|
$custom,$customshow)=split(/:/,$userinput); |
$query=~s/\n*$//g; |
$query=~s/\n*$//g; |
print $client sqlreply("$hostid{$clientip}\&$query"). |
unless ($custom or $customshow) { |
"\n"; |
print $client "". |
|
sqlreply("$hostid{$clientip}\&$query")."\n"; |
|
} |
|
else { |
|
print $client "". |
|
sqlreply("$hostid{$clientip}\&$query". |
|
"\&$custom"."\&$customshow")."\n"; |
|
} |
# ------------------------------------------------------------------ queryreply |
# ------------------------------------------------------------------ queryreply |
} elsif ($userinput =~ /^queryreply/) { |
} elsif ($userinput =~ /^queryreply/) { |
my ($cmd,$id,$reply)=split(/:/,$userinput); |
my ($cmd,$id,$reply)=split(/:/,$userinput); |
my $store; |
my $store; |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
if ($store=IO::File->new(">$execdir/tmp/$id")) { |
if ($store=IO::File->new(">$execdir/tmp/$id")) { |
|
$reply=~s/\&/\n/g; |
print $store $reply; |
print $store $reply; |
close $store; |
close $store; |
|
my $store2=IO::File->new(">$execdir/tmp/$id.end"); |
|
print $store2 "done\n"; |
|
close $store2; |
print $client "ok\n"; |
print $client "ok\n"; |
} |
} |
else { |
else { |
Line 1070 sub make_new_child {
|
Line 1210 sub make_new_child {
|
my $ulsout=''; |
my $ulsout=''; |
my $ulsfn; |
my $ulsfn; |
if (-e $ulsdir) { |
if (-e $ulsdir) { |
while ($ulsfn=<$ulsdir/*>) { |
if (opendir(LSDIR,$ulsdir)) { |
my @ulsstats=stat($ulsfn); |
while ($ulsfn=readdir(LSDIR)) { |
|
my @ulsstats=stat($ulsdir.'/'.$ulsfn); |
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; |
$ulsout.=$ulsfn.'&'.join('&',@ulsstats).':'; |
} |
} |
|
closedir(LSDIR); |
|
} |
} else { |
} else { |
$ulsout='no_such_dir'; |
$ulsout='no_such_dir'; |
} |
} |
if ($ulsout eq '') { $ulsout='empty'; } |
if ($ulsout eq '') { $ulsout='empty'; } |
print $client "$ulsout\n"; |
print $client "$ulsout\n"; |
|
# ------------------------------------------------------------------ Hanging up |
|
} elsif (($userinput =~ /^exit/) || |
|
($userinput =~ /^init/)) { |
|
&logthis( |
|
"Client $clientip ($hostid{$clientip}) hanging up: $userinput"); |
|
print $client "bye\n"; |
|
last; |
# ------------------------------------------------------------- unknown command |
# ------------------------------------------------------------- unknown command |
} else { |
} else { |
# unknown command |
# unknown command |