--- loncom/lond 2002/08/22 20:00:00 1.91 +++ loncom/lond 2003/03/14 21:25:44 1.103.2.1 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.91 2002/08/22 20:00:00 albertel Exp $ +# $Id: lond,v 1.103.2.1 2003/03/14 21:25:44 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -83,6 +83,68 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; +# +# The array below are password error strings." +# +my $lastpwderror = 13; # Largest error number from lcpasswd. +my @passwderrors = ("ok", + "lcpasswd must be run as user 'www'", + "lcpasswd got incorrect number of arguments", + "lcpasswd did not get the right nubmer of input text lines", + "lcpasswd too many simultaneous pwd changes in progress", + "lcpasswd User does not exist.", + "lcpasswd Incorrect current passwd", + "lcpasswd Unable to su to root.", + "lcpasswd Cannot set new passwd.", + "lcpasswd Username has invalid characters", + "lcpasswd Invalid characters in password", + "11", "12", + "lcpasswd Password mismatch"); + + +# The array below are lcuseradd error strings.: + +my $lastadderror = 13; +my @adderrors = ("ok", + "User ID mismatch, lcuseradd must run as user www", + "lcuseradd Incorrect number of command line parameters must be 3", + "lcuseradd Incorrect number of stdinput lines, must be 3", + "lcuseradd Too many other simultaneous pwd changes in progress", + "lcuseradd User does not exist", + "lcuseradd Unabel to mak ewww member of users's group", + "lcuseradd Unable to su to root", + "lcuseradd Unable to set password", + "lcuseradd Usrname has invbalid charcters", + "lcuseradd Password has an invalid character", + "lcuseradd User already exists", + "lcuseradd Could not add user.", + "lcuseradd Password mismatch"); + + +# +# Convert an error return code from lcpasswd to a string value. +# +sub lcpasswdstrerror { + my $ErrorCode = shift; + if(($ErrorCode < 0) || ($ErrorCode > $lastpwderror)) { + return "lcpasswd Unrecognized error return value ".$ErrorCode; + } else { + return $passwderrors[$ErrorCode]; + } +} + +# +# Convert an error return code from lcuseradd to a string value: +# +sub lcuseraddstrerror { + my $ErrorCode = shift; + if(($ErrorCode < 0) || ($ErrorCode > $lastadderror)) { + return "lcuseradd - Unrecognized error code: ".$ErrorCode; + } else { + return $adderrors[$ErrorCode]; + } +} + # grabs exception and records it to log before exiting sub catchexception { my ($error)=@_; @@ -107,9 +169,8 @@ $SIG{'QUIT'}=\&catchexception; $SIG{__DIE__}=\&catchexception; # ---------------------------------- 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'); +&status("Read loncapa.conf and loncapa_apache.conf"); +my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf'); my %perlvar=%{$perlvarref}; undef $perlvarref; @@ -211,17 +272,25 @@ sub checkchildren { } } sleep 5; + $SIG{ALRM} = sub { die "timeout" }; + $SIG{__DIE__} = 'DEFAULT'; foreach (sort keys %children) { unless (-e "$docdir/lon-status/londchld/$_.txt") { + eval { + alarm(300); &logthis('Child '.$_.' did not respond'); kill 9 => $_; $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}"; $subj="LON: $perlvar{'lonHostID'} killed lond process $_"; my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`; $execdir=$perlvar{'lonDaemons'}; - $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_` + $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`; + alarm(0); + } } } + $SIG{ALRM} = 'DEFAULT'; + $SIG{__DIE__} = \&cathcexception; } # --------------------------------------------------------------------- Logging @@ -279,6 +348,7 @@ sub status { my $now=time; my $local=localtime($now); $status=$local.': '.$what; + $0='lond: '.$what.' '.$local; } # -------------------------------------------------------- Escape Special Chars @@ -501,6 +571,8 @@ sub make_new_child { # ============================================================================= # do something with the connection # ----------------------------------------------------------------------------- + $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of + # connection liveness. # see if we know client and check for spoof IP by challenge my $caller=getpeername($client); my ($port,$iaddr)=unpack_sockaddr_in($caller); @@ -632,15 +704,22 @@ sub make_new_child { my ($howpwd,$contentpwd)=split(/:/,$realpasswd); my $pwdcorrect=0; if ($howpwd eq 'internal') { + &Debug("Internal auth"); $pwdcorrect= (crypt($upass,$contentpwd) eq $contentpwd); } elsif ($howpwd eq 'unix') { - $contentpwd=(getpwnam($uname))[1]; - my $pwauth_path="/usr/local/sbin/pwauth"; - unless ($contentpwd eq 'x') { - $pwdcorrect= - (crypt($upass,$contentpwd) eq $contentpwd); - } + &Debug("Unix auth"); + if((getpwnam($uname))[1] eq "") { #no such user! + $pwdcorrect = 0; + } else { + $contentpwd=(getpwnam($uname))[1]; + 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"; @@ -648,6 +727,7 @@ sub make_new_child { close PWAUTH; $pwdcorrect=!$?; } + } } elsif ($howpwd eq 'krb4') { $null=pack("C",0); unless ($upass=~/$null/) { @@ -660,7 +740,6 @@ sub make_new_child { $null=pack("C",0); unless ($upass=~/$null/) { my $krbclient=&Authen::Krb5::parse_name($uname.'@'.$contentpwd); - &logthis("Realm ".$krbclient->realm); my $krbservice="krbtgt/".$contentpwd."\@".$contentpwd; my $krbserver=&Authen::Krb5::parse_name($krbservice); my $credentials=&Authen::Krb5::cc_default(); @@ -668,10 +747,10 @@ sub make_new_child { my $krbreturn = &Authen::Krb5::get_in_tkt_with_password( $krbclient,$krbserver,$upass,$credentials); - unless ($krbreturn) { - &logthis("Krb5 Error: ". - &Authen::Krb5::error()); - } +# unless ($krbreturn) { +# &logthis("Krb5 Error: ". +# &Authen::Krb5::error()); +# } $pwdcorrect = ($krbreturn == 1); } else { $pwdcorrect=0; } } elsif ($howpwd eq 'localauth') { @@ -697,7 +776,7 @@ sub make_new_child { chomp($npass); $upass=&unescape($upass); $npass=&unescape($npass); - &logthis("Trying to change password for $uname"); + &Debug("Trying to change password for $uname"); my $proname=propath($udom,$uname); my $passfilename="$proname/passwd"; if (-e $passfilename) { @@ -707,6 +786,7 @@ sub make_new_child { chomp($realpasswd); my ($howpwd,$contentpwd)=split(/:/,$realpasswd); if ($howpwd eq 'internal') { + &Debug("internal auth"); if (crypt($upass,$contentpwd) eq $contentpwd) { my $salt=time; $salt=substr($salt,6,2); @@ -723,6 +803,7 @@ sub make_new_child { # one way or another. # First: Make sure the current password is # correct + &Debug("auth is unix"); $contentpwd=(getpwnam($uname))[1]; my $pwdcorrect = "0"; my $pwauth_path="/usr/local/sbin/pwauth"; @@ -734,16 +815,20 @@ sub make_new_child { die "Cannot invoke authentication"; print PWAUTH "$uname\n$upass\n"; close PWAUTH; - $pwdcorrect=!$?; + &Debug("exited pwauth with $? ($uname,$upass) "); + $pwdcorrect=($? == 0); } if ($pwdcorrect) { my $execdir=$perlvar{'lonDaemons'}; - my $pf = IO::File->new("|$execdir/lcpasswd"); + &Debug("Opening lcpasswd pipeline"); + my $pf = IO::File->new("|$execdir/lcpasswd > /home/www/lcpasswd.log"); print $pf "$uname\n$npass\n$npass\n"; close $pf; - my $result = ($?>0 ? 'pwchange_failure' + my $err = $?; + my $result = ($err>0 ? 'pwchange_failure' : 'ok'); - &logthis("Result of password change for $uname: $result"); + &logthis("Result of password change for $uname: ". + &lcpasswdstrerror($?)); print $client "$result\n"; } else { print $client "non_authorized\n"; @@ -789,7 +874,7 @@ sub make_new_child { } } unless ($fperror) { - my $result=&make_passwd_file($umode,$npass, + my $result=&make_passwd_file($uname, $umode,$npass, $passfilename); print $client $result; } else { @@ -815,7 +900,8 @@ sub make_new_child { if ($udom ne $perlvar{'lonDefDomain'}) { print $client "not_right_domain\n"; } else { - &make_passwd_file($umode,$npass,$passfilename); + my $result=&make_passwd_file($uname, $umode,$npass, + $passfilename); print $client $result; } } else { @@ -938,6 +1024,10 @@ sub make_new_child { # ------------------------------------------------------------------- subscribe } elsif ($userinput =~ /^sub/) { print $client &subscribe($userinput,$clientip); +# ------------------------------------------------------------- current version + } elsif ($userinput =~ /^currentversion/) { + my ($cmd,$fname)=split(/:/,$userinput); + print $client ¤tversion($fname)."\n"; # ------------------------------------------------------------------------- log } elsif ($userinput =~ /^log/) { my ($cmd,$udom,$uname,$what)=split(/:/,$userinput); @@ -1147,21 +1237,25 @@ sub make_new_child { } else { $regexp='.'; } - my $proname=propath($udom,$uname); my $qresult=''; - if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { + my $proname=propath($udom,$uname); + if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { study($regexp); - foreach $key (keys %hash) { - my $unescapeKey = &unescape($key); - if (eval('$unescapeKey=~/$regexp/')) { - $qresult.="$key=$hash{$key}&"; - } + while (($key,$value) = each(%hash)) { + if ($regexp eq '.') { + $qresult.=$key.'='.$value.'&'; + } else { + my $unescapeKey = &unescape($key); + if (eval('$unescapeKey=~/$regexp/')) { + $qresult.="$key=$value&"; + } + } } - if (untie(%hash)) { - $qresult=~s/\&$//; - print $client "$qresult\n"; + if (untie(%hash)) { + chop($qresult); + print $client "$qresult\n"; } else { - print $client "error:$!\n"; + print $client "error:$!\n"; } } else { print $client "error:$!\n"; @@ -1566,12 +1660,68 @@ sub unsub { return $result; } +sub currentversion { + my $fname=shift; + my $version=-1; + my $ulsdir=''; + if ($fname=~/^(.+)\/[^\/]+$/) { + $ulsdir=$1; + } + $fname=~s/\.\d+\.(\w+(?:\.meta)*)$/\.$1/; + $fname=~s/\.(\w+(?:\.meta)*)$/\.\(\\d\+\)\.$1\$/; + + if (-e $fname) { $version=1; } + if (-e $ulsdir) { + if(-d $ulsdir) { + if (opendir(LSDIR,$ulsdir)) { + while ($ulsfn=readdir(LSDIR)) { +# see if this is a regular file (ignore links produced earlier) + my $thisfile=$ulsdir.'/'.$ulsfn; + unless (-l $thisfile) { + if ($thisfile=~/$fname/) { + if ($1>$version) { $version=$1; } + } + } + } + closedir(LSDIR); + $version++; + } + } + } + return $version; +} + +sub thisversion { + my $fname=shift; + my $version=-1; + if ($fname=~/\.(\d+)\.\w+(?:\.meta)*$/) { + $version=$1; + } + return $version; +} + sub subscribe { my ($userinput,$clientip)=@_; my $result; my ($cmd,$fname)=split(/:/,$userinput); my $ownership=&ishome($fname); if ($ownership eq 'owner') { +# explitly asking for the current version? + unless (-e $fname) { + my $currentversion=¤tversion($fname); + if (&thisversion($fname)==$currentversion) { + if ($fname=~/^(.+)\.\d+\.(\w+(?:\.meta)*)$/) { + my $root=$1; + my $extension=$2; + symlink($root.'.'.$extension, + $root.'.'.$currentversion.'.'.$extension); + unless ($extension=~/\.meta$/) { + symlink($root.'.'.$extension.'.meta', + $root.'.'.$currentversion.'.'.$extension.'.meta'); + } + } + } + } if (-e $fname) { if (-d $fname) { $result="directory\n"; @@ -1599,7 +1749,7 @@ sub subscribe { } sub make_passwd_file { - my ($umode,$npass,$passfilename)=@_; + my ($uname, $umode,$npass,$passfilename)=@_; my $result="ok\n"; if ($umode eq 'krb4' or $umode eq 'krb5') { { @@ -1625,11 +1775,16 @@ sub make_passwd_file { my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; { &Debug("Executing external: ".$execpath); - my $se = IO::File->new("|$execpath"); + &Debug("user = ".$uname.", Password =". $npass); + my $se = IO::File->new("|$execpath > /home/www/lcuseradd.log"); print $se "$uname\n"; print $se "$npass\n"; print $se "$npass\n"; } + my $useraddok = $?; + if($useraddok > 0) { + &logthis("Failed lcuseradd: ".&lcuseraddstrerror($useraddok)); + } my $pf = IO::File->new(">$passfilename"); print $pf "unix:\n"; }