#----------------------------------------------------------------------
# Fripost tools - backend library
# Copyright © 2012-2018 Fripost
# Copyright © 2012-2018 Guilhem Moulin <guilhem@fripost.org>
#
# This program is free software: you can redistribute it and/or modify it
# under the terms of the GNU Affero General Public License as published by
# the Free Software Foundation, either version 3 of the License, or (at your
# option) any later version.
#
# 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.  See the GNU Affero General Public
# License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program.  If not, see <http://www.gnu.org/licenses/>.
#----------------------------------------------------------------------

package Fripost v0.0.1;
use warnings;
use strict;

use Net::LDAP ();
use Net::LDAP::Constant qw/LDAP_SUCCESS LDAP_INVALID_CREDENTIALS/;
use Net::LDAP::Extension::WhoAmI ();
use Net::LDAP::Util "escape_dn_value";
use Net::IDN::Encode "domain_to_ascii";


########################################################################
#

# new(OPTION => VALUE)
#   Create a new Fripost object.
sub new($%) {
    my $class = shift;
    my %conf = @_;
    my $uri = $conf{ldap}->{uri} // die;
    my $fpr = $conf{ldap}->{"ssl-fingerprint"};

    my %args = ( raw => qr/(?:^fripostOpenPGPKeyring\b|;binary$)/i );
    $args{verify} //= ($uri =~ /\Aldaps:\/\// and not defined $fpr) ? "require" : "none";
    my $ldap = Net::LDAP::->new($uri, %args) // die "LDAP connection to $uri failed";

    if (defined $fpr) {
        my $cert = $ldap->certificate->peer_certificate;
        die("Aborting LDAP connection to $uri: fingerprint mismatch")
            unless $fpr->( Net::SSLeay::X509_get_X509_PUBKEY($cert) );
    }
    undef $conf{ldap}->{suffix} if ($conf{ldap}->{suffix} // "") eq "";
    bless {_ldap => $ldap, _config => \%conf}, $class;
}

sub DESTROY {
    my $ldap = shift->{_ldap} // return;
    $ldap->unbind();
}

# croak(FORMAT, [ARG..])
#   Format the message and throw an exception.
sub croak($$@) {
    my $self = shift;
    my $format = shift;
    if (defined (my $throw = $self->{_config}->{onerror})) {
        $throw->($format, @_);
    } else {
        $format =~ s/[A-Z]<(%\p{PosixAlpha})>/$1/g; # Remove all markup
        die sprintf("Error: ".$format, @_);
    }
}

# login(USER@DOMAIN, PASSWORD)
#   Login to the LDAP backend (with a simple bind).  LDAP errors other
#   than 49 (INVALID_CREDENTIALS) are treated as internal backend
#   errors and shown to the user.
sub login($$$) {
    my ($self, $username, $password) = @_;

    # convert IDNA domain names to ASCII
    my ($l, $d) = ($1, $2)
        if $username =~ /\A(\p{ASCII}*)[\@\N{U+FE6B}\N{U+FF20}](.*)\z/;
    eval { $d = domain_to_ascii($d) if defined $d and $d =~ /\P{ASCII}/ };
    $self->croak("Invalid username: C<%s>\n", $username // "")
        if $@ or ($l // "") eq "" or ($d // "") eq "";

    my $dn = "fvl=".escape_dn_value($l).",fvd=".escape_dn_value($d);
    $dn .= ",".$self->{_config}->{ldap}->{suffix}
        if defined $self->{_config}->{ldap}->{suffix};

    my $r = $self->{_ldap}->bind($dn, password => $password);
    if ($r->code == LDAP_INVALID_CREDENTIALS) {
        $self->croak("Invalid username or password.\n");
    } elsif ($r->code != LDAP_SUCCESS) {
        $self->croak("LDAP error code %i: %s\n", $r->code, $r->error);
    }
}

# whoami()
#   Perform the LDAP "Who Am I?" (RFC 4532) extended operation.
sub whoami($) {
    my $self = shift;

    my $dse = $self->{_ldap}->root_dse();
    $self->croak("LDAP server doesn't support \"Who am I?\" operation.")
        unless $dse->supported_extension("1.3.6.1.4.1.4203.1.11.3");

    my $r = $self->{_ldap}->who_am_i();
    $self->croak("LDAP error code %i: %s\n", $r->code, $r->error)
        unless $r->code == LDAP_SUCCESS;
    return $r->response();
}

1;