This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Initial integration of libnet-1.0703.
[perl5.git] / 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 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