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 |
|
---|
Replies are listed 'Best First'. | |
---|---|
Re: Net::Services
by Chmrr (Vicar) on Oct 22, 2001 at 00:17 UTC | |
Re: Net::Services
by Starky (Chaplain) on Oct 22, 2001 at 09:49 UTC | |
Re: Net::Services
by Masem (Monsignor) on Oct 22, 2001 at 16:52 UTC | |
by grinder (Bishop) on Oct 22, 2001 at 19:22 UTC |
Back to
Code Catacombs