File: Log.pm

package info (click to toggle)
mailscanner 4.79.11-2.2
  • links: PTS
  • area: main
  • in suites: squeeze
  • size: 5,820 kB
  • ctags: 1,309
  • sloc: perl: 25,655; sh: 2,666; xml: 624; makefile: 242
file content (207 lines) | stat: -rw-r--r-- 5,825 bytes parent folder | download
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
#
#   MailScanner - SMTP E-Mail Virus Scanner
#   Copyright (C) 2002  Julian Field
#
#   $Id: Log.pm 4709 2009-03-28 10:06:21Z sysjkf $
#
#   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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#   The author, Julian Field, can be contacted by email at
#      Jules@JulianField.net
#   or by paper mail at
#      Julian Field
#      Dept of Electronics & Computer Science
#      University of Southampton
#      Southampton
#      SO17 1BJ
#      United Kingdom
#

###########################################################
# Syslog library calls
###########################################################

package MailScanner::Log;

use strict;
use Sys::Syslog;
use Carp;
use vars qw($LogType $Banner $WarningsOnly);

# Used to say 'syslog' but for the MailScanner.conf syntax checking code I
# need the default log output to be stderr, as I don't know enough to start
# the logging properly.
$LogType |= 'syslog'; #'stderr';
$WarningsOnly = 0;

sub Configure {
  my($banner,$type) = @_;

  $Banner = $banner?$banner:undef;
  $LogType = $type?$type:'syslog';
}

sub WarningsOnly {
  $WarningsOnly = 1;
}

sub Start {
  my($name, $facility, $logsock) = @_;

  $logsock =~ s/\W//g; # Take out all the junk

  # These are needed later if we need to restart the logging connection
  # due to a SIGPIPE.
  $MailScanner::Log::name = $name;
  $MailScanner::Log::facility = $facility;
  $MailScanner::Log::logsock = $logsock;

  if ($LogType eq 'syslog') {
    # Do this in an eval so it can fail quietly if setlogsock
    # is not supported in the installed version of Sys::Syslog
    #eval { $SIG{'__DIE__'} = 'IGNORE';
    #       Sys::Syslog::setlogsock('unix');
    #     }; # Doesn't need syslogd -r
    #$SIG{'__DIE__'} = 'DEFAULT';
    # This was too simple and didn't work on some Solaris and IRIX systems
    #eval { Sys::Syslog::setlogsock('unix'); }; # This may fail!
    if ($logsock eq '') {
      if ($^O =~ /solaris|sunos|irix/i) {
        $logsock = 'udp';
      } else {
        $logsock = 'unix';
      }
    }
    $MailScanner::Log::logsock = $logsock;
    print STDERR "Trying to setlogsock($logsock)\n" unless $WarningsOnly;
    eval { Sys::Syslog::setlogsock($logsock); };
    eval { Sys::Syslog::openlog($name, 'pid, nowait', $facility); };
  }
  
  if (defined $Banner) {
    InfoLog($Banner);
  }
}

# Re-open the logging, used after SA::initialise has nobbled it due to
# nasty Razor code.
sub Reset {
  if ($LogType eq 'syslog') {
    eval { Sys::Syslog::setlogsock($MailScanner::Log::logsock); };
    eval { Sys::Syslog::openlog($MailScanner::Log::name, 'pid, nowait',
                                $MailScanner::Log::facility); };
  }
}

sub Stop {
    Sys::Syslog::closelog() if $LogType eq 'syslog';
}

sub DieLog {
  # closelog changes $! in @_
  my(@x) = @_;

  my $logmessage = sprintf shift @x, @x;

  LogText($logmessage, 'err');

  Sys::Syslog::closelog() if $LogType eq 'syslog';

  croak "$logmessage";
}

sub WarnLog {
  my(@x) = @_;
  my $logmessage = sprintf shift @x, @x;

  LogText($logmessage, 'warning');

  carp $logmessage if $LogType eq 'stderr';
}

sub NoticeLog {
  my(@x) = @_;
  my $logmessage = sprintf shift @x, @x;

  unless ($WarningsOnly) {
    LogText($logmessage, 'notice');

    print STDERR "$logmessage\n" if $LogType eq 'stderr';
  }
}

sub InfoLog {
  my(@x) = @_;
  my $logmessage = sprintf shift @x, @x;

  unless ($WarningsOnly) {
    LogText($logmessage, 'info');

    print STDERR "$logmessage\n" if $LogType eq 'stderr';
  }
}

sub DebugLog {
  my(@x) = @_;
  if (MailScanner::Config::Value('debug')) {
    my $logmessage = sprintf shift @x, @x;

    LogText($logmessage, 'debug');

    print STDERR "$logmessage\n" if $LogType eq 'stderr';
  }
}

sub LogText {
  my($logmessage, $level) = @_;

  return unless $LogType eq 'syslog';

  #my $old = $SIG{'PIPE'};
  #$SIG{'PIPE'} = sub { $MailScanner::Log::SIGPIPE_RECEIVED++; };

  # Force use of 8-bit characters, UTF16 breaks syslog badly.
  use bytes;

  foreach(split /\n/,$logmessage) {
    s/%/%%/g;
    eval { Sys::Syslog::syslog($level, $_) if $_ ne "" };

    ## If we got a SIGPIPE then something broke in the logging socket.
    ## So try to open a new one and use that from now on instead.
    #if ($MailScanner::Log::SIGPIPE_RECEIVED) {
    #  # SIGPIPE received while trying to log. This probably means they
    #  # are using syslog-ng and it was hupped by a log-rolling script.
    #  # Close and re-open our syslog connection and have another go.
    #  Sys::Syslog::closelog();
    #  eval { Sys::Syslog::setlogsock($MailScanner::Log::logsock); }; #may fail!
    #  Sys::Syslog::openlog($MailScanner::Log::name, 'pid, nowait',
    #                       $MailScanner::Log::facility);
    #  #Sys::Syslog::syslog($level, "SIGPIPE received - trying new log socket");
    #  Sys::Syslog::syslog($level, $_);
    #  # Whinge is logging is still broken
    #  warn "MailScanner logging failure, multiple SIGPIPEs received"
    #    if $MailScanner::Log::SIGPIPE_RECEIVED > 1;
    #  $MailScanner::Log::SIGPIPE_RECEIVED = 0;
    #}
  }

  no bytes;

  # Reset old SIGPIPE handler
  #$SIG{'PIPE'} = $old if defined($old);
}

1;