whitelister/rules.ml

98 lines
3.7 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 -> ()
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 ()