diff options
-rw-r--r-- | INSTALL | 6 | ||||
-rw-r--r-- | README | 16 | ||||
-rw-r--r-- | default.yml.template | 6 | ||||
-rwxr-xr-x | fripost-adduser | 205 | ||||
-rw-r--r-- | fripost.yml.template | 8 | ||||
-rwxr-xr-x | lib/Fripost/Prompt.pm | 19 | ||||
-rwxr-xr-x | lib/Fripost/Schema.pm | 91 |
7 files changed, 282 insertions, 69 deletions
@@ -3,8 +3,8 @@ You need several CPAN modules to use these scripts. If you use Debian GNU/Linux, you can install them like so: sudo aptitude install -R libdatetime-format-mysql-perl libdatetime-perl \ -libdbd-mysql-perl libdbix-class-perl libemail-valid-perl libfile-slurp-perl \ -libio-prompt-perl libmime-base64-perl libmime-lite-perl libstring-mkpasswd-perl \ -libtemplate-perl libyaml-syck-perl +libdigest-perl libemail-valid-perl libfile-slurp-perl libio-prompt-perl \ +libmime-base64-perl libmime-lite-perl libnet-ldap-perl \ +libstring-mkpasswd-perl libtemplate-perl libyaml-syck-perl This will most probably work for Ubuntu as well. @@ -10,12 +10,13 @@ skangas@skangas.se Read installation file INSTALL and follow those instructions. -Copy file default.yml.template to default.yml, edit file default.yml and add the following +Copy file fripost.yml.template to ~/.fripost.yml, edit it and add the following - admuser: <admin username> - admpass: <admin password> + bind_dn: <admin bind DN> + bind_pw: <admin bind password> -where <admin username> and <admin password> are user name and password to the MySQL-server on <remote server> in next section. +where <admin bind username> and <admin bind password> your own admin DN +and password. Configure an locla Mail Transger Agent (MTA) for example exim4: @@ -25,9 +26,9 @@ Choose use smarthost for outgoing and no local e-mail. Choos your IPS's SMTP ser #. Log in to server - $ ssh -vNfL 3306:localhost:3306 <remote server> + $ ssh -vNfL 389:localhost:389 <remote server> -This opens an ssh-tunnel and returns to standard prompt. Use standard mysql port 3306. +This opens an ssh-tunnel and returns to standard prompt. Use standard LDAP port 389. #. Add a new mailbox. @@ -51,6 +52,9 @@ The script prompts first for go-to address, which is where the new alias is supp $ fripost-passwd +All these scripts have an integrated manual you can read using e.g., +`fripost-adduser --man'. A short help is also available with e.g., +`fripost-adduser --help'. Have fun! diff --git a/default.yml.template b/default.yml.template deleted file mode 100644 index 6e4314c..0000000 --- a/default.yml.template +++ /dev/null @@ -1,6 +0,0 @@ -# default.yml -- defaults for fripost administrative scripts ---- -dbi_dsn: dbi:mysql:mail;host=127.0.0.1;port=3306 -admin_email: admin@fripost.org -admuser: root -admpass: diff --git a/fripost-adduser b/fripost-adduser index 5c21ef1..f13868d 100755 --- a/fripost-adduser +++ b/fripost-adduser @@ -9,60 +9,174 @@ use utf8; 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 mailbox to the system, unless B<--pretend> +is set. +If no I<username> or I<password> are given, the user is prompted for them. +If I<username> is not fully qualified, C<fripost.org> is appended. + +=head1 OPTIONS + +=over 8 + +=item B<--prentend> + +Only simulates the insertion. (But still query the LDAP server to check +if I<username> is 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 inserted 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. It has to be set, either in the +configuration file, or using the command line option B<--server_host>. + +=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; +use Getopt::Long qw /:config noauto_abbrev no_ignore_case + gnu_compat bundling permute nogetopt_compat + auto_version auto_help/; +use Pod::Usage; use IO::Prompt; -use MIME::Base64; use MIME::Lite; use MIME::QuotedPrint; use Template; use YAML::Syck; + ## Get command line options -our $conf = LoadFile('default.yml'); +our $conf = LoadFile( catfile ($HOME, '.fripost.yml') ); GetOptions( - 'dbi_dsn' => \$conf->{dbi_dsn}, - 'admuser=s' => \$conf->{admuser}, - 'admpass=s' => \$conf->{admpass}, - 'debug' => \$conf->{debug}, - 'pretend' => \$conf->{pretend}, - 'verbose' => \$conf->{verbose}, -) or die "Unable to get command line options."; - -sub dsay { say @_ if $conf->{debug}; } -sub vsay { say @_ if $conf->{verbose} || $conf->{debug}; } - -# Connect to the database -my $schema = Fripost::Schema->connect( - $conf->{dbi_dsn}, $conf->{admuser}, $conf->{admpass}, {} #\%dbi_params -); - + 'server_host' => \$conf->{server_host}, + 'base_dn=s' => \$conf->{base_dn}, + 'bind_dn=s' => \$conf->{bind_dn}, + 'bind_pw=s' => \$conf->{bind_pw}, + 'debug' => \$conf->{debug}, + 'pretend' => \$conf->{pretend}, + '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 $username = prompt_email("New username: ", 'is_user'); - my $domain = (split /\@/, $username)[1]; - my $maildir = "$domain/". (split /\@/, $username)[0] . "/Maildir/"; # trailing slash important - my $active = 1; - my $password = prompt_password(); + my $username = $ARGV[0]; + $username //= prompt_email("New username: ", 'is_user'); + + # Default domain + $username .= '@fripost.org' unless $username =~ /\@.+$/; + + my ($domain, $login) = split /\@/, $username, 2; + my $maildir = "$domain/$login/Maildir/"; # Trailing slash important + my $isActive = 'TRUE'; + my ($userPassword, $clearPassword); + if ( defined $conf->{password} ) { + $userPassword = $conf->{password}; + } + else { + $clearPassword = 'hop'; #prompt_password(); + $userPassword = hash( undef, undef, $clearPassword ); + } $user = { - username => $username, - domain => $domain, - maildir => $maildir, - active => $active, - password => $password, + username => $username, + maildir => $maildir, + isActive => $isActive, + userPassword => $userPassword, }; + $user->{clearPassword} = $clearPassword unless defined $conf->{password}; say "User name: $user->{username}"; say "Password: (hidden)"; @@ -70,19 +184,25 @@ my $user; confirm_or_abort(); } -die "User already exists" - if ($schema->resultset('Mailbox')->search({ - username => $user->{username} })->count); +die "Error: User already exists.\n" + if $ldap->searchUser($user->{username})->count; + -## Insert user into database +## Insert the new user if ($conf->{pretend}) { - vsay "Did not create user since we are pretending." + vsay "Did not create user since we are pretending."; } else { - $schema->resultset('Mailbox')->new($user)->insert; - say "New account $user->{username} added."; + my %user = %$user; + delete $user{clearPassword}; + $ldap->addUser(\%user); + say "New account $user{username} added."; } +$ldap->unbind(); + + + ### Prepare sending emails my $tt = Template->new({ @@ -90,8 +210,11 @@ my $tt = Template->new({ INTERPOLATE => 1, }) || die "$Template::ERROR\n"; +my $admin_email = 'admin@fripost.org'; +$admin_email = $conf->{admin_email} if defined $conf->{admin_email}; my $msg = MIME::Lite->new( - From => encode('MIME-Q', 'Friposts administratörer') . ' <admin@fripost.org>', + + From => encode('MIME-Q', 'Friposts administratörer') . ' <' .$admin_email. '>', Subject => encode('MIME-Q', 'Välkommen till Fripost!'), Encoding => 'quoted-printable', ); @@ -130,11 +253,11 @@ if (confirm("Subscribe user to announce mailing list? ")) { } ### Send login credentials to new user -{ +if (exists $user->{clearPassword}) { my ($vars, $data); $vars = { user => $user->{username}, - pass => $user->{password}, + pass => $user->{clearPassword}, }; $tt->process('user_info.tt', $vars, \$data) @@ -164,10 +287,14 @@ if (confirm("Subscribe user to announce mailing list? ")) { 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 diff --git a/fripost.yml.template b/fripost.yml.template new file mode 100644 index 0000000..f278790 --- /dev/null +++ b/fripost.yml.template @@ -0,0 +1,8 @@ +# fripost.yml -- defaults for fripost administrative scripts +# To be moved to ~/.fripost.yml +--- +server_host: ldap://127.0.0.1:389 +admin_email: admin@fripost.org +bind_dn: cn=admin,ou=managers,dc=mail,dc=fripost,dc=org +bind_pw: xxxxxx +base_dn: dc=mail,dc=fripost,dc=org diff --git a/lib/Fripost/Prompt.pm b/lib/Fripost/Prompt.pm index d90d42d..95ea7ea 100755 --- a/lib/Fripost/Prompt.pm +++ b/lib/Fripost/Prompt.pm @@ -15,7 +15,7 @@ use Data::Dumper; use Email::Valid; use Exporter; use IO::Prompt; -use String::MkPasswd qw/mkpasswd/; +use Fripost::Password qw/mkpasswd/; our @EXPORT = qw(confirm confirm_or_abort fix_username prompt_email prompt_password); our @ISA = qw(Exporter); @@ -49,20 +49,20 @@ sub prompt_email { my ($msg, $is_username) = @_; $msg //= "Enter email: "; my $email; - while (not defined $email) { + do { $email = prompt $msg; if ($is_username) { $email = fix_username($email); } - if (!Email::Valid->address($email)) { + unless (Email::Valid->address($email)) { undef $email; say "This is not a valid e-mail address. Try again." } } + until (defined $email); return $email; - } sub prompt_password { @@ -71,7 +71,7 @@ sub prompt_password { $msg2 //= "Enter new password again (blank for random): "; my $password; - while (not defined $password) { + do { $password = prompt $msg, -e => '*'; my $confirm = prompt $msg2, -e => '*'; unless ($password eq $confirm) { @@ -79,13 +79,10 @@ sub prompt_password { say "Passwords do not match"; } } + until (defined $password); - if (!length $password) { - $password = mkpasswd( - -length => 10, - -minnum => 2, - -minspecial => 2, - ); + if ($password eq '') { + $password = mkpasswd(); say "Using password: $password"; } return $password; diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm index c9cc832..8124a54 100755 --- a/lib/Fripost/Schema.pm +++ b/lib/Fripost/Schema.pm @@ -3,10 +3,93 @@ package Fripost::Schema; use 5.010_000; use strict; -use base qw/DBIx::Class::Schema/; +use base qw/Net::LDAP/; our $VERSION = '0.01'; - __PACKAGE__->load_namespaces(); +# Initialize a connection to the LDAP host. +sub new { + my $class = shift; + my $h = shift; + + my $self = {options => $h}; + bless $self, $class; + + my $ldap = Net::LDAP->new ( $h->{server_host} ) + or die "Error: Cannot initialize connection to LDAP server.\n"; + + my $mesg; + if ( (defined $h->{bind_dn}) and $h->{bind_dn} ne '' ) { + $self->_dsay( "Binding to DN `" .$h->{bind_dn}. "'." ); + $mesg = $ldap->bind( $h->{bind_dn}, password => $h->{bind_pw} ); + } + else { + # Anonymous bind + $self->_dsay( "Anonymous bind." ); + $mesg = $ldap->bind(); + } + die "Error: " .$mesg->error. "\n" if $mesg->code; + + $self->{ldap} = $ldap; + return $self; +} + + +# Search a user, and return the corresponding entries if found. If no +# user is given, returns all users. +sub searchUser { + my $self = shift; + + my $base = join ',', ('ou=mailboxes',$self->{options}->{base_dn}); + my $filter = "(ObjectClass=virtualMailbox)"; + + $filter = "(&" .$filter. "(uid=" .$_[0]. ")" .")" + if defined $_[0]; + + my $res = $self->{ldap}->search( + base => $base, + scope => 'one', + attrs => [ 'uid', 'gn' , 'sn', 'maildir', 'isActive' ], + filter => $filter + ); + die "Error: " .$res->error. "\n" if $res->code; + + return $res; +} + +# Add a user +sub addUser { + my $self = shift; + my $user = shift; + + my $base = join ',', ('ou=mailboxes',$self->{options}->{base_dn}); + + my $res = $self->{ldap}->add( 'uid=' .$user->{username}. ',' .$base, + attrs => [ uid => $user->{username}, + objectClass => [ 'top', 'virtualMailbox' ], + userPassword => $user->{userPassword}, + maildir => $user->{maildir}, + isActive => $user->{isActive} + ] + ); + die "Error: " .$res->error. "\n" if $res->code; + return $res; +} + + +# Disconnect to the LDAP server. +sub unbind { + $_[0]->{ldap}->unbind(); +} + + +# Debug print. +sub _dsay { + my $self = shift; + return unless (exists $self->{options}->{debug}) and $self->{options}->{debug}; + print STDERR "Debug: "; + say STDERR @_; +} + 1; @@ -16,11 +99,11 @@ Fripost::Schema - =head1 AUTHOR -Stefan Kangas C<< <skangas at skangas.se> >> +Guilhem Moulin C<< <guilhem at fripost.org> >> =head1 COPYRIGHT -Copyright 2010,2011 Stefan Kangas, all rights reserved. +Copyright 2012 Guilhem Moulin, all rights reserved. =head1 LICENSE |