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 =~ s/<(\d+)>// ) {
                my $level    = $1 % 8;
                my $facility = ( $1-$level ) / 8;
        
                $buf =~ s/^\w\w\w \d+ \d\d:\d\d:\d\d//; # strip timestamp which some syslog servers insert here

                my ( $program, $pid );

                if ( $buf =~ s/^\s*([^:]+)\s*:\s*// ) {
                        $program  = $1;
                        $pid      = $1 if $program =~ s/\[(\d+)\]$//;
                }

                $values[2] = $buf;
                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	18	if ( $buf =~ s/<(\d+)>// ) {
124	dpavlin	6	my $level = $1 % 8;
125			my $facility = ( $1-$level ) / 8;
126	dpavlin	18
127			$buf =~ s/^\w\w\w \d+ \d\d:\d\d:\d\d//; # strip timestamp which some syslog servers insert here
128
129			my ( $program, $pid );
130
131			if ( $buf =~ s/^\s([^:]+)\s:\s*// ) {
132			$program = $1;
133			$pid = $1 if $program =~ s/\[(\d+)\]$//;
134			}
135
136			$values[2] = $buf;
137	dpavlin	6	push @values, ( $level, $facility, $program, $pid );
138			$sth_log_full->execute( @values );
139	dpavlin	5	} else {
140	dpavlin	6	$sth_log_unparsed->execute( @values );
141	dpavlin	1	}
142	dpavlin	6	_log( @values );
143	dpavlin	1	}