#!/usr/bin/perl
# -w has some problems with stdargs.ph...
#
# This is a Perl version of the poppassd (change pop password daemon)
# for use with Eudora clients. This version REQUIRES the newusers command
# which is part of most Linux distributions. if you don't have Linux,
# but can find and build/install newusers, set the $NOT_LINUX_OK variable.
#
#
# Based on prior work by
# Andrew Macpherson <A.Macpherson@bnr.co.uk>
#        to support the eudora password change protocol
# Changed fairly radically by Vicki Brown <vlb@cfcl.com>
#
# Entry for /etc/services:
#       poppassd      106/tcp
# And for /etc/inetd.conf:
#       poppassd      stream  tcp     nowait  pop  /path/to/poppassd poppassd
#
#
# Steve Dorner's description of the simple protocol:
#
#  The server's responses should be like an FTP server's responses;
#  1xx for in progress, 2xx for success, 3xx for more information
#  needed, 4xx for temporary failure, and 5xx for permanent failure.
#  Putting it all together, here's a sample conversation:
#
#   S: 200 machine_name popassd v1.4 hello, who are you?\r\n
#   E: user yourloginname\r\n
#   S: 200 your password please.
#   E: pass yourcurrentpassword\r\n
#   S: 200 your new password please.\r\n
#   E: newpass yournewpassword\r\n
#   200 Password changed, thank-you.\r\n
#   E: quit\r\n
#   S: 200 Bye-bye\r\n
#   S: <closes connection>
#   E: <closes connection>
#
#
# N.B. This will run on Linux and other systems that have the newusers
#      command. The newusers command IS A REQUIREMENT because that's how
#      we set the new password! If you don't have it, look for it and
#      try to build it. It's in the shadow utiliites package on at least
#      RedHat and Debian Linux distributions.
#
#   NEWUSERS(8)                                           NEWUSERS(8)
#
#   NAME
#          newusers - update and create new users in batch
#
#   SYNOPSIS
#          newusers [ new_users ]
#
#   DESCRIPTION
#          newusers  reads a file of user name and cleartext password
#          pairs and uses this  information  to  update  a  group  of
#          existing  users  or  to create new users.  Each line is in
#          the  same  format  as  the  standard  password  file  (see
#          passwd(5)) with the following exceptions.
#
#          pw_passwd This field will be encrypted and used as the new
#                    value of the encrpted password.
use strict;

use vars qw {$ERR $RCSID $PopPassd $HOST $NOT_LINUX_OK};

$RCSID = '$Id$';

$PopPassd = 'poppassd';

$HOST = `hostname`;

$NOT_LINUX_OK = 0;

unless (($^O eq 'linux') || ($NOT_LINUX_OK)) {
    print "500 Error!! This is a $^O system.\n";
    print "Important! This program requires the newusers command " .
          "most often found on Linux.\n";
    print "You must install newusers and then set $NOT_LINUX_OK to true.\n";
    exit(1);
}

use Sys::Syslog;
&openlog($PopPassd,"pid,cons,nowait", "auth");



print "200 $HOST POP password service hello, who are you?\r\n" ;

my $newcrypt;
my $curcrypt;
my $user;
my $pass;
my $newpass;
my $result;

$| = 1;
LOOP: while(<>) {
    chomp();
    my ($action, $arg, $extra) = split;

    ($action =~ m/^USER$/i) && do {
        $user = $arg ;
        print "200 Hello $user, your password please?\r\n" ;
        next LOOP;
    };

    ($action =~ m/^PASS$/i) && do {
        $pass = $arg ;
        unless ($user) {
            print "400 I need to know who you are first\r\n" ;
            next LOOP;
        }
        $curcrypt = ValidUser($user, $pass);
        unless ($curcrypt) {
            last LOOP;
        }
        print "200 Thank you $user; your new password?\r\n" ;
        &syslog('info', "POP user $user validated");
        next LOOP;
    };

    ($action =~ m/^NEWPASS$/i) && do {
        $newpass = $arg;
        if ($user eq '') {
            print "400 Who are you? You must provide USER and PASS first\r\n" ;
            next LOOP;
        }
        if ($curcrypt eq '') {
            print "401 You must provide your current password first\r\n";
            next LOOP;
        }
        if (crypt($newpass, $curcrypt) eq $curcrypt) {
            print "402 Password unchanged\r\n" ;
            next LOOP;
        }
        $newcrypt = crypt($newpass, substr($curcrypt,1,2));
        # run newusers here to put the new password into the passwd file
        # print "echo \"${user}:${newpass}:::::\" | newusers\n";
        $result = `echo \"${user}:${newpass}:::::\" | newusers 2>&1`;
        unless ($? == 0) { # Unix commands exit 0 on success...
            chomp $result;
            print "500 Sorry, update failed [$result]\r\n" ;
        } else {
            # The final interaction appears in a Eudora dialog
            # with an OK button
            print "200 Password Changed (Please remember it!)\r\n";
        }
        last LOOP;
    };

    ($action =~ m/^STATUS$/i) && do {
        print "200 " . ($user eq '' ? "no user" : "user $user") .
                 ($curcrypt eq '' ? ' not' : '') . ' authenticated' .
                 "\r\n";
        next LOOP;
    };

    ($action =~ m/^VERSION$/i) && do {
        print "200 $PopPassd $RCSID\r\n" ;
        next LOOP;
    };

    ($action =~ m/^QUIT$/i) && do {
        print "200 $HOST, See you next time\r\n" ;
        last LOOP;
    };

    ($action =~ m/^HELP$/i) && do {
        print "200 Supported actions:" .
                 " USER PASS NEWPASS HELP QUIT STATUS VERSION" .
                 (($user eq 'pop' && $curcrypt ne '')
                 ? " NEWUSER SETPASS" : "") .
                 "\r\n";
        last LOOP;
    };

    ($action =~ m/^NEWUSER$/i) && do {
        unless ($user eq 'pop') {
            print "500 Sorry; only pop admin can issue NEWUSER command\r\n";
            last LOOP;
        }
        if ($curcrypt ne '') {
            if ($arg ne '' && $extra ne '') {
                NewUser($arg, $extra) ;
            } else {
                print "400 Newuser user pass\r\n" ;
            }
        }
        next LOOP;
    };

    ($action =~ m/^SETPASS$/i) && do {
        unless ($user eq 'pop') {
            print "500 Sorry; only pop admin can issue SETPASS command\r\n";
            last LOOP;
        }

        if ($curcrypt ne '' && $arg ne '' && $extra ne '') {
            $newcrypt = crypt($extra, substr($curcrypt,1,2));
            # newusers
            # print "echo \"${user}:${newpass}:::::\" | newusers\n";
            $result = `echo \"${user}:${newpass}:::::\" | newusers 2>&1`;
            unless ($? == 0) { # Unix commands exit 0 on success...
                chomp $result;
                print "500 Sorry, update failed [$result]\n" ;
            } else {
                print "200 Password Changed (Please remember it!)\r\n";
            }
        }
        last LOOP;
    };

    { # default
        print "400 I don't understand '$action' try help\r\n" ;
    }
}
&closelog();
exit 0;

sub ValidUser {
    my($user, $pass) = @_ ;

    my ($pw_name, $pw_passwd, $pw_uid, $pw_gid, $pw_quota,
     $pw_comment, $pw_gcos, $pw_dir, $pw_shell) = getpwnam("$user") ;

    unless ($pw_name) {
        &syslog('notice', "POP user $user does not exist\n");
        print "500 Sorry; Invalid current password or invalid user $user\r\n" ;
        return;
    }

    return($pw_passwd) if (crypt($pass, $pw_passwd) eq $pw_passwd);
    # else
    &syslog('notice', "invalid current password given\n");
    print "500 Sorry; Invalid current password or invalid user $user\r\n" ;
    return;
}

sub NewUser {
    my($user, $pass) = @_ ;

    my ($pw_name, $pw_passwd, $pw_uid, $pw_gid, $pw_quota,
     $pw_comment, $pw_gcos, $pw_dir, $pw_shell) = getpwnam("$user") ;

    if ($pw_name) {
        &syslog('notice', "POP user $user already exists\n");
        print "500 $user exists\r\n" ;
        return ;
    }

    # newusers
    print "200 $user added\r\n" ;
}
__END__