(**************************************************************************)
(*                                                                        *)
(*      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 ()