Skip to content
This repository
Newer
Older
100755 270 lines (231 sloc) 7.454 kb
29ac2860 » aqua
2004-06-28 - Enable taint checking
1 #!/usr/bin/perl -Tw
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
2 # Copyright (c) 2001 Ask Bjoern Hansen. See the LICENSE file for details.
3 # The "command dispatch" system is taken from colobus - http://trainedmonkey.com/colobus/
4 #
5 # For more information see http://develooper.com/code/qpsmtpd/
6 #
7 #
8
9 use lib 'lib';
10 use Qpsmtpd::TcpServer;
11 use Qpsmtpd::Constants;
12 use IO::Socket;
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
13 use IO::Select;
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
14 use Socket;
29ac2860 » aqua
2004-06-28 - Enable taint checking
15 use Getopt::Long;
f84bd186 » Matt Sergeant
2004-03-18 Slightly better signal handling - may help stability issues for some …
16 use POSIX qw(:sys_wait_h :errno_h :signal_h);
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
17 use strict;
18 $| = 1;
19
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
20 # Configuration
1e68345c » aqua
2005-07-06 Clean up whitespace (mainloop had a swath of 4-space indentation, whi…
21 my $MAXCONN = 15; # max simultaneous connections
22 my $PORT = 2525; # port number
23 my @LOCALADDR; # ip address(es) to bind to
24 my $USER = 'smtpd'; # user to suid to
25 my $MAXCONNIP = 5; # max simultaneous connections from one IP
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
26 my $PID_FILE = '';
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
27
29ac2860 » aqua
2004-06-28 - Enable taint checking
28 sub usage {
29 print <<"EOT";
30 usage: qpsmtpd-forkserver [ options ]
1fbfe515 » aqua
2005-07-06 Implement listening on multiple local addresses simultaneously, if sp…
31 -l, --listen-address addr : listen on specific address(es); can be specified
32 multiple times for multiple bindings. Default is
33 0.0.0.0 (all interfaces).
22a1d999 » rspier
2004-11-29 From: Jim Winstead
34 -p, --port P : listen on a specific port; default 2525
29ac2860 » aqua
2004-06-28 - Enable taint checking
35 -c, --limit-connections N : limit concurrent connections to N; default 15
28471446 » aqua
2005-06-29 Fix typo in forkserver commandline help
36 -u, --user U : run as a particular user (default 'smtpd')
22a1d999 » rspier
2004-11-29 From: Jim Winstead
37 -m, --max-from-ip M : limit connections from a single IP; default 5
03f8c0d2 » abh
2005-07-04
38 --pid-file P : print main servers PID to file P
29ac2860 » aqua
2004-06-28 - Enable taint checking
39 EOT
40 exit 0;
41 }
42
43 GetOptions('h|help' => \&usage,
1fbfe515 » aqua
2005-07-06 Implement listening on multiple local addresses simultaneously, if sp…
44 'l|listen-address=s' => \@LOCALADDR,
29ac2860 » aqua
2004-06-28 - Enable taint checking
45 'c|limit-connections=i' => \$MAXCONN,
22a1d999 » rspier
2004-11-29 From: Jim Winstead
46 'm|max-from-ip=i' => \$MAXCONNIP,
29ac2860 » aqua
2004-06-28 - Enable taint checking
47 'p|port=i' => \$PORT,
03f8c0d2 » abh
2005-07-04
48 'u|user=s' => \$USER,
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
49 'pid-file=s' => \$PID_FILE,
03f8c0d2 » abh
2005-07-04
50 ) || &usage;
29ac2860 » aqua
2004-06-28 - Enable taint checking
51
52 # detaint the commandline
53 if ($PORT =~ /^(\d+)$/) { $PORT = $1 } else { &usage }
1fbfe515 » aqua
2005-07-06 Implement listening on multiple local addresses simultaneously, if sp…
54 @LOCALADDR = ( '0.0.0.0' ) if !@LOCALADDR;
55 for (0..$#LOCALADDR) {
56 if ($LOCALADDR[$_] =~ /^([\d\w\-.]+)$/) {
57 $LOCALADDR[$_] = $1;
58 } else {
59 &usage;
60 }
61 }
29ac2860 » aqua
2004-06-28 - Enable taint checking
62 if ($USER =~ /^([\w\-]+)$/) { $USER = $1 } else { &usage }
63 if ($MAXCONN =~ /^(\d+)$/) { $MAXCONN = $1 } else { &usage }
64
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
65 delete $ENV{ENV};
66 $ENV{PATH} = '/bin:/usr/bin:/var/qmail/bin';
67
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
68 my %childstatus = ();
69
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
70 sub REAPER {
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
71 while ( defined(my $chld = waitpid(-1, WNOHANG)) ){
72 last unless $chld > 0;
e331f6b2 » John Peacock
2005-03-24 Add plugable logging support include sample plugin which replicates the
73 ::log(LOGINFO,"cleaning up after $chld");
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
74 delete $childstatus{$chld};
75 }
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
76 }
77
5d409640 » Matt Sergeant
2004-06-16 Make signal handling slightly more stable
78 sub HUNTSMAN {
79 $SIG{CHLD} = 'DEFAULT';
80 kill 'INT' => keys %childstatus;
81 exit(0);
82 }
83
84 $SIG{INT} = \&HUNTSMAN;
85 $SIG{TERM} = \&HUNTSMAN;
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
86
1fbfe515 » aqua
2005-07-06 Implement listening on multiple local addresses simultaneously, if sp…
87 my $select = new IO::Select;
88
89 # establish SERVER socket(s), bind and listen.
90 for my $listen_addr (@LOCALADDR) {
91 my $server = IO::Socket::INET->new(LocalPort => $PORT,
92 LocalAddr => $listen_addr,
93 Proto => 'tcp',
94 Reuse => 1,
95 Blocking => 0,
96 Listen => SOMAXCONN )
97 or die "Creating TCP socket $listen_addr:$PORT: $!\n";
98 IO::Handle::blocking($server, 0);
99 $select->add($server);
100 }
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
101
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
102 if ($PID_FILE) {
103 if ($PID_FILE =~ m#^(/[\w\d/\-.]+)$#) { $PID_FILE = $1 } else { &usage }
104 if (-e $PID_FILE) {
105 open PID, "+<$PID_FILE"
106 or die "open pid_file: $!\n";
107 my $running_pid = <PID>; chomp $running_pid;
108 if ($running_pid =~ /(\d+)/) {
109 $running_pid = $1;
110 if (kill 0, $running_pid) {
111 die "Found an already running qpsmtpd with pid $running_pid.\n";
112 }
03f8c0d2 » abh
2005-07-04
113 }
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
114 seek PID, 0, 0
115 or die "Could not seek back to beginning of $PID_FILE: $!\n";
116 } else {
117 open PID, ">$PID_FILE"
118 or die "open pid_file: $!\n";
03f8c0d2 » abh
2005-07-04
119 }
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
120 print PID $$,"\n";
121 close PID;
03f8c0d2 » abh
2005-07-04
122 }
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
123
124 # Load plugins here
125 my $qpsmtpd = Qpsmtpd::TcpServer->new();
126 $qpsmtpd->load_plugins;
03f8c0d2 » abh
2005-07-04
127
128 # Drop privileges
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
129 my (undef, undef, $quid, $qgid) = getpwnam $USER or
130 die "unable to determine uid/gid for $USER\n";
03f8c0d2 » abh
2005-07-04
131 my $groups = "$qgid $qgid";
132 while (my ($name,$passwd,$gid,$members) = getgrent()) {
133 my @m = split(/ /, $members);
134 if (grep {$_ eq $USER} @m) {
135 ::log(LOGINFO,"$USER is member of group $name($gid)");
136 $groups .= " $gid";
137 }
138 }
139 $) = $groups;
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
140 POSIX::setgid($qgid) or
141 die "unable to change gid: $!\n";
142 POSIX::setuid($quid) or
143 die "unable to change uid: $!\n";
144 $> = $quid;
145
e331f6b2 » John Peacock
2005-03-24 Add plugable logging support include sample plugin which replicates the
146 ::log(LOGINFO,"Listening on port $PORT");
147 ::log(LOGINFO, 'Running as user '.
148 (getpwuid($>) || $>) .
149 ', group '.
150 (getgrgid($)) || $)));
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
151
152 while (1) {
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
153 REAPER();
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
154 my $running = scalar keys %childstatus;
314625d0 » Matt Sergeant
2005-07-05 Another small cleanup
155 if ($running >= $MAXCONN) {
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
156 ::log(LOGINFO,"Too many connections: $running >= $MAXCONN. Waiting one second.");
4b72a401 » Matt Sergeant
2005-07-05 Minor cleanup
157 sleep(1);
158 next;
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
159 }
1fbfe515 » aqua
2005-07-06 Implement listening on multiple local addresses simultaneously, if sp…
160 my @ready = $select->can_read(1);
161 next if !@ready;
162 my $server = shift @ready;
163
164 my ($client, $hisaddr) = $server->accept;
165
1e68345c » aqua
2005-07-06 Clean up whitespace (mainloop had a swath of 4-space indentation, whi…
166 if (!$hisaddr) {
167 # possible something condition...
168 next;
169 }
170 IO::Handle::blocking($client, 1);
171 my ($port, $iaddr) = sockaddr_in($hisaddr);
172 if ($MAXCONNIP) {
173 my $num_conn = 1; # seed with current value
174
175 foreach my $rip (values %childstatus) {
176 ++$num_conn if (defined $rip && $rip eq $iaddr);
b82536df » Matt Sergeant
2004-07-05 Support per-IP throttling (Hanno Hecker <hah@uu-x.de>)
177 }
1e68345c » aqua
2005-07-06 Clean up whitespace (mainloop had a swath of 4-space indentation, whi…
178
179 if ($num_conn > $MAXCONNIP) {
180 my $rem_ip = inet_ntoa($iaddr);
181 ::log(LOGINFO,"Too many connections from $rem_ip: "
182 ."$num_conn > $MAXCONNIP. Denying connection.");
183 $client->autoflush(1);
184 print $client "451 Sorry, too many connections from $rem_ip, try again later\r\n";
185 close $client;
186 next;
f84bd186 » Matt Sergeant
2004-03-18 Slightly better signal handling - may help stability issues for some …
187 }
1e68345c » aqua
2005-07-06 Clean up whitespace (mainloop had a swath of 4-space indentation, whi…
188 }
189 my $pid = safe_fork();
190 if ($pid) {
191 # parent
192 $childstatus{$pid} = $iaddr; # add to table
193 # $childstatus{$pid} = 1; # add to table
194 $running++;
195 close($client);
196 next;
197 }
198 # otherwise child
199
200 # all children should have different seeds, to prevent conflicts
201 srand( time ^ ($$ + ($$ << 15)) );
202
203 close($server);
204
205 $SIG{$_} = 'DEFAULT' for keys %SIG;
206 $SIG{ALRM} = sub {
207 print $client "421 Connection Timed Out\n";
208 ::log(LOGINFO, "Connection Timed Out");
209 exit; };
210
211 my $localsockaddr = getsockname($client);
212 my ($lport, $laddr) = sockaddr_in($localsockaddr);
213 $ENV{TCPLOCALIP} = inet_ntoa($laddr);
214 # my ($port, $iaddr) = sockaddr_in($hisaddr);
215 $ENV{TCPREMOTEIP} = inet_ntoa($iaddr);
216 $ENV{TCPREMOTEHOST} = gethostbyaddr($iaddr, AF_INET) || "Unknown";
217
218 # don't do this!
219 #$0 = "qpsmtpd-forkserver: $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}";
220
221 ::log(LOGINFO, "Accepted connection $running/$MAXCONN from $ENV{TCPREMOTEIP} / $ENV{TCPREMOTEHOST}");
222
223 # dup to STDIN/STDOUT
224 POSIX::dup2(fileno($client), 0);
225 POSIX::dup2(fileno($client), 1);
226
227 $qpsmtpd->start_connection
228 (
229 local_ip => $ENV{TCPLOCALIP},
230 local_port => $lport,
231 remote_ip => $ENV{TCPREMOTEIP},
232 remote_port => $port,
233 );
234 $qpsmtpd->run();
235
236 exit; # child leaves
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
237 }
238
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
239 sub log {
240 my ($level,$message) = @_;
66200343 » John Peacock
2005-05-25 * qpsmtpd-forkserver
241 $qpsmtpd->log($level,$message);
d8c8d40e » rspier
2004-04-15 - move configuration to top. (still suboptimal)
242 }
243
698fc015 » Matt Sergeant
2005-07-05 Make pid-file optional
244 ### routine to protect process during fork
245 sub safe_fork {
246
247 ### block signal for fork
248 my $sigset = POSIX::SigSet->new(SIGINT);
249 POSIX::sigprocmask(SIG_BLOCK, $sigset)
250 or die "Can't block SIGINT for fork: [$!]\n";
251
252 ### fork off a child
253 my $pid = fork;
254 unless( defined $pid ){
255 die "Couldn't fork: [$!]\n";
256 }
257
258 ### make SIGINT kill us as it did before
259 $SIG{INT} = 'DEFAULT';
260
261 ### put back to normal
262 POSIX::sigprocmask(SIG_UNBLOCK, $sigset)
263 or die "Can't unblock SIGINT for fork: [$!]\n";
264
265 return $pid;
266 }
267
04dacc44 » Matt Sergeant
2004-03-15 Pure perl forking qpsmtpd
268 __END__
269
270 1;
Something went wrong with that request. Please try again.