diff options
author | Stefan Kangas <stefankangas@gmail.com> | 2010-12-31 05:57:21 +0100 |
---|---|---|
committer | Stefan Kangas <stefankangas@gmail.com> | 2010-12-31 05:57:21 +0100 |
commit | b30fb0d7e1b16d60a769fa4c5d8053420cf06774 (patch) | |
tree | 39c17405c7645171ea05473ae522692d2513db5d /fripost-adduser.pl | |
parent | 7c2dc3d833206c9f869a4bf55db6c69c37953d7f (diff) |
remove .pl filename extension
Diffstat (limited to 'fripost-adduser.pl')
-rwxr-xr-x | fripost-adduser.pl | 154 |
1 files changed, 0 insertions, 154 deletions
diff --git a/fripost-adduser.pl b/fripost-adduser.pl deleted file mode 100755 index d7a0fd3..0000000 --- a/fripost-adduser.pl +++ /dev/null @@ -1,154 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use warnings; -use strict; - -=head1 NAME - -fripost-adduser.pl - Add a new mailbox to the system - -=head1 DESCRIPTION - -This script eases the burden of adding a new user to the system. - -Necessary steps to add a user to the system: -1. Create the Maildir (ensuring proper permissions) -2. Add him to the MySQL database -3. Send welcome message -4. Ensure welcome message has arrived - -=cut - -our $VERSION = '0.01'; - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Data::Dumper; -use DateTime; -use Email::Valid; -use Fripost::Password; -use Fripost::Schema; -use IO::Prompt; -use Getopt::Long; -use String::MkPasswd qw/mkpasswd/; -use YAML::Syck; - -# Prompt for user info -sub read_user_info { - my %user; - # Get the full e-mail of the user (aka e-mail) - while (not defined $user{username}) { - $user{username} = prompt "New username: "; - if (!($user{username} =~ /\@/)) { - $user{username} .= '@fripost.org'; - say "Using $user{username}"; - } - if (!Email::Valid->address($user{username})) { - undef $user{username}; - say "This is not a valid e-mail address. Try again." - } - } - - # 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"; - - # Set dates - my $now = DateTime->now( - # locale => 'sv_SE', - # time_zone => 'Europe/Stockholm', - ); - $user{create_date} = $now; - $user{change_date} = $now; - - $user{active} = 1; - - # Generate password - my $password = mkpasswd( - -length => 20, - -minnum => 5, - -minspecial => 3 - ); - $user{password} = smd5($password); - - # Show the information that will be inserted - say Dumper \%user; - say "Generated 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}, -) 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; -} - -## Create maildir -my ($login,$pass,$uid,$gid) = getpwnam($conf->{maildir_user}) - or die "maildir_user not found: $conf->{maildir_user}"; - -my $maildir_loc = $conf->{maildir_base} . '/' . $user->{maildir}; - -system(qw/sudo mkdir -p -m/, $conf->{maildir_umask}, $maildir_loc =~ m!(.+)/Maildir$!); -system(qw/sudo maildirmake/, $maildir_loc); -system(qw/sudo chmod/, $conf->{maildir_umask}, $maildir_loc); -system(qw/sudo chown -R/, "$conf->{maildir_user}:$conf->{maildir_group}", $conf->{maildir_base}); - -say "Created maildir in $maildir_loc"; - -## 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<< <skangas at skangas.se> >> - -=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 |