From ccc5ce7bf9abe341119acb0aa4a8a138add41dc7 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Tue, 5 Jun 2012 09:49:33 +0200 Subject: Changing the command names to something more intuitive (hopefully). --- TODO.org | 12 +-- fripost | 88 +++++++++---------- lib/Fripost/Commands/add_alias.pm | 133 ++++++++++++++++++++++++++++ lib/Fripost/Commands/add_domain.pm | 150 +++++++++++++++++++++++++++++++ lib/Fripost/Commands/add_user.pm | 161 ++++++++++++++++++++++++++++++++++ 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/search_alias.pm | 80 +++++++++++++++++ lib/Fripost/Commands/search_domain.pm | 60 +++++++++++++ lib/Fripost/Commands/search_user.pm | 58 ++++++++++++ lib/Fripost/Commands/user_add.pm | 161 ---------------------------------- lib/Fripost/Commands/user_passwd.pm | 2 +- lib/Fripost/Commands/user_search.pm | 58 ------------ lib/Fripost/Schema.pm | 3 - 16 files changed, 693 insertions(+), 696 deletions(-) create mode 100644 lib/Fripost/Commands/add_alias.pm create mode 100644 lib/Fripost/Commands/add_domain.pm create mode 100644 lib/Fripost/Commands/add_user.pm delete mode 100644 lib/Fripost/Commands/alias_add.pm delete mode 100644 lib/Fripost/Commands/alias_search.pm delete mode 100644 lib/Fripost/Commands/domain_add.pm delete mode 100644 lib/Fripost/Commands/domain_search.pm create mode 100644 lib/Fripost/Commands/search_alias.pm create mode 100644 lib/Fripost/Commands/search_domain.pm create mode 100644 lib/Fripost/Commands/search_user.pm delete mode 100644 lib/Fripost/Commands/user_add.pm delete mode 100644 lib/Fripost/Commands/user_search.pm diff --git a/TODO.org b/TODO.org index 4f720c7..6b9d830 100644 --- a/TODO.org +++ b/TODO.org @@ -8,11 +8,11 @@ ** TODO Detect cycles when creating aliases. (E.g., a->b, b->a should not be allowed.) ** TODO Add a subroutine is_email_valid with options (e.g., `allow_empty_login'), and add options to prompt_email (e.g., `allow_list', `allow_empty_login', `ensure_domain_known', `ensure_user_known', `allow_empty_user'). ** DONE Merge the tools into a single executable. -*** fripost-adduser -> fripost user-add +*** fripost-adduser -> fripost add-user *** fripost-mkpass -> fripost mkpass -*** fripost-newalias -> fripost alias-add -*** fripost-newdomain -> fripost domain-add +*** fripost-newalias -> fripost add-alias +*** fripost-newdomain -> fripost add-domain *** fripost-passwd -> fripost user-passwd -*** fripost-searchalias -> fripost alias-search -*** fripost-searchdomain -> fripost domain-search -*** fripost-searchuser -> fripost user-search +*** fripost-searchalias -> fripost search-alias +*** fripost-searchdomain -> fripost search-domain +*** fripost-searchuser -> fripost search-user diff --git a/fripost b/fripost index e9e27e7..5a80d70 100755 --- a/fripost +++ b/fripost @@ -13,8 +13,8 @@ fripost - Fripost.org handling utility for virtual hosting =head1 SYNOPSIS -B [I] { mkpass | user-add | user-search | user-passwd -| domain-add | domain-search | alias-add | alias-search } +B [I] { mkpass | add-user | search-user | user-passwd +| add-domain | search-domain | add-alias | search-alias } B B<--man> @@ -26,11 +26,11 @@ B B<--man> Create a random new password, and returns its hash. -=item B user-add [I] [B<--password=>I] +=item B add-user [I] [B<--password=>I] Add a new virtual mailbox. -=item B user-search [I] +=item B search-user [I] List matching virtual users. @@ -38,19 +38,19 @@ List matching virtual users. Change user password. -=item B domain-add [I [I]] +=item B add-domain [I [I]] Add a new virtual domain. -=item B domain-search [I [I]] +=item B search-domain [I [I]] List matching virtual domains. -=item B alias-add [B<--force>] [I [I...]] +=item B add-alias [B<--force>] [I [I...]] Add a new virtual alias. -=item B alias-search [B<-f>|B<--from>] [B<-g>|B<--goto>] [I
] +=item B search-alias [B<-f>|B<--from>] [B<-g>|B<--goto>] [I
] List matching virtual aliases. @@ -69,9 +69,9 @@ C is used to generate a salted SHA-1 hash of the given I. If no argument is given, the password is randomly generated, respecting Fripost's password policy. -=item B user-add [I] [B<--password=>I] +=item B add-user [I] [B<--password=>I] -C is used to add a new virtual mailbox to the system, unless +C is used to add a new virtual mailbox to the system, unless B<--pretend> is set. If I or I are not given, the user is prompted for their value. @@ -84,16 +84,16 @@ 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 user-search [I] +=item B search-user [I] -C is used to +C is used to list virtual mailboxes whose username matches exactly I. Wildcards I<*> can appear in I, to match zero or more characters. If no I is given, lists all existing mailboxes. -If I has no domain part, C lists matching users for any +If I has no domain part, C lists matching users for any domains. -Otherwise, C looks up the matching user parts for each matching +Otherwise, C looks up the matching user parts for each matching domain. Because of these multiple searches, the use of wildcards on the domain part of I may be inefficient. @@ -111,31 +111,31 @@ 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 domain-add [I [I]] +=item B add-domain [I [I]] -C is used add a new virtual domain to the system, unless +C is used add a new virtual domain to the system, unless B<--pretend> is set. If I is not given, the user is prompted for its value. -By default, C prompts for the owner(s) of the new +By default, C prompts for the owner(s) of the new domain; Use the empty string I<''> to create a "global" domain, only managed by Fripost's administrators. If I is an existing virtual domain, the owner(s) are simply added to the list of managers. -=item B domain-search [I [I]] +=item B search-domain [I [I]] -C is used to list virtual domains matching exactly I, +C is used to list virtual domains matching exactly I, and whose owner is I. Wildcards I<*> can appear in I, to match zero or more characters. If no I is given, list all domains matching I, regardless of the owner; If I is the empty string I<''>, list only the non self-managed domains. -If neither I nor I are given, C lists +If neither I nor I are given, C lists all existing virtual domains. -=item B alias-add [B<--force>] [I [I...]] +=item B add-alias [B<--force>] [I [I...]] -C is used to add a new virtual alias to the system, unless +C is used to add a new virtual alias to the system, unless B<--pretend> is set. If I or I are not given, the user is prompted for their value. @@ -166,18 +166,18 @@ See B(5) for details and warnings. If serveral entries are matching, for instance if there are an alias from I@I to I and another for I@I to I, emails to I@I will be redirected to BOTH I -and I. Note that C forbids the creation of such +and I. Note that C forbids the creation of such multi-recipient aliases, unless B<--force> is set. -=item B alias-search [B<-f>|B<--from>] [B<-g>|B<--goto>] [I
] +=item B search-alias [B<-f>|B<--from>] [B<-g>|B<--goto>] [I
] -C is used to list virtual aliases whose value or target +C is used to list virtual aliases whose value or target matches exactly I
. As of the current version, wilcards are not allowed in I
; This will be fixed soon. To list matching aliases (resp., targets) only, use the flag B<-f> (resp., B<-g>). -If no I
is given, C lists all existing virtual +If no I
is given, C lists all existing virtual aliases. =back @@ -315,13 +315,13 @@ use YAML::Syck; use Fripost::Schema; use Fripost::Commands::mkpass; -use Fripost::Commands::user_add; -use Fripost::Commands::user_search; +use Fripost::Commands::add_user; +use Fripost::Commands::search_user; use Fripost::Commands::user_passwd; -use Fripost::Commands::domain_add; -use Fripost::Commands::domain_search; -use Fripost::Commands::alias_add; -use Fripost::Commands::alias_search; +use Fripost::Commands::add_domain; +use Fripost::Commands::search_domain; +use Fripost::Commands::add_alias; +use Fripost::Commands::search_alias; ## Get global command line options @@ -372,26 +372,26 @@ if ($cmd eq 'mkpass') { &Fripost::Commands::mkpass::main (@ARGV); exit 0; } -elsif ($cmd eq 'user-add') { - $main = "Fripost::Commands::user_add::main"; +elsif ($cmd eq 'add-user') { + $main = "Fripost::Commands::add_user::main"; } -elsif ($cmd eq 'user-search') { - $main = "Fripost::Commands::user_search::main"; +elsif ($cmd eq 'search-user') { + $main = "Fripost::Commands::search_user::main"; } elsif ($cmd eq 'user-passwd') { $main = "Fripost::Commands::user_passwd::main"; } -elsif ($cmd eq 'domain-add') { - $main = "Fripost::Commands::domain_add::main"; +elsif ($cmd eq 'add-domain') { + $main = "Fripost::Commands::add_domain::main"; } -elsif ($cmd eq 'domain-search') { - $main = "Fripost::Commands::domain_search::main"; +elsif ($cmd eq 'search-domain') { + $main = "Fripost::Commands::search_domain::main"; } -elsif ($cmd eq 'alias-add') { - $main = "Fripost::Commands::alias_add::main"; +elsif ($cmd eq 'add-alias') { + $main = "Fripost::Commands::add_alias::main"; } -elsif ($cmd eq 'alias-search') { - $main = "Fripost::Commands::alias_search::main"; +elsif ($cmd eq 'search-alias') { + $main = "Fripost::Commands::search_alias::main"; } else { pod2usage( -exitstatus => 1, diff --git a/lib/Fripost/Commands/add_alias.pm b/lib/Fripost/Commands/add_alias.pm new file mode 100644 index 0000000..7155368 --- /dev/null +++ b/lib/Fripost/Commands/add_alias.pm @@ -0,0 +1,133 @@ +package Fripost::Commands::add_alias; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +add_alias - 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 add_alias.pm + +__END__ diff --git a/lib/Fripost/Commands/add_domain.pm b/lib/Fripost/Commands/add_domain.pm new file mode 100644 index 0000000..4d53e35 --- /dev/null +++ b/lib/Fripost/Commands/add_domain.pm @@ -0,0 +1,150 @@ +package Fripost::Commands::add_domain; + +use 5.010_000; +use warnings; +use strict; +use utf8; + +=head1 NAME + +add_domain - 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 add_domain.pm + +__END__ diff --git a/lib/Fripost/Commands/add_user.pm b/lib/Fripost/Commands/add_user.pm new file mode 100644 index 0000000..4e1cf10 --- /dev/null +++ b/lib/Fripost/Commands/add_user.pm @@ -0,0 +1,161 @@ +package Fripost::Commands::add_user; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +add_user - 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 add_user.pm + +__END__ diff --git a/lib/Fripost/Commands/alias_add.pm b/lib/Fripost/Commands/alias_add.pm deleted file mode 100644 index f86b1f7..0000000 --- a/lib/Fripost/Commands/alias_add.pm +++ /dev/null @@ -1,133 +0,0 @@ -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 deleted file mode 100644 index 6e638ac..0000000 --- a/lib/Fripost/Commands/alias_search.pm +++ /dev/null @@ -1,80 +0,0 @@ -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 deleted file mode 100644 index a727623..0000000 --- a/lib/Fripost/Commands/domain_add.pm +++ /dev/null @@ -1,150 +0,0 @@ -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 deleted file mode 100644 index 8aaf775..0000000 --- a/lib/Fripost/Commands/domain_search.pm +++ /dev/null @@ -1,60 +0,0 @@ -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/search_alias.pm b/lib/Fripost/Commands/search_alias.pm new file mode 100644 index 0000000..fc1959d --- /dev/null +++ b/lib/Fripost/Commands/search_alias.pm @@ -0,0 +1,80 @@ +package Fripost::Commands::search_alias; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +search_alias.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 search_alias.pm + +__END__ diff --git a/lib/Fripost/Commands/search_domain.pm b/lib/Fripost/Commands/search_domain.pm new file mode 100644 index 0000000..9c47d43 --- /dev/null +++ b/lib/Fripost/Commands/search_domain.pm @@ -0,0 +1,60 @@ +package Fripost::Commands::search_domain; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +search_domain.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 search_domain.pm + +__END__ diff --git a/lib/Fripost/Commands/search_user.pm b/lib/Fripost/Commands/search_user.pm new file mode 100644 index 0000000..f476a98 --- /dev/null +++ b/lib/Fripost/Commands/search_user.pm @@ -0,0 +1,58 @@ +package Fripost::Commands::search_user; + +use 5.010_000; +use strict; +use warnings; +use utf8; + +=head1 NAME + +search_user.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 search_user.pm + +__END__ diff --git a/lib/Fripost/Commands/user_add.pm b/lib/Fripost/Commands/user_add.pm deleted file mode 100644 index 70ee638..0000000 --- a/lib/Fripost/Commands/user_add.pm +++ /dev/null @@ -1,161 +0,0 @@ -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 index f443ef6..805b7e1 100644 --- a/lib/Fripost/Commands/user_passwd.pm +++ b/lib/Fripost/Commands/user_passwd.pm @@ -8,7 +8,7 @@ use utf8; =head1 NAME -user_add - Change user password +user_passwd - Change user password =cut diff --git a/lib/Fripost/Commands/user_search.pm b/lib/Fripost/Commands/user_search.pm deleted file mode 100644 index 30ffd4d..0000000 --- a/lib/Fripost/Commands/user_search.pm +++ /dev/null @@ -1,58 +0,0 @@ -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__ diff --git a/lib/Fripost/Schema.pm b/lib/Fripost/Schema.pm index f8649b7..72a7484 100755 --- a/lib/Fripost/Schema.pm +++ b/lib/Fripost/Schema.pm @@ -30,9 +30,6 @@ sub new { my $class = shift; my $h = shift; - $h->{server_host} //= 'ldap://127.0.0.1:389'; - $h->{base_dn} //= ''; - my $self = {_options => $h}; bless $self, $class; -- cgit v1.2.3