--- loncom/lond 2002/08/09 10:05:00 1.87 +++ loncom/lond 2002/09/16 13:26:21 1.97 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.87 2002/08/09 10:05:00 www Exp $ +# $Id: lond,v 1.97 2002/09/16 13:26:21 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -74,6 +74,7 @@ use Crypt::IDEA; use LWP::UserAgent(); use GDBM_File; use Authen::Krb4; +use Authen::Krb5; use lib '/home/httpd/lib/perl/'; use localauth; @@ -82,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)=@_; @@ -106,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; @@ -488,7 +550,10 @@ sub make_new_child { or die "Can't unblock SIGINT for fork: $!\n"; $tmpsnum=0; - +#---------------------------------------------------- kerberos 5 initialization + &Authen::Krb5::init_context(); + &Authen::Krb5::init_ets(); + # handle connections until we've reached $MAX_CLIENTS_PER_CHILD for ($i=0; $i < $MAX_CLIENTS_PER_CHILD; $i++) { &status('Idle, waiting for connection'); @@ -497,6 +562,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); @@ -652,6 +719,23 @@ sub make_new_child { $contentpwd,'krbtgt',$contentpwd,1, $upass) == 0); } else { $pwdcorrect=0; } + } elsif ($howpwd eq 'krb5') { + $null=pack("C",0); + unless ($upass=~/$null/) { + my $krbclient=&Authen::Krb5::parse_name($uname.'@'.$contentpwd); + my $krbservice="krbtgt/".$contentpwd."\@".$contentpwd; + my $krbserver=&Authen::Krb5::parse_name($krbservice); + my $credentials=&Authen::Krb5::cc_default(); + $credentials->initialize($krbclient); + my $krbreturn = + &Authen::Krb5::get_in_tkt_with_password( + $krbclient,$krbserver,$upass,$credentials); +# unless ($krbreturn) { +# &logthis("Krb5 Error: ". +# &Authen::Krb5::error()); +# } + $pwdcorrect = ($krbreturn == 1); + } else { $pwdcorrect=0; } } elsif ($howpwd eq 'localauth') { $pwdcorrect=&localauth::localauth($uname,$upass, $contentpwd); @@ -712,16 +796,18 @@ sub make_new_child { die "Cannot invoke authentication"; print PWAUTH "$uname\n$upass\n"; close PWAUTH; - $pwdcorrect=!$?; + my $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' + 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"; @@ -737,7 +823,7 @@ sub make_new_child { } # -------------------------------------------------------------------- makeuser } elsif ($userinput =~ /^makeuser/) { - Debug("Make user received"); + &Debug("Make user received"); my $oldumask=umask(0077); if ($wasenc==1) { my @@ -767,53 +853,9 @@ sub make_new_child { } } unless ($fperror) { - if ($umode eq 'krb4') { - { - my $pf = IO::File->new(">$passfilename"); - print $pf "krb4:$npass\n"; - } - print $client "ok\n"; - } elsif ($umode eq 'internal') { - my $salt=time; - $salt=substr($salt,6,2); - my $ncpass=crypt($npass,$salt); - { - &Debug("Creating internal auth"); - my $pf = IO::File->new(">$passfilename"); - print $pf "internal:$ncpass\n"; - } - print $client "ok\n"; - } elsif ($umode eq 'localauth') { - { - my $pf = IO::File->new(">$passfilename"); - print $pf "localauth:$npass\n"; - } - print $client "ok\n"; - } elsif ($umode eq 'unix') { - { - my $execpath="$perlvar{'lonDaemons'}/". - "lcuseradd"; - { - &Debug("Executing external: ". - $execpath); - my $se = IO::File->new("|$execpath"); - print $se "$uname\n"; - print $se "$npass\n"; - print $se "$npass\n"; - } - my $pf = IO::File->new(">$passfilename"); - print $pf "unix:\n"; - } - print $client "ok\n"; - } elsif ($umode eq 'none') { - { - my $pf = IO::File->new(">$passfilename"); - print $pf "none:\n"; - } - print $client "ok\n"; - } else { - print $client "auth_mode_error\n"; - } + my $result=&make_passwd_file($umode,$npass, + $passfilename); + print $client $result; } else { print $client "$fperror\n"; } @@ -827,60 +869,19 @@ sub make_new_child { &Debug("Changing authorization"); if ($wasenc==1) { my - ($cmd,$udom,$uname,$umode,$npass)=split(/:/,$userinput); + ($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 $proname=&propath($udom,$uname); my $passfilename="$proname/passwd"; if ($udom ne $perlvar{'lonDefDomain'}) { print $client "not_right_domain\n"; } else { - if ($umode eq 'krb4') { - { - my $pf = IO::File->new(">$passfilename"); - print $pf "krb4:$npass\n"; - } - print $client "ok\n"; - } elsif ($umode eq 'internal') { - my $salt=time; - $salt=substr($salt,6,2); - my $ncpass=crypt($npass,$salt); - { - my $pf = IO::File->new(">$passfilename"); - print $pf "internal:$ncpass\n"; - } - print $client "ok\n"; - } elsif ($umode eq 'localauth') { - { - my $pf = IO::File->new(">$passfilename"); - print $pf "localauth:$npass\n"; - } - print $client "ok\n"; - } elsif ($umode eq 'unix') { - { - my $execpath="$perlvar{'lonDaemons'}/". - "lcuseradd"; - { - my $se = IO::File->new("|$execpath"); - print $se "$uname\n"; - print $se "$npass\n"; - print $se "$npass\n"; - } - my $pf = IO::File->new(">$passfilename"); - print $pf "unix:\n"; - } - print $client "ok\n"; - } elsif ($umode eq 'none') { - { - my $pf = IO::File->new(">$passfilename"); - print $pf "none:\n"; - } - print $client "ok\n"; - } else { - print $client "auth_mode_error\n"; - } + my $result=&make_passwd_file($umode,$npass, + $passfilename); + print $client $result; } } else { print $client "refused\n"; @@ -952,7 +953,7 @@ sub make_new_child { my ($cmd,$fname)=split(/:/,$userinput); my ($udom,$uname,$ufile)=split(/\//,$fname); my $udir=propath($udom,$uname).'/userfiles'; - unless (-e $udir) { mkdir($udir); } + unless (-e $udir) { mkdir($udir,0770); } if (-e $udir) { $ufile=~s/^[\.\~]+//; $ufile=~s/\///g; @@ -1214,10 +1215,12 @@ sub make_new_child { my $proname=propath($udom,$uname); my $qresult=''; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER,0640)) { + study($regexp); foreach $key (keys %hash) { - if (eval('$key=~/$regexp/')) { + my $unescapeKey = &unescape($key); + if (eval('$unescapeKey=~/$regexp/')) { $qresult.="$key=$hash{$key}&"; - } + } } if (untie(%hash)) { $qresult=~s/\&$//; @@ -1537,7 +1540,7 @@ sub GetAuthType my ($authtype, $contentpwd) = split(/:/, $realpassword); Debug("Authtype = $authtype, content = $contentpwd\n"); my $availinfo = ''; - if($authtype eq 'krb4') { + if($authtype eq 'krb4' or $authtype eq 'krb5') { $availinfo = $contentpwd; } @@ -1573,44 +1576,42 @@ sub getchat { my %hash; my $proname=&propath($cdom,$cname); my @entries=(); - if - (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",&GDBM_READER(),0640)) - { - @entries=map { $_.':'.$hash{$_} } sort keys %hash; - untie %hash; + if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db", + &GDBM_READER(),0640)) { + @entries=map { $_.':'.$hash{$_} } sort keys %hash; + untie %hash; } return @entries; } sub chatadd { - my ($cdom,$cname,$newchat)=@_; - my %hash; - my $proname=&propath($cdom,$cname); - my @entries=(); - if - (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",&GDBM_WRCREAT(),0640)) - { - @entries=map { $_.':'.$hash{$_} } sort keys %hash; - my $time=time; - my ($lastid)=($entries[$#entries]=~/^(\w+)\:/); - my ($thentime,$idnum)=split(/\_/,$lastid); - my $newid=$time.'_000000'; - if ($thentime==$time) { - $idnum=~s/^0+//; - $idnum++; - $idnum=substr('000000'.$idnum,-6,6); - $newid=$time.'_'.$idnum; - } - $hash{$newid}=$newchat; - my $expired=$time-3600; - foreach (keys %hash) { - my ($thistime)=($_=~/(\d+)\_/); - if ($thistime<$expired) { - undef $hash{$_}; - } + my ($cdom,$cname,$newchat)=@_; + my %hash; + my $proname=&propath($cdom,$cname); + my @entries=(); + if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db", + &GDBM_WRCREAT(),0640)) { + @entries=map { $_.':'.$hash{$_} } sort keys %hash; + my $time=time; + my ($lastid)=($entries[$#entries]=~/^(\w+)\:/); + my ($thentime,$idnum)=split(/\_/,$lastid); + my $newid=$time.'_000000'; + if ($thentime==$time) { + $idnum=~s/^0+//; + $idnum++; + $idnum=substr('000000'.$idnum,-6,6); + $newid=$time.'_'.$idnum; + } + $hash{$newid}=$newchat; + my $expired=$time-3600; + foreach (keys %hash) { + my ($thistime)=($_=~/(\d+)\_/); + if ($thistime<$expired) { + delete $hash{$_}; + } + } + untie %hash; } - untie %hash; - } } sub unsub { @@ -1661,6 +1662,57 @@ sub subscribe { } return $result; } + +sub make_passwd_file { + my ($umode,$npass,$passfilename)=@_; + my $result="ok\n"; + if ($umode eq 'krb4' or $umode eq 'krb5') { + { + my $pf = IO::File->new(">$passfilename"); + print $pf "$umode:$npass\n"; + } + } elsif ($umode eq 'internal') { + my $salt=time; + $salt=substr($salt,6,2); + my $ncpass=crypt($npass,$salt); + { + &Debug("Creating internal auth"); + my $pf = IO::File->new(">$passfilename"); + print $pf "internal:$ncpass\n"; + } + } elsif ($umode eq 'localauth') { + { + my $pf = IO::File->new(">$passfilename"); + print $pf "localauth:$npass\n"; + } + } elsif ($umode eq 'unix') { + { + my $execpath="$perlvar{'lonDaemons'}/"."lcuseradd"; + { + &Debug("Executing external: ".$execpath); + my $se = IO::File->new("|$execpath"); + 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"; + } + } elsif ($umode eq 'none') { + { + my $pf = IO::File->new(">$passfilename"); + print $pf "none:\n"; + } + } else { + $result="auth_mode_error\n"; + } + return $result; +} + # ----------------------------------- POD (plain old documentation, CPAN style) =head1 NAME @@ -1959,6 +2011,7 @@ Crypt::IDEA LWP::UserAgent() GDBM_File Authen::Krb4 +Authen::Krb5 =head1 COREQUISITES