line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# Paranoid::Log::File -- File Log support for paranoid programs |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# $Id: lib/Paranoid/Log/File.pm, 2.08 2020/12/31 12:10:06 acorliss Exp $ |
4
|
|
|
|
|
|
|
# |
5
|
|
|
|
|
|
|
# This software is free software. Similar to Perl, you can redistribute it |
6
|
|
|
|
|
|
|
# and/or modify it under the terms of either: |
7
|
|
|
|
|
|
|
# |
8
|
|
|
|
|
|
|
# a) the GNU General Public License |
9
|
|
|
|
|
|
|
# as published by the |
10
|
|
|
|
|
|
|
# Free Software Foundation ; either version 1 |
11
|
|
|
|
|
|
|
# , or any later version |
12
|
|
|
|
|
|
|
# , or |
13
|
|
|
|
|
|
|
# b) the Artistic License 2.0 |
14
|
|
|
|
|
|
|
# , |
15
|
|
|
|
|
|
|
# |
16
|
|
|
|
|
|
|
# subject to the following additional term: No trademark rights to |
17
|
|
|
|
|
|
|
# "Paranoid" have been or are conveyed under any of the above licenses. |
18
|
|
|
|
|
|
|
# However, "Paranoid" may be used fairly to describe this unmodified |
19
|
|
|
|
|
|
|
# software, in good faith, but not as a trademark. |
20
|
|
|
|
|
|
|
# |
21
|
|
|
|
|
|
|
# (c) 2005 - 2020, Arthur Corliss (corliss@digitalmages.com) |
22
|
|
|
|
|
|
|
# (tm) 2008 - 2020, Paranoid Inc. (www.paranoid.com) |
23
|
|
|
|
|
|
|
# |
24
|
|
|
|
|
|
|
##################################################################### |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
##################################################################### |
27
|
|
|
|
|
|
|
# |
28
|
|
|
|
|
|
|
# Environment definitions |
29
|
|
|
|
|
|
|
# |
30
|
|
|
|
|
|
|
##################################################################### |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
package Paranoid::Log::File; |
33
|
|
|
|
|
|
|
|
34
|
7
|
|
|
7
|
|
598
|
use 5.008; |
|
7
|
|
|
|
|
22
|
|
35
|
|
|
|
|
|
|
|
36
|
7
|
|
|
7
|
|
36
|
use strict; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
128
|
|
37
|
7
|
|
|
7
|
|
35
|
use warnings; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
273
|
|
38
|
7
|
|
|
7
|
|
47
|
use vars qw($VERSION); |
|
7
|
|
|
|
|
8
|
|
|
7
|
|
|
|
|
407
|
|
39
|
7
|
|
|
7
|
|
50
|
use Paranoid::Debug qw(:all); |
|
7
|
|
|
|
|
8
|
|
|
7
|
|
|
|
|
1750
|
|
40
|
7
|
|
|
7
|
|
3620
|
use Paranoid::Filesystem; |
|
7
|
|
|
|
|
20
|
|
|
7
|
|
|
|
|
685
|
|
41
|
7
|
|
|
7
|
|
55
|
use Paranoid::Input; |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
358
|
|
42
|
7
|
|
|
7
|
|
43
|
use Paranoid::IO; |
|
7
|
|
|
|
|
8
|
|
|
7
|
|
|
|
|
701
|
|
43
|
7
|
|
|
7
|
|
43
|
use Fcntl qw(:DEFAULT :flock :mode :seek); |
|
7
|
|
|
|
|
14
|
|
|
7
|
|
|
|
|
8915
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
($VERSION) = ( q$Revision: 2.08 $ =~ /(\d+(?:\.\d+)+)/sm ); |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
##################################################################### |
48
|
|
|
|
|
|
|
# |
49
|
|
|
|
|
|
|
# Module code follows |
50
|
|
|
|
|
|
|
# |
51
|
|
|
|
|
|
|
##################################################################### |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
{ |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
my $hostname; |
56
|
|
|
|
|
|
|
my $pname; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
sub _getHostname { |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# Purpose: Returns the hostname, defaulting to localhost if |
61
|
|
|
|
|
|
|
# /bin/hostname is unusable |
62
|
|
|
|
|
|
|
# Returns: Hostname |
63
|
|
|
|
|
|
|
# Usage: $hostname = _getHostname(); |
64
|
|
|
|
|
|
|
|
65
|
6
|
|
|
6
|
|
12
|
my $fd; |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# Return cached result |
68
|
6
|
50
|
|
|
|
18
|
return $hostname if defined $hostname; |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
# Get the current hostname |
71
|
6
|
50
|
|
|
|
240
|
if ( -x '/bin/hostname' ) { |
72
|
6
|
50
|
|
|
|
16566
|
if ( open $fd, '-|', '/bin/hostname' ) { |
73
|
6
|
|
|
|
|
4980
|
chomp( $hostname = <$fd> ); |
74
|
6
|
|
|
|
|
714
|
close $fd; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# Do a little sanitizing... |
79
|
6
|
50
|
33
|
|
|
180
|
if (defined $hostname and length $hostname) { |
80
|
6
|
|
|
|
|
54
|
$hostname =~ s/\..*$//so; |
81
|
|
|
|
|
|
|
} else { |
82
|
0
|
|
|
|
|
0
|
$hostname = 'localhost'; |
83
|
|
|
|
|
|
|
} |
84
|
|
|
|
|
|
|
|
85
|
6
|
|
|
|
|
156
|
return $hostname; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub _timestamp { |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
# Purpose: Returns a syslog-stype timestamp string for the current or |
91
|
|
|
|
|
|
|
# passed time |
92
|
|
|
|
|
|
|
# Returns: String |
93
|
|
|
|
|
|
|
# Usage: $timestamp = ptimestamp(); |
94
|
|
|
|
|
|
|
# Usage: $timestamp = ptimestamp($epoch); |
95
|
|
|
|
|
|
|
|
96
|
256
|
|
|
256
|
|
692
|
my $utime = shift; |
97
|
256
|
|
|
|
|
1206
|
my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); |
98
|
256
|
|
|
|
|
361
|
my @ctime; |
99
|
|
|
|
|
|
|
|
100
|
256
|
50
|
|
|
|
7085
|
@ctime = defined $utime ? ( localtime $utime ) : (localtime); |
101
|
|
|
|
|
|
|
|
102
|
256
|
|
|
|
|
3990
|
return sprintf |
103
|
|
|
|
|
|
|
'%s %2d %02d:%02d:%02d', |
104
|
|
|
|
|
|
|
$months[ $ctime[4] ], |
105
|
|
|
|
|
|
|
@ctime[ 3, 2, 1, 0 ]; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
sub init { |
109
|
6
|
|
|
6
|
1
|
24
|
_getHostname(); |
110
|
6
|
|
|
|
|
180
|
($pname) = ( $0 =~ m#^(?:.+/)?([^/]+)$#s ); |
111
|
6
|
|
|
|
|
1446
|
return 1; |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
sub addLogger { |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
# Purpose: Opens a handle the requested file |
117
|
|
|
|
|
|
|
# Returns: Boolean |
118
|
|
|
|
|
|
|
# Usage: $rv = addLogger(%record); |
119
|
|
|
|
|
|
|
|
120
|
14
|
|
|
14
|
1
|
61
|
my %record = @_; |
121
|
14
|
|
|
|
|
88
|
my ( $mode, $perm, $rv ); |
122
|
|
|
|
|
|
|
|
123
|
14
|
|
|
|
|
122
|
pdebug( 'entering w/%s', PDLEVEL1, %record ); |
124
|
14
|
|
|
|
|
50
|
pIn(); |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
# Get mode and permissions |
127
|
|
|
|
|
|
|
$mode = |
128
|
|
|
|
|
|
|
exists $record{options}{mode} |
129
|
|
|
|
|
|
|
? $record{options}{mode} |
130
|
14
|
100
|
|
|
|
107
|
: O_CREAT | O_APPEND | O_WRONLY; |
131
|
14
|
100
|
|
|
|
49
|
$perm = $record{options}{perm} if exists $record{options}{perm}; |
132
|
14
|
|
|
|
|
50
|
pdebug( 'perm: %s mode: %s', PDLEVEL1, $perm, $mode ); |
133
|
14
|
100
|
66
|
|
|
154
|
if ( defined $record{options}{file} |
134
|
|
|
|
|
|
|
and length $record{options}{file} ) { |
135
|
8
|
|
|
|
|
120
|
$rv = defined popen( $record{options}{file}, $mode, $perm ); |
136
|
|
|
|
|
|
|
} else { |
137
|
|
|
|
|
|
|
Paranoid::ERROR = |
138
|
|
|
|
|
|
|
pdebug( 'invalid file name specified in options: %s', |
139
|
6
|
|
|
|
|
66
|
PDLEVEL1, $record{options}{file} ); |
140
|
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
|
142
|
14
|
|
|
|
|
55
|
pOut(); |
143
|
14
|
|
|
|
|
43
|
pdebug( 'leaving w/rv: %s', PDLEVEL1, $rv ); |
144
|
|
|
|
|
|
|
|
145
|
14
|
|
|
|
|
66
|
return $rv; |
146
|
|
|
|
|
|
|
} |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
sub delLogger { |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
# Purpose: Closes the requested file |
151
|
|
|
|
|
|
|
# Returns: Return value of close |
152
|
|
|
|
|
|
|
# Usage: $rv = delLogger(%record); |
153
|
|
|
|
|
|
|
|
154
|
2
|
|
|
2
|
1
|
16
|
my %record = @_; |
155
|
|
|
|
|
|
|
|
156
|
2
|
|
|
|
|
11
|
return pclose( $record{options}{file} ); |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
sub logMsg { |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# Purpose: Logs the passed message to the named file |
162
|
|
|
|
|
|
|
# Returns: Return value of print() |
163
|
|
|
|
|
|
|
# Usage: $rv = logMsg(%record); |
164
|
|
|
|
|
|
|
|
165
|
256
|
|
|
256
|
1
|
2621
|
my %record = @_; |
166
|
256
|
|
|
|
|
528
|
my ( $fh, $message, $rv ); |
167
|
|
|
|
|
|
|
|
168
|
256
|
|
|
|
|
971
|
pdebug( 'entering w/%s', PDLEVEL1, %record ); |
169
|
256
|
|
|
|
|
828
|
pIn(); |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
# Get the message and make sure it's terminated by a single newline |
172
|
256
|
|
|
|
|
504
|
$message = $record{message}; |
173
|
256
|
|
|
|
|
2297
|
$message =~ s/\n*$/\n/so; |
174
|
|
|
|
|
|
|
|
175
|
256
|
50
|
|
|
|
864
|
if ( $record{options}{syslog} ) { |
176
|
256
|
|
|
|
|
726
|
$message =~ s/\n//so; |
177
|
|
|
|
|
|
|
$message = sprintf "%s %s %s[%d]: %s\n", |
178
|
256
|
|
|
|
|
1141
|
_timestamp( $record{msgtime} ), $hostname, $pname, $$, |
179
|
|
|
|
|
|
|
substr $message, 0, 2048; |
180
|
|
|
|
|
|
|
} |
181
|
|
|
|
|
|
|
|
182
|
256
|
|
|
|
|
1623
|
$rv = pappend( $record{options}{file}, $message ); |
183
|
|
|
|
|
|
|
|
184
|
256
|
|
|
|
|
764
|
pOut(); |
185
|
256
|
|
|
|
|
605
|
pdebug( 'leaving w/rv: %s', PDLEVEL1, $rv ); |
186
|
|
|
|
|
|
|
|
187
|
256
|
|
|
|
|
1733
|
return $rv; |
188
|
|
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
1; |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
__END__ |