This file is indexed.

/usr/share/perl5/Mail/SpamAssassin/Logger.pm is in spamassassin 3.4.2-0ubuntu0.14.04.1.

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
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
# <@LICENSE>
# Licensed to the Apache Software Foundation (ASF) under one or more
# contributor license agreements.  See the NOTICE file distributed with
# this work for additional information regarding copyright ownership.
# The ASF licenses this file to you under the Apache License, Version 2.0
# (the "License"); you may not use this file except in compliance with
# the License.  You may obtain a copy of the License at:
# 
#     http://www.apache.org/licenses/LICENSE-2.0
# 
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
# </@LICENSE>

=head1 NAME

Mail::SpamAssassin::Logger - SpamAssassin logging module

=head1 SYNOPSIS

  use Mail::SpamAssassin::Logger;

  $SIG{__WARN__} = sub {
    log_message("warn", $_[0]);
  };

  $SIG{__DIE__} = sub {
    log_message("error", $_[0])  if !$^S;
  };

=cut

package Mail::SpamAssassin::Logger;

use strict;
use warnings;
# use bytes;
use re 'taint';

use Exporter ();

our @ISA = qw(Exporter);
our @EXPORT = qw(dbg info would_log);
our @EXPORT_OK = qw(log_message);

use constant ERROR => 0;
use constant WARNING => 1;
use constant INFO => 2;
use constant DBG => 3;

my %log_level = (
		 0 => 'ERROR',
		 1 => 'WARNING',
		 2 => 'INFO',
		 3 => 'DBG',
		 );

# global shared object
our %LOG_SA;
our $LOG_ENTERED;  # to avoid recursion on die or warn from within logging

# defaults
$LOG_SA{level} = WARNING;       # log info, warnings and errors
$LOG_SA{facility} = {};		# no dbg facilities turned on

# always log to stderr initially
use Mail::SpamAssassin::Logger::Stderr;
$LOG_SA{method}->{stderr} = Mail::SpamAssassin::Logger::Stderr->new();

=head1 METHODS

=over 4

=item add_facilities(facilities)

Enable debug logging for specific facilities.  Each facility is the area
of code to debug.  Facilities can be specified as a hash reference (the
key names are used), an array reference, an array, or a comma-separated
scalar string. Facility names are case-sensitive.

If "all" is listed, then all debug facilities are implicitly enabled,
except for those explicitly disabled.  A facility name may be preceded
by a "no" (case-insensitive), which explicitly disables it, overriding
the "all".  For example: all,norules,noconfig,nodcc.  When facility names
are given as an ordered list (array or scalar, not a hash), the last entry
applies, e.g. 'nodcc,dcc,dcc,noddc' is equivalent to 'nodcc'.  Note that
currently no facility name starts with a "no", it is advised to keep this
practice with newly added facility names to make life easier.

Higher priority informational messages that are suitable for logging in
normal circumstances are available with an area of "info".  Some very
verbose messages require the facility to be specifically enabled (see
C<would_log> below).

=cut

sub add_facilities {
  my ($facilities) = @_;

  my @facilities;
  if (ref ($facilities) eq '') {
    if (defined $facilities && $facilities ne '0') {
      @facilities = split(/,/, $facilities);
    }
  }
  elsif (ref ($facilities) eq 'ARRAY') {
    @facilities = @{ $facilities };
  }
  elsif (ref ($facilities) eq 'HASH') {
    @facilities = keys %{ $facilities };
  }
  @facilities = grep(/^\S+$/, @facilities);
  if (@facilities) {
    for my $fac (@facilities) {
      local ($1,$2);
      $LOG_SA{facility}->{$2} = !defined($1)  if $fac =~ /^(no)?(.+)\z/si;
    }
    # turn on debugging if facilities other than "info" are enabled
    if (grep { !/^info\z/ && !/^no./si } keys %{ $LOG_SA{facility} }) {
      $LOG_SA{level} = DBG if $LOG_SA{level} < DBG;
    }
    else {
      $LOG_SA{level} = INFO if $LOG_SA{level} < INFO;
    }
    # debug statement last so we might see it
    dbg("logger: adding facilities: " . join(", ", @facilities));
    dbg("logger: logging level is " . $log_level{$LOG_SA{level}});
  }
}

=item log_message($level, @message)

Log a message at a specific level.  Levels are specified as strings:
"warn", "error", "info", and "dbg".  The first element of the message
must be prefixed with a facility name followed directly by a colon.

=cut

sub log_message {
  my ($level, @message) = @_;

  # too many die and warn messages out there, don't log the ones that we don't
  # own.  jm: off: this makes no sense -- if a dependency module dies or warns,
  # we want to know about it, unless we're *SURE* it's not something worth
  # worrying about.
  # if ($level eq "error" or $level eq "warn") {
  # return unless $message[0] =~ /^\S+:/;
  # }

  if ($level eq "error") {
    # don't log alarm timeouts or broken pipes of various plugins' network checks
    return if ($message[0] =~ /__ignore__/);

    # dos: we can safely ignore any die's that we eval'd in our own modules so
    # don't log them -- this is caller 0, the use'ing package is 1, the eval is 2
    my @caller = caller 2;
    return if (defined $caller[3] && defined $caller[0] &&
		       $caller[3] =~ /^\(eval\)$/ &&
		       $caller[0] =~ m#^Mail::SpamAssassin(?:$|::)#);
  }

  return if $LOG_ENTERED;  # avoid recursion on die or warn from within logging
  $LOG_ENTERED = 1;  # no 'returns' from this point on, must clear the flag

  my $message = join(" ", @message);
  $message =~ s/[\r\n]+$//;		# remove any trailing newlines

  # split on newlines and call log_message multiple times; saves
  # the subclasses having to understand multi-line logs
  my $first = 1;
  foreach my $line (split(/\n/, $message)) {
    # replace control characters with "_", tabs and spaces get
    # replaced with a single space.
    $line =~ tr/\x09\x20\x00-\x1f/  _/s;
    if ($first) {
      $first = 0;
    } else {
      local $1;
      $line =~ s/^([^:]+?):/$1: [...]/;
    }
    while (my ($name, $object) = each %{ $LOG_SA{method} }) {
      $object->log_message($level, $line);
    }
  }
  $LOG_ENTERED = 0;
}

=item dbg("facility: message")

This is used for all low priority debugging messages.

=cut

sub dbg {
  _log(DBG, @_)  if $LOG_SA{level} >= DBG;
  1;  # always return the same simple value, regardless of log level
}

=item info("facility: message")

This is used for informational messages indicating a normal, but
significant, condition.  This should be infrequently called.  These
messages are typically logged when SpamAssassin is run as a daemon.

=cut

sub info {
  _log(INFO, @_)  if $LOG_SA{level} >= INFO;
  1;  # always return the same simple value, regardless of log level
}

# remember to avoid deep recursion, my friend
sub _log {
  my $facility;
  local ($1);

  # it's faster to access this as the $_[1] alias, and not to perform
  # string mods until we're sure we actually want to log anything
  if ($_[1] =~ /^([a-z0-9_-]*):/i) {
    $facility = $1;
  } else {
    $facility = "generic";
  }

  # log all info, warn, and error messages;
  # only debug if asked to
  if ($_[0] == DBG) {
    return unless
      exists $LOG_SA{facility}->{$facility} ? $LOG_SA{facility}->{$facility}
                                            : $LOG_SA{facility}->{all};
  }

  my ($level, $message, @args) = @_;
  $message =~ s/^(?:[a-z0-9_-]*):\s*//i;

  $message = sprintf($message,@args)  if @args;
  $message =~ s/\n+$//s;
  $message =~ s/^/${facility}: /mg;

  # no reason to go through warn()
  log_message(($level == INFO ? "info" : "dbg"), $message);
}

=item add(method => 'syslog', socket => $socket, facility => $facility)

C<socket> is the type the syslog ("unix" or "inet").  C<facility> is the
syslog facility (typically "mail").

=item add(method => 'file', filename => $file)

C<filename> is the name of the log file.

=item add(method => 'stderr')

No options are needed for stderr logging, just don't close stderr first.

=cut

sub add {
  my %params = @_;

  my $name = lc($params{method});
  my $class = ucfirst($name);

  eval 'use Mail::SpamAssassin::Logger::'.$class.'; 1'
  or do {
    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
    die "logger: add $class failed: $eval_stat\n";
  };

  if (!exists $LOG_SA{method}->{$name}) {
    my $object;
    my $eval_stat;
    eval '$object = Mail::SpamAssassin::Logger::'.$class.'->new(%params); 1'
    or do {
      $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
      undef $object;  # just in case
    };
    if (!$object) {
      if (!defined $eval_stat) {
        $eval_stat = "Mail::SpamAssassin::Logger::$class->new ".
                     "failed to return an object";
      }
      warn "logger: failed to add $name method: $eval_stat\n";
    }
    else {
      $LOG_SA{method}->{$name} = $object;
      dbg("logger: successfully added $name method\n");
      return 1;
    }
    return 0;
  }

  warn "logger: $name method already added\n";
  return 1;
}

=item remove(method)

Remove a logging method.  Only the method name needs to be passed as a
scalar.

=cut

sub remove {
  my ($method) = @_;

  my $name = lc($method);
  if (exists $LOG_SA{method}->{$name}) {
    delete $LOG_SA{method}->{$name};
    info("logger: removing $name method");
    return 1;
  }
  warn "logger: unable to remove $name method, not present to be removed\n";
  return 1;
}

=item would_log($level, $facility)

Returns false if a message at the given level and with the given facility
would not be logged.  Returns 1 if a message at a given level and facility
would be logged normally.  Returns 2 if the facility was specifically
enabled.

The facility argument is optional.

=cut

sub would_log {
  my ($level, $facility) = @_;

  if ($level eq "info") {
    return $LOG_SA{level} >= INFO;
  }
  if ($level eq "dbg") {
    return 0 if $LOG_SA{level} < DBG;
    return 1 if !$facility;
    return ($LOG_SA{facility}->{$facility} ? 2 : 0)
      if exists $LOG_SA{facility}->{$facility};
    return 1 if $LOG_SA{facility}->{all};
    return 0;
  }
  warn "logger: would_log called with unknown level: $level\n";
  return 0;
}

=item close_log()

Close all logs.

=cut

sub close_log {
  while (my ($name, $object) = each %{ $LOG_SA{method} }) {
    $object->close_log();
  }
}

END {
  close_log();
}

1;

=back

=cut