line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# |
2
|
|
|
|
|
|
|
# $Id: SmartTail.pm,v 4.66 2008/07/09 20:40:20 mprewitt Exp $ |
3
|
|
|
|
|
|
|
# |
4
|
|
|
|
|
|
|
# ----- |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
B Routines to smartly tail a file |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 SYNOPSIS |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
Special tail routines to tail a file, remember where you were, and |
13
|
|
|
|
|
|
|
pick up from there again if necessary. |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
Called as: |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
use File::SmartTail; |
18
|
|
|
|
|
|
|
$tail = new File::SmartTail(file1, file2, ...); |
19
|
|
|
|
|
|
|
while ($line = $tail->Tail()) { |
20
|
|
|
|
|
|
|
print $line; |
21
|
|
|
|
|
|
|
} |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
Or: |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
$tail = new File::SmartTail; |
26
|
|
|
|
|
|
|
$tail->WatchFile(-file=>"file1", |
27
|
|
|
|
|
|
|
-type=>"UNIX-REMOTE", |
28
|
|
|
|
|
|
|
-host=>"lamachine", |
29
|
|
|
|
|
|
|
-user=>"bozo", |
30
|
|
|
|
|
|
|
-rmtopts=>"-type UNIX -prefix appname", |
31
|
|
|
|
|
|
|
-date=>"parsed", -yrfmt=>4, -monthdir=>"../..", |
32
|
|
|
|
|
|
|
-timeout=>999, |
33
|
|
|
|
|
|
|
-request_timeout=>999, |
34
|
|
|
|
|
|
|
-prefix=>appname, |
35
|
|
|
|
|
|
|
-reset=>1); |
36
|
|
|
|
|
|
|
while ($line = GetLine(-doitfn=>\&YourFn)) { |
37
|
|
|
|
|
|
|
print $line; |
38
|
|
|
|
|
|
|
} |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
The format of the result is: |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
hostname:filename:line-of-data |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
See WatchFile for detailed description of options. |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
=head1 DESCRIPTION |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
The File::SmartTail module provides functionality modeled on the UNIX tail command, but enhanced with a variety of options, and the capability to "remember" how far it has processed a file, between invocations. rtail.pl is not normally used directly, but is invoked by a File::SmartTail object when monitoring a file on a remote host. When monitoring files on a remote machine, rtail.pl must be in the path of the owner of the process, on the remote machine. Normally it is installed in /usr/local/bin. |
49
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
=head1 AUTHOR |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
DMJA, Inc |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
=head1 COPYRIGHT |
55
|
|
|
|
|
|
|
|
56
|
|
|
|
|
|
|
Copyright (C) 2003-2008 DMJA, Inc, File::SmartTail comes with |
57
|
|
|
|
|
|
|
ABSOLUTELY NO WARRANTY. This is free software, and you are welcome to |
58
|
|
|
|
|
|
|
redistribute it and/or modify it under the same terms as Perl itself. |
59
|
|
|
|
|
|
|
See the "The Artistic License" L for more details. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
=cut |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
package File::SmartTail; |
64
|
|
|
|
|
|
|
|
65
|
3
|
|
|
3
|
|
2897
|
use strict; |
|
3
|
|
|
|
|
6
|
|
|
3
|
|
|
|
|
119
|
|
66
|
3
|
|
|
3
|
|
16
|
use vars qw( $VERSION ); |
|
3
|
|
|
|
|
4
|
|
|
3
|
|
|
|
|
127
|
|
67
|
3
|
|
|
3
|
|
1103
|
use DB_File; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
use NDBM_File; |
69
|
|
|
|
|
|
|
use Fcntl; |
70
|
|
|
|
|
|
|
use File::Basename; |
71
|
|
|
|
|
|
|
use IO::Seekable; |
72
|
|
|
|
|
|
|
use IO::File; |
73
|
|
|
|
|
|
|
use IO::Socket; |
74
|
|
|
|
|
|
|
use Time::Local; |
75
|
|
|
|
|
|
|
use Sys::Hostname; |
76
|
|
|
|
|
|
|
use File::SmartTail::Logger; |
77
|
|
|
|
|
|
|
use File::SmartTail::DB; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
$VERSION = (qw$Revision: 4.66 $)[1]; |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
use vars qw( $BATCHLIM $BEAT $BEATOUT $COUNT $DIRTY $MAX_RETRIES $SLEEP $TODAY $TOMORROW ); |
82
|
|
|
|
|
|
|
|
83
|
|
|
|
|
|
|
# |
84
|
|
|
|
|
|
|
# Heartbeat frequency (seconds), heartbeat timeout interval (seconds), |
85
|
|
|
|
|
|
|
# maximum attempts to restart remote process ("your results may vary"), |
86
|
|
|
|
|
|
|
# |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
$BEAT = 30; |
89
|
|
|
|
|
|
|
$BEATOUT = 120; |
90
|
|
|
|
|
|
|
$MAX_RETRIES = 6; |
91
|
|
|
|
|
|
|
$SLEEP = 2; |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
$BATCHLIM = 100; # Chunk of records before running DoIt() if present. |
94
|
|
|
|
|
|
|
$COUNT = 0; |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
#$BINDIR="/usr/local/bin"; |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
$TODAY = fmtime(time, 4); |
99
|
|
|
|
|
|
|
$TOMORROW = rolldate($TODAY, 4); |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
=head2 new |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
$tail = new File::SmartTail($filename1, $filename2, ...) |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
or |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
$tail = new File::SmartTail(-tietype=>$type, -statuskey=>$programname, -bindir=>$rtail_script_location, $filename1, $filename2, ...) |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
Supported tietypes: |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
NDBM_File |
112
|
|
|
|
|
|
|
DB_File |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
Default statuskey is name of invoking program. |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
=cut |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
sub new { |
119
|
|
|
|
|
|
|
my $type = shift; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
my $self = bless {}, ref $type || $type; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
# |
124
|
|
|
|
|
|
|
# due to funny API, we do a funny thing here.... |
125
|
|
|
|
|
|
|
# it's a hash; it's a list; what is it? |
126
|
|
|
|
|
|
|
# |
127
|
|
|
|
|
|
|
my $STATUSKEY; |
128
|
|
|
|
|
|
|
my $TIETYPE; |
129
|
|
|
|
|
|
|
my %args; |
130
|
|
|
|
|
|
|
@args{ @_ } = (); |
131
|
|
|
|
|
|
|
my %h = @_; |
132
|
|
|
|
|
|
|
if ( exists $h{-tietype} ) { |
133
|
|
|
|
|
|
|
$h{-tietype} && $h{-tietype} =~ /NDBM/ and $TIETYPE = 'NDBM_File'; |
134
|
|
|
|
|
|
|
delete @args{ '-tietype', $h{-tietype} }; |
135
|
|
|
|
|
|
|
} |
136
|
|
|
|
|
|
|
if ( exists $h{-statuskey} ) { |
137
|
|
|
|
|
|
|
$h{-statuskey} and $STATUSKEY = $h{-statuskey}; |
138
|
|
|
|
|
|
|
delete @args{ '-statuskey', $h{-statuskey} }; |
139
|
|
|
|
|
|
|
} |
140
|
|
|
|
|
|
|
if ( exists $h{-bindir} ) { |
141
|
|
|
|
|
|
|
$self->{BINDIR} = $h{-bindir}; |
142
|
|
|
|
|
|
|
delete @args{ '-bindir', $h{-bindir} }; |
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
# |
145
|
|
|
|
|
|
|
# remaining args in original order, in case order matters |
146
|
|
|
|
|
|
|
# |
147
|
|
|
|
|
|
|
my @parms = grep exists $args{$_}, @_; |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
# |
150
|
|
|
|
|
|
|
# Use a key to record where we are in the file. |
151
|
|
|
|
|
|
|
# |
152
|
|
|
|
|
|
|
$STATUSKEY or $STATUSKEY = $0; |
153
|
|
|
|
|
|
|
$STATUSKEY = basename($STATUSKEY); |
154
|
|
|
|
|
|
|
$STATUSKEY =~ s/\W/_/g; |
155
|
|
|
|
|
|
|
$STATUSKEY .= ":$>"; |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
$self->{DB} = File::SmartTail::DB->new( statuskey => $STATUSKEY, tietype => $TIETYPE ); |
158
|
|
|
|
|
|
|
### |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# |
161
|
|
|
|
|
|
|
# Go ahead and open all the files. |
162
|
|
|
|
|
|
|
# |
163
|
|
|
|
|
|
|
foreach my $file ( @parms ) { |
164
|
|
|
|
|
|
|
$self->OpenFile( $file ) || |
165
|
|
|
|
|
|
|
die "Unable to tail file \"$file\" [$!]."; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
return $self; |
169
|
|
|
|
|
|
|
} |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head2 Tail |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
$tail->Tail() |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
or |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
$tail->Tail( @files ) (doesn't seem to be supported) |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
Format of the returned line is: |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
$file1: line of file here. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
As a degenerate case, $tail->Tail( $file ) will simply return the next |
184
|
|
|
|
|
|
|
line without a need to manage or massage. |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
=cut |
187
|
|
|
|
|
|
|
sub Tail { |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
my $self = shift; |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
# |
192
|
|
|
|
|
|
|
# Now, read through the files. If the file has stuff in its array, |
193
|
|
|
|
|
|
|
# then start by returning stuff from there. If it does not, then |
194
|
|
|
|
|
|
|
# read some more into the file, parse it, and then return it. |
195
|
|
|
|
|
|
|
# Otherwise, go on to the next file. |
196
|
|
|
|
|
|
|
# |
197
|
|
|
|
|
|
|
for ( ; ; ) { |
198
|
|
|
|
|
|
|
if ( $DIRTY && ! ( $COUNT++ % 10 ) ) { |
199
|
|
|
|
|
|
|
$DIRTY = 0; |
200
|
|
|
|
|
|
|
$self->{DB}->sync; |
201
|
|
|
|
|
|
|
} |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
FILE: foreach my $file ( keys %{ $self->{file_data} } ) { |
204
|
|
|
|
|
|
|
my $line; |
205
|
|
|
|
|
|
|
if ( ! @{$self->{file_data}->{$file}->{array}} ) { |
206
|
|
|
|
|
|
|
# |
207
|
|
|
|
|
|
|
# If there's nothing left on the array, then read something new in. |
208
|
|
|
|
|
|
|
# This should never fail, I think. |
209
|
|
|
|
|
|
|
# |
210
|
|
|
|
|
|
|
my $length; |
211
|
|
|
|
|
|
|
SYSREAD: { |
212
|
|
|
|
|
|
|
$length = $self->{file_data}->{$file}->{FILE}->sysread($line, 1024); |
213
|
|
|
|
|
|
|
unless ( defined $length ) { |
214
|
|
|
|
|
|
|
next SYSREAD if $! =~ /^Interrupted/; |
215
|
|
|
|
|
|
|
die "sysread of $file failed [$!].\n"; |
216
|
|
|
|
|
|
|
} |
217
|
|
|
|
|
|
|
}; |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
if ( ! $length ) { |
220
|
|
|
|
|
|
|
# |
221
|
|
|
|
|
|
|
# Hmmm...zero length here, perhaps we've been aged out? |
222
|
|
|
|
|
|
|
# |
223
|
|
|
|
|
|
|
my ( $inode, $size ) = (stat($file))[1,7]; |
224
|
|
|
|
|
|
|
if ( $self->{file_data}->{$file}->{inode} != $inode || |
225
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{seek} > $size ) { |
226
|
|
|
|
|
|
|
# |
227
|
|
|
|
|
|
|
# We've been aged (inode diff) or we've been truncated |
228
|
|
|
|
|
|
|
# (our checkpoint is larger than the file.) |
229
|
|
|
|
|
|
|
# |
230
|
|
|
|
|
|
|
$self->OpenFile( $file ) || |
231
|
|
|
|
|
|
|
die "Unable to tail file \"$file\" [$!]\n"; |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
# |
234
|
|
|
|
|
|
|
# In any case, we didn't read anything, so go to the next file. |
235
|
|
|
|
|
|
|
# |
236
|
|
|
|
|
|
|
next FILE; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
# |
240
|
|
|
|
|
|
|
# We read something! But don't forget to add on anything we may have |
241
|
|
|
|
|
|
|
# read before. Build our array by splitting our latest read plus whatever |
242
|
|
|
|
|
|
|
# is saved. |
243
|
|
|
|
|
|
|
# |
244
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{array} = [ split( /^/m, $self->{file_data}->{$file}->{line} . $line) ]; |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
# |
247
|
|
|
|
|
|
|
# If there's a leftover piece, then save it in the "line". Otherwise, |
248
|
|
|
|
|
|
|
# clear it out. |
249
|
|
|
|
|
|
|
# |
250
|
|
|
|
|
|
|
if ( substr($self->{file_data}->{$file}->{array}->[$#{$self->{file_data}->{$file}->{array}}], |
251
|
|
|
|
|
|
|
-1, 1) ne "\n" ) { |
252
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{line} = pop @{$self->{file_data}->{$file}->{array}}; |
253
|
|
|
|
|
|
|
next unless @{$self->{file_data}->{$file}->{array}}; |
254
|
|
|
|
|
|
|
} else { |
255
|
|
|
|
|
|
|
undef $self->{file_data}->{$file}->{line}; |
256
|
|
|
|
|
|
|
} |
257
|
|
|
|
|
|
|
} |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
# |
260
|
|
|
|
|
|
|
# If we make it here, then we have something on our array to return. |
261
|
|
|
|
|
|
|
# Increment our counter and sync up our disk file. |
262
|
|
|
|
|
|
|
# |
263
|
|
|
|
|
|
|
my $return = shift @{$self->{file_data}->{$file}->{"array"}}; |
264
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{seek} += length($return); |
265
|
|
|
|
|
|
|
if ($self->{DB}->{STATFILE}) { |
266
|
|
|
|
|
|
|
$self->{DB}->{STATUS}->{$file} = "$self->{file_data}->{$file}->{inode}:$self->{file_data}->{$file}->{seek}"; |
267
|
|
|
|
|
|
|
} |
268
|
|
|
|
|
|
|
$DIRTY++; |
269
|
|
|
|
|
|
|
return "$file:$return"; |
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
# |
272
|
|
|
|
|
|
|
# Still here? That means we redo the loop. |
273
|
|
|
|
|
|
|
# |
274
|
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
sleep $SLEEP; |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
sub OpenFile { |
280
|
|
|
|
|
|
|
my( $self, $file ) = @_; |
281
|
|
|
|
|
|
|
# |
282
|
|
|
|
|
|
|
# Give the file a moment to reappear if it's not there. |
283
|
|
|
|
|
|
|
# |
284
|
|
|
|
|
|
|
unless ( -r $file ) { |
285
|
|
|
|
|
|
|
sleep 10; |
286
|
|
|
|
|
|
|
unless ( -r $file ) { |
287
|
|
|
|
|
|
|
$! = 2; |
288
|
|
|
|
|
|
|
return undef; |
289
|
|
|
|
|
|
|
} |
290
|
|
|
|
|
|
|
} |
291
|
|
|
|
|
|
|
|
292
|
|
|
|
|
|
|
# |
293
|
|
|
|
|
|
|
# Stat it, and see if it's the file we were last tailing if this |
294
|
|
|
|
|
|
|
# is the first time we're trying to open the file. |
295
|
|
|
|
|
|
|
# |
296
|
|
|
|
|
|
|
my $foundfile = $file; |
297
|
|
|
|
|
|
|
if ($self->{DB}->{STATFILE}) { |
298
|
|
|
|
|
|
|
if ( ! $self->{file_data}->{$file}->{done} ) { |
299
|
|
|
|
|
|
|
( $self->{file_data}->{$file}->{inode}, $self->{file_data}->{$file}->{seek} ) = split(/:/, $self->{DB}->{STATUS}->{$file} ); |
300
|
|
|
|
|
|
|
my $inode = (stat($file))[1]; |
301
|
|
|
|
|
|
|
if ( $self->{file_data}->{$file}->{inode} && |
302
|
|
|
|
|
|
|
$inode != $self->{file_data}->{$file}->{inode} ) { |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
# |
305
|
|
|
|
|
|
|
# It's not where we left off. Uh-oh - see if we can find the |
306
|
|
|
|
|
|
|
# last inode we were on when we quit. |
307
|
|
|
|
|
|
|
# |
308
|
|
|
|
|
|
|
my ( $findfile, $dir, $item ); |
309
|
|
|
|
|
|
|
$findfile = basename($file); |
310
|
|
|
|
|
|
|
$dir = dirname($file); |
311
|
|
|
|
|
|
|
opendir(DIR, $dir) || |
312
|
|
|
|
|
|
|
die "Unable to read directory $dir to search for previous file [$!].\n"; |
313
|
|
|
|
|
|
|
foreach $item ( grep(/^$findfile\.\d+/, readdir DIR ) ) { |
314
|
|
|
|
|
|
|
next unless (stat("$dir/$item"))[1] == $self->{file_data}->{$file}->{inode}; |
315
|
|
|
|
|
|
|
$foundfile = "$dir/$item"; |
316
|
|
|
|
|
|
|
last; |
317
|
|
|
|
|
|
|
} |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
} |
321
|
|
|
|
|
|
|
# |
322
|
|
|
|
|
|
|
# Now, open the file. |
323
|
|
|
|
|
|
|
# |
324
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{FILE} = new IO::File; |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
# |
327
|
|
|
|
|
|
|
# Did we find a temporary old ratty file to tail from? Either |
328
|
|
|
|
|
|
|
# way, get our current $inode and size. |
329
|
|
|
|
|
|
|
# |
330
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{FILE}->open("< $foundfile") || |
331
|
|
|
|
|
|
|
die "Failed to open $file [$!].\n"; |
332
|
|
|
|
|
|
|
my ( $inode, $size ) = (stat($foundfile))[1,7]; |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{done}++; |
335
|
|
|
|
|
|
|
|
336
|
|
|
|
|
|
|
# |
337
|
|
|
|
|
|
|
# Clear our array. |
338
|
|
|
|
|
|
|
# |
339
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{array} = [ ]; |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
if ($self->{DB}->{STATFILE}) { |
342
|
|
|
|
|
|
|
if ( $inode == $self->{file_data}->{$file}->{inode} ) { |
343
|
|
|
|
|
|
|
# |
344
|
|
|
|
|
|
|
# We've reopened the same file. Skip ahead to count. |
345
|
|
|
|
|
|
|
# |
346
|
|
|
|
|
|
|
if ( $size >= $self->{file_data}->{$file}->{seek} && |
347
|
|
|
|
|
|
|
sysseek($self->{file_data}->{$file}->{FILE}, $self->{file_data}->{$file}->{seek}, 0 ) ) { |
348
|
|
|
|
|
|
|
# |
349
|
|
|
|
|
|
|
# Successful read. Let's return and be done. |
350
|
|
|
|
|
|
|
# |
351
|
|
|
|
|
|
|
return 1; |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
# |
356
|
|
|
|
|
|
|
# We've opened a new file OR the above if failed and it's a truncated |
357
|
|
|
|
|
|
|
# file, so we start as if we reopened the file anyway. |
358
|
|
|
|
|
|
|
# |
359
|
|
|
|
|
|
|
$self->{DB}->{STATUS}->{$file} = "$inode:0"; |
360
|
|
|
|
|
|
|
$self->{DB}->sync; |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{inode} = $inode; |
363
|
|
|
|
|
|
|
$self->{file_data}->{$file}->{seek} = 0; |
364
|
|
|
|
|
|
|
|
365
|
|
|
|
|
|
|
return 1; |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub OpenFileWithOpts { |
369
|
|
|
|
|
|
|
my( $self, $key ) = @_; |
370
|
|
|
|
|
|
|
# |
371
|
|
|
|
|
|
|
# Give the file a moment to reappear if it's not there. |
372
|
|
|
|
|
|
|
# |
373
|
|
|
|
|
|
|
my $filename = $self->{file_data}->{$key}->{opts}->{-current}; |
374
|
|
|
|
|
|
|
LOG()->debug( "filename: $filename" ); |
375
|
|
|
|
|
|
|
unless ( -r $filename ) { |
376
|
|
|
|
|
|
|
sleep 10; |
377
|
|
|
|
|
|
|
unless ( -r $filename ) { |
378
|
|
|
|
|
|
|
$! = 2; |
379
|
|
|
|
|
|
|
return undef; |
380
|
|
|
|
|
|
|
} |
381
|
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
my $hostname = $self->{file_data}->{$key}->{opts}->{-host}; |
384
|
|
|
|
|
|
|
my $prefix = $self->{file_data}->{$key}->{opts}->{-prefix}; |
385
|
|
|
|
|
|
|
# |
386
|
|
|
|
|
|
|
# Stat it, and see if it's the file we were last tailing if this |
387
|
|
|
|
|
|
|
# is the first time we're trying to open the file. |
388
|
|
|
|
|
|
|
# |
389
|
|
|
|
|
|
|
my $foundfile = $filename; |
390
|
|
|
|
|
|
|
if ($self->{DB}->{STATFILE}) { |
391
|
|
|
|
|
|
|
if ( ! $self->{file_data}->{$key}->{done} ) { |
392
|
|
|
|
|
|
|
LOG()->debug( sub { |
393
|
|
|
|
|
|
|
my $db_key = "$prefix:$hostname:$filename"; |
394
|
|
|
|
|
|
|
my $db_val = $self->{DB}->{STATUS}->{$db_key}; |
395
|
|
|
|
|
|
|
"$db_key => $db_val"; |
396
|
|
|
|
|
|
|
} ); |
397
|
|
|
|
|
|
|
( $self->{file_data}->{$key}->{inode}, $self->{file_data}->{$key}->{seek} ) = split(/:/, $self->{DB}->{STATUS}->{"$prefix:$hostname:$filename"} ); |
398
|
|
|
|
|
|
|
my $inode = (stat($filename))[1]; |
399
|
|
|
|
|
|
|
LOG()->debug( "filename: $filename; inode: $inode" ); |
400
|
|
|
|
|
|
|
if ( $self->{file_data}->{$key}->{inode} && |
401
|
|
|
|
|
|
|
$inode != $self->{file_data}->{$key}->{inode} ) { |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
# |
404
|
|
|
|
|
|
|
# It's not where we left off. Uh-oh - see if we can find the |
405
|
|
|
|
|
|
|
# last inode we were on when we quit. |
406
|
|
|
|
|
|
|
# |
407
|
|
|
|
|
|
|
LOG()->debug( "filename: $filename; inode: $inode; self->{file_data}->{$key}->{inode}:$self->{file_data}->{$key}->{inode} " ); |
408
|
|
|
|
|
|
|
my ( $findfile, $dir, $item ); |
409
|
|
|
|
|
|
|
$findfile = basename($filename); |
410
|
|
|
|
|
|
|
$dir = dirname($filename); |
411
|
|
|
|
|
|
|
opendir(DIR, $dir) || |
412
|
|
|
|
|
|
|
die "Unable to read directory $dir to search for previous file [$!].\n"; |
413
|
|
|
|
|
|
|
foreach $item ( grep(/^$findfile\.\d+/, readdir DIR ) ) { |
414
|
|
|
|
|
|
|
next unless (stat("$dir/$item"))[1] == $self->{file_data}->{$key}->{inode}; |
415
|
|
|
|
|
|
|
$foundfile = "$dir/$item"; |
416
|
|
|
|
|
|
|
last; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
} |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
} |
422
|
|
|
|
|
|
|
# |
423
|
|
|
|
|
|
|
# Now, open the file. |
424
|
|
|
|
|
|
|
# |
425
|
|
|
|
|
|
|
if (defined $self->{file_data}->{$key}->{FILE}) { |
426
|
|
|
|
|
|
|
undef $self->{file_data}->{$key}->{FILE}; |
427
|
|
|
|
|
|
|
} |
428
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{FILE} = new IO::File; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
# |
431
|
|
|
|
|
|
|
# Did we find a temporary old ratty file to tail from? Either |
432
|
|
|
|
|
|
|
# way, get our current $inode and size. |
433
|
|
|
|
|
|
|
# |
434
|
|
|
|
|
|
|
LOG()->debug( qq( open("< $foundfile") ) ); |
435
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{FILE}->open("< $foundfile") || |
436
|
|
|
|
|
|
|
die "Failed to open $foundfile [$!].\n"; |
437
|
|
|
|
|
|
|
my ( $inode, $size ) = (stat($foundfile))[1,7]; |
438
|
|
|
|
|
|
|
|
439
|
|
|
|
|
|
|
LOG()->debug( "foundfile: $foundfile; inode: $inode; size: $size" ); |
440
|
|
|
|
|
|
|
LOG()->debug( "key: $key; inode: $self->{file_data}->{$key}->{inode}; seek: $self->{file_data}->{$key}->{seek}" ); |
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{done}++; |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
# |
445
|
|
|
|
|
|
|
# Clear our array. |
446
|
|
|
|
|
|
|
# |
447
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{array} = [ ]; |
448
|
|
|
|
|
|
|
if ($self->{DB}->{STATFILE}) { |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
if ( $inode == $self->{file_data}->{$key}->{inode} ) { |
451
|
|
|
|
|
|
|
# |
452
|
|
|
|
|
|
|
# We've reopened the same file. Skip ahead to count. |
453
|
|
|
|
|
|
|
# |
454
|
|
|
|
|
|
|
LOG()->debug( "We've reopened the same file. Skip ahead to count." ); |
455
|
|
|
|
|
|
|
if ( $size >= $self->{file_data}->{$key}->{seek} && |
456
|
|
|
|
|
|
|
sysseek($self->{file_data}->{$key}->{FILE}, $self->{file_data}->{$key}->{seek}, 0 ) ) { |
457
|
|
|
|
|
|
|
# |
458
|
|
|
|
|
|
|
# Successful read. Let's return and be done. |
459
|
|
|
|
|
|
|
# |
460
|
|
|
|
|
|
|
LOG()->debug( "Successful seek. Let's return and be done." ); |
461
|
|
|
|
|
|
|
return 1; |
462
|
|
|
|
|
|
|
} |
463
|
|
|
|
|
|
|
} |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
# |
466
|
|
|
|
|
|
|
# We've opened a new file OR the above if failed and it's a truncated |
467
|
|
|
|
|
|
|
# file, so we start as if we reopened the file anyway. |
468
|
|
|
|
|
|
|
# |
469
|
|
|
|
|
|
|
LOG()->debug( "We've opened a new file OR same file, but it has been truncated. Start as if we reopened the file anyway." ); |
470
|
|
|
|
|
|
|
$self->{DB}->{STATUS}->{"$prefix:$hostname:$filename"} = "$inode:0"; |
471
|
|
|
|
|
|
|
$self->{DB}->sync; |
472
|
|
|
|
|
|
|
} |
473
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{inode} = $inode; |
474
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{seek} = 0; |
475
|
|
|
|
|
|
|
|
476
|
|
|
|
|
|
|
LOG()->debug( sub { $self->{DB}->DumpStatus } ); |
477
|
|
|
|
|
|
|
|
478
|
|
|
|
|
|
|
return 1; |
479
|
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
|
|
481
|
|
|
|
|
|
|
=head2 Watchfile |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
WatchFile(-option1=>"value1", -option2=>"value2", ...) |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
=over 4 |
486
|
|
|
|
|
|
|
|
487
|
|
|
|
|
|
|
B |
488
|
|
|
|
|
|
|
|
489
|
|
|
|
|
|
|
=over 4 |
490
|
|
|
|
|
|
|
|
491
|
|
|
|
|
|
|
=item -file=>"filename" |
492
|
|
|
|
|
|
|
|
493
|
|
|
|
|
|
|
The name of a file to watch. |
494
|
|
|
|
|
|
|
|
495
|
|
|
|
|
|
|
=back |
496
|
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
B |
498
|
|
|
|
|
|
|
|
499
|
|
|
|
|
|
|
=over 4 |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
=item -type=>"UNIX" (default, i.e. if omitted) or "UNIX-REMOTE" |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=item -rmtsh=>"ssh" (default) valid values are "rsh" or "ssh" |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
=item -host=>"host" |
506
|
|
|
|
|
|
|
|
507
|
|
|
|
|
|
|
Required for type "UNIX-REMOTE" unless file name is of the form host:filename (similar to rcp). |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
=item -rmtopts=>"-opt1 val1 -opt2 val2" |
510
|
|
|
|
|
|
|
|
511
|
|
|
|
|
|
|
Any flags that should be passed to the remote process. Since these become command-line args, they should have the form "-opt1 val1 -opt2 val2 ...". |
512
|
|
|
|
|
|
|
|
513
|
|
|
|
|
|
|
=item -date=>'parsed' or 'gz' |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
indicates special date-related file |
516
|
|
|
|
|
|
|
processing. B is used with files having dates in their |
517
|
|
|
|
|
|
|
name. B is used for files which are archived so that a new |
518
|
|
|
|
|
|
|
open call is needed to continue monitoring. Other archive |
519
|
|
|
|
|
|
|
file extensions can be used in theory, but the file name is |
520
|
|
|
|
|
|
|
assumed to be of the format name.date.extension |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
=item -yrfmt=>2 or 4 |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
For files having dates in their name, how |
525
|
|
|
|
|
|
|
many digits are used to represent the year. The default |
526
|
|
|
|
|
|
|
is 2, but a value of 4 may be set with this option. |
527
|
|
|
|
|
|
|
|
528
|
|
|
|
|
|
|
=item -monthdir=>$relative_path |
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
for files having dates in their |
531
|
|
|
|
|
|
|
name, to indicate, where applicable, the relative position |
532
|
|
|
|
|
|
|
in the path of the month's directory. E.g. ".." |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
=item -timeout=>$secs |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
Used for an application-specific timeout. If the file does not grow during |
537
|
|
|
|
|
|
|
the specified interval, a message of the form |
538
|
|
|
|
|
|
|
host1:file1:_timeout_999999999 is returned, where 999999999 is |
539
|
|
|
|
|
|
|
secs-in-epoch (UNIX timestamp). |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
=item -request_timeout=>$secs |
542
|
|
|
|
|
|
|
|
543
|
|
|
|
|
|
|
Used for an application-specific timeout. If no data is available within the |
544
|
|
|
|
|
|
|
specified interval from the time the request was made (GetLine() was called), a |
545
|
|
|
|
|
|
|
message of the form host1:file1:_timeout_999999999 is returned, where 999999999 |
546
|
|
|
|
|
|
|
is secs-in-epoch (UNIX timestamp). |
547
|
|
|
|
|
|
|
|
548
|
|
|
|
|
|
|
=back |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
B |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
=over 4 |
553
|
|
|
|
|
|
|
|
554
|
|
|
|
|
|
|
=item -heartbeat=>"send" |
555
|
|
|
|
|
|
|
|
556
|
|
|
|
|
|
|
Set on the child process for a "UNIX-REMOTE" file. Similarly, flags will |
557
|
|
|
|
|
|
|
be set in the parent process to listen for the heartbeat. |
558
|
|
|
|
|
|
|
|
559
|
|
|
|
|
|
|
When processing a UNIX-REMOTE file, the child process is set to send an |
560
|
|
|
|
|
|
|
internal heartbeat message, and the local process is set to receive them. |
561
|
|
|
|
|
|
|
The heartbeat messages are of the form host1:file1:_heartbeat_999999999 |
562
|
|
|
|
|
|
|
where 999999999 is secs-in-epoch (UNIX timestamp). |
563
|
|
|
|
|
|
|
|
564
|
|
|
|
|
|
|
=item -current |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
Holds the current file name. This is used when |
567
|
|
|
|
|
|
|
files with date-suffixed names roll, since the hash entry is |
568
|
|
|
|
|
|
|
still keyed by the original file name. |
569
|
|
|
|
|
|
|
|
570
|
|
|
|
|
|
|
=item -prefix |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
a prefix for the filestatus file, which is used to |
573
|
|
|
|
|
|
|
keep track of the seek pointer between invocations. The default |
574
|
|
|
|
|
|
|
is the path of the calling application. |
575
|
|
|
|
|
|
|
|
576
|
|
|
|
|
|
|
=item -reset=>1 |
577
|
|
|
|
|
|
|
|
578
|
|
|
|
|
|
|
will ignore the status file that normally keeps |
579
|
|
|
|
|
|
|
track of Tail's progress through the file, including between |
580
|
|
|
|
|
|
|
invocations |
581
|
|
|
|
|
|
|
|
582
|
|
|
|
|
|
|
=item -clear=>1 |
583
|
|
|
|
|
|
|
|
584
|
|
|
|
|
|
|
like -reset, but will remove the file. |
585
|
|
|
|
|
|
|
|
586
|
|
|
|
|
|
|
=back |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
=back |
589
|
|
|
|
|
|
|
|
590
|
|
|
|
|
|
|
=cut |
591
|
|
|
|
|
|
|
sub WatchFile { |
592
|
|
|
|
|
|
|
my ($self, %opts) = @_; |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
%opts = %{$self->ResolveOpts(%opts)}; |
595
|
|
|
|
|
|
|
my $key = $opts{-file}; |
596
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts} = \%opts; |
597
|
|
|
|
|
|
|
|
598
|
|
|
|
|
|
|
if ($opts{-type} eq "UNIX"){ |
599
|
|
|
|
|
|
|
$self->OpenFileWithOpts( $key ) || |
600
|
|
|
|
|
|
|
die "Unable to tail \"$key\" [$!]\n"; |
601
|
|
|
|
|
|
|
} |
602
|
|
|
|
|
|
|
elsif ($opts{-type} eq "UNIX-REMOTE") { |
603
|
|
|
|
|
|
|
$self->OpenRemote( %opts ) || |
604
|
|
|
|
|
|
|
die "Unable to tail \"$key\" [$!]\n"; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
else { |
607
|
|
|
|
|
|
|
die "Unknown file type \"$opts{-type}\".\n"; |
608
|
|
|
|
|
|
|
} |
609
|
|
|
|
|
|
|
} |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
sub OpenRemote { |
612
|
|
|
|
|
|
|
my ($self, %opts) = @_; |
613
|
|
|
|
|
|
|
my $userflag = ""; |
614
|
|
|
|
|
|
|
my $key = $opts{-file}; |
615
|
|
|
|
|
|
|
my $filename = $opts{-current}; |
616
|
|
|
|
|
|
|
my $hostname = $opts{-host}; |
617
|
|
|
|
|
|
|
my $prefix = $opts{-prefix}; |
618
|
|
|
|
|
|
|
my $ssh = $opts{-rmtsh} || $self->{file_data}->{$key}->{opts}->{-rmtsh} || "ssh"; |
619
|
|
|
|
|
|
|
my ($conn_try, $port, $port_try, $ssh_try, $sock, $tmpfile); |
620
|
|
|
|
|
|
|
|
621
|
|
|
|
|
|
|
if ($opts{-user}) { |
622
|
|
|
|
|
|
|
$userflag = "-l $opts{-user}"; |
623
|
|
|
|
|
|
|
} |
624
|
|
|
|
|
|
|
my $rmtopts = $opts{-rmtopts} || ""; |
625
|
|
|
|
|
|
|
# |
626
|
|
|
|
|
|
|
# Must have a file type for the remotely tailed file. |
627
|
|
|
|
|
|
|
# |
628
|
|
|
|
|
|
|
if (!$rmtopts =~ /\B-type\s+\w/) { |
629
|
|
|
|
|
|
|
return undef; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
# |
633
|
|
|
|
|
|
|
# Set the filestatus file prefix for the remote process |
634
|
|
|
|
|
|
|
# (if it isn't set already). |
635
|
|
|
|
|
|
|
# |
636
|
|
|
|
|
|
|
$rmtopts = $rmtopts . " -prefix $prefix" |
637
|
|
|
|
|
|
|
unless $rmtopts =~ /\B-prefix\s+\S+/; |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
# |
640
|
|
|
|
|
|
|
# Set the hostname for the remote process (if it isn't set already). |
641
|
|
|
|
|
|
|
# |
642
|
|
|
|
|
|
|
$rmtopts = $rmtopts . " -host $hostname " |
643
|
|
|
|
|
|
|
unless $rmtopts =~ /\B-host\s+\w/; |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
# |
646
|
|
|
|
|
|
|
# Send a heartbeat from the remote process and receive it here. |
647
|
|
|
|
|
|
|
# |
648
|
|
|
|
|
|
|
$rmtopts = $rmtopts . " -heartbeat send " |
649
|
|
|
|
|
|
|
unless $rmtopts =~ /\B-heartbeat\s+send\b/; |
650
|
|
|
|
|
|
|
|
651
|
|
|
|
|
|
|
# |
652
|
|
|
|
|
|
|
# Set the statuskey for the remote process (if it isn't set already). |
653
|
|
|
|
|
|
|
# |
654
|
|
|
|
|
|
|
( my $statuskey_base = $self->{DB}->{STATUSKEY} ) =~ s/:.*$//; |
655
|
|
|
|
|
|
|
$rmtopts = $rmtopts . " -statuskey rtail_$statuskey_base " |
656
|
|
|
|
|
|
|
unless $rmtopts =~ /\B-statuskey\s+\w/; |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
$opts{-heartbeat} = "recv" |
659
|
|
|
|
|
|
|
unless $opts{-heartbeat} && $opts{-heartbeat} eq "recv"; |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
# Kill child process if necessary. |
662
|
|
|
|
|
|
|
$self->Kill($key); |
663
|
|
|
|
|
|
|
|
664
|
|
|
|
|
|
|
$ssh_try = 1; |
665
|
|
|
|
|
|
|
$port_try = 1; |
666
|
|
|
|
|
|
|
my $fallback_ssh = 0; |
667
|
|
|
|
|
|
|
RSHELL: { |
668
|
|
|
|
|
|
|
$tmpfile = new IO::File; |
669
|
|
|
|
|
|
|
my $cmd = "$ssh $hostname -n $userflag $self->{BINDIR}rtail.pl -file $filename $rmtopts |"; |
670
|
|
|
|
|
|
|
LOG()->debug( qq( Preparing to open "$cmd") ); |
671
|
|
|
|
|
|
|
unless ($self->{file_data}->{$key}->{child} = $tmpfile->open($cmd)) { |
672
|
|
|
|
|
|
|
warn "Attempt $ssh_try to open of $ssh pipe for $key failed [$!] , child status [$?]\n"; |
673
|
|
|
|
|
|
|
if ( ($! =~ /^Interrupted|^Resource|^Bad file/) and ++$ssh_try < 7) { |
674
|
|
|
|
|
|
|
$self->Kill($key); |
675
|
|
|
|
|
|
|
undef $tmpfile; |
676
|
|
|
|
|
|
|
sleep 2; |
677
|
|
|
|
|
|
|
redo RSHELL; |
678
|
|
|
|
|
|
|
} else { |
679
|
|
|
|
|
|
|
if ($fallback_ssh) { |
680
|
|
|
|
|
|
|
die "Failure opening $ssh pipe for $key [$!] after $ssh_try attempts [ERR_SSH].\n"; |
681
|
|
|
|
|
|
|
} else { |
682
|
|
|
|
|
|
|
my $old_ssh = $ssh; |
683
|
|
|
|
|
|
|
if ($ssh eq "ssh") { |
684
|
|
|
|
|
|
|
$ssh = "rsh"; |
685
|
|
|
|
|
|
|
} else { |
686
|
|
|
|
|
|
|
$ssh = "ssh"; |
687
|
|
|
|
|
|
|
} |
688
|
|
|
|
|
|
|
warn "Failure opening $old_ssh pipe for $key [$!] after $ssh_try attempts [ERR_SSH]. Trying to $ssh.\n"; |
689
|
|
|
|
|
|
|
$ssh_try = 0; |
690
|
|
|
|
|
|
|
$fallback_ssh = 1; |
691
|
|
|
|
|
|
|
redo RSHELL; |
692
|
|
|
|
|
|
|
} |
693
|
|
|
|
|
|
|
} |
694
|
|
|
|
|
|
|
} |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
unless (fcntl( $tmpfile, F_SETFL, fcntl($tmpfile, F_GETFL, 0) | O_NONBLOCK )) { |
697
|
|
|
|
|
|
|
die "fcntl of $ssh pipe for $key failed [$!] [ERR_FCNTL].\n"; |
698
|
|
|
|
|
|
|
} |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
PORT: { |
701
|
|
|
|
|
|
|
$port = <$tmpfile>; |
702
|
|
|
|
|
|
|
$port_try++; |
703
|
|
|
|
|
|
|
if (not defined $port) { |
704
|
|
|
|
|
|
|
if ($! =~ /^Interrupted/ and $port_try < 20) { |
705
|
|
|
|
|
|
|
redo PORT; |
706
|
|
|
|
|
|
|
} elsif ($! =~ /^Resource/ and $port_try < 20) { |
707
|
|
|
|
|
|
|
sleep 2; |
708
|
|
|
|
|
|
|
redo PORT; |
709
|
|
|
|
|
|
|
} else { |
710
|
|
|
|
|
|
|
if ($fallback_ssh) { |
711
|
|
|
|
|
|
|
die "Failure reading port from $ssh [$!] after $port_try attempts [ERR_RETRIES].\n"; |
712
|
|
|
|
|
|
|
} else { |
713
|
|
|
|
|
|
|
my $old_ssh = $ssh; |
714
|
|
|
|
|
|
|
if ($ssh eq "ssh") { |
715
|
|
|
|
|
|
|
$ssh = "rsh"; |
716
|
|
|
|
|
|
|
} else { |
717
|
|
|
|
|
|
|
$ssh = "ssh"; |
718
|
|
|
|
|
|
|
} |
719
|
|
|
|
|
|
|
warn "Failure opening $old_ssh pipe for $key [$!] after $ssh_try attempts [ERR_SSH]. Trying to $ssh.\n"; |
720
|
|
|
|
|
|
|
$ssh_try = 0; |
721
|
|
|
|
|
|
|
$port_try = 0; |
722
|
|
|
|
|
|
|
$fallback_ssh = 1; |
723
|
|
|
|
|
|
|
redo RSHELL; |
724
|
|
|
|
|
|
|
} |
725
|
|
|
|
|
|
|
} |
726
|
|
|
|
|
|
|
} elsif ($port == 0) { |
727
|
|
|
|
|
|
|
die "Failure reading port from $ssh: 0 read after $port_try attempt(s) [ERR_EMPTY].\n" if $port_try > 20; |
728
|
|
|
|
|
|
|
sleep 2; |
729
|
|
|
|
|
|
|
redo RSHELL; |
730
|
|
|
|
|
|
|
} elsif ($port =~ /^\d+$/) { |
731
|
|
|
|
|
|
|
last RSHELL; # Success |
732
|
|
|
|
|
|
|
} else { |
733
|
|
|
|
|
|
|
die "$cmd failed: $port [ERR_REMOTE]\n"; # Remote error |
734
|
|
|
|
|
|
|
} |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
}; |
737
|
|
|
|
|
|
|
}; |
738
|
|
|
|
|
|
|
|
739
|
|
|
|
|
|
|
|
740
|
|
|
|
|
|
|
undef $tmpfile; |
741
|
|
|
|
|
|
|
|
742
|
|
|
|
|
|
|
if (defined $self->{file_data}->{$key}->{FILE}) { |
743
|
|
|
|
|
|
|
undef $self->{file_data}->{$key}->{FILE}; |
744
|
|
|
|
|
|
|
} |
745
|
|
|
|
|
|
|
$conn_try = 0; |
746
|
|
|
|
|
|
|
CONNECT: { |
747
|
|
|
|
|
|
|
unless ($self->{file_data}->{$key}->{FILE} = |
748
|
|
|
|
|
|
|
new IO::Socket::INET(PeerAddr =>$hostname, |
749
|
|
|
|
|
|
|
PeerPort =>$port, |
750
|
|
|
|
|
|
|
Proto =>'tcp')) { |
751
|
|
|
|
|
|
|
$conn_try++; |
752
|
|
|
|
|
|
|
warn "Failed creating socket for $key [$!], after $conn_try attempts\n"; |
753
|
|
|
|
|
|
|
if ( ($! =~ /^Interrupted|^Resource|^Bad file|^Connection/) and |
754
|
|
|
|
|
|
|
$conn_try < 6) { |
755
|
|
|
|
|
|
|
undef ($self->{file_data}->{$key}->{FILE}); |
756
|
|
|
|
|
|
|
sleep 2; |
757
|
|
|
|
|
|
|
redo CONNECT; |
758
|
|
|
|
|
|
|
} else { |
759
|
|
|
|
|
|
|
die "Failure creating socket for $key [$!], $conn_try attempt(s) [ERR_SOCKET].\n"; |
760
|
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
}; |
763
|
|
|
|
|
|
|
|
764
|
|
|
|
|
|
|
unless ( fcntl( $self->{file_data}->{$key}->{FILE}, F_SETFL, |
765
|
|
|
|
|
|
|
fcntl($self->{file_data}->{$key}->{FILE}, F_GETFL, 0) | |
766
|
|
|
|
|
|
|
O_NONBLOCK ) ) { |
767
|
|
|
|
|
|
|
die "fcntl of socket for $key failed [$!] [ERR_SOCKFCNTL].\n"; |
768
|
|
|
|
|
|
|
} |
769
|
|
|
|
|
|
|
|
770
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{done}++; |
771
|
|
|
|
|
|
|
|
772
|
|
|
|
|
|
|
# |
773
|
|
|
|
|
|
|
# Clear our array. |
774
|
|
|
|
|
|
|
# |
775
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{array} = [ ]; |
776
|
|
|
|
|
|
|
|
777
|
|
|
|
|
|
|
# |
778
|
|
|
|
|
|
|
# (Re)set |
779
|
|
|
|
|
|
|
# |
780
|
|
|
|
|
|
|
# No inode for remote connections. |
781
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{seek} = 0; |
782
|
|
|
|
|
|
|
if ($self->{DB}->{STATFILE}) { |
783
|
|
|
|
|
|
|
$self->{DB}->{STATUS}->{"$prefix:$hostname:$filename"} = "0:0"; |
784
|
|
|
|
|
|
|
$self->{DB}->sync; |
785
|
|
|
|
|
|
|
} |
786
|
|
|
|
|
|
|
# |
787
|
|
|
|
|
|
|
# (Re)set heartbeat detection. |
788
|
|
|
|
|
|
|
# |
789
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{heartbeat} = time; |
790
|
|
|
|
|
|
|
|
791
|
|
|
|
|
|
|
# |
792
|
|
|
|
|
|
|
# Add internal opts to object |
793
|
|
|
|
|
|
|
# |
794
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts}->{-rmtopts} = $rmtopts; |
795
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts}->{-heartbeat} = $opts{-heartbeat}; |
796
|
|
|
|
|
|
|
return 1; |
797
|
|
|
|
|
|
|
} |
798
|
|
|
|
|
|
|
|
799
|
|
|
|
|
|
|
=head2 GetLine |
800
|
|
|
|
|
|
|
|
801
|
|
|
|
|
|
|
Format of the returned line is: |
802
|
|
|
|
|
|
|
|
803
|
|
|
|
|
|
|
$hoste1:$file1: line of file here. |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
If a remote file is being followed, heartbeat messages of the form |
806
|
|
|
|
|
|
|
$host1:$file1:_heartbeat_999999999, where 999999999 is secs-in-epoch |
807
|
|
|
|
|
|
|
are returned. |
808
|
|
|
|
|
|
|
|
809
|
|
|
|
|
|
|
If a set of file opts includes a -timeout, and there is no |
810
|
|
|
|
|
|
|
activity on the file within the timeout interval, messages of the form |
811
|
|
|
|
|
|
|
$host1:file1:_timeout_999999999 |
812
|
|
|
|
|
|
|
are returned. |
813
|
|
|
|
|
|
|
|
814
|
|
|
|
|
|
|
If a set of file opts includes a -request_timeout, and there is no data to be |
815
|
|
|
|
|
|
|
returned within the timeout interval from the time that GetLine was called, |
816
|
|
|
|
|
|
|
a message of the form $host1:file1:_timeout_999999999 is returned. |
817
|
|
|
|
|
|
|
|
818
|
|
|
|
|
|
|
=cut |
819
|
|
|
|
|
|
|
sub GetLine { |
820
|
|
|
|
|
|
|
|
821
|
|
|
|
|
|
|
my ($self, %doitfn) = @_; |
822
|
|
|
|
|
|
|
my ($now, $donefiles); |
823
|
|
|
|
|
|
|
my $request_mark; |
824
|
|
|
|
|
|
|
|
825
|
|
|
|
|
|
|
# |
826
|
|
|
|
|
|
|
# First time through set up index array that we will permute |
827
|
|
|
|
|
|
|
# to reduce bias toward the first files in the keys list. |
828
|
|
|
|
|
|
|
# |
829
|
|
|
|
|
|
|
unless ( defined $self->{KEYS} ) { |
830
|
|
|
|
|
|
|
$self->{KEYS} = [ keys %{ $self->{file_data} } ]; |
831
|
|
|
|
|
|
|
$self->{FILECOUNT} = scalar @{ $self->{KEYS} }; |
832
|
|
|
|
|
|
|
} else { |
833
|
|
|
|
|
|
|
push @{ $self->{KEYS} }, shift @{ $self->{KEYS} }; |
834
|
|
|
|
|
|
|
} |
835
|
|
|
|
|
|
|
|
836
|
|
|
|
|
|
|
for ( ; ; ) { |
837
|
|
|
|
|
|
|
$request_mark ||= time(); |
838
|
|
|
|
|
|
|
$COUNT++; |
839
|
|
|
|
|
|
|
if ( $DIRTY && ! ( $COUNT % 10 ) ) { |
840
|
|
|
|
|
|
|
$DIRTY = 0; |
841
|
|
|
|
|
|
|
$self->{DB}->sync; |
842
|
|
|
|
|
|
|
} |
843
|
|
|
|
|
|
|
|
844
|
|
|
|
|
|
|
$donefiles = $self->{FILECOUNT}; |
845
|
|
|
|
|
|
|
|
846
|
|
|
|
|
|
|
# |
847
|
|
|
|
|
|
|
# Now, read through the files. If the file has stuff in its array, |
848
|
|
|
|
|
|
|
# then start by returning stuff from there. If it does not, then |
849
|
|
|
|
|
|
|
# read some more into the file, parse it, and then return it. |
850
|
|
|
|
|
|
|
# Otherwise, go on to the next file. |
851
|
|
|
|
|
|
|
# |
852
|
|
|
|
|
|
|
|
853
|
|
|
|
|
|
|
FILE: foreach my $key ( @{ $self->{KEYS} } ) { |
854
|
|
|
|
|
|
|
my $line; |
855
|
|
|
|
|
|
|
my $filename = $self->{file_data}->{$key}->{opts}->{-current}; |
856
|
|
|
|
|
|
|
my $host = $self->{file_data}->{$key}->{opts}->{-host}; |
857
|
|
|
|
|
|
|
my $prefix = $self->{file_data}->{$key}->{opts}->{-prefix}; |
858
|
|
|
|
|
|
|
# If the file has rolled, the name has changed, although it's |
859
|
|
|
|
|
|
|
# still keyed by the original name. |
860
|
|
|
|
|
|
|
if (exists $self->{file_data}->{$key}->{opts}->{-heartbeat} && |
861
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts}->{-heartbeat} eq "send") { |
862
|
|
|
|
|
|
|
my $msg = $self->Heartbeat($key); |
863
|
|
|
|
|
|
|
if (defined $msg) { |
864
|
|
|
|
|
|
|
return "$key:$msg"; |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
} |
867
|
|
|
|
|
|
|
# If heartbeat fails and the retry limit is exceeded |
868
|
|
|
|
|
|
|
# return message. |
869
|
|
|
|
|
|
|
# $self->{file_data}->{$key}->{heartbeat} will be undefined. |
870
|
|
|
|
|
|
|
elsif (exists $self->{file_data}->{$key}->{opts}->{-heartbeat} && |
871
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts}->{-heartbeat} eq "recv") { |
872
|
|
|
|
|
|
|
my $msg = $self->CheckBeat($key); |
873
|
|
|
|
|
|
|
if (defined $msg) { |
874
|
|
|
|
|
|
|
return "$key:$msg"; |
875
|
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
|
} |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
if (exists $self->{file_data}->{$key}->{opts}{-timeout}) { |
879
|
|
|
|
|
|
|
my $msg = $self->CheckTimeout($key); |
880
|
|
|
|
|
|
|
if (defined $msg) { |
881
|
|
|
|
|
|
|
return "$key:$msg"; |
882
|
|
|
|
|
|
|
} |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
} |
885
|
|
|
|
|
|
|
|
886
|
|
|
|
|
|
|
if (exists $self->{file_data}->{$key}->{opts}{-request_timeout}) { |
887
|
|
|
|
|
|
|
my $msg = $self->CheckRequestTimeout($key, $request_mark || time() ); |
888
|
|
|
|
|
|
|
if (defined $msg) { |
889
|
|
|
|
|
|
|
return "$key:$msg"; |
890
|
|
|
|
|
|
|
} |
891
|
|
|
|
|
|
|
|
892
|
|
|
|
|
|
|
} |
893
|
|
|
|
|
|
|
|
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
if ( ! @{$self->{file_data}->{$key}->{array}} ) { |
896
|
|
|
|
|
|
|
# |
897
|
|
|
|
|
|
|
# If there's nothing left on the array, then read something new in. |
898
|
|
|
|
|
|
|
# This should never fail, I think. |
899
|
|
|
|
|
|
|
# |
900
|
|
|
|
|
|
|
my $length; |
901
|
|
|
|
|
|
|
SYSREAD: { |
902
|
|
|
|
|
|
|
$length = $self->{file_data}->{$key}->{FILE}->sysread($line, 1024); |
903
|
|
|
|
|
|
|
unless ( defined $length ) { |
904
|
|
|
|
|
|
|
if ($! =~ /^Interrupted/) { |
905
|
|
|
|
|
|
|
redo SYSREAD; |
906
|
|
|
|
|
|
|
} |
907
|
|
|
|
|
|
|
elsif ($self->{file_data}->{$key}->{opts}->{-type} eq |
908
|
|
|
|
|
|
|
"UNIX-REMOTE" && $! =~ /^Resource/) { |
909
|
|
|
|
|
|
|
$donefiles--; |
910
|
|
|
|
|
|
|
next FILE; |
911
|
|
|
|
|
|
|
} |
912
|
|
|
|
|
|
|
else { |
913
|
|
|
|
|
|
|
die "sysread of $filename failed [$!].\n"; |
914
|
|
|
|
|
|
|
} |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
}; |
917
|
|
|
|
|
|
|
|
918
|
|
|
|
|
|
|
if ( ! $length ) { |
919
|
|
|
|
|
|
|
# |
920
|
|
|
|
|
|
|
# Hmmm...zero length here, perhaps we've been aged out? |
921
|
|
|
|
|
|
|
# |
922
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{opts}->{-type} eq "UNIX") { |
923
|
|
|
|
|
|
|
my ( $inode, $size ) = (stat($filename))[1,7]; |
924
|
|
|
|
|
|
|
if ( $self->{file_data}->{$key}->{inode} != $inode || |
925
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{seek} > $size ) { |
926
|
|
|
|
|
|
|
# |
927
|
|
|
|
|
|
|
# We've been aged (inode diff) or we've been |
928
|
|
|
|
|
|
|
# truncated (our checkpoint is larger than the |
929
|
|
|
|
|
|
|
# file.) Pass the file key to OpenFileWithOpts, |
930
|
|
|
|
|
|
|
# which may be different from the current name. |
931
|
|
|
|
|
|
|
# |
932
|
|
|
|
|
|
|
LOG()->debug( sub { |
933
|
|
|
|
|
|
|
my $happened = $self->{file_data}->{$key}->{inode} != $inode ? 'aged' : 'truncated'; |
934
|
|
|
|
|
|
|
"File $filename has been $happened. OpenFileWithOpts( $key )."; |
935
|
|
|
|
|
|
|
} ); |
936
|
|
|
|
|
|
|
|
937
|
|
|
|
|
|
|
$self->OpenFileWithOpts( $key ) || |
938
|
|
|
|
|
|
|
die "Unable to tail file \"$filename\" [$!]\n"; |
939
|
|
|
|
|
|
|
# |
940
|
|
|
|
|
|
|
# For a -request_timeout, don't count the time it |
941
|
|
|
|
|
|
|
# took to OpenFileWithOpts(), or the SLEEP at the |
942
|
|
|
|
|
|
|
# end of this loop. That is, reset $request_mark. |
943
|
|
|
|
|
|
|
# |
944
|
|
|
|
|
|
|
LOG()->debug( sub { |
945
|
|
|
|
|
|
|
'Undefining request_mark at ' . localtime(); |
946
|
|
|
|
|
|
|
} ); |
947
|
|
|
|
|
|
|
undef $request_mark; |
948
|
|
|
|
|
|
|
} |
949
|
|
|
|
|
|
|
|
950
|
|
|
|
|
|
|
if (exists $self->{file_data}->{$key}->{opts}->{-date}) { |
951
|
|
|
|
|
|
|
# We use "rollover" to refer to files whose |
952
|
|
|
|
|
|
|
# names change daily, and the parent process |
953
|
|
|
|
|
|
|
# wants the current file. |
954
|
|
|
|
|
|
|
# |
955
|
|
|
|
|
|
|
# We use "archive" to refer to files whose names |
956
|
|
|
|
|
|
|
# are constant, but the file itself is compressed |
957
|
|
|
|
|
|
|
# or otherwise renamed. |
958
|
|
|
|
|
|
|
# |
959
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{opts}->{-date} eq |
960
|
|
|
|
|
|
|
"parsed") { |
961
|
|
|
|
|
|
|
# Need to pass original key here, not current |
962
|
|
|
|
|
|
|
# name. |
963
|
|
|
|
|
|
|
my $msg = $self->RollFile($key); |
964
|
|
|
|
|
|
|
# Rollover: If a file named with the new date |
965
|
|
|
|
|
|
|
# has appeared, the return is |
966
|
|
|
|
|
|
|
# _rollover_999999999 where the numeric |
967
|
|
|
|
|
|
|
# portion is seconds-in-epoch. |
968
|
|
|
|
|
|
|
# (1) the -timeout option is deleted by a |
969
|
|
|
|
|
|
|
# true timeout, but not by a rollover. |
970
|
|
|
|
|
|
|
# (2) Caller can detect new file name in |
971
|
|
|
|
|
|
|
# -current option after a rollover. |
972
|
|
|
|
|
|
|
# (3) The timed-out counter has been reset |
973
|
|
|
|
|
|
|
# by RollFile if the rollover succeeded. |
974
|
|
|
|
|
|
|
if (defined $msg) { |
975
|
|
|
|
|
|
|
$filename = |
976
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts}->{-current}; |
977
|
|
|
|
|
|
|
return "$key:$msg"; |
978
|
|
|
|
|
|
|
} |
979
|
|
|
|
|
|
|
} else { |
980
|
|
|
|
|
|
|
my $msg = $self->ArchFile($key); |
981
|
|
|
|
|
|
|
# Archive: the value of -date in this case is |
982
|
|
|
|
|
|
|
# the file extension of the archived file. |
983
|
|
|
|
|
|
|
# Currrently the only name format supported is |
984
|
|
|
|
|
|
|
# filename.99999999.extension. |
985
|
|
|
|
|
|
|
# The returned line is: |
986
|
|
|
|
|
|
|
# _archived_999999999 where |
987
|
|
|
|
|
|
|
# the numeric portion is seconds-in-epoch. |
988
|
|
|
|
|
|
|
if (defined $msg) { |
989
|
|
|
|
|
|
|
return "$key:$msg"; |
990
|
|
|
|
|
|
|
} |
991
|
|
|
|
|
|
|
} |
992
|
|
|
|
|
|
|
} |
993
|
|
|
|
|
|
|
} |
994
|
|
|
|
|
|
|
elsif ($self->{file_data}->{$key}->{opts}->{-type} eq |
995
|
|
|
|
|
|
|
"UNIX-REMOTE") { |
996
|
|
|
|
|
|
|
# Zero length does not necessarily mean a problem |
997
|
|
|
|
|
|
|
# for UNIX-REMOTE files. Only reopen if the |
998
|
|
|
|
|
|
|
# heartbeat fails. |
999
|
|
|
|
|
|
|
$donefiles--; |
1000
|
|
|
|
|
|
|
next FILE; |
1001
|
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
|
else { |
1003
|
|
|
|
|
|
|
die "Bogus file type\n"; |
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
|
1006
|
|
|
|
|
|
|
# |
1007
|
|
|
|
|
|
|
# In any case, we didn't read anything, so go to the |
1008
|
|
|
|
|
|
|
# next FILE; |
1009
|
|
|
|
|
|
|
# |
1010
|
|
|
|
|
|
|
$donefiles--; |
1011
|
|
|
|
|
|
|
next FILE; |
1012
|
|
|
|
|
|
|
} |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
# |
1015
|
|
|
|
|
|
|
# We read something! Mark the time if required. |
1016
|
|
|
|
|
|
|
# Don't forget to add on anything we may have read before. |
1017
|
|
|
|
|
|
|
# Build our array by splitting our latest read plus whatever |
1018
|
|
|
|
|
|
|
# is saved. |
1019
|
|
|
|
|
|
|
# |
1020
|
|
|
|
|
|
|
$now = time; |
1021
|
|
|
|
|
|
|
if (exists $self->{file_data}->{$key}->{opts}{-timeout}) { |
1022
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{filetime} = $now; |
1023
|
|
|
|
|
|
|
} |
1024
|
|
|
|
|
|
|
if (defined $self->{file_data}->{$key}->{heartbeat}) { |
1025
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{heartbeat} = $now; |
1026
|
|
|
|
|
|
|
} |
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{array} = [ split( /^/m, $self->{file_data}->{$key}->{line} . $line) ]; |
1029
|
|
|
|
|
|
|
|
1030
|
|
|
|
|
|
|
# |
1031
|
|
|
|
|
|
|
# If there's a leftover piece, then save it in the "line". Otherwise, |
1032
|
|
|
|
|
|
|
# clear it out. |
1033
|
|
|
|
|
|
|
# |
1034
|
|
|
|
|
|
|
if ( substr($self->{file_data}->{$key}->{array}->[$#{$self->{file_data}->{$key}->{array}}], |
1035
|
|
|
|
|
|
|
-1, 1) ne "\n" ) { |
1036
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{line} = pop @{$self->{file_data}->{$key}->{array}}; |
1037
|
|
|
|
|
|
|
next unless @{$self->{file_data}->{$key}->{array}}; |
1038
|
|
|
|
|
|
|
} else { |
1039
|
|
|
|
|
|
|
undef $self->{file_data}->{$key}->{line}; |
1040
|
|
|
|
|
|
|
} |
1041
|
|
|
|
|
|
|
} |
1042
|
|
|
|
|
|
|
|
1043
|
|
|
|
|
|
|
# |
1044
|
|
|
|
|
|
|
# If we make it here, then we have something on our array. |
1045
|
|
|
|
|
|
|
# If it's a heartbeat, continue (we marked it above). |
1046
|
|
|
|
|
|
|
# Otherwise increment our counter, sync up our disk file, |
1047
|
|
|
|
|
|
|
# and return the line. |
1048
|
|
|
|
|
|
|
# |
1049
|
|
|
|
|
|
|
my $return = shift @{$self->{file_data}->{$key}->{"array"}}; |
1050
|
|
|
|
|
|
|
if ($return =~ /(_heartbeat_)(\d+)/) { |
1051
|
|
|
|
|
|
|
$donefiles--; |
1052
|
|
|
|
|
|
|
next FILE; |
1053
|
|
|
|
|
|
|
} |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
$DIRTY++; |
1056
|
|
|
|
|
|
|
|
1057
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{opts}->{-type} eq "UNIX-REMOTE") { |
1058
|
|
|
|
|
|
|
my ($host, $file, $msg) = split(/:/, $return, 3); |
1059
|
|
|
|
|
|
|
# |
1060
|
|
|
|
|
|
|
# See comment at IsRollover(). |
1061
|
|
|
|
|
|
|
# |
1062
|
|
|
|
|
|
|
my @roll = $self->IsRollover($msg); |
1063
|
|
|
|
|
|
|
if ($roll[1]) { |
1064
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts}->{-current} = $roll[0]; |
1065
|
|
|
|
|
|
|
} |
1066
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{seek} += length($msg); |
1067
|
|
|
|
|
|
|
if ($self->{DB}->{STATFILE}) { |
1068
|
|
|
|
|
|
|
$self->{DB}->{STATUS}->{"$prefix:$host:$filename"} = |
1069
|
|
|
|
|
|
|
"$self->{file_data}->{$key}->{inode}:$self->{file_data}->{$key}->{seek}"; |
1070
|
|
|
|
|
|
|
} |
1071
|
|
|
|
|
|
|
return "$key:$msg"; |
1072
|
|
|
|
|
|
|
} |
1073
|
|
|
|
|
|
|
else { |
1074
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{seek} += length($return); |
1075
|
|
|
|
|
|
|
if ($self->{DB}->{STATFILE}) { |
1076
|
|
|
|
|
|
|
$self->{DB}->{STATUS}->{"$prefix:$host:$filename"} = |
1077
|
|
|
|
|
|
|
"$self->{file_data}->{$key}->{inode}:$self->{file_data}->{$key}->{seek}"; |
1078
|
|
|
|
|
|
|
} |
1079
|
|
|
|
|
|
|
return "$key:$return"; |
1080
|
|
|
|
|
|
|
} |
1081
|
|
|
|
|
|
|
} |
1082
|
|
|
|
|
|
|
# |
1083
|
|
|
|
|
|
|
# Still here? That means we redo the loop. But first ... |
1084
|
|
|
|
|
|
|
# |
1085
|
|
|
|
|
|
|
# Run the DoIt function every $BATCHLIM records. |
1086
|
|
|
|
|
|
|
# |
1087
|
|
|
|
|
|
|
|
1088
|
|
|
|
|
|
|
if (! ($COUNT % $BATCHLIM)) { |
1089
|
|
|
|
|
|
|
if (%doitfn) { |
1090
|
|
|
|
|
|
|
$doitfn{-doitfn}->(); # run it |
1091
|
|
|
|
|
|
|
} |
1092
|
|
|
|
|
|
|
} |
1093
|
|
|
|
|
|
|
# |
1094
|
|
|
|
|
|
|
# Sleep only if all files are temporarily unavailable. |
1095
|
|
|
|
|
|
|
# |
1096
|
|
|
|
|
|
|
sleep ($SLEEP) unless $donefiles; |
1097
|
|
|
|
|
|
|
} |
1098
|
|
|
|
|
|
|
} |
1099
|
|
|
|
|
|
|
|
1100
|
|
|
|
|
|
|
=head2 Heartbeat |
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
=cut |
1103
|
|
|
|
|
|
|
sub Heartbeat { |
1104
|
|
|
|
|
|
|
my $self = shift; |
1105
|
|
|
|
|
|
|
my $key = shift; |
1106
|
|
|
|
|
|
|
my $now = time; |
1107
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{heartbeat} eq undef || |
1108
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{heartbeat} < $now - $BEAT +$SLEEP) { |
1109
|
|
|
|
|
|
|
my $msg = "_heartbeat_$now\n"; |
1110
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{heartbeat} = $now; |
1111
|
|
|
|
|
|
|
return $msg; |
1112
|
|
|
|
|
|
|
} |
1113
|
|
|
|
|
|
|
else { |
1114
|
|
|
|
|
|
|
return undef; |
1115
|
|
|
|
|
|
|
} |
1116
|
|
|
|
|
|
|
} |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
=head2 ResetHeartBeats |
1119
|
|
|
|
|
|
|
|
1120
|
|
|
|
|
|
|
Use e.g. if monitor has been paused. Start checking for heartfailure |
1121
|
|
|
|
|
|
|
again now. |
1122
|
|
|
|
|
|
|
|
1123
|
|
|
|
|
|
|
=cut |
1124
|
|
|
|
|
|
|
sub ResetHeartbeats { |
1125
|
|
|
|
|
|
|
my $self = shift; |
1126
|
|
|
|
|
|
|
my $now = time; |
1127
|
|
|
|
|
|
|
foreach my $key ( keys %{ $self->{file_data} } ) { |
1128
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{opts}->{-heartbeat} eq 'recv') { |
1129
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{heartbeat} = $now; |
1130
|
|
|
|
|
|
|
} |
1131
|
|
|
|
|
|
|
} |
1132
|
|
|
|
|
|
|
} |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
=head2 CheckBeat |
1135
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
=cut |
1137
|
|
|
|
|
|
|
sub CheckBeat{ |
1138
|
|
|
|
|
|
|
my $self = shift; |
1139
|
|
|
|
|
|
|
my $key = shift; |
1140
|
|
|
|
|
|
|
my $now = time; |
1141
|
|
|
|
|
|
|
my $return = undef; |
1142
|
|
|
|
|
|
|
|
1143
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{heartbeat} && |
1144
|
|
|
|
|
|
|
$now - $self->{file_data}->{$key}->{heartbeat} > $BEATOUT) { |
1145
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{retries}++ > $MAX_RETRIES) { |
1146
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{FILE}->close(); |
1147
|
|
|
|
|
|
|
$self->Kill($key); |
1148
|
|
|
|
|
|
|
undef $self->{file_data}->{$key}->{heartbeat}; |
1149
|
|
|
|
|
|
|
$return = "_heartfailure_$now\n"; |
1150
|
|
|
|
|
|
|
} |
1151
|
|
|
|
|
|
|
else { |
1152
|
|
|
|
|
|
|
sleep (2 ** $self->{file_data}->{$key}{retries}); |
1153
|
|
|
|
|
|
|
$self->WatchFile(%{$self->{file_data}->{$key}->{opts}}); |
1154
|
|
|
|
|
|
|
} |
1155
|
|
|
|
|
|
|
} |
1156
|
|
|
|
|
|
|
return $return; |
1157
|
|
|
|
|
|
|
} |
1158
|
|
|
|
|
|
|
|
1159
|
|
|
|
|
|
|
=head2 CheckTimeout |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
=cut |
1162
|
|
|
|
|
|
|
sub CheckTimeout { |
1163
|
|
|
|
|
|
|
my $self = shift; |
1164
|
|
|
|
|
|
|
my $key = shift; |
1165
|
|
|
|
|
|
|
my $now = time; |
1166
|
|
|
|
|
|
|
my $return = undef; |
1167
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{filetime} = $now |
1168
|
|
|
|
|
|
|
unless $self->{file_data}->{$key}->{filetime}; |
1169
|
|
|
|
|
|
|
if ($now - $self->{file_data}->{$key}->{filetime} > |
1170
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts}{-timeout} - $SLEEP) { |
1171
|
|
|
|
|
|
|
delete $self->{file_data}->{$key}->{opts}->{-timeout}; |
1172
|
|
|
|
|
|
|
$return = "_timeout_$now\n"; |
1173
|
|
|
|
|
|
|
} |
1174
|
|
|
|
|
|
|
return $return; |
1175
|
|
|
|
|
|
|
} |
1176
|
|
|
|
|
|
|
|
1177
|
|
|
|
|
|
|
=head2 CheckRequestTimeout |
1178
|
|
|
|
|
|
|
|
1179
|
|
|
|
|
|
|
=cut |
1180
|
|
|
|
|
|
|
|
1181
|
|
|
|
|
|
|
sub CheckRequestTimeout { |
1182
|
|
|
|
|
|
|
my $self = shift; |
1183
|
|
|
|
|
|
|
my $key = shift; |
1184
|
|
|
|
|
|
|
my $request_mark = shift; |
1185
|
|
|
|
|
|
|
my $now = time(); |
1186
|
|
|
|
|
|
|
my $return = undef; |
1187
|
|
|
|
|
|
|
|
1188
|
|
|
|
|
|
|
if ($now - $request_mark > $self->{file_data}->{$key}->{opts}{-request_timeout} ) { |
1189
|
|
|
|
|
|
|
$return = "_timeout_request_$now\n"; |
1190
|
|
|
|
|
|
|
} |
1191
|
|
|
|
|
|
|
return $return; |
1192
|
|
|
|
|
|
|
} |
1193
|
|
|
|
|
|
|
|
1194
|
|
|
|
|
|
|
=head2 Kill |
1195
|
|
|
|
|
|
|
|
1196
|
|
|
|
|
|
|
=cut |
1197
|
|
|
|
|
|
|
sub Kill { |
1198
|
|
|
|
|
|
|
my $self = shift; |
1199
|
|
|
|
|
|
|
my $key = shift; |
1200
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{child}) { |
1201
|
|
|
|
|
|
|
my $child = $self->{file_data}->{$key}->{child}; |
1202
|
|
|
|
|
|
|
kill 'TERM', $child; |
1203
|
|
|
|
|
|
|
sleep 2; |
1204
|
|
|
|
|
|
|
kill 0, $child && |
1205
|
|
|
|
|
|
|
kill 'KILL', $child; |
1206
|
|
|
|
|
|
|
} |
1207
|
|
|
|
|
|
|
} |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
=head2 ArchFile |
1210
|
|
|
|
|
|
|
|
1211
|
|
|
|
|
|
|
=cut |
1212
|
|
|
|
|
|
|
sub ArchFile { |
1213
|
|
|
|
|
|
|
my $self = shift; |
1214
|
|
|
|
|
|
|
my $key = shift; |
1215
|
|
|
|
|
|
|
my $return = undef; |
1216
|
|
|
|
|
|
|
my $now = time; |
1217
|
|
|
|
|
|
|
my $fname = $self->{file_data}->{$key}->{opts}->{-current}; |
1218
|
|
|
|
|
|
|
my $ext = $self->{file_data}->{$key}->{opts}->{-date}; |
1219
|
|
|
|
|
|
|
my $archname = "$fname.$TOMORROW.$ext"; |
1220
|
|
|
|
|
|
|
if (-r $archname) { |
1221
|
|
|
|
|
|
|
$TODAY = $TOMORROW; |
1222
|
|
|
|
|
|
|
$TOMORROW = rolldate ($TODAY, 4); |
1223
|
|
|
|
|
|
|
# |
1224
|
|
|
|
|
|
|
# Open the new file (with the same name) |
1225
|
|
|
|
|
|
|
# |
1226
|
|
|
|
|
|
|
if ($self->OpenFileWithOpts( $key ) ) { |
1227
|
|
|
|
|
|
|
$return = "_archived_$now\n"; |
1228
|
|
|
|
|
|
|
} |
1229
|
|
|
|
|
|
|
} |
1230
|
|
|
|
|
|
|
return $return; |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
|
1233
|
|
|
|
|
|
|
=head2 RollFile |
1234
|
|
|
|
|
|
|
|
1235
|
|
|
|
|
|
|
=cut |
1236
|
|
|
|
|
|
|
sub RollFile { |
1237
|
|
|
|
|
|
|
my $self = shift; |
1238
|
|
|
|
|
|
|
my $key = shift; |
1239
|
|
|
|
|
|
|
my $return = undef; |
1240
|
|
|
|
|
|
|
my $now = time; |
1241
|
|
|
|
|
|
|
my ($base, $datepart, $dir, $monthdir, $name, $newdate, $newname, $pre, $yrfmt); |
1242
|
|
|
|
|
|
|
$name = $self->{file_data}->{$key}->{opts}->{-current}; |
1243
|
|
|
|
|
|
|
$dir = dirname($name); |
1244
|
|
|
|
|
|
|
$base = basename($name); |
1245
|
|
|
|
|
|
|
$monthdir = $self->{file_data}->{$key}->{opts}->{-monthdir}; |
1246
|
|
|
|
|
|
|
$yrfmt = $self->{file_data}->{$key}->{opts}->{-yrfmt}; |
1247
|
|
|
|
|
|
|
if ($base =~ /(^[\/A-Za-z]*)([0-9]+)$/) { |
1248
|
|
|
|
|
|
|
$pre = $1; |
1249
|
|
|
|
|
|
|
$datepart = $2; |
1250
|
|
|
|
|
|
|
$newdate = rolldate($datepart, $yrfmt); |
1251
|
|
|
|
|
|
|
if (defined $monthdir) { |
1252
|
|
|
|
|
|
|
my $curym = int 0.01 * $datepart; |
1253
|
|
|
|
|
|
|
my $newym = int 0.01 * $newdate; |
1254
|
|
|
|
|
|
|
my @arr = split (/\//, $dir); |
1255
|
|
|
|
|
|
|
if ($curym ne $newym) { |
1256
|
|
|
|
|
|
|
my $p = -1; |
1257
|
|
|
|
|
|
|
my $i = 0; |
1258
|
|
|
|
|
|
|
while (($p = index($monthdir, "..", $p)) > -1) { |
1259
|
|
|
|
|
|
|
$i++; |
1260
|
|
|
|
|
|
|
$p++; |
1261
|
|
|
|
|
|
|
} |
1262
|
|
|
|
|
|
|
die "RollFile cannot determine month directory.\n" if ($i < 0 or $i > $#arr); |
1263
|
|
|
|
|
|
|
@arr[scalar(@arr) - $i] = $newym; |
1264
|
|
|
|
|
|
|
$dir = join("\/", @arr); |
1265
|
|
|
|
|
|
|
} |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
$newname = "$dir/$pre$newdate"; |
1268
|
|
|
|
|
|
|
if (-r $newname) { |
1269
|
|
|
|
|
|
|
close($self->{file_data}->{$key}->{FILE}); |
1270
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{opts}->{-current} = $newname; |
1271
|
|
|
|
|
|
|
# (Re)initialize timed-out counter. |
1272
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{timedout}) { |
1273
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{timedout} = 0; |
1274
|
|
|
|
|
|
|
} |
1275
|
|
|
|
|
|
|
# Reset {done} flag |
1276
|
|
|
|
|
|
|
if ($self->{file_data}->{$key}->{done}) { |
1277
|
|
|
|
|
|
|
$self->{file_data}->{$key}->{done} = 0; |
1278
|
|
|
|
|
|
|
} |
1279
|
|
|
|
|
|
|
# |
1280
|
|
|
|
|
|
|
# Open the new file |
1281
|
|
|
|
|
|
|
# |
1282
|
|
|
|
|
|
|
$self->OpenFileWithOpts( $key ) |
1283
|
|
|
|
|
|
|
or return undef; |
1284
|
|
|
|
|
|
|
# |
1285
|
|
|
|
|
|
|
# |
1286
|
|
|
|
|
|
|
# |
1287
|
|
|
|
|
|
|
$return = '_rollover_' . $now . '_' . $newname . '_'; |
1288
|
|
|
|
|
|
|
return "$return\n"; |
1289
|
|
|
|
|
|
|
} |
1290
|
|
|
|
|
|
|
} |
1291
|
|
|
|
|
|
|
return undef; |
1292
|
|
|
|
|
|
|
} |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
sub rolldate { |
1295
|
|
|
|
|
|
|
my $date = shift; |
1296
|
|
|
|
|
|
|
my $yrfmt = shift; # positions we would like for the year in the result. |
1297
|
|
|
|
|
|
|
my ($yr, $mon, $day, $newdate); |
1298
|
|
|
|
|
|
|
$yr = int $date * 0.0001; |
1299
|
|
|
|
|
|
|
$day = ($date % 10000) % 100; |
1300
|
|
|
|
|
|
|
$mon = int 0.01 * ($date % 10000); |
1301
|
|
|
|
|
|
|
# |
1302
|
|
|
|
|
|
|
# Arbitrary choice to treat year numbers < 50 as in 2000s. |
1303
|
|
|
|
|
|
|
# |
1304
|
|
|
|
|
|
|
if ($yr < 100) { |
1305
|
|
|
|
|
|
|
if ($yr < 50) { |
1306
|
|
|
|
|
|
|
$yr += 2000; |
1307
|
|
|
|
|
|
|
} |
1308
|
|
|
|
|
|
|
else { |
1309
|
|
|
|
|
|
|
$yr += 1900; |
1310
|
|
|
|
|
|
|
} |
1311
|
|
|
|
|
|
|
} |
1312
|
|
|
|
|
|
|
my $time = timelocal(0, 0, 3, $day, ($mon - 1), $yr); |
1313
|
|
|
|
|
|
|
$newdate = fmtime($time + 86400, $yrfmt); |
1314
|
|
|
|
|
|
|
|
1315
|
|
|
|
|
|
|
return $newdate; |
1316
|
|
|
|
|
|
|
} |
1317
|
|
|
|
|
|
|
|
1318
|
|
|
|
|
|
|
|
1319
|
|
|
|
|
|
|
=head2 Size |
1320
|
|
|
|
|
|
|
|
1321
|
|
|
|
|
|
|
=cut |
1322
|
|
|
|
|
|
|
sub Size { |
1323
|
|
|
|
|
|
|
my $self = shift; |
1324
|
|
|
|
|
|
|
my $key = shift; |
1325
|
|
|
|
|
|
|
if (exists $self->{file_data}->{$key}->{seek}) { |
1326
|
|
|
|
|
|
|
return $self->{file_data}->{$key}->{seek}; |
1327
|
|
|
|
|
|
|
} else { |
1328
|
|
|
|
|
|
|
return undef; |
1329
|
|
|
|
|
|
|
} |
1330
|
|
|
|
|
|
|
} |
1331
|
|
|
|
|
|
|
|
1332
|
|
|
|
|
|
|
# |
1333
|
|
|
|
|
|
|
# Format a seconds-in-epoch time as a date with 2 to 4 positions in the year |
1334
|
|
|
|
|
|
|
# Called as fmtime( $unixtime, 4 ); |
1335
|
|
|
|
|
|
|
# Second parameter is optional and defaults to 2. |
1336
|
|
|
|
|
|
|
# |
1337
|
|
|
|
|
|
|
sub fmtime { |
1338
|
|
|
|
|
|
|
my $time = shift; |
1339
|
|
|
|
|
|
|
my $yrfmt = shift; # positions we would like for the year in the result. |
1340
|
|
|
|
|
|
|
my ($fmt, $sec, $min, $hrs, $day, $mon, $yr, $newdate); |
1341
|
|
|
|
|
|
|
|
1342
|
|
|
|
|
|
|
($sec, $min, $hrs, $day, $mon, $yr) = localtime ($time); |
1343
|
|
|
|
|
|
|
$yrfmt = 2 |
1344
|
|
|
|
|
|
|
unless $yrfmt && $yrfmt ge 2 && $yrfmt lt 5; |
1345
|
|
|
|
|
|
|
$fmt = "%".$yrfmt.".u%2.u%2.u"; |
1346
|
|
|
|
|
|
|
$newdate = sprintf($fmt, (($yr + 1900) % 10 ** $yrfmt), ($mon + 1), $day); |
1347
|
|
|
|
|
|
|
$newdate =~ s/ /0/g; |
1348
|
|
|
|
|
|
|
return $newdate; |
1349
|
|
|
|
|
|
|
} |
1350
|
|
|
|
|
|
|
|
1351
|
|
|
|
|
|
|
=head2 Detecting Exception Notification |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
The following functions may be used to determine if a returned line |
1354
|
|
|
|
|
|
|
is a notification of exception conditions. |
1355
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
Called as: |
1357
|
|
|
|
|
|
|
|
1358
|
|
|
|
|
|
|
$tail = new File::SmartTail; |
1359
|
|
|
|
|
|
|
$line = $tail->GetLine(); |
1360
|
|
|
|
|
|
|
$tail->WatchFile(%options); |
1361
|
|
|
|
|
|
|
($host, $file, $rec) = split (/:/, $line, 3); |
1362
|
|
|
|
|
|
|
if ($tail->IsFn($rec)) { # do what you like }; |
1363
|
|
|
|
|
|
|
|
1364
|
|
|
|
|
|
|
where IsFn represents one of the Is-prefixed functions below. |
1365
|
|
|
|
|
|
|
All of the IsFns return 1 if the named condition is present, else undef. |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
=head2 IsTimeout |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
An application timeout has been exceeded. |
1370
|
|
|
|
|
|
|
|
1371
|
|
|
|
|
|
|
=cut |
1372
|
|
|
|
|
|
|
sub IsTimeout { |
1373
|
|
|
|
|
|
|
my $self = shift; |
1374
|
|
|
|
|
|
|
my $line = shift; |
1375
|
|
|
|
|
|
|
my $return = undef; |
1376
|
|
|
|
|
|
|
if ($line =~ /(_timeout_)(\d+)/) { |
1377
|
|
|
|
|
|
|
$return = 1; |
1378
|
|
|
|
|
|
|
} |
1379
|
|
|
|
|
|
|
|
1380
|
|
|
|
|
|
|
return $return; |
1381
|
|
|
|
|
|
|
} |
1382
|
|
|
|
|
|
|
|
1383
|
|
|
|
|
|
|
=head2 IsRequestTimeout |
1384
|
|
|
|
|
|
|
|
1385
|
|
|
|
|
|
|
An application timeout has been exceeded. |
1386
|
|
|
|
|
|
|
|
1387
|
|
|
|
|
|
|
=cut |
1388
|
|
|
|
|
|
|
sub IsRequestTimeout { |
1389
|
|
|
|
|
|
|
my $self = shift; |
1390
|
|
|
|
|
|
|
my $line = shift; |
1391
|
|
|
|
|
|
|
my $return = undef; |
1392
|
|
|
|
|
|
|
if ($line =~ /(_timeout_request_)(\d+)/) { |
1393
|
|
|
|
|
|
|
$return = 1; |
1394
|
|
|
|
|
|
|
} |
1395
|
|
|
|
|
|
|
|
1396
|
|
|
|
|
|
|
return $return; |
1397
|
|
|
|
|
|
|
} |
1398
|
|
|
|
|
|
|
|
1399
|
|
|
|
|
|
|
=head2 IsRollover |
1400
|
|
|
|
|
|
|
|
1401
|
|
|
|
|
|
|
A -date=>'parsed' file has rolled to the next day. In array context, |
1402
|
|
|
|
|
|
|
returns (newfilename, 1) if true |
1403
|
|
|
|
|
|
|
|
1404
|
|
|
|
|
|
|
!Note: returns 1 in scalar context, and an array with elt 0 containing |
1405
|
|
|
|
|
|
|
the new filename in array context. |
1406
|
|
|
|
|
|
|
|
1407
|
|
|
|
|
|
|
=cut |
1408
|
|
|
|
|
|
|
sub IsRollover { |
1409
|
|
|
|
|
|
|
my $self = shift; |
1410
|
|
|
|
|
|
|
my $line = shift; |
1411
|
|
|
|
|
|
|
my $return = undef; |
1412
|
|
|
|
|
|
|
if ($line =~ /(_rollover_)(\d+)(_)(.*)_$/) { |
1413
|
|
|
|
|
|
|
$return = $4; |
1414
|
|
|
|
|
|
|
} |
1415
|
|
|
|
|
|
|
|
1416
|
|
|
|
|
|
|
return ($return, defined($return)); |
1417
|
|
|
|
|
|
|
} |
1418
|
|
|
|
|
|
|
|
1419
|
|
|
|
|
|
|
=head2 IsArchived |
1420
|
|
|
|
|
|
|
|
1421
|
|
|
|
|
|
|
A -date=>'gz' file has been gzip'd (archived). |
1422
|
|
|
|
|
|
|
|
1423
|
|
|
|
|
|
|
=cut |
1424
|
|
|
|
|
|
|
sub IsArchived { |
1425
|
|
|
|
|
|
|
my $self = shift; |
1426
|
|
|
|
|
|
|
my $line = shift; |
1427
|
|
|
|
|
|
|
my $return = undef; |
1428
|
|
|
|
|
|
|
if ($line =~ /(_archived_)(\d+)/) { |
1429
|
|
|
|
|
|
|
$return = 1; |
1430
|
|
|
|
|
|
|
} |
1431
|
|
|
|
|
|
|
|
1432
|
|
|
|
|
|
|
return $return; |
1433
|
|
|
|
|
|
|
} |
1434
|
|
|
|
|
|
|
|
1435
|
|
|
|
|
|
|
=head2 IsHeartFailure |
1436
|
|
|
|
|
|
|
|
1437
|
|
|
|
|
|
|
The internal heartbeat has not been detected for longer than the |
1438
|
|
|
|
|
|
|
prescribed interval (currently 120 seconds). |
1439
|
|
|
|
|
|
|
|
1440
|
|
|
|
|
|
|
=cut |
1441
|
|
|
|
|
|
|
sub IsHeartFailure { |
1442
|
|
|
|
|
|
|
my $self = shift; |
1443
|
|
|
|
|
|
|
my $line = shift; |
1444
|
|
|
|
|
|
|
my $return = undef; |
1445
|
|
|
|
|
|
|
# |
1446
|
|
|
|
|
|
|
# If the heartbeat is not received within the prescribed interval, |
1447
|
|
|
|
|
|
|
# and the max retries are exhausted, a message is sent. |
1448
|
|
|
|
|
|
|
if ($line =~ /(_heartfailure_)(\d+)/) { |
1449
|
|
|
|
|
|
|
$return = 1; |
1450
|
|
|
|
|
|
|
} |
1451
|
|
|
|
|
|
|
|
1452
|
|
|
|
|
|
|
return $return; |
1453
|
|
|
|
|
|
|
} |
1454
|
|
|
|
|
|
|
|
1455
|
|
|
|
|
|
|
=head2 IsZipd |
1456
|
|
|
|
|
|
|
|
1457
|
|
|
|
|
|
|
The file options include -date=>'gz' |
1458
|
|
|
|
|
|
|
|
1459
|
|
|
|
|
|
|
=cut |
1460
|
|
|
|
|
|
|
sub IsZipd { |
1461
|
|
|
|
|
|
|
my %opts = @_; |
1462
|
|
|
|
|
|
|
my $return = undef; |
1463
|
|
|
|
|
|
|
if (%opts) { |
1464
|
|
|
|
|
|
|
if ( ($opts{-date} eq 'gz') or |
1465
|
|
|
|
|
|
|
$opts{-rmtopts} =~ /-date\s+gz/ ) { |
1466
|
|
|
|
|
|
|
$return++; |
1467
|
|
|
|
|
|
|
} |
1468
|
|
|
|
|
|
|
} |
1469
|
|
|
|
|
|
|
return $return; |
1470
|
|
|
|
|
|
|
} |
1471
|
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
|
# Nonmember functions: |
1473
|
|
|
|
|
|
|
|
1474
|
|
|
|
|
|
|
# From given opts (minimum: -file=>filename) supply defaults as |
1475
|
|
|
|
|
|
|
# necessary to fill in key, filename, host, and type. |
1476
|
|
|
|
|
|
|
|
1477
|
|
|
|
|
|
|
sub ResolveOpts { |
1478
|
|
|
|
|
|
|
my $self = shift; |
1479
|
|
|
|
|
|
|
my %opts = @_; |
1480
|
|
|
|
|
|
|
# If we have hostname:filename, that's the key. |
1481
|
|
|
|
|
|
|
# If we have -host and it's different, complain. |
1482
|
|
|
|
|
|
|
# If no host is given use Sys::Hostname |
1483
|
|
|
|
|
|
|
# |
1484
|
|
|
|
|
|
|
# If no explicit -prefix, use the path name of the executing file. |
1485
|
|
|
|
|
|
|
my ($tmpa, $tmpb) = split (/:/, $opts{-file}, 2); |
1486
|
|
|
|
|
|
|
my ($key, $host, $filename); |
1487
|
|
|
|
|
|
|
if (defined $tmpb) { |
1488
|
|
|
|
|
|
|
$key = $opts{-file}; |
1489
|
|
|
|
|
|
|
$filename = $tmpb; |
1490
|
|
|
|
|
|
|
if (exists $opts{-host}) { |
1491
|
|
|
|
|
|
|
if ($opts{-host} ne $tmpa) { |
1492
|
|
|
|
|
|
|
die "Ambiguous host: -file => $opts{-file} and -host => $opts{-host}\n"; |
1493
|
|
|
|
|
|
|
} |
1494
|
|
|
|
|
|
|
} else { |
1495
|
|
|
|
|
|
|
$opts{-host} = $tmpa; |
1496
|
|
|
|
|
|
|
} |
1497
|
|
|
|
|
|
|
} else { |
1498
|
|
|
|
|
|
|
$filename = $tmpa; |
1499
|
|
|
|
|
|
|
$opts{-host} = hostname |
1500
|
|
|
|
|
|
|
unless (exists $opts{-host}); |
1501
|
|
|
|
|
|
|
$host = $opts{-host}; |
1502
|
|
|
|
|
|
|
$key = "$host:$filename"; |
1503
|
|
|
|
|
|
|
$opts{-file} = $key; |
1504
|
|
|
|
|
|
|
} |
1505
|
|
|
|
|
|
|
|
1506
|
|
|
|
|
|
|
unless (exists $opts{-current}) { |
1507
|
|
|
|
|
|
|
$opts{-current} = $filename |
1508
|
|
|
|
|
|
|
} |
1509
|
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
|
unless (exists $opts{-type}) { |
1511
|
|
|
|
|
|
|
$opts{-type} = "UNIX"; |
1512
|
|
|
|
|
|
|
} |
1513
|
|
|
|
|
|
|
|
1514
|
|
|
|
|
|
|
unless (exists $opts{-rmtsh}) { |
1515
|
|
|
|
|
|
|
$opts{-rmtsh} = "ssh"; |
1516
|
|
|
|
|
|
|
} |
1517
|
|
|
|
|
|
|
|
1518
|
|
|
|
|
|
|
$opts{-prefix} = normalize_prefix( $opts{-prefix} ) ; |
1519
|
|
|
|
|
|
|
# unless (exists $opts{-prefix}) { |
1520
|
|
|
|
|
|
|
# my @path = fileparse($0); |
1521
|
|
|
|
|
|
|
# if ($path[1] eq "\.\/") { |
1522
|
|
|
|
|
|
|
# $path[1] = `pwd &2>&1`; |
1523
|
|
|
|
|
|
|
# chomp $path[1]; |
1524
|
|
|
|
|
|
|
# $path[1] .= "\/"; |
1525
|
|
|
|
|
|
|
# } |
1526
|
|
|
|
|
|
|
# $opts{-prefix} = $path[1] . $path[0] . $path[2]; |
1527
|
|
|
|
|
|
|
# } |
1528
|
|
|
|
|
|
|
|
1529
|
|
|
|
|
|
|
if (exists $opts{'-clear'}) { |
1530
|
|
|
|
|
|
|
if (-f $self->{DB}->{STATFILE}) { |
1531
|
|
|
|
|
|
|
unlink $self->{DB}->{STATFILE} || die "Cannot unlink $self->{DB}->{STATFILE}"; |
1532
|
|
|
|
|
|
|
} |
1533
|
|
|
|
|
|
|
$self->{DB}->{STATFILE} = ""; |
1534
|
|
|
|
|
|
|
} |
1535
|
|
|
|
|
|
|
if (exists $opts{'-reset'}) { |
1536
|
|
|
|
|
|
|
$self->{DB}->{STATFILE}="" |
1537
|
|
|
|
|
|
|
} |
1538
|
|
|
|
|
|
|
|
1539
|
|
|
|
|
|
|
if ( exists $opts{'-request_timeout'} ) { |
1540
|
|
|
|
|
|
|
if ($opts{'-request_timeout'} < 1) { |
1541
|
|
|
|
|
|
|
$opts{'-request_timeout'} = 1; |
1542
|
|
|
|
|
|
|
} |
1543
|
|
|
|
|
|
|
} |
1544
|
|
|
|
|
|
|
|
1545
|
|
|
|
|
|
|
return \%opts; |
1546
|
|
|
|
|
|
|
} |
1547
|
|
|
|
|
|
|
|
1548
|
|
|
|
|
|
|
sub FileType { |
1549
|
|
|
|
|
|
|
my %opts = @_; |
1550
|
|
|
|
|
|
|
my $return = undef; |
1551
|
|
|
|
|
|
|
|
1552
|
|
|
|
|
|
|
if (%opts) { |
1553
|
|
|
|
|
|
|
$return = $opts{-type}; |
1554
|
|
|
|
|
|
|
} |
1555
|
|
|
|
|
|
|
|
1556
|
|
|
|
|
|
|
return $return; |
1557
|
|
|
|
|
|
|
} |
1558
|
|
|
|
|
|
|
|
1559
|
|
|
|
|
|
|
sub HostUser { |
1560
|
|
|
|
|
|
|
my %opts = @_; |
1561
|
|
|
|
|
|
|
my $return = undef; |
1562
|
|
|
|
|
|
|
|
1563
|
|
|
|
|
|
|
if (%opts) { |
1564
|
|
|
|
|
|
|
my @array; |
1565
|
|
|
|
|
|
|
push @array, $opts{-host}; |
1566
|
|
|
|
|
|
|
push @array, $opts{-user}; |
1567
|
|
|
|
|
|
|
$return = \@array; |
1568
|
|
|
|
|
|
|
} |
1569
|
|
|
|
|
|
|
return $return; |
1570
|
|
|
|
|
|
|
} |
1571
|
|
|
|
|
|
|
|
1572
|
|
|
|
|
|
|
sub Filename { |
1573
|
|
|
|
|
|
|
my %opts = @_; |
1574
|
|
|
|
|
|
|
my $return = undef; |
1575
|
|
|
|
|
|
|
|
1576
|
|
|
|
|
|
|
if (%opts){ |
1577
|
|
|
|
|
|
|
$return = $opts{-current}; |
1578
|
|
|
|
|
|
|
} |
1579
|
|
|
|
|
|
|
|
1580
|
|
|
|
|
|
|
return $return; |
1581
|
|
|
|
|
|
|
} |
1582
|
|
|
|
|
|
|
|
1583
|
|
|
|
|
|
|
sub Key { |
1584
|
|
|
|
|
|
|
my %opts = @_; |
1585
|
|
|
|
|
|
|
my $return = undef; |
1586
|
|
|
|
|
|
|
|
1587
|
|
|
|
|
|
|
if (%opts){ |
1588
|
|
|
|
|
|
|
$return = $opts{-file}; |
1589
|
|
|
|
|
|
|
} |
1590
|
|
|
|
|
|
|
|
1591
|
|
|
|
|
|
|
return $return; |
1592
|
|
|
|
|
|
|
} |
1593
|
|
|
|
|
|
|
|
1594
|
|
|
|
|
|
|
sub DateOpt { |
1595
|
|
|
|
|
|
|
my %opts = @_; |
1596
|
|
|
|
|
|
|
my $return = undef; |
1597
|
|
|
|
|
|
|
|
1598
|
|
|
|
|
|
|
if (%opts){ |
1599
|
|
|
|
|
|
|
$return = $opts{-date}; |
1600
|
|
|
|
|
|
|
} |
1601
|
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
|
return $return; |
1603
|
|
|
|
|
|
|
} |
1604
|
|
|
|
|
|
|
|
1605
|
|
|
|
|
|
|
sub RmtOpts { |
1606
|
|
|
|
|
|
|
my %opts = @_; |
1607
|
|
|
|
|
|
|
my $return = undef; |
1608
|
|
|
|
|
|
|
if (%opts) { |
1609
|
|
|
|
|
|
|
$return = $opts{-rmtopts}; |
1610
|
|
|
|
|
|
|
} |
1611
|
|
|
|
|
|
|
return $return; |
1612
|
|
|
|
|
|
|
} |
1613
|
|
|
|
|
|
|
|
1614
|
|
|
|
|
|
|
{ |
1615
|
|
|
|
|
|
|
my $v; |
1616
|
|
|
|
|
|
|
sub LOG { |
1617
|
|
|
|
|
|
|
$v ||= require File::SmartTail::Logger && File::SmartTail::Logger::LOG(); |
1618
|
|
|
|
|
|
|
} |
1619
|
|
|
|
|
|
|
} |
1620
|
|
|
|
|
|
|
|
1621
|
|
|
|
|
|
|
# |
1622
|
|
|
|
|
|
|
# Attempt to normalize path of prefix. |
1623
|
|
|
|
|
|
|
# |
1624
|
|
|
|
|
|
|
# If an arbitrary string (not the name of an existing file) is passed as -prefix, |
1625
|
|
|
|
|
|
|
# return input untouched, for backwards compatibility. |
1626
|
|
|
|
|
|
|
# If an existing filename is passed as -prefix (and for default of $0), |
1627
|
|
|
|
|
|
|
# resolve any symlinks in path. |
1628
|
|
|
|
|
|
|
# |
1629
|
|
|
|
|
|
|
sub normalize_prefix { |
1630
|
|
|
|
|
|
|
my $prefix = shift || $0; |
1631
|
|
|
|
|
|
|
|
1632
|
|
|
|
|
|
|
-e $prefix or |
1633
|
|
|
|
|
|
|
return $prefix; |
1634
|
|
|
|
|
|
|
require File::Basename; |
1635
|
|
|
|
|
|
|
my ($name,$path,$suffix) = File::Basename::fileparse( $prefix ); |
1636
|
|
|
|
|
|
|
$name = '' unless $name; |
1637
|
|
|
|
|
|
|
$path = '' unless $path; |
1638
|
|
|
|
|
|
|
$suffix = '' unless $suffix; |
1639
|
|
|
|
|
|
|
require Cwd; |
1640
|
|
|
|
|
|
|
$path = Cwd::abs_path( $path ) or |
1641
|
|
|
|
|
|
|
return $prefix; |
1642
|
|
|
|
|
|
|
$path =~ m{/$} or $path .= '/'; |
1643
|
|
|
|
|
|
|
return $path . $name . $suffix; |
1644
|
|
|
|
|
|
|
} |
1645
|
|
|
|
|
|
|
|
1646
|
|
|
|
|
|
|
=head1 Examples |
1647
|
|
|
|
|
|
|
|
1648
|
|
|
|
|
|
|
=head2 Regular local file |
1649
|
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
|
use File::SmartTail; |
1651
|
|
|
|
|
|
|
|
1652
|
|
|
|
|
|
|
$file = "/tmp/foo" |
1653
|
|
|
|
|
|
|
$tail = new File::SmartTail($file); |
1654
|
|
|
|
|
|
|
|
1655
|
|
|
|
|
|
|
while($line = $tail->Tail) { |
1656
|
|
|
|
|
|
|
print $line; |
1657
|
|
|
|
|
|
|
} |
1658
|
|
|
|
|
|
|
|
1659
|
|
|
|
|
|
|
or |
1660
|
|
|
|
|
|
|
|
1661
|
|
|
|
|
|
|
use File::SmartTail; |
1662
|
|
|
|
|
|
|
|
1663
|
|
|
|
|
|
|
$file = "/tmp/foo" |
1664
|
|
|
|
|
|
|
$tail = new File::SmartTail(); |
1665
|
|
|
|
|
|
|
$tail->WatchFile(-file=>$file); |
1666
|
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
|
while($line = $tail->GetLine) { |
1668
|
|
|
|
|
|
|
print $line; |
1669
|
|
|
|
|
|
|
} |
1670
|
|
|
|
|
|
|
|
1671
|
|
|
|
|
|
|
=head2 Regular remote file on two hosts |
1672
|
|
|
|
|
|
|
|
1673
|
|
|
|
|
|
|
use File::SmartTail; |
1674
|
|
|
|
|
|
|
|
1675
|
|
|
|
|
|
|
$file = "/tmp/foo"; |
1676
|
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
|
$tail = new File::SmartTail; |
1678
|
|
|
|
|
|
|
$tail->WatchFile(-file=>$file, -type=>"UNIX-REMOTE", -host=>"guinness", -rmtopts |
1679
|
|
|
|
|
|
|
=>"-type UNIX"); |
1680
|
|
|
|
|
|
|
$tail->WatchFile(-file=>$file, -type=>"UNIX-REMOTE", -host=>"corona", -rmtopts=> |
1681
|
|
|
|
|
|
|
"-type UNIX"); |
1682
|
|
|
|
|
|
|
|
1683
|
|
|
|
|
|
|
while($line = $tail->GetLine()) { |
1684
|
|
|
|
|
|
|
print $line; |
1685
|
|
|
|
|
|
|
} |
1686
|
|
|
|
|
|
|
|
1687
|
|
|
|
|
|
|
=head2 Local file, with timeout |
1688
|
|
|
|
|
|
|
|
1689
|
|
|
|
|
|
|
use File::SmartTail; |
1690
|
|
|
|
|
|
|
|
1691
|
|
|
|
|
|
|
$file = "/tmp/foo"; |
1692
|
|
|
|
|
|
|
|
1693
|
|
|
|
|
|
|
$tail = new File::SmartTail; |
1694
|
|
|
|
|
|
|
$tail->WatchFile(-file=>$file, -type=>"UNIX", -timeout=>70); |
1695
|
|
|
|
|
|
|
|
1696
|
|
|
|
|
|
|
while($line = $tail->GetLine()) { |
1697
|
|
|
|
|
|
|
print $line; |
1698
|
|
|
|
|
|
|
} |
1699
|
|
|
|
|
|
|
|
1700
|
|
|
|
|
|
|
=head2 Remote file named by date, 4-digit year, having month directory |
1701
|
|
|
|
|
|
|
|
1702
|
|
|
|
|
|
|
use File::SmartTail; |
1703
|
|
|
|
|
|
|
|
1704
|
|
|
|
|
|
|
$file = "guinness:/tmp/foo20011114"; |
1705
|
|
|
|
|
|
|
|
1706
|
|
|
|
|
|
|
$tail = new File::SmartTail; |
1707
|
|
|
|
|
|
|
$tail->WatchFile(-file=>$file, -type=>"UNIX-REMOTE", -rmtopts=>'-date parsed -yrfmt 4 -monthdir ".." -type UNIX'); |
1708
|
|
|
|
|
|
|
|
1709
|
|
|
|
|
|
|
while($line = $tail->GetLine()) { |
1710
|
|
|
|
|
|
|
print $line; |
1711
|
|
|
|
|
|
|
|
1712
|
|
|
|
|
|
|
|
1713
|
|
|
|
|
|
|
=cut |
1714
|
|
|
|
|
|
|
|
1715
|
|
|
|
|
|
|
1; |