Beefy Boxes and Bandwidth Generously Provided by pair Networks
Syntactic Confectionery Delight
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??
#!/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-&gt;{ 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

In reply to Net::Services by Masem

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others contemplating the Monastery: (7)
    As of 2014-12-19 22:55 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      Is guessing a good strategy for surviving in the IT business?





      Results (94 votes), past polls