whitelister/policy.ml

113 lines
3.9 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 *)
(* *)
(**************************************************************************)
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)