source: A2P/a2p/A2P/Syslog.pm @ 3

Last change on this file since 3 was 3, checked in by guillaume, 17 years ago
  • AUTHORS: Ajout des différents contributeurs
  • COPYING: Ajout de la licence GPL v3
  • a2p: Préparation des sources pour leur publication sous GPL
  • Property svn:keywords set to Id
File size: 12.3 KB
Line 
1#
2# Copyright (c) 2004-2007 - Consultas, PKG.fr
3#
4# This file is part of A2P.
5#
6# A2P is free software; you can redistribute it and/or modify
7# it under the terms of the GNU General Public License as published by
8# the Free Software Foundation; either version 2 of the License, or
9# (at your option) any later version.
10#
11# A2P is distributed in the hope that it will be useful,
12# but WITHOUT ANY WARRANTY; without even the implied warranty of
13# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14# GNU General Public License for more details.
15#
16# You should have received a copy of the GNU General Public License
17# along with A2P; if not, write to the Free Software
18# Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
19#
20# $Id: Syslog.pm 3 2007-10-18 16:20:19Z guillaume $
21#
22
23package A2P::Syslog;
24
25use strict ;
26use Socket ;
27use Errno qw( EINTR );
28use Time::HiRes qw( usleep gettimeofday tv_interval );
29use IO::Socket ;
30use MIME::Base64 ;
31use A2P::Globals ;
32use A2P::Com qw( GetCom comREQ comCOM comLOG TakeComLocking ReleaseComLocking );
33
34BEGIN {
35    use Exporter ();
36    our ( $VERSION , @ISA , @EXPORT , @EXPORT_OK , @TT );
37
38    $VERSION = sprintf "%s", q$Rev: 762 $ =~ /(\d[0-9.]+)\s+/ ;
39
40    @ISA = qw(Exporter);
41    @EXPORT = qw(   &Debug &Info &Notice &Error &Warn &Alert
42                    $loggertid &DirectLog &SetLogger &getBackLogs &AlertError
43                    &debugdev &NotImplemented &ResetDebug );
44    @EXPORT_OK= qw( &AttachZipToAlertError );
45
46    # Set timer ref to starting time
47    @TT = ( $^T , ( $^T * 1_000_000 ) % 1_000_000 ) unless @TT ;
48}
49our $VERSION ;
50
51our $loggertid  = 0 ;
52
53my $Logger      = 0 ;
54my $loggingname = $Progname ;
55
56# Shared timer to get syslog timestamps synchronized
57our @TT ;
58
59# Log backup
60my @BackLogs = () ;
61
62# Locking var to not get coflicts with coms
63my $lockfile = undef ;
64my $locked   = 0 ;
65
66# Syslog socket
67sub facility { 6 << 3 } # LOG_LPR Facility
68my $who = "" ;
69
70sub OpenSyslog {
71    my $toconnect = sockaddr_un($SYSLOG_PATH);
72    unless ( $toconnect ) {
73        warn "Can't locate $SYSLOG_PATH: $!\n" ;
74        return "" ;
75    }
76
77    unless ( socket( $SYSLOG, AF_UNIX, SOCK_STREAM, 0 )) {
78        warn "Can't open Syslog unix stream socket: $!\n" ;
79        return "" ;
80    }
81
82    if (!connect($SYSLOG,$toconnect)) {
83        unless (socket( $SYSLOG, AF_UNIX, SOCK_DGRAM, 0 )) {
84            warn "Can't open Syslog unix datagram socket: $!\n" ;
85            return "" ;
86        }
87        unless (connect($SYSLOG,$toconnect)) {
88            warn "Can't connect to Syslog unix datagram socket: $!\n" ;
89            return "" ;
90        }
91    }
92    return $loggingname . ( $LOCKID ? "-$LOCKID" : "" ) . "[$$]" ;
93}
94
95my %Level = ( 1 => 'alert', 3 => 'error' , 4 => 'warning' , 5 => 'notice' ,
96    6 => 'info' , 7 => 'debug' );
97
98sub DirectLog {
99
100    # First argument should be log level
101    # Second is an array of messages to log
102    # Third should be defined to get message up to parent
103    #   and content debugging info when required
104
105    return unless ( ref($_[1]) =~/^ARRAY/ );
106
107    my $level = shift ;
108    my $ref   = shift ;
109    $level = 6 unless ( defined($level) and $level );
110
111    my @hdr = $NO_SYSLOG_DEBUG ? () : ( &timestamp(), '>' );
112    push @hdr, "$Level{$level}: $loggingname:", @_ if @_ ;
113
114    # Reset error status for debugging output problems
115    $! = 0 ;
116
117    if ( $loggertid and $loggertid != $$ and $Logger and ! $ADVANCED_DEBUGGING ) {
118
119        close($SYSLOG) if (defined($SYSLOG));
120
121        # Keep who is logging when logging in file, and not at debug level
122        push @hdr, $Level{$level} . ":", $loggingname . "[$$]:"
123            if ( $LOGFILE_VS_SYSLOG and $level < 7 );
124
125        foreach my $logline ( @{$ref} ) {
126
127            my $comlog = &GetCom( comLOG , $level ,
128                 &KeepValidatedLog( \@hdr, $logline ));
129
130            unless($Logger->DoLog($comlog)) {
131                &debugdev("Log not sent on $Logger: $logline");
132
133                # Try to log directly by recall ourselves but avoiding this case
134                my $keep = $ADVANCED_DEBUGGING ;
135                $ADVANCED_DEBUGGING = 1 ;
136                &DirectLog( $level , $ref, @_ );
137                $ADVANCED_DEBUGGING = $keep ;
138            }
139        }
140
141    } elsif ( $LOGFILE_VS_SYSLOG or ( $level == 7 and $DEBUG_IN_FILE )) {
142
143        my $LOG ;
144
145        unshift @hdr, scalar(localtime), "[$$]:" ;
146        open( $LOG, '>>', $LOGFILENAME )
147            or warn "Can't open '$LOGFILENAME' for appending: $!\n", return 0 ;
148
149        &TakeComLocking($LOG);
150
151        my $test = 0 ;
152        map {
153            $test += print $LOG &KeepValidatedLog( \@hdr, $_ ), "\n"
154        } @{$ref} ;
155
156        $test == @{$ref} ? &UPSTAT('GOOD-LOGPRINT') : &UPSTAT('BAD-LOGPRINT');
157
158        &ReleaseComLocking($LOG);
159        close($LOG);
160
161    } else {
162
163        $who = &OpenSyslog();
164
165        if ($who) {
166            $level += facility ;
167            unshift @hdr, "<$level>$who:" ;
168
169            my $test = 0 ;
170            my $tempo = 0 ;
171            foreach my $line ( @{$ref} ) {
172                my $log = &KeepValidatedLog( \@hdr, $line );
173                my $sent = $! = 0 ;
174                while ( ! defined($sent = send( $SYSLOG , $log . "\0" , 0 ))) {
175                    # Retry only when we got a interrupted system call
176                    unless ( $! == EINTR ) {
177                        &debugdev("With line '$line'...",
178                            "Can't send to syslog '$log'");
179                        &debugdev("And errno[".int($!)."]= $!") if $! ;
180                        last ;
181                    }
182                    usleep $USLEEP ;
183                    $! = 0 ;
184                }
185
186                $test ++ ;
187                $tempo += $sent ;
188            }
189
190            $test == @{$ref} ? &UPSTAT('GOOD-SYSLOGPRINT') : &UPSTAT('BAD-SYSLOGPRINT');
191
192            close($SYSLOG);
193        }
194    }
195
196    $! = 0 ;
197}
198
199sub KeepValidatedLog {
200    my $timeref = shift ;
201    my $logline = shift ;
202
203    $logline =~ s/[^ -~]/ /go ;
204
205    # Keep ref to log if requested
206    if ( $MAX_BACKLOG and ! $KEEP_DYNAMIC_JOB_LOG ) {
207        shift @BackLogs until ( @BackLogs < $MAX_BACKLOG );
208        push @BackLogs, [ @{$timeref} , $logline ] ;
209    }
210
211    local $" = ' ' ;
212    return ( @{$timeref} ? "@{$timeref} " : "" ) . $logline ;
213}
214
215sub getBackLogs {
216    # Re-assemble logs ref
217    return map { join('', @{$_}) } @BackLogs ;
218}
219
220sub timestamp {
221    return "" if ( $NO_SYSLOG_DEBUG and ! $MAX_BACKLOG and ! $STDOUT_DEBUG);
222    # Keep timer in the current minute
223    my @tt = &gettimeofday() ;
224    return sprintf("%.8d",
225        (( $tt[0] - $TT[0] ) * 1_000_000 + ( $tt[1] - $TT[1] )) % 60_000_000 );
226}
227
228#############################################################################
229##                 Standard system logging functions                       ##
230#############################################################################
231my $LastCount = 0 ;
232my $LastDebugMessage = "" ;
233
234sub SetLogger {
235    $Logger      = shift ;
236    $loggingname = $0 ;
237}
238
239sub debugdev {
240    my $time = localtime(time);
241    print STDERR
242        map { $time, &timestamp, ": $Progname\[$$]: [DEV]: ", $_, "\n" } @_ ;
243}
244
245sub NotImplemented {
246    my ( $package, $filename, $line, $sub ) = caller ;
247    &DirectLog( 5 , [ "Need implementation".(@_?" of '@_'":"")." in $filename" ],
248         $package.", ".$sub."(), L.".$line.":");
249}
250
251my %DebugMods = () ;
252my $ReversedDebugModList = 0 ;
253sub ResetDebug {
254    my $last = $ReversedDebugModList ;
255    $ReversedDebugModList = $NODEBUG_MOD_LIST =~ /^(!)/ ;
256    $NODEBUG_MOD_LIST =~ s/[!]//g ;
257    %DebugMods = map { $_ => 1 } split(/[,;\s]+/,$NODEBUG_MOD_LIST) ;
258    return if ($NO_SYSLOG_DEBUG);
259    &DirectLog( 7 , [ "Switching NODEBUG_MOD_LIST comportement to " .
260        ($ReversedDebugModList?"":"not ") . "debug on ".join(" ",keys(%DebugMods)) ] )
261        unless ( $ReversedDebugModList == $last );
262}
263
264my $lastdebug = [ &gettimeofday() ] ;
265sub Debug {
266    return &debugdev(@_) if ( $STDOUT_DEBUG );
267    return if ( $NO_SYSLOG_DEBUG and ( $KEEP_DYNAMIC_JOB_LOG or ! $MAX_BACKLOG ));
268
269    my ($package, $filename, $line) = caller ;
270
271    return if ($ReversedDebugModList ^ defined($DebugMods{$package}));
272
273    my @sub = caller(1);
274    @sub = caller(2) if ( defined($sub[3]) and $sub[3] =~ /Debug$/ );
275    $sub[3] = "(none)" unless (@sub > 3);
276    my ( $sub ) = $sub[3] =~ /^.*::([^:]*)$/ ;
277
278    return if ( $sub and $NODEBUG_SUB_LIST =~ /$sub/ );
279    if ( $#_ or $_[0] ne $LastDebugMessage or &tv_interval($lastdebug) > 1 ) {
280        if ($NO_SYSLOG_DEBUG) {
281            &KeepValidatedLog( [ &timestamp() ],
282                "Last message repeated $LastCount times")
283                    if $LastCount ;
284            map {
285                &KeepValidatedLog( [ &timestamp(), "$package,".
286                ( $sub ? "$sub," : ""), "L.$line:" ], $_ )
287            } @_ ;
288
289        } else {
290            &DirectLog( 7 , [ " last message repeated $LastCount times" ] , "..." )
291                if $LastCount ;
292            &DirectLog( 7 , \@_, "$package,".( $sub ? "$sub," : ""), "L.$line:" );
293        }
294        $LastDebugMessage = defined($_[$#_]) ? $_[$#_] : "" ;
295        $LastCount = 0 if $LastCount ;
296        $lastdebug = [ &gettimeofday() ] ;
297
298    } else {
299        $LastCount ++ ;
300    }
301}
302
303sub Info {
304    &DirectLog( 6 , \@_ );
305}
306
307sub Notice {
308    &DirectLog( 5 , \@_ );
309}
310
311sub Error {
312   if ($NO_SYSLOG_DEBUG and ! $ADVANCED_DEBUGGING) {
313        &DirectLog( 3 , \@_ );
314
315    } else {
316        my ( $package, $filename, $line, $sub ) = caller ;
317        $filename =~ m|([^/]+)$| ;
318        &DirectLog( 3   , \@_ , "$package, L.$line:" );
319        &DirectLog( 7 , \@_ , "ERROR: $package, L.$line:" );
320        ($package, $filename, $line, $sub) = caller(1);
321        return 0 unless (defined($filename) and defined($line) and defined($sub) and $sub);
322        $filename =~ m|([^/]+)$| ;
323        &DirectLog( 7 , \@_ , "ERROR: $1, $sub, L.$line:" );
324        ($package, $filename, $line, $sub) = caller(2);
325        return 0 unless (defined($filename) and defined($line) and defined($sub) and $sub);
326        $filename =~ m|([^/]+)$| ;
327        &DirectLog( 7 , \@_ , "ERROR: $1, $sub, L.$line:" );
328    }
329    0 ;
330}
331
332sub Warn {
333    &DirectLog( 4 , \@_ );
334}
335
336sub Alert {
337    return &Warn("Alert called without message") unless ( @_ and $_[0] );
338    if ( -x $MAIL_BIN ) {
339        if ( $ALERT_MAILS ) {
340            open(*MAIL,"|$MAIL_BIN $ALERT_MAILS")
341                or &Warn("Can't open mailer program: $!");
342            print MAIL "Subject: [$Progname;$LOCKID] $_[0]\n";
343            close(MAIL);
344            &Info("Alert sent to '$ALERT_MAILS'");
345        }
346        &AlertError(@_) if $ERROR_MAILS ;
347
348    } else {
349        &Warn("Can't open mailer program as it is not launchable");
350    }
351    # Reduce alert to syslog to only give the alert title
352    &DirectLog( 1 , [ $_[0] ] );
353}
354
355my $zipfile = "" ;
356sub AttachZipToAlertError {
357    $zipfile = shift ;
358}
359
360sub AlertError {
361    return &Warn("Alert called without message") unless ( @_ and $_[0] );
362    if ( -x $MAIL_BIN ) {
363        if ( $ERROR_MAILS ) {
364
365            open(*MAIL,"|$MAIL_BIN $ERROR_MAILS")
366                or return &Warn("Can't open mailer program: $!");
367
368            my $boundary = "_----------=_" . int(time) . $$ ;
369
370            print MAIL "Subject: [$Progname;$LOCKID] $_[0]\n" ;
371
372            print MAIL "Content-Transfer-Encoding: binary
373Content-Type: multipart/mixed; boundary=$boundary
374MIME-Version: 1.0
375X-Mailer: $loggingname v$VERSION (", __PACKAGE__, " rev $VERSION)
376
377This is a multi-part message in MIME format.
378
379--$boundary
380
381"               if ( $zipfile and -e $zipfile );
382
383            # Anyway insert alert content
384            map { print MAIL $_ , "\n" } @_ ;
385
386            if ( $zipfile and -e $zipfile ) {
387                my $buf ;
388                my ( $zipname ) = $zipfile =~ m|^.*/([^/]+)$| ;
389                if ( open(*ZIP, '<', $zipfile)) {
390                    binmode(ZIP);
391                    print MAIL "
392--$boundary
393Content-Transfer-Encoding: base64
394Content-Type: application/zip; name='$zipname'\n\n" ;
395                    while (read(ZIP,$buf,60*57)) {
396                        print MAIL encode_base64($buf);
397                    }
398                }
399                $zipfile = "" ;
400                print MAIL "\n\n--$boundary--\n\n" ;
401            }
402            close(MAIL);
403            &Info("Alert with errors sent to '$ERROR_MAILS'");
404            &Debug("Mail sent");
405        }
406
407    } else {
408        &Warn("Can't open mailer program as it is not launchable");
409    }
410}
411
412&Debug("Module " . __PACKAGE__ . " v$VERSION loaded") unless ( $0 =~ /cgi/ );
413
4141;
Note: See TracBrowser for help on using the repository browser.