Commit | Line | Data |
406c51ee |
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 | |
022735b4 |
106 | C<Net::DummyInetd> is just what its name says, it is a dummy inetd server. |
406c51ee |
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 |