lib/Net/DummyInetd.pm

   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 its 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