@@ -2,7 +2,7 @@ use strict;
use warnings;
use Module::Build;
-if ($^O =~ m/^(?:mswin32|dos|macos|os2|cygwin|v[mo]s|riscos|amigaos|beos|mpeix)$/) {
+if ($^O =~ m/^(?:mswin32|dos|macos|os2|cygwin|v[mo]s|riscos|amigaos|beos|mpeix)$/i) {
die "NA: OS unsupported , lsof is not available for OS $^O, no point installing this module\n";
}
@@ -1,5 +1,23 @@
Revision history for Unix-Lsof
+0.1.0 Wed 11 20 11:41:00 2013
+ - Minuscule update to support task IDs
+ - bumped version number to 0.1.0 because no serious bug reports in 4 years
+
+0.0.9 Fri 07 24 15:29:00 2009
+ - Fixed failing tests ID 4752286, 4745065, 4740865 (removed skip for Test::Warn on a test file)
+
+0.0.8 Wed 07 22 11:49:00 2009
+ - Fixed RT bug 46009 by removing workaround introduced in 0.0.6 and replacing it with correct parsing
+ - Changed parse_lsof_output to accept raw output in a scalar instead of pre-split array reference
+
+0.0.7 Wed 03 25 17:23:00 2009
+ - Additional test and fix for 43394
+
+0.0.6 Tue 03 17 11:28:00 2009
+ - Fixed RT bugs 41016 and 43394 by working around broken lsof output
+ - Documentation fixes
+
0.0.5 Mon 09 01 17:55:00 2008
- Fixed test failures
@@ -8,5 +8,6 @@ lib/Unix/Lsof.pm
lib/Unix/Lsof/Result.pm
t/10.procedural.t
t/20.lsof-result.t
+t/30.parse_lsof_output.t
t/pod-coverage.t
t/pod.t
@@ -1,13 +1,24 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Unix-Lsof
-version: v0.0.5
-version_from: lib/Unix/Lsof.pm
-installdirs: site
+--- #YAML:1.0
+name: Unix-Lsof
+version: 0.1.0
+abstract: Wrapper to the Unix lsof utility
+author:
+ - Marc Beyer <japh@tirwhan.org>
+license: unknown
+distribution_type: module
+configure_requires:
+ ExtUtils::MakeMaker: 0
+build_requires:
+ ExtUtils::MakeMaker: 0
requires:
- IPC::Run3: 0
- Test::More: 0
- version: 0
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30_01
+ IPC::Run3: 0
+ Test::More: 0
+ version: 0
+no_index:
+ directory:
+ - t
+ - inc
+generated_by: ExtUtils::MakeMaker version 6.57_05
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
@@ -3,7 +3,7 @@ use warnings;
use 5.008;
use ExtUtils::MakeMaker;
-if ($^O =~ m/^(?:mswin32|dos|macos|os2|cygwin|v[mo]s|riscos|amigaos|beos|mpeix)$/) {
+if ($^O =~ m/^(?:mswin32|dos|macos|os2|cygwin|v[mo]s|riscos|amigaos|beos|mpeix)$/i) {
die "NA: OS unsupported , lsof is not available for OS $^O, no point installing this module\n";
}
@@ -30,7 +30,7 @@ None.
COPYRIGHT AND LICENCE
-Copyright (C) 2008, Marc Beyer
+Copyright (C) 2008,2009 Marc Beyer
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
@@ -1,7 +1,7 @@
package Unix::Lsof::Result;
use 5.008;
-use version; our $VERSION = qv('0.0.5');
+use version; our $VERSION = qv('0.1.0');
use warnings;
use strict;
@@ -294,7 +294,7 @@ Unix::Lsof::Result - Perlish interface to lsof output
=head1 VERSION
-This document describes Unix::Lsof::Result version 0.0.5
+This document describes Unix::Lsof::Result version 0.1.0
=head1 SYNOPSIS
@@ -692,7 +692,7 @@ Marc Beyer C<< <japh@tirwhan.org> >>
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2008, Marc Beyer C<< <japh@tirwhan.org> >>. All rights reserved.
+Copyright (c) 2008-2013,2009, Marc Beyer C<< <japh@tirwhan.org> >>. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
@@ -1,7 +1,7 @@
package Unix::Lsof;
use 5.008;
-use version; our $VERSION = qv('0.0.5');
+use version; our $VERSION = qv('0.1.0');
use warnings;
use strict;
@@ -21,15 +21,16 @@ our %op_field = (
D => q(major/minor device number),
f => q(file descriptor),
F => q(structure address),
+ g => q(process group id),
G => q(flags),
i => q(inode number),
k => q(link count),
+ K => q(task id),
l => q(lock status),
L => q(login name),
n => q(file name),
N => q(node identifier),
o => q(file offset),
- g => q(process group id),
p => q(process id),
P => q(protocol name),
r => q(raw device number),
@@ -39,7 +40,9 @@ our %op_field = (
t => q(file type),
T => q(tcp/tpi info),
u => q(user id),
- z => q(zone name)
+ z => q(zone name),
+ Z => q(selinux security context),
+
);
our %tcptpi_field = (
@@ -73,20 +76,20 @@ sub lsof {
_idie("$opt{binary} is not an executable binary: $!");
}
- my ( @out);
+ my $out="";
- eval { run3( [ $opt{binary}, "-F0", @arg ], \undef, \@out, \$err ); };
+ eval { run3( [ $opt{binary}, "-F0", @arg ], \undef, \$out, \$err ); };
if ($@) {
$err = $err ? $@ . $err : $@;
}
- my $parsed = _parse_lsof_output( \@out );
+ my $parsed = _parse_lsof_output( $out );
if (wantarray) {
return ( $parsed, $err );
} else {
- return Unix::Lsof::Result->_new( $parsed, $err, \@out,\%opt );
+ return Unix::Lsof::Result->_new( $parsed, $err, $out,\%opt );
}
}
@@ -133,7 +136,7 @@ sub _find_binary {
my $bin;
PATHLOOP:
for my $p (@path) {
- if ( -e $p . "/lsof" ) {
+ if ( -f $p . "/lsof" && -x _ ) {
$bin = $p . "/lsof";
last PATHLOOP;
}
@@ -161,20 +164,26 @@ sub _construct_parameters {
}
sub _parse_lsof_output {
- my $output = shift;
- my ( %result, $pid );
-
- for my $line (@$output) {
+ my $out = shift;
+ my ( %result, $pid, $previous );
+ my @output = split (/\000\012/, $out);
+ for my $line (@output) {
+ $line =~ s/^[\s\0]*//;
my @elements = split( "\0", $line );
- my $first = $elements[0];
- if ( $first =~ m/^p(\d+)$/ ) {
- $pid = $1;
+ my ($ident,$content) = ( $elements[0] =~ m/^(\w)(.*)$/ );
+ if ( !$ident ) {
+ _idie("Can't parse line $line, identifier missing");
+ } elsif ($ident eq "p") {
+ $pid = $content;
$result{$pid} = _parseelements( \@elements );
- } elsif ( $first =~ m/^f(.*)$/ ) {
+ $previous = $ident;
+ } elsif ( $ident eq "f" ) {
push @{ $result{$pid}{files} }, _parseelements( \@elements );
+ $previous = $ident;
} else {
- _idie("Can't parse line $line");
+ _idie("Can't parse line $line, operator field $ident is not valid");
}
+
}
return \%result;
@@ -183,8 +192,12 @@ sub _parse_lsof_output {
sub parse_lsof_output {
my @args = @_;
$err = undef;
- _parse_opt(\@args);
- return _parse_lsof_output(@args)
+ if (ref($args[0]) eq ref([])) {
+ my $str = join("\000\012",@{$args[0]});
+ return _parse_lsof_output($str);
+ } else {
+ return _parse_lsof_output($args[0]);
+ }
}
sub _parseelements {
@@ -205,7 +218,9 @@ sub _parseelements {
$result{ $op_field{$fident} }{ $key } = $fc;
}
} else {
+# warn $fident. " - ".$op_field{$fident}." - ".$content;
$result{ $op_field{$fident} } = $content;
+# exit;
}
}
return \%result;
@@ -221,7 +236,7 @@ Unix::Lsof - Wrapper to the Unix lsof utility
=head1 VERSION
-This document describes Unix::Lsof version 0.0.5
+This document describes Unix::Lsof version 0.1.0
=head1 SYNOPSIS
@@ -345,8 +360,9 @@ Process field names are:
"process id"
"process group id"
"parent pid"
+ "task id"
"user id"
-
+
File field names are:
"access mode"
@@ -370,6 +386,7 @@ File field names are:
"tcp/tpi info"
"user id"
"zone name"
+ "selinux security context"
Special mention needs to be made of the field "tcp/tpi info", since that will
contain a list of information. Therefore, the value for this field is itself a
@@ -390,9 +407,12 @@ man page for more.
=item parse_lsof_output ( <STRING> )
-This function takes the raw output as obtained from the lsof binary (with the
--F0 option) and parses it into the data structure explained above. It does
-B<not> understand the lsof STDERR output.
+This function takes the output as obtained from the lsof binary (with the
+-F0 option) and parses it into the data structure explained above. You need to
+pass the lsof STDOUT output in as a single string. Previous behaviour (passing
+the output as an array reference with one line of output per array element) is
+deprecated as of Unix::Lsof version 0.0.8 and may not work in future releases.
+C<parse_lsof_output> does B<not> understand the lsof STDERR output.
=item OPTIONS
@@ -451,6 +471,23 @@ get this from calling C<lsof()> it is almost certainly a bug, please let me know
so I can fix it. If you encountered it from running C<parse_lsof_output>, please
make sure that the output was obtained from running lsof with the -F0 option.
+=item C<< Adding results of this line to process set for PID %s >>
+
+Appears in conjunction with the "invalid field identifier" warning
+and show that the incorrect output was encountered in a process set.
+
+=item C<< Adding results of this line to file set line >>
+
+Appears in conjunction with the "invalid field identifier" warning
+and show that the incorrect output was encountered in a field set.
+
+=item C<< Previous record neither a process nor file set, identifier was "%s" >>
+
+Appears in conjunction with the "invalid field identifier" warning, something else
+has gone wrong and we were unable to work around it. Please send a bug report to
+C<bug-unix-lsof@rt.cpan.org>.
+
+
=back
@@ -513,7 +550,7 @@ Marc Beyer C<< <japh@tirwhan.org> >>
=head1 LICENCE AND COPYRIGHT
-Copyright (c) 2008, Marc Beyer C<< <japh@tirwhan.org> >>. All rights reserved.
+Copyright (c) 2008-2013, Marc Beyer C<< <japh@tirwhan.org> >>. All rights reserved.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself. See L<perlartistic>.
@@ -1,6 +1,6 @@
use Test::More;
use IO::Socket::INET;
-use Fatal qw(open close unlink link);
+use Fatal qw(open close unlink symlink);
use strict;
use warnings;
@@ -0,0 +1,57 @@
+use Test::More;
+
+use strict;
+use warnings;
+
+my $hasnt_test_nowarnings;
+my $hasnt_test_warn;
+
+BEGIN {
+
+ use Unix::Lsof qw(parse_lsof_output);
+ my $SKIP = Unix::Lsof::_find_binary();
+
+ if (!$SKIP) {
+ plan skip_all => q{lsof not found in $PATH, please install it (see ftp://lsof.itap.purdue.edu/pub/tools/unix/lsof)};
+ } else {
+ plan tests => 10;
+ }
+ use_ok( 'Unix::Lsof' );
+ eval ' require Test::NoWarnings;';
+ $hasnt_test_nowarnings = 1 if $@;
+ eval 'use Test::Warn';
+ $hasnt_test_warn = 1 if $@;
+}
+
+my @lsof_result;
+
+
+my $lrs;
+
+ok ( $lrs = parse_lsof_output(["p1111\0g22222\0R3333\0carthur\0u42\0Lzaphod\0","f8\0ar\0l \0tREG\0"]),
+ "Successfully parsed known good lsof output");
+
+
+ok (exists $lrs->{1111},"Correct process number reported");
+
+ok ( $lrs = parse_lsof_output("p1111\0g22222\0R3333\0carthur\0u42\0Lzaphod\0\012f8\0ar\0l \0tREG\0"),
+ "Successfully parsed known good lsof output in a string");
+
+
+ok (exists $lrs->{1111},"Correct process number reported");
+
+
+# These tests are for the output which caused RT bug numbers 41016 and 43394
+ok ( $lrs = parse_lsof_output("p1111\0Zerror message\012g22222\0R3333\0cford\0u42\0Lzaphod\0\012f8\0ar\0l \0tREG\0"),
+ "Recognizes line breaks without NUL terminator");
+
+is ($lrs->{1111}->{"command name"},"ford","Correct command name from second line reported");
+
+ok ( $lrs = parse_lsof_output("p1111\0Zerror message\0g22222\0R3333\0cford\0u42\0Lzaphod\0\012f8\0ar\0l \0nnewline\0tREG\0i4242"),
+ "Survives with malformed result in file set");
+is ($lrs->{1111}{files}[0]{"inode number"},4242,"Correct inode reported");
+
+SKIP: {
+ skip "Test::NoWarnings not installed", 1 if $hasnt_test_nowarnings;
+ Test::NoWarnings->had_no_warnings();
+}