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