aboutsummaryrefslogtreecommitdiffstats
path: root/fripost-newdomain
diff options
context:
space:
mode:
Diffstat (limited to 'fripost-newdomain')
-rwxr-xr-xfripost-newdomain263
1 files changed, 0 insertions, 263 deletions
diff --git a/fripost-newdomain b/fripost-newdomain
deleted file mode 100755
index 2f204ee..0000000
--- a/fripost-newdomain
+++ /dev/null
@@ -1,263 +0,0 @@
-#!/usr/bin/perl
-
-use 5.010_000;
-use warnings;
-use strict;
-use utf8;
-
-=head1 NAME
-
-fripost-newdomain - Add a new domain to the system
-
-=head1 SYNOPSIS
-
-B<fripost-newdomain> [B<--verbose>] [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 I<domain> is not 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 together.
-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<-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<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::Prompter;
-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},
- 'owner=s' => \$conf->{owner},
- 'debug' => \$conf->{debug},
- 'v|verbose' => \$conf->{verbose},
- 'man' => sub { pod2usage(-exitstatus => 0,
- -verbose => 2) }
-) or pod2usage(2);
-
-sub vsay { say STDERR @_ if $conf->{verbose} || $conf->{debug}; }
-
-
-# Connect to the LDAP server
-my $ldap = Fripost::Schema->new( $conf );
-
-
-# Define the domain that is to be added.
-my %domain;
-$domain{domain} = $ARGV[0];
-$domain{domain} //= prompt "Domain name: ";
-$domain{isActive} = 'TRUE';
-
-# Ensure that the domain is valid.
-Email::Valid->address('fake@'.$domain{domain})
- or die "Error: Invalid domain `$domain{domain}'.\n";
-
-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');
-}
-
-
-{
- # Check that the owner exists.
- die "Error: Unknown user `" .$domain{owner}. "'.\n"
- unless (not defined $domain{owner})
- or $ldap->user->search({ username => $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 "WARN: 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";
- }
-}
-
-
-if ($conf->{pretend}) {
- vsay "Nothing to do since we are only pretending...";
- exit 0;
-}
-
-
-# Add the domain.
-$ldap->domain->add(\%domain);
-if (defined $domain{owner}) {
- print "New domain `" .$domain{domain}. "' added";
- print " for user `" .$domain{owner}. "'" if defined $domain{owner};
- say ".";
-}
-else {
- say "New non self-managed domain `" .$domain{domain}. "' added.";
-}
-
-
-# Create aliases.
-sub create_alias {
- my ($ldap, $from, $to) = @_;
-
- my %alias = (address => $from, goto => $to);
-
- my $res = $ldap->alias->search(\%alias);
- if ($res->count) {
- print STDERR "WARN: 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{isActive} = 'TRUE';
- $ldap->alias->add( \%alias );
- say "Created alias from $from to $to.";
-}
-
-create_alias($ldap, 'abuse@' . $domain{domain} ,'abuse@fripost.org');
-create_alias($ldap, 'postmaster@' . $domain{domain},'postmaster@fripost.org');
-$ldap->unbind();
-
-
-=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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 03:48:02 +0000