/usr/share/perl5/LookupMap.pm is in dkimproxy 1.4.1-3.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 | #
# This file is part of DKIMproxy, an SMTP-proxy implementing DKIM.
# Copyright (c) 2005-2008 Messiah College.
# Written by Jason Long <jlong@messiah.edu>.
#
# 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 2
# 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, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor,
# Boston, MA 02110-1301, USA.
#
use strict;
use warnings;
package LookupMap;
=head1 NAME
LookupMap - query a Dkimproxy-compatible lookup table
=head1 SYNOPSIS
my $map = LookupMap->load("/path/to/mapfile");
my $result = $map->lookup(
=head1 CONSTRUCTOR
=head2 load() - load a lookup table
my $map = LookupMap->load("/path/to/mapfile");
my $result = $map->lookup_address('bob@example.org');
=cut
sub load
{
my $class = shift;
my ($mapfile) = @_;
unless (-f $mapfile)
{
die "Error: $mapfile: file not found\n";
}
my $self = bless { file => $mapfile }, $class;
$self->read_map();
return $self;
}
=head1 METHODS
=head2 lookup_address() - find an address in a map file
my ($result, $key) = $map->lookup_address('bob@example.com');
The address is an email address. this function looks first for
the full email address, and if not found, tries more and more
general forms of the email addresses
The result is a two element list. The first element is the result
found in the map. The second element is the key by which the value
was found. E.g. if you looked up bob@example.com but the map only
had an entry for example.com, the key would be example.com.
=cut
sub lookup_address
{
my $self = shift;
my ($address) = @_;
$address = lc $address;
my @lookup_keys = ($address);
if ($address =~ s/\+(.*)\@//)
{
# local part of address has a extension, lookup same
# address without extension
# e.g. jason+extra@long.name => jason@long.name
push @lookup_keys, $address;
}
if ($address =~ s/^(.*)\@//)
{
# lookup just the domain of the address
push @lookup_keys, $address;
}
while ($address =~ s/^([^.]+\.)//)
{
# domain has at least two parts, try again with
# the first part removed
push @lookup_keys, $address;
}
# a catch-all key
push @lookup_keys, ".";
return $self->lookup(\@lookup_keys);
}
=head2 lookup() - lookup a raw value in the map file
my $result = $map->lookup('10.20.30.40');
my ($result, $key) = $map->lookup([ '10.20.30.40', '10.20.30', '10.20', '10' ]);
=cut
sub lookup
{
my $self = shift;
my ($keys_arrayref) = @_;
$keys_arrayref = [ $keys_arrayref ] if not ref $keys_arrayref;
my $map = $self->{map};
foreach my $key (@$keys_arrayref)
{
my $result = $map->{$key};
if (defined $result)
{
if (wantarray)
{
return ($result, $key);
}
else
{
return $result;
}
}
}
return;
}
# read_map() - private function - reads the map file into memory
#
# this function loads the map file and reads it into a hash.
#
sub read_map
{
my $self = shift;
open my $fh, "<", $self->{file}
or die "Error: cannot read $self->{file}: $!\n";
my $map = {};
while (<$fh>)
{
chomp;
next if /^\s*$/;
next if /^\s*[#;]/;
if (/^(\S+)\s+(.*)$/)
{
$map->{$1} = $2;
}
}
close $fh;
$self->{map} = $map;
return;
}
1;
|