diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/exilog_config.pm | 63 | ||||
| -rw-r--r-- | lib/exilog_parse.pm | 351 | ||||
| -rw-r--r-- | lib/exilog_sql.pm | 556 | ||||
| -rw-r--r-- | lib/exilog_util.pm | 136 |
4 files changed, 1106 insertions, 0 deletions
diff --git a/lib/exilog_config.pm b/lib/exilog_config.pm new file mode 100644 index 0000000..47d5483 --- /dev/null +++ b/lib/exilog_config.pm @@ -0,0 +1,63 @@ +#!/usr/bin/perl +# +# This file is part of the exilog suite. +# +# http://duncanthrax.net/exilog/ +# +# (c) Tom Kistner 2004 +# +# See LICENSE for licensing information. +# + +package exilog_config; +use strict; + +use FindBin; +use FindBin qw($RealBin); +use lib "$RealBin/"; + + +BEGIN { + use Exporter; + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + + # set the version for version checking + $VERSION = 0.1; + @ISA = qw(Exporter); + @EXPORT = qw( + $config + $version + ); + + %EXPORT_TAGS = (); + + # your exported package globals go here, + # as well as any optionally exported functions + @EXPORT_OK = qw(); + + use vars qw( $config $version ); +} + +$version = "0.5"; + +$config = _read_ph("$RealBin/exilog.conf"); + +unless ($config) { + print STDERR "($$) [exilog_config] Can't parse configuration file.\n"; + exit(0); +}; + +sub _read_ph { + my $file = shift; + + open(PH,"< $file"); + undef $/; + my $tmp = (eval(<PH>)); + print STDERR "Eval Error: ".$@."\n" if ($@); + $/ = "\n"; + close(PH); + + return $tmp; +}; + +1; diff --git a/lib/exilog_parse.pm b/lib/exilog_parse.pm new file mode 100644 index 0000000..2074b13 --- /dev/null +++ b/lib/exilog_parse.pm @@ -0,0 +1,351 @@ +#!/usr/bin/perl -w +# +# This file is part of the exilog suite. +# +# http://duncanthrax.net/exilog/ +# +# (c) Tom Kistner 2004 +# +# See LICENSE for licensing information. +# + +package exilog_parse; +use strict; +use exilog_util; +use Digest::MD5 qw( md5_base64 ); + +use Data::Dumper; + +BEGIN { + use Exporter; + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + + $VERSION = 0.1; + @ISA = qw(Exporter); + @EXPORT = qw( + &parse_message_line + &parse_reject_line + &date_to_stamp + &stamp_to_date + ); + + %EXPORT_TAGS = (); + @EXPORT_OK = qw(); +} + +sub _parse_error { + my $subj = shift || ""; + my $h = shift || {}; + + $subj = _parse_delivery($subj,$h); + + m/()()/; + if ($subj =~ / host ([^ ]+?) \[([0-9.]+?)\]\:/) { + $h->{host_addr} = $2; + $h->{host_dns} = $1; + }; + $subj =~ s/^[ :]+//; + $subj =~ s/ +$//; + $h->{errmsg} = $subj if ($subj); + + return $subj; +}; + + +sub _parse_deferral { + my $subj = shift || ""; + my $h = shift || {}; + + $subj = _parse_delivery($subj,$h); + + if ($subj =~ / host ([^ ]+?) \[([0-9.]+?)\]\:/) { + $h->{host_addr} = $2; + $h->{host_dns} = $1; + }; + $subj =~ s/^[ :]+//; + $subj =~ s/ +$//; + $h->{errmsg} = $subj if ($subj); + + return $subj; +}; + + +sub _parse_delivery { + my $subj = shift || ""; + my $h = shift || {}; + + + # When +sender_on_delivery is set, cut away the F=<> part + $subj =~ s/[PF]\=[^ ]+ //; + + m/()/; + + $subj =~ s/^.+?[\=\-\*][\>\=\*] (.+?)((\: )|( R\=)|( \<)|( \())/$2/; + $h->{rcpt_final} = $1 if ($1); + $subj =~ s/^\: //; + $subj =~ s/^ +//; + + m/()/; + $subj =~ s/^\((.+?)\) //; + $h->{rcpt_intermediate} = $1 if ($1); + + m/()/; + $subj =~ s/^\<(.+?)\> //; + if ($1) { + $h->{rcpt} = $1; + } + else { + $h->{rcpt} = $h->{rcpt_final}; + }; + + m/()/; + $subj =~ s/R\=([^ \:]+)//; + $h->{router} = $1 if ($1); + + m/()/; + $subj =~ s/ST\=([^ \:]+)//; + $h->{shadow_transport} = $1 if ($1); + + m/()/; + $subj =~ s/T\=([^ \:]+)//; + $h->{transport} = $1 if ($1); + + m/()/; + $subj =~ s/X\=([^ ]+)//; + $h->{tls_cipher} = $1 if ($1); + + m/()()/; + $subj =~ s/H\=([^ ]+) \[(.+?)\]//; + $h->{host_dns} = $1 if ($1); + $h->{host_addr} = $2 if ($2); + + return $subj; +}; + + + + +sub _parse_arrival { + my $subj = shift || ""; + my $h = shift || {}; + + m/()/; + $subj =~ s/^.+?\<\= (.+?) //; + $h->{mailfrom} = $1 if ($1); + + m/()()/; + $subj =~ s/H\=(.+?) ([A-Za-z]\=)/$2/; + if ($1) { + my $hstr = $1; + m/()/; + $hstr =~ s/\[([0-9.]+)\]$//; + $h->{host_addr} = $1 if ($1); + + $hstr =~ s/^ +//; + $hstr =~ s/ +$//; + + m/()/; + $hstr =~ s/\((.+?)\)$//; + $h->{host_helo} = $1 if ($1); + + $hstr =~ s/^ +//; + $hstr =~ s/ +$//; + + # if we have something left over now, it must + # be a confirmed rdns host name + $h->{host_rdns} = $hstr if ($hstr); + } + + m/()/; + $subj =~ s/P\=([^ ]+)//; + $h->{proto} = $1 if ($1); + if ($1 =~ /^local/) { + # U= contains local user account + m/()/; + $subj =~ s/U\=([^ ]+)//; + $h->{user} = $1 if ($1); + } + elsif ( ($1 eq 'asmtp') || ($1 eq 'esmtpa') || ($1 eq 'esmtpsa') ) { + # fill in both auth user and ident + m/()/; + $subj =~ s/A\=([^ ]+)//; + $h->{user} = $1 if ($1); + + m/()/; + $subj =~ s/U\=([^ ]+)//; + $h->{host_ident} = $1 if ($1); + } + else { + # U= contains remote ident + m/()/; + $subj =~ s/U\=([^ ]+)//; + $h->{host_ident} = $1 if ($1); + }; + + m/()/; + $subj =~ s/S\=([^ ]+)//; + $h->{size} = $1 if ($1); + + m/()/; + $subj =~ s/id\=([^ ]+)//; + $h->{msgid} = $1 if ($1); + + m/()/; + $subj =~ s/X\=([^ ]+)//; + $h->{tls_cipher} = $1 if ($1); + + m/()/; + $subj =~ s/R\=([^ ]+)//; + $h->{bounce_parent} = $1 if ($1); + + return $subj; +}; + +sub _parse_reject { + my $subj = shift; + my $h = shift; + + m/()()/; + $subj =~ s/H\=(.+?) \[(.+?)\] //; + if ($1 && $2) { + $h->{host_addr} = $2; + my $hstr = $1; + + $hstr =~ s/^ +//; + $hstr =~ s/ +$//; + + m/()/; + $hstr =~ s/\((.+?)\)$//; + $h->{host_helo} = $1 if ($1); + + $hstr =~ s/^ +//; + $hstr =~ s/ +$//; + + # if we have something left over now, it must + # be a confirmed rdns host name + $h->{host_rdns} = $hstr if ($hstr); + }; + + m/()/; + $subj =~ s/U\=(.+?) //; + $h->{host_ident} = $1 if ($1); + + m/()()/; + $subj =~ s/F\=(\<.*?\>) //; + $h->{mailfrom} = $1 if ($1); + if (exists($h->{mailfrom})) { + unless ($h->{mailfrom} eq '<>') { + $h->{mailfrom} =~ s/[<>]//g; + } + }; + + m/()()/; + $subj =~ m/\<(.+?)\>/; + if ($1) { + $h->{rcpt} = $1; + }; + + return $subj; +}; + + +# Parse a reject line +sub parse_reject_line { + my $subj = shift || ""; + chomp($subj); + + my $h = { 'table' => 'rejects' }; + + # There are 2 types of rejects: one without a message ID (pre-DATA) + # and one with message ID (post-DATA). Try the latter first. + + m/()()()()/; + $subj =~ m/(\d{4}-\d\d-\d\d) (\d\d:\d\d:\d\d( [-+]\d{4})?) ([A-Za-z0-9]{6}-[A-Za-z0-9]{6}-[A-Za-z0-9]{2}) (H=.*)$/; + my ($date,$tod,$msgid,$line) = ($1,$2,$4,$5); + if ($date && $tod && $msgid && $line) { + # line with message id + $h->{data}->{message_id} = $msgid; + } + else { + # try format without message id + m/()()()()/; + $subj =~ m/(\d{4}-\d\d-\d\d) (\d\d:\d\d:\d\d( [-+]\d{4})?) (H=.*)$/; + ($date,$tod,$line) = ($1,$2,$4); + unless ($date && $tod && $line) { + # unparsable + return 0; + }; + # Add custom "Message ID" hash + $h->{data}->{message_id} = substr(md5_base64($date,$tod,$line),0,16); + }; + + $h->{data}->{timestamp} = date_to_stamp($date,$tod); + $h->{data}->{errmsg} = substr(_parse_reject($line,$h->{data}),0,255); + + return $h; +}; + + +# Parse line that relates to an actual message. +sub parse_message_line { + my $subj = shift || ""; + chomp($subj); + + # Exception: do not use "retry time not reached [for any host]". + # It's just too spammy and gets logged by default. + return 0 if ($subj =~ /retry time not reached$/); + return 0 if ($subj =~ /retry time not reached for any host$/); + + # Grab date, time and message id + $subj =~ m/(\d{4}-\d\d-\d\d) (\d\d:\d\d:\d\d( [-+]\d{4})?) ([A-Za-z0-9]{6}-[A-Za-z0-9]{6}-[A-Za-z0-9]{2}) (([^ ]+).*)$/; + my ($date,$tod,$msgid,$line,$type) = ($1,$2,$4,$5,$6); + $line =~ s/^ +// if (defined($line)); + unless ($date && $tod && $msgid && $line && $type) { + # non-message based line + return 0; + }; + + # removed fttb, too much overhead + #my $h = { 'data' => { 'line' => $line, 'message_id' => $msgid } }; + my $h = { 'data' => { 'message_id' => $msgid } }; + + + if ($type eq '<=') { + $h->{table} = 'messages'; + $h->{data}->{timestamp} = date_to_stamp($date,$tod); + _parse_arrival($subj,$h->{data}); + } + elsif (($type eq '=>') || ($type eq '->') || ($type eq '*>')) { + $h->{table} = 'deliveries'; + $h->{data}->{timestamp} = date_to_stamp($date,$tod); + _parse_delivery($subj,$h->{data}); + } + elsif ($type eq '**') { + $h->{table} = 'errors'; + $h->{data}->{timestamp} = date_to_stamp($date,$tod); + _parse_error($subj,$h->{data}); + } + elsif ($type eq '==') { + $h->{table} = 'deferrals'; + $h->{data}->{timestamp} = date_to_stamp($date,$tod); + _parse_deferral($subj,$h->{data}); + } + elsif ($type eq 'Completed') { + $h->{table} = 'messages'; + $h->{data}->{completed} = date_to_stamp($date,$tod); + } + else { + if ($line =~ /^H\=.*rejected/) { + # looks like a reject line after DATA, pass on + return 0; + }; + + $h->{table} = 'unknown'; + $h->{data}->{timestamp} = date_to_stamp($date,$tod); + $h->{data}->{line} = substr($line,0,255); + }; + + return $h; +}; + +1; diff --git a/lib/exilog_sql.pm b/lib/exilog_sql.pm new file mode 100644 index 0000000..fc8bc71 --- /dev/null +++ b/lib/exilog_sql.pm @@ -0,0 +1,556 @@ +#!/usr/bin/perl +# +# This file is part of the exilog suite. +# +# http://duncanthrax.net/exilog/ +# +# (c) Tom Kistner 2004 +# +# See LICENSE for licensing information. +# + +package exilog_sql; +use strict; +use DBI; +use exilog_config; +use exilog_util; + +use Data::Dumper; + +BEGIN { + use Exporter; + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + + # set the version for version checking + $VERSION = 0.1; + @ISA = qw(Exporter); + @EXPORT = qw( + &reconnect + &sql_select + &sql_delete + &sql_optimize + &sql_count + &sql_queue_add + &sql_queue_update + &sql_queue_delete + &sql_queue_set_action + &sql_queue_clear_action + &write_message + ); + + %EXPORT_TAGS = (); + + # your exported package globals go here, + # as well as any optionally exported functions + @EXPORT_OK = qw(); +} + + +# open DB connection +my $dbh = DBI->connect($config->{sql}->{DBI}, $config->{sql}->{user}, $config->{sql}->{pass}); +unless (defined($dbh) && $dbh) { + print STDERR "[exilog_sql] Can't open exilog database.\n"; + exit(255); +}; + +sub reconnect { + my $conditional = shift || 0; + if ($conditional) { + return 1 if ($dbh->ping); + }; + eval { + $dbh->disconnect() if (defined($dbh)); + }; + $dbh = 0; + $dbh = DBI->connect($config->{sql}->{DBI}, $config->{sql}->{user}, $config->{sql}->{pass}); + unless (defined($dbh) && $dbh) { + print STDERR "[exilog_sql] Can't open exilog database.\n"; + return 0; + }; + return 1; +}; + + +# -------------------------------------------------------------------------- +# Generic Stubs, these are just frontends that call the backend-specific +# SQL subroutines for each database type. +sub write_message { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_write_message" }(@_); +}; + +sub sql_select { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_select" }(@_); +}; + +sub sql_delete { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_delete" }(@_); +}; + +sub sql_optimize { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_optimize" }(@_); +}; + +sub sql_queue_add { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_queue_add" }(@_); +}; + +sub sql_queue_update { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_queue_update" }(@_); +}; + +sub sql_queue_delete { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_queue_delete" }(@_); +}; + +sub sql_queue_set_action { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_queue_set_action" }(@_); +}; + +sub sql_queue_clear_action { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_queue_clear_action" }(@_); +}; + +sub sql_count { + no strict "refs"; + return &{ "_".$config->{sql}->{type}."_sql_count" }(@_); +}; +# -------------------------------------------------------------------------- + + +# -------------------------------------------------------------------------- +# PostgreSQL functions +sub _pgsql_sql_count { + my $where = shift; + my $criteria = shift || {}; + + my $sql = "SELECT ". + "COUNT(*) ". + "FROM ".$where. + ((scalar keys %{ $criteria } ) ? " "._build_WHERE($criteria) : "" ); + + my $sh = $dbh->prepare($sql); + $sh->execute; + my $tmp = $sh->fetchrow_arrayref(); + return @{$tmp}[0]; +}; + +sub _pgsql_sql_queue_delete { + my $spool_path = shift; + + $dbh->do("DELETE FROM queue WHERE spool_path='$spool_path'"); +}; + +sub _pgsql_sql_queue_update { + my $hdr = shift; + + return unless (ref($hdr) eq 'HASH'); + + my $server = $hdr->{server}; + my $message_id = $hdr->{message_id}; + delete $hdr->{server}; + delete $hdr->{message_id}; + + # PostgreSQL is case sensitive by default. Nice feature, + # but it complicates our life tremendously. + # Since we want to keep indexes working, the columns in + # this list are lowercased before they are inserted. Sigh. + my @lowercase = ( 'mailfrom', 'recipients_delivered', 'recipients_pending' ); + foreach my $col (@lowercase) { + $hdr->{$col} = lc($hdr->{$col}) if (edt($hdr,$col)); + }; + + my @tmp; + foreach my $item (keys %{ $hdr }) { + my $value = $hdr->{$item}; + $value =~ s/\'/\'\'/g; + $value =~ s/\n/\\n/g; + push @tmp, $item.'='."'".$value."'"; + }; + + $dbh->do("UPDATE queue SET ".join(",",@tmp)." WHERE message_id='".$message_id."' AND server='".$server."'"); +}; + +sub _pgsql_sql_queue_add { + my $hdr = shift; + + return unless (ref($hdr) eq 'HASH'); + + # PostgreSQL is case sensitive by default. Nice feature, + # but it complicates our life tremendously. + # Since we want to keep indexes working, the columns in + # this list are lowercased before they are inserted. Sigh. + my @lowercase = ( 'mailfrom', 'recipients_delivered', 'recipients_pending' ); + foreach my $col (@lowercase) { + $hdr->{$col} = lc($hdr->{$col}) if (edt($hdr,$col)); + }; + + my @fields = sort {$a cmp $b} keys(%{$hdr}); + my @vals = (); + foreach (@fields) { + my $val = $hdr->{$_}; + $val =~ s/\'/\'\'/g; + $val =~ s/\n/\\n/g; + push @vals, "'".$val."'"; + }; + + $dbh->do("INSERT INTO queue (".join(',',@fields).") VALUES(".join(',',@vals).")"); +}; + +sub _pgsql_sql_optimize { + my $where = shift || "nothing"; + + my $sql = "OPTIMIZE TABLE ".$where; + my $sh = $dbh->prepare($sql); + $sh->execute; + $sh->finish; + + return 1; +}; + +sub _pgsql_sql_delete { + my $where = shift || "nothing"; + my $criteria = shift || {}; + + my $sql = "DELETE FROM ".$where. + ((scalar keys %{ $criteria } ) ? " "._build_WHERE($criteria) : "" ); + + my $sh = $dbh->prepare($sql); + my $num = $sh->execute; + $sh->finish; + + return (($num eq '0E0') ? 0 : $num); +}; + +sub _pgsql_sql_select { + my $where = shift; + my @what = @{ (shift || [ "*" ]) }; + my $criteria = shift || {}; + my $order_by = shift || ""; + my $order_direction = shift || "DESC"; + my $limit_min = shift; + my $limit_max = shift; + my $distinct = shift; + + my $sql = "SELECT ". + (defined($distinct) ? "DISTINCT " : ""). + join(", ", @what). + " FROM ".$where. + ((scalar keys %{ $criteria } ) ? " "._build_WHERE($criteria) : "" ). + ($order_by ? " ORDER BY ".$order_by." ".$order_direction : ""). + (defined($limit_min) ? " LIMIT ".$limit_min : ""). + (defined($limit_max) ? ",".$limit_max : ""); + + return _fetch_multirow($where, $sql); +}; + +sub _pgsql_write_message { + my $server = shift || 'default'; + my $h = shift; + my $rc = 0; + + # PostgreSQL is case sensitive by default. Nice feature, + # but it complicates our life tremendously. + # Since we want to keep indexes working, the columns in + # this list are lowercased before they are inserted. Sigh. + my @lowercase = ( 'mailfrom', 'rcpt', 'rcpt_final', 'host_dns', 'host_helo', 'host_rdns' ); + foreach my $col (@lowercase) { + $h->{data}->{$col} = lc($h->{data}->{$col}) if (edt($h->{data},$col)); + }; + + # Special case: we only need to UPDATE the 'completed' field + # in the messages table. + if ( ($h->{table} eq 'messages') && (exists($h->{data}->{completed})) ) { + my $rc = $dbh->do("UPDATE messages SET completed='".$h->{data}->{completed}."' WHERE message_id='".$h->{data}->{message_id}."' AND server='".$server."'"); + if (defined($rc)) { + return 1; + } + else { + # error + return 0; + }; + } + else { + my @fields = sort {$a cmp $b} keys(%{$h->{data}}); + my @vals = ( "'".$server."'" ); + foreach (@fields) { + my $val = $h->{data}->{$_}; + $val =~ s/\'/\'\'/g; + # shorten $val to limit and remove eventual + # trailing quote and backslash characters. + $val = substr($val,0,255); + $val =~ s/[\\']+$//; + push @vals, "'".$val."'"; + }; + unshift @fields, 'server'; + + my $sql = "INSERT INTO ".$h->{table}.' ("'.join('","',@fields).'") VALUES('.join(',',@vals).")"; + my $rc = $dbh->do($sql); + + if (defined($rc)) { + return 1; + } + else { + return 2 if ($dbh->errstr =~ /duplicate/i); + print STDERR "SQL Error (code ".$dbh->err.") on '$h->{table}' with query: $sql\n"; + return 0; + }; + }; +}; + + +# -------------------------------------------------------------------------- +# MySQL functions +sub _mysql_sql_count { + my $where = shift; + my $criteria = shift || {}; + + my $sql = "SELECT ". + "COUNT(*) ". + "FROM ".$where. + ((scalar keys %{ $criteria } ) ? " "._build_WHERE($criteria) : "" ); + + my $sh = $dbh->prepare($sql); + $sh->execute; + my $tmp = $sh->fetchrow_arrayref(); + return @{$tmp}[0]; +}; + +sub _mysql_sql_queue_delete { + my $spool_path = shift; + + $dbh->do("DELETE FROM queue WHERE spool_path='$spool_path'"); +}; + +sub _mysql_sql_queue_update { + my $hdr = shift; + + return unless (ref($hdr) eq 'HASH'); + + my $server = $hdr->{server}; + my $message_id = $hdr->{message_id}; + delete $hdr->{server}; + delete $hdr->{message_id}; + + my @tmp; + foreach my $item (keys %{ $hdr }) { + my $value = $hdr->{$item}; + $value =~ s/\'/\'\'/g; + $value =~ s/\n/\\n/g; + push @tmp, $item.'='."'".$value."'"; + }; + + $dbh->do("UPDATE queue SET ".join(",",@tmp)." WHERE message_id='".$message_id."' AND server='".$server."'"); +}; + +sub _mysql_sql_queue_add { + my $hdr = shift; + + return unless (ref($hdr) eq 'HASH'); + + my @fields = sort {$a cmp $b} keys(%{$hdr}); + my @vals = (); + foreach (@fields) { + my $val = $hdr->{$_}; + $val =~ s/\'/\'\'/g; + $val =~ s/\n/\\n/g; + push @vals, "'".$val."'"; + }; + + $dbh->do("INSERT INTO queue (".join(',',@fields).") VALUES(".join(',',@vals).")"); +}; + +sub _mysql_sql_queue_set_action { + my $server = shift; + my $message_id = shift; + my $action = shift; + + $dbh->do("UPDATE queue SET action='$action' WHERE server='$server' AND message_id='$message_id'"); +}; + +sub _mysql_sql_queue_clear_action { + my $server = shift; + my $message_id = shift; + + $dbh->do("UPDATE queue SET action=NULL WHERE server='$server' AND message_id='$message_id'"); +}; + + +sub _mysql_sql_optimize { + my $where = shift || "nothing"; + + my $sql = "OPTIMIZE TABLE ".$where; + my $sh = $dbh->prepare($sql); + $sh->execute; + $sh->finish; + + return 1; +}; + +sub _mysql_sql_delete { + my $where = shift || "nothing"; + my $criteria = shift || {}; + + my $sql = "DELETE FROM ".$where. + ((scalar keys %{ $criteria } ) ? " "._build_WHERE($criteria) : "" ); + + my $sh = $dbh->prepare($sql); + my $num = $sh->execute; + $sh->finish; + + return (($num eq '0E0') ? 0 : $num); +}; + +sub _mysql_sql_select { + my $where = shift; + my @what = @{ (shift || [ "*" ]) }; + my $criteria = shift || {}; + my $order_by = shift || ""; + my $order_direction = shift || "DESC"; + my $limit_min = shift; + my $limit_max = shift; + my $distinct = shift; + + my $sql = "SELECT ". + (defined($distinct) ? "DISTINCT " : ""). + join(", ", @what). + " FROM ".$where. + ((scalar keys %{ $criteria } ) ? " "._build_WHERE($criteria) : "" ). + ($order_by ? " ORDER BY ".$order_by." ".$order_direction : ""). + (defined($limit_min) ? " LIMIT ".$limit_min : ""). + (defined($limit_max) ? ",".$limit_max : ""); + + return _fetch_multirow($where, $sql); +}; + +sub _mysql_write_message { + my $server = shift || 'default'; + my $h = shift; + my $rc = 0; + + # Special case: we only need to UPDATE the 'completed' field + # in the messages table. + if ( ($h->{table} eq 'messages') && (exists($h->{data}->{completed})) ) { + my $rc = $dbh->do("UPDATE messages SET completed='".$h->{data}->{completed}."' WHERE message_id='".$h->{data}->{message_id}."' AND server='".$server."'"); + if (defined($rc)) { + return 1; + } + else { + # error + return 0; + }; + } + else { + my @fields = sort {$a cmp $b} keys(%{$h->{data}}); + my @vals = ( "'".$server."'" ); + foreach (@fields) { + my $val = $h->{data}->{$_}; + $val =~ s/\'/\'\'/g; + # shorten $val to limit and remove eventual + # trailing quote and backslash characters. + $val = substr($val,0,255); + $val =~ s/[\\']+$//; + push @vals, "'".$val."'"; + }; + unshift @fields, 'server'; + + my $sql = "INSERT INTO ".$h->{table}." (".join(',',@fields).") VALUES(".join(',',@vals).")"; + my $rc = $dbh->do($sql); + + if (defined($rc)) { + return 1; + } + else { + # error 1062 means "Duplicate key". + return 2 if ($dbh->err == 1062); + print STDERR "SQL Error (code ".$dbh->err.") on '$h->{table}' with query: $sql\n"; + return 0; + }; + }; +}; + + +# -------------------------------------------------------------------------- +# misc subroutines used across several DB types +sub _fetch_multirow { + my $table = shift; + my $sql = shift; + my $limit = shift || 0; + + my $a = []; + my $sh = $dbh->prepare($sql); + $sh->execute; + while (my $tmp = $sh->fetchrow_hashref) { + push @{ $a }, $tmp; + $limit--; + last if ($limit == 0); + }; + $sh->finish; + + return $a; +}; + +sub _build_WHERE { + my $criteria = shift || {}; + + my @set = (); + foreach my $col (keys %{ $criteria }) { + next unless(defined($criteria->{$col})); + + if ( ($col eq "timestamp") || + ($col eq "completed") || + ($col eq "frozen") || + ($col eq "size") ) { + # integer column + my ($min,$max) = split / /,$criteria->{$col}; + + if (defined($min)) { + # greater than X + push @set, $col." > ".$min; + } + if (defined($max)) { + # smaller than X + push @set, $col." < ".$max; + } + } + elsif (ref($criteria->{$col}) eq 'ARRAY') { + # array ref, use exact string match with OR + my $str = "( "; + foreach my $entry (@{ $criteria->{$col} }) { + $str .= " ".$col." = '".$entry."' OR"; + }; + chop($str);chop($str); + $str .= " )"; + + push @set, $str; + } + else { + # string column + if (($criteria->{$col} =~ /\%/) || ($criteria->{$col} =~ /\_/)) { + # use ILIKE for PGSQL + if ($config->{sql}->{type} eq 'pgsql') { + push @set, $col." ILIKE '".$criteria->{$col}."'"; + } + else { + push @set, $col." LIKE '".$criteria->{$col}."'"; + }; + } + else { + push @set, $col." = '".$criteria->{$col}."'"; + }; + }; + }; + + return " WHERE ".join(" AND ", @set); +}; + + +1; diff --git a/lib/exilog_util.pm b/lib/exilog_util.pm new file mode 100644 index 0000000..c50e679 --- /dev/null +++ b/lib/exilog_util.pm @@ -0,0 +1,136 @@ +#!/usr/bin/perl -w +# +# This file is part of the exilog suite. +# +# http://duncanthrax.net/exilog/ +# +# (c) Tom Kistner 2004 +# +# See LICENSE for licensing information. +# + +package exilog_util; +use Time::Local; +use POSIX qw( strftime ); +use strict; +use exilog_config; + +BEGIN { + use Exporter; + use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS); + + # set the version for version checking + $VERSION = 0.1; + @ISA = qw(Exporter); + @EXPORT = qw( + &edt + &edv + &ina + &date_to_stamp + &stamp_to_date + &human_size + ); + + %EXPORT_TAGS = (); + + # your exported package globals go here, + # as well as any optionally exported functions + @EXPORT_OK = qw(); +} + + +# checks if scalar is in array +sub ina { + my $aref = shift || []; + my $str = shift || ""; + + unless (ref($aref) eq 'ARRAY') { + $aref = [ $aref ]; + }; + + foreach (@{ $aref }) { + return 1 if ($_ eq $str); + }; + return 0; +}; + + +# exists, defined and true (in perl sense) +sub edt { + my $h = shift; + my $hkey = shift; + return 0 unless (ref($h) eq 'HASH'); + return 1 if ( exists($h->{$hkey}) && + defined($h->{$hkey}) && + $h->{$hkey} ); + return 0; +}; + + +# exists, defined and valid (that is, not empty) +sub edv { + my $h = shift; + my $hkey = shift; + return 0 unless (ref($h) eq 'HASH'); + return 1 if ( exists($h->{$hkey}) && + defined($h->{$hkey}) && + $h->{$hkey} ne '' ); + return 0; +}; + + +sub date_to_stamp { + my $date = shift || ""; + my $tod = shift || "00:00:00"; + my ($year,$month,$mday) = split /\-/, $date; + my ($hour,$minute,$second,$junk) = split /[: ]/, $tod; + $year-=1900; + $month--; + + # This is for parsing timestamps that include GMT offsets + if (edv($junk)) { + my $hoff = ($junk =~ /[-+](\d\d)\d\d/); + my $moff = ($junk =~ /[-+]\d\d(\d\d)/); + if ($junk =~ /\+/) { + $hour = $hour - $hoff; + $minute = $minute - $moff; + } + else { + $hour = $hour + $hoff; + $minute = $minute + $moff; + } + }; + + if ($config->{web}->{timestamps} eq 'local') { + return timelocal($second,$minute,$hour,$mday,$month,$year); + } + else { + return timegm($second,$minute,$hour,$mday,$month,$year); + }; +}; + + +sub stamp_to_date { + my $stamp = shift; + my $no_seconds = shift || 0; + # convert to date/time string + if ($config->{web}->{timestamps} eq 'local') { + return ($no_seconds ? strftime("%Y-%m-%d %H:%M",localtime($stamp)) : strftime("%Y-%m-%d %H:%M:%S",localtime($stamp))); + } + else { + return ($no_seconds ? strftime("%Y-%m-%d %H:%M",gmtime($stamp)) : strftime("%Y-%m-%d %H:%M:%S",gmtime($stamp))); + }; +}; + +sub human_size { + my $size = shift; + my @units = ( '', 'k', 'M', 'G' ); + while ( ($size > 9999) && ((scalar @units) > 1) ) { + shift @units; + $size = int($size/1024); + }; + return $size.$units[0]; +}; + + +1; |