#!/usr/bin/perl use base 'LEOCHARRE::CLI'; use lib './lib'; use strict; require CGI::Auth::Auto; 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