#!/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);