From a3684346f4d60715512c7ca30ba9fc7bb270c38e Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Sun, 3 Jun 2012 22:20:58 +0200 Subject: Merge everything into a single executable. --- lib/Fripost/Commands/alias_add.pm | 133 ++++++++++++++++++++++++++++ lib/Fripost/Commands/alias_search.pm | 80 +++++++++++++++++ lib/Fripost/Commands/domain_add.pm | 150 +++++++++++++++++++++++++++++++ lib/Fripost/Commands/domain_search.pm | 60 +++++++++++++ lib/Fripost/Commands/mkpass.pm | 59 +++++++++++++ lib/Fripost/Commands/user_add.pm | 161 ++++++++++++++++++++++++++++++++++ lib/Fripost/Commands/user_passwd.pm | 89 +++++++++++++++++++ lib/Fripost/Commands/user_search.pm | 58 ++++++++++++ 8 files changed, 790 insertions(+) create mode 100644 lib/Fripost/Commands/alias_add.pm create mode 100644 lib/Fripost/Commands/alias_search.pm create mode 100644 lib/Fripost/Commands/domain_add.pm create mode 100644 lib/Fripost/Commands/domain_search.pm create mode 100644 lib/Fripost/Commands/mkpass.pm create mode 100644 lib/Fripost/Commands/user_add.pm create mode 100644 lib/Fripost/Commands/user_passwd.pm create mode 100644 lib/Fripost/Commands/user_search.pm (limited to 'lib/Fripost/Commands') diff --git a/lib/Fripost/Commands/alias_add.pm b/lib/Fripost/Commands/alias_add.pm new file mode 100644 index 0000000..f86b1f7 --- /dev/null +++ b/lib/Fripost/Commands/alias_add.pm @@ -0,0 +1,133 @@ +package Fripost::Commands::alias_add; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +alias_add - Add a new virtual alias + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Email::Valid; +use IO::Prompter; +use Fripost::Prompt; +use Fripost::Schema; +use Fripost::Email; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + # Get information + my $goto = fix_username(shift); + $goto //= prompt_email("Alias goto address: ", 'is_user'); + my @addr = @_; + @addr || push @addr, (split /, */, prompt "Alias from address(es): "); + + + # Show goto adress + say "Goto adress: $goto"; + + # Show from adresses + @addr = grep { + if (Email::Valid->address('fake'.$_)) { + # Warn if the domain is unknown. + my $domain = (split /\@/, $_, 2)[1]; + if ($ldap->domain->search({ domain => $domain })->count) { + 1; + } + else { + warn "WARN: Skipping unknown domain `" .$domain. "'.\n"; + undef; + } + } + else { + warn "WARN: Skipping invalid address `" .$_. "'.\n"; + undef; + } + } @addr; + if (@addr == 0) { + warn "No valid destination adresses. Aborting...\n"; + exit 1; + } + say "From adress(es): " . (join ", ", @addr); + confirm_or_abort(); + + my $msg = new_alias_info_message ($conf, $goto, \@addr); + + ## Insert alias + for my $addr (@addr) { + + my ($u,$d) = split /\@/, $addr, 2; + + # Ensure that the alias doesn't already exist. + my $rs = $ldap->alias->search({ address => $addr }); + if ($rs->count and not (defined $conf->{force})) { + print STDERR "Error: Alias $addr already exists. "; + print STDERR "(Targetting to "; + print STDERR (join ', ', map { $_->{goto} } $rs->entries); + say STDERR ".)"; + exit 1; + } + + die "Error: Username $addr exists.\n" + if ($ldap->user->search({ username => $addr })->count); + + if ($conf->{pretend}) { + say STDERR "Did not create alias since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + $ldap->alias->add({ address => $addr, goto => $goto, + isActive => 'TRUE' }); + say "New alias added from $addr to $goto."; + } + } + + if ($conf->{pretend}) { + say STDERR "Did not send confirmation since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + if (confirm_or_abort("Send confirmation? ")) { + $msg->send(); + say "Sent confirmation (". (security_status $msg) .")."; + } + } +} + + +=head1 AUTHOR + +Stefan Kangas C<< >> + +Guilhem Moulin C<< >> + +=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. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of alias_add.pm + +__END__ diff --git a/lib/Fripost/Commands/alias_search.pm b/lib/Fripost/Commands/alias_search.pm new file mode 100644 index 0000000..6e638ac --- /dev/null +++ b/lib/Fripost/Commands/alias_search.pm @@ -0,0 +1,80 @@ +package Fripost::Commands::alias_search; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +alias_search.pm - List matching virtual aliases + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Schema; + +our $VERSION = '0.01'; + +sub perform_search { + my $ldap = shift; + + foreach my $alias ($ldap->alias->search( $_[0] )->entries) { + say "" . ($alias->{isActive} ? "ACTIVE" : "INACTIVE") + . " alias for " . $alias->{goto} . " are " + . (join ', ', @{$alias->{address}}); + } +} + +sub main { + my $ldap = shift; + my $conf = shift; + + my $search = $_[0]; + + my $f = $conf->{from}; + my $g = $conf->{goto}; + my $from = $f || !$f && !$g; + my $goto = $g || !$f && !$g; + + if ($from) { + perform_search($ldap, {address => $search}); + + my ($u,$d) = split /\@/, $search, 2; + $d = $u if (defined $u) and not (defined $d); + $ldap->domain->search({ domain => $d })->count + or die "Error: Unknown domain `$d'.\n"; + } + + if ($goto) { + perform_search($ldap, {goto => $search}); + } +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2012 Guilhem Moulin. + +Copyright 2012 Stefan Kangas . + +=head1 LICENSE + +This program is free software; you can redistribute it and/or modify it +under the same terms as perl itself. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of alias_search.pm + +__END__ diff --git a/lib/Fripost/Commands/domain_add.pm b/lib/Fripost/Commands/domain_add.pm new file mode 100644 index 0000000..a727623 --- /dev/null +++ b/lib/Fripost/Commands/domain_add.pm @@ -0,0 +1,150 @@ +package Fripost::Commands::domain_add; + +use 5.010_000; +use warnings; +use strict; +use utf8; + +=head1 NAME + +domain_add - Add a new virtual domain. + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Password; +use Fripost::Prompt; +use Fripost::Schema; +use Email::Valid; +use IO::Prompter; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + # Define the domain that is to be added. + my %domain; + $domain{domain} = $_[0]; + $domain{domain} //= prompt "Domain name: "; + $domain{isActive} = 'TRUE'; + + # Ensure that the domain is valid. + die "Error: Invalid domain `$domain{domain}'.\n" + unless Email::Valid->address('fake@'.$domain{domain}); + + $domain{owner} = $_[1]; + $domain{owner} //= prompt_email("Belongs to user: ", 'is_user'); + + if ($domain{owner} eq '') { + $domain{owner} = undef + } + else { + die "Error: $domain{owner} is not a valid e-mail.\n" + unless Email::Valid->address($domain{owner}); + } + + # 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}) { + say STDERR "Did not add the domain since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + # 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_alias($ldap, 'abuse@' . $domain{domain}, + 'abuse@fripost.org'); + create_alias($ldap, 'postmaster@' . $domain{domain}, + 'postmaster@fripost.org'); + } +} + + +# 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."; +} + + + +=head1 AUTHOR + +Stefan Kangas C<< >> + +Guilhem Moulin C<< >> + +=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. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of domain_add.pm + +__END__ diff --git a/lib/Fripost/Commands/domain_search.pm b/lib/Fripost/Commands/domain_search.pm new file mode 100644 index 0000000..8aaf775 --- /dev/null +++ b/lib/Fripost/Commands/domain_search.pm @@ -0,0 +1,60 @@ +package Fripost::Commands::domain_search; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +domain_search.pm - List matching virtual domains + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Schema; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + my %domain; + $domain{domain} = $_[0] if defined $_[0]; + $domain{owner} = $_[1] if defined $_[1]; + + foreach my $domain ($ldap->domain->search( \%domain )->entries) { + say '' . ($domain->{isActive} ? 'ACTIVE' : 'INACTIVE') + . ' domain ' . $domain->{domain} + . ' is owned by ' + . (defined $domain->{owner} ? join ', ', @{$domain->{owner}} + : '(none)'); + } +} + + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +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. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of domain_search.pm + +__END__ diff --git a/lib/Fripost/Commands/mkpass.pm b/lib/Fripost/Commands/mkpass.pm new file mode 100644 index 0000000..0ac2570 --- /dev/null +++ b/lib/Fripost/Commands/mkpass.pm @@ -0,0 +1,59 @@ +package Fripost::Commands::mkpass; + +use 5.010_000; +use warnings; +use strict; +use utf8; + +=head1 NAME + +mkpass.pm - Create a random new password, and returns its hash + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; +use Fripost::Password; + +our $VERSION = '0.01'; + +our @EXPORT = qw/main/; +our @ISA = qw(Exporter); + +sub main { + my $password = shift; + $password //= mkpasswd(); + + # Show the information that will be inserted + say "Password: " . $password; + say "Salted SHA-1: " . hash($password, SHA1, undef); +} + + +=head1 AUTHORS + +Stefan Kangas C<< >> + +Guilhem Moulin C<< >> + +=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. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of mkpass.pm + +__END__ + diff --git a/lib/Fripost/Commands/user_add.pm b/lib/Fripost/Commands/user_add.pm new file mode 100644 index 0000000..70ee638 --- /dev/null +++ b/lib/Fripost/Commands/user_add.pm @@ -0,0 +1,161 @@ +package Fripost::Commands::user_add; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +user_add - Add a new mailbox to the system + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Password; +use Fripost::Prompt; +use Fripost::Schema; +use Fripost::Email; + +our $VERSION = '0.01'; + +our @EXPORT = qw/main/; +our @ISA = qw(Exporter); + +sub assert { + my $ldap = shift; + my $username = shift; + my ($login, $domain) = split /\@/, $username, 2; + + # 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 `" .$username. "' already exists.\n" + if $ldap->user->search({ username => $username })->count; + + # Ensure that the username doesn't correspond to an existing alias. + my $res = $ldap->alias->search({ address => $username }); + if ($res->count) { + print STDERR "Error: Alias $username already exists. "; + print STDERR "(Targetting to "; + print STDERR (join ', ', map { $_->{goto} } $res->entries); + say STDERR ".)"; + exit 1; + } +} + + +sub main { + my $ldap = shift; + my $conf = shift; + + # Define the new user + my $username; + { + if (defined $_[0]) { + $username = fix_username ($_[0]); + Email::Valid->address($username) + or die "Error: $username is not a valid e-mail.\n"; + } + else { + $username = prompt_email( "New username: ", 'is_user' ); + # TODO: add the assert in the hash. + } + } + + &assert ($ldap, $username); + + + my $user; + my $clearPassword; + { + my $isActive = 'TRUE'; + my $userPassword; + if ( defined $conf->{password} ) { + $userPassword = $conf->{password}; + } + else { + $clearPassword = prompt_password(); + $userPassword = hash( $clearPassword ); + } + + $user = { + username => $username, + isActive => $isActive, + userPassword => $userPassword, + }; + + say "User name: $user->{username}"; + say "Password: (hidden)"; + + confirm_or_abort(); + } + + my $welcome = new_welcome_message ($conf, $user->{username}); + my $info; + unless (defined $conf->{password}) { + if (confirm "Send email with login information? ") { + my $to = prompt_email("Where should the email be sent? "); + $info = new_user_info_message ( $conf, $user->{username}, + $clearPassword, + $to ); + } + } + + if ($conf->{pretend}) { + say STDERR "Did not create user since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + # Insert the new user + my %user = %$user; + delete $user{clearPassword}; + $ldap->user->add(\%user); + say STDERR "New account $user{username} added."; + + # Send the prepared emails + $welcome->send(); + say "Sent welcome message (". (security_status $welcome) .")."; + + # Subscribe user to announce-list + subscribe($conf, $username, 'announce@lists.fripost.org') + if confirm("Subscribe user to announce mailing list? "); + + if (defined $info) { + $info->send(); + say "Credentials sent (". (security_status $info) .")."; + } + } +} + + +=head1 AUTHOR + +Stefan Kangas C<< >> + +Guilhem Moulin C<< >> + +=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. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of user_add.pm + +__END__ diff --git a/lib/Fripost/Commands/user_passwd.pm b/lib/Fripost/Commands/user_passwd.pm new file mode 100644 index 0000000..f443ef6 --- /dev/null +++ b/lib/Fripost/Commands/user_passwd.pm @@ -0,0 +1,89 @@ +#!/usr/bin/perl +package Fripost::Commands::user_passwd; + +use 5.010_000; +use warnings; +use strict; +use utf8; + +=head1 NAME + +user_add - Change user password + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Password; +use Fripost::Prompt; +use Fripost::Schema; + +our $VERSION = '0.01'; + +sub main { + my $ldap = shift; + my $conf = shift; + + my $username; + if (defined $_[0]) { + $username = fix_username ($_[0]); + Email::Valid->address($username) + or die "Error: `" .$username. "' is not a valid e-mail.\n"; + } + else { + $username = prompt_email("Username: ", 'is_user'); + } + + + # Ensure that the user exists. + my $domain = (split /\@/, $username, 2)[1]; + die "Error: Unknown domain `" .$domain. "'.\n" + unless $ldap->domain->search({ domain => $domain })->count; + die "Error: Unknown user `" .$username. "'.\n" + unless $ldap->user->search({ username => $username })->count; + + + my $password = $conf->{password}; + $password //= hash( prompt_password() ); + + + if ($conf->{pretend}) { + say STDERR "Did not change password since we are pretending." + if $conf->{verbose} or $conf->{debug}; + } + else { + # Change the password. + $ldap->user->passwd({ username => $username, + userPassword => $password }); + say "Updated password for $username."; + } +} + + +=head1 AUTHOR + +Stefan Kangas C<< >> + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +Copyright 2010 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. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of user_passwd.pm + +__END__ diff --git a/lib/Fripost/Commands/user_search.pm b/lib/Fripost/Commands/user_search.pm new file mode 100644 index 0000000..30ffd4d --- /dev/null +++ b/lib/Fripost/Commands/user_search.pm @@ -0,0 +1,58 @@ +package Fripost::Commands::user_search; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +user_search.pm - List matching virtual users + +=cut + +use FindBin qw($Bin); +use lib "$Bin/lib"; + +use Fripost::Schema; + +our $VERSION = '0.01'; + +our @EXPORT = qw/main/; +our @ISA = qw(Exporter); + +sub main { + my $ldap = shift; + my $conf = shift; + + my %user; + $user{username} = $_[0] if defined $_[0]; + + foreach my $user ($ldap->user->search( \%user )->entries) { + say '' . ($user->{isActive} ? 'ACTIVE' : 'INACTIVE') + . ' user ' . $user->{username}; + } +} + +=head1 AUTHOR + +Guilhem Moulin C<< >> + +=head1 COPYRIGHT + +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. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. + +=cut + +1; # End of user_search.pm + +__END__ -- cgit v1.2.3