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