The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl

# $Id: authman.pl,v 1.4 2003/10/02 06:30:10 cmdrwalrus Exp $

require CGI::Auth;
require AuthCfg;

my $cfg = $AuthCfg::authcfg;
$cfg->{-admin} = 1;

my $userfile = $cfg->{-authdir} . "/" . ( $cfg->{-userfile} || "user.dat" );
unless ( -f $userfile )
{
	# Create the user data file.
	open USERDAT, "> $userfile" and close USERDAT;
}

my $auth = new CGI::Auth( $cfg ) or die "CGI::Auth error";

if ($ARGV[0] eq 'prune')
{
	print "Pruning session file directory...\n";
	print $auth->prune, " stale session files deleted.\n";
	exit;
}

my $menutext = <<MENU;
Acquisitions Database Authorization Manager

Select one of the following options:

A - Add a user.
L - List users.
V - View a user.
D - Delete a user.
P - Prune session files.
Q - Quit.

MENU

# If not a member of CGI::Auth, just pass it an auth object reference.
sub addprompt
{
	my $self = shift;

    my @authfields = @{ $self->{authfields} };
	print "Adding a new user.\n";
    print scalar( @authfields ), " fields are needed:  ", join( ', ', map $_->{display}, @authfields ), ".\n\n";

	my $validchars = $self->{validchars};
	my @fields;
	FIELD: for my $f ( @authfields )
	{
		my $notice = ( $f->{hidden} && !$self->{md5pwd} ) ? '16 characters or less; ' : '';
		print "Enter " . $f->{display} . "(${notice}Leave blank to cancel) : ";
		my $data = <STDIN>;

		# Untaint, and remove newlines.
		$data =~ /^(.*?)$/;
		$data = $1;

		# Cancel if nothing entered.
		unless ( $data )
        {
            print "Cancelled.\n";
            return 0;
        }

		# Check for non-valid characters.
		if ( $data =~ /([^$validchars])/ )
		{
			print "Data entered contains an invalid character ($1).\n";
			redo FIELD;
		}

		# Valid data.  So store it, and move on.
		push @fields, $data;
	}

	print "Adding user '$fields[0]'.\n";
	$auth->adduser( @fields );

	return 1;
}

do
{
	print $menutext, "Option: ";
	$option = <STDIN>;

	print "\n";
	if ($option =~ /^a/i)
	{
        addprompt( $auth );
	}
	elsif ($option =~ /^l/i)
	{
		print "Users currently in the userbase:\n\n";
		$auth->listusers;
	}
	elsif ($option =~ /^v/i)
	{
		my $un;
		print "User name to view: ";
		$un = <STDIN>;
		chomp $un; chomp $un;		# Two chomps because of the \r\n in Windows

		$auth->viewuser($un);
	}
	elsif ($option =~ /^d/i)
	{
		my $un;

		print "User name to delete: ";
		$un = <STDIN>;
		chomp $un; chomp $un;		# Two chomps because of the \r\n in Windows

		$auth->deluser($un);
	}
	elsif ($option =~ /^p/i)
	{
		print "Pruning session file directory...\n";
		print $auth->prune, " stale session files deleted.\n";
	}

	print "\n";
} while ($option !~ /^q/i);