--- loncom/lond 2002/03/03 19:49:00 1.74 +++ loncom/lond 2002/05/17 14:03:04 1.81 @@ -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.81 2002/05/17 14:03:04 matthew Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,6 +53,7 @@ # 02/12 Gerd Kortemeyer # 02/19 Matthew Hall # 02/25 Gerd Kortemeyer +# 05/11 Scott Harrison ### # based on "Perl Cookbook" ISBN 1-56592-243-3 @@ -61,6 +62,9 @@ # HUPs # uses IDEA encryption +use lib '/home/httpd/lib/perl/'; +use LONCAPA::Configuration; + use IO::Socket; use IO::File; use Apache::File; @@ -73,6 +77,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=''; @@ -99,18 +105,12 @@ sub timeout { $SIG{'QUIT'}=\&catchexception; $SIG{__DIE__}=\&catchexception; -# ------------------------------------ Read httpd access.conf and get variables - -open (CONFIG,"/etc/httpd/conf/access.conf") || die "Can't read access.conf"; - -while ($configline=) { - if ($configline =~ /PerlSetVar/) { - my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); - chomp($varvalue); - $perlvar{$varname}=$varvalue; - } -} -close(CONFIG); +# ---------------------------------- Read loncapa_apache.conf and loncapa.conf +&status("Read loncapa_apache.conf and loncapa.conf"); +my $perlvarref=LONCAPA::Configuration::read_conf('loncapa_apache.conf', + 'loncapa.conf'); +my %perlvar=%{$perlvarref}; +undef $perlvarref; # ----------------------------- Make sure this process is running from user=www my $wwwid=getpwnam('www'); @@ -160,7 +160,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 +235,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 +308,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 +349,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 +539,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}"); @@ -538,6 +547,7 @@ sub make_new_child { # ------------------------------------------------------------ Process requests while (my $userinput=<$client>) { chomp($userinput); + Debug("Request = $userinput\n"); &status('Processing '.$hostid{$clientip}.': '.$userinput); my $wasenc=0; alarm(120); @@ -554,8 +564,9 @@ sub make_new_child { } $userinput=substr($userinput,0,$cmdlength); $wasenc=1; - } } + } + # ------------------------------------------------------------- Normal commands # ------------------------------------------------------------------------ ping if ($userinput =~ /^ping/) { @@ -592,21 +603,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, $uname); + if($result eq "nouser") { + print $client "unknown_user\n"; + } + else { + print $client "$result\n" + } } else { print $client "refused\n"; } @@ -734,14 +737,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 +778,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 +794,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 +824,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 +1039,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 +1062,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 +1443,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 +1461,68 @@ 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; + + Debug("GetAuthType( $domain, $user ) \n"); + my $proname = &propath($domain, $user); + my $passwdfile = "$proname/passwd"; + if( -e $passwdfile ) { + my $pf = IO::File->new($passwdfile); + my $realpassword = <$pf>; + chomp($realpassword); + Debug("Password info = $realpassword\n"); + my ($authtype, $contentpwd) = split(/:/, $realpassword); + Debug("Authtype = $authtype, content = $contentpwd\n"); + my $availinfo = ''; + if($authtype eq 'krb4') { + $availinfo = $contentpwd; + } + + return "$authtype:$availinfo"; + } + else { + Debug("Returning nouser"); + return "nouser"; + } + +} + # ----------------------------------- POD (plain old documentation, CPAN style) =head1 NAME