package Fripost::Commands::add_user; use 5.010_000; use strict; use warnings; use utf8; =head1 NAME add_user - Add a new mailbox to the system =cut use FindBin qw($Bin); use lib "$Bin/lib"; use Fripost::Password; use Fripost::Prompt; use Fripost::Schema; use Fripost::Email; our $VERSION = '0.01'; our @EXPORT = qw/main/; our @ISA = qw(Exporter); sub assert { my $ldap = shift; my $username = shift; my ($login, $domain) = split /\@/, $username, 2; # Error if the domain is unknown. die "Error: Unknown domain `" .$domain. "'.\n" unless $ldap->domain->search({ domain => $domain })->count; # Ensure that the username doesn't already exist. die "Error: User `" .$username. "' already exists.\n" if $ldap->user->search({ username => $username })->count; # Ensure that the username doesn't correspond to an existing alias. my $res = $ldap->alias->search({ address => $username }); if ($res->count) { print STDERR "Error: Alias $username already exists. "; print STDERR "(Targetting to "; print STDERR (join ', ', map { $_->{goto} } $res->entries); say STDERR ".)"; exit 1; } } sub main { my $ldap = shift; my $conf = shift; # Define the new user my $username; { if (defined $_[0]) { $username = fix_username ($_[0]); Email::Valid->address($username) or die "Error: $username is not a valid e-mail.\n"; } else { $username = prompt_email( "New username: ", 'is_user' ); # TODO: add the assert in the hash. } } &assert ($ldap, $username); my $user; my $clearPassword; { my $isActive = 'TRUE'; my $userPassword; if ( defined $conf->{password} ) { $userPassword = $conf->{password}; } else { $clearPassword = prompt_password(); $userPassword = hash( $clearPassword ); } $user = { username => $username, isActive => $isActive, userPassword => $userPassword, }; say "User name: $user->{username}"; say "Password: (hidden)"; confirm_or_abort(); } my $welcome = new_welcome_message ($conf, $user->{username}); my $info; unless (defined $conf->{password}) { if (confirm "Send email with login information? ") { my $to = prompt_email("Where should the email be sent? "); $info = new_user_info_message ( $conf, $user->{username}, $clearPassword, $to ); } } if ($conf->{pretend}) { say STDERR "Did not create user since we are pretending." if $conf->{verbose} or $conf->{debug}; } else { # Insert the new user my %user = %$user; delete $user{clearPassword}; $ldap->user->add(\%user); say STDERR "New account $user{username} added."; # Send the prepared emails $welcome->send(); say "Sent welcome message (". (security_status $welcome) .")."; # Subscribe user to announce-list subscribe($conf, $username, 'announce@lists.fripost.org') if confirm("Subscribe user to announce mailing list? "); if (defined $info) { $info->send(); say "Credentials sent (". (security_status $info) .")."; } } } =head1 AUTHOR Stefan Kangas C<< >> Guilhem Moulin C<< >> =head1 COPYRIGHT Copyright 2010,2011 Stefan Kangas. Copyright 2012 Guilhem Moulin. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. =cut 1; # End of add_user.pm __END__