#!/usr/bin/perl use 5.010_000; use warnings; use strict; =head1 NAME fripost-adduser - Add a new mailbox to the system =cut our $VERSION = '0.02'; use FindBin qw($Bin); use lib "$Bin/lib"; use Data::Dumper; use Encode qw(encode); use File::Slurp qw(slurp); use Fripost::Password; use Fripost::Prompt; use Fripost::Schema; use Getopt::Long; use IO::Prompt; use MIME::Base64; use MIME::Lite; use MIME::QuotedPrint; use YAML::Syck; ## 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 = { username => prompt_email("New username: ", 'is_user'), name => prompt "Full (real) name: ", domain => (split /\@/, $username)[1], maildir => "$domain/". (split /\@/, $username)[0] . "/Maildir/", # trailing slash important active => 1, password => prompt_password(), }; say "Username: $user->{username}"; say "Name: $user->{name}"; say "Password: (hidden)"; ask_if_ok_or_abort(); } die "User already exists" if ($schema->resultset('Mailbox')->search({ username => $user->{username} })->count); if ($conf->{pretend}) { say "Nothing to do since we are pretending..."; exit 0; } ## Insert user into database my $db_user = $schema->resultset('Mailbox')->new($user); $db_user->insert; say "New account $user->{username} added."; ## Send email my $msg = MIME::Lite->new( From => 'admin@fripost.org', To => 'test@example.com', Subject => "=?UTF-8?B?" . encode_base64(encode("utf8", 'Välkommen till Fripost!'), "") . "?=", Data => scalar slurp('templ/new_user_mail.tt'), # TODO: actually use TT Encoding => 'quoted-printable', ); $msg->attr('content-type.charset' => 'utf-8'); $msg->send(); say "Sent welcome message: "; say $msg->as_string; #say decode_qp($msg->as_string); ask_if_ok_or_abort("Send email with login information? "); prompt_email("Where should the email be sent? "); =head1 AUTHOR Stefan Kangas C<< >> =head1 COPYRIGHT Copyright 2010,2011 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