aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Fripost.pm114
-rw-r--r--lib/Fripost/Session.pm122
-rw-r--r--lib/Fripost/Util.pm90
3 files changed, 326 insertions, 0 deletions
diff --git a/lib/Fripost.pm b/lib/Fripost.pm
new file mode 100644
index 0000000..93531f9
--- /dev/null
+++ b/lib/Fripost.pm
@@ -0,0 +1,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 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 General Public License for more details.
+#
+# You should have received a copy of the GNU 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;
diff --git a/lib/Fripost/Session.pm b/lib/Fripost/Session.pm
new file mode 100644
index 0000000..888385f
--- /dev/null
+++ b/lib/Fripost/Session.pm
@@ -0,0 +1,122 @@
+#----------------------------------------------------------------------
+# Fripost admin panel - ephemeral sessions
+# Copyright © 2018 Fripost
+# Copyright © 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 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+#----------------------------------------------------------------------
+
+package Fripost::Session v0.0.1;
+use warnings;
+use strict;
+
+use Authen::SASL ();
+use Net::LDAP::Constant qw/LDAP_SUCCESS LDAP_ALREADY_EXISTS/;
+use Net::LDAP::Extension::Refresh ();
+use Net::LDAP::Util "escape_dn_value";
+
+use Crypt::URandom "urandom";
+
+use Fripost ();
+
+
+# create(Fripost object)
+# Create a new ephemeral session from a Fripost object, and return
+# suitable credentials for later SASL proxy authorization.
+sub create($$) {
+ my ($class, $fp) = @_;
+
+ # don't base64-encode but hex-encode as the commonName is case-insensitive
+ my $id = unpack("H*", urandom(16));
+ my $dn = sprintf($fp->{_config}->{ldap}->{"session-authcDN"},
+ escape_dn_value($id));
+ # hex-encode the password too since we can't have NUL bytes in the SASL packet
+ my $password = unpack("H*", urandom(16));
+
+ my $authzid = $fp->whoami() // die;
+ die "Invalid identity: $authzid\n" unless $authzid =~ /\Adn:/;
+
+ my @attrs = (objectClass => [ qw/organizationalRole simpleSecurityObject dynamicObject/ ]);
+ # libsasl2 requires {CLEARTEXT} passwords, even for PLAIN, cf.
+ # https://openldap.org/lists/openldap-technical/201310/msg00007.html
+ # (not a big deal here though since our shared secrets are internal
+ # and ephemeral)
+ push @attrs, userPassword => ( "{CLEARTEXT}" . $password );
+
+ my $r = $fp->{_ldap}->add($dn, attrs => \@attrs);
+ if ($r->code == LDAP_ALREADY_EXISTS) {
+ # try to delete the entry (we're not allowed to modify existing entries)
+ my $r2 = $fp->{_ldap}->delete($dn);
+ $r = $fp->{_ldap}->add($dn, attrs => \@attrs)
+ if $r2->code == LDAP_SUCCESS;
+ }
+ $fp->croak("LDAP error code %i: %s\n", $r->code, $r->error)
+ unless $r->code == LDAP_SUCCESS;
+
+ my %creds = (authcid => $id, password => $password, authzid => $authzid);
+ bless \%creds, $class;
+}
+
+# authenticate(CREDENTIALS, OPTION => VALUE, ..)
+# Create a new Fripost object and return it after authentication
+# (using SASL proxy authorization with the ephemeral credentials).
+# If the "refresh" is set (the default), then TTL value of the entry
+# on the backup is refreshed.
+sub authenticate($%) {
+ my $creds = shift;
+ my %conf = @_;
+
+ my $refresh = delete $conf{refresh} // 1;
+ my $authcid = sprintf($conf{ldap}->{"session-authcID"} // "%s",
+ $creds->{authcid});
+
+ my $sasl = Authen::SASL::->new( mechanism => "PLAIN", callback => {
+ user => $authcid
+ , pass => $creds->{password}
+ , authname => $creds->{authzid}
+ }) or die "Creation of Authen::SASL object failed";
+
+ my $fp = Fripost::->new(%conf);
+ my $r = $fp->{_ldap}->bind(undef, sasl => $sasl);
+ $fp->croak("LDAP error code %i: %s\n", $r->code, $r->error)
+ unless $r->code == LDAP_SUCCESS;
+
+ if ($refresh) {
+ my $dn = sprintf($conf{ldap}->{"session-authcDN"} // "%s",
+ escape_dn_value($creds->{authcid}));
+ my $ttl = $conf{www}->{"cache-expires"};
+ $r = $fp->{_ldap}->refresh(entryName => $dn, requestTtl => $ttl);
+ $fp->croak("LDAP error code %i: %s\n", $r->code, $r->error)
+ unless $r->code == LDAP_SUCCESS;
+ }
+ return $fp;
+}
+
+# authenticate(CREDENTIALS, OPTION => VALUE, ..)
+# Create a new Fripost object, authenticate (using SASL proxy
+# authorization), and delete the entry on the LDAP backend.
+sub destroy($%) {
+ my $creds = shift;
+ my %conf = @_;
+
+ my $dn = sprintf($conf{ldap}->{"session-authcDN"} // "%s",
+ escape_dn_value($creds->{authcid}));
+
+ my $fp = authenticate($creds, %conf, refresh => 0);
+ my $r = $fp->{_ldap}->delete($dn);
+ $fp->croak("LDAP error code %i: %s\n", $r->code, $r->error)
+ unless $r->code == LDAP_SUCCESS;
+}
+
+1;
diff --git a/lib/Fripost/Util.pm b/lib/Fripost/Util.pm
new file mode 100644
index 0000000..6fa55a5
--- /dev/null
+++ b/lib/Fripost/Util.pm
@@ -0,0 +1,90 @@
+#----------------------------------------------------------------------
+# Fripost utils
+# Copyright © 2018 Fripost
+# Copyright © 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 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 General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program. If not, see <http://www.gnu.org/licenses/>.
+#----------------------------------------------------------------------
+
+package Fripost::Util v0.0.1;
+use warnings;
+use strict;
+
+use Config::Tiny ();
+use MIME::Base64 qw/encode_base64 decode_base64/;
+
+use Exporter "import";
+BEGIN {
+ our @EXPORT_OK = qw/read_config session_cache/;
+}
+
+
+# read_config()
+# Read the configuration file.
+sub read_config() {
+ my $filename = "./config.ini";
+ my $h = Config::Tiny::->read($filename, "utf8");
+ die Config::Tiny::->errstr(), "\n" unless defined $h;
+
+ my $ldap = $h->{ldap} // die "Missing [ldap] section";
+ $ldap->{uri} //= "ldapi://";
+
+ # replace "ssl-fingerprint" with a function taking an SPKI and
+ # verifying its fingerprint
+ my $fpr = delete $ldap->{"ssl-fingerprint"}
+ if $ldap->{uri} =~ /\Aldaps:\/\//;
+ if (defined $fpr) {
+ die "Invalid value: $fpr" unless $fpr =~ s/\A([A-Za-z0-9]+)=//;
+ my $algo = $1;
+
+ my $digest = decode_base64($fpr);
+ die "Invalid base64 value: $fpr\n"
+ # decode_base64() silently ignores invalid characters so we
+ # re-encode the output to validate it
+ unless encode_base64($digest, "") eq $fpr and $fpr ne "";
+
+ require "Net/SSLeay.pm";
+ my $type = Net::SSLeay::EVP_get_digestbyname($algo) or
+ die "Can't find MD value for name '$algo'";
+ $ldap->{"ssl-fingerprint"} = sub($) {
+ my $pkey = shift // return 0;
+ return (Net::SSLeay::EVP_Digest($pkey, $type) eq $digest) ? 1 : 0;
+ };
+ }
+
+ $h->{www} //= {};
+ $h->{www}->{"cache-expires"} //= "3600";
+ return %$h;
+}
+
+
+# session_cache(%CONFIG)
+# Define a new CHI object for the server-side session store.
+sub session_cache(%) {
+ my %www_config = @_;
+ require "CHI.pm";
+
+ my %cache_opts;
+ $cache_opts{root_dir} = $www_config{"cache-directory"};
+ $cache_opts{dir_create_mode} = 0700;
+ $cache_opts{namespace} = "fripost";
+
+ CHI->new(
+ driver => "FastMmap" # use Cache::FastMmap
+ , %cache_opts
+ , expires_in => $www_config{"cache-expires"}
+ );
+}
+
+1;
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-29 15:04:32 +0000