#!/usr/bin/perl -w
#
# $Id: syslog-snarf,v 2.6 2005/09/05 20:29:58 jmates Exp $
#
# The author disclaims all copyrights and releases this document into
# the public domain.
#
# Syslogd server for debugging or experimenting with syslog.
#
# Run perldoc(1) on this file for additional documentation.

use strict;
use IO::Socket;

use Date::Parse;
use POSIX qw(strftime);

# what address to listen on (default everywhere)
my $bind;

# what port to bind to by default
my $port = 514;

# max message length for incoming data ([RFC 3164] limits this to 1024
# by default, though things might not follow the standards)
my $max_msg_len  = 5000;
my $msg_len_warn = 1024;

# to match PRI header plus remaining fields
my $PRI_data_re = qr/^ < (\d{1,3}) > (.*) /x;

# to decode remaining data past the priority into TIMESTAMP, HOSTNAME,
# and MSG fields
my $HEADER_MSG_re = qr/^ ((  # match HEADER, TIMESTAMP for reference
  (?:Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)  # Month
  (?:[ ][ ]\d|[ ]\d\d) # day of month, '  5' or ' 10'
  [ ] \d\d:\d\d:\d\d)  # timestamp
  [ ] ([\w@.:-]+)      # HOSTNAME host|IPv4|IPv6 (syslog-ng prefixes foo@?)
  )                    # close match on HEADER
  [ ] (.*)             # MSG data
/x;

# see strftime man page for allowed fields here
my $timestamp_template = "%Y-%m-%dT%H:%M:%S%z";

# this is a custom template based on contents of %message hash for each
# log entry
my $message_template =
 '%{TIMESTAMP} <%{facility}.%{priority}> %{HOSTNAME} %{MSG}\n';

# syslog.h code->name mappings for better output
my %syslog_priorities = (
  0 => 'emerg',
  1 => 'alert',
  2 => 'crit',
  3 => 'err',
  4 => 'warning',
  5 => 'notice',
  6 => 'info',
  7 => 'debug'
);

# TODO some vendors (notably Apple) have fiddled with these to add
# NETINFO and similar... support this by reading these defintions
# from a file?
my %syslog_facilities = (
  0  => 'kern',
  1  => 'user',
  2  => 'mail',
  3  => 'daemon',
  4  => 'auth',
  5  => 'syslog',
  6  => 'lpr',
  7  => 'news',
  8  => 'uucp',
  9  => 'cron',
  10 => 'authpriv',
  11 => 'ftp',
  16 => 'local0',
  17 => 'local1',
  18 => 'local2',
  19 => 'local3',
  20 => 'local4',
  21 => 'local5',
  22 => 'local6',
  23 => 'local7'
);

my $VERSION;
( $VERSION = '$Revision: 2.6 $ ' ) =~ s/[^0-9.]//g;

# parse command-line options
use Getopt::Std;
my %opts;
getopts 'h?lvb:p:t:f:', \%opts;

print_help() if exists $opts{h} or exists $opts{'?'};

# list known elements might be in %message for templating needs
if ( $opts{l} ) {
  print join(
    "\n",
    qw{raw MSG time_recv TIMESTAMP priority length HOSTNAME facility facility_code peerport HEADER priority_code peerhost PRI}
   ),
   "\n";
  exit;
}

# no input checking as let IO::Socket handle any errors
my (@bind) = ( 'LocalAddr', $opts{b} ) if exists $opts{b};
$port = $opts{p} if exists $opts{p};

$message_template   = $opts{f} if exists $opts{f};
$timestamp_template = $opts{t} if exists $opts{t};

$SIG{INT} = sub { exit 0 };  # control+c handler

# start up the syslog server
my $sock = IO::Socket::INET->new(
  Proto     => 'udp',
  LocalPort => $port,
  @bind
 )
 or die "error: could not start server: errno=$@\n";

$| = 1;                        # autoflush output

my ( %message, @errors );

while (1) {
  %message = ();
  @errors  = ();

  next unless $sock->recv( $message{raw}, $max_msg_len );

  $message{time_recv} = strftime $timestamp_template, localtime time;

  # get various info on the packet in question
  $message{peerhost} = gethostbyaddr( $sock->peeraddr, AF_INET )
   || $sock->peerhost;
  $message{peerport} = $sock->peerport;

  # see [RFC 3164] for syslog message format details
  $message{length} = length( $message{raw} );
  push @errors, "message exceeds length of $msg_len_warn"
   if $message{length} > $msg_len_warn;

  if ( $message{length} == 0 ) {
    push @errors, 'message contains no data';
    next;
  }

  my $header_msg = q{};

  if ( $message{raw} =~ m/$PRI_data_re/o ) {
    ( $message{PRI}, $header_msg ) = ( $1, $2 );

    # decode facility/priority (see [RFC 2234] for PRI part values
    if ( $message{PRI} ) {
      $message{priority_code} = $message{PRI} % 8;
      if ( exists $syslog_priorities{ $message{priority_code} } ) {
        $message{priority} = $message{priority_code};
        $message{priority} = $syslog_priorities{ $message{priority_code} };
      } else {
        push @errors, "no name for priority $message{priority_code}";
      }

      $message{facility_code} = int( $message{PRI} / 8 );
      if ( exists $syslog_facilities{ $message{facility_code} } ) {
        $message{facility} = $syslog_facilities{ $message{facility_code} };
      } else {
        $message{facility} = $message{facility_code};
        push @errors, "no name for facility $message{facility_code}";
      }
    }

  } else {
    push @errors, 'could not parse PRI field';
    next;
  }

  # TODO is syslog-ng adding \n to the data already?
  chomp $header_msg;

  if ( $header_msg =~ m/$HEADER_MSG_re/o ) {
    (
      $message{HEADER},   $message{TIMESTAMP},
      $message{HOSTNAME}, $message{MSG}
    )
     = ( $1, $2, $3, $4 );

    my $epoch_time = str2time $message{TIMESTAMP};
    if ($epoch_time) {
      $message{TIMESTAMP} = strftime $timestamp_template,
       localtime $epoch_time;
    } else {
      push @errors, 'could not convert TIMESTAMP to epoch';
    }
  } else {
    push @errors, 'could not parse HEADER and MSG fields';
  }

} continue {

  if ( $opts{v} and @errors ) {
    warn "error: $_\n" for @errors;
  }

  # converts '\n' and similar to actual character
  ( my $output = $message_template ) =~ s/(\\.)/qq!"$1"!/eeg;

  # replaces %{foo} keys from %message hash with values for log entry
  $output =~ s/%{(\w+)}/$message{$1}||q{}/eg;

  # template needs a line ending thingy!
  print $output;
}

END {
  $sock->close if $sock;
}

# a generic help blarb
sub print_help {
  print <<"HELP";
Usage: $0 [opts]

Syslogd server for debugging or experimenting with syslog.

Options for version $VERSION:
  -h/-?  Display this message
  -l     Lists available message keys to template on and exists

  -v     Verbose: lists errors in parsing log data.

  -b bb  Bind to host or address instead of to everything
  -p pp  Use UDP port instead of default ($port)

  -f ff  Use different message template (custom format)
  -t tt  Use different time format in strftime(3) format

Run perldoc(1) on this script for additional documentation.

HELP
  exit 100;
}

=head1 NAME

syslog-snarf - Syslogd server for debugging or experimenting with syslog

=head1 SYNOPSIS

Close any running syslog daemon (the stock syslogd binds to UDP port 514
even when not being a server), then run the following to act as a
debugging syslog server:

  # syslog-snarf

Bind to an alternate localhost-only port, be verbose about errors, and
use custom time and message formats:

  $ syslog-snarf -b 127.1 -p 9999 -v -t %s -f '%{time_recv} %{raw}\n'

To see a list of available message fields for templating:

  $ syslog-snarf -l

=head1 DESCRIPTION

This script is a simple syslog server that binds to a specified UDP
port (514 by default) and prints out a formatted message of the
parsed log data:

  2004-06-08T00:16:48-0700 <user.notice> example.org username: test

The output format of the log entries and the timestamps involved can be
altered via templates; timestamps use strftime(3) templates, and log
entries a custom macro format that uses C<%{keyword}> expansion. The
currently supported keys to expand on are:

  HEADER - syslog message data past the priority field
  HOSTNAME
  MSG
  PRI - syslog protocol facility/priority number
  TIMESTAMP - timestamp set by log generator
  facility
  facility_code
  length - size of log packet
  peerhost - where log packet came from
  peerport
  priority
  priority_code
  raw - unparsed log data
  time_recv - timestamp when log entry seen by this script
  
=head2 Normal Usage

  $ syslog-snarf [options]

See L<"OPTIONS"> for details on the command line switches supported.
Output is to standard output, errors (under verbose mode) go to
standard error.

=head1 OPTIONS

This script currently supports the following command line switches:

=over 4

=item B<-h>, B<-?>

Prints a brief usage note about the script.

=item B<-l>

List available fields for templating the message format with the B<-f>
option.

=item B<-b> I<hostname>

Bind to specified hostname or address instead of everywhere. For testing
and to prevent remote connects, 127.1 would be used to bind only to the
localhost interface:

  -b 127.0.0.1

=item B<-p> I<port>

Listen on the specified UDP port instead of the default.

=item B<-t> I<timeformat>

Specify a different time format to use instead of the default ISO
format. See strftime(3) for a list of allowed parameters, as well as the
strftime notes under the POSIX man page.

=item B<-f> I<messageformat>

Specify a different format for how messages are printed. Uses a
custom %{keyword} expansion format; use the B<-l> option to list
available fields.

To emulate the format used by stock unix syslogd:

  -t '%b %e %H:%M:%S' -f '%{TIMESTAMP} %{HOSTNAME} %{MSG}\n'

=back

=head1 EXAMPLES

=over 4

=item B<Forward logs from syslog-ng>

To have the syslog-ng daemon forward log messages to this script, add
the following to the syslog-ng.conf configuration file and restart
syslog-ng. The source statement will need to be altered to suit your
configuration file:

  destination testdaemon {
    udp("127.0.0.1" port (9999));
  };
  log { source(local); destination(testdaemon); };

=back

=head1 BUGS

=head2 Reporting Bugs

Newer versions of this script may be available from:

http://sial.org/code/perl/

If the bug is in the latest version, send a report to the author.
Patches that fix problems or add new features are welcome.

=head2 Known Issues

No known bugs.

=head1 SEE ALSO

perl(1), [RFC 3164]

=head1 AUTHOR

Jeremy Mates, http://sial.org/contact/

=head1 COPYRIGHT

The author disclaims all copyrights and releases this document into the
public domain.

=head1 HISTORY

Adapted from udp_echo_serv.pl by Lincoln D. Stein in the text
http://www.modperl.com/perl_networking/ (Chapter 18), plus data from
the Net::Syslog module as well as information in the sys/syslog.h
header file.

=head1 VERSION

$Id: syslog-snarf,v 2.6 2005/09/05 20:29:58 jmates Exp $

=cut