#!/usr/bin/perl
#
# NOTE: Install Perl5 and reference #!/usr/local/bin/perl if you have an older
# version of FreeBSD
#
# This software is intended for distribution under the same terms and spirit
# as FreeBSD.
#
# This script was originally authored by Dan Howard <dannyman@dannyland.org>
# for EnterAct, LLC, 1998. (http://www.enteract.com/)
#
use Fcntl ':flock';
#use Getopt::Std;

# Global, user-customizeable configs
my $pw_path = '/usr/sbin/pw';
my $pw_conf_path = '/etc/pw.conf';
my $sendmail_path = '/usr/sbin/sendmail';
my $welcome_message_path = '/etc/adduser.message';
my $logfile = '/var/log/enteruser.log';
my $organization = '';
my $domain = `/bin/hostname`;
#my $lockfile = '/var/run/enteruser.LOCK';

### Forward declarations ###
# Main functions
sub enteruser;
sub queueuser;
# Queueuser helpers
sub queueadd;
sub queuelist;
sub queuedel;
sub queuedo;
# Common helpers
sub get_user_data;
sub print_user_data;
sub add_user;
# UI
sub get_fullname;
sub get_password;
sub get_shell;
sub get_username;
#sub get_billing_id;
#sub get_group;
#sub get_referral;
# Generic helpers
sub append_file;

### START PROGRAM ###
if( $< != 0 ) {
	print "You must be root to run $0!\n";
	exit -1;
}

# Here's an example of how you could use GetOpt to extend functionality, but I
# never was too keen on this example.  One possibility is to set various
# defaults for a queueuser operation, or change the path for the welcome
# message.
#
# One possibility that has excited me on occasion has been the idea of setting
# input through the command-line, which could ease the lives of advanced users
# somewhat, but not enough that I've bothered to try.
#
# getopts('c');
# # -c is for curt, meaning no welcome message
# if( $opt_c ) {
# 	print "Will not send welcome message.\n";
# 	$welcome_message_path = '';
# }

if( $0 =~ /queueuser/ ) {
	&queueuser();
}
else {
	&enteruser();
}
###  END PROGRAM  ###

sub enteruser {
	my %newuser;

	my $y_or_n;
	
	%newuser = &get_user_data;
	print "\nVerify User Information\n";
	print "-----------------------\n";
	&print_user_data(%newuser);
	print "\nIs this okay? (Y/n) ";
	$y_or_n = <>;
	if( $y_or_n !~ /^n/i ) {
		&add_user(%newuser);
	}
}

sub queueuser {
	my @userqueue;
	my $choice;

while(1) {
	my $yn;

	print<<__MENU;

   Please Select Operation
   -----------------------
   [A]dd a user to the queue
   [L]ist users in the queue
   [D]elete user from the queue
   [P]rocess users in queue
   [Q]uit this program
__MENU
		print "What would you like to do? ";
		$choice = <>;
		if( $choice =~ /^a/i ) {
			LAME: { # the LAME kludge
				push @userqueue, &queueadd;
			}
			print "Add another? (Y/n) ";
			$yn = <>;
			goto LAME unless $yn =~ /^n/i;
		}
		elsif( $choice =~ /^l/i ) {
			&queuelist(@userqueue);
		}
		elsif( $choice =~ /^d/i ) {
			@userqueue = &queuedel(@userqueue);
		}
		elsif( $choice =~ /^p/i ) {
			@userqueue = &queuedo(@userqueue);
		}
		elsif( $choice =~ /^q/i ) {
			if( @userqueue ) {
				print "There are unprocessed users in your queue.\n";
				print "If you quit now, they will be lost!\n";
				print "Do you really want to quit? (y/N) ";
				$choice = <>;
				if( $choice =~ /^y/i ) {
					exit(0);
				}
			}
			else {
				exit(0);
			}
		}
		else {
			print "\nHuh?\n";
		}
	}
}
	
# Pretty much just enteruser, only we stay within queueuser
sub queueadd {
	my %newuser;

	my $y_or_n;
	
	%newuser = &get_user_data;
	print "\nVerify User Information\n";
	print "-----------------------\n";
	&print_user_data(%newuser);
	print "\nIs this okay? (Y/n) ";
	$y_or_n = <>;
	if( $y_or_n !~ /^n/i ) {
		return {%newuser};
	}
}

sub queuelist {
	my @userlist = @_;
	my $user;

	for $user (@userlist) {
		printf("%8s %16s %10s %4s\n", 
			$user->{username}, $user->{password},
			$user->{fullname}, $user->{shell});
	}
}

sub queuedel {
	my @userlist = @_;
	my $goner;
	my ($i, $confirm);

	&queuelist(@userlist);
	print "Which user do you wish to remove? ";
	$goner = <>;
	chomp $goner;
	for $i ( 0 .. $#userlist ) {
		if( $userlist[$i]->{username} eq $goner ) {
			print "\nConfirm User Deletion\n";
			print "---------------------\n";
			&print_user_data(%{$userlist[$i]});
			print "Remove this user from your queue? (Y/n) ";
			$confirm = <>;
			if( $confirm !~ /^n/i ) {
				splice(@userlist,$i,1);
				print "User $goner removed from queue.\n";
			}
			else {
				print "Okay then, we'll leave this one alone.\n";
			}
		}
	}
	return @userlist;
}

sub queuedo {
	my @userlist = @_;
	my $i;

	for $user (@userlist) {
		if( $user->{username} ) {
			print "\n>>> ADDING USER ", $user->{username}, ":\n";
			&add_user(%{$user});
		}
	}
	return;
}

# Self-explanatory ...
sub print_user_data {
	my %user = @_;
print<<__EOUD;
   username: $user{username}
   fullname: $user{fullname}
   password: $user{password}
      shell: $user{shell}
__EOUD
}

# Get each piece of user data, calling appropriate get_ function until it
# returns 1
sub get_user_data {
	my %user;
#	while( $user{group} eq '' ) { $user{group} = &get_group; }
	while( $user{username} eq '' ) { $user{username} = &get_username; }
	while( $user{fullname} eq '' ) { $user{fullname} = &get_fullname; }
	while( $user{password} eq '' ) { $user{password} = &get_password; }
	while( $user{shell} eq '' ) { $user{shell} = &get_shell; }
	return %user;
}

# Here's an example of a custom function used by EnterAct.  Here we ask
# additionally for a 'Billing ID' to be stored in the log
# sub get_billing_id {
# 	print "                   Billing ID: ";
# 	my $billing_id = <>;
# 	chomp $billing_id;
# 	if( $billing_id =~ /^\d+$/ ) {
# 		return $billing_id;
# 	}
# 	print "I'm sorry, but I was hoping for a number.\n";
# 	return '';
# }

sub get_fullname {
	print "                    Full Name: ";
	my $fullname = <>;
	chomp $fullname;
	if( $fullname eq '' ) {
		return "J. Doe";
	}
	if( $fullname =~ /^[\w\s\.\&\']*$/ ) {
		return $fullname;
	}
	print "Names should be alphanumeric.\n";
	return '';
}

# Here's another example of how you might want to specify going about setting
# group names.  This is an EnterAct-specific example which prompts for a few
# different acceptable groups.
# sub get_group {
# 	while(1) {
# 		print "Choose from: dialin, mailbox, loyola, nologin\n";
# 		print "                  Which group? ";
# 		my $group = <>;
# 		if( $group =~ /^d/i ) {
# 			return 'dialin';
# 		}
# 		elsif( $group =~ /^m/i ) {
# 			return 'mailbox';
# 		}
# 		elsif( $group =~ /^l/i ) {
# 			return 'loyola';
# 		}
# 		elsif( $group =~ /^n/i ) {
# 			return 'nologin';
# 		}
# 	}
# }

# This one I like.  It'll generate a random password if none is entered, using
# an algorithm that results in something a little easier to tell a customer
# over the phone than what pw generates but that should still be quite
# unpredictable.
#
# If a password is entered, it does a very basic sanity check on it to
# determine if it might be easily crack-able.
sub get_password {
	my ($file, $confirm);
	my @check_files = ('/etc/passwd', '/usr/share/dict/words');
	my @ary = ( 0 .. 9, 'A' .. 'Z', 'a' .. 'z', 'z', '!', '$', '%');

	print "            Password: [random] ";
	my $password = <>;
	chomp $password;
	if( $password ne '' ) {
		foreach $file (@check_files) {
			if( (system ("/usr/bin/grep", "-qw", $password, $file))/256 == 0 ) {
				print "Ewww, no.  That password is found in $file.\n";
				print "This password is inexcusably lame, do you really want it? (Y/n) ";
				$confirm = <>;
				if( $confirm !~ /^n/i ) {
					return $password;
				}
				else {
					return '';
				}
			}
		}
	}
	else {
		my $pw_len = rand(5)+6;
		for(1..$pw_len) {
			$password .= $ary[rand(@ary)];
		}
	}
	return $password;
}

# Another custom function used at EnterAct.  This one actually got much more
# sophisticated with time.  Seen here is an earlier version, that could still
# be interesting.
# 
# sub get_referral {
# 	my @ary = (
# 	    'Current customer',
# 	    'Word of mouth',
# 	    'Additional account',
# 	    'Microcenter',
# 	    'CNET',
# 	    'Newsgroups',
# 	    'Loyola',
# 	    'Byte By Byte',
# 	    'Chicago Computer Guide',
# 	    'Digital Chicago',
# 	    'National-Louis',
# 	    'Lake Forest College',
# 	    'Web',
# 	    'Phone book',
# 	);
# 
# 	foreach $n (0..@ary-1) {
# 		print " ", $n+1, "\) $ary[$n]\n";
# 	}
# 
# 	print "Enter referral numer or other: ";
# 	my $referral = <>;
# 	chomp $referral;
# 	if( $referral =~ /^\d+$/ && $ary[$referral-1] ) {
# 		$referral = $ary[$referral-1];
# 	}
# 	return $referral;
# }

# This function will determine what shells are available in $pw_conf_path and
# offer these as choices
sub get_shell {
	my($i, $shell, $shellstr, $default);
	$shellstr = `/usr/bin/grep ^shells $pw_conf_path`;
	$shellstr =~ s/.*?=\W*(.*)/$1/;
	chomp $shellstr;
	my @shells = split(/\W+/, $shellstr);
	$default = $shells[0]; # Default shell is first choice listed.
	$default or die "Not enough shells in $pw_conf_path!";
	print "                 Shell: [$default] ";
	$shell = <>;
	chomp $shell;
	$shell = $default unless $shell;
	for $i ( 0 .. $#shells ) {
		if( $shell eq $shells[$i] ) {
			return $shell;
		}
	}
	print "\"$shell\" is not a valid shell.\n";
	print "Please select from among:\n   @shells\n";
	return '';
}

# If you are using a more modern version of FreeBSD and want to use usernames
# greater than eight characters, you need to change this function.  Add/remove
# checks as desired.
sub get_username {
	print "                     Username: ";
	my $username = <>;
	chomp $username;
	$username =~ tr/[A-Z]/[a-z]/;
	if( length($username) > 8 ) {
		print "No, that username is too long.\n";
		print "Usernames must be eight of fewer characters.\n";
		return '';
	}
	if( length($username) < 3 ) {
		print "No, that username is too short.\n";
		print "Usernames must be three or more characters in length.\n";
		return '';
	}
	if( $username !~ /^[a-z0-9]*$/ ) {
		print "No, that username's not good.\n";
		print "Usernames should consist solely of alphanumeric characters.\n";
		return '';
	}
	if( $username !~ /^[a-z]/ ) {
		print "I'm sorry, but usernames shouldn't start with numbers.\n";
		return '';
	}
	if( (system "/usr/bin/id $username 2> /dev/null > /dev/null")/256 == 0 ) {
		print "Ouch - that one's taken already.\n";
		return '';
	}
	if( (system "/usr/bin/grep -q ^$username: /etc/aliases")/256 == 0 ) {
		print "Ouch - that one's claimed as a mail alias.\n";
		return '';
	}
	return $username;
}

# Calls pw to enter a user into the system.  Did you properly configure
# /etc/pw.conf?
sub add_user {
	my %user = @_;
	my $logline;
	my $username = $user{username};
	my $fullname = $user{fullname};
	my $password = $user{password};
	my $shell = $user{shell};
#	my $group = $user{group};

	my $oldbuf = $|;
	$| = 1;

	# It's nice to finish what we start.
	local $SIG{INT} = 'IGNORE';

	print "Running pw ... ";
	open( PW, 
	 "| $pw_path useradd $username -c \"$fullname\" -m -s $shell -h 0" )
#	 "| $pw_path useradd $username -c \"$fullname\" -g $group -m -s $shell -h 0" )
	 or die "$pw_path failure: $!";
	print PW $password, "\n";
	close PW or warn "$pw_path exited on $?: $!";
	print "DONE!\n";

	print "Creating public directories ... ";
	system("/bin/mkdir", "/home/$username/public_html");
	system("/usr/sbin/chown", "-R", "$username.$username", "/home/$username/public_html");
#	system("/usr/sbin/chown", "-R", "$username.$group", "/home/$username/public_html");
	print "DONE!\n";

	if( -s $welcome_message_path ) {
		print "Queueing welcome message ... ";
		open( WELCOME, $welcome_message_path ) 
       		or die "Couldn't open $welcome_message_path: $!";
		open( MAIL, "| $sendmail_path -it " )
  		|| die "Couldn't open pipe to $sendmail: $0";
		local $SIG{PIPE} = sub { die "Couldn't open pipe to $sendmail: $0" };
		select MAIL;
		print<<__MAIL;
To: $username\@$domain ($fullname)
Subject: Welcome to $organization!

__MAIL
		while( <WELCOME> ) {
			# This is better than exec()'ing arbitrary code as root, agreed?
			s/\$name/$username/g;
			s/\$fullname/$fullname/g;
			s/\$password/$password/g;
			print unless /^#/;
		}
		close MAIL || die "Error completing mail operation: $0";
		select STDOUT;
		print "DONE!\n";
	}

	print "Logging ... ";
	$logline = localtime() . " $0 " . "$username (" . (getpwnam($username))[2] . "/" . (getpwnam($username))[3] . ") \"$fullname\"";
#	$logline = localtime() . " $0 " . "$username/$group (" . (getpwnam($username))[2] . "/" . (getpwnam($username))[3] . ") \"$fullname\"";
	&append_file($logfile, $logline);
	print "DONE!\n";

	$| = $oldbuf;
}

sub append_file {
	my($filename,$line) = @_;

	open(FH, ">>$filename") or warn
		"Can't open $logfile: $!";
	flock(FH,LOCK_EX);
	seek(FH, 0, 2);
	print FH $line, "\n";
	close(FH);
	flock(FH, LOCK_UN);
}