#---------------------------------------------------------------------- # Fripost utils # Copyright © 2018 Fripost # Copyright © 2018 Guilhem Moulin # # 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 . #---------------------------------------------------------------------- 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;