whitelister/server.ml

97 lines
3.6 KiB
OCaml

(**************************************************************************)
(* *)
(* whitelister : a Whitelister Policy Daemon for Postfix *)
(* ~~~~~~~~~~~ *)
(* *)
(* Copyright (C) 2005 AAEGE.org *)
(* Author : Pierre Habouzit <pierre.habouzit@m4x.org> *)
(* ____________________________________________________________________ *)
(* *)
(* This program is free software; you can redistribute it and/or modify *)
(* it under the terms of the GNU General Public License as published by *)
(* the Free Software Foundation; either version 2 of the License, or *)
(* (at your option) any later version. *)
(* *)
(* This program is distributed in the hope that it will be useful, *)
(* but WITHOUT ANY WARRANTY; without even the implied warranty of *)
(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *)
(* GNU General Public License for more details. *)
(* *)
(* You should have received a copy of the GNU General Public License *)
(* along with this program; if not, write to the Free Software *)
(* Foundation, Inc., *)
(* 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *)
(* *)
(**************************************************************************)
open Unix
let string_of_sockaddr = function
| ADDR_UNIX u -> "unix:"^u
| ADDR_INET (a,p) -> Printf.sprintf "inet:%s:%i" (string_of_inet_addr a) p
let rec unix_do f x =
try f x
with Unix_error(EINTR, _, _) -> unix_do f x
(* pid file stuff *)
let pidfile_fd = ref None
let pidfile_close () =
match !pidfile_fd with
| Some f -> close f; pidfile_fd := None
| None -> ()
let pidfile_open file =
try
pidfile_close ();
pidfile_fd := Some (openfile file [O_WRONLY;O_CREAT;O_TRUNC] 0o644)
with Sys_error _ ->
prerr_endline ("Cannot write my pid in the pidfile "^file);
exit 1
let pidfile_write () =
match !pidfile_fd with
| None ->
prerr_endline ("pidfile is not open, call pidfile_open before pidfile_write");
exit 1
| Some fd ->
ignore (lseek fd 0 SEEK_SET);
ftruncate fd 0;
let pid = Printf.sprintf "%i\n" (getpid()) in
ignore (unix_do (single_write fd pid 0) (String.length pid))
(* server stuff *)
let drop_privs ( user, group ) =
if geteuid () = 0 then (
setgid (getgrnam group).gr_gid;
setuid (getpwnam user).pw_uid
)
let bind_to_sock sockaddr =
(match sockaddr with ADDR_UNIX u -> (try unlink u with _ -> ()) | _ -> ());
let mask = umask 0o111 in
let sock = socket (domain_of_sockaddr sockaddr) SOCK_STREAM 0 in
setsockopt sock SO_REUSEADDR true;
bind sock sockaddr;
listen sock 0;
let _ = umask mask in
sock
let double_fork f x =
match fork () with
| 0 -> if fork () <> 0 then exit 0; f x
| id -> ignore (waitpid [] id)
let daemonize runas server_loop arg =
drop_privs runas;
let dev_null = openfile "/dev/null" [O_WRONLY] 0o666 in
close stdin;
dup2 dev_null stdout;
dup2 dev_null stderr;
close dev_null;
double_fork server_loop arg