lots of misc work
This commit is contained in:
parent
2458cd4742
commit
5c6b88bc19
|
@ -3,50 +3,526 @@ package Net::Connection;
|
|||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Net::DNS;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Net::Connection - The great new Net::Connection!
|
||||
Net::Connection - Represents a network connection as a object.
|
||||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.01
|
||||
Version 0.0.0
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.01';
|
||||
our $VERSION = '0.0.0';
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
Quick summary of what the module does.
|
||||
=head1 Methods
|
||||
|
||||
Perhaps a little code snippet.
|
||||
=head2 new
|
||||
|
||||
use Net::Connection;
|
||||
This initiates a new connection object.
|
||||
|
||||
my $foo = Net::Connection->new();
|
||||
...
|
||||
One argument is taken is taken
|
||||
|
||||
=head1 EXPORT
|
||||
local_host
|
||||
local_port
|
||||
foreign_host
|
||||
foreign_port
|
||||
proto
|
||||
state
|
||||
|
||||
A list of functions that can be exported. You can delete this section
|
||||
if you don't export anything, such as for a purely object-oriented module.
|
||||
=head3 keys
|
||||
|
||||
=head1 SUBROUTINES/METHODS
|
||||
=head4 foreign_host
|
||||
|
||||
=head2 function1
|
||||
The local host of the connection.
|
||||
|
||||
This can either be a IP or hostname. Max utility is achieved via a
|
||||
IP though as that allows PTR lookup to be done.
|
||||
|
||||
If appears to be a hostname, it is copied to local_ptr and even
|
||||
if asked to resolve PTRs it won't attempt to.
|
||||
|
||||
=head4 foreign_port
|
||||
|
||||
This is the foreign port of the connection.
|
||||
|
||||
For best utility, using numeric here is best.
|
||||
|
||||
If ports is true it will attempt to resolve it,
|
||||
including reverse resolving if it is a port name instead.
|
||||
|
||||
If ports is false or not set and this value is
|
||||
non-numeric, it will be copied to foreign_port_name.
|
||||
|
||||
=head4 foreign_port_name
|
||||
|
||||
This is the name of foreign port, if one exists in the
|
||||
service records.
|
||||
|
||||
=head4 foreign_ptr
|
||||
|
||||
This is the PTR address for foreign_host.
|
||||
|
||||
If ptrs is not true and foreign_host appears to be
|
||||
a hostname, then it is set to the same as foreign_host.
|
||||
|
||||
=head4 local_port
|
||||
|
||||
This is the local port of the connection.
|
||||
|
||||
For best utility, using numeric here is best.
|
||||
|
||||
If ports is true it will attempt to resolve it,
|
||||
including reverse resolving if it is a port name instead.
|
||||
|
||||
If ports is false or not set and this value is
|
||||
non-numeric, it will be copied to local_port_name.
|
||||
|
||||
=head4 local_port_name
|
||||
|
||||
This is the name of local port, if one exists in the
|
||||
service records.
|
||||
|
||||
=head4 local_ptr
|
||||
|
||||
This is the PTR address for local_host.
|
||||
|
||||
If ptrs is not true and local_host appears to be
|
||||
a hostname, then it is set to the same as local_host.
|
||||
|
||||
=head4 pid
|
||||
|
||||
This is the pid for a connection.
|
||||
|
||||
If defined, it needs to be numeric.
|
||||
|
||||
=head4 ports
|
||||
|
||||
If true, it will attempt to resolve the port names.
|
||||
|
||||
=head4 proto
|
||||
|
||||
This is the protocol type.
|
||||
|
||||
This needs to be defined, but unfortunately no real checking is done
|
||||
as of currently as various OSes uses varrying capitalizations and slightly
|
||||
different forms of TCP, TCP4, tcp4, tcpv4, and the like.
|
||||
|
||||
=head4 ptrs
|
||||
|
||||
If is true, then
|
||||
|
||||
=head4 recvq
|
||||
|
||||
This is the recieve queue size.
|
||||
|
||||
If set, it must be numeric.
|
||||
|
||||
=head4 sendq
|
||||
|
||||
This is the send queue size.
|
||||
|
||||
If set, it must be numeric.
|
||||
|
||||
=head4 state
|
||||
|
||||
This is the current state of the connection.
|
||||
|
||||
This needs to be defined, but unfortunately no real checking is
|
||||
done as of currently as there are minor naming differences between
|
||||
OSes as well as some including states that are not found in others.
|
||||
|
||||
=head4 uid
|
||||
|
||||
The UID is the of the user the has the connection open.
|
||||
|
||||
This must be numeric.
|
||||
|
||||
If uid_resolve is set to true then the UID will be resolved
|
||||
and stored in username.
|
||||
|
||||
If this is not defined, uid_resolve is true, and username is defined
|
||||
then it will attempt to resolve the UID from the username.
|
||||
|
||||
=head4 uid_resolve
|
||||
|
||||
If set to true and uid is given, then a attempt will be made to
|
||||
resolve the UID to a username.
|
||||
|
||||
=head4 username
|
||||
|
||||
This is the username for a connection.
|
||||
|
||||
If uid_resolve is true and uid is defined, then this
|
||||
will attempt to be automatically contemplated.
|
||||
|
||||
If uid_resolve is true and uid is defined, then this
|
||||
will attempt to be automatically contemplated.
|
||||
|
||||
=cut
|
||||
|
||||
sub function1 {
|
||||
sub new{
|
||||
my %args;
|
||||
if(defined($_[1])){
|
||||
%args= %{$_[1]};
|
||||
};
|
||||
|
||||
# make sure we got the required bits
|
||||
if (
|
||||
(!defined( $args{'foreign_host'}) ) ||
|
||||
(!defined( $args{'local_host'}) ) ||
|
||||
(!defined( $args{'foreign_port'}) ) ||
|
||||
(!defined( $args{'local_port'}) ) ||
|
||||
(!defined( $args{'state'}) ) ||
|
||||
(!defined( $args{'proto'}) )
|
||||
){
|
||||
die "One or more of the required arguments is not defined";
|
||||
}
|
||||
|
||||
# PID must be numeric if given
|
||||
if (
|
||||
defined( $args{'pid'} ) &&
|
||||
( $args{'pid'} !~ /^[0-9]+$/ )
|
||||
){
|
||||
die '$args{"pid"} is not numeric';
|
||||
}
|
||||
|
||||
# UID must be numeric if given
|
||||
if (
|
||||
defined( $args{'uid'} ) &&
|
||||
( $args{'uid'} !~ /^[0-9]+$/ )
|
||||
){
|
||||
die '$args{"uid"} is not numeric';
|
||||
}
|
||||
|
||||
# set the sendq/recvq and make sure they are numeric if given
|
||||
if (
|
||||
defined( $args{'sendq'} ) &&
|
||||
( $args{'sendq'} !~ /^[0-9]+$/ )
|
||||
){
|
||||
die '$args{"sendq"} is not numeric';
|
||||
}
|
||||
if (
|
||||
defined( $args{'recvq'} ) &&
|
||||
( $args{'recvq'} !~ /^[0-9]+$/ )
|
||||
){
|
||||
die '$args{"recvq"} is not numeric';
|
||||
}
|
||||
|
||||
my $self={
|
||||
'foreign_host' => $args{'foreign_host'},
|
||||
'local_host' => $args{'local_host'},
|
||||
'foreign_port' => $args{'foreign_port'},
|
||||
'foreign_port_name' => $args{'foreign_port_name'},
|
||||
'local_port' => $args{'local_port'},
|
||||
'local_port_name' => $args{'local_port_name'},
|
||||
'sendq' => undef,
|
||||
'recvq' => undef,
|
||||
'pid' => undef,
|
||||
'uid' => undef,
|
||||
'state' => $args{'state'},
|
||||
'proto' => $args{'proto'},
|
||||
'local_ptr' => undef,
|
||||
'foreign_ptr' => undef,
|
||||
};
|
||||
|
||||
# Set these if defined
|
||||
if (defined( $args{'sendq'} )){
|
||||
$self->{'sendq'}=$args{'sendq'};
|
||||
}
|
||||
if (defined( $args{'recvq'} )){
|
||||
$self->{'recvq'}=$args{'recvq'};
|
||||
}
|
||||
if (defined( $args{'local_ptr'} )){
|
||||
$self->{'local_ptr'}=$args{'local_ptr'};
|
||||
}
|
||||
if (defined( $args{'foreign_ptr'} )){
|
||||
$self->{'foreign_ptr'}=$args{'foreign_ptr'};
|
||||
}
|
||||
if (defined( $args{'uid'} )){
|
||||
$self->{'uid'}=$args{'uid'};
|
||||
}
|
||||
if (defined( $args{'pid'} )){
|
||||
$self->{'pid'}=$args{'pid'};
|
||||
}
|
||||
if (defined( $args{'username'} )){
|
||||
$self->{'username'}=$args{'username'};
|
||||
}
|
||||
|
||||
# resolve port names if asked to
|
||||
if ( $args{ports} ){
|
||||
# If the port is non-numeric, set the name and attempt to resolve it.
|
||||
if ( $self->{'local_port'} =~ /[A-Za-z]/ ){
|
||||
$self->{'local_port_name'}=$self->{'local_port'};
|
||||
my $service=getservbyname($self->{'local_port_name'}, undef);
|
||||
if (defined( $service )){
|
||||
$self->{'local_port'}=$service;
|
||||
}
|
||||
}
|
||||
if ( $self->{'foreign_port'} =~ /[A-Za-z]/ ){
|
||||
$self->{'foreign_port_name'}=$self->{'foreign_port'};
|
||||
my $service=getservbyname($self->{'foreign_port_name'}, undef);
|
||||
if (defined( $service )){
|
||||
$self->{'foreign_port'}=$service;
|
||||
}
|
||||
}
|
||||
}else{
|
||||
# If the port is non-numeric, set it as the port name
|
||||
if ( $self->{'local_port'} =~ /[A-Za-z]/ ){
|
||||
$self->{'local_port_name'}=$self->{'local_port'};
|
||||
}
|
||||
if ( $self->{'foreign_port'} =~ /[A-Za-z]/ ){
|
||||
$self->{'foreign_port_name'}=$self->{'foreign_port'};
|
||||
}
|
||||
}
|
||||
|
||||
my $dns=Net::DNS::Resolver->new;
|
||||
|
||||
# resolve PTRs if asked to
|
||||
if (
|
||||
defined( $args{ptrs} ) &&
|
||||
$args{ptrs}
|
||||
){
|
||||
# process foreign_host
|
||||
if (
|
||||
( $self->{'foreign_host'} =~ /[A-Za-z]/ ) &&
|
||||
( $self->{'foreign_host'} !~ /\:/ )
|
||||
){
|
||||
# appears to be a hostname already
|
||||
$self->{'foreign_ptr'}=$self->{'foreign_host'};
|
||||
}else{
|
||||
# attempt to resolve it
|
||||
eval{
|
||||
my $answer=$dns->search( $self->{'foreign_host'} );
|
||||
if ( defined( $answer->{answer}[0] ) &&
|
||||
( ref( $answer->{answer}[0] ) eq 'Net::DNS::RR::PTR' )
|
||||
){
|
||||
$self->{'foreign_ptr'}=lc($answer->{answer}[0]->ptrdname);
|
||||
}
|
||||
}
|
||||
}
|
||||
# process local_host
|
||||
if (
|
||||
( $self->{'local_host'} =~ /[A-Za-z]/ ) &&
|
||||
( $self->{'local_host'} !~ /\:/ )
|
||||
){
|
||||
# appears to be a hostname already
|
||||
$self->{'local_ptr'}=$self->{'local_host'};
|
||||
}else{
|
||||
# attempt to resolve it
|
||||
eval{
|
||||
my $answer=$dns->search( $self->{'local_host'} );
|
||||
if ( defined( $answer->{answer}[0] ) &&
|
||||
( ref( $answer->{answer}[0] ) eq 'Net::DNS::RR::PTR' )
|
||||
){
|
||||
$self->{'local_ptr'}=lc($answer->{answer}[0]->ptrdname);
|
||||
}
|
||||
}
|
||||
}
|
||||
}else{
|
||||
# We are not doing auto PTR resolving...
|
||||
# just set them if it appears to be a hostname
|
||||
if (
|
||||
( $self->{'foreign_host'} =~ /[A-Za-z]/ ) &&
|
||||
( $self->{'foreign_host'} !~ /\:/ )
|
||||
){
|
||||
$self->{'foreign_ptr'}=$self->{'foreign_host'};
|
||||
}
|
||||
if (
|
||||
( $self->{'local_host'} =~ /[A-Za-z]/ ) &&
|
||||
( $self->{'local_host'} !~ /\:/ )
|
||||
){
|
||||
$self->{'local_ptr'}=$self->{'local_host'};
|
||||
}
|
||||
}
|
||||
|
||||
# resolve the UID/username if asked
|
||||
if (
|
||||
defined( $args{'uid_resolve'} ) &&
|
||||
$args{'uid_resolve'} &&
|
||||
defined( $self->{'uid'} )
|
||||
){
|
||||
if ( $self->{'uid'} =~ /^[0-9]+$/ ){
|
||||
eval{
|
||||
my @pwline=getpwuid( $self->{'uid'} );
|
||||
if ( defined( $pwline[0] ) ){
|
||||
$self->{'username'}=$pwline[0];
|
||||
}
|
||||
}
|
||||
}
|
||||
}elsif (
|
||||
defined( $args{'uid_resolve'} ) &&
|
||||
$args{'uid_resolve'} &&
|
||||
defined( $self->{'username'} ) &&
|
||||
( ! defined( $self->{'uid'} ) )
|
||||
){
|
||||
if ( $self->{'uid'} =~ /^[0-9]+$/ ){
|
||||
eval{
|
||||
my @pwline=getpwnam( $self->{'username'} );
|
||||
if ( defined( $pwline[2] ) ){
|
||||
$self->{'username'}=$pwline[2];
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $self;
|
||||
}
|
||||
|
||||
=head2 function2
|
||||
=head2 foreign_host
|
||||
|
||||
Returns the foreign host.
|
||||
|
||||
my $f_host=$conn->foreign_host;
|
||||
|
||||
=cut
|
||||
|
||||
sub function2 {
|
||||
sub foreign_host{
|
||||
return $_[0]->{'foreign_host'};
|
||||
}
|
||||
|
||||
=head2 foreign_port
|
||||
|
||||
This returns the foreign port.
|
||||
|
||||
my $f_port=$conn->foreign_port;
|
||||
|
||||
=cut
|
||||
|
||||
sub foreign_port{
|
||||
return $_[0]->{'foreign_port'};
|
||||
}
|
||||
|
||||
=head2 foreign_port_name
|
||||
|
||||
This returns the foreign port name.
|
||||
|
||||
This may potentially return undef if one is
|
||||
not set/unknown.
|
||||
|
||||
my $f_port=$conn->foreign_port;
|
||||
|
||||
=cut
|
||||
|
||||
sub foreign_port_name{
|
||||
return $_[0]->{'foreign_port_name'};
|
||||
}
|
||||
|
||||
=head2 foreign_ptr
|
||||
|
||||
This returns the PTR for the foreign host.
|
||||
|
||||
If one was not supplied or if it could not be found
|
||||
if resolving was enabled then undef will be returned.
|
||||
|
||||
my $f_ptr=$conn-<foreign_ptr;
|
||||
|
||||
=cut
|
||||
|
||||
sub foreign_ptr{
|
||||
return $_[0]->{'foreign_ptr'};
|
||||
}
|
||||
|
||||
=head2 local_host
|
||||
|
||||
Returns the local host.
|
||||
|
||||
my $l_host=$conn->local_host;
|
||||
|
||||
=cut
|
||||
|
||||
sub local_host{
|
||||
return $_[0]->{'local_host'};
|
||||
}
|
||||
|
||||
=head2 local_port
|
||||
|
||||
This returns the local port.
|
||||
|
||||
my $l_port=$conn->local_port;
|
||||
|
||||
=cut
|
||||
|
||||
sub local_port{
|
||||
return $_[0]->{'local_port'};
|
||||
}
|
||||
|
||||
=head2 foreign_port_name
|
||||
|
||||
This returns the local port name.
|
||||
|
||||
This may potentially return undef if one is
|
||||
not set/unknown.
|
||||
|
||||
my $l_port=$conn->local_port;
|
||||
|
||||
=cut
|
||||
|
||||
sub local_port_name{
|
||||
return $_[0]->{'local_port_name'};
|
||||
}
|
||||
|
||||
=head2 proto
|
||||
|
||||
Returns the protocol in use by the connection.
|
||||
|
||||
Please note this value with vary slightly between OSes.
|
||||
|
||||
my $proto=$conn->proto;
|
||||
|
||||
=cut
|
||||
|
||||
sub proto{
|
||||
return $_[0]->{'proto'};
|
||||
}
|
||||
|
||||
=head2 state
|
||||
|
||||
Returns the state the connection is currently in.
|
||||
|
||||
Please note this value with vary slightly between OSes.
|
||||
|
||||
my $state=$conn->state;
|
||||
|
||||
=cut
|
||||
|
||||
sub state{
|
||||
return $_[0]->{'state'};
|
||||
}
|
||||
|
||||
=head2 uid
|
||||
|
||||
Returns the UID that has the connection.
|
||||
|
||||
This may not be if it was not set. Please see new
|
||||
for more information.
|
||||
|
||||
my $uid=$conn->uid;
|
||||
|
||||
=cut
|
||||
|
||||
sub uid{
|
||||
return $_[0]->{'uid'};
|
||||
}
|
||||
|
||||
=head2 username
|
||||
|
||||
Returns the username that has the connection.
|
||||
|
||||
This may not be if it was not set. Please see new
|
||||
for more information.
|
||||
|
||||
my $username=$conn->username;
|
||||
|
||||
=cut
|
||||
|
||||
sub username{
|
||||
return $_[0]->{'username'};
|
||||
}
|
||||
|
||||
=head1 AUTHOR
|
||||
|
|
Loading…
Reference in New Issue