File Coverage

blib/lib/Mail/SpamAssassin/Conf/LDAP.pm
Criterion Covered Total %
statement 12 85 14.1
branch 0 18 0.0
condition 0 12 0.0
subroutine 4 10 40.0
pod 1 5 20.0
total 17 130 13.0


line stmt bran cond sub pod time code
1             # <@LICENSE>
2             # Licensed to the Apache Software Foundation (ASF) under one or more
3             # contributor license agreements. See the NOTICE file distributed with
4             # this work for additional information regarding copyright ownership.
5             # The ASF licenses this file to you under the Apache License, Version 2.0
6             # (the "License"); you may not use this file except in compliance with
7             # the License. You may obtain a copy of the License at:
8             #
9             # http://www.apache.org/licenses/LICENSE-2.0
10             #
11             # Unless required by applicable law or agreed to in writing, software
12             # distributed under the License is distributed on an "AS IS" BASIS,
13             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
14             # See the License for the specific language governing permissions and
15             # limitations under the License.
16             # </@LICENSE>
17              
18             =head1 NAME
19              
20             Mail::SpamAssassin::Conf::LDAP - load SpamAssassin scores from LDAP database
21              
22             =head1 SYNOPSIS
23              
24             (see Mail::SpamAssassin)
25              
26              
27             =head1 DESCRIPTION
28              
29             Mail::SpamAssassin is a module to identify spam using text analysis and
30             several internet-based realtime blacklists.
31              
32             This class is used internally by SpamAssassin to load scores from an LDAP
33             database. Please refer to the C<Mail::SpamAssassin> documentation for public
34             interfaces.
35              
36             =head1 METHODS
37              
38             =over 4
39              
40             =cut
41              
42             package Mail::SpamAssassin::Conf::LDAP;
43              
44 40     40   294 use Mail::SpamAssassin::Logger;
  40         89  
  40         2281  
45              
46 40     40   246 use strict;
  40         80  
  40         777  
47 40     40   198 use warnings;
  40         81  
  40         1008  
48             # use bytes;
49 40     40   209 use re 'taint';
  40         84  
  40         33749  
50              
51             our @ISA = qw();
52              
53             ###########################################################################
54              
55             sub new {
56 0     0 0   my $class = shift;
57 0   0       $class = ref($class) || $class;
58 0           my ($main) = @_;
59              
60 0           my $self = {
61             'main' => $main
62             };
63              
64 0           bless ($self, $class);
65 0           $self;
66             }
67              
68             ###########################################################################
69              
70             sub load_modules { # static
71 0     0 0   dbg("ldap: loading Net::LDAP and URI");
72 0           eval {
73 0           require Net::LDAP; # actual server connection
74 0           require URI; # parse server connection dsn
75             };
76              
77             # do any other preloading that will speed up operation
78             }
79              
80             ###########################################################################
81              
82             =item $f->load ($username)
83              
84             Read configuration parameters from LDAP server and parse scores from it.
85              
86             =back
87              
88             =cut
89              
90             sub load {
91 0     0 1   my ($self, $username) = @_;
92              
93 0           my $conf = $self->{main}->{conf};
94 0           my $url = $conf->{user_scores_dsn}; # an ldap URI
95 0           dbg("ldap: URL is $url");
96 0 0 0       if(!defined($url) || $url eq '') {
97 0           dbg("ldap: No URL defined; skipping LDAP");
98 0           return;
99             }
100              
101             eval {
102             # make sure we can see croak messages from DBI
103 0     0     local $SIG{'__DIE__'} = sub { warn "$_[0]"; };
  0            
104 0           require Net::LDAP;
105 0           require URI;
106 0           load_with_ldap($self, $username, $url);
107 0           1;
108 0 0         } or do {
109 0 0         my $eval_stat = $@ ne '' ? $@ : "errno=$!"; chomp $eval_stat;
  0            
110 0 0         if ($conf->{user_scores_fail_to_global}) {
111 0           info("ldap: failed to load user (%s) scores from LDAP server, ".
112             "using a global default: %s", $username, $eval_stat);
113 0           return 1;
114             } else {
115 0           warn sprintf(
116             "ldap: failed to load user (%s) scores from LDAP server: %s\n",
117             $username, $eval_stat);
118 0           return 0;
119             }
120             };
121             }
122              
123             sub load_with_ldap {
124 0     0 0   my ($self, $username, $url) = @_;
125              
126             # ldapurl = scheme "://" [hostport] ["/"
127             # [dn ["?" [attributes] ["?" [scope]
128             # ["?" [filter] ["?" extensions]]]]]]
129              
130 0           my $uri = URI->new("$url");
131              
132 0           my $host = $uri->host;
133 0 0 0       if (!defined($host) || $host eq '') {
134 0           dbg("ldap: No server specified, assuming localhost");
135 0           $host = "localhost";
136             }
137 0           my $port = $uri->port;
138 0           my $base = $uri->dn;
139 0           my @attr = $uri->attributes;
140 0           my $scope = $uri->scope;
141 0           my $filter = $uri->filter;
142 0           my $scheme = $uri->scheme;
143 0           my %extn = $uri->extensions; # unused
144              
145 0           $filter =~ s/__USERNAME__/$username/g;
146 0           dbg("ldap: host=$host, port=$port, base='$base', attr=${attr[0]}, scope=$scope, filter='$filter'");
147              
148 0           my $main = $self->{main};
149 0           my $conf = $main->{conf};
150 0           my $ldapuser = $conf->{user_scores_ldap_username};
151 0           my $ldappass = $conf->{user_scores_ldap_password};
152              
153 0 0         if(!$ldapuser) {
154 0           undef($ldapuser);
155             } else {
156 0           dbg("ldap: user='$ldapuser'");
157             }
158              
159 0 0         if(!$ldappass) {
160 0           undef($ldappass);
161             } else {
162             # don't log this to avoid leaking sensitive info
163             # dbg("ldap: pass='$ldappass'");
164             }
165              
166 0           my $f_attribute = $attr[0];
167              
168 0           my $ldap = Net::LDAP->new ("$host:$port",
169             onerror => "warn",
170             scheme => $scheme);
171              
172 0 0 0       if (!defined($ldapuser) && !defined($ldappass)) {
173 0           $ldap->bind;
174             } else {
175 0           $ldap->bind($ldapuser, password => $ldappass);
176             }
177              
178 0           my $result = $ldap->search( base => $base,
179             filter => $filter,
180             scope => $scope,
181             attrs => \@attr
182             );
183              
184 0           my $config_text = '';
185 0           foreach my $entry ($result->all_entries) {
186 0           my @v = $entry->get_value($f_attribute);
187 0           foreach my $v (@v) {
188 0           dbg("ldap: retrieving prefs for $username: $v");
189 0           $config_text .= $v."\n";
190             }
191             }
192 0 0         if ($config_text ne '') {
193 0           $conf->{main} = $main;
194 0           $conf->parse_scores_only($config_text);
195 0           delete $conf->{main};
196             }
197 0           return;
198             }
199              
200             ###########################################################################
201              
202 0     0 0   sub sa_die { Mail::SpamAssassin::sa_die(@_); }
203              
204             ###########################################################################
205              
206             1;