File Coverage

blib/lib/Metabrik/System/Netstat.pm

Criterion	Covered	Total	%
statement	9	38	23.6
branch	0	8	0.0
condition	0	6	0.0
subroutine	3	6	50.0
pod	1	3	33.3
total	13	61	21.3

#
# $Id$
#
# system::netstat Brik
#
package Metabrik::System::Netstat;
use strict;
use warnings;

use base qw(Metabrik::Shell::Command);

sub brik_properties {
   return {
      revision => '$Revision$',
      tags => [ qw(unstable listen) ],
      author => 'GomoR ',
      license => 'http://opensource.org/licenses/BSD-3-Clause',
      commands => {
         udp_listen => [ ],
         tcp_listen => [ ],
      },
      require_binaries => {
         'netstat', => [ ],
      },
   };
}

sub udp_listen {
   my $self = shift;

   $self->as_array(0);
   $self->as_matrix(1);
   my $lines = $self->capture("netstat -an");

   my $listen = { };
   for my $line (@$lines) {
      my $proto = $line->[0];
      if ($proto eq 'udp') {
         $proto = 'udp4'; # Rewrite for FreeBSD and uniformity
      }
      if ($proto eq 'udp4' || $line->[0] eq 'udp6') {
         my $ip_port = $line->[3];
         my ($ip, $port) = $ip_port =~ /^(.*)[:\.](\d+)$/;   # : is Linux separator, . is FreeBSD one
         $listen->{$proto}->{$ip_port} = { ip => $ip, port => $port };
      }
   }

   return $listen;
}

sub tcp_listen {
   my $self = shift;

   $self->as_array(0);
   $self->as_matrix(1);
   my $lines = $self->capture("netstat -an");

   my $listen = { };
   for my $line (@$lines) {
      my $proto = $line->[0];
      if ($proto eq 'tcp') {
         $proto = 'tcp4'; # Rewrite for FreeBSD and uniformity
      }
      if ($proto eq 'tcp4' || $proto eq 'tcp6') {
         my $ip_port = $line->[3];
         my ($ip, $port) = $ip_port =~ /^(.*)[:\.](\d+)$/;   # : is Linux separator, . is FreeBSD one
         $listen->{$proto}->{$ip_port} = { ip => $ip, port => $port };
      }
   }

   return $listen;
}

1;

__END__