version 1.71, 2002/02/12 23:08:27
|
version 1.76, 2002/03/28 04:27:42
|
Line 51
|
Line 51
|
# 02/05 Guy Albertelli |
# 02/05 Guy Albertelli |
# 02/07 Scott Harrison |
# 02/07 Scott Harrison |
# 02/12 Gerd Kortemeyer |
# 02/12 Gerd Kortemeyer |
|
# 02/19 Matthew Hall |
|
# 02/25 Gerd Kortemeyer |
### |
### |
|
|
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
# based on "Perl Cookbook" ISBN 1-56592-243-3 |
Line 158 $server = IO::Socket::INET->new(LocalPor
|
Line 160 $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 299 sub reconlonc {
|
Line 301 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 340 sub reply {
|
Line 342 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 529 sub make_new_child {
|
Line 532 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 552 sub make_new_child {
|
Line 556 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 670 sub make_new_child {
|
Line 675 sub make_new_child {
|
chomp($npass); |
chomp($npass); |
$upass=&unescape($upass); |
$upass=&unescape($upass); |
$npass=&unescape($npass); |
$npass=&unescape($npass); |
my $proname=propath($udom,$uname); |
&logthis("Trying to change password for $uname"); |
|
my $proname=propath($udom,$uname); |
my $passfilename="$proname/passwd"; |
my $passfilename="$proname/passwd"; |
if (-e $passfilename) { |
if (-e $passfilename) { |
my $realpasswd; |
my $realpasswd; |
Line 685 sub make_new_child {
|
Line 691 sub make_new_child {
|
my $ncpass=crypt($npass,$salt); |
my $ncpass=crypt($npass,$salt); |
{ my $pf = IO::File->new(">$passfilename"); |
{ my $pf = IO::File->new(">$passfilename"); |
print $pf "internal:$ncpass\n"; } |
print $pf "internal:$ncpass\n"; } |
|
&logthis("Result of password change for $uname: pwchange_success"); |
print $client "ok\n"; |
print $client "ok\n"; |
} else { |
} else { |
print $client "non_authorized\n"; |
print $client "non_authorized\n"; |
} |
} |
} else { |
} elsif ($howpwd eq 'unix') { |
|
# Unix means we have to access /etc/password |
|
# one way or another. |
|
# First: Make sure the current password is |
|
# correct |
|
$contentpwd=(getpwnam($uname))[1]; |
|
my $pwdcorrect = "0"; |
|
my $pwauth_path="/usr/local/sbin/pwauth"; |
|
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=!$?; |
|
} |
|
if ($pwdcorrect) { |
|
my $execdir=$perlvar{'lonDaemons'}; |
|
my $pf = IO::File->new("|$execdir/lcpasswd"); |
|
print $pf "$uname\n$npass\n$npass\n"; |
|
close $pf; |
|
my $result = ($?>0 ? 'pwchange_failure' |
|
: 'ok'); |
|
&logthis("Result of password change for $uname: $result"); |
|
print $client "$result\n"; |
|
} else { |
|
print $client "non_authorized\n"; |
|
} |
|
} else { |
print $client "auth_mode_error\n"; |
print $client "auth_mode_error\n"; |
} |
} |
} else { |
} else { |
Line 1387 sub make_new_child {
|
Line 1424 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 |
|
|
$client->close(); |
|
$server->close(); |
$server->close(); |
|
|
# this exit is VERY important, otherwise the child will become |
# this exit is VERY important, otherwise the child will become |
Line 1413 lond - "LON Daemon" Server (port "LOND"
|
Line 1450 lond - "LON Daemon" Server (port "LOND"
|
|
|
=head1 SYNOPSIS |
=head1 SYNOPSIS |
|
|
Should only be run as user=www. Invoked by loncron. |
Usage: B<lond> |
|
|
|
Should only be run as user=www. This is a command-line script which |
|
is invoked by B<loncron>. There is no expectation that a typical user |
|
will manually start B<lond> from the command-line. (In other words, |
|
DO NOT START B<lond> YOURSELF.) |
|
|
=head1 DESCRIPTION |
=head1 DESCRIPTION |
|
|
|
There are two characteristics associated with the running of B<lond>, |
|
PROCESS MANAGEMENT (starting, stopping, handling child processes) |
|
and SERVER-SIDE ACTIVITIES (password authentication, user creation, |
|
subscriptions, etc). These are described in two large |
|
sections below. |
|
|
|
B<PROCESS MANAGEMENT> |
|
|
Preforker - server who forks first. Runs as a daemon. HUPs. |
Preforker - server who forks first. Runs as a daemon. HUPs. |
Uses IDEA encryption |
Uses IDEA encryption |
|
|
=head1 README |
B<lond> forks off children processes that correspond to the other servers |
|
in the network. Management of these processes can be done at the |
|
parent process level or the child process level. |
|
|
|
B<logs/lond.log> is the location of log messages. |
|
|
|
The process management is now explained in terms of linux shell commands, |
|
subroutines internal to this code, and signal assignments: |
|
|
|
=over 4 |
|
|
|
=item * |
|
|
|
PID is stored in B<logs/lond.pid> |
|
|
|
This is the process id number of the parent B<lond> process. |
|
|
|
=item * |
|
|
|
SIGTERM and SIGINT |
|
|
|
Parent signal assignment: |
|
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
|
|
|
Child signal assignment: |
|
$SIG{INT} = 'DEFAULT'; (and SIGTERM is DEFAULT also) |
|
(The child dies and a SIGALRM is sent to parent, awaking parent from slumber |
|
to restart a new child.) |
|
|
|
Command-line invocations: |
|
B<kill> B<-s> SIGTERM I<PID> |
|
B<kill> B<-s> SIGINT I<PID> |
|
|
|
Subroutine B<HUNTSMAN>: |
|
This is only invoked for the B<lond> parent I<PID>. |
|
This kills all the children, and then the parent. |
|
The B<lonc.pid> file is cleared. |
|
|
|
=item * |
|
|
|
SIGHUP |
|
|
|
Current bug: |
|
This signal can only be processed the first time |
|
on the parent process. Subsequent SIGHUP signals |
|
have no effect. |
|
|
|
Parent signal assignment: |
|
$SIG{HUP} = \&HUPSMAN; |
|
|
|
Child signal assignment: |
|
none (nothing happens) |
|
|
|
Command-line invocations: |
|
B<kill> B<-s> SIGHUP I<PID> |
|
|
|
Subroutine B<HUPSMAN>: |
|
This is only invoked for the B<lond> parent I<PID>, |
|
This kills all the children, and then the parent. |
|
The B<lond.pid> file is cleared. |
|
|
|
=item * |
|
|
|
SIGUSR1 |
|
|
|
Parent signal assignment: |
|
$SIG{USR1} = \&USRMAN; |
|
|
|
Child signal assignment: |
|
$SIG{USR1}= \&logstatus; |
|
|
|
Command-line invocations: |
|
B<kill> B<-s> SIGUSR1 I<PID> |
|
|
|
Subroutine B<USRMAN>: |
|
When invoked for the B<lond> parent I<PID>, |
|
SIGUSR1 is sent to all the children, and the status of |
|
each connection is logged. |
|
|
|
=item * |
|
|
|
SIGCHLD |
|
|
|
Parent signal assignment: |
|
$SIG{CHLD} = \&REAPER; |
|
|
|
Child signal assignment: |
|
none |
|
|
|
Command-line invocations: |
|
B<kill> B<-s> SIGCHLD I<PID> |
|
|
|
Subroutine B<REAPER>: |
|
This is only invoked for the B<lond> parent I<PID>. |
|
Information pertaining to the child is removed. |
|
The socket port is cleaned up. |
|
|
|
=back |
|
|
|
B<SERVER-SIDE ACTIVITIES> |
|
|
|
Server-side information can be accepted in an encrypted or non-encrypted |
|
method. |
|
|
|
=over 4 |
|
|
|
=item ping |
|
|
|
Query a client in the hosts.tab table; "Are you there?" |
|
|
|
=item pong |
|
|
|
Respond to a ping query. |
|
|
|
=item ekey |
|
|
|
Read in encrypted key, make cipher. Respond with a buildkey. |
|
|
|
=item load |
|
|
Not yet written. |
Respond with CPU load based on a computation upon /proc/loadavg. |
|
|
|
=item currentauth |
|
|
|
Reply with current authentication information (only over an |
|
encrypted channel). |
|
|
|
=item auth |
|
|
|
Only over an encrypted channel, reply as to whether a user's |
|
authentication information can be validated. |
|
|
|
=item passwd |
|
|
|
Allow for a password to be set. |
|
|
|
=item makeuser |
|
|
|
Make a user. |
|
|
|
=item passwd |
|
|
|
Allow for authentication mechanism and password to be changed. |
|
|
|
=item home |
|
|
|
Respond to a question "are you the home for a given user?" |
|
|
|
=item update |
|
|
|
Update contents of a subscribed resource. |
|
|
|
=item unsubscribe |
|
|
|
The server is unsubscribing from a resource. |
|
|
|
=item subscribe |
|
|
|
The server is subscribing to a resource. |
|
|
|
=item log |
|
|
|
Place in B<logs/lond.log> |
|
|
|
=item put |
|
|
|
stores hash in namespace |
|
|
|
=item rolesput |
|
|
|
put a role into a user's environment |
|
|
|
=item get |
|
|
|
returns hash with keys from array |
|
reference filled in from namespace |
|
|
|
=item eget |
|
|
|
returns hash with keys from array |
|
reference filled in from namesp (encrypts the return communication) |
|
|
|
=item rolesget |
|
|
|
get a role from a user's environment |
|
|
|
=item del |
|
|
|
deletes keys out of array from namespace |
|
|
|
=item keys |
|
|
|
returns namespace keys |
|
|
|
=item dump |
|
|
|
dumps the complete (or key matching regexp) namespace into a hash |
|
|
|
=item store |
|
|
|
stores hash permanently |
|
for this url; hashref needs to be given and should be a \%hashname; the |
|
remaining args aren't required and if they aren't passed or are '' they will |
|
be derived from the ENV |
|
|
|
=item restore |
|
|
|
returns a hash for a given url |
|
|
|
=item querysend |
|
|
|
Tells client about the lonsql process that has been launched in response |
|
to a sent query. |
|
|
|
=item queryreply |
|
|
|
Accept information from lonsql and make appropriate storage in temporary |
|
file space. |
|
|
|
=item idput |
|
|
|
Defines usernames as corresponding to IDs. (These "IDs" are unique identifiers |
|
for each student, defined perhaps by the institutional Registrar.) |
|
|
|
=item idget |
|
|
|
Returns usernames corresponding to IDs. (These "IDs" are unique identifiers |
|
for each student, defined perhaps by the institutional Registrar.) |
|
|
|
=item tmpput |
|
|
|
Accept and store information in temporary space. |
|
|
|
=item tmpget |
|
|
|
Send along temporarily stored information. |
|
|
|
=item ls |
|
|
|
List part of a user's directory. |
|
|
|
=item Hanging up (exit or init) |
|
|
|
What to do when a client tells the server that they (the client) |
|
are leaving the network. |
|
|
|
=item unknown command |
|
|
|
If B<lond> is sent an unknown command (not in the list above), |
|
it replys to the client "unknown_cmd". |
|
|
|
=item UNKNOWN CLIENT |
|
|
|
If the anti-spoofing algorithm cannot verify the client, |
|
the client is rejected (with a "refused" message sent |
|
to the client, and the connection is closed. |
|
|
|
=back |
|
|
=head1 PREREQUISITES |
=head1 PREREQUISITES |
|
|
Line 1447 linux
|
Line 1752 linux
|
Server/Process |
Server/Process |
|
|
=cut |
=cut |
|
|
|
|
|
|
|
|