diff options
Diffstat (limited to 'fripost-adduser')
| -rwxr-xr-x | fripost-adduser | 325 |
1 files changed, 0 insertions, 325 deletions
diff --git a/fripost-adduser b/fripost-adduser deleted file mode 100755 index fc37489..0000000 --- a/fripost-adduser +++ /dev/null @@ -1,325 +0,0 @@ -#!/usr/bin/perl - -use 5.010_000; -use strict; -use warnings; -use utf8; - -=head1 NAME - -fripost-adduser - Add a new mailbox to the system - -=head1 SYNOPSIS - -B<fripost-adduser> [B<--verbose>] [B<--debug>] [B<--pretend>] [I<username>] -[B<--password=>I<password>] - -=head1 DESCRIPTION - -B<fripost-adduser> adds a new virtual mailbox to the system, unless -B<--pretend> is set. -If I<username> or I<password> are not given, the user is prompted for -them. -If I<username> is not fully qualified, C<fripost.org> is appended. -If I<username> is already an existing username or alias, -B<fripost-adduser> raises an error. - -=head1 OPTIONS - -=over 8 - -=item B<--pretend> - -Only simulates the insertion. (But still query the LDAP server to ensure -that I<username> is not already in the database.) - -=item B<--password=>I<password> - -By default, the user is prompted for his/her new password, which is -hashed, salted and then added to the LDAP entry. -By using B<--password>, I<password> is inserted RAW in the database. -This can be useful if the user does not want to give the clear copy but -only a hash, for example. -Using this option disables the sending of credentials. - -=item B<--server_host=>I<host> - -The LDAP URI to connect to. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_dn=>I<binddn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-adduser> binds anonymously.) -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--bind_pw=>I<password> - -The password to to bind with. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<--base_dn=>I<basedn> - -The root DN for everything done by B<fripost-adduser>. -The default value is read from the configuration file, see B<CONFIGURATION>. - -=item B<-v>, B<--verbose> - -Verbose mode. - -=item B<--debug> - -Debug mode. - -=back - -=head1 CONFIGURATION - -The configuration is read from the file C<$HOME/.fripost.yml>. -Valid keys include: - -=over 4 - -=item I<server_host> - -The LDAP URI to connect to. Defaults to C<ldap://127.0.0.1:389>. - -=item I<admin_email> - -The I<From:> e-mail address to use. Defaults to C<admin@fripost.org>. - -=item I<bind_dn> - -The Distinguished Name (DN) to bind to the LDAP directory. -(If not set, B<fripost-adduser> binds anonymously.) - -=item I<bind_pw> - -The password to to bind with. - -=item I<base_dn> - -The root DN for everything done by B<fripost-adduser>. - -=back - -=cut - -use FindBin qw($Bin); -use lib "$Bin/lib"; - -use Env qw /HOME/; -use File::Spec::Functions; - -use Data::Dumper; -use Encode qw(encode); -use File::Slurp qw(slurp); -use Fripost::Password; -use Fripost::Prompt; -use Fripost::Schema; -use Getopt::Long qw /:config noauto_abbrev no_ignore_case - gnu_compat bundling permute nogetopt_compat - auto_version auto_help/; -use Pod::Usage; -use MIME::Lite; -use MIME::QuotedPrint; -use Template; -use YAML::Syck; - - -## Get command line options -our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); - -GetOptions( - 'server_host=s' => \$conf->{server_host}, - 'base_dn=s' => \$conf->{base_dn}, - 'bind_dn=s' => \$conf->{bind_dn}, - 'bind_pw=s' => \$conf->{bind_pw}, - 'pretend' => \$conf->{pretend}, - 'debug' => \$conf->{debug}, - 'v|verbose' => \$conf->{verbose}, - 'password=s' => \$conf->{password}, - 'man' => sub { pod2usage(-exitstatus => 0, - -verbose => 2) } -) or pod2usage(2); - -sub dsay { say STDERR @_ if $conf->{debug}; } -sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; } - - -# Connect to the LDAP server -my $ldap = Fripost::Schema->new( $conf ); - - -# Define the new user -my $user; -my ($domain, $login); -{ - my $username; - if (defined $ARGV[0]) { - $username = fix_username ($ARGV[0]); - Email::Valid->address($username) - or die "Error: $username is not a valid e-mail.\n"; - } - else { - $username = prompt_email("New username: ", 'is_user'); - } - ($login, $domain) = split /\@/, $username, 2; - my $isActive = 'TRUE'; - my ($userPassword, $clearPassword); - if ( defined $conf->{password} ) { - $userPassword = $conf->{password}; - } - else { - $clearPassword = prompt_password(); - $userPassword = hash( $clearPassword ); - } - - $user = { - username => $username, - isActive => $isActive, - userPassword => $userPassword, - }; - $user->{clearPassword} = $clearPassword unless defined $conf->{password}; - - say "User name: $user->{username}"; - say "Password: (hidden)"; - - confirm_or_abort(); -} - - -{ - # 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 `" .$user->{username}. "' already exists.\n" - if $ldap->user->search({ username => $user->{username} })->count; - - # Ensure that the username doesn't correspond to an existing alias. - my $res = $ldap->alias->search({ address => $user->{username} }); - if ($res->count) { - print STDERR "Error: Alias $user->{username} already exists. "; - print STDERR "(Targetting to "; - print STDERR (join ', ', map { $_->{goto} } $res->entries); - say STDERR ".)"; - exit 1; - } -} - - -## Insert the new user -if ($conf->{pretend}) { - vsay "Did not create user since we are pretending."; -} -else { - my %user = %$user; - delete $user{clearPassword}; - $ldap->user->add(\%user); - say "New account $user{username} added."; -} - -$ldap->unbind(); - - - -### Prepare sending emails - -my $tt = Template->new({ - INCLUDE_PATH => "$Bin/templ", - INTERPOLATE => 1, -}) || die "$Template::ERROR\n"; - -my $admin_email = $conf->{admin_email}; -$admin_email //= 'admin@fripost.org'; -my $msg = MIME::Lite->new( - - From => encode('MIME-Q', 'Friposts administratörer') . ' <' .$admin_email. '>', - Subject => encode('MIME-Q', 'Välkommen till Fripost!'), - Encoding => 'quoted-printable', -); - -$msg->attr('content-type.charset' => 'utf-8'); - -### Send welcome email to new user -{ - my ($vars, $data); - $vars = {}; - - $tt->process('new_user_mail.tt', $vars, \$data) - || die $tt->error(), '\n'; - $msg->data($data); - - $msg->replace(To => $user->{username}); - - unless ($conf->{pretend}) { - $msg->send() unless $conf->{pretend}; - say "Sent welcome message."; - } - dsay "-----------------------------------"; - dsay "| Welcome mail |"; - dsay "-----------------------------------"; - dsay decode_qp($msg->as_string); - dsay "-----------------------------------"; -} - -### Subscribe user to announce-list -if (confirm("Subscribe user to announce mailing list? ")) { - $msg->replace(From => $user->{username}); - $msg->replace(To => 'announce-subscribe@lists.fripost.org'); - $msg->replace(Subject => ''); - $msg->replace(Data => ''); - $msg->send(); -} - -### Send login credentials to new user -if (exists $user->{clearPassword}) { - my ($vars, $data); - $vars = { - user => $user->{username}, - pass => $user->{clearPassword}, - }; - - $tt->process('user_info.tt', $vars, \$data) - || die $tt->error(), '\n'; - $msg->data($data); - - dsay "-----------------------------------"; - dsay "| Login credentials mail |"; - dsay "-----------------------------------"; - dsay decode_qp($msg->as_string); - dsay "-----------------------------------"; - - confirm_or_abort("Send email with login information? "); - my $to = prompt_email("Where should the email be sent? "); - $msg->replace(To => $to); - - if (!$conf->{pretend}) { - $msg->send; - say "Credentials sent."; - } - else { - say "Pretending, will not send credentials."; - } -} - -=head1 AUTHOR - -Stefan Kangas C<< <skangas at skangas.se> >> - -Guilhem Moulin C<< <guilhem at fripost.org> >> - -=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. - -=cut |