lib/Net/DummyInetd.pm

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