whitelister/.pc/disable_spf.patch/whitelister.ml

185 lines
7.0 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 *)
(* *)
(**************************************************************************)
(* types *)
type config = {
mutable pidf: string;
mutable sock: Unix.sockaddr;
mutable user: string;
mutable group: string;
mutable verb: int;
mutable spf: Rules.spf_mode;
mutable spfrej: bool;
mutable rbl: string list;
mutable rhbl_client: string list;
mutable rhbl_rcpt: string list;
mutable rhbl_sender: string list;
mutable rhbl_helo: string list;
mutable dns_client: bool;
mutable dns_rev_client: bool;
}
(* Checker *)
let log msg =
let lg = Syslog.openlog ~facility:`LOG_MAIL ~flags:[`LOG_PID] "whitelister" in
Syslog.syslog lg `LOG_INFO msg;
Syslog.closelog lg
let log_event level answer pcy =
log (Policy.log_format level answer pcy)
let checker cfg s =
let oc = Unix.out_channel_of_descr s in
try
while true do
let pcy = Policy.read (Unix.in_channel_of_descr s) in
let ans = (
try
Rules.check_rbl cfg.rbl pcy;
Rules.check_rhbl Rules.Helo cfg.rhbl_helo pcy;
Rules.check_rhbl Rules.Sender cfg.rhbl_sender pcy;
Rules.check_rhbl Rules.Rcpt cfg.rhbl_rcpt pcy;
Rules.check_rhbl Rules.Client cfg.rhbl_client pcy;
Rules.check_spf cfg.spf cfg.spfrej pcy;
Rules.check_dns_client cfg.dns_client pcy;
Rules.check_dns_rev_client cfg.dns_rev_client pcy;
if cfg.verb > 0 then log_event "Clean" "OK" pcy;
"OK"
with
| Rules.Dirty s ->
log_event "Dirty" (Printf.sprintf "DUNNO (%s)" s) pcy;
"DUNNO"
| Rules.Reject s ->
let s' = "REJECT "^s in
log_event "Reject" s' pcy;
s'
) in
Printf.fprintf oc "action=%s\n\n" ans;
flush oc;
Policy.clear pcy (* not needed, but can help the GC *)
done
with _ -> Unix.shutdown s Unix.SHUTDOWN_ALL
(* Configuration *)
let empty_config () = {
pidf = "/var/run/whitelister.pid" ;
sock = Unix.ADDR_INET (Unix.inet_addr_of_string "127.0.0.1", 10000) ;
user = "nobody" ;
group = "nogroup" ;
verb = 0 ;
spf = Rules.Spf_off ;
spfrej = false;
rbl = [] ;
rhbl_client = [] ;
rhbl_rcpt = [] ;
rhbl_sender = [] ;
rhbl_helo = [] ;
dns_client = false;
dns_rev_client = false;
}
let to_bool s =
function
| "0" | "off" | "no" -> false
| "1" | "yes" | "on" -> true
| _ -> prerr_endline ("cannot read a boolean value for `"^s^"', possible values are on/off, yes/no, 1/0"); exit 1
let update_config cfg file =
let ic = open_in file in
try
while true do
let line = input_line ic in
if String.length line > 0 && line.[0] <> '#' then
match Str.split (Str.regexp "[ \t:]+") line with
| [] -> ()
| ["pidf"; f] -> cfg.pidf <- f
| ["sock"; s] -> cfg.sock <- Unix.ADDR_UNIX s
| ["sock"; ip; p] -> cfg.sock <- Unix.ADDR_INET (Unix.inet_addr_of_string ip, int_of_string p)
| ["user"; u] -> cfg.user <- u
| ["group"; g] -> cfg.group <- g
| ["verb"; "0"] -> cfg.verb <- 0
| ["verb"; "1"] -> cfg.verb <- 1
| ["spf"; "0"] -> cfg.spf <- Rules.Spf_off
| ["spf"; "1"] -> cfg.spf <- Rules.Spf_normal
| ["spf"; "2"] -> cfg.spf <- Rules.Spf_strict
| ["spf"; "3"] -> cfg.spf <- Rules.Spf_paranoid
| ["spfrej"; b] -> cfg.spfrej <- to_bool "spfrej" b
| ["rbl"; h] -> cfg.rbl <- h::cfg.rbl
| ["rhbl_client"; h] -> cfg.rhbl_client <- h::cfg.rhbl_client
| ["rhbl_helo"; h] -> cfg.rhbl_helo <- h::cfg.rhbl_helo
| ["rhbl_rcpt"; h] -> cfg.rhbl_rcpt <- h::cfg.rhbl_rcpt
| ["rhbl_sender"; h] -> cfg.rhbl_sender <- h::cfg.rhbl_sender
| ["dns_client"; d] -> cfg.dns_client <- to_bool "dns_client" d
| ["dns_rev_client"; e] -> cfg.dns_rev_client <- to_bool "dns_rev_client" e
(* deprecated settings *)
| ["rhbl"; h] -> prerr_endline "rhbl is deprecated, it defaults to rhbl_client which may not be what you want.";
cfg.rhbl_client <- h::cfg.rhbl_client
| _ -> prerr_string (Printf.sprintf "`%s' is not a valid config line\n" line)
done;
assert false
with End_of_file -> close_in ic; cfg
let read_config () =
let found_files = List.filter Sys.file_exists ["/etc/whitelister.conf" ; "whitelister.conf"] in
List.fold_left update_config (empty_config ()) found_files
(* Server thingies *)
open Server
let my_server_loop cfg sock =
pidfile_write ();
pidfile_close ();
log ("started, listening to " ^ (string_of_sockaddr cfg.sock));
while true do
let s = fst (unix_do Unix.accept sock) in
double_fork (fun s -> Unix.close sock; checker cfg s ; exit 0) s;
Unix.close s
done
(* Main LOOP *)
let _ =
let cfg = read_config () in
pidfile_open cfg.pidf;
pidfile_write ();
daemonize (cfg.user,cfg.group) (my_server_loop cfg) (bind_to_sock cfg.sock)