aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Fripost/Util.pm
blob: 793d034262750bdfd1a9672896f63dc9bc8a2d61 (plain)
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
#----------------------------------------------------------------------
# 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 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::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;