viewvc.cgi/sysplogd/sysplogd

#!/usr/bin/perl

use warnings;
use strict;

use IO::Socket;
use Data::Dump qw/dump/;
use DBI;
use Getopt::Long;

our $port = 514;
our $MAXLEN = 1524;

our $dsn    = 'DBI:Pg:dbname=syslog';
our $user   = 'dpavlin';
our $log    = '/tmp/sysplog.log';

my $config = $0;
$config =~ s{/[^/]+$}{/conf.pl};
if ( -e $config ) {
        require $config;
        warn "# using $config ", -s $config, $/;
}

my $debug  = 0;
my $schema = 0;

GetOptions(
        'debug+'  => \$debug,
        'schema!' => \$schema,
        'log=s'   => \$log,
        'port=i'  => \$port,
) || die "usage: $0 --debug --schema\n";

our $VERSION = '0.00';

my $sql_schema = q{

CREATE TABLE facilities (
        id              serial,
        name            text,

        PRIMARY KEY(name)
);

CREATE TABLE log (
        id              serial,
        timestamp       timestamp default now(),
        ip              inet not null,
        hostname        text,
        message         text,
        level           int,
        facility        int,
        program         text,
        pid             int,

        PRIMARY KEY (id)
);

};


my $dbh = DBI->connect( $dsn, $user, '', { RaiseError => 1 } ) || die $DBI::errstr;

if ( $schema ) {
        $dbh->begin_work;

        $dbh->do( $_ ) foreach split(/;/, $sql_schema);

        my $sth = $dbh->prepare( q{
                insert into facilities (name) values (?)
        });

        $sth->execute( $_ ) foreach ( 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
        / );

        warn "# created sql schema\n";

        $dbh->commit;
}

my $sth_log_full = $dbh->prepare(qq{
        insert into log
        (ip,hostname,message,level,facility,program,pid)
        values (?,?,?,?,?,?,?)
});

my $sth_log_unparsed = $dbh->prepare(qq{
        insert into log (ip,hostname,message) values (?,?,?)
});


my $sock = IO::Socket::INET->new(
        LocalPort => $port,
        Proto => 'udp'
#       ReuseAddr => 1,
) || die "can't listen to $port: $!";

open(my $log_fh, '>>', $log) || die "can't open log $log: $!";
$log_fh->autoflush(1);
sub _log {
        warn 'LOG ',dump( @_ ), $/ if $debug;
        print $log_fh time() . '|' . join('|', @_), $/;
}

_log "INFO: listen on $port";

my $buf;
while(1) {
        $sock->recv($buf, $MAXLEN);
        my ($port, $ipaddr) = sockaddr_in($sock->peername);
        my $hostname = gethostbyaddr($ipaddr, AF_INET);
        my $ip = join('.', unpack('C4',$ipaddr));
        my @values = ( $ip, $hostname, $buf );

        if ( $buf =~ /<(\d+)>\s*(\S*)\s*:\s*(.*)/ ) {
                $values[2] = $3;
                my $level    = $1 % 8;
                my $facility = ( $1-$level ) / 8;
                my $program  = $2;
                my $pid      = $1 if $program =~ s/\[(\d+)\]$//;
                push @values, ( $level, $facility, $program, $pid );
                $sth_log_full->execute( @values );
        } else {
                $sth_log_unparsed->execute( @values );
        }
        _log( @values );
}
1	dpavlin	1	#!/usr/bin/perl
2
3			use warnings;
4			use strict;
5
6			use IO::Socket;
7			use Data::Dump qw/dump/;
8	dpavlin	3	use DBI;
9	dpavlin	6	use Getopt::Long;
10	dpavlin	1
11	dpavlin	12	our $port = 514;
12			our $MAXLEN = 1524;
13	dpavlin	1
14	dpavlin	12	our $dsn = 'DBI:Pg:dbname=syslog';
15			our $user = 'dpavlin';
16			our $log = '/tmp/sysplog.log';
17	dpavlin	1
18	dpavlin	13	my $config = $0;
19			$config =~ s{/[^/]+$}{/conf.pl};
20			if ( -e $config ) {
21			require $config;
22			warn "# using $config ", -s $config, $/;
23			}
24	dpavlin	12
25	dpavlin	6	my $debug = 0;
26			my $schema = 0;
27	dpavlin	3
28	dpavlin	6	GetOptions(
29			'debug+' => \$debug,
30			'schema!' => \$schema,
31			'log=s' => \$log,
32	dpavlin	11	'port=i' => \$port,
33	dpavlin	6	) \|\| die "usage: $0 --debug --schema\n";
34
35	dpavlin	9	our $VERSION = '0.00';
36	dpavlin	1
37	dpavlin	6	my $sql_schema = q{
38
39			CREATE TABLE facilities (
40			id serial,
41			name text,
42
43			PRIMARY KEY(name)
44			);
45
46			CREATE TABLE log (
47			id serial,
48			timestamp timestamp default now(),
49			ip inet not null,
50	dpavlin	14	hostname text,
51	dpavlin	6	message text,
52			level int,
53			facility int,
54			program text,
55			pid int,
56
57			PRIMARY KEY (id)
58			);
59
60			};
61
62
63			my $dbh = DBI->connect( $dsn, $user, '', { RaiseError => 1 } ) \|\| die $DBI::errstr;
64
65			if ( $schema ) {
66			$dbh->begin_work;
67
68			$dbh->do( $_ ) foreach split(/;/, $sql_schema);
69
70			my $sth = $dbh->prepare( q{
71			insert into facilities (name) values (?)
72			});
73
74			$sth->execute( $_ ) foreach ( qw/
75			kernel user mail system security internal
76			printer news uucp clock
77			security2
78			ftp ntp
79			audit alert
80			clock2
81			local0 local1 local2 local3 local4 local5 local6 local7
82			/ );
83
84			warn "# created sql schema\n";
85
86			$dbh->commit;
87			}
88
89			my $sth_log_full = $dbh->prepare(qq{
90			insert into log
91			(ip,hostname,message,level,facility,program,pid)
92			values (?,?,?,?,?,?,?)
93			});
94
95			my $sth_log_unparsed = $dbh->prepare(qq{
96	dpavlin	14	insert into log (ip,hostname,message) values (?,?,?)
97	dpavlin	6	});
98
99
100	dpavlin	1	my $sock = IO::Socket::INET->new(
101			LocalPort => $port,
102			Proto => 'udp'
103			# ReuseAddr => 1,
104			) \|\| die "can't listen to $port: $!";
105
106	dpavlin	6	open(my $log_fh, '>>', $log) \|\| die "can't open log $log: $!";
107			$log_fh->autoflush(1);
108			sub _log {
109			warn 'LOG ',dump( @_ ), $/ if $debug;
110			print $log_fh time() . '\|' . join('\|', @_), $/;
111			}
112	dpavlin	3
113	dpavlin	8	_log "INFO: listen on $port";
114
115	dpavlin	1	my $buf;
116			while(1) {
117			$sock->recv($buf, $MAXLEN);
118			my ($port, $ipaddr) = sockaddr_in($sock->peername);
119			my $hostname = gethostbyaddr($ipaddr, AF_INET);
120			my $ip = join('.', unpack('C4',$ipaddr));
121	dpavlin	6	my @values = ( $ip, $hostname, $buf );
122	dpavlin	2
123	dpavlin	5	if ( $buf =~ /<(\d+)>\s(\S)\s:\s(.*)/ ) {
124	dpavlin	6	$values[2] = $3;
125			my $level = $1 % 8;
126			my $facility = ( $1-$level ) / 8;
127			my $program = $2;
128			my $pid = $1 if $program =~ s/\[(\d+)\]$//;
129			push @values, ( $level, $facility, $program, $pid );
130			$sth_log_full->execute( @values );
131	dpavlin	5	} else {
132	dpavlin	6	$sth_log_unparsed->execute( @values );
133	dpavlin	1	}
134	dpavlin	6	_log( @values );
135	dpavlin	1	}