home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / perl_ste.zip / Net / DummyInetd.pm < prev    next >
Text File  |  1997-09-26  |  3KB  |  149 lines
  1. # Net::DummyInetd.pm
  2. #
  3. # Copyright (c) 1995-1997 Graham Barr <gbarr@pobox.com>. All rights reserved.
  4. # This program is free software; you can redistribute it and/or
  5. # modify it under the same terms as Perl itself.
  6.  
  7. package Net::DummyInetd;
  8.  
  9. require 5.002;
  10.  
  11. use IO::Handle;
  12. use IO::Socket;
  13. use strict;
  14. use vars qw($VERSION);
  15. use Carp;
  16.  
  17. $VERSION = do { my @r=(q$Revision: 1.6 $=~/\d+/g); sprintf "%d."."%02d"x$#r,@r};
  18.  
  19.  
  20. sub _process
  21. {
  22.  my $listen = shift;
  23.  my @cmd = @_;
  24.  my $vec = '';
  25.  my $r;
  26.  
  27.  vec($vec,fileno($listen),1) = 1;
  28.  
  29.  while(select($r=$vec,undef,undef,undef))
  30.   {
  31.    my $sock = $listen->accept;
  32.    my $pid;
  33.  
  34.    if($pid = fork())
  35.     {
  36.      sleep 1;
  37.      close($sock);
  38.     }
  39.    elsif(defined $pid)
  40.     {
  41.      my $x =  IO::Handle->new_from_fd($sock,"r");
  42.      open(STDIN,"<&=".fileno($x)) || die "$! $@";
  43.      close($x);
  44.  
  45.      my $y = IO::Handle->new_from_fd($sock,"w");
  46.      open(STDOUT,">&=".fileno($y)) || die "$! $@";
  47.      close($y);
  48.  
  49.      close($sock);
  50.      exec(@cmd) || carp "$! $@";
  51.     }
  52.    else
  53.     {
  54.      close($sock);
  55.      carp $!;
  56.     }
  57.   }
  58.  exit -1; 
  59. }
  60.  
  61. sub new
  62. {
  63.  my $self = shift;
  64.  my $type = ref($self) || $self;
  65.  
  66.  my $listen = IO::Socket::INET->new(Listen => 5, Proto => 'tcp');
  67.  my $pid;
  68.  
  69.  return bless [ $listen->sockport, $pid ]
  70.     if($pid = fork());
  71.  
  72.  _process($listen,@_);
  73. }
  74.  
  75. sub port
  76. {
  77.  my $self = shift;
  78.  $self->[0];
  79. }
  80.  
  81. sub DESTROY
  82. {
  83.  my $self = shift;
  84.  kill 9, $self->[1];
  85. }
  86.  
  87. 1;
  88.  
  89. __END__
  90.  
  91. =head1 NAME
  92.  
  93. Net::DummyInetd - A dummy Inetd server
  94.  
  95. =head1 SYNOPSIS
  96.  
  97.     use Net::DummyInetd;
  98.     use Net::SMTP;
  99.     
  100.     $inetd = new Net::DummyInetd qw(/usr/lib/sendmail -ba -bs);
  101.     
  102.     $smtp  = Net::SMTP->new('localhost', Port => $inetd->port);
  103.  
  104. =head1 DESCRIPTION
  105.  
  106. C<Net::DummyInetd> is just what it's name says, it is a dummy inetd server.
  107. Creation of a C<Net::DummyInetd> will cause a child process to be spawned off
  108. which will listen to a socket. When a connection arrives on this socket
  109. the specified command is fork'd and exec'd with STDIN and STDOUT file
  110. descriptors duplicated to the new socket.
  111.  
  112. This package was added as an example of how to use C<Net::SMTP> to connect
  113. to a C<sendmail> process, which is not the default, via SIDIN and STDOUT.
  114. A C<Net::Inetd> package will be available in the next release of C<libnet>
  115.  
  116. =head1 CONSTRUCTOR
  117.  
  118. =over 4
  119.  
  120. =item new ( CMD )
  121.  
  122. Creates a new object and spawns a child process which listens to a socket.
  123. C<CMD> is a list, which will be passed to C<exec> when a new process needs
  124. to be created.
  125.  
  126. =back
  127.  
  128. =head1 METHODS
  129.  
  130. =over 4
  131.  
  132. =item port
  133.  
  134. Returns the port number on which the I<DummyInetd> object is listening
  135.  
  136. =back
  137.  
  138. =head1 AUTHOR
  139.  
  140. Graham Barr <gbarr@pobox.com>
  141.  
  142. =head1 COPYRIGHT
  143.  
  144. Copyright (c) 1995-1997 Graham Barr. All rights reserved.
  145. This program is free software; you can redistribute it and/or modify
  146. it under the same terms as Perl itself.
  147.  
  148. =cut
  149.