From c3af385908866291109afb8cf8779da555a9922a Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sun, 2 Sep 2018 04:57:06 +0200
Subject: Simple login screen.

---
 lib/Fripost/Util.pm | 90 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 90 insertions(+)
 create mode 100644 lib/Fripost/Util.pm

(limited to 'lib/Fripost/Util.pm')

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;
-- 
cgit v1.2.3