#!/usr/bin/perl -wT
package Net::Services;
#=====================================================================
+========
#
# $Id: Services.pm,v 0.01 2001/10/21 19:40:42 mneylon Exp $
# $Revision: 0.01 $
# $Author: mneylon $
# $Date: 2001/10/21 19:40:42 $
# $Log: Services.pm,v $
# Revision 0.01 2001/10/21 19:40:42 mneylon
# Initial Release to Perlmonks
#
#
#=====================================================================
+========
use strict;
use warnings;
BEGIN {
use Exporter ();
use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS);
$VERSION = sprintf( "%d.%02d", q($Revision: 0.01 $) =~ /\s(\d+
+)\.(\d+)/ );
@ISA = qw(Exporter);
@EXPORT = qw();
%EXPORT_TAGS = ( );
}
# Constructor; call to rebuild() when completed.
sub new {
my $proto = shift;
my $class = ref( $proto ) || $proto;
my $self = {
services => []
};
bless $self, $class;
$self->rebuild();
return $self;
}
# Rebuilds the services list using standard system calls
sub rebuild {
my $self = shift;
my @services;
setservent( 1 ); # Start polling, get only desired prototypes
while ( my @data = getservent() )
{
push @services, \@data;
}
endservent();
$self->{ services } = \@services;
# A cache to improve lookups
my %cache;
my $i = 0;
foreach my $service ( @services ) {
push @{$cache{ $service->[ 2 ] }}, $i; # by port...
push @{$cache{ $service->[ 0 ] }}, $i; # by name...
foreach my $alias ( split /\s*/, $service->[1] ) {
push @{$cache{ $alias } }, $i;
}
$i++;
}
$self->{ cache } = \%cache;
return 1;
}
# Returns the services information for a given port or service name
sub get_service_info {
my $self = shift;
my $key = shift;
my $protocol = lc(shift) || 'tcp';
# Look for 'dddd/ccc' formats in the key , and work with appropria
+te
if ( $key =~ /^(\d*)\/(\w*)$/ ) {
$key = $1;
$protocol = $2;
}
if ( exists $self->{ cache }->{ $key } ) {
foreach my $index ( @{ $self->{ cache }->{ $key } } ) {
my ( $name, $aliases, $port, $proto ) =
@{ $self->{ services }->[ $index ] };
if ( $proto eq $protocol ) {
return ( $name, $aliases, $port, $proto )
} else { next; }
}
}
return undef;
}
sub get_services {
my $self = shift;
my $key = shift;
my $protocol = lc( shift ) || 'tcp';
# Look for 'dddd/ccc' formats in the key , and work with appropria
+te
if ( $key =~ /^(\d*)\/(\w*)$/ ) {
$key = $1;
$protocol = $2;
}
my @services;
if ( exists $self->{ cache }->{ $key } ) {
foreach my $index ( @{ $self->{ cache }->{ $key } } ) {
my @data =
@{ $self->{ services }->[ $index ] };
if ( $data[-1] eq $protocol ) {
push @services, \@data;
} else { next; }
}
return @services;
}
return undef;
}
# Now some functions to access specific data from the list above
sub get_service_port {
my $self = shift;
if ( my @service = $self->get_service_info( @_ ) ) {
return $service[2];
} else {
return undef;
}
}
sub get_service_name {
my $self = shift;
if ( my @service = $self->get_service_info( @_ ) ) {
return $service[0];
} else {
return undef;
}
}
sub get_service_aliases {
my $self = shift;
if ( my @service = $self->get_service_info( @_ ) ) {
return split /\s*/, $service[1]; # Split aliases up nicely
} else {
return undef;
}
}
sub get_service_protocol {
my $self = shift;
if ( my @service = $self->get_service_info( @_ ) ) {
return $service[3];
} else {
return undef;
}
}
sub get_all_services {
my $self = shift;
my $proto = shift;
my @services;
foreach my $service ( @{ $self->{ services } } ) {
my @data = @$service;
if ( $proto && $data[-1] eq $proto ) {
push @services, \@data;
}
}
return @services;
}
sub get_all_ports {
my $self = shift;
my $proto = shift;
my @ports;
foreach my $service ( @{ $self->{ services } } ) {
my @data = @$service;
if ( $proto && $data[-1] eq $proto ) {
push @ports, $data[2];
}
}
return @ports;
}
sub get_all_names {
my $self = shift;
my $proto = shift;
my @names;
foreach my $service ( @{ $self->{ services } } ) {
my @data = @$service;
if ( $proto && $data[-1] eq $proto ) {
push @names, $data[0];
}
}
return @names;
}
1;
__END__
# Below is stub documentation for your module. You better edit it!
=head1 NAME
Net::Services - Quick access to ports and service information
=head1 SYNOPSIS
use Net::Services;
my $services = new Net::Services;
my ( $name, $aliases, $port, $protocall ) =
$services->get_service_info( 80 );
my $www_port = $services->get_service_port( 'www' );
my $service_name = $services->get_service_name( '21/tcp' );
my @exec_ports = grep { $_ < 1024 } $services->get_all_ports( 'tcp'
+);
=head1 DESCRIPTION
Net::Services provides quick access to the OS's description of ports
and services, normally available to perl by the use of C<getservent()>
+ and
other related functions. While these functions are sufficiently easy
+to
use, it does require the OS to run through it's internal database of
service entries in order to locate them. Net::Services caches these
values upon creation (along with the ability to rebuild this at any ti
+me)
as to help speed up the process.
Note that because multiple possible services exist for a given port
or name (eg many-to-many relationships), the functions here that retur
+n
a single service behave as C<getservent()> and friends do, by returnin
+g
the first service in the database with that port or name. Other
functions are available to enumerate across all possible ports if
needed.
Also note that unless otherwise specified, the services are returned
for the 'tcp' protocol. In most cases, you can specify a different
protocol to be returned.
=over
=item C<new>
Creates a new Net::Services object. The services cache is built at th
+is
time.
=item C<rebuild>
Rebuilds the services cache. While the OS's services database is
typcially static until a reboot, it may change by the installation
of new software or the editing of files (such as C</etc/services> for
UNIX).
=item C<get_service_info> ( <port|name|alias>, [<protocol>] )
Returns the first services information as an array that is associated
+with
either the numerical port or textual name or alias. Additionally, one
+ may
use 'number/protocol' format (i.e. '80/tcp'). The protocol is option
+al,
but defaults to 'tcp' if not otherwise specified. The order of the
returned information is the same as with C<getservent()>, that is,
name, aliases, port, and protocol. Returns undef if no service is fou
+nd
at the given port or with the given name or alias.
=item C<get_service> ( <port|name|alias>, [<protocol>] )
Similar to C<get_service_info>, but returns all services as an array o
+f
arrays that are at that port or with that name or alias.
=item C<get_service_name> ( <port|name|alias>, [<protocol>] )
=item C<get_service_aliases> ( <port|name|alias>, [<protocol>] )
=item C<get_service_port> ( <port|name|alias>, [<protocol>] )
=item C<get_service_protocol> ( <port|name|alias>, [<protocol>] )
Similar to C<get_service_info>, but returns the specific data field
requested (name, aliases, port, protocol). Note that in the case of
aliases, this is returned as an array of the alias strings.
=item C<get_all_services> ( [<protocol>] )
Returns an array of arrays containing all services in the cache. The
order is unspecified. If the protocol is specified, entries are limit
+ed
to only that protocol type.
=item C<get_all_ports> ( [<protocol>] )
=item C<get_all_names> ( [<protocol>] )
Returns a list of all ports or names known to the cache; if protocol
is specified, the list is limited to only those services with that
protocol. Note that because it's possible to have a many-to-many mapp
+ing
of ports and names, there may be duplicates on this list.
=back
=head1 AUTHOR
Michael K. Neylon <lt>mneylon-pm@masemware.com<gt>
=head1 SEE ALSO
L<Net::servent>
=cut
|
