scripts/we_user - metacpan.org

#!/usr/bin/perl -w
# -*- perl -*-

#
# $Id: we_user,v 1.18 2005/05/10 12:02:04 eserte Exp $
# Author: Slaven Rezic
#
# Copyright (C) 2002,2004,2005 Slaven Rezic.
# This is free software; you can redistribute it and/or modify it under the
# terms of the GNU General Public License, see the file COPYING.
#
# Mail: slaven@rezic.de
# WWW:  http://we-framework.sourceforge.net
#

use strict;

use Getopt::Long;

use vars qw($VERSION);
$VERSION = sprintf("%d.%02d", q$Revision: 1.18 $ =~ /(\d+)\.(\d+)/);

my @args;
my $class = "WE::DB::ComplexUser";
my $contained_in;
my $force_dd;
my $rootdir = ".";
my $userdb_file;
my $onlineuserdb_file;
my $need_rw = 1;
my $show_version;
my @inc;

use WE::DB::Info;

my $info = WE::DB::Info->new;
$info->load;
my %opt = $info->getopt;

$class = $opt{userdbclass} if defined $opt{userdbclass};
$contained_in = $opt{userdbclass_file} if defined $opt{userdbclass_file};
@inc = @{ $opt{inc} } if defined $opt{inc};

Getopt::Long::config('pass_through', 'no_auto_abbrev');
GetOptions("class=s" => \$class,
	   "containedin=s" => \$contained_in,
	   "forcedd|forcedatadumper!" => \$force_dd,
	   "rootdir=s" => \$rootdir,
	   "userdb=s" => \$userdb_file,
	   "onlineuserdb=s" => \$onlineuserdb_file,
	   'inc=s@' => \@inc,
	   'version' => \$show_version,
	  );
Getopt::Long::config('no_pass_through');

if ($show_version) {
    print "$0 version $VERSION\n";
    exit 0;
}

if (@inc) {
    unshift @INC, @inc;
}

my $command = shift @ARGV;
my %cmdarg;
if ($command =~ /^-/) {
    usage("Wrong command line option $command");
} elsif ($command eq 'show') {
    $need_rw = 0;
} elsif ($command =~ /^(add|add-if-not-exists)$/) {
    if (!GetOptions('u|user=s' => \$cmdarg{User},
		    'p|pw|password=s' => \$cmdarg{Password},
		    'n|name|fullname=s' => \$cmdarg{Fullname},
		    'g|groups=s' => \$cmdarg{GroupString},
		    'email=s' => \$cmdarg{Email},
		   )) {
	usage("wrong arguments for $command");
    }
} elsif ($command =~ /^(add-group|add-group-if-not-exists)$/) {
    if (!GetOptions("g|group=s" => \$cmdarg{Group},
		    "desc|description=s" => \$cmdarg{Description},
		   )) {
	usage("wrong arguments for $command");
    }
} elsif ($command =~ /^user-exists$/) {
    if (!GetOptions('u|user=s' => \$cmdarg{User},
		   )) {
	usage("Wrong argument for user-exists");
    }
    if (!defined $cmdarg{User}) {
	usage("user-exists needs the -u argument");
    }
} elsif ($command =~ /^(del|delete)$/) {
    if (!GetOptions('u|user=s' => \$cmdarg{User},
		   )) {
	usage("wrong arguments for del");
    }
    $command = "del";
} elsif ($command eq 'passwd') {
    if (!GetOptions('u|user=s' => \$cmdarg{User},
		    'p|pw|password=s' => \$cmdarg{Password},
		   )) {
	usage("wrong arguments for passwd");
    }
} elsif ($command =~ /^(update|change)$/) {
    if (!GetOptions('u|user=s' => \$cmdarg{User},
		    'p|pw|password=s' => \$cmdarg{Password},
		    'n|name|fullname=s' => \$cmdarg{Fullname},
		    'g|groups=s' => \$cmdarg{GroupString},
		    'k|key=s' => \$cmdarg{Key},
		    'v|val|value=s' => \$cmdarg{Value},
		    'email=s' => \$cmdarg{Email},
		   )) {
	usage("wrong arguments for update");
    }
    $command = "update";
} elsif ($command =~ /^(dbinfo|meta)$/) {
    if (!GetOptions('k|key=s' => \$cmdarg{Key},
		    'v|val|value=s' => \$cmdarg{Value},
		   )) {
	usage("wrong arguments for dbinfo");
    }
    $command = "dbinfo";
} elsif ($command =~ /^show(?:dbinfo|meta)$/) {
    if (!GetOptions('k|key=s' => \$cmdarg{Key},
		   )) {
	usage("wrong arguments for showdbinfo");
    }
    $command = "showdbinfo";
} else {
    usage("Invalid command $command");
}

if (!defined $userdb_file) {
    if (-d $rootdir) {
	$userdb_file = "$rootdir/userdb.db";
    } else {
	die "$rootdir is not a directory";
    }
}

if (@ARGV) {
    die "Extra arguments: @ARGV";
}

my $module = $class;
if ($contained_in) {
    $module = $contained_in;
}
eval 'require ' . $module; die $@ if $@;

# Check if the file exists already and has the correct format
if (-e $userdb_file) {
    my $db;
    # XXX why is this eval not quiet???
    eval {
	$db = $class->new(undef, $userdb_file, -connect => 1, -readonly => 1);
    };
    if ($@ || !$db) {
	#warn $@;
    } else {
	die "Wrong class for $userdb_file?" if !$db->check_data_format;
    }
}

my $db = get_db();

if ($onlineuserdb_file) {
    require WE::DB::OnlineUser;
    my $online_db = WE::DB::OnlineUser->new(undef, $onlineuserdb_file);
    die "Can't open/create WE::DB::OnlineUser database from $onlineuserdb_file" if !$online_db;
}

if ($command eq 'show') {
    if (!$force_dd && eval { require YAML }) {
	print YAML::Dump($db->{DB}), "\n";
    } else {
	require Data::Dumper;
	print Data::Dumper->new([$db->{DB}],[])->Indent(1)->Useqq(1)->Dump;
    }

} elsif ($command eq 'add-if-not-exists') {
    if (!defined $cmdarg{User}) {
	die "Username necessary!";
    }
    if (!$db->user_exists($cmdarg{User})) {
	add_user();
    }
} elsif ($command eq 'add') {
    add_user();

} elsif ($command eq 'add-group-if-not-exists' ||
	 $command eq 'add-group') {
    if (!defined $cmdarg{Group}) {
	die "Groupname necessary!";
    }
    my $group_obj = $db->GroupObjClass->new;
    $group_obj->Groupname($cmdarg{Group});
    if (defined $cmdarg{Description}) {
	$group_obj->Description($cmdarg{Description});
    }
    my $ret = $db->add_group_definition($group_obj);
    if ($command eq 'add-group-if-not-exists' &&
	$ret eq $db->ERROR_GROUP_EXISTS) {
	# ignore
    } elsif ($ret ne $db->ERROR_OK) {
	die "Cannot add group $cmdarg{Group}, error code: $ret";
    }

} elsif ($command eq 'user-exists') {
    if ($db->user_exists($cmdarg{User})) {
	exit 0;
    } else {
	exit 1;
    }
} elsif ($command eq 'del') {
    if (!defined $cmdarg{User}) {
	die "Username necessary!";
    }
    $db->delete_user($cmdarg{User});

} elsif ($command eq 'passwd') {
    if (!defined $cmdarg{User}) {
	die "Username necessary!";
    }
    $cmdarg{Password} = get_password($cmdarg{User})
	if !defined $cmdarg{Password};
    $db->update_user($cmdarg{User}, $cmdarg{Password}, undef, undef);

} elsif ($command eq 'update') {
    if (!defined $cmdarg{User}) {
	die "Username necessary!";
    }

    $db->update_user($cmdarg{User}, $cmdarg{Password}, $cmdarg{Fullname}, undef);

    if (defined $cmdarg{GroupString}) {
	foreach my $group ($db->get_groups($cmdarg{User})) {
	    $db->delete_group($cmdarg{User}, $group);
	}
	foreach my $group (split /,/, $cmdarg{GroupString}) {
	    if ((my $err = $db->add_group($cmdarg{User}, $group)) != $db->ERROR_OK) {
		die "Error $err while adding group $group for $cmdarg{User}";
	    }
	}
    }

    my %user_args;
    if (defined $cmdarg{Key}) {
	$user_args{$cmdarg{Key}} = $cmdarg{Value};
    }
    if (defined $cmdarg{Email}) {
	$user_args{Email} = $cmdarg{Email};
    }

    if (%user_args) {
	my $u = $db->get_user_object($cmdarg{User});
	if (!$u) {
	    die "Can't get user object";
	}
	while(my($k,$v) = each %user_args) {
	    $u->{$k} = $v;
	}
	$db->set_user_object($u);
    }

} elsif ($command eq 'dbinfo') {
    # XXX Should not poke in the internals!
    my $dbinfo = $db->DB->{__DBINFO__};
    my $dbinfo_usage = <<EOF;
Known keys/values for dbinfo:
-k CryptMode|crypt   -v none|crypt
-k InvalidChars      -v ...
-k InvalidGroupChars -v ...

Warning: changing the crypt mode will invalidate all passwords!
EOF
    if (!defined $cmdarg{Key}) {
	die "-k is needed for dbinfo
$dbinfo_usage";
    }
    my $method = normalize_dbinfo_key($cmdarg{Key});
    if (!defined $method) {
	die "Unknown key $cmdarg{Key}
$dbinfo_usage";
    }
    $dbinfo->$method($cmdarg{Value});
    $db->DB->{__DBINFO__} = $dbinfo;
} elsif ($command eq 'showdbinfo') {
    # XXX Should not poke in the internals!
    my $dbinfo = $db->DB->{__DBINFO__};
    my $dbinfo_usage = <<EOF;
Known keys for showdbinfo:
-k CryptMode|crypt
-k InvalidChars
-k InvalidGroupChars
EOF
    if (!defined $cmdarg{Key}) {
	die "-k is needed for showdbinfo
$dbinfo_usage";
    }
    my $method = normalize_dbinfo_key($cmdarg{Key});
    if (!defined $method) {
	die "Unknown key $cmdarg{Key}
$dbinfo_usage";
    }
    print $dbinfo->$method, "\n";
}

sub add_user {
    if (!defined $cmdarg{User}) {
	die "Username necessary!";
    }
    my %user_args = (Username => $cmdarg{User},
		     Password => $cmdarg{Password},
		     Realname => $cmdarg{Fullname},
		    );
    if ($cmdarg{Email}) {
	$user_args{Email} = $cmdarg{Email};
    }
    my $userobj = $db->UserObjClass->new(%user_args);

    if ((my $err = $db->add_user_object($userobj)) != $db->ERROR_OK) {
	die "Error (code=$err) while adding user $cmdarg{User}";
    }
    if ($cmdarg{GroupString}) {
	foreach my $group (split /,/, $cmdarg{GroupString}) {
	    if ((my $err = $db->add_group($cmdarg{User}, $group)) != $db->ERROR_OK) {
		die "Error (code=$err) while adding group $group for $cmdarg{User}";
	    }
	}
    }
}

sub get_db {
    my(%args) = @_;
    my $db = $class->new(undef, $userdb_file, -readonly => !$need_rw);
    die "Can't open $class database from $userdb_file" if !$db;
    $db;
}

sub usage {
    my($error) = @_;
    require Pod::Usage;
    print STDERR $error, "\n";
    Pod::Usage::pod2usage(1);
}

sub get_password {
    my $user = shift;
    my $password;
    if (eval { require Term::ReadKey; 1 }) {
	while (1) {
	    print STDERR "Password for $user: ";
	    Term::ReadKey::ReadMode('noecho');
	    chomp($password = Term::ReadKey::ReadLine(0));
	    Term::ReadKey::ReadMode(0);
	    print STDERR "\nRetype password for $user: ";
	    Term::ReadKey::ReadMode('noecho');
	    chomp(my $retype_password = Term::ReadKey::ReadLine(0));
	    Term::ReadKey::ReadMode(0);
	    print STDERR "\n";
	    last if $password eq $retype_password;
	    print STDERR "Password mismatch. Please retry again.\n";
	};
    } else {
	print STDERR "WARNING: Term::ReadKey could not be loaded, therefore the password will be
visible on the screen.

Password for $user: ";
	chomp($password = <STDIN>);
    }
    $password;
}

sub normalize_dbinfo_key {
    my($key) = @_;
    if ($key =~ /^(CryptMode|crypt)$/i) {
	"CryptMode";
    } elsif ($key =~ /^InvalidChars$/i) {
	"InvalidChars";
    } elsif ($key =~ /^InvalidGroupChars$/i) {
	"InvalidGroupChars";
    } else {
	undef;
    }
}

__END__

=head1 NAME

we_user - manipulate the web.editor user database

=head1 SYNOPSIS

    we_user [-class classname] [-containedin modulename]
            [-rootdir dir | -userdb file -onlineuserdb file]
             command options ...

=head1 DESCRIPTION

=head2 COMMANDS

Valid commands are:

=over

=item show

Show the whole database

=item add -u I<user> -p I<password> [-n "I<Full Name>"] [-g
I<group1>,I<group2>,...] [-email I<emailadress>]

Add a new user with a password and optionaly a real name and groups.

=item add-if-not-exists -u I<user> -p I<password> [-n "I<Full Name>"]
[-g I<group1>,I<group2>,...] [-email I<emailadress>]

Like C<add>, but do not fail if user already exists.

=item del -u I<user>

Delete the named user (by username).

=item passwd -u I<user> -p I<password>

Change the password for I<user>. The C<-p I<password>> option may be
omitted, in this case the password is queried in the terminal
(recommended).

=item update -u I<user> [-p I<password>] [-n "I<Full Name>"] [-g
I<group1>,I<group2>,...] [-email I<emailadress>]

Change attributes for I<user>.

=item dbinfo -k I<key> -v I<value>

Change database meta data.

=item showdbinfo -k I<key>

Print the value of the named key.

=item user-exists -u I<user>

Exit with 0 if the named user exists and with 1 if the user does not
exist.

=back

=head2 OPTIONS

=over

=item -class I<class>

WE_Framework UserDB class e.g. L<WE::DB::User> or L<WE::DB::ComplexUser>.
Default is C<WE::DB::ComplexUser>.

=item -containedin I<module>

Set this if the UserDB class is contained in another module

=item -rootdir I<directory>

The root directory of the database (can be used instead of specifying
C<-userdb>). By default the current directory is used.

=item -userdb I<file>

The user database file.

=item -onlineuserdb

The online user database file

=back

=head1 AUTHOR

Slaven Rezic

=head1 SEE ALSO

L<WE::DB::ComplexUser>, L<WE::DB::User>.

=cut
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)