107 lines
4.1 KiB
OCaml
107 lines
4.1 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 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 -> ()
|
||
|
|