You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
113 lines
3.9 KiB
OCaml
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)
|