[logs] Trial SELP server implementation

From: Bennett Todd (betat_private)
Date: Thu Jan 09 2003 - 16:01:26 PST

  • Next message: Mikael Olsson: "Re: [logs] Trial SELP client implementation"

    2003-01-09T18:25:24 Bennett Todd:
    > I hope to crank out the server tomorrow, time permitting.
    
    "Hacking --- it's not just a job, it's an obsession".
    
    Here's that server. Likewise probably has more room for improvement;
    I expect I'll add code to perform validation on the hostname part
    (although that'll force me to figure out all the permissible
    representations of IPv6 addrs, which I've yet to actually learn:-);
    and I'll probably make this debugging tool explicitly quote any
    characters it finds in the MSG that aren't printable US-ASCII, just
    because I am what I am:-).
    
    But this might just be enough now to be comfortable as a protocol
    testbed.
    
    -Bennett
    
    #!/usr/bin/perl -w
    use strict;
    
    =head1 NAME
    
      selpd --- test daemon for SELP protocol
    
    =head1 SYNOPSIS
    
      selpd [--port=127.0.0.1:1514]
    
    =head1 DESCRIPTION
    
    selpd binds to the indicated port, and accepts TCP connections.
    It's a straightforward iterating daemon --- only one connection
    is serviced at a time. If a connection is attempted while one is
    already active, the OS queues it. selpd prints each complete record
    it receives to stdout. The <PRI> is decoded. The timestamp is
    validated; if it is in RFC 3164 format it's recoded into RFC 3999
    format with the local timezone appended.
    
    =cut
    
    use Getopt::Long;
    my $port = "127.0.0.1:1514";
    my $syntax = "selpd [--port=$port]\n";
    GetOptions("port=s" => \$port) || die $syntax;
    
    use IO::Socket::INET;
    my $sock = IO::Socket::INET->new(
        LocalAddr => $port,
        Proto => 'tcp',
        Listen => 65536,
    ) or die "$0: socket bind failed: $!\n";
    
    $| = 1;
    
    use Date::Parse;
    use POSIX qw(strftime);
    
    session: while (my $s = $sock->accept()) {
        line: while (defined($_ = $s->getline)) {
    	chomp; s/\r$//;
    	if (/^<(\d{1,3})>(\d{4}-\d{2}-\d{2}T\d{2}:\d{2}:\d{2}(?:\.\d+)?(?:Z|[+-]\d{4})) (\S+) (.*)/) {
    	    my ($prio, $ts, $host, $msg) = ($1, $2, $3, $4);
    	    $prio = prio_decode($prio);
    	    print "<$prio>$ts $host $msg\n";
    	    next line;
    	}
    	if (/^<(\d{1,3})>([A-Z][a-z][a-z] [0-9 ]\d \d{2}:\d{2}:\d{2}) (\S+) (.*)/) {
    	    my ($prio, $ts, $host, $msg) = ($1, $2, $3, $4);
    	    $prio = prio_decode($prio);
    	    $ts = strftime("%Y-%m-%dT%H:%M:%S%z", localtime(str2time($ts)));
    	    print "<$prio>$ts $host $msg\n";
    	    next line;
    	}
    	print "misformatted message: $_\n"
        }
    }
    
    sub prio_decode {
        my ($prio) = @_;
        local(*_);
    
        # These are taken from syslog.h, plus cross-checked and filled out
        # from RFC 6134
        my @priority = qw(emerg alert crit err warning notice info debug);
        my @facility = qw(
    	kern user mail daemon auth syslog lpr news uucp cron authpriv
    	ftp ntp audit alert cron2 local0 local1 local2 local3 local4
    	local5 local6 local7
        );
    
        my $priority = ($prio & 0x07);
        my $facility = ($prio >> 3);
        if ($facility <= $#facility) {
    	return ($facility[$facility] . '.' . $priority[$priority]);
        } else {
    	return ("unknown$facility" . '.' . $priority[$priority]);
        }
    }
    
    
    

    _______________________________________________ LogAnalysis mailing list LogAnalysisat_private http://lists.shmoo.com/mailman/listinfo/loganalysis



    This archive was generated by hypermail 2b30 : Thu Jan 09 2003 - 16:18:36 PST