Merge from vendor branch LIBSTDC++:
[dragonfly.git] / contrib / sendmail / contrib / smcontrol.pl
1 #!/usr/local/bin/perl -w
2
3 use strict;
4 use Getopt::Std;
5 use FileHandle;
6 use Socket;
7
8 my $sendmailDaemon = "/usr/sbin/sendmail -q30m -bd";
9
10 ##########################################################################
11 #
12 #  &get_controlname -- read ControlSocketName option from sendmail.cf
13 #
14 #       Parameters:
15 #               none.
16 #
17 #       Returns:
18 #               control socket filename, undef if not found
19 #
20
21 sub get_controlname
22 {
23         my $cn = undef;
24         my $qd = undef;
25  
26         open(CF, "</etc/mail/sendmail.cf") or return $cn;
27         while (<CF>)
28         {
29                 chomp;
30                 if (/^O ControlSocketName\s*=\s*([^#]+)$/o)
31                 {
32                         $cn = $1;
33                 }
34                 if (/^O QueueDirectory\s*=\s*([^#]+)$/o)
35                 {
36                         $qd = $1;
37                 }
38                 if (/^OQ([^#]+)$/o)
39                 {
40                         $qd = $1;
41                 }
42         }
43         close(CF);
44         if (not defined $cn)
45         {
46                 return undef;
47         }
48         if ($cn !~ /^\//o)
49         {
50                 return undef if (not defined $qd);
51                 
52                 $cn = $qd . "/" . $cn;
53         }
54         return $cn;
55 }
56
57 ##########################################################################
58 #
59 #  &do_command -- send command to sendmail daemon view control socket
60 #
61 #       Parameters:
62 #               controlsocket -- filename for socket
63 #               command -- command to send
64 #
65 #       Returns:
66 #               reply from sendmail daemon
67 #
68
69 sub do_command
70 {
71         my $controlsocket = shift;
72         my $command = shift;
73         my $proto = getprotobyname('ip');
74         my @reply;
75         my $i;
76
77         socket(SOCK, PF_UNIX, SOCK_STREAM, $proto) or return undef;
78
79         for ($i = 0; $i < 4; $i++)
80         {
81                 if (!connect(SOCK, sockaddr_un($controlsocket)))
82                 {
83                         if ($i == 3)
84                         {
85                                 close(SOCK);
86                                 return undef;
87                         }
88                         sleep 1;
89                         next;
90                 }
91                 last;
92         }
93         autoflush SOCK 1;
94         print SOCK "$command\n";
95         @reply = <SOCK>;
96         close(SOCK);
97         return join '', @reply;
98 }
99
100 ##########################################################################
101 #
102 #  &sendmail_running -- check if sendmail is running via SMTP
103 #
104 #       Parameters:
105 #               none
106 #
107 #       Returns:
108 #               1 if running, undef otherwise
109 #
110
111 sub sendmail_running
112 {
113         my $port = getservbyname("smtp", "tcp") || 25;
114         my $proto = getprotobyname("tcp");
115         my $iaddr = inet_aton("localhost");
116         my $paddr = sockaddr_in($port, $iaddr);
117
118         socket(SOCK, PF_INET, SOCK_STREAM, $proto) or return undef;
119         if (!connect(SOCK, $paddr))
120         {
121                 close(SOCK);
122                 return undef;
123         }
124         autoflush SOCK 1;
125         while (<SOCK>)
126         {
127                 if (/^(\d{3})([ -])/)
128                 {
129                         if ($1 != 220)
130                         {
131                                 close(SOCK);
132                                 return undef;
133                         }
134                 }
135                 else
136                 {
137                         close(SOCK);
138                         return undef;
139                 }
140                 last if ($2 eq " ");
141         }
142         print SOCK "QUIT\n";
143         while (<SOCK>)
144         {
145                 last if (/^\d{3} /);
146         }
147         close(SOCK);
148         return 1;
149 }
150
151 ##########################################################################
152 #
153 #  &munge_status -- turn machine readable status into human readable text
154 #
155 #       Parameters:
156 #               raw -- raw results from sendmail daemon STATUS query
157 #
158 #       Returns:
159 #               human readable text
160 #
161
162 sub munge_status
163 {
164         my $raw = shift;
165         my $cooked = "";
166         my $daemonStatus = "";
167
168         if ($raw =~ /^(\d+)\/(\d+)\/(\d+)\/(\d+)/mg)
169         {
170                 $cooked .= "Current number of children: $1";
171                 if ($2 > 0)
172                 {
173                         $cooked .= " (maximum $2)";
174                 }
175                 $cooked .= "\n";
176                 $cooked .= "QueueDir free disk space (in blocks): $3\n";
177                 $cooked .= "Load average: $4\n";
178         }
179         while ($raw =~ /^(\d+) (.*)$/mg)
180         {
181                 if (not $daemonStatus)
182                 {
183                         $daemonStatus = "(process $1) " . ucfirst($2) . "\n";
184                 }
185                 else
186                 {
187                         $cooked .= "Child Process $1 Status: $2\n";
188                 }
189         }
190         return ($daemonStatus, $cooked);
191 }
192
193 ##########################################################################
194 #
195 #  &start_daemon -- fork off a sendmail daemon
196 #
197 #       Parameters:
198 #               control -- control socket name
199 #
200 #       Returns:
201 #               Error message or "OK" if successful
202 #
203
204 sub start_daemon
205 {
206         my $control = shift;
207         my $pid;
208
209         if ($pid = fork)
210         {
211                 my $exitstat;
212
213                 waitpid $pid, 0 or return "Could not get status of created process: $!\n";
214                 $exitstat = $? / 256;
215                 if ($exitstat != 0)
216                 {
217                         return "sendmail daemon startup exited with exit value $exitstat";
218                 }
219         }
220         elsif (defined $pid)
221         {
222                 exec($sendmailDaemon);
223                 die "Unable to start sendmail daemon: $!.\n";
224         }
225         else
226         {
227                 return "Could not create new process: $!\n";
228         }
229         return "OK\n";
230 }
231
232 ##########################################################################
233 #
234 #  &stop_daemon -- stop the sendmail daemon using control socket
235 #
236 #       Parameters:
237 #               control -- control socket name
238 #
239 #       Returns:
240 #               Error message or status message
241 #
242
243 sub stop_daemon
244 {
245         my $control = shift;
246         my $status;
247
248         if (not defined $control)
249         {
250                 return "The control socket is not configured so the daemon can not be stopped.\n";
251         }
252         return &do_command($control, "SHUTDOWN");
253 }
254
255 ##########################################################################
256 #
257 #  &restart_daemon -- restart the sendmail daemon using control socket
258 #
259 #       Parameters:
260 #               control -- control socket name
261 #
262 #       Returns:
263 #               Error message or status message
264 #
265
266 sub restart_daemon
267 {
268         my $control = shift;
269         my $status;
270
271         if (not defined $control)
272         {
273                 return "The control socket is not configured so the daemon can not be restarted.";
274         }
275         return &do_command($control, "RESTART");
276 }
277
278 ##########################################################################
279 #
280 #  &memdump -- get memdump from the daemon using the control socket
281 #
282 #       Parameters:
283 #               control -- control socket name
284 #
285 #       Returns:
286 #               Error message or status message
287 #
288
289 sub memdump
290 {
291         my $control = shift;
292         my $status;
293
294         if (not defined $control)
295         {
296                 return "The control socket is not configured so the daemon can not be queried for memdump.";
297         }
298         return &do_command($control, "MEMDUMP");
299 }
300
301 ##########################################################################
302 #
303 #  &help -- get help from the daemon using the control socket
304 #
305 #       Parameters:
306 #               control -- control socket name
307 #
308 #       Returns:
309 #               Error message or status message
310 #
311
312 sub help
313 {
314         my $control = shift;
315         my $status;
316
317         if (not defined $control)
318         {
319                 return "The control socket is not configured so the daemon can not be queried for help.";
320         }
321         return &do_command($control, "HELP");
322 }
323
324 my $status = undef;
325 my $daemonStatus = undef;
326 my $opts = {};
327
328 getopts('f:', $opts) || die "Usage: $0 [-f /path/to/control/socket] command\n";
329
330 my $control = $opts->{f} || &get_controlname;
331 my $command = shift;
332
333 if (not defined $control)
334 {
335         die "No control socket available.\n";
336 }
337 if (not defined $command)
338 {
339         die "Usage: $0 [-f /path/to/control/socket] command\n";
340 }
341 if ($command eq "status")
342 {
343         $status = &do_command($control, "STATUS");
344         if (not defined $status)
345         {
346                 # Not responding on control channel, query via SMTP
347                 if (&sendmail_running)
348                 {
349                         $daemonStatus = "Sendmail is running but not answering status queries.";
350                 }
351                 else
352                 {
353                         $daemonStatus = "Sendmail does not appear to be running.";
354                 }
355         }
356         else
357         {
358                 # Munge control channel output
359                 ($daemonStatus, $status) = &munge_status($status);
360         }
361 }
362 elsif (lc($command) eq "shutdown")
363 {
364         $status = &stop_daemon($control);
365 }
366 elsif (lc($command) eq "restart")
367 {
368         $status = &restart_daemon($control);
369 }
370 elsif (lc($command) eq "start")
371 {
372         $status = &start_daemon($control);
373 }
374 elsif (lc($command) eq "memdump")
375 {
376         $status = &memdump($control);
377 }
378 elsif (lc($command) eq "help")
379 {
380         $status = &help($control);
381 }
382 elsif (lc($command) eq "mstat")
383 {
384         $status = &do_command($control, "mstat");
385         if (not defined $status)
386         {
387                 # Not responding on control channel, query via SMTP
388                 if (&sendmail_running)
389                 {
390                         $daemonStatus = "Sendmail is running but not answering status queries.";
391                 }
392                 else
393                 {
394                         $daemonStatus = "Sendmail does not appear to be running.";
395                 }
396         }
397 }
398 else
399 {
400         die "Unrecognized command $command\n";
401 }
402 if (defined $daemonStatus)
403 {
404         print "Daemon Status: $daemonStatus\n";
405 }
406 if (defined $status)
407 {
408         print "$status\n";
409 }
410 else
411 {
412         die "No response\n";
413 }