version 1.74, 2002/03/03 19:49:00
|
version 1.78, 2002/05/03 03:21:25
|
Line 73 use Authen::Krb4;
|
Line 73 use Authen::Krb4;
|
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use localauth; |
use localauth; |
|
|
|
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
my $status=''; |
my $status=''; |
my $lastlog=''; |
my $lastlog=''; |
|
|
Line 160 $server = IO::Socket::INET->new(LocalPor
|
Line 162 $server = IO::Socket::INET->new(LocalPor
|
|
|
# global variables |
# global variables |
|
|
$MAX_CLIENTS_PER_CHILD = 5; # number of clients each child should |
$MAX_CLIENTS_PER_CHILD = 50; # number of clients each child should |
# process |
# process |
%children = (); # keys are current child process IDs |
%children = (); # keys are current child process IDs |
$children = 0; # current number of children |
$children = 0; # current number of children |
Line 235 sub logthis {
|
Line 237 sub logthis {
|
print $fh "$local ($$): $message\n"; |
print $fh "$local ($$): $message\n"; |
} |
} |
|
|
|
# ------------------------- Conditional log if $DEBUG true. |
|
sub Debug { |
|
my $message = shift; |
|
if($DEBUG) { |
|
&logthis($message); |
|
} |
|
} |
# ------------------------------------------------------------------ Log status |
# ------------------------------------------------------------------ Log status |
|
|
sub logstatus { |
sub logstatus { |
Line 301 sub reconlonc {
|
Line 310 sub reconlonc {
|
if (kill 0 => $loncpid) { |
if (kill 0 => $loncpid) { |
&logthis("lonc at pid $loncpid responding, sending USR1"); |
&logthis("lonc at pid $loncpid responding, sending USR1"); |
kill USR1 => $loncpid; |
kill USR1 => $loncpid; |
sleep 1; |
sleep 5; |
if (-e "$peerfile") { return; } |
if (-e "$peerfile") { return; } |
&logthis("$peerfile still not there, give it another try"); |
&logthis("$peerfile still not there, give it another try"); |
sleep 5; |
sleep 10; |
if (-e "$peerfile") { return; } |
if (-e "$peerfile") { return; } |
&logthis( |
&logthis( |
"<font color=blue>WARNING: $peerfile still not there, giving up</font>"); |
"<font color=blue>WARNING: $peerfile still not there, giving up</font>"); |
Line 342 sub reply {
|
Line 351 sub reply {
|
if ($answer eq 'con_lost') { |
if ($answer eq 'con_lost') { |
$answer=subreply("ping",$server); |
$answer=subreply("ping",$server); |
if ($answer ne $server) { |
if ($answer ne $server) { |
|
&logthis("sub reply: answer != server"); |
&reconlonc("$perlvar{'lonSockDir'}/$server"); |
&reconlonc("$perlvar{'lonSockDir'}/$server"); |
} |
} |
$answer=subreply($cmd,$server); |
$answer=subreply($cmd,$server); |
Line 531 sub make_new_child {
|
Line 541 sub make_new_child {
|
} |
} |
if ($clientok) { |
if ($clientok) { |
# ---------------- New known client connecting, could mean machine online again |
# ---------------- New known client connecting, could mean machine online again |
|
|
&reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}"); |
&reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}"); |
&logthis( |
&logthis( |
"<font color=green>Established connection: $hostid{$clientip}</font>"); |
"<font color=green>Established connection: $hostid{$clientip}</font>"); |
Line 554 sub make_new_child {
|
Line 565 sub make_new_child {
|
} |
} |
$userinput=substr($userinput,0,$cmdlength); |
$userinput=substr($userinput,0,$cmdlength); |
$wasenc=1; |
$wasenc=1; |
} |
|
} |
} |
|
} |
|
|
# ------------------------------------------------------------- Normal commands |
# ------------------------------------------------------------- Normal commands |
# ------------------------------------------------------------------------ ping |
# ------------------------------------------------------------------------ ping |
if ($userinput =~ /^ping/) { |
if ($userinput =~ /^ping/) { |
Line 592 sub make_new_child {
|
Line 604 sub make_new_child {
|
} elsif ($userinput =~ /^currentauth/) { |
} elsif ($userinput =~ /^currentauth/) { |
if ($wasenc==1) { |
if ($wasenc==1) { |
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
my ($cmd,$udom,$uname)=split(/:/,$userinput); |
my $proname=propath($udom,$uname); |
my $result = GetAuthType($udom, $user); |
my $passfilename="$proname/passwd"; |
if($result eq "nouser") { |
if (-e $passfilename) { |
print $client "unknown_user\n"; |
my $pf = IO::File->new($passfilename); |
} |
my $realpasswd=<$pf>; |
else { |
chomp($realpasswd); |
print $client "$result\n" |
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 { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
} |
} |
Line 734 sub make_new_child {
|
Line 738 sub make_new_child {
|
} |
} |
# -------------------------------------------------------------------- makeuser |
# -------------------------------------------------------------------- makeuser |
} elsif ($userinput =~ /^makeuser/) { |
} elsif ($userinput =~ /^makeuser/) { |
|
Debug("Make user received"); |
my $oldumask=umask(0077); |
my $oldumask=umask(0077); |
if ($wasenc==1) { |
if ($wasenc==1) { |
my |
my |
($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); |
($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); |
|
&Debug("cmd =".$cmd." $udom =".$udom. |
|
" uname=".$uname); |
chomp($npass); |
chomp($npass); |
$npass=&unescape($npass); |
$npass=&unescape($npass); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $passfilename="$proname/passwd"; |
my $passfilename="$proname/passwd"; |
|
&Debug("Password file created will be:". |
|
$passfilename); |
if (-e $passfilename) { |
if (-e $passfilename) { |
print $client "already_exists\n"; |
print $client "already_exists\n"; |
} elsif ($udom ne $perlvar{'lonDefDomain'}) { |
} elsif ($udom ne $perlvar{'lonDefDomain'}) { |
Line 770 sub make_new_child {
|
Line 779 sub make_new_child {
|
$salt=substr($salt,6,2); |
$salt=substr($salt,6,2); |
my $ncpass=crypt($npass,$salt); |
my $ncpass=crypt($npass,$salt); |
{ |
{ |
my $pf = IO::File->new(">$passfilename"); |
&Debug("Creating internal auth"); |
|
my $pf = IO::File->new(">$passfilename"); |
print $pf "internal:$ncpass\n"; |
print $pf "internal:$ncpass\n"; |
} |
} |
print $client "ok\n"; |
print $client "ok\n"; |
Line 785 sub make_new_child {
|
Line 795 sub make_new_child {
|
my $execpath="$perlvar{'lonDaemons'}/". |
my $execpath="$perlvar{'lonDaemons'}/". |
"lcuseradd"; |
"lcuseradd"; |
{ |
{ |
|
&Debug("Executing external: ". |
|
$execpath); |
my $se = IO::File->new("|$execpath"); |
my $se = IO::File->new("|$execpath"); |
print $se "$uname\n"; |
print $se "$uname\n"; |
print $se "$npass\n"; |
print $se "$npass\n"; |
Line 813 sub make_new_child {
|
Line 825 sub make_new_child {
|
umask($oldumask); |
umask($oldumask); |
# -------------------------------------------------------------- changeuserauth |
# -------------------------------------------------------------- changeuserauth |
} elsif ($userinput =~ /^changeuserauth/) { |
} elsif ($userinput =~ /^changeuserauth/) { |
if ($wasenc==1) { |
&Debug("Changing authorization"); |
|
if ($wasenc==1) { |
my |
my |
($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); |
($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); |
chomp($npass); |
chomp($npass); |
|
&Debug("cmd = ".$cmd." domain= ".$udom. |
|
"uname =".$uname." umode= ".$umode); |
$npass=&unescape($npass); |
$npass=&unescape($npass); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
my $passfilename="$proname/passwd"; |
my $passfilename="$proname/passwd"; |
Line 1025 sub make_new_child {
|
Line 1040 sub make_new_child {
|
} |
} |
# -------------------------------------------------------------------- rolesput |
# -------------------------------------------------------------------- rolesput |
} elsif ($userinput =~ /^rolesput/) { |
} elsif ($userinput =~ /^rolesput/) { |
|
&Debug("rolesput"); |
if ($wasenc==1) { |
if ($wasenc==1) { |
my ($cmd,$exedom,$exeuser,$udom,$uname,$what) |
my ($cmd,$exedom,$exeuser,$udom,$uname,$what) |
=split(/:/,$userinput); |
=split(/:/,$userinput); |
|
&Debug("cmd = ".$cmd." exedom= ".$exedom. |
|
"user = ".$exeuser." udom=".$udom. |
|
"what = ".$what); |
my $namespace='roles'; |
my $namespace='roles'; |
chomp($what); |
chomp($what); |
my $proname=propath($udom,$uname); |
my $proname=propath($udom,$uname); |
Line 1044 sub make_new_child {
|
Line 1063 sub make_new_child {
|
if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { |
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); |
|
&ManagePermissions($key, $udom, $uname, |
|
&GetAuthType( $udom, |
|
$uname)); |
$hash{$key}=$value; |
$hash{$key}=$value; |
|
|
} |
} |
if (untie(%hash)) { |
if (untie(%hash)) { |
print $client "ok\n"; |
print $client "ok\n"; |
Line 1421 sub make_new_child {
|
Line 1444 sub make_new_child {
|
$client->close(); |
$client->close(); |
&logthis("<font color=blue>WARNING: " |
&logthis("<font color=blue>WARNING: " |
."Rejected client $clientip, closing connection</font>"); |
."Rejected client $clientip, closing connection</font>"); |
} |
} |
&logthis("<font color=red>CRITICAL: " |
} |
."Disconnect from $clientip ($hostid{$clientip})</font>"); |
|
# ============================================================================= |
# ============================================================================= |
} |
|
|
&logthis("<font color=red>CRITICAL: " |
|
."Disconnect from $clientip ($hostid{$clientip})</font>"); |
# tidy up gracefully and finish |
# tidy up gracefully and finish |
|
|
$server->close(); |
$server->close(); |
Line 1438 sub make_new_child {
|
Line 1462 sub make_new_child {
|
} |
} |
} |
} |
|
|
|
|
|
# |
|
# Checks to see if the input roleput request was to set |
|
# an author role. If so, invokes the lchtmldir script to set |
|
# up a correct public_html |
|
# Parameters: |
|
# request - The request sent to the rolesput subchunk. |
|
# We're looking for /domain/_au |
|
# domain - The domain in which the user is having roles doctored. |
|
# user - Name of the user for which the role is being put. |
|
# authtype - The authentication type associated with the user. |
|
# |
|
sub ManagePermissions |
|
{ |
|
my $request = shift; |
|
my $domain = shift; |
|
my $user = shift; |
|
my $authtype= shift; |
|
|
|
# See if the request is of the form /$domain/_au |
|
|
|
if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... |
|
my $execdir = $perlvar{'lonDaemons'}; |
|
my $userhome= "/home/$user" ; |
|
Debug("system $execdir/lchtmldir $userhome $system $authtype"); |
|
system("$execdir/lchtmldir $userhome $user $authtype"); |
|
} |
|
} |
|
# |
|
# GetAuthType - Determines the authorization type of a user in a domain. |
|
|
|
# Returns the authorization type or nouser if there is no such user. |
|
# |
|
sub GetAuthType |
|
{ |
|
my $domain = shift; |
|
my $user = shift; |
|
|
|
my $proname = &propath($domain, $user); |
|
my $passwdfile = "$proname/passwd"; |
|
if( -e $passwdfile ) { |
|
my $pf = IO::File->new($passwdfile); |
|
my $realpassword = <$pf>; |
|
chomp($realpassword); |
|
my ($authtype, $contentpwd) = split(/:/, $realpassword); |
|
my $availinfo = ''; |
|
if($authtype eq 'krb4') { |
|
$availinfo = $contentpwd; |
|
} |
|
return "$authtype:$availinfo"; |
|
} |
|
else { |
|
return "nouser"; |
|
} |
|
|
|
} |
|
|
# ----------------------------------- POD (plain old documentation, CPAN style) |
# ----------------------------------- POD (plain old documentation, CPAN style) |
|
|
=head1 NAME |
=head1 NAME |