[logs] Trial SELP client implementation

betat_private

Only just this minute got it to where it appears to be working
approximately correctly. It probably still needs work, but it's
small enough that that won't be extravagently painful. I've not yet
added the "expanded mode", but that should be straightforward.

I hope to crank out the server tomorrow, time permitting. I've got
the frame --- currently little more functional than

	while true;do nc -l 127.0.0.1 -p 1514; done

but with that frame, I just need to add the PRIO decoder, timestamp
validation, and RFC 3164 timestamp transcoder, that should be
quick.

Anyway, here's a client to look at. I figure this (and the companion
server, coming soon) might be helpful to have around as debugging
tools, but are probably most interesting as test stubs for other
implementations, and as another form of documentation. I've tried to
keep this simple enough that it won't be painful to read to resolve
any questions.

-Bennett

#!/usr/bin/perl -w
use strict;

=head1 NAME

  selp --- test client for SELP protocol

=head1 SYNOPSIS

  selp [--port=127.0.0.1:1514] priority [message]

=head1 DESCRIPTION

selp sends SELP message[s] to the indicated destination port, in a
fashion loosely similar to logger(1). The priority must be specified
as facility.level. If the message is missing selp will read stdin,
sending each line as a separate message, computing the timestamp as
it sends it, and sending them all in a single TCP connection.

=head1 BUGS

This implementation doesn't attempt to reconnect and resend if the
receiver drops the connection.

=cut

use Getopt::Long;
use POSIX qw(strftime);
use IO::Socket::INET;
use Sys::Hostname;

my $port = "127.0.0.1:1514";
my $syntax = "selp [--port=$port] priority [message]\n";
GetOptions("port=s" => \$port) || die $syntax;
die $syntax unless @ARGV;

my $prio = prio_decode(shift(@ARGV));

my $host = hostname;

my $sock = IO::Socket::INET->new(
    PeerAddr => $port,
    Proto => 'tcp',
) or die "$0: socket bind failed: $!\n";

if (@ARGV) {
    my $timestamp = strftime("%Y-%m-%dT%H:%M:%S%z", localtime(time));
    $sock->print("<$prio>$timestamp $host @ARGV\r\n");
} else {
    while (<>) {
    	chomp;
	my $timestamp = strftime("%Y-%m-%dT%H:%M:%S%z", localtime(time));
	$sock->print("<$prio>$timestamp $host $_\r\n");
    }
}

sub prio_decode {
    my ($prio) = @_;
    local(*_);

my %prio_codes = (
	# Generated by syslog-prio.c, reformatted by hand
"alert" => 1, "crit" => 2, "debug" => 7, "emerg" => 0, "err" => 3, "error" => 3,
"info" => 6, "none" => 16, "notice" => 5, "panic" => 0, "warn" => 4,
"warning" => 4, "auth" => 32, "authpriv" => 80, "cron" => 72, "daemon" => 24,
"ftp" => 88, "kern" => 0, "lpr" => 48, "mail" => 16, "mark" => 192,
"news" => 56, "security" => 32, "syslog" => 40, "user" => 8, "uucp" => 64,
"local0" => 128, "local1" => 136, "local2" => 144, "local3" => 152,
"local4" => 160, "local5" => 168, "local6" => 176, "local7" => 184,
);

    die "$0: priority must be facility.level, is $prio\n" unless $prio =~ /^([a-z0-9]+)\.([a-z0-9]+)$/i;
    my ($facility, $level) = map { lc($_) } ($1, $2);
    die "$facility is not a known facility\n" unless exists $prio_codes{$facility};
    die "$level is not a known level\n" unless exists $prio_codes{$level};
    return($prio_codes{$facility} + $prio_codes{$level});
}