master
Gregory Colpart 8 years ago
commit f570931b5b

@ -0,0 +1,11 @@
policy.cmo: policy.cmi
policy.cmx: policy.cmi
rules.cmo: spf.cmi policy.cmi rules.cmi
rules.cmx: spf.cmx policy.cmx rules.cmi
server.cmo: server.cmi
server.cmx: server.cmi
spf.cmo: spf.cmi
spf.cmx: spf.cmi
whitelister.cmo: server.cmi rules.cmi policy.cmi
whitelister.cmx: server.cmx rules.cmx policy.cmx
rules.cmi: policy.cmi

@ -0,0 +1 @@
debian/patches

@ -0,0 +1,2 @@
reject_unknown_client.patch
disable_spf.patch

@ -0,0 +1,95 @@
##########################################################################
# #
# 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 #
# #
##########################################################################
VERSION = 0.8
PROGRAM = whitelister
PKG_DIST = $(PROGRAM)-$(VERSION)
REPO = $(shell svn info | grep URL | sed -e 's,URL *: *,,')
PKGS = -package syslog
CFLAGS = -O2 -Wall -fPIC
CCLIB = -cclib -lspf
CCOPT = $(foreach opt,$(CFLAGS),-ccopt $(opt))
OCAMLC = ocamlfind ocamlc $(PKGS) $(CCOPT) $(CCLIB)
OCAMLOPT= ocamlfind ocamlopt $(PKGS) $(CCOPT) $(CCLIB)
OCAMLDEP= ocamlfind ocamldep $(PKGS)
BIB = str.cmxa unix.cmxa syslog.cmxa
CMX = spf.cmx policy.cmx rules.cmx server.cmx whitelister.cmx
COB = spfstubs.o
##############################################################
all: $(PROGRAM)
whitelister: $(COB) $(CMX)
$(OCAMLOPT) -o $@ $(BIB) $^
headers: Makefile *.ml *.mli
headache -h tpl/header $^
dist:
@rm -rf $(PKG_DIST) $(PKG_DIST).tar.gz
@svn export $(REPO) $(PKG_DIST)
@rm -rf $(PKG_DIST)/debian
@tar czf $(PKG_DIST).tar.gz $(PKG_DIST)
@rm -rf $(PKG_DIST)
@echo -e "\ndistribution built in $(PKG_DIST).tar.gz\n"
##############################################################
.SUFFIXES: .mli .ml .cmi .cmo .cmx .mll .mly .c .o
.c.o:
$(OCAMLC) $(CCOPT) -c $<
.mli.cmi:
$(OCAMLC) -c $<
.ml.cmo:
$(OCAMLC) -c $<
.ml.cmx:
$(OCAMLOPT) -c $<
.mll.ml:
$(OCAMLLEX) $<
##############################################################
cleanbyte:
rm -rf *.{cm?,o} *~
clean: cleanbyte
rm -f .depend
rm -f $(PROGRAM)
.depend depend: *.ml *.mli
rm -f .depend
$(OCAMLDEP) *.ml *.mli > .depend
include .depend

@ -0,0 +1,117 @@
(**************************************************************************)
(* *)
(* 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 *)
(* *)
(**************************************************************************)
exception ParseError
exception Unknown
exception DSN
type t = (string, string) Hashtbl.t
(* Private : access to hashtbl *)
let get h k =
try Hashtbl.find h k
with Not_found -> raise Unknown
let getu h k =
try Hashtbl.find h k
with Not_found -> "unknown"
let check_policy pcy =
if getu pcy "request" = "smtpd_access_policy" then
pcy
else
raise ParseError
let domain s =
try
Str.string_after s ((String.index s '@')+1)
with Not_found -> raise Unknown (* case of rpcts / sender that are not email addresses *)
(* Private : log formats *)
let log_end pcy =
Printf.sprintf
"from=<%s> to=<%s> proto=%s helo=<%s>"
( getu pcy "sender" )
( getu pcy "recipient" )
( getu pcy "protocol_name" )
( getu pcy "helo_name" )
let log_start : t -> string = fun pcy ->
Printf.sprintf
"%s from %s[%s][%s]"
( getu pcy "protocol_state" )
( getu pcy "client_name" )
( getu pcy "client_address" )
( getu pcy "reverse_client_name" )
(* public *)
let read ic =
let res = Hashtbl.create 13 in
try
while true do
try
let line = input_line ic in
if String.length line = 0 then raise End_of_file;
let i = String.index line '=' in
Hashtbl.add res (Str.string_before line i) (Str.string_after line (i+1))
with Not_found -> raise ParseError
done;
assert false
with
| End_of_file -> check_policy res
let clear = Hashtbl.clear
let client_address h = get h "client_address"
let client_name h = get h "client_name"
let reverse_client_name h = get h "reverse_client_name"
let helo_name h = get h "helo_name"
let sender h =
try
(
match Hashtbl.find h "sender" with
| "" -> raise DSN
| s -> s
)
with Not_found -> raise DSN
let rcpt_domain h = domain (get h "recipient")
let sender_domain h = domain (sender h)
let log_format level answer pcy =
Printf.sprintf "%s: %s: %s; %s"
level (log_start pcy) answer (log_end pcy)
let spf_explain pcy =
let sender = getu pcy "sender" in
let ip = getu pcy "client_address" in
Printf.sprintf " - Please see http://spf.pobox.com/why.html?sender=%s&ip=%s" sender ip

@ -0,0 +1,45 @@
(**************************************************************************)
(* *)
(* 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 *)
(* *)
(**************************************************************************)
type t
exception ParseError
exception Unknown
exception DSN
val read : in_channel -> t
val clear : t -> unit
val client_address : t -> string
val client_name : t -> string
val reverse_client_name : t -> string
val sender : t -> string
val helo_name : t -> string
val rcpt_domain: t -> string
val sender_domain : t -> string
val log_format : string -> string -> t -> string
val spf_explain : t -> string

@ -0,0 +1,116 @@
(**************************************************************************)
(* *)
(* 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 Policy
exception Dirty of string
exception Reject of string
type rhbl_type = Helo | Rcpt | Sender | Client
(* HELPERS *)
(** [rev_ip "ip1.ip2.ip3.ip4"] returns ["ip4.ip3.ip2.ip1"] *)
let rev_ip ip =
let l = Str.split (Str.regexp_string ".") ip in
String.concat "." (List.rev l)
(** [dns_check r i h] returns :
* [i+1] if ["$r.$h"] domain exists,
* [i] if domain does not exists,
* [i+1] if any error occur.
* This is meant to be use with List.fold_left
*)
let dns_check rad host =
try
let _ = Unix.gethostbyname (rad ^ "." ^ host) in
raise (Dirty ("blacklisted by " ^ host))
with
| Not_found -> ()
| Dirty _ as e -> raise e
| _ -> raise (Dirty "rbl failure")
let rhbl_extract_domain =
function
| Helo -> helo_name
| Rcpt -> helo_name
| Sender -> sender_domain
| Client -> client_name
(* PUBLIC INTERFACE *)
let check_rbl rbl_list pcy =
try
let revip = rev_ip (client_address pcy) in
List.iter (dns_check revip) rbl_list
with
| Policy.Unknown -> raise (Dirty "no `client_address' found")
| Policy.DSN -> ()
let check_rhbl kind rhbl_list pcy =
try
let host = (rhbl_extract_domain kind) pcy in
List.iter (dns_check host) rhbl_list
with
| Policy.Unknown ->
(
match kind with
| Helo | Rcpt -> raise (Dirty "no `helo_name' found")
| Sender -> raise (Dirty "no `sender_name' found")
| Client -> raise (Dirty "no `client_name' found")
)
| Policy.DSN -> ()
open Spf
type spf_mode = Spf_off | Spf_normal | Spf_strict | Spf_paranoid
let check_spf mode dorej pcy =
if mode != Spf_off then
let fail s =
if dorej then raise (Reject (s ^ Policy.spf_explain pcy)) else raise (Dirty s)
in try
match spf_query (sender pcy) (client_address pcy) (helo_name pcy) with
| SPF_pass -> ()
| SPF_softerr -> fail "SPF soft error"
| SPF_harderr -> fail "SPF hard error"
| SPF_none -> if mode != Spf_normal then raise (Dirty "no SPF record found")
| SPF_neutral -> if mode = Spf_paranoid then raise (Dirty "SPF neutral")
with
| Spf.Error -> raise (Dirty "SPF Internal error")
| Policy.DSN -> ()
let check_dns_client dorej pcy =
if dorej then
if (client_name pcy) = "unknown" then raise (Dirty "no client_name (reject_unknown_client)")
else ()
let check_dns_rev_client dorej pcy =
if dorej then
if (reverse_client_name pcy) = "unknown" then raise (Dirty "no reverse_client_name (reject_unknown_reverse_client)")
else ()

@ -0,0 +1,41 @@
(**************************************************************************)
(* *)
(* 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 *)
(* *)
(**************************************************************************)
exception Error
type spf_result =
SPF_pass | SPF_neutral | SPF_none | SPF_softerr | SPF_harderr
external _spf_query : string -> string -> string -> int = "spf_query"
let spf_query host ip helo =
match _spf_query host ip helo with
| 0 -> SPF_pass
| 1 -> SPF_neutral
| 2 -> SPF_none
| 3 -> SPF_softerr
| 4 -> SPF_harderr
| _ -> raise Error

@ -0,0 +1,33 @@
(**************************************************************************)
(* *)
(* 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 *)
(* *)
(**************************************************************************)
exception Error
type spf_result =
SPF_pass | SPF_neutral | SPF_none | SPF_softerr | SPF_harderr
val spf_query : string -> string -> string -> spf_result

@ -0,0 +1,42 @@
#include <caml/mlvalues.h>
#include <caml/memory.h>
#include <spf.h>
value spf_query(value from, value ip, value helo)
{
int res;
peer_info_t* peer_info;
CAMLparam3(from, ip, helo);
peer_info = SPF_init("whitelister", String_val(ip), NULL, NULL, NULL, 0, 0);
SPF_smtp_helo(peer_info, String_val(helo));
SPF_smtp_from(peer_info, String_val(from));
res = peer_info->RES = SPF_policy_main(peer_info);
SPF_close(peer_info);
switch(res)
{
case SPF_PASS:
CAMLreturn(Val_int(0));
case SPF_NEUTRAL:
CAMLreturn(Val_int(1));
case SPF_NONE:
CAMLreturn(Val_int(2));
case SPF_S_FAIL:
CAMLreturn(Val_int(3));
case SPF_H_FAIL:
CAMLreturn(Val_int(4));
default: /* SPF_ERROR, SPF_UNKNOWN, SPF_UNMECH */
CAMLreturn(Val_int(5));
}
}

@ -0,0 +1,184 @@
(**************************************************************************)
(* *)
(* 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)

@ -0,0 +1,95 @@
##########################################################################
# #
# 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 #
# #
##########################################################################
VERSION = 0.8
PROGRAM = whitelister
PKG_DIST = $(PROGRAM)-$(VERSION)
REPO = $(shell svn info | grep URL | sed -e 's,URL *: *,,')
PKGS = -package syslog
CFLAGS = -O2 -Wall -fPIC
CCLIB = -cclib -lspf
CCOPT = $(foreach opt,$(CFLAGS),-ccopt $(opt))
OCAMLC = ocamlfind ocamlc $(PKGS) $(CCOPT) $(CCLIB)
OCAMLOPT= ocamlfind ocamlopt $(PKGS) $(CCOPT) $(CCLIB)
OCAMLDEP= ocamlfind ocamldep $(PKGS)
BIB = str.cmxa unix.cmxa syslog.cmxa
CMX = spf.cmx policy.cmx rules.cmx server.cmx whitelister.cmx
COB = spfstubs.o
##############################################################
all: $(PROGRAM)
whitelister: $(COB) $(CMX)
$(OCAMLOPT) -o $@ $(BIB) $^
headers: Makefile *.ml *.mli
headache -h tpl/header $^
dist:
@rm -rf $(PKG_DIST) $(PKG_DIST).tar.gz
@svn export $(REPO) $(PKG_DIST)
@rm -rf $(PKG_DIST)/debian
@tar czf $(PKG_DIST).tar.gz $(PKG_DIST)
@rm -rf $(PKG_DIST)
@echo -e "\ndistribution built in $(PKG_DIST).tar.gz\n"
##############################################################
.SUFFIXES: .mli .ml .cmi .cmo .cmx .mll .mly .c .o
.c.o:
$(OCAMLC) $(CCOPT) -c $<
.mli.cmi:
$(OCAMLC) -c $<
.ml.cmo:
$(OCAMLC) -c $<
.ml.cmx:
$(OCAMLOPT) -c $<
.mll.ml:
$(OCAMLLEX) $<
##############################################################
cleanbyte:
rm -rf *.{cm?,o} *~
clean: cleanbyte
rm -f $(PROGRAM)
.depend depend: *.ml *.mli
rm -f .depend
$(OCAMLDEP) *.ml *.mli > .depend
include .depend

@ -0,0 +1,115 @@
(**************************************************************************)
(* *)
(* 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 *)
(* *)
(**************************************************************************)
exception ParseError
exception Unknown
exception DSN
type t = (string, string) Hashtbl.t
(* Private : access to hashtbl *)
let get h k =
try Hashtbl.find h k
with Not_found -> raise Unknown
let getu h k =
try Hashtbl.find h k
with Not_found -> "unknown"
let check_policy pcy =
if getu pcy "request" = "smtpd_access_policy" then
pcy
else
raise ParseError
let domain s =
try
Str.string_after s ((String.index s '@')+1)
with Not_found -> raise Unknown (* case of rpcts / sender that are not email addresses *)
(* Private : log formats *)
let log_end pcy =
Printf.sprintf
"from=<%s> to=<%s> proto=%s helo=<%s>"
( getu pcy "sender" )
( getu pcy "recipient" )
( getu pcy "protocol_name" )
( getu pcy "helo_name" )
let log_start : t -> string = fun pcy ->
Printf.sprintf
"%s from %s[%s]"
( getu pcy "protocol_state" )
( getu pcy "client_name" )
( getu pcy "client_address" )
(* public *)
let read ic =
let res = Hashtbl.create 13 in
try
while true do
try
let line = input_line ic in
if String.length line = 0 then raise End_of_file;
let i = String.index line '=' in
Hashtbl.add res (Str.string_before line i) (Str.string_after line (i+1))
with Not_found -> raise ParseError
done;
assert false
with
| End_of_file -> check_policy res
let clear = Hashtbl.clear
let client_address h = get h "client_address"
let client_name h = get h "client_name"
let helo_name h = get h "helo_name"
let sender h =
try
(
match Hashtbl.find h "sender" with
| "" -> raise DSN
| s -> s
)
with Not_found -> raise DSN
let rcpt_domain h = domain (get h "recipient")
let sender_domain h = domain (sender h)
let log_format level answer pcy =
Printf.sprintf "%s: %s: %s; %s"
level (log_start pcy) answer (log_end pcy)
let spf_explain pcy =
let sender = getu pcy "sender" in
let ip = getu pcy "client_address" in
Printf.sprintf " - Please see http://spf.pobox.com/why.html?sender=%s&ip=%s" sender ip

@ -0,0 +1,44 @@
(**************************************************************************)
(* *)
(* 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 *)
(* *)
(**************************************************************************)
type t
exception ParseError
exception Unknown
exception DSN
val read : in_channel -> t
val clear : t -> unit
val client_address : t -> string
val client_name : t -> string
val sender : t -> string
val helo_name : t -> string
val rcpt_domain: t -> string
val sender_domain : t -> string
val log_format : string -> string -> t -> string
val spf_explain : t -> string

@ -0,0 +1,106 @@
(**************************************************************************)
(* *)
(* 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 Policy
exception Dirty of string
exception Reject of string
type rhbl_type = Helo | Rcpt | Sender | Client
(* HELPERS *)
(** [rev_ip "ip1.ip2.ip3.ip4"] returns ["ip4.ip3.ip2.ip1"] *)
let rev_ip ip =
let l = Str.split (Str.regexp_string ".") ip in
String.concat "." (List.rev l)
(** [dns_check r i h] returns :
* [i+1] if ["$r.$h"] domain exists,
* [i] if domain does not exists,
* [i+1] if any error occur.
* This is meant to be use with List.fold_left
*)
let dns_check rad host =
try
let _ = Unix.gethostbyname (rad ^ "." ^ host) in
raise (Dirty ("blacklisted by " ^ host))
with
| Not_found -> ()
| Dirty _ as e -> raise e
| _ -> raise (Dirty "rbl failure")
let rhbl_extract_domain =
function
| Helo -> helo_name
| Rcpt -> helo_name
| Sender -> sender_domain
| Client -> client_name
(* PUBLIC INTERFACE *)
let check_rbl rbl_list pcy =
try
let revip = rev_ip (client_address pcy) in
List.iter (dns_check revip) rbl_list
with
| Policy.Unknown -> raise (Dirty "no `client_address' found")
| Policy.DSN -> ()
let check_rhbl kind rhbl_list pcy =
try
let host = (rhbl_extract_domain kind) pcy in
List.iter (dns_check host) rhbl_list
with
| Policy.Unknown ->
(
match kind with
| Helo | Rcpt -> raise (Dirty "no `helo_name' found")
| Sender -> raise (Dirty "no `sender_name' found")
| Client -> raise (Dirty "no `client_name' found")
)
| Policy.DSN -> ()
open Spf
type spf_mode = Spf_off | Spf_normal | Spf_strict | Spf_paranoid
let check_spf mode dorej pcy =
if mode != Spf_off then
let fail s =
if dorej then raise (Reject (s ^ Policy.spf_explain pcy)) else raise (Dirty s)
in try
match spf_query (sender pcy) (client_address pcy) (helo_name pcy) with
| SPF_pass -> ()
| SPF_softerr -> fail "SPF soft error"
| SPF_harderr -> fail "SPF hard error"
| SPF_none -> if mode != Spf_normal then raise (Dirty "no SPF record found")
| SPF_neutral -> if mode = Spf_paranoid then raise (Dirty "SPF neutral")
with
| Spf.Error -> raise (Dirty "SPF Internal error")
| Policy.DSN -> ()

@ -0,0 +1,50 @@
(**************************************************************************)
(* *)
(* 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 *)
(* *)
(**************************************************************************)
exception Dirty of string
exception Reject of string
type spf_mode = Spf_off | Spf_normal | Spf_strict | Spf_paranoid
type rhbl_type = Helo | Rcpt | Sender | Client
(**
* this module defines some rules that a Policy should verify to be whitelisted.
*
* quoting POSTFIX POLICY README [1] :
* In case of trouble the policy server must not send a reply.
* Instead the server must log a warning and disconnect.
* Postfix will retry the request at some later time.
*
* We DON'T follow that policy since we write a WHITELIST server.
* So our choice is that any problem is similar to a invalid Check.
*
* [1] http://www.postfix.org/SMTPD_POLICY_README.html
*)
val check_rbl : string list -> Policy.t -> unit
val check_rhbl : rhbl_type -> string list -> Policy.t -> unit
val check_spf : spf_mode -> bool -> Policy.t -> unit

@ -0,0 +1,63 @@
##
## Example config for whitelister.
## put this file in /etc/whitelister.conf
##
################################################################################
#
# 1. DAEMON CONFIGURATION
#
################################################################################
# verb
# verbosity of the logs
# 0: `Clean' notifications are off
# 1: enable `Clean' notifications
# pidf
# path to the pidfile whitelister has to use
# default is /var/run/whitelister.pid
# examples:
# pidf: /dev/null
# sock
# socket the server has to listen to
# either unix or tcp socket are possible.
# syntax is ip:port (the :port is required) for tcp sockets
# default is 127.0.0.1:10000
# examples :
# sock: /var/spool/postfix/private/whitelister.ctl
# sock: 127.0.0.1:100
# user
# name of the user that whitelister will run under if launched from root
# default is nobody
user: nobody
# group
# name of the group that whitelister will run under if launched from root
# default is nogroup
group: nogroup
################################################################################
#
# 2. RULES CONFIGURATION
#
################################################################################
# rbl
# put one rbl per line
rbl: dynablock.njabl.org
rbl: dul.dnsbl.sorbs.net
# rhbl_* : rhbl_client / rhbl_sender / rhbl_rcpt / rhbl_helo
# put one rhbl per line
rhbl_sender: bogusmx.rfc-ignorant.org
# spf
# use spf diagnostics (default is 0)
# spf: 1
# spfrej
# what to do with spf rejects, default is nothing. ignored if spf is off
# spfrej: off

@ -0,0 +1,173 @@
(**************************************************************************)
(* *)
(* 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;
}
(* 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;
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 = [] ;
}
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
(* 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)

@ -0,0 +1,26 @@
Copyright (c) The Regents of the University of California.
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions
are met:
1. Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
3. Neither the name of the University nor the names of its contributors
may be used to endorse or promote products derived from this software
without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
SUCH DAMAGE.

@ -0,0 +1,69 @@
whitelister 0.8
* relicense under BSD license. GPLv3 seems to be delirious wrt DRM, and I
mean whitelister to be as free as possible.
* rework DSN code fully, so that it won't allow DSN's to skip some tests.
* rework rhbl logging: on DSN, whitelister claimed client_name did not
exist, where it was in fact the sender that has no domain.
whitelister 0.7
* reorganize code so that privilege drop is done before exec.
(needed kludgy organization for the pidfile)
* put daemon independante code in server.ml
* close /dev/null after dup2 calls.
* DSN (mail from <> are mails we MUST accept).
whitelister 0.6
* reorganize logs a bit, copy postfix logs formats.
* SPF REJECT now build a message pointing to spf.pobox.com.
* Add setting `verb' in order to hide `Clean' log entries.
* Finer grained rhbl checkings :
rhbl_helo / rhbl_rcpt / rhbl_sender / rhbl_client.
* whitelister can answer to multiple requests:
dont close the socket ourselves, so that postfix can talk to us on the
same socket. postfix is now the one that will close the socket.
Bugfixes:
* Fix fd starvation introduced in 0.5.
whitelister 0.5.2 (the `never release too quickly' release)
* umask set to 0111 during socket bind, so that anybody can talk to it.
* shutdown the socket ... else it remains open, and makes postfix timeout.
whitelister 0.5
* rewrite the main server loop so that the privileges are drop just after
the bind/listen calls.
* better logging format : now use "$level ($hostname[$ip] $reason)", eg
`Dirty (foo.bar.org[1.2.3.4] blacklisted by rbl.quux.com)'.
whitelister 0.4
* create module Spf (against libspf).
* enable an spf check.
* allow whitelister to reject mails on unvalid SPF.
whitelister 0.3
* now use a pidfile.
* now daemonize itself in the background.
whitelister 0.2.1 (bugfix release)
* bug in logging: in case of an rbl failure, the error was masked.
whitelister 0.2
* add support for privilege drop:
- create user and group configs (defaults to nobody:nogroup).
* Logging facilities.
whitelister 0.1
* initial release.
vim: set ts=2 sts=2 sw=2 noet:

@ -0,0 +1,94 @@
##########################################################################
# #
# 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 #
# #
##########################################################################