Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Net::Services

by Masem (Monsignor)
on Oct 22, 2001 at 00:06 UTC ( #120400=sourcecode: print w/ replies, xml ) Need Help??

Category: Networking Code
Author/Contact Info Michael K. Neylon (mneylon-pm@masemware.com)
Description: Allows better access to the list of system services on an OS. Your OS must support sockets for this to work; this includes *nix, and rules out all Windows varients - 9x, NT, 2K (and probably XP) (thanks Arguile)

I am looking for comments and critiques on this before I submit it to CPAN, msg or email me any suggestions

#!/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

Comment on Net::Services
Download Code
Re: Net::Services
by Chmrr (Vicar) on Oct 22, 2001 at 00:17 UTC

    I only see two niggling documentation nitpicks -- one might want to take out the # Below is stub documentation for your module. You better edit it! line, as well as s/protocall/protocol/ about 10 lines below that. Other than these two nitpicks, looks well-written and useful.

    perl -pe '"I lo*`+$^X$\"$]!$/"=~m%(.*)%s;$_=$1;y^+*`^ ve^#$&V"+@( NO CARRIER'

Re: Net::Services
by Starky (Chaplain) on Oct 22, 2001 at 09:49 UTC
    It looks like a well-written and very useful module.

    Another very minor nitpick which you may even want to ignore depending on your preferences:

    I noticed you took out the "our" vars created by h2xs, something that is important for compatibility with 5.005. I would also suggest removing the warnings pragma as well for the sake of backwards compatibility. I generally leave it commented so that if my module is still seeing general use several years from now I'll remember to put it back in.

    I like your examples :-) Good examples are something I often find lacking in PODs.

Re: Net::Services
by Masem (Monsignor) on Oct 22, 2001 at 16:52 UTC
    In light of the fact that this code requires socket capability, is there something I can add, say in a BEGIN block or via 'use' that would check that the system can support sockets at compile-time, as opposed to the run-time error message that one gets when the servent methods are used?

    -----------------------------------------------------
    Dr. Michael K. Neylon - mneylon-pm@masemware.com || "You've left the lens cap of your mind on again, Pinky" - The Brain
    "I can see my house from here!"
    It's not what you know, but knowing how to find it if you don't know that's important

      Do you mean something along the lines of:

      use Config; BEGIN { die "You are socketless!\n" unless Config::config_vars(qw/d_socket/) eq 'define'; }

      If you need really specific socket capabilities there is any number of fine-grained tests you could perform. Randomly cutting and pasting from perldoc Config gives things like

      =over `d_getsbyname' From d_getsrvby.U: This variable conditionally defines the `HAS_GETSERVBYNAME' symbol, which indicates to the C program that the getservbyname() routine is available to look up services by their name. =cut

      Is this what you were looking for?

      --
      g r i n d e r

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://120400]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others romping around the Monastery: (16)
As of 2014-07-25 09:31 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    My favorite superfluous repetitious redundant duplicative phrase is:









    Results (170 votes), past polls