/usr/share/doc/lsof/examples/identd.perl5 is in lsof 4.86+dfsg-1.
This file is owned by root:root, with mode 0o755.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 | #!/usr/bin/perl
###################################################################
# identd.perl5 : An implementation of RFC 1413 Ident Server
# using Vic Abell's lsof.
#
# - Started from inetd with 'nowait' option. This entry in
# /etc/inetd.conf will suffice :
#
# ident stream tcp nowait root /usr/local/bin/identd.perl5 -t200
#
# - Multiple instances of the server are not a performance penalty
# since they shall use lsof's cacheing mechanism. (compare with
# Peter Eriksson's pidentd)
# - assumes 'lsof' binary in $PATH
# - Command line arguments :
# -t TIMEOUT Number of seconds to wait for a query before aborting.
# Default is 120.
#
# Kapil Chowksey <kchowksey@hss.hns.com>
###################################################################
use Socket;
require 'getopts.pl';
# Set path to lsof.
if (($LSOF = &isexec("../lsof")) eq "") { # Try .. first
if (($LSOF = &isexec("lsof")) eq "") { # Then try . and $PATH
print "can't execute $LSOF\n"; exit 1
}
}
# redirect lsof's warnings/errors to /dev/null
close(STDERR);
open(STDERR, ">/dev/null");
$Timeout = "120";
&Getopts('t:');
if ($opt_t) {
$Timeout = $opt_t;
}
($port, $iaddr) = sockaddr_in(getpeername(STDIN));
$peer_addr = inet_ntoa($iaddr);
# read ident-query from socket (STDIN) with a timeout.
$timeout = int($Timeout);
eval {
local $SIG{ALRM} = sub { die "alarm\n" };
alarm $timeout;
$query = <STDIN>;
alarm 0;
};
die if $@ && $@ ne "alarm\n";
if ($@) {
# timed out
exit;
}
# remove all white-spaces from query
$query =~ s/\s//g;
$serv_port = "";
$cli_port = "";
($serv_port,$cli_port) = split(/,/,$query);
if ($serv_port =~ /^[0-9]+$/) {
if (int($serv_port) < 1 || int($serv_port) > 65535) {
print $query." : ERROR : INVALID-PORT"."\n";
exit;
}
} else {
print $query." : ERROR : INVALID-PORT"."\n";
exit;
}
if ($cli_port =~ /^[0-9]+$/) {
if (int($cli_port) < 1 || int($cli_port) > 65535) {
print $query." : ERROR : INVALID-PORT"."\n";
exit;
}
} else {
print $query." : ERROR : INVALID-PORT"."\n";
exit;
}
open(LSOFP,"$LSOF -nPDi -T -FLn -iTCP@".$peer_addr.":".$cli_port."|");
$user = "UNKNOWN";
while ($a_line = <LSOFP>) {
# extract user name.
if ($a_line =~ /^L.*/) {
($user) = ($a_line =~ /^L(.*)/);
}
# make sure local port matches.
if ($a_line =~ /^n.*:\Q$serv_port->/) {
print $serv_port.", ".$cli_port." : USERID : UNIX :".$user."\n";
exit;
}
}
print $serv_port.", ".$cli_port." : ERROR : NO-USER"."\n";
## isexec($path) -- is $path executable
#
# $path = absolute or relative path to file to test for executabiity.
# Paths that begin with neither '/' nor '.' that arent't found as
# simple references are also tested with the path prefixes of the
# PATH environment variable.
sub
isexec {
my ($path) = @_;
my ($i, @P, $PATH);
$path =~ s/^\s+|\s+$//g;
if ($path eq "") { return(""); }
if (($path =~ m#^[\/\.]#)) {
if (-x $path) { return($path); }
return("");
}
$PATH = $ENV{PATH};
@P = split(":", $PATH);
for ($i = 0; $i <= $#P; $i++) {
if (-x "$P[$i]/$path") { return("$P[$i]/$path"); }
}
return("");
}
|