package Fripost::Schema::Local;

=head1 NAME

Local.pm -

=head1 DESCRIPTION

Local.pm abstracts the LDAP schema definition and provides methods to
search for virtual users, aliases or lists alltogether.

=cut

use 5.010_000;
use strict;
use warnings;
use utf8;

use parent 'Fripost::Schema';
use Fripost::Schema::Util qw/concat split_addr canonical_dn/;
use Net::IDN::Encode qw/email_to_ascii email_to_unicode/;
use Net::LDAP::Util 'escape_filter_value';


=head1 METHODS

=over 4

=item B<get> (I<local>, I<OPTIONS>)

Returns a hash with all the (visible) attributes for the given entry. An
additional 'type' attribute gives the type of *the* found entry
(possible values are 'user', 'alias', and 'list').

=cut

sub get {
    my $self = shift;
    my $loc = shift;
    my %options = @_;
    my $concat = $options{'-concat'};

    my ($l,$d) = split_addr( $loc, -encode => 'ascii' );
    $l = escape_filter_value($l);
    my $locals = $self->ldap->search(
                     base => canonical_dn({fvd => $d}, @{$self->suffix}),
                     scope => 'one',
                     deref => 'never',
                     filter => "(|(&(objectClass=FripostVirtualUser)(fvu=$l))
                                  (&(objectClass=FripostVirtualAlias)(fva=$l))
                                  (&(objectClass=FripostVirtualList)(fvl=$l)))",
                     attrs => [ qw/fvu description
                                   fripostIsStatusActive
                                   fripostOptionalMaildrop
                                   fripostUserQuota
                                   fva fripostMaildrop
                                   fvl fripostListManager/ ]
    );
    if ($locals->code) {
        die $options{'-die'}."\n" if defined $options{'-die'};
        die $locals->error."\n";
    }

    # The following is not supposed to happen. Note that there is
    # nothing in the LDAP schema to prevent that, but it's not too
    # critical as Postfix searchs for user, aliases and lists in
    # that order.
    die "Error: Multiple matching entries found." if $locals->count > 1;
    my $local = $locals->pop_entry;

    unless (defined $local) {
        die $options{'-die'}."\n" if defined $options{'-die'};
        die "No such such entry ‘".$loc."’.\n";
    }

    my %ret;
    if ($local->dn =~ /^fvu=/) {
        $ret{type} = 'user';
        $ret{user} = $local->get_value('fvu');
        $ret{forwards} = concat($concat, map { email_to_unicode($_) }
                                         $local->get_value('fripostOptionalMaildrop'))
    }
    elsif ($local->dn =~ /^fva=/) {
        $ret{type} = 'alias';
        $ret{alias} = $local->get_value('fva');
        $ret{maildrop} = concat($concat, map { email_to_unicode($_) }
                                         $local->get_value('fripostMaildrop'))
    }
    elsif ($local->dn =~ /^fvl=/) {
        $ret{type} = 'list';
        $ret{list} = $local->get_value('fvl');
        $ret{transport} = $local->get_value('fripostListManager');
    }
    $ret{isactive} = $local->get_value('fripostIsStatusActive') eq 'TRUE';
    $ret{description} = concat($concat, $local->get_value('description'));
    $ret{ispending} = ($local->get_value('fripostIsStatusPending') // '') eq 'TRUE';

    return %ret;
}


=item B<exists> (I<local>, I<OPTIONS>)

Returns 1 if the given I<local>@I<domain> exists, and 0 otherwise.
The authenticated user needs to have search access to the 'entry'
attribute.

=cut

sub exists {
    my $self = shift;
    my ($l,$d) = split_addr( shift, -encode => 'ascii' );
    my %options = @_;

    # We may not have read access to the list commands
    # The trick is somewhat dirty, but it's safe enough since postfix
    # delivers to users, aliases, and lists with different
    # priorities (and lists have the lowest).
    my @cmds = qw/admin bounces confirm join leave owner request
                  subscribe unsubscribe bounce sendkey/;
    my @tests = ( {fvu => $l}, {fva => $l}, {fvl => $l} );

    foreach (@cmds) {
        # If the entry is of the form 'foo-command', we need to ensure
        # that no list 'foo' exists, otherwise the new entry would
        # override foo's command.
        if ($l =~ s/-$_$//) {
            push @tests, {fvl => $l};
            last;
        }
    }
    if (defined $options{t} and $options{t} eq 'list') {
        # If that's a list that is to be created, we need to ensure that
        # none of its commands exists.
        foreach (@cmds) {
            my $l2 = $l.'-'.$_;
            push @tests, {fvu => $l2}, {fva => $l2};
        }
    }

    foreach (@tests) {
        my $dn = canonical_dn($_, {fvd => $d}, @{$self->suffix});
        my $mesg = $self->ldap->search( base => $dn
                                      , scope => 'base'
                                      , deref => 'never'
                                      , filter => 'objectClass=*'
                                      , attrs => []
        );
        return 1 unless $mesg->code; # 0  Success
        unless ($mesg->code == 32) { # 32 No such object
            die $options{'-die'}."\n" if defined $options{'-die'};
            die $mesg->error."\n";
        }

    }
    return 0;
}

=back

=head1 GLOBAL OPTIONS

If the B<-concat> option is present, it will intersperse multi-valued
attributes. Otherwise, an array reference containing every values will
be returned for these attributes.

The B<-die> option, if present, overides LDAP croaks and errors.

=cut


=head1 AUTHOR

Guilhem Moulin C<< <guilhem at fripost.org> >>

=head1 COPYRIGHT

Copyright 2012,2013 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

1;

__END__