#!/usr/bin/perl use 5.010_000; use warnings; use strict; =head1 NAME fripost-adduser - Add a new mailbox to the system =head1 DESCRIPTION This script eases the burden of adding a new user to the system. It simply adds a new user to the database. =cut our $VERSION = '0.02'; use FindBin qw($Bin); use lib "$Bin/lib"; use Data::Dumper; use Fripost::Password; use Fripost::Prompt; use Fripost::Schema; use IO::Prompt; use Getopt::Long; use YAML::Syck; # Prompt for user info sub read_user_info { my %user; $user{username} = prompt_username("New username: "); # Full name of user $user{name} = prompt "Full (real) name: "; # Extrapolate domain from full e-mail my @parts = split /\@/, $user{username}; my $username = $parts[0]; my $domain = $parts[1]; # Set domain name $user{domain} = $domain; # Construct maildir from domain and user $user{maildir} = "$domain/$username/Maildir/"; # trailing slash important $user{active} = 1; # Generate password my $password = prompt_password(); $user{password} = smd5($password); # Show the information that will be inserted say Dumper \%user; say "Using password $password"; # Ask the user if the information is OK my $confirmed = prompt "Is this OK? ", -yn; if ($confirmed) { return \%user; } else { return undef; } } ## Get command line options our $conf = LoadFile('default.yml'); GetOptions( 'dbi_dsn' => \$conf->{dbi_dsn}, 'admuser=s' => \$conf->{admuser}, 'admpass=s' => \$conf->{admpass}, 'pretend' => \$conf->{pretend}, ) or die "Unable to get command line options."; # Connect to the database my $schema = Fripost::Schema->connect( $conf->{dbi_dsn}, $conf->{admuser}, $conf->{admpass}, {} #\%dbi_params ); say "Adding a new virtual user."; my $user = read_user_info(); if (!defined $user) { say "Aborted by user."; exit 1; } if ($conf->{pretend}) { say "Nothing to do since we are pretending..."; exit 0; } ## TODO: Make sure the user does not already exist ## Insert user into database my $db_user = $schema->resultset('Mailbox')->new($user); $db_user->insert; say "New account $user->{username} added."; =head1 AUTHOR Stefan Kangas C<< >> =head1 COPYRIGHT Copyright 2010 Stefan Kangas. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as perl itself. =cut