Imported Upstream version 1.7
This commit is contained in:
Mario Fetka
172
lib/Data/DTO/GELF.pm
Normal file
172
lib/Data/DTO/GELF.pm
Normal file
@@ -0,0 +1,172 @@
|
||||
package Data::DTO::GELF;
|
||||
|
||||
# ABSTRACT: The DTO object for GELF version 1.1
|
||||
our $VERSION = '1.7'; # VERSION 1.7
|
||||
our $VERSION = 1.7;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Moose;
|
||||
use namespace::autoclean;
|
||||
|
||||
use JSON::Tiny qw(encode_json);
|
||||
use Sys::Hostname;
|
||||
use Data::UUID;
|
||||
use POSIX qw(strftime);
|
||||
|
||||
use Log::Log4perl;
|
||||
|
||||
use Data::DTO::GELF::Types qw( LogLevel );
|
||||
use Devel::StackTrace;
|
||||
|
||||
our $GELF_VERSION = 1.1;
|
||||
|
||||
has 'version' => (
|
||||
is => 'ro',
|
||||
isa => 'Str',
|
||||
builder => '_build_version',
|
||||
);
|
||||
|
||||
has 'host' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
builder => '_build_host',
|
||||
);
|
||||
|
||||
has 'short_message' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
lazy => 1,
|
||||
builder => '_long_to_short'
|
||||
);
|
||||
|
||||
has 'full_message' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
);
|
||||
|
||||
has 'timestamp' => (
|
||||
is => 'ro',
|
||||
isa => 'Int',
|
||||
builder => '_build_timestamp',
|
||||
);
|
||||
|
||||
has 'level' => (
|
||||
is => 'ro',
|
||||
isa => LogLevel,
|
||||
coerce => 1,
|
||||
);
|
||||
has '_facility' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
);
|
||||
|
||||
has '_line' => (
|
||||
is => 'rw',
|
||||
isa => 'Int',
|
||||
);
|
||||
|
||||
has '_file' => (
|
||||
is => 'rw',
|
||||
isa => 'Str',
|
||||
);
|
||||
|
||||
sub BUILD {
|
||||
my $self = shift;
|
||||
my $args = shift;
|
||||
foreach my $key1 ( keys %{$args} ) {
|
||||
if ( ( substr $key1, 0, 1 ) eq "_" ) {
|
||||
$self->meta->add_attribute( "$key1" => ( accessor => $key1 ) );
|
||||
$self->meta->get_attribute($key1)
|
||||
->set_value( $self, $args->{$key1} );
|
||||
}
|
||||
}
|
||||
|
||||
my $trace = Devel::StackTrace->new;
|
||||
foreach my $frame ( $trace->frames ) {
|
||||
if ( $frame->{subroutine} eq "Log::Log4perl::Logger::__ANON__" ) {
|
||||
$self->_line( $frame->{line} );
|
||||
$self->_file( $frame->{filename} );
|
||||
$self->_facility( $frame->{package} );
|
||||
}
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
sub _build_version {
|
||||
my $self = shift;
|
||||
return "$GELF_VERSION";
|
||||
}
|
||||
|
||||
sub _build_host {
|
||||
my $self = shift;
|
||||
return hostname();
|
||||
}
|
||||
|
||||
sub _build_timestamp {
|
||||
my $self = shift;
|
||||
return time();
|
||||
}
|
||||
|
||||
sub message {
|
||||
my $self = shift;
|
||||
my $m = shift;
|
||||
if ( defined $m ) {
|
||||
$self->full_message($m);
|
||||
}
|
||||
else {
|
||||
return $self->full_message();
|
||||
}
|
||||
|
||||
return;
|
||||
}
|
||||
|
||||
sub _long_to_short {
|
||||
my $self = shift;
|
||||
my $msg = $self->full_message();
|
||||
$msg =~ s/\n//sg;
|
||||
$msg =~ s/\s\s//sg;
|
||||
$msg = substr $msg, 0, 100;
|
||||
return $msg;
|
||||
}
|
||||
|
||||
sub TO_HASH {
|
||||
my $self = shift;
|
||||
{ $self->short_message() } #fire off lazy message builder
|
||||
return {%$self};
|
||||
}
|
||||
|
||||
sub TO_JSON {
|
||||
my $self = shift;
|
||||
{ $self->short_message() } #fire off lazy message builder
|
||||
return {%$self};
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Data::DTO::GELF - The DTO object for GELF version 1.1
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.7
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Brandon "Dimentox Travanti" Husbands <xotmid@gmail.com>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
58
lib/Data/DTO/GELF/Types.pm
Normal file
58
lib/Data/DTO/GELF/Types.pm
Normal file
@@ -0,0 +1,58 @@
|
||||
package Data::DTO::GELF::Types;
|
||||
|
||||
# ABSTRACT: Special types for log level conversion
|
||||
our $VERSION = '1.7'; # VERSION 1.7
|
||||
our $VERSION=1.7;
|
||||
use MooseX::Types -declare => [
|
||||
qw(
|
||||
LogLevel
|
||||
|
||||
)
|
||||
];
|
||||
|
||||
use MooseX::Types::Moose qw/Int Str/;
|
||||
|
||||
use Readonly;
|
||||
Readonly my %LOGLEVEL_MAP => (
|
||||
DEBUG => 0,
|
||||
INFO => 1,
|
||||
NOTICE => 2,
|
||||
WARNING => 3,
|
||||
ERROR => 4,
|
||||
CRITICAL => 5,
|
||||
ALERT => 6,
|
||||
EMERGENCY => 8
|
||||
);
|
||||
|
||||
subtype LogLevel, as Int;
|
||||
|
||||
coerce LogLevel, from Str, via { $LOGLEVEL_MAP{ uc $_ } // $_; };
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Data::DTO::GELF::Types - Special types for log level conversion
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.7
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Brandon "Dimentox Travanti" Husbands <xotmid@gmail.com>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
212
lib/Log/Log4perl/Appender/Graylog.pm
Normal file
212
lib/Log/Log4perl/Appender/Graylog.pm
Normal file
@@ -0,0 +1,212 @@
|
||||
package Log::Log4perl::Appender::Graylog;
|
||||
|
||||
# ABSTRACT: Log dispatcher writing to udp Graylog server
|
||||
our $VERSION = '1.7'; # VERSION 1.7
|
||||
my $VERSION = 1.7;
|
||||
our @ISA = qw(Log::Log4perl::Appender);
|
||||
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use Sys::Hostname;
|
||||
use Data::UUID;
|
||||
use POSIX qw(strftime);
|
||||
use IO::Compress::Gzip qw( gzip $GzipError );
|
||||
use IO::Socket;
|
||||
use Data::DTO::GELF;
|
||||
use Carp;
|
||||
use Log::GELF::Util qw(
|
||||
:all
|
||||
);
|
||||
|
||||
##################################################
|
||||
# Log dispatcher writing to udp Graylog server
|
||||
##################################################
|
||||
# cmd line example echo -n '{ "version": "1.1", "host": "example.org", "short_message": "A short message", "level": 5, "_some_info": "foo" }' | nc -w0 -u graylog.xo.gy 12201
|
||||
##################################################
|
||||
sub new {
|
||||
##################################################
|
||||
my $proto = shift;
|
||||
my $class = ref $proto || $proto;
|
||||
my %params = @_;
|
||||
|
||||
my $self = {
|
||||
name => "unknown name",
|
||||
PeerAddr => "",
|
||||
PeerPort => "",
|
||||
Proto => "udp",
|
||||
Gzip => 1,
|
||||
Chunked => 0,
|
||||
%params,
|
||||
|
||||
};
|
||||
bless $self, $class;
|
||||
|
||||
}
|
||||
|
||||
sub _create_socket {
|
||||
my ( $self, $socket_opts ) = @_;
|
||||
|
||||
require IO::Socket::INET;
|
||||
my $socket = IO::Socket::INET->new(
|
||||
PeerAddr => $socket_opts->{host},
|
||||
PeerPort => $socket_opts->{port},
|
||||
Proto => $socket_opts->{protocol},
|
||||
) or die "Cannot create socket: $!";
|
||||
|
||||
return $socket;
|
||||
}
|
||||
##################################################
|
||||
sub log {
|
||||
##################################################
|
||||
my $self = shift;
|
||||
my %params = @_;
|
||||
|
||||
my $packet = Data::DTO::GELF->new(
|
||||
'full_message' => $params{'message'},
|
||||
'level' => $params{level},
|
||||
'host' => $params{server} || $params{host} || hostname(),
|
||||
'_uuid' => Data::UUID->new()->create_str(),
|
||||
'_name' => $params{name},
|
||||
'_category' => $params{log4p_category},
|
||||
"_pid" => $$,
|
||||
|
||||
);
|
||||
|
||||
my $msg = validate_message( $packet->TO_HASH() );
|
||||
my $chunked = parse_size( $self->{Chunked} );
|
||||
$msg = encode($msg);
|
||||
$msg = compress($msg) if $self->{'Gzip'};
|
||||
my $socket = $self->_create_socket(
|
||||
{ 'host' => $self->{'PeerAddr'},
|
||||
'port' => $self->{'PeerPort'},
|
||||
'protocol' => $self->{'Proto'}
|
||||
}
|
||||
);
|
||||
$socket->send($_) foreach enchunk( $msg, $chunked );
|
||||
$socket->close();
|
||||
|
||||
}
|
||||
|
||||
1;
|
||||
|
||||
__END__
|
||||
|
||||
=pod
|
||||
|
||||
=encoding UTF-8
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Log::Log4perl::Appender::Graylog - Log dispatcher writing to udp Graylog server
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
version 1.7
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Log::Log4perl::Appender::Graylog;
|
||||
|
||||
my $appender = Log::Log4perl::Appender::Graylog->new(
|
||||
PeerAddr => "glog.foo.com",
|
||||
PeerPort => 12209,
|
||||
Gzip => 1, # Glog2 usually requires gzip but can send plain text
|
||||
);
|
||||
|
||||
$appender->log(message => "Log me\n");
|
||||
|
||||
or
|
||||
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||
log4perl.appender.SERVER.layout = NoopLayout
|
||||
log4perl.appender.SERVER.PeerAddr = <ip>
|
||||
log4perl.appender.SERVER.PeerPort = 12201
|
||||
log4perl.appender.SERVER.Gzip = 1
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This is a simple appender for writing to a graylog server.
|
||||
|
||||
It relies on L<IO::Socket::INET>. L<Log::GELF::Util>. This sends in the 1.1
|
||||
format.
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Log::Log4perl::Appender::Graylog; - Log to a Graylog server
|
||||
|
||||
=head1 CONFIG
|
||||
|
||||
log4perl.appender.SERVER = Log::Log4perl::Appender::Graylog
|
||||
log4perl.appender.SERVER.layout = NoopLayout
|
||||
log4perl.appender.SERVER.PeerAddr = <ip>
|
||||
log4perl.appender.SERVER.PeerPort = 12201
|
||||
log4perl.appender.SERVER.Gzip = 1
|
||||
log4perl.appender.SERVER.Chunked = <0|lan|wan>
|
||||
|
||||
layout This needs to be NoopLayout as we do not want any special formatting.
|
||||
Gzip Accepts an integer specifying if to compress the message.
|
||||
Chunked Accepts an integer specifying the chunk size or the special string values lan or wan corresponding to 8154 or 1420 respectively.
|
||||
|
||||
=head1 EXAMPLE
|
||||
|
||||
Write a server quickly using the IO::Socket:
|
||||
(based on orelly-perl-cookbook-ch17)
|
||||
|
||||
use strict;
|
||||
use IO::Socket;
|
||||
my($sock, $oldmsg, $newmsg, $hisaddr, $hishost, $MAXLEN, $PORTNO);
|
||||
$MAXLEN = 8192;
|
||||
$PORTNO = 12201;
|
||||
$sock = IO::Socket::INET->new(LocalPort => $PORTNO, Proto => 'udp')
|
||||
or die "socket: $@";
|
||||
print "Awaiting UDP messages on port $PORTNO\n";
|
||||
$oldmsg = "This is the starting message.";
|
||||
while ($sock->recv($newmsg, $MAXLEN)) {
|
||||
my($port, $ipaddr) = sockaddr_in($sock->peername);
|
||||
$hishost = gethostbyaddr($ipaddr, AF_INET);
|
||||
print "Client $hishost said ``$newmsg''\n";
|
||||
$sock->send($oldmsg);
|
||||
$oldmsg = "[$hishost] $newmsg";
|
||||
}
|
||||
die "recv: $!";
|
||||
|
||||
Start it and then run the following script as a client:
|
||||
|
||||
use Log::Log4perl qw(:easy);
|
||||
my $conf = q{
|
||||
log4perl.category = WARN, Graylog
|
||||
log4perl.appender.Graylog = Log::Log4perl::Appender::Graylog
|
||||
log4perl.appender.Graylog.PeerAddr = localhost
|
||||
log4perl.appender.Graylog.PeerPort = 12201
|
||||
log4perl.appender.Graylog.layout = SimpleLayout
|
||||
|
||||
};
|
||||
|
||||
Log::Log4perl->init( \$conf );
|
||||
|
||||
sleep(2);
|
||||
|
||||
for ( 1 .. 10 ) {
|
||||
ERROR("Quack!");
|
||||
sleep(5);
|
||||
}
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright 2017 by Brandon "Dimentox Travanti" Husbands E<lt>xotmid@gmail.comE<gt>
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself.
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Brandon "Dimentox Travanti" Husbands <xotmid@gmail.com>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
This software is copyright (c) 2017 by Brandon "Dimentox Travanti" Husbands.
|
||||
|
||||
This is free software; you can redistribute it and/or modify it under
|
||||
the same terms as the Perl 5 programming language system itself.
|
||||
|
||||
=cut
|
||||
Reference in New Issue
Block a user