1 files changed, 122 insertions, 0 deletions
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;