blob: 63b8d0f10270de0202b5efcba9d50dae37a5d788 (
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
|
#! /usr/bin/env perl
# Copyright 2012, Matthias Andreas Benkard <code@mail.matthias.benkard.de>.
use common::sense;
#use Modern::Perl 2011;
use Modern::Perl;
use Mail::ExpandAliases;
use URI;
use MIME::Base64 qw(encode_base64 decode_base64);
sub load_config() {
$::MULKONF = { };
do "config.pl";
}
sub email_users($) {
my ($email) = @_;
my $fakedomain = $::MULKONF->{fake_domain};
my $realdomain = $::MULKONF->{real_domain};
$email =~ s/\@$realdomain/\@$fakedomain/ if $fakedomain;
return ($email)
if $::MULKONF->{auth_type} eq 'google';
my $alias;
if ($email =~ /^(.*?)@/) { $alias = $1; }
my $aliases_file = $::MULKONF->{aliases};
if (not ($aliases_file eq ".")) {
my $aliases = Mail::ExpandAliases->new($aliases_file);
my $email_users = $aliases->expand($alias) or die "User not found";
return @$email_users;
} else {
return ($alias);
}
}
sub reluri($$) {
my ($cgi, $x) = @_;
my $uri = "https://" . $::MULKONF->{real_domain} . $::MULKONF->{basepath} . "/$x";
return "$uri";
}
sub decode_base64_url($) {
# From: https://github.com/ptarjan/base64url/blob/master/perl.pl
(my $s = shift) =~ tr{-_}{+/};
$s .= '=' x (4 - length($s));
return decode_base64($s);
}
sub encode_base64_url($) {
my ($s) = shift;
$s = encode_base64($s);
$s =~ tr{+/}{-_};
$s =~ s/=*$//;
$s =~ s/\n//g;
return $s;
}
|