Net-Syslogd-0.16/0000755000000000000000000000000012502671706012314 5ustar rootrootNet-Syslogd-0.16/t/0000755000000000000000000000000012502671701012552 5ustar rootrootNet-Syslogd-0.16/t/03-test-pod.t0000644000000000000000000000023512367762651014734 0ustar rootrooteval "use Test::Pod 1.00"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod 1.00 required for testing"); } else { all_pod_files_ok(); } Net-Syslogd-0.16/t/00-Net-Syslogd.t0000644000000000000000000000024511457056723015336 0ustar rootroot#!/usr/bin/perl use strict; use Test::Simple tests => 1; use Net::Syslogd; ok(1, "Loading Module"); # If we made it this far, we're ok. ######################### Net-Syslogd-0.16/t/02-pod-coverage.t0000644000000000000000000000025212367763250015542 0ustar rootrooteval "use Test::Pod::Coverage"; if ($@) { use Test; plan(tests => 1); skip("Test::Pod::Coverage required for testing"); } else { all_pod_coverage_ok(); } Net-Syslogd-0.16/Changes0000644000000000000000000000433412502664342013611 0ustar rootrootRevision history for Perl extension Net::Syslogd. 0.16 Thu Mar 19 20:30:00 2015 - Updated bin/syslogd-simple.pl server. 0.15 Thu Mar 19 20:30:00 2015 - SKIPPED 0.14 Wed Mar 18 16:30:00 2015 - Fixed v6Only tag when selecting IPv6 to account for Windows issues. 0.13 Mon Mar 2 09:30:00 2015 - Updated v6Only tag when selecting IPv6 to account for Linux issues. 0.12 Thu Nov 20 21:30:00 2014 - Updated Socket requirements for IPv6. - Updated bin/syslogd-sendtest.pl error when no priority value provided. 0.11 Mon Aug 4 21:30:00 2014 - Top down order for Changes. - Added LICENSE to Makefile.PL. - Cleanup code (remove Exporter). 0.10 Fri Aug 22 21:30:00 2013 - Fixed bug in hostname detection - Added --list to bin\syslogd-simple.pl 0.09 Sun Oct 7 21:30:00 2012 - Require Socket 1.87. 0.08 Thu Oct 4 23:59:00 2012 - Make IO::Socket::IP optional with failback to IP::Socket::INET with SUPER. - Changed peeraddr(), peerport() accessors to remoteaddr(), remoteport() to remove conflict with IO::Socket::*. 0.07 Tue Sep 4 12:00:00 2012 - Timeout on advanced tests with EU::MM prompt(). 0.06 Fri Aug 24 12:00:00 2012 - Added server() accessor. 0.05 Wed Aug 22 22:00:00 2012 - Changed to IO::Socket::IP and enabled IPv6 support. - Updated tests. 0.04 Fri Oct 15 23:30:00 2010 - Added PDU size and timeout options to get_message() method. - Updated regex in process_message() and added regex for user defined regex to be passed in. - Updated bin/ scripts. 0.03 Mon Jan 18 16:29:48 2010 - Allowed legacy and case insensitive calling of switches. 0.02 Wed Jan 13 19:29:48 2010 - Updated dependences to include IO::Socket and Test::Simple - Updated test plan to not fail if sockets can't be opened. Instead, print error message about Syslog already on UDP 514 and exit gracefully. - Corrected POD documentation inconsistencies and spelling. - Updated process_message() to allow calling as subroutine. 0.01 Fri Jan 8 18:29:48 2010 - original version; created by h2xs 1.23 with options -b 5.6.1 -v 0.01 -XAn Net::Syslogd Net-Syslogd-0.16/bin/0000755000000000000000000000000012502671701013057 5ustar rootrootNet-Syslogd-0.16/bin/syslogd-simple.pl0000644000000000000000000001215612502670356016401 0ustar rootroot#!/usr/bin/perl use strict; use warnings; use Getopt::Long qw(:config no_ignore_case); #bundling use Pod::Usage; use Net::Syslogd; my %opt; my ($opt_help, $opt_man); GetOptions( '4!' => \$opt{4}, '6!' => \$opt{6}, 'directory=s' => \$opt{dir}, 'interface:i' => \$opt{interface}, 'list!' => \$opt{list}, 'time!' => \$opt{time}, 'write+' => \$opt{write}, 'help!' => \$opt_help, 'man!' => \$opt_man ) or pod2usage(-verbose => 0); pod2usage(-verbose => 1) if defined $opt_help; pod2usage(-verbose => 2) if defined $opt_man; # Default to IPv4 my $family = 4; if ($opt{6}) { $family = 6 } $opt{time} = $opt{time} || 0; # -d is a directory, if it exists, assign it if (defined $opt{dir}) { # replace \ with / for compatibility with UNIX/Windows $opt{dir} =~ s/\\/\//g; # remove trailing / so we're sure it does NOT exist and we CAN put it in later $opt{dir} =~ s/\/$//; if (!(-e $opt{dir})) { print "$0: directory does not exist - $opt{dir}"; exit 1 } $opt{write} = 1 if (!$opt{write}) } if (defined $opt{interface}) { if (!(($opt{interface} > 0) && ($opt{interface} < 65536))) { print "$0: port not valid - $opt{interface}" } } else { $opt{interface} = '514' } my $syslogd = Net::Syslogd->new( LocalPort => $opt{interface}, Family => $family ); if (!$syslogd) { printf "$0: Error creating Syslogd listener: %s", Net::Syslogd->error; exit 1 } printf "Listening on %s:%i\n", $syslogd->server->sockhost, $syslogd->server->sockport; while (1) { my $message = $syslogd->get_message(); if (!defined $message) { printf "$0: %s\n", Net::Syslogd->error; exit 1 } elsif ($message == 0) { next } if (!defined $message->process_message()) { printf "$0: %s\n", Net::Syslogd->error } else { my $p; if ($opt{list}) { $p = sprintf "Time = %s\n" . "RemoteAddr = %s\n" . "RemotePort = %s\n" . "Severity = %s\n" . "Facility = %s\n" . "Time = %s\n" . "Hostname = %s\n" . "Message = %s\n", ($opt{time} ? yyyymmddhhmmss() : time), $message->remoteaddr, $message->remoteport, $message->severity, $message->facility, $message->time, $message->hostname, $message->message } else { $p = sprintf "%s\t%s\t%i\t%s\t%s\t%s\t%s\t%s\n", ($opt{time} ? yyyymmddhhmmss() : time), $message->remoteaddr, $message->remoteport, $message->severity, $message->facility, $message->time, $message->hostname, $message->message } print $p; if ($opt{write}) { my $outfile; if (defined $opt{dir}) { $outfile = $opt{dir} . "/" } if ($opt{write} == 1) { $outfile .= "syslogd.log" } elsif ($opt{write} == 2) { $outfile .= $message->facility . ".log" } else { $outfile .= $message->remoteaddr . ".log" } if (open(my $OUT, '>>', $outfile)) { print $OUT $p; close $OUT } else { print STDERR "$0: cannot open outfile - $outfile\n" } } } } sub yyyymmddhhmmss { my @time = localtime(); return (($time[5] + 1900) . ((($time[4] + 1) < 10)?("0" . ($time[4] + 1)):($time[4] + 1)) . (($time[3] < 10)?("0" . $time[3]):$time[3]) . (($time[2] < 10)?("0" . $time[2]):$time[2]) . (($time[1] < 10)?("0" . $time[1]):$time[1]) . (($time[0] < 10)?("0" . $time[0]):$time[0])) } __END__ =head1 NAME SYSLOGD-SIMPLE - Simple Syslog Server =head1 SYNOPSIS syslod-simple [options] =head1 DESCRIPTION Listens for Syslog messages and logs to console and optional file. Tries to decode according to RFC 3164 message format. Syslog columns are: Source IP Address Source UDP port Facility Severity Timestamp (or 0 if not matched) Hostname (or 0 if not matched) Message =head1 OPTIONS -4 Force IPv4. -6 Force IPv6 (overrides -4). -d Output file directory. --directory DEFAULT: (or not specified) [Current]. -i # UDP Port to listen on. --interface DEFAULT: (or not specified) 514. -l Output list format. --list DEFAULT: (or not specified) Line. -t Print time in human-readable yyyymmddhhmmss format. --time DEFAULT: (or not specified) Unix epoch. -w Log to "syslogd.log". -w -w Log by facility in ".log". -w -w -w Log by hostname in ".log". =head1 LICENSE This software is released under the same terms as Perl itself. If you don't know what that means visit L. =head1 AUTHOR Copyright (C) Michael Vincent 2010 L All rights reserved =cut Net-Syslogd-0.16/bin/syslogd-sendtest.pl0000644000000000000000000001361512502671452016740 0ustar rootroot#!/usr/bin/perl use strict; use warnings; use Getopt::Long qw(:config no_ignore_case); #bundling use Pod::Usage; use Sys::Hostname; use Socket qw(AF_INET); my $AF_INET6 = eval { Socket::AF_INET6() }; my $HAVE_IO_Socket_IP = 0; eval "use IO::Socket::IP -register"; if(!$@) { $HAVE_IO_Socket_IP = 1; } else { eval "use IO::Socket::INET"; } my %opt; my ($opt_help, $opt_man); GetOptions( '4!' => \$opt{4}, '6!' => \$opt{6}, 'datagram=s' => \$opt{datagram}, 'facility=s' => \$opt{facility}, 'h|hostname=s' => \$opt{hostname}, 'm|message=s' => \$opt{message}, 'msec!' => \$opt{msec}, 'severity=s' => \$opt{severity}, 'year!' => \$opt{year}, 'help!' => \$opt_help, 'man!' => \$opt_man ) or pod2usage(-verbose => 0); pod2usage(-verbose => 1) if defined $opt_help; pod2usage(-verbose => 2) if defined $opt_man; # Default to IPv4 my $family = AF_INET; if ($opt{6}) { $family = $AF_INET6 } if (!$HAVE_IO_Socket_IP && ($family == $AF_INET6)) { print "IO::Socket::IP required for IPv6\n"; exit 1 } # Strict RFC 3164 # "<174>Dec 11 12:31:15 192.168.200.1 " . $0 . "[" . $$ . "]: Strict RFC 3164 format", # Net::Syslog # "<182>" . $0 . "[" . $$ . "]: Net::Syslog format", # Cisco # "<190>62: *Dec 4 12:31:15.087: %SYS-5-CONFIG_I: Cisco format" ### Syslog message my $message; if (defined($opt{datagram})) { $message = $opt{datagram} } else { my %SYSLOG_FAC=( kernel => 0, user => 1, mail => 2, system => 3, security => 4, internal => 5, printer => 6, news => 7, uucp => 8, clock => 9, security2 => 10, ftp => 11, ntp => 12, audit => 13, alert => 14, clock2 => 15, local0 => 16, local1 => 17, local2 => 18, local3 => 19, local4 => 20, local5 => 21, local6 => 22, local7 => 23 ); my %SYSLOG_SEV=( emergency => 0, alert => 1, critical => 2, error => 3, warning => 4, notice => 5, informational => 6, debug => 7 ); my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); $opt{facility} = $opt{facility} || 'local7'; $opt{severity} = $opt{severity} || 'informational'; ### Priority # Facility my $facility = $SYSLOG_FAC{$opt{facility}}; # Severity my $severity = $SYSLOG_SEV{$opt{severity}}; $facility = $facility || 23; $severity = $severity || 6; # Priority my $priority = (($facility<<3)|($severity)); ### Timestamp my @time = localtime(); my $timestamp = $month[$time[4]] . " " . (($time[3] < 10)?(" " . $time[3]):$time[3]) . " "; if (defined($opt{year})) { $timestamp .= $time[5] + 1900 . " "; } $timestamp .= (($time[2] < 10)?("0" . $time[2]):$time[2]) . ":" . (($time[1] < 10)?("0" . $time[1]):$time[1]) . ":" . (($time[0] < 10)?("0" . $time[0]):$time[0]); if (defined($opt{msec})) { $timestamp .= "." . "123"; } ### Hostname if (!defined($opt{hostname})) { $opt{hostname} = 'localhost' } ### Message my $msg = $opt{message} || "Message from $0"; $message = "<$priority>$timestamp $opt{hostname} $0\[$$\]: $msg" } my $sock; if ($HAVE_IO_Socket_IP) { $sock = IO::Socket::IP->new( PeerHost => $ARGV[0] || 'localhost', PeerPort => 514, Family => $family, Proto => 'udp' ) or die "Error: creating Syslog sender - $!\n"; } else { $sock = IO::Socket::INET->new( PeerHost => $ARGV[0] || 'localhost', PeerPort => 514, Proto => 'udp' ) or die "Error: creating Syslog sender - $!\n"; } $sock->send($message); $sock->close(); __END__ =head1 NAME SYSLOGD-SENDTEST - Syslog Message Tests =head1 SYNOPSIS syslod-sendtest [options] [host] =head1 DESCRIPTION Sends sample Syslog messages. =head1 OPTIONS host The host to send to. DEFAULT: (or not specified) localhost. -4 Force IPv4. -6 Force IPv6 (overrides -4). -d datagram Entire Syslog datagram. Use double-quotes to delimit. --datagram Overrides all other options except 'host'. Example: "<190>Jan 01 00:00:00 host syslog.pl[123]: Message" DEFAULT: (or not specified) [build from user input] -f facility Syslog facility. Valid facility: --facility kernel, user, mail, system, security, internal, printer, news, uucp, clock, security2, ftp, ntp, audit, alert, clock2, local0, local1, local2, local3, local4, local5, local6, local7 DEFAULT: (or not specified) [local7] -h name|IP[v6] Hostname. --hostname DEFAULT: (or not specified) localhost -m message Syslog message. Use double-quotes to delimit --message if spaces are used. DEFAULT: (or not specified) ["Message from ..."] -ms Include milliseconds in timestamp. --msec Not RFC 3164 compliant. DEFAULT: (or not specified) [do not include] -s severity Syslog severity. Valid severity: --severity emergency, alert, critical, error, warning, notice, informational, debug DEFAULT: (or not specified) [informational] -y Include year in timestamp. --year Not RFC 3164 compliant. DEFAULT: (or not specified) [do not include] =head1 LICENSE This software is released under the same terms as Perl itself. If you don't know what that means visit L. =head1 AUTHOR Copyright (C) Michael Vincent 2010 L All rights reserved =cut Net-Syslogd-0.16/META.json0000644000000000000000000000170712502671705013741 0ustar rootroot{ "abstract" : "Perl implementation of Syslog Listener", "author" : [ "Michael Vincent " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Net-Syslogd", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Socket" : "0", "Test::Simple" : "0" } } }, "release_status" : "stable", "version" : "0.16" } Net-Syslogd-0.16/MANIFEST0000644000000000000000000000050712367762662013462 0ustar rootrootChanges Makefile.PL MANIFEST README bin/syslogd-sendtest.pl bin/syslogd-simple.pl t/00-Net-Syslogd.t t/02-pod-coverage.t t/03-test-pod.t test.pl lib/Net/Syslogd.pm META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Net-Syslogd-0.16/test.pl0000644000000000000000000002751412370025650013633 0ustar rootroot#!/usr/bin/perl # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl Net-SNMPTrapd.t' use strict; use warnings; use Test::Simple tests => 21; use ExtUtils::MakeMaker qw(prompt); my $NUM_TESTS = 21; my $VERBOSE = 0; use Net::Syslogd; ok(1, "Loading Module"); # If we made it this far, we're ok. ######################### print <new(); if (defined($syslogd)) { return $syslogd } else { printf "Error: %s\nDo you have a Syslog program listening already?\n ('netstat -an | grep 514')\n", Net::Syslogd->error; return undef } } my $syslogd = start_server(); if (!defined($syslogd)) { ok(1, "Starting Server - Skipping remaining tests"); for (3..$NUM_TESTS) { ok(1, "Skipping test ...") } exit } else { ok(1, "Starting Server"); } ######################### # Test 3 if ($syslogd->server->sockport == 514) { ok(1, "server() accessor"); } else { ok(0, "server() accessor"); } ######################### # Test 4 - 20 sub receive_message { my @tests = ( { name => 'Strict RFC 3164 format', data => '<189>Dec 11 12:31:15 10.10.10.1 AGENT[1234]: Strict RFC 3164 format' }, { name => 'Net::Syslog format', data => '<189>AGENT[1234]: Net::Syslog format' }, { name => 'Cisco: service timestamps log datetime', data => '<189>10: *Jan 7 16:28:06: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime localtime', data => '<189>11: *Jan 7 11:36:06: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime show-timezone', data => '<189>12: *Jan 7 16:36:41 UTC: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime msec', data => '<189>13: *Jan 7 16:37:23.439: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime year', data => '<189>14: *Jan 7 2011 16:38:17: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime localtime show-timezone', data => '<189>15: *Jan 7 11:39:50 EST: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime msec localtime', data => '<189>16: *Jan 7 11:40:20.723: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime localtime year', data => '<189>17: *Jan 7 2011 11:40:47: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime msec show-timezone', data => '<189>18: *Jan 7 16:41:20.575 UTC: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime show-timezone year', data => '<189>19: *Jan 7 2011 16:41:51 UTC: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime msec year', data => '<189>20: *Jan 7 2011 16:42:34.315: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime msec localtime show-timezone', data => '<189>21: *Jan 7 11:42:56.387 EST: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime localtime show-timezone year', data => '<189>22: *Jan 7 2011 11:43:15 EST: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime msec show-timezone year', data => '<189>23: *Jan 7 2011 16:43:37.031 UTC: %SYS-5-CONFIG_I: Configured from console by console' }, { name => 'Cisco: service timestamps log datetime msec localtime show-timezone year', data => '<189>24: *Jan 7 2011 11:44:02.671 EST: %SYS-5-CONFIG_I: Configured from console by console' } ); my $pid = fork(); if (!defined($pid)) { print "Error: fork() - $!\n"; return 1 } elsif ($pid == 0) { #child sleep 2; use IO::Socket::INET; my $sock=new IO::Socket::INET( PeerAddr => 'localhost', PeerPort => 514, Proto => 'udp' ); if (!defined($sock)) { printf "Error: Syslog send test could not start: %s\n", $sock->sockopt(SO_ERROR); return 1 } for (@tests) { print $sock "$_->{data}" } $sock->close(); exit } else { # parent my $FAILED = 0; for (@tests) { my $message; if (!($message = $syslogd->get_message())) { printf "Error: %s\n", Net::Syslogd->error; return 1 } if (!(defined($message->process_message()))) { printf "Error: %s\n", Net::Syslogd->error; return 1 } else { print " -- $_->{name} --\n" if ($VERBOSE); print " remoteaddr = " if ($VERBOSE); if (defined($message->remoteaddr) && ($message->remoteaddr eq "127.0.0.1")) { printf "%s\n", $message->remoteaddr if ($VERBOSE) } else { printf " !ERROR! - %s\n", $message->remoteaddr if ($VERBOSE); $FAILED++ } print " remoteport = " if ($VERBOSE); if (defined($message->remoteport) && ($message->remoteport =~ /^\d{1,5}$/)) { printf "%s\n", $message->remoteport if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->remoteport if ($VERBOSE); $FAILED++ } print " facility = " if ($VERBOSE); if (defined($message->facility) && ($message->facility =~ /^local[567]$/)) { printf "%s\n", $message->facility if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->facility if ($VERBOSE); $FAILED++ } print " severity = " if ($VERBOSE); if (defined($message->severity) && ($message->severity eq "Notice")) { printf "%s\n", $message->severity if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->severity if ($VERBOSE); $FAILED++ } print " time = " if ($VERBOSE); if (defined($message->time) && (($message->time eq "0") || ($message->time =~ /^((?:[JFMASONDjfmasond]\w\w) {1,2}(?:\d+)(?: \d{4})* (?:\d{2}:\d{2}:\d{2}[\.\d{1,3}]*)(?: [A-Z]{1,3})*)$/))) { printf "%s\n", $message->time if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->time if ($VERBOSE); $FAILED++ } print " hostname = " if ($VERBOSE); if (defined($message->hostname) && (($message->hostname eq "0") || ($message->hostname eq "10.10.10.1"))) { printf "%s\n", $message->hostname if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->hostname if ($VERBOSE); $FAILED++ } print " message = " if ($VERBOSE); if (defined($message->message)) { printf "%s\n", $message->message if ($VERBOSE); } else { $FAILED++ } } ok(!$FAILED, "$_->{name}"); $FAILED = 0 } } } receive_message(); ######################### # Test 21 sub process_as_sub { my $FAILED = 0; my $message = Net::Syslogd->process_message("<174>Dec 11 12:31:15 10.10.10.1 AGENT[0]: Strict RFC 3164 format"); # print " facility = "; if (defined($message->facility) && ($message->facility =~ /^local[567]$/)) { printf "%s\n", $message->facility } else { printf " !ERROR! - %s\n", $message->facility; $FAILED++ } # print " severity = "; if (defined($message->severity) && ($message->severity eq "Informational")) { printf "%s\n", $message->severity } else { printf " !ERROR! - %s\n", $message->severity; $FAILED++ } # print " time = "; if (defined($message->time) && (($message->time eq "0") || ($message->time =~ /^Dec\s+[14]{1,2}\s12:31:15[\.087]*$/))) { printf "%s\n", $message->time } else { printf " !ERROR! - %s\n", $message->time; $FAILED++ } # print " hostname = "; if (defined($message->hostname) && (($message->hostname eq "0") || ($message->hostname eq "10.10.10.1"))) { printf "%s\n", $message->hostname } else { printf " !ERROR! - %s\n", $message->hostname; $FAILED++ } # print " message = "; if (defined($message->message)) { printf "%s\n", $message->message } else { $FAILED++ } print " facility = " if ($VERBOSE); if (defined($message->facility) && ($message->facility eq 'local5')) { printf "%s\n", $message->facility if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->facility if ($VERBOSE); $FAILED++ } print " severity = " if ($VERBOSE); if (defined($message->severity) && ($message->severity eq 'Informational')) { printf "%s\n", $message->severity if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->severity if ($VERBOSE); $FAILED++ } print " time = " if ($VERBOSE); if (defined($message->time) && ($message->time eq 'Dec 11 12:31:15')) { printf "%s\n", $message->time if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->time if ($VERBOSE); $FAILED++ } print " hostname = " if ($VERBOSE); if (defined($message->hostname) && ($message->hostname eq "10.10.10.1")) { printf "%s\n", $message->hostname if ($VERBOSE); } else { printf " !ERROR! - %s\n", $message->hostname if ($VERBOSE); $FAILED++ } print " message = " if ($VERBOSE); if (defined($message->message)) { printf "%s\n", $message->message if ($VERBOSE); } else { $FAILED++ } return $FAILED } ok(process_as_sub() == 0, "Process as sub"); Net-Syslogd-0.16/README0000644000000000000000000000113112502361767013173 0ustar rootrootNet-Syslogd =========== INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: Socket (requires 1.94 for IPv6) IO::Socket::IP (for IPv6 support) Test::Simple Term::ReadKey COPYRIGHT AND LICENCE Copyright (C) 2010 by Michael Vincent (www.VinsWorld.com) This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.10.1 or, at your option, any later version of Perl 5 you may have available. Net-Syslogd-0.16/Makefile.PL0000644000000000000000000000144012433437036014264 0ustar rootrootuse 5.008001; use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( NAME => 'Net::Syslogd', VERSION_FROM => 'lib/Net/Syslogd.pm', # finds $VERSION ($ExtUtils::MakeMaker::VERSION >= 6.3002) ? ('LICENSE' => 'perl', ) : (), EXE_FILES => ['bin/syslogd-simple.pl', 'bin/syslogd-sendtest.pl'], PREREQ_PM => {Test::Simple => 0, Socket => 0 }, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Net/Syslogd.pm', # retrieve abstract from module AUTHOR => 'Michael Vincent ') : ()), ); Net-Syslogd-0.16/lib/0000755000000000000000000000000012502671701013055 5ustar rootrootNet-Syslogd-0.16/lib/Net/0000755000000000000000000000000012502671701013603 5ustar rootrootNet-Syslogd-0.16/lib/Net/Syslogd.pm0000644000000000000000000004671012502664125015577 0ustar rootrootpackage Net::Syslogd; ######################################################## # AUTHOR = Michael Vincent # www.VinsWorld.com ######################################################## use strict; use warnings; use Socket qw(AF_INET); my $AF_INET6 = eval { Socket::AF_INET6() }; our $VERSION = '0.16'; our @ISA; my $HAVE_IO_Socket_IP = 0; eval "use IO::Socket::IP -register"; if(!$@) { $HAVE_IO_Socket_IP = 1; push @ISA, "IO::Socket::IP" } else { require IO::Socket::INET; push @ISA, "IO::Socket::INET"; } ######################################################## # Start Variables ######################################################## use constant SYSLOGD_DEFAULT_PORT => 514; use constant SYSLOGD_RFC_SIZE => 1024; # RFC Limit use constant SYSLOGD_REC_SIZE => 2048; # Recommended size use constant SYSLOGD_MAX_SIZE => 65467; # Actual limit (65535 - IP/UDP) my @FACILITY = qw(kernel user mail system security internal printer news uucp clock security2 FTP NTP audit alert clock2 local0 local1 local2 local3 local4 local5 local6 local7); my @SEVERITY = qw(Emergency Alert Critical Error Warning Notice Informational Debug); our $LASTERROR; ######################################################## # End Variables ######################################################## ######################################################## # Start Public Module ######################################################## sub new { my $self = shift; my $class = ref($self) || $self; # Default parameters my %params = ( 'Proto' => 'udp', 'LocalPort' => SYSLOGD_DEFAULT_PORT, 'Timeout' => 10, 'Family' => AF_INET ); if (@_ == 1) { $LASTERROR = "Insufficient number of args - @_"; return undef } else { my %cfg = @_; for (keys(%cfg)) { if (/^-?localport$/i) { $params{LocalPort} = $cfg{$_} } elsif (/^-?localaddr$/i) { $params{LocalAddr} = $cfg{$_} } elsif (/^-?family$/i) { if ($cfg{$_} =~ /^(?:(?:(:?ip)?v?(?:4|6))|${\AF_INET}|$AF_INET6)$/) { if ($cfg{$_} =~ /^(?:(?:(:?ip)?v?4)|${\AF_INET})$/) { $params{Family} = AF_INET } else { if (!$HAVE_IO_Socket_IP) { $LASTERROR = "IO::Socket::IP required for IPv6"; return undef } $params{Family} = $AF_INET6; if ($^O ne 'MSWin32') { $params{V6Only} = 1 } } } else { $LASTERROR = "Invalid family - $cfg{$_}"; return undef } } elsif (/^-?timeout$/i) { if ($cfg{$_} =~ /^\d+$/) { $params{Timeout} = $cfg{$_} } else { $LASTERROR = "Invalid timeout - $cfg{$_}"; return undef } # pass through } else { $params{$_} = $cfg{$_} } } } if (my $udpserver = $class->SUPER::new(%params)) { return bless { %params, # merge user parameters '_UDPSERVER_' => $udpserver }, $class } else { $LASTERROR = "Error opening socket for listener: $@"; return undef } } sub get_message { my $self = shift; my $class = ref($self) || $self; my $message; foreach my $key (keys(%{$self})) { # everything but '_xxx_' $key =~ /^\_.+\_$/ and next; $message->{$key} = $self->{$key} } my $datagramsize = SYSLOGD_MAX_SIZE; if (@_ == 1) { $LASTERROR = "Insufficient number of args: @_"; return undef } else { my %args = @_; for (keys(%args)) { # -maxsize if (/^-?(?:max)?size$/i) { if ($args{$_} =~ /^\d+$/) { if (($args{$_} >= 1) && ($args{$_} <= SYSLOGD_MAX_SIZE)) { $datagramsize = $args{$_} } } elsif ($args{$_} =~ /^rfc$/i) { $datagramsize = SYSLOGD_RFC_SIZE } elsif ($args{$_} =~ /^rec(?:ommend)?(?:ed)?$/i) { $datagramsize = SYSLOGD_REC_SIZE } else { $LASTERROR = "Not a valid size: $args{$_}"; return undef } # -timeout } elsif (/^-?timeout$/i) { if ($args{$_} =~ /^\d+$/) { $message->{Timeout} = $args{$_} } else { $LASTERROR = "Invalid timeout - $args{$_}"; return undef } } } } my $Timeout = $message->{Timeout}; my $udpserver = $self->{_UDPSERVER_}; my $datagram; if ($Timeout != 0) { # vars for IO select my ($rin, $rout, $ein, $eout) = ('', '', '', ''); vec($rin, fileno($udpserver), 1) = 1; # check if a message is waiting if (! select($rout=$rin, undef, $eout=$ein, $Timeout)) { $LASTERROR = "Timed out waiting for datagram"; return(0) } } # read the message if ($udpserver->recv($datagram, $datagramsize)) { $message->{_UDPSERVER_} = $udpserver; $message->{_MESSAGE_}{PeerPort} = $udpserver->SUPER::peerport; $message->{_MESSAGE_}{PeerAddr} = $udpserver->SUPER::peerhost; $message->{_MESSAGE_}{datagram} = $datagram; return bless $message, $class } $LASTERROR = sprintf "Socket RECV error: $!"; return undef } sub process_message { my $self = shift; my $class = ref($self) || $self; ### Allow to be called as subroutine # Net::Syslogd->process_message($data) if (($self eq $class) && ($class eq __PACKAGE__)) { my %th; $self = \%th; ($self->{_MESSAGE_}{datagram}) = @_ } # Net::Syslogd::process_message($data) if ($class ne __PACKAGE__) { my %th; $self = \%th; ($self->{_MESSAGE_}{datagram}) = $class; $class = __PACKAGE__ } # Syslog RFC 3164 correct format: # <###>Mmm dd hh:mm:ss hostname tag msg # # NOTE: This module parses the tag and msg as a single field called msg ###### # Cisco: # service timestamps log uptime # <189>82: 00:20:10: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # service timestamps log datetime # <189>83: *Oct 16 21:41:00: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # service timestamps log datetime msec # <189>88: *Oct 16 21:46:48.671: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # service timestamps log datetime year # <189>86: *Oct 16 2010 21:45:56: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # service timestamps log datetime show-timezone # <189>92: *Oct 16 21:49:30 UTC: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # service timestamps log datetime msec year # <189>90: *Oct 16 2010 21:47:50.439: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # service timestamps log datetime msec show-timezone # <189>93: *Oct 16 21:51:13.823 UTC: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # service timestamps log datetime year show-timezone # <189>94: *Oct 16 2010 21:51:49 UTC: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # service timestamps log datetime msec year show-timezone # <189>91: *Oct 16 2010 21:48:41.663 UTC: %SYS-5-CONFIG_I: Configured from console by cisco on vty0 (192.168.200.1) # IPv4 only # my $regex = '<(\d{1,3})>[\d{1,}: \*]*((?:[JFMASONDjfmasond]\w\w) {1,2}(?:\d+)(?: \d{4})* (?:\d{2}:\d{2}:\d{2}[\.\d{1,3}]*)(?: [A-Z]{1,3})*)?:*\s*(?:((?:[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})|(?:[a-zA-Z0-9\-]+)) )?(.*)'; # IPv6 my $regex = '<(\d{1,3})>[\d{1,}: \*]*((?:[JFMASONDjfmasond]\w\w) {1,2}(?:\d+)(?: \d{4})? (?:\d{2}:\d{2}:\d{2}[\.\d{1,3}]*)(?: [A-Z]{1,3}:)?)?:?\s*(?:((?:[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})|(?:[a-zA-Z0-9\-]+)|(?:(?:(?:[0-9A-Fa-f]{1,4}:){7}(?:[0-9A-Fa-f]{1,4}|:))|(?:(?:[0-9A-Fa-f]{1,4}:){6}(?::[0-9A-Fa-f]{1,4}|(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3})|:))|(?:(?:[0-9A-Fa-f]{1,4}:){5}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,2})|:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3})|:))|(?:(?:[0-9A-Fa-f]{1,4}:){4}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,3})|(?:(?::[0-9A-Fa-f]{1,4})?:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[0-9A-Fa-f]{1,4}:){3}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,4})|(?:(?::[0-9A-Fa-f]{1,4}){0,2}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[0-9A-Fa-f]{1,4}:){2}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,5})|(?:(?::[0-9A-Fa-f]{1,4}){0,3}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[0-9A-Fa-f]{1,4}:){1}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,6})|(?:(?::[0-9A-Fa-f]{1,4}){0,4}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?::(?:(?:(?::[0-9A-Fa-f]{1,4}){1,7})|(?:(?::[0-9A-Fa-f]{1,4}){0,5}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:)))(?:%.+)?) )?(.*)'; # If more than 1 argument, parse the options if (@_ != 1) { my %args = @_; for (keys(%args)) { # -datagram if ((/^-?data(?:gram)?$/i) || (/^-?pdu$/i)) { $self->{_MESSAGE_}{datagram} = $args{$_} } # -regex if (/^-?regex$/i) { if ($args{$_} =~ /^rfc(?:3164)?$/i) { # Strict RFC 3164 $regex = '<(\d{1,3})>((?:[JFMASONDjfmasond]\w\w) {1,2}(?:\d+)(?: \d{4})? (?:\d{2}:\d{2}:\d{2}))?:*\s*(?:((?:[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})|(?:[a-zA-Z0-9\-]+)) )?(.*)' } else { $regex = $args{$_}; # strip leading / if found $regex =~ s/^\///; # strip trailing / if found $regex =~ s/\/$// } } } } my $Cregex = qr/$regex/; # Parse message $self->{_MESSAGE_}{datagram} =~ /$Cregex/; $self->{_MESSAGE_}{priority} = $1; $self->{_MESSAGE_}{time} = $2 || 0; $self->{_MESSAGE_}{hostname} = $3 || 0; $self->{_MESSAGE_}{message} = $4; $self->{_MESSAGE_}{severity} = $self->{_MESSAGE_}{priority} % 8; $self->{_MESSAGE_}{facility} = ($self->{_MESSAGE_}{priority} - $self->{_MESSAGE_}{severity}) / 8; $self->{_MESSAGE_}{hostname} =~ s/\s+//; $self->{_MESSAGE_}{time} =~ s/:$//; return bless $self, $class } sub server { my $self = shift; return $self->{_UDPSERVER_} } sub datagram { my $self = shift; return $self->{_MESSAGE_}{datagram} } sub remoteaddr { my $self = shift; return $self->{_MESSAGE_}{PeerAddr} } sub remoteport { my $self = shift; return $self->{_MESSAGE_}{PeerPort} } sub priority { my $self = shift; return $self->{_MESSAGE_}{priority} } sub facility { my ($self, $arg) = @_; if (defined($arg) && ($arg >= 1)) { return $self->{_MESSAGE_}{facility} } else { return $FACILITY[$self->{_MESSAGE_}{facility}] } } sub severity { my ($self, $arg) = @_; if (defined($arg) && ($arg >= 1)) { return $self->{_MESSAGE_}{severity} } else { return $SEVERITY[$self->{_MESSAGE_}{severity}] } } sub time { my $self = shift; return $self->{_MESSAGE_}{time} } sub hostname { my $self = shift; return $self->{_MESSAGE_}{hostname} } sub message { my $self = shift; return $self->{_MESSAGE_}{message} } sub error { return $LASTERROR } ######################################################## # End Public Module ######################################################## 1; __END__ ######################################################## # Start POD ######################################################## =head1 NAME Net::Syslogd - Perl implementation of Syslog Listener =head1 SYNOPSIS use Net::Syslogd; my $syslogd = Net::Syslogd->new() or die "Error creating Syslogd listener: ", Net::Syslogd->error; while (1) { my $message = $syslogd->get_message(); if (!defined($message)) { printf "$0: %s\n", Net::Syslogd->error; exit 1 } elsif ($message == 0) { next } if (!defined($message->process_message())) { printf "$0: %s\n", Net::Syslogd->error } else { printf "%s\t%i\t%s\t%s\t%s\t%s\t%s\n", $message->remoteaddr, $message->remoteport, $message->facility, $message->severity, $message->time, $message->hostname, $message->message } } =head1 DESCRIPTION Net::Syslogd is a class implementing a simple Syslog listener in Perl. Net::Syslogd will accept messages on the default Syslog port (UDP 514) and attempt to decode them according to RFC 3164. =head1 METHODS =head2 new() - create a new Net::Syslogd object my $syslogd = Net::Syslogd->new([OPTIONS]); Create a new Net::Syslogd object with OPTIONS as optional parameters. Valid options are: Option Description Default ------ ----------- ------- -Family Address family IPv4/IPv6 IPv4 Valid values for IPv4: 4, v4, ip4, ipv4, AF_INET (constant) Valid values for IPv6: 6, v6, ip6, ipv6, AF_INET6 (constant) -LocalAddr Interface to bind to any -LocalPort Port to bind server to 514 -timeout Timeout in seconds for socket 10 operations and to wait for request B: IPv6 requires IO::Socket::IP. Failback is IO::Socket::INET and only IPv4 support. Allows the following accessors to be called. =head3 server() - return IO::Socket::IP object for server $syslogd->server(); Return B object for the created server. All B accessors can then be called. =head2 get_message() - listen for Syslog message my $message = $syslogd->get_message([OPTIONS]); Listen for Syslog messages. Timeout after default or user specified timeout set in C method and return '0'. If message is received before timeout, return is defined. Return is not defined if error encountered. Valid options are: Option Description Default ------ ----------- ------- -maxsize Max size in bytes of acceptable 65467 message. Value can be integer 1 <= # <= 65467. Keywords: 'RFC' = 1024 'recommended' = 2048 -timeout Timeout in seconds to wait for 10 request. Overrides value set with new(). Allows the following accessors to be called. =head3 remoteaddr() - return remote address from Syslog message $message->remoteaddr(); Return remote address value from a received (C) Syslog message. This is the address from the IP header on the UDP datagram. =head3 remoteport() - return remote port from Syslog message $message->remoteport(); Return remote port value from a received (C) Syslog message. This is the port from the IP header on the UDP datagram. =head3 datagram() - return datagram from Syslog message $message->datagram(); Return the raw datagram from a received (C) Syslog message. =head2 process_message() - process received Syslog message $message->process_message([OPTIONS]); Process a received Syslog message according to RFC 3164 - or as close as possible. RFC 3164 format is as follows: <###>Mmm dd hh:mm:ss hostname tag content |___||_____________| |______| |_________| | Timestamp Hostname Message | Priority -> (facility and severity) B This module parses the tag and content as a single field. Called with one argument, interpreted as the datagram to process. Valid options are: Option Description Default ------ ----------- ------- -datagram Datagram to process -Provided by get_message()- -regex Regular expression to parse received -Provided in syslog message. this method- Keywords: 'RFC' = Strict RFC 3164 Must include ()-matching: $1 = priority $2 = time $3 = hostname $4 = message B This uses a regex that parses RFC 3164 compliant syslog messages. It will also recoginize Cisco syslog messages (not fully RFC 3164 compliant) sent with 'timestamp' rather than 'uptime'. This can also be called as a procedure if one is inclined to write their own UDP listener instead of using C. For example: $sock = IO::Socket::IP->new( blah blah blah ); $sock->recv($datagram, 1500); # process datagram in $datagram variable $message = Net::Syslogd->process_message($datagram); In either instantiation, allows the following accessors to be called. =head3 priority() - return priority from Syslog message $message->priority(); Return priority value from a received and processed (C) Syslog message. This is the raw priority number not decoded into facility and severity. =head3 facility() - return facility from Syslog message $message->facility([1]); Return facility value from a received and processed (C) Syslog message. This is the text representation of the facility. For the raw number, use the optional boolean argument. =head3 severity() - return severity from Syslog message $message->severity([1]); Return severity value from a received and processed (C) Syslog message. This is the text representation of the severity. For the raw number, use the optional boolean argument. =head3 time() - return time from Syslog message $message->time(); Return time value from a received and processed (C) Syslog message. =head3 hostname() - return hostname from Syslog message $message->hostname(); Return hostname value from a received and processed (C) Syslog message. =head3 message() - return message from Syslog message $message->message(); Return message value from a received and processed (C) Syslog message. Note this is the tag B msg field from a properly formatted RFC 3164 Syslog message. =head2 error() - return last error printf "Error: %s\n", Net::Syslogd->error; Return last error. =head1 EXPORT None by default. =head1 EXAMPLES This distribution comes with several scripts (installed to the default "bin" install directory) that not only demonstrate example uses but also provide functional execution. =head1 LICENSE This software is released under the same terms as Perl itself. If you don't know what that means visit L. =head1 AUTHOR Copyright (C) Michael Vincent 2010 L All rights reserved =cut Net-Syslogd-0.16/META.yml0000644000000000000000000000104012502671703013555 0ustar rootroot--- abstract: 'Perl implementation of Syslog Listener' author: - 'Michael Vincent ' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.72, CPAN::Meta::Converter version 2.132140' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Net-Syslogd no_index: directory: - t - inc requires: Socket: 0 Test::Simple: 0 version: 0.16