1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
|
#----------------------------------------------------------------------
# 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;
|
