File Coverage

blib/lib/Net/Frame/Layer/Syslog.pm

Criterion	Covered	Total	%
statement	200	216	92.5
branch	25	46	54.3
condition	6	11	54.5
subroutine	49	50	98.0
pod	9	9	100.0
total	289	332	87.0

#
# $Id: Syslog.pm 49 2012-11-19 13:15:34Z VinsWorldcom $
#
package Net::Frame::Layer::Syslog;
use strict; use warnings;

our $VERSION = '1.04';

use Net::Frame::Layer qw(:consts :subs);
use Exporter;
our @ISA = qw(Net::Frame::Layer Exporter);

our %EXPORT_TAGS = (
   consts => [qw(
      NF_SYSLOG_FACILITY_KERNEL
      NF_SYSLOG_FACILITY_USER
      NF_SYSLOG_FACILITY_MAIL
      NF_SYSLOG_FACILITY_SYSTEM
      NF_SYSLOG_FACILITY_SECURITY
      NF_SYSLOG_FACILITY_INTERNAL
      NF_SYSLOG_FACILITY_PRINTER
      NF_SYSLOG_FACILITY_NEWS
      NF_SYSLOG_FACILITY_UUCP
      NF_SYSLOG_FACILITY_CLOCK
      NF_SYSLOG_FACILITY_SECURITY2
      NF_SYSLOG_FACILITY_FTP
      NF_SYSLOG_FACILITY_NTP
      NF_SYSLOG_FACILITY_AUDIT
      NF_SYSLOG_FACILITY_ALERT
      NF_SYSLOG_FACILITY_CLOCK2
      NF_SYSLOG_FACILITY_LOCAL0
      NF_SYSLOG_FACILITY_LOCAL1
      NF_SYSLOG_FACILITY_LOCAL2
      NF_SYSLOG_FACILITY_LOCAL3
      NF_SYSLOG_FACILITY_LOCAL4
      NF_SYSLOG_FACILITY_LOCAL5
      NF_SYSLOG_FACILITY_LOCAL6
      NF_SYSLOG_FACILITY_LOCAL7
      NF_SYSLOG_SEVERITY_EMERGENCY
      NF_SYSLOG_SEVERITY_ALERT
      NF_SYSLOG_SEVERITY_CRITICAL
      NF_SYSLOG_SEVERITY_ERROR
      NF_SYSLOG_SEVERITY_WARNING
      NF_SYSLOG_SEVERITY_NOTICE
      NF_SYSLOG_SEVERITY_INFORMATIONAL
      NF_SYSLOG_SEVERITY_DEBUG
   )],
   subs => [qw(
      priorityAton
      priorityNtoa
   )],
);
our @EXPORT_OK = (
   @{$EXPORT_TAGS{consts}},
   @{$EXPORT_TAGS{subs}},
);

use constant NF_SYSLOG_FACILITY_KERNEL        => 0;
use constant NF_SYSLOG_FACILITY_USER          => 1;
use constant NF_SYSLOG_FACILITY_MAIL          => 2;
use constant NF_SYSLOG_FACILITY_SYSTEM        => 3;
use constant NF_SYSLOG_FACILITY_SECURITY      => 4;
use constant NF_SYSLOG_FACILITY_INTERNAL      => 5;
use constant NF_SYSLOG_FACILITY_PRINTER       => 6;
use constant NF_SYSLOG_FACILITY_NEWS          => 7;
use constant NF_SYSLOG_FACILITY_UUCP          => 8;
use constant NF_SYSLOG_FACILITY_CLOCK         => 9;
use constant NF_SYSLOG_FACILITY_SECURITY2     => 10;
use constant NF_SYSLOG_FACILITY_FTP           => 11;
use constant NF_SYSLOG_FACILITY_NTP           => 12;
use constant NF_SYSLOG_FACILITY_AUDIT         => 13;
use constant NF_SYSLOG_FACILITY_ALERT         => 14;
use constant NF_SYSLOG_FACILITY_CLOCK2        => 15;
use constant NF_SYSLOG_FACILITY_LOCAL0        => 16;
use constant NF_SYSLOG_FACILITY_LOCAL1        => 17;
use constant NF_SYSLOG_FACILITY_LOCAL2        => 18;
use constant NF_SYSLOG_FACILITY_LOCAL3        => 19;
use constant NF_SYSLOG_FACILITY_LOCAL4        => 20;
use constant NF_SYSLOG_FACILITY_LOCAL5        => 21;
use constant NF_SYSLOG_FACILITY_LOCAL6        => 22;
use constant NF_SYSLOG_FACILITY_LOCAL7        => 23;
use constant NF_SYSLOG_SEVERITY_EMERGENCY     => 0;
use constant NF_SYSLOG_SEVERITY_ALERT         => 1;
use constant NF_SYSLOG_SEVERITY_CRITICAL      => 2;
use constant NF_SYSLOG_SEVERITY_ERROR         => 3;
use constant NF_SYSLOG_SEVERITY_WARNING       => 4;
use constant NF_SYSLOG_SEVERITY_NOTICE        => 5;
use constant NF_SYSLOG_SEVERITY_INFORMATIONAL => 6;
use constant NF_SYSLOG_SEVERITY_DEBUG         => 7;

our @FACILITY = 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);
our @SEVERITY = qw(Emergency Alert Critical Error Warning Notice Informational Debug);

our @AS = qw(
   facility
   severity
   timestamp
   host
   tag
   content
   msg
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

#no strict 'vars';
use Socket qw(inet_ntoa AF_INET IPPROTO_TCP);

#my $AF_INET6 = eval { Socket::AF_INET6() };
my $AF_UNSPEC = eval { Socket::AF_UNSPEC() };
#my $AI_NUMERICHOST = eval { Socket::AI_NUMERICHOST() };
my $NI_NUMERICHOST = eval { Socket::NI_NUMERICHOST() };

use Sys::Hostname;

$Net::Frame::Layer::UDP::Next->{514} = "Syslog";

sub new {
   my $time = _getTime();
   my $host = _getHost();
   my $tag  = _getTag();

   shift->SUPER::new(
      facility  => NF_SYSLOG_FACILITY_LOCAL7,
      severity  => NF_SYSLOG_SEVERITY_INFORMATIONAL,
      timestamp => $time,
      host      => $host,
      tag       => $tag,
      content   => 'syslog message',
      @_,
   );
}

sub message {
   my $time = _getTime();
   my $host = _getHost();
   my $tag  = _getTag();

   shift->SUPER::new(
      msg => "<190>$time $host $tag syslog message",
      @_,
   );
}

sub getLength {
   my $self = shift;

   if (defined($self->msg)) {
       return length($self->msg)
   } else {

      my $priority = priorityAton($self->facility, $self->severity);
      my $len =
         length($priority)        +
         length($self->timestamp) +
         length($self->host)      +
         length($self->tag)       +
         length($self->content)   +
         5;

      return $len
   }
}

sub pack {
   my $self = shift;

   my $raw;
   if (defined($self->msg)) {
      $raw = $self->SUPER::pack('a*',
         $self->msg
      ) or return;
   } else {
      my $priority = priorityAton($self->facility, $self->severity);

      $raw = $self->SUPER::pack('a*',
         "<" .
         $priority .
         ">" .
         $self->timestamp .
         " " .
         $self->host .
         " " .
         $self->tag .
         " " .
         $self->content
      ) or return;
   }

   return $self->raw($raw);
}

sub unpack {
   my $self = shift;

   my ($payload) =
      $self->SUPER::unpack('a*', $self->raw)
         or return;

   my $regex = '<(\d{1,3})>[\d{1,}: \*]*((?:[JFMASONDjfmasond]\w\w) {1,2}(?:\d+)(?: \d{4})* (?:\d{2}:\d{2}:\d{2}[\.\d{1,3}]*)(?: [A-Z]{1,3})*)?:*\s*(?:((?:[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3})|(?:[a-zA-Z\-]+)|(?:(?:(?:[0-9A-Fa-f]{1,4}:){7}(?:[0-9A-Fa-f]{1,4}|:))|(?:(?:[0-9A-Fa-f]{1,4}:){6}(?::[0-9A-Fa-f]{1,4}|(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3})|:))|(?:(?:[0-9A-Fa-f]{1,4}:){5}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,2})|:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3})|:))|(?:(?:[0-9A-Fa-f]{1,4}:){4}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,3})|(?:(?::[0-9A-Fa-f]{1,4})?:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[0-9A-Fa-f]{1,4}:){3}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,4})|(?:(?::[0-9A-Fa-f]{1,4}){0,2}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[0-9A-Fa-f]{1,4}:){2}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,5})|(?:(?::[0-9A-Fa-f]{1,4}){0,3}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?:(?:[0-9A-Fa-f]{1,4}:){1}(?:(?:(?::[0-9A-Fa-f]{1,4}){1,6})|(?:(?::[0-9A-Fa-f]{1,4}){0,4}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:))|(?::(?:(?:(?::[0-9A-Fa-f]{1,4}){1,7})|(?:(?::[0-9A-Fa-f]{1,4}){0,5}:(?:(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)(?:\.(?:25[0-5]|2[0-4]\d|1\d\d|[1-9]?\d)){3}))|:)))(?:%.+)?) )?(.*)';
   my $Cregex = qr/$regex/;

   if ($payload =~ /$Cregex/) {

      my $priority  = $1;
      my $timestamp = $2 || '0';
      my $hostname  = $3 || '0';
      my $message   = $4;
      my ($facility, $severity) = priorityNtoa($priority);

      $self->facility($facility);
      $self->severity($severity);
      $self->timestamp($timestamp);

      $hostname =~ s/\s+//;
      $self->host($hostname);

      my %chars;
      $chars{bracket} = index($message,"]");
      $chars{colon}   = index($message,":");
      $chars{space}   = index($message," ");
      my $win = 0;
      foreach my $ch (sort {$chars{$b} cmp $chars{$a}} keys %chars) {
          if ($chars{$ch} > 0) {
             $win = $ch
          }
      }
      if ($chars{$win} > 0) {
         my $tag     = substr($message, 0, $chars{$win}+1) || '0';
         my $content = substr($message, $chars{$win}+1)    || '0';
         $self->tag($tag);
         $self->content($content)
      } else {
          $self->tag('0');
          $self->content($message)
      }

      my $msg = substr $payload, index($payload,">")+1;
      $self->msg($msg)

   } else {
      $self->facility(undef);
      $self->severity(undef);
      $self->msg($payload)
   }

   return $self;
}

sub encapsulate {
   my $self = shift;

   return $self->nextLayer if $self->nextLayer;

   # Needed?
   if ($self->payload) {
      return 'Syslog';
   }

   NF_LAYER_NONE;
}

sub print {
   my $self = shift;

   my $l = $self->layer;
   my $buf;
   if (defined($self->msg)) {
      if (defined($self->facility) && defined($self->severity)) {
         $buf = sprintf
            "$l: facility:$FACILITY[$self->facility]  severity:$SEVERITY[$self->severity]\n"
      }
      $buf .= sprintf
         "$l: message:%s",
            $self->msg;
   } else {
      $buf = sprintf
         "$l: facility:$FACILITY[$self->facility]  severity:$SEVERITY[$self->severity]\n".
         "$l: timestamp:%s  host:%s\n".
         "$l: tag:%s\n".
         "$l: content:%s",
            $self->timestamp, $self->host,
            $self->tag,
            $self->content;
   }

   return $buf;
}

####

sub priorityAton {
   my ($fac, $sev) = @_;

   return (($fac << 3) | $sev)
}

sub priorityNtoa {
   my ($pri, $flag) = @_;

   my $sev = $pri % 8;
   my $fac = ($pri - $sev) / 8;

   if (defined($flag)) {
      return ($FACILITY[$fac], $SEVERITY[$sev])
   } else {
      return ($fac, $sev)
   }
}

sub _getTime {
   my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
   my @time = localtime();
   my $ts =
        $month[ $time[4] ] . " "
      . ( ( $time[3] < 10 ) ? ( " " . $time[3] ) : $time[3] ) . " "
      . ( ( $time[2] < 10 ) ? ( "0" . $time[2] ) : $time[2] ) . ":"
      . ( ( $time[1] < 10 ) ? ( "0" . $time[1] ) : $time[1] ) . ":"
      . ( ( $time[0] < 10 ) ? ( "0" . $time[0] ) : $time[0] );

   return $ts
}

sub _getHost {
   my $hostname = 'localhost';

   if ($Socket::VERSION >= 1.94) {
      my %hints = (
         family => $AF_UNSPEC,
         protocol => IPPROTO_TCP
      );
      my ($err, @getaddr) = Socket::getaddrinfo(Sys::Hostname::hostname, undef, \%hints);
      if (defined($getaddr[0])) {
         my ($err, $address) = Socket::getnameinfo($getaddr[0]->{addr}, $NI_NUMERICHOST);
         if (defined($address)) {
            $hostname = $address;
            $hostname =~ s/\%(.)*$// # remove %ifID if IPv6
         }
      }
   } else {
      my @gethost = gethostbyname(Sys::Hostname::hostname);
      if (defined($gethost[4])) {
         $hostname = inet_ntoa($gethost[4])
      }
   }
   return $hostname
}

sub _getTag {
   my $name  = $0;
   if ($name =~ /.+\/(.+)/) {
      $name = $1;
   } elsif ($name =~ /.+\\(.+)/) {
      $name = $1;
   }

   return $name . "[" . $$ . "]"
}

1;

__END__