diff options
| -rwxr-xr-x | fripost-newdomain | 222 |
1 files changed, 191 insertions, 31 deletions
diff --git a/fripost-newdomain b/fripost-newdomain index 99c2ce3..155e6ae 100755 --- a/fripost-newdomain +++ b/fripost-newdomain @@ -9,76 +9,236 @@ use utf8; fripost-newdomain - Add a new domain to the system +=head1 SYNOPSIS + +B<fripost-newdomain> [B<--debug>] [B<--pretend>] +[B<--owner=>I<username>] [I<domain>] + +=head1 DESCRIPTION + +B<fripost-newdomain> adds a new virtual domain to the system, unless +B<--pretend> is set. +If no I<domain> is given, the user is prompted for it. +By default, B<fripost-newdomain> prompts for the owner of the new +domain; Use B<--owner=>I<''> to create a "global" domain, only managed +by the administrators. +Several users can manage the same domain togother. (TODO: is that what we +want?) If B<fripost-newdomain> warns if it is asked to register an existing +domain to a new owner. + +=head1 OPTIONS + +=over 8 + +=item B<--pretend> + +Only simulates the insertion. (But still query the LDAP server to ensure +that I<domain> is not already in the database, and that the owner +exists.) + +=item B<--owner=>I<username> + +By default, the user is prompted for the owner of the new domain. It is +possible to use this option instead. Also, to create a domain that is +not owned by anyone, hence only managed by the administrators, use +B<--owner=>I<''>. + +=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-newdomain> 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-newdomain>. +The default value is read from the configuration file, see B<CONFIGURATION>. + +=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<bind_dn> + +The Distinguished Name (DN) to bind to the LDAP directory. +(If not set, B<fripost-newdomain> 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-newdomain>. + +=back + =cut use FindBin qw($Bin); use lib "$Bin/lib"; +use Env qw /HOME/; +use File::Spec::Functions; + use Data::Dumper; 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 Email::Valid; use IO::Prompt; -use Getopt::Long; 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}, - 'pretend' => \$conf->{pretend}, -) or die "Unable to get command line options."; + 'server_host' => \$conf->{server_host}, + 'base_dn=s' => \$conf->{base_dn}, + 'bind_dn=s' => \$conf->{bind_dn}, + 'bind_pw=s' => \$conf->{bind_pw}, + 'pretend' => \$conf->{pretend}, + 'owner=s' => \$conf->{owner}, + 'debug' => \$conf->{debug}, + 'man' => sub { pod2usage(-exitstatus => 0, + -verbose => 2) } +) or pod2usage(2); + -# Connect to the database -my $schema = Fripost::Schema->connect( - $conf->{dbi_dsn}, $conf->{admuser}, $conf->{admpass}, {} #\%dbi_params -); +# Connect to the LDAP server +my $ldap = Fripost::Schema->new( $conf ); + +# Define the domain that is to be added. my %domain; -$domain{domain} = prompt "Domain name: "; -$domain{description} = prompt_email("Belongs to user: ", 'is_user'); +$domain{domain} = $ARGV[0]; +$domain{domain} //= prompt "Domain name: "; +$domain{isActive} = 'TRUE'; +if (defined $conf->{owner}) { + if ($conf->{owner} eq '') { + $domain{owner} = undef + } + else { + Email::Valid->address($conf->{owner}) + or die "Error: `" .$conf->{owner}. "' is not a valid e-mail.\n"; + $domain{owner} = $conf->{owner}; + } +} +else { + $domain{owner} = prompt_email("Belongs to user: ", 'is_user'); +} + + +# Checks. +{ + # Check that the owner exists. + die "Error: Unknown user `" .$domain{owner}. "'.\n" + unless (not defined $domain{owner}) + or $ldap->user->search($domain{owner})->count; + + # Check that the owner doesn't already own this very domain, or that the + # domain isn't an existing "global" domain. + if ($ldap->domain->search(\%domain)->count) { + print STDERR "Error: Domain `" .$domain{domain}. "' already exists"; + print STDERR " for user `" .$domain{owner}. "'" if defined $domain{owner}; + say STDERR "."; + exit 1; + } + + # If the domain exists (but is eg, owned by someone else), produce a + # warning. + my $res = $ldap->domain->search({ domain => $domain{domain} }); + if ($res->count) { + print STDERR "Warning: Domain `" .$domain{domain}. "' already exists."; + my @owners; + map { push @owners, $_->{owner} if defined $_->{owner} } ($res->entries); + if (@owners) { + print STDERR " (Owned by "; + print STDERR (join ', ', map { '`' .$_. "'"} @owners); + print STDERR ".)"; + } + print STDERR "\n"; + } +} -## TODO: Make sure the user does exists -## TODO: Warn if the user has a domain already if ($conf->{pretend}) { say "Nothing to do since we are only pretending..."; exit 0; } -## Insert domain into database -my $db_domain = $schema->resultset('Domain')->new(\%domain); -$db_domain->insert; -say "New domain $domain{domain} added."; -sub create_alias { - my ($schema, $from, $to, $domain) = @_; - - my $alias = $schema->resultset('Alias')->new({ - address => $from, - goto => $to, - domain => $domain, - }); +# Add the domain. +$ldap->domain->add(\%domain); +print "New domain `" .$domain{domain}. "' added"; +print " for user `" .$domain{owner}. "'" if defined $domain{owner}; +say "."; - $alias->insert; - say "Created alias from $from to $to"; +# Create aliases. +sub create_alias { + my ($ldap, $from, $to, $owner) = @_; + + my %alias = (address => $from, goto => $to); + + my $res = $ldap->alias->search(\%alias); + if ($res->count) { + print STDERR "Warning: Alias `" .$alias{address}. "' already exists."; + print STDERR "(Targetting to "; + print STDERR (join ', ', map { '`' .$_->{goto}. "'"} ($res->entries)); + say STDERR ".)"; + return unless grep { $_->{goto} eq $alias{goto} } $res->entries; + } + + $alias{owner} = $owner if defined $owner; + $alias{isActive} = 'TRUE'; + $ldap->alias->add( \%alias ); + say "Created alias from $from to $to."; } -create_alias($schema, 'abuse@' . $domain{domain} ,'abuse@fripost.org' ,$domain{domain}); -create_alias($schema, 'postmaster@' . $domain{domain},'postmaster@fripost.org',$domain{domain}); +create_alias($ldap, 'abuse@' . $domain{domain} ,'abuse@fripost.org', $domain{owner}); +create_alias($ldap, 'postmaster@' . $domain{domain},'postmaster@fripost.org', $domain{owner}); =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 |