Compare commits
16 Commits
Author | SHA1 | Date |
---|---|---|
Zane C. B-H | 65c3a237d9 | |
Zane C. B-H | af843ec121 | |
Zane C. B-H | dd3643de9e | |
Zane C. B-H | 8808fe7955 | |
Zane C. B-H | e534739d04 | |
Zane C. B-H | 350a2939b4 | |
Zane C. B-H | 161a8d7b46 | |
Zane C. B-H | 4b41137edf | |
Zane C. B-H | 4c573eaa14 | |
Zane C. B-H | c0370eee3f | |
Zane C. B-H | a839fc6de2 | |
Zane C. B-H | 34a865e864 | |
Zane C. B-H | 51cd8ea0d8 | |
Zane C. B-H | bfbf095e00 | |
Zane C. B-H | 928f9b465e | |
Zane C. B-H | e9dec9c9eb |
|
@ -1,5 +1,31 @@
|
|||
Revision history for Net-Connection-lsof
|
||||
|
||||
0.01 Date/time
|
||||
First version, released on an unsuspecting world.
|
||||
0.3.0 2023-06-01/13:15
|
||||
- Redirect stderr to dev null to prevent pointless warning about kern diffferences from lsof.
|
||||
|
||||
0.2.0 2019-08-16/16:40
|
||||
- WChan support added to Linux.
|
||||
|
||||
0.1.1 2019-08-13/06:00
|
||||
- Only call sysctl on BSD.
|
||||
|
||||
0.1.0 2019-08-12/05:45
|
||||
- Add support for process information.
|
||||
|
||||
0.0.3 2019-08-09/07:30
|
||||
- Add a work around for on some Linux systems
|
||||
where lsof will exit 1 upon successful completion,
|
||||
such as Debian 9.
|
||||
|
||||
0.0.2 2019-07-28/21:45
|
||||
- Properly set uid_resolve.
|
||||
- Actually remove ) from state now.
|
||||
- Properly set if it is 4 or 6 on the protocol.
|
||||
|
||||
0.0.1 2019-07-28/21:10
|
||||
- Some versions of lsof shipped with some linux
|
||||
distros don't support +c so don't use that option.
|
||||
|
||||
0.0.0 2019-07-28/06:40
|
||||
- Initial release.
|
||||
|
||||
|
|
|
@ -17,7 +17,8 @@ my %WriteMakefileArgs = (
|
|||
'Test::More' => '0',
|
||||
},
|
||||
PREREQ_PM => {
|
||||
'Net::Connection' => '0.0.0',
|
||||
'Net::Connection' => '0.2.0',
|
||||
'Proc::ProcessTable' => '0.59',
|
||||
},
|
||||
dist => { COMPRESS => 'gzip -9f', SUFFIX => 'gz', },
|
||||
clean => { FILES => 'Net-Connection-lsof-*' },
|
||||
|
|
|
@ -1,9 +1,11 @@
|
|||
|
||||
package Net::Connection::lsof;
|
||||
|
||||
use 5.006;
|
||||
use strict;
|
||||
use warnings;
|
||||
use Net::Connection;
|
||||
use Proc::ProcessTable;
|
||||
require Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
|
@ -15,11 +17,11 @@ Net::Connection::lsof - This uses lsof to generate a array of Net::Connection ob
|
|||
|
||||
=head1 VERSION
|
||||
|
||||
Version 0.0.0
|
||||
Version 0.3.0
|
||||
|
||||
=cut
|
||||
|
||||
our $VERSION = '0.0.0';
|
||||
our $VERSION = '0.3.0';
|
||||
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
@ -41,7 +43,7 @@ our $VERSION = '0.0.0';
|
|||
|
||||
=head2 lsof_to_nc_objects
|
||||
|
||||
This runs 'lsof -i UDP -i TCP -n -l +c 19 -P' and parses the output
|
||||
This runs 'lsof -i UDP -i TCP -n -l -P' and parses the output
|
||||
returns a array of L<Net::Connection> objects. If a non-zero exit code is
|
||||
returned, it will die.
|
||||
|
||||
|
@ -66,6 +68,12 @@ Defaults to 1.
|
|||
|
||||
Attempt to resolve the UID to a username.
|
||||
|
||||
Defaults to 1.
|
||||
|
||||
=head4 proc_info
|
||||
|
||||
Add assorted process information to the objects.
|
||||
|
||||
Defaults to 1.
|
||||
|
||||
my @objects;
|
||||
|
@ -88,19 +96,49 @@ sub lsof_to_nc_objects{
|
|||
if ( !defined( $func_args{uid_resolve} ) ){
|
||||
$func_args{uid_resolve}=1;
|
||||
}
|
||||
if ( !defined( $func_args{proc_info} ) ){
|
||||
$func_args{proc_info}=1;
|
||||
}
|
||||
|
||||
my $output_raw=`lsof -i UDP -i TCP -n -l +c 19 -P`;
|
||||
if ( $? ne 0 ){
|
||||
die('"lsof -i UDP -i TCP -n -l +c 19 -P" exited with a non-zero value');
|
||||
my $output_raw=`lsof -i UDP -i TCP -n -l -P 2> /dev/null`;
|
||||
if (
|
||||
( $? ne 0 ) &&
|
||||
(
|
||||
( $^O =~ /linux/ ) &&
|
||||
( $? ne 256 )
|
||||
)
|
||||
){
|
||||
die('"lsof -i UDP -i TCP -n -l -P" exited with a non-zero value or in the case of some linux distros a non-1 value');
|
||||
}
|
||||
my @output_lines=split(/\n/, $output_raw);
|
||||
|
||||
my @nc_objects;
|
||||
|
||||
# process info caches
|
||||
my %pid_proc;
|
||||
my %pid_pctmem;
|
||||
my %pid_pctcpu;
|
||||
my %pid_wchan;
|
||||
my %pid_start;
|
||||
|
||||
my $proc_table;
|
||||
my $physmem;
|
||||
if ( $func_args{proc_info} ){
|
||||
my $pt=Proc::ProcessTable->new;
|
||||
$proc_table=$pt->table;
|
||||
if ( $^O =~ /bsd/ ){
|
||||
$physmem=`/sbin/sysctl -a hw.physmem`;
|
||||
chomp( $physmem );
|
||||
$physmem=~s/^.*\: //;
|
||||
}
|
||||
}
|
||||
|
||||
my $line_int=1;
|
||||
while ( defined( $output_lines[$line_int] ) ){
|
||||
my $command=substr $output_lines[$line_int], 0, 19;
|
||||
my $line=substr $output_lines[$line_int], 19;
|
||||
my $command=substr $output_lines[$line_int], 0, 9;
|
||||
my $line=substr $output_lines[$line_int], 10;
|
||||
|
||||
$line=~s/^[\t ]*//;
|
||||
|
||||
my @line_split=split(/[\ \t]+/, $line );
|
||||
|
||||
|
@ -109,9 +147,10 @@ sub lsof_to_nc_objects{
|
|||
uid=>$line_split[1],
|
||||
ports=>$func_args{ports},
|
||||
ptrs=>$func_args{ptrs},
|
||||
uid_resolve=>$func_args{uid_resolve},
|
||||
};
|
||||
|
||||
my $type=$line_split[2];
|
||||
my $type=$line_split[3];
|
||||
my $mode=$line_split[6];
|
||||
my $name=$line_split[7];
|
||||
|
||||
|
@ -120,7 +159,7 @@ sub lsof_to_nc_objects{
|
|||
if ( $type =~ /6/ ){
|
||||
$proto='6';
|
||||
}elsif( $type =~ /4/ ){
|
||||
$proto='6';
|
||||
$proto='4';
|
||||
}
|
||||
if ( $mode =~ /[Uu][Dd][Pp]/ ){
|
||||
$proto='udp'.$proto;
|
||||
|
@ -163,7 +202,73 @@ sub lsof_to_nc_objects{
|
|||
$args->{state}='';
|
||||
if ( defined( $line_split[8] ) ){
|
||||
$args->{state}=$line_split[8];
|
||||
$args->{state}=~s/[\(\)]//;
|
||||
$args->{state}=~s/[\(\)]//g;
|
||||
}
|
||||
|
||||
#
|
||||
# put together process info if requested
|
||||
#
|
||||
if ( $func_args{proc_info} ){
|
||||
if ( defined( $pid_proc{ $args->{pid} } ) ){
|
||||
$args->{proc}=$pid_proc{ $args->{pid} };
|
||||
$args->{wchan}=$pid_wchan{ $args->{pid} };
|
||||
$args->{pctmem}=$pid_pctmem{ $args->{pid} };
|
||||
$args->{pctcpu}=$pid_pctcpu{ $args->{pid} };
|
||||
$args->{pid_start}=$pid_start{ $args->{pid} };
|
||||
}else{
|
||||
my $loop=1;
|
||||
my $proc_int=0;
|
||||
while(
|
||||
defined( $proc_table->[ $proc_int ] ) &&
|
||||
$loop
|
||||
){
|
||||
|
||||
# matched
|
||||
if ( $proc_table->[ $proc_int ]->{pid} eq $args->{pid} ){
|
||||
# exit the loop
|
||||
$loop = 0;
|
||||
|
||||
# fetch and save the proc info
|
||||
if ( $proc_table->[ $proc_int ]->cmndline =~ /^$/ ){
|
||||
# kernel proc
|
||||
$args->{proc}='['.$proc_table->[ $proc_int ]->{fname}.']';
|
||||
}else{
|
||||
# non-kernel proc
|
||||
$args->{proc}=$proc_table->[ $proc_int ]->{cmndline};
|
||||
}
|
||||
$pid_proc{ $args->{pid} }=$args->{proc};
|
||||
|
||||
# linux has shit wchan reporting and apparently if you want more than
|
||||
# the address you need to use the ass backwards /proc
|
||||
if ( $^O =~ /linux/ ){
|
||||
if ( -e '/proc/'.$args->{pid}.'/wchan'){
|
||||
open( my $wchan_fh, '<', '/proc/'.$args->{pid}.'/wchan' );
|
||||
$args->{wchan}=readline( $wchan_fh );
|
||||
close( $wchan_fh );
|
||||
$pid_wchan{ $args->{pid} }=$args->{wchan};
|
||||
}
|
||||
}else{
|
||||
$args->{wchan}=$proc_table->[ $proc_int ]->{wchan};
|
||||
$pid_wchan{ $args->{pid} }=$args->{wchan};
|
||||
}
|
||||
|
||||
$args->{pid_start}=$proc_table->[ $proc_int ]->{pid_start};
|
||||
$pid_start{ $args->{pid} }=$args->{pid_start};
|
||||
|
||||
$args->{pctcpu}=$proc_table->[ $proc_int ]->{pctcpu};
|
||||
$pid_pctcpu{ $args->{pid} }=$args->{pctcpu};
|
||||
|
||||
if ($^O =~ /bsd/){
|
||||
$args->{pctmem}= (( $proc_table->[ $proc_int ]->{rssize} * 1024 * 4 ) / $physmem) * 100;
|
||||
}else{
|
||||
$args->{pctmem}=$proc_table->[ $proc_int ]->{pctmem};
|
||||
}
|
||||
$pid_pctmem{ $args->{pid} }=$args->{pctmem};
|
||||
}
|
||||
|
||||
$proc_int++;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
push( @nc_objects, Net::Connection->new( $args ) );
|
||||
|
@ -202,14 +307,6 @@ You can also look for information at:
|
|||
|
||||
L<https://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-Connection-lsof>
|
||||
|
||||
=item * AnnoCPAN: Annotated CPAN documentation
|
||||
|
||||
L<http://annocpan.org/dist/Net-Connection-lsof>
|
||||
|
||||
=item * CPAN Ratings
|
||||
|
||||
L<https://cpanratings.perl.org/d/Net-Connection-lsof>
|
||||
|
||||
=item * Search CPAN
|
||||
|
||||
L<https://metacpan.org/release/Net-Connection-lsof>
|
||||
|
|
|
@ -11,8 +11,14 @@ BEGIN {
|
|||
}
|
||||
|
||||
|
||||
my $output_raw=`lsof -i UDP -i TCP -n -l +c 19 -P`;
|
||||
if ( $? eq 0 ){
|
||||
my $output_raw=`lsof -i UDP -i TCP -n -l -P 2> /dev/null`;
|
||||
if (
|
||||
( $? eq 0 ) ||
|
||||
(
|
||||
( $^O =~ /linux/ ) &&
|
||||
( $? eq 256 )
|
||||
)
|
||||
){
|
||||
$extra_tests++;
|
||||
my $worked=0;
|
||||
eval{
|
||||
|
|
Loading…
Reference in New Issue