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