#!/usr/local/bin/perl

# schpd.pl - Socket CHange Password Daemon
# modified: aperrin 7/19/98

require "getopts.pl";
use Socket;

&Getopts('dp:a:s:h');
if ($opt_h) {
	print "Usage: $0 [-d (debug)] [-p port] [-a AlertLevel] [-s ShutdownLevel] [-h (help)]\n";
	exit 0;
}
$debug = $opt_d;
$alert = 1;
$alert = $opt_a if $opt_a;
$shutdown = 10;
$shutdown = $opt_s if $opt_s;
$port = getservbyname('schp', 'tcp') || do {$port = 75};
$port = $opt_p if $opt_p;
$ops = ""; #put e-mail address of root or admin here
$okshell = "/bin/posh"; #shell indicating it's okay to give access to mail-only machine.
	#probably not useful for other sites.
$tmpfile = "/tmp/$$.pwf";
$pwfile = "/etc/shadow";
$passfile = "/etc/passwd";
$smbfile = ""; #put location of your smbpasswd file (not binary) here
$sockaddr = 'S n a4 x8';
$termreq = 0;
$SIG{'TERM'} = 'SigTerm';
$SIG{'INT'} = 'SigTerm';
$allowpath = "/etc";

sub SigTerm {
    local($sig) = @_;
    if ($working) {
	print STDERR "Working on $user, cacheing SIG$sig.\n";
	$termreq = 1;
	return;
    }
    else {
	print STDERR "Caught a SIG$sig - going down.\n";
	close(NS) || print STDERR "NS not open...\n";
	exit 0;
    }
}

sub Refuse {
    local($pri,$msg)=@_;
    print NS "-ERR $msg\. $0 Out\n";
    close(NS);
    $iad=join('.',@inetaddr);
    print STDERR "$0: $msg\n from $iad\n";
    if ($pri >= $alert) {
	open(MAILOUT, "| /usr/ucb/mail -s \'$0 Alert\' $ops");
	print MAILOUT "ALERT! $0 received the following request:\n";
	print MAILOUT "$inline\n";
	print MAILOUT "Error: $msg\n";
        $iad=join('.',@inetaddr);	
        print MAILOUT "Internet address: $iad\n";
	print MAILOUT localtime;
	close(MAILOUT);
	if ($pri >= $shutdown) {
	    die "Stopped $0 because $msg\n";
	}
    }
}

sub Accept {
    local ($format) = @_;
    local ($filename,$error,$smb);
    if ($format =~ /^smb$/) {
	$smb = 1;
	$filename = $smbfile;
    }
    else {
	$smb = 0;
	$filename = $pwfile;
    }
    open(PWF, "<$filename") || do {
	$error = "PWF: Error opening $filename for read";
	return $error;
    };
    flock(PWF, 2);
    open(TMPF, ">$tmpfile") || do {
	$error = "File error TMPF: $!";
	return $error;
    };
    flock(TMPF, 2);
    
    while (<PWF>) {
	($luser,$rest)=split(/:/,$_);
	if ($luser eq $user) {
	    $now=time;
	    if ($smb) {
		$lct=sprintf("%lx",$now);
		$lct =~ tr/a-z/A-Z/;
		($junk, $junk, $junk, $junk, $lreal,$lhdir,$lshell) = split (/:/,$_);
		$userline="$user:$uid:$lmhash:$nthash:$lreal:$lhdir:$lshell\n";
	    }
	    else {
		$lct=$now/(60*60*24);
		$userline="$user:$pwc:$lct\:\:\:\:\:\:\n";
	}
	    if ($debug) {print "line: $userline\n";}
	}
	else {
	    $userline=$_;
	}
	print TMPF $userline;
    }
    
    close PWF;
    close TMPF;
    flock(TMPF, 8);
    flock(PWF,8);
    unlink $filename || do {
	$error= "File error PWF: $!";
	return $error;
    };
    $mverr = `mv $tmpfile $filename`;
    if ($mverr) {
        $error= "File error TMPF: $mverr";
	return $error;
    }

    return 0;
}

sub OutRange {
    if (($inetaddr[0]==127) && ($inetaddr[1]==0) && ($inetaddr[2]==0) && ($inetaddr[3]==1)) {
	$hostout = 0;
    }
    elsif (-f "$allowpath/schpd.allow") {
	if ($debug) {print "Doing schpd.allow\n";}
	open (ALLOW, "$allowpath/schpd.allow");
	$hostout = 1;	
	while (<ALLOW>) {
	    chop;
	    if ($debug) {print "Doing schpd.allow: $_\n";}
	    if ($_ =~ /^\#/) {
		next;
	    }
	    ($oct0, $oct1, $oct2, $oct3) = split(/\./,$_);
            if ($debug) {print "schpd.allow: $oct0.$oct1.$oct2.$oct3 vs $inetaddr[0].$inetaddr[1].$inetaddr[2].$inetaddr[3]\n";}
	    if ((($oct0 =~ /^\*/) || ($oct0 == $inetaddr[0])) &&
		(($oct1 =~ /^\*/) || ($oct1 == $inetaddr[1])) &&
		(($oct2 =~ /^\*/) || ($oct2 == $inetaddr[2])) &&
		(($oct3 =~ /^\*/) || ($oct3 == $inetaddr[3]))) {
                if ($debug) {print "BINGO!\n";}
		$hostout = 0;
		last;
	    }
	}
	close ALLOW;
    }
    elsif (-f "$allowpath/schpd.deny") {
	if ($debug) {print "Doing schpd.deny\n";}
	open (DENY, "$allowpath/schpd.deny"); 
	$hostout = 0;
	while (<DENY>) {
	    chop;
	    if ($_ =~ /^\#/) {
		next;
	    }
	    ($oct0, $oct1, $oct2, $oct3) = split(/\./,$_);
	    if ($debug) {print "schpd.deny: $oct0.$oct1.$oct2.$oct3 vs $inetaddr[0].$inetaddr[1].$inetaddr[2].$inetaddr[3]\n";}
	    if ((($oct0 =~ /^\*/) || ($oct0 == $inetaddr[0])) &&
		(($oct1 =~ /^\*/) || ($oct1 == $inetaddr[1])) &&
		(($oct2 =~ /^\*/) || ($oct2 == $inetaddr[2])) &&
		(($oct3 =~ /^\*/) || ($oct3 == $inetaddr[3]))) {
                if ($debug) {print "BINGO!\n";}
		$hostout = 1;
		last;
	    }
	}
	close DENY;
    }
    else {
	$hostout = 0;
    }
    if ($debug) {
	if ($hostout) {
	    print "OutRange Returning True\n";
	}
	else {
	    print "OutRange Returning False\n";
	}
    }
    return $hostout;
}

sub &Update {
    @rlist = split(' ',`ypmatch demogmailonly netgroup`);
    $rloc = "/etc"
    foreach $rhost (@rlist) {
	if ($debug) {print "Doing rdists for $rhost\n";}
	system("rdist -c $passfile $rhost:$loc/passwd");
	system("rdist -c $pwfile $rhost:$loc/shadow");
    }
}

# Begin Main Program Body
($name, $aliases, $proto) = getprotobyname('tcp');
if ($debug) {print "Binding to port $port\n";}
$this = pack($sockaddr, &AF_INET, $port, "\0\0\0\0");

select(NS); $| = 1; select(STDOUT);

socket(S, &AF_INET, &SOCK_STREAM, $proto) || die "socket: $!";
$linger=pack("II",0,0);
setsockopt(S, &SOL_SOCKET, &SO_LINGER, $linger);
setsockopt(S, &SOL_SOCKET, &SO_KEEPALIVE, 1);
setsockopt(S, &SOL_SOCKET, &SO_REUSEADDR, 1);
bind(S,$this) || die "bind: $!";
listen(S,5) || die "connect: $!";

select(S); $| = 1; select(STDOUT);

$con = 0;
print "Listening for connection 1....";
if ($debug) {
	print "(Port=$port)\n";
}
else {
	print "\n";
}
for(;;) {
    $working = 0;
    if ($termreq) {
	SigTerm ("TERM");
    }
    if ($con > 1) {
	print "Listening for connection $con....";
	if ($debug) {
		print "(Port=$port)\n";
	}
	else {
		print "\n";
	}
    }
    ($addr = accept(NS,S)) || die $!;

    $con++;
    $working = 1;
    print "accept ok\n";

    ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
    @inetaddr = unpack('C4',$inetaddr);
    $from=gethostbyaddr($inetaddr, &AF_INET);
    print "$con: $af $port @inetaddr $from\n";
    
    if (&OutRange) {
	&Refuse (0, "schp not allowed from host $from");
	next;
    }

    print NS "+OK $0 Go ahead $from\n";
    $inline = (<NS>);
    chop($inline);
    if ($debug) {print "\<NS: $inline\n";}
    $user="";
    $uid="";
    $pwc="";
    $next="";
    if ($inline =~ /^QUIT|^quit/) {
        &Refuse (0, "Client requested disconnect");
        next;
    }
    if ($inline =~ /^HELP|^help/) {
	print NS "+OKH Spewing possible result codes\n";
	print NS "+OK0 No Changes requested\n";
	print NS "+OK1 Changed 2 passwords for (user)\n";
	print NS "+OK2 Changed SMB password for (user)\n";
	print NS "+OK3 Changed PWF password for (user)\n";
	print NS "+XSM Changed SMB password, PWF returned (error)\n";
	print NS "+XPW Changed PWF password, SMB returned (error)\n";
	print NS "-ERR (error message)\n";
	close NS;
	next;
    }

    ($junk,$user,$uid,$pwc,$lmhash,$nthash,$junk2,$next) = split(/:/, $inline);
    if($debug) {print "user: $user uid: $uid pwc: $pwc lmhash: $lmhash nthash: $nthash next: $next\n";}
    if ($next) {
	&Refuse (1, "Too many parameters");
	next;
    }
    
    if (($user eq "") or ($uid eq "")) {
	&Refuse (1, "Too few parameters");
	next;
    }
    
    if (($user eq "root") || ($uid == 0)) {
	&Refuse (10, "Attempt to change root password");
	next;
    }
    
    if ((length($lmhash) == 32) && (length($nthash) == 32)) {
	$chgsmb = 1;
    }
    else {
	$chgsmb = 0;
    }

    open(PASSWD, "<$passfile");
    while (<PASSWD>) {
	($puser, $ppwd, $puid, $pgid, $prealname, $phdir, $psh) = split(/:/,$_,7);
	if ($puser eq $user) {
	    last;
	}
    }
    close(PASSWD);
    
    if ($puser ne $user) {
	&Refuse (1, "No such user $user");
	next;
    }
    if ($puid != $uid) {
	&Refuse (1, "UID Mismatch");
	next;
    }
    
    if (($okshell) && ($psh !=~ $okshell)) {
	&Refuse (0, "Not $okshell shell");
	next;
    }

    if ($chgsmb && $pwc) {
	$chgboth = 1;
    }

    $smbok=$pwfok=1;
    if ($chgsmb) {
	$smberr = &Accept ('smb');
	if ($smberr) {
	    $smbok = 0;
	}
    }
    if ($pwc) {
	$pwerr = &Accept ('pwd');
	if ($pwerr) {
	    $pwfok = 0;
	}
    }

    if ($chgboth) {
	$bothok = $smbok * $pwfok;
	if ($bothok) {
	    $out = "+OK1 Changed 2 passwords for $user";
	}
	elsif ($smbok) {
	    $out = "+XSM Changed SMB password, PWF returned $pwerr";
	}
	elsif ($pwfok) {
	    $out = "+XPW Changed PWF password, SMB returned $smberr";
	}
	else {
	    $out = "-ERR PWF $pwerr SMB $smberr";
	}
    }
    elsif ($chgsmb) {
	if ($smbok) {
	    $out = "+OK2 Changed SMB password for $user";
	}
	else {
	    $out = "-ERR $smberr";
	}
    }
    elsif ($pwc) {
	if ($pwfok) {
	    $out = "+OK3 Changed PWF password for $user";
	}
	else {
	    $out = "-ERR $pwerr";
	}
    }
    else {
	$out = "+OK0 No changes requested";
    }
    print NS "$out\n";
    close NS;
}