--- loncom/lond 2002/03/03 19:49:00 1.74 +++ loncom/lond 2002/05/03 03:21:25 1.78 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.74 2002/03/03 19:49:00 harris41 Exp $ +# $Id: lond,v 1.78 2002/05/03 03:21:25 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -73,6 +73,8 @@ use Authen::Krb4; use lib '/home/httpd/lib/perl/'; use localauth; +my $DEBUG = 0; # Non zero to enable debug log entries. + my $status=''; my $lastlog=''; @@ -160,7 +162,7 @@ $server = IO::Socket::INET->new(LocalPor # 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 %children = (); # keys are current child process IDs $children = 0; # current number of children @@ -235,6 +237,13 @@ sub logthis { print $fh "$local ($$): $message\n"; } +# ------------------------- Conditional log if $DEBUG true. +sub Debug { + my $message = shift; + if($DEBUG) { + &logthis($message); + } +} # ------------------------------------------------------------------ Log status sub logstatus { @@ -301,10 +310,10 @@ sub reconlonc { if (kill 0 => $loncpid) { &logthis("lonc at pid $loncpid responding, sending USR1"); kill USR1 => $loncpid; - sleep 1; + sleep 5; if (-e "$peerfile") { return; } &logthis("$peerfile still not there, give it another try"); - sleep 5; + sleep 10; if (-e "$peerfile") { return; } &logthis( "WARNING: $peerfile still not there, giving up"); @@ -342,6 +351,7 @@ sub reply { if ($answer eq 'con_lost') { $answer=subreply("ping",$server); if ($answer ne $server) { + &logthis("sub reply: answer != server"); &reconlonc("$perlvar{'lonSockDir'}/$server"); } $answer=subreply($cmd,$server); @@ -531,6 +541,7 @@ sub make_new_child { } if ($clientok) { # ---------------- New known client connecting, could mean machine online again + &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}"); &logthis( "Established connection: $hostid{$clientip}"); @@ -554,8 +565,9 @@ sub make_new_child { } $userinput=substr($userinput,0,$cmdlength); $wasenc=1; - } } + } + # ------------------------------------------------------------- Normal commands # ------------------------------------------------------------------------ ping if ($userinput =~ /^ping/) { @@ -592,21 +604,13 @@ sub make_new_child { } 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"; - } + my $result = GetAuthType($udom, $user); + if($result eq "nouser") { + print $client "unknown_user\n"; + } + else { + print $client "$result\n" + } } else { print $client "refused\n"; } @@ -734,14 +738,19 @@ sub make_new_child { } # -------------------------------------------------------------------- makeuser } elsif ($userinput =~ /^makeuser/) { + Debug("Make user received"); my $oldumask=umask(0077); if ($wasenc==1) { my ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); + &Debug("cmd =".$cmd." $udom =".$udom. + " uname=".$uname); chomp($npass); $npass=&unescape($npass); my $proname=propath($udom,$uname); my $passfilename="$proname/passwd"; + &Debug("Password file created will be:". + $passfilename); if (-e $passfilename) { print $client "already_exists\n"; } elsif ($udom ne $perlvar{'lonDefDomain'}) { @@ -770,7 +779,8 @@ sub make_new_child { $salt=substr($salt,6,2); 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 $client "ok\n"; @@ -785,6 +795,8 @@ sub make_new_child { my $execpath="$perlvar{'lonDaemons'}/". "lcuseradd"; { + &Debug("Executing external: ". + $execpath); my $se = IO::File->new("|$execpath"); print $se "$uname\n"; print $se "$npass\n"; @@ -813,10 +825,13 @@ sub make_new_child { umask($oldumask); # -------------------------------------------------------------- changeuserauth } elsif ($userinput =~ /^changeuserauth/) { - if ($wasenc==1) { + &Debug("Changing authorization"); + if ($wasenc==1) { my ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); chomp($npass); + &Debug("cmd = ".$cmd." domain= ".$udom. + "uname =".$uname." umode= ".$umode); $npass=&unescape($npass); my $proname=propath($udom,$uname); my $passfilename="$proname/passwd"; @@ -1025,9 +1040,13 @@ sub make_new_child { } # -------------------------------------------------------------------- rolesput } elsif ($userinput =~ /^rolesput/) { + &Debug("rolesput"); if ($wasenc==1) { my ($cmd,$exedom,$exeuser,$udom,$uname,$what) =split(/:/,$userinput); + &Debug("cmd = ".$cmd." exedom= ".$exedom. + "user = ".$exeuser." udom=".$udom. + "what = ".$what); my $namespace='roles'; chomp($what); my $proname=propath($udom,$uname); @@ -1044,7 +1063,11 @@ sub make_new_child { if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) { foreach $pair (@pairs) { ($key,$value)=split(/=/,$pair); + &ManagePermissions($key, $udom, $uname, + &GetAuthType( $udom, + $uname)); $hash{$key}=$value; + } if (untie(%hash)) { print $client "ok\n"; @@ -1421,12 +1444,13 @@ sub make_new_child { $client->close(); &logthis("WARNING: " ."Rejected client $clientip, closing connection"); - } - &logthis("CRITICAL: " - ."Disconnect from $clientip ($hostid{$clientip})"); + } + } + # ============================================================================= - } - + + &logthis("CRITICAL: " + ."Disconnect from $clientip ($hostid{$clientip})"); # tidy up gracefully and finish $server->close(); @@ -1438,6 +1462,63 @@ 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) =head1 NAME