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