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