#!/usr/bin/perl
use lib './lib';
use strict;
use Cwd;
our $VERSION = '0.01';
my $o = gopts('a:p');
my $cfg = _figureout_cfg();
my $auth = new CGI::Auth::Auto( $cfg ) or die "CGI::Auth error";
_detect_prune();
sub _detect_prune{
$o->{p} or return;
print "Pruning session file directory...\n";
print $auth->prune, " stale session files deleted.\n";
exit;
}
my $option;
do {
show_info();
show_menu();
print "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);
sub show_info {
printf "Authdir %s\nSessdir: %s\nUserfiledat: %s %s\n\n",
$auth->authdir, $auth->sessdir, $auth->userfile, (get_mode($auth->userfile) || '') ;
return;
}
# *Since* 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;
}
sub show_menu {
my $menutext = <<MENU;
Acquisitions Database Authorization Manager
Select one of the following options (case insensitive):
A - Add a user
L - List users
V - View a user
D - Delete a user
P - Prune session files
Q - Quit
--------------------------------------------------------
MENU
print $menutext;
}
sub _figureout_cfg {
scalar @ARGV or die("you must provide path to user.dat file, even if it does not exist yet");
my $abs= $ARGV[0]
or die('missing path to user.dat');
$abs=~/^\// or $abs = cwd()."/$abs" ;
$abs=~/^(.+)\/+([^\/]+)$/ or die("cant match inside [$abs]");
my $authdir = $1;
my $userfile = $2;
my $cfg = {};
$cfg->{-admin} = 1;
$cfg->{-authdir} = $authdir;
$cfg->{-userfile} = $userfile;
$cfg->{-sessdir} = $authdir.'/sess';
#assure
if (-e $abs){
-f $abs or die("$abs should be a file not a dir");
}
unless ( -f $abs ){
# Create the user data file.
open USERDAT, '>', $abs and close USERDAT;
}
return $cfg;
}
=pod
=head1 NAME
authman - manage CGI::Auth files for user web logins
=head1 DESCRIPTION
This is to manage a users.dat type file for user logins into scripts via the web
the main argument is the path to where the user.dat file is or you want it to be at.
=head1 USAGE EXAMPLE
cgiauthman /var/www/cgi-bin/auth/users.dat
=head1 OPTION FLAGS
-p prune, get rid of old session files
=head1 NOTES
From the original authman.pl from CGI::Auth
=head1 AUTHOR
Leo Charre
=cut