aboutsummaryrefslogtreecommitdiffstats
path: root/fripost-adduser
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@fripost.org>2012-06-03 22:20:58 +0200
committerGuilhem Moulin <guilhem.moulin@fripost.org>2012-06-03 22:20:58 +0200
commita3684346f4d60715512c7ca30ba9fc7bb270c38e (patch)
treeb6c4d3a5223faf5801f5e5e7860110fca5efa521 /fripost-adduser
parent0461d89edb3f8e272697726208ab7747c30a81df (diff)
Merge everything into a single executable.
Diffstat (limited to 'fripost-adduser')
-rwxr-xr-xfripost-adduser325
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