| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
# |
|
2
|
|
|
|
|
|
|
# $Id$ |
|
3
|
|
|
|
|
|
|
# |
|
4
|
|
|
|
|
|
|
# string::syslog Brik |
|
5
|
|
|
|
|
|
|
# |
|
6
|
|
|
|
|
|
|
package Metabrik::String::Syslog; |
|
7
|
1
|
|
|
1
|
|
716
|
use strict; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
28
|
|
|
8
|
1
|
|
|
1
|
|
6
|
use warnings; |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
24
|
|
|
9
|
|
|
|
|
|
|
|
|
10
|
1
|
|
|
1
|
|
5
|
use base qw(Metabrik); |
|
|
1
|
|
|
|
|
2
|
|
|
|
1
|
|
|
|
|
910
|
|
|
11
|
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
sub brik_properties { |
|
13
|
|
|
|
|
|
|
return { |
|
14
|
0
|
|
|
0
|
1
|
|
revision => '$Revision$', |
|
15
|
|
|
|
|
|
|
tags => [ qw(unstable) ], |
|
16
|
|
|
|
|
|
|
author => 'GomoR ', |
|
17
|
|
|
|
|
|
|
license => 'http://opensource.org/licenses/BSD-3-Clause', |
|
18
|
|
|
|
|
|
|
attributes => { |
|
19
|
|
|
|
|
|
|
datadir => [ qw(datadir) ], |
|
20
|
|
|
|
|
|
|
hostname => [ qw(hostname) ], |
|
21
|
|
|
|
|
|
|
process => [ qw(name) ], |
|
22
|
|
|
|
|
|
|
pid => [ qw(id) ], |
|
23
|
|
|
|
|
|
|
do_rfc3164 => [ qw(0|1) ], |
|
24
|
|
|
|
|
|
|
timestamp => [ qw(timestamp) ], |
|
25
|
|
|
|
|
|
|
}, |
|
26
|
|
|
|
|
|
|
attributes_default => { |
|
27
|
|
|
|
|
|
|
process => 'metabrik', |
|
28
|
|
|
|
|
|
|
pid => $$, |
|
29
|
|
|
|
|
|
|
do_rfc3164 => 0, |
|
30
|
|
|
|
|
|
|
}, |
|
31
|
|
|
|
|
|
|
commands => { |
|
32
|
|
|
|
|
|
|
encode => [ qw($data hostname|OPTIONAL process|OPTIONAL pid|OPTIONAL) ], |
|
33
|
|
|
|
|
|
|
decode => [ qw($data) ], |
|
34
|
|
|
|
|
|
|
date => [ qw(timestamp|OPTIONAL) ], |
|
35
|
|
|
|
|
|
|
}, |
|
36
|
|
|
|
|
|
|
}; |
|
37
|
|
|
|
|
|
|
} |
|
38
|
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
sub brik_use_properties { |
|
40
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
|
41
|
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
return { |
|
43
|
0
|
|
0
|
|
|
|
attributes_default => { |
|
44
|
|
|
|
|
|
|
hostname => defined($self->global) && $self->global->hostname || 'hostname', |
|
45
|
|
|
|
|
|
|
}, |
|
46
|
|
|
|
|
|
|
}; |
|
47
|
|
|
|
|
|
|
} |
|
48
|
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
sub encode { |
|
50
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
51
|
0
|
|
|
|
|
|
my ($data, $hostname, $process, $pid) = @_; |
|
52
|
|
|
|
|
|
|
|
|
53
|
0
|
|
0
|
|
|
|
$hostname ||= $self->hostname; |
|
54
|
0
|
|
0
|
|
|
|
$process ||= $self->process; |
|
55
|
0
|
|
0
|
|
|
|
$pid ||= $self->pid; |
|
56
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('encode', $data) or return; |
|
57
|
0
|
0
|
|
|
|
|
$self->brik_help_set_undef_arg('hostname', $hostname) or return; |
|
58
|
0
|
0
|
|
|
|
|
$self->brik_help_set_undef_arg('process', $process) or return; |
|
59
|
0
|
0
|
|
|
|
|
$self->brik_help_set_undef_arg('pid', $pid) or return; |
|
60
|
0
|
0
|
|
|
|
|
my $ref = $self->brik_help_run_invalid_arg('encode', $data, 'HASH', 'SCALAR') |
|
61
|
|
|
|
|
|
|
or return; |
|
62
|
|
|
|
|
|
|
|
|
63
|
0
|
|
|
|
|
|
my $timestamp = $self->timestamp; |
|
64
|
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
# Convert to key=value |
|
66
|
0
|
0
|
|
|
|
|
if ($ref eq 'HASH') { |
|
67
|
0
|
|
|
|
|
|
my $kv = ''; |
|
68
|
0
|
|
|
|
|
|
for my $k (sort { $a cmp $b } keys %$data) { |
|
|
0
|
|
|
|
|
|
|
|
69
|
0
|
0
|
|
|
|
|
if ($k !~ m{\s}) { # If there is no space char, we don't put between double quotes |
|
70
|
0
|
|
|
|
|
|
$kv .= "$k=\"".$data->{$k}."\" "; |
|
71
|
|
|
|
|
|
|
} |
|
72
|
|
|
|
|
|
|
else { |
|
73
|
0
|
|
|
|
|
|
$kv .= "\"$k\"=\"".$data->{$k}."\" "; |
|
74
|
|
|
|
|
|
|
} |
|
75
|
|
|
|
|
|
|
} |
|
76
|
0
|
|
|
|
|
|
$kv =~ s{\s*$}{}; |
|
77
|
0
|
|
|
|
|
|
$data = $kv; |
|
78
|
|
|
|
|
|
|
} |
|
79
|
|
|
|
|
|
|
|
|
80
|
0
|
|
|
|
|
|
my $message = ''; |
|
81
|
0
|
0
|
|
|
|
|
if ($self->do_rfc3164) { |
|
82
|
0
|
|
|
|
|
|
my $date = $self->date($timestamp); |
|
83
|
0
|
|
|
|
|
|
$message = "$date $hostname $process\[$pid\]: $data"; |
|
84
|
|
|
|
|
|
|
} |
|
85
|
|
|
|
|
|
|
else { |
|
86
|
0
|
|
|
|
|
|
$message = "$process\[$pid\]: $data"; |
|
87
|
|
|
|
|
|
|
} |
|
88
|
|
|
|
|
|
|
|
|
89
|
0
|
|
|
|
|
|
return $message; |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub decode { |
|
93
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
94
|
0
|
|
|
|
|
|
my ($data) = @_; |
|
95
|
|
|
|
|
|
|
|
|
96
|
0
|
0
|
|
|
|
|
$self->brik_help_run_undef_arg('encode', $data) or return; |
|
97
|
0
|
0
|
|
|
|
|
$self->brik_help_run_invalid_arg('encode', $data, 'SCALAR') or return; |
|
98
|
|
|
|
|
|
|
|
|
99
|
0
|
|
|
|
|
|
my ($timestamp, $hostname, $process, $pid, $message); |
|
100
|
|
|
|
|
|
|
# May 17 18:18:06 |
|
101
|
0
|
0
|
|
|
|
|
if ($data =~ m{^(\S+\s+\d+\s+\S+)\s+(\S+)\s+(\S+)\[(\d+)\]:\s+(.*)$}) { |
|
|
|
0
|
|
|
|
|
|
|
102
|
0
|
|
|
|
|
|
$timestamp = $1; |
|
103
|
0
|
|
|
|
|
|
$hostname = $2; |
|
104
|
0
|
|
|
|
|
|
$process = $3; |
|
105
|
0
|
|
|
|
|
|
$pid = $4; |
|
106
|
0
|
|
|
|
|
|
$message = $5; |
|
107
|
|
|
|
|
|
|
} |
|
108
|
|
|
|
|
|
|
# Wed May 17 18:18:06 2017 |
|
109
|
|
|
|
|
|
|
elsif ($data =~ m{^(\S+\s+\S+\s+\d+\s+\S+\s+\S+)\s+(\S+)\s+(\S+)\[(\d+)\]:\s+(.*)$}) { |
|
110
|
0
|
|
|
|
|
|
$timestamp = $1; |
|
111
|
0
|
|
|
|
|
|
$hostname = $2; |
|
112
|
0
|
|
|
|
|
|
$process = $3; |
|
113
|
0
|
|
|
|
|
|
$pid = $4; |
|
114
|
0
|
|
|
|
|
|
$message = $5; |
|
115
|
|
|
|
|
|
|
} |
|
116
|
|
|
|
|
|
|
|
|
117
|
0
|
0
|
|
|
|
|
if (! defined($timestamp)) { |
|
118
|
0
|
|
|
|
|
|
return $self->log->error("decode: unable to decode message [$data]"); |
|
119
|
|
|
|
|
|
|
} |
|
120
|
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
return { |
|
122
|
0
|
|
|
|
|
|
timestamp => $timestamp, |
|
123
|
|
|
|
|
|
|
hostname => $hostname, |
|
124
|
|
|
|
|
|
|
process => $process, |
|
125
|
|
|
|
|
|
|
pid => $pid, |
|
126
|
|
|
|
|
|
|
message => $message, |
|
127
|
|
|
|
|
|
|
}; |
|
128
|
|
|
|
|
|
|
} |
|
129
|
|
|
|
|
|
|
|
|
130
|
|
|
|
|
|
|
sub date { |
|
131
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
|
132
|
0
|
|
|
|
|
|
my ($timestamp) = @_; |
|
133
|
|
|
|
|
|
|
|
|
134
|
0
|
|
|
|
|
|
my @month = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec}; |
|
135
|
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# |
|
137
|
|
|
|
|
|
|
# Courtesy of Net::Syslog |
|
138
|
|
|
|
|
|
|
# |
|
139
|
|
|
|
|
|
|
# But not RDC3164 compliant in regards to time format. |
|
140
|
|
|
|
|
|
|
# RFC3164: "Wed May 17 18:18:06 2017" |
|
141
|
|
|
|
|
|
|
# Not RFC3164: "May 17 18:18:06" |
|
142
|
|
|
|
|
|
|
# |
|
143
|
0
|
0
|
|
|
|
|
my @time = defined($timestamp) ? localtime($timestamp) : localtime(); |
|
144
|
0
|
0
|
|
|
|
|
my $date = |
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
$month[$time[4]]. |
|
146
|
|
|
|
|
|
|
' '. |
|
147
|
|
|
|
|
|
|
(($time[3] < 10) ? (' '.$time[3]) : $time[3]). |
|
148
|
|
|
|
|
|
|
' '. |
|
149
|
|
|
|
|
|
|
(($time[2] < 10 ) ? ('0'.$time[2]) : $time[2]). |
|
150
|
|
|
|
|
|
|
':'. |
|
151
|
|
|
|
|
|
|
(($time[1] < 10) ? ('0'.$time[1]) : $time[1]). |
|
152
|
|
|
|
|
|
|
':'. |
|
153
|
|
|
|
|
|
|
(($time[0] < 10) ? ('0'.$time[0]) : $time[0]); |
|
154
|
|
|
|
|
|
|
|
|
155
|
0
|
|
|
|
|
|
return $date; |
|
156
|
|
|
|
|
|
|
} |
|
157
|
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
1; |
|
159
|
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
__END__ |