Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Add Release-based daemon

  • Loading branch information...
commit 3bfa1b2523e07fb5ec29d21a8737d6a2f341632a 1 parent d346cc6
@andrenth authored
View
30 _oasis
@@ -14,13 +14,37 @@ Library spf
CCLib: -lspf2
CCOpt: -Wall -Werror
-Executable "postfix-policyd-spf-ocaml"
+Executable "spfd"
Path: src
BuildTools: ocamlbuild
- MainIs: policyd.ml
+ MainIs: spfd.ml
Install: true
CompiledObject: best
- BuildDepends: spf, str, unix, uint.uint32, uint.uint128
+ BuildDepends: spf,
+ str,
+ unix,
+ uint.uint32,
+ uint.uint128,
+ release,
+ lwt,
+ lwt.unix,
+ lwt.syntax
+
+Executable "spf-slave"
+ Path: src
+ BuildTools: ocamlbuild
+ MainIs: spf_slave.ml
+ Install: true
+ CompiledObject: best
+ BuildDepends: spf,
+ str,
+ unix,
+ uint.uint32,
+ uint.uint128,
+ release,
+ lwt,
+ lwt.unix,
+ lwt.syntax
Executable spf_test
Path: lib_test
View
29 _tags
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: 9c85301202a40310cc058c4149f0ec73)
+# DO NOT EDIT (digest: 49dee584e93d7b1c34bc9adcf227f405)
# Library spf
"lib": include
<lib/*.ml{,i}>: oasis_library_spf_ccopt
@@ -10,6 +10,16 @@
"lib/libspf.a": oasis_library_spf_cclib
"lib/dllspf.so": oasis_library_spf_cclib
<lib/spf.{cma,cmxa}>: use_libspf
+# Executable spf-slave
+<src/spf_slave.{native,byte}>: use_spf
+<src/spf_slave.{native,byte}>: pkg_unix
+<src/spf_slave.{native,byte}>: pkg_uint.uint32
+<src/spf_slave.{native,byte}>: pkg_uint.uint128
+<src/spf_slave.{native,byte}>: pkg_str
+<src/spf_slave.{native,byte}>: pkg_release
+<src/spf_slave.{native,byte}>: pkg_lwt.unix
+<src/spf_slave.{native,byte}>: pkg_lwt.syntax
+<src/spf_slave.{native,byte}>: pkg_lwt
# Executable spf_test
<lib_test/test.{native,byte}>: use_spf
<lib_test/test.{native,byte}>: pkg_unix
@@ -21,10 +31,27 @@
<src/policyd.{native,byte}>: pkg_uint.uint32
<src/policyd.{native,byte}>: pkg_uint.uint128
<src/policyd.{native,byte}>: pkg_str
+# Executable spfd
+<src/spfd.{native,byte}>: use_spf
+<src/spfd.{native,byte}>: pkg_unix
+<src/spfd.{native,byte}>: pkg_uint.uint32
+<src/spfd.{native,byte}>: pkg_uint.uint128
+<src/spfd.{native,byte}>: pkg_str
+<src/spfd.{native,byte}>: pkg_release
+<src/spfd.{native,byte}>: pkg_lwt.unix
+<src/spfd.{native,byte}>: pkg_lwt.syntax
+<src/spfd.{native,byte}>: pkg_lwt
<src/*.ml{,i}>: use_spf
<src/*.ml{,i}>: pkg_unix
<src/*.ml{,i}>: pkg_uint.uint32
<src/*.ml{,i}>: pkg_uint.uint128
<src/*.ml{,i}>: pkg_str
+<src/*.ml{,i}>: pkg_release
+<src/*.ml{,i}>: pkg_lwt.unix
+<src/*.ml{,i}>: pkg_lwt.syntax
+<src/*.ml{,i}>: pkg_lwt
# OASIS_STOP
<*/*.ml>: annot
+<*/*.ml>: warn_error
+<src/spfd.ml>: syntax_camlp4o
+<src/spf_slave.ml>: syntax_camlp4o
View
72 setup.ml
@@ -1,7 +1,7 @@
(* setup.ml generated for the first time by OASIS v0.2.0 *)
(* OASIS_START *)
-(* DO NOT EDIT (digest: 1267c49f20f5e65d945716f5a217bb0e) *)
+(* DO NOT EDIT (digest: 90cde8cd14daa3629a88c9f270c20285) *)
(*
Regenerated by OASIS v0.2.0
Visit http://oasis.forge.ocamlcore.org for more information and
@@ -5044,6 +5044,40 @@ let setup_t =
});
Executable
({
+ cs_name = "spf-slave";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = [];
+ },
+ {
+ bs_build = [(OASISExpr.EBool true, true)];
+ bs_install = [(OASISExpr.EBool true, true)];
+ bs_path = "src";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [
+ InternalLibrary "spf";
+ FindlibPackage ("str", None);
+ FindlibPackage ("unix", None);
+ FindlibPackage ("uint.uint32", None);
+ FindlibPackage ("uint.uint128", None);
+ FindlibPackage ("release", None);
+ FindlibPackage ("lwt", None);
+ FindlibPackage ("lwt.unix", None);
+ FindlibPackage ("lwt.syntax", None)
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])];
+ },
+ {exec_custom = false; exec_main_is = "spf_slave.ml"; });
+ Executable
+ ({
cs_name = "spf_test";
cs_data = PropList.Data.create ();
cs_plugin_data = [];
@@ -5096,7 +5130,41 @@ let setup_t =
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])];
},
- {exec_custom = false; exec_main_is = "policyd.ml"; })
+ {exec_custom = false; exec_main_is = "policyd.ml"; });
+ Executable
+ ({
+ cs_name = "spfd";
+ cs_data = PropList.Data.create ();
+ cs_plugin_data = [];
+ },
+ {
+ bs_build = [(OASISExpr.EBool true, true)];
+ bs_install = [(OASISExpr.EBool true, true)];
+ bs_path = "src";
+ bs_compiled_object = Best;
+ bs_build_depends =
+ [
+ InternalLibrary "spf";
+ FindlibPackage ("str", None);
+ FindlibPackage ("unix", None);
+ FindlibPackage ("uint.uint32", None);
+ FindlibPackage ("uint.uint128", None);
+ FindlibPackage ("release", None);
+ FindlibPackage ("lwt", None);
+ FindlibPackage ("lwt.unix", None);
+ FindlibPackage ("lwt.syntax", None)
+ ];
+ bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_c_sources = [];
+ bs_data_files = [];
+ bs_ccopt = [(OASISExpr.EBool true, [])];
+ bs_cclib = [(OASISExpr.EBool true, [])];
+ bs_dlllib = [(OASISExpr.EBool true, [])];
+ bs_dllpath = [(OASISExpr.EBool true, [])];
+ bs_byteopt = [(OASISExpr.EBool true, [])];
+ bs_nativeopt = [(OASISExpr.EBool true, [])];
+ },
+ {exec_custom = false; exec_main_is = "spfd.ml"; })
];
plugins = [];
schema_data = PropList.Data.create ();
View
193 src/policy.ml
@@ -0,0 +1,193 @@
+open Printf
+
+type response
+ = Dunno
+ | Prepend of string
+ | Defer_if_permit of string
+ | Five_zero_five of string
+
+type cache =
+ { instance : string
+ ; mutable helo_response : Spf.response option
+ ; mutable from_response : Spf.response option
+ ; mutable spf_header_added : bool
+ ; mutable timestamp : float
+ }
+
+type handler = string * (Postfix.attrs -> cache -> response)
+
+let new_cache_entry instance =
+ { instance = instance
+ ; helo_response = None
+ ; from_response = None
+ ; spf_header_added = false
+ ; timestamp = Unix.time ()
+ }
+
+let string_of_response = function
+ | Dunno -> "DUNNO"
+ | Prepend s -> sprintf "PREPEND %s" s
+ | Defer_if_permit s -> sprintf "DEFER_IF_PERMIT %s" s
+ | Five_zero_five s -> sprintf "550 %s" s
+
+let results_cache = ref None
+let default_response = Dunno
+
+let localhost_addresses =
+ List.map
+ (Unix.inet_addr_of_string)
+ ["127.0.0.1"; "::1"]
+
+let exempt_localhost attrs cache =
+ let addr = attrs.Postfix.client_address in
+ if addr <> "" && List.mem (Unix.inet_addr_of_string addr) localhost_addresses
+ then
+ Prepend "X-Comment: SPF not applicable to localhost connection"
+ else
+ Dunno
+
+let relay_addresses =
+ [ "187.73.32.128/25"
+ ]
+
+let exempt_relay attrs cache =
+ let addr = attrs.Postfix.client_address in
+ if addr <> "" then
+ let client_addr = Unix.inet_addr_of_string addr in
+ let rec exempt = function
+ | [] ->
+ Dunno
+ | relay::rest ->
+ let net = Network.of_string relay in
+ if Network.includes client_addr net then
+ Prepend "X-Comment: SPF skipped for whitelisted relay"
+ else
+ exempt rest in
+ exempt relay_addresses
+ else
+ Dunno
+
+let spf_server = Spf.server Spf.Dns_cache
+
+let unbox_spf_response = function
+ | `Error e -> failwith (sprintf "error: %s" e)
+ | `Response r -> r
+
+let some = function
+ | None -> failwith "Option.some: None value"
+ | Some x -> x
+
+let may_default z f = function
+ | None -> z
+ | Some x -> f x
+
+let fail_on_helo_temperror = true
+
+let handle_helo_response sender cache =
+ let res = some cache.helo_response in
+ match Spf.result res with
+ | Spf.Fail comment ->
+ Five_zero_five (Spf.smtp_comment comment)
+ | Spf.Temperror ->
+ if fail_on_helo_temperror then
+ let comment = Spf.header_comment res in
+ Defer_if_permit (sprintf "SPF-Result=%s" comment)
+ else
+ Dunno
+ | _ ->
+ if sender = "" && not cache.spf_header_added then begin
+ cache.spf_header_added <- true;
+ let expl = match Spf.result res with
+ | Spf.Neutral c | Spf.Fail c
+ | Spf.Softfail c ->
+ sprintf " %s" (Spf.smtp_comment c)
+ | _ ->
+ "" in
+ Prepend (sprintf "%s%s" (Spf.received_spf res) expl)
+ end else
+ Dunno
+
+let handle_from_response cache =
+ let res = some cache.from_response in
+ match Spf.result res with
+ | Spf.Fail comment ->
+ Five_zero_five (Spf.explanation comment)
+ | Spf.Temperror ->
+ let comment = Spf.header_comment res in
+ Defer_if_permit (sprintf "SPF-Result=%s" comment)
+ | _ ->
+ if not cache.spf_header_added then begin
+ cache.spf_header_added <- true;
+ let expl = match Spf.result res with
+ | Spf.Neutral c | Spf.Fail c
+ | Spf.Softfail c ->
+ sprintf " %s" (Spf.explanation c)
+ | _ ->
+ "" in
+ Prepend (sprintf "%s%s" (Spf.received_spf res) expl)
+ end else
+ Dunno
+
+let process_helo client_addr helo_name sender cache =
+ (if cache.helo_response = None then
+ let res = Spf.check_helo spf_server client_addr helo_name in
+ let res = unbox_spf_response res in
+ cache.helo_response <- Some res);
+ handle_helo_response sender cache
+
+let process_from client_addr helo_name sender cache =
+ (if cache.from_response = None then
+ let res = Spf.check_from spf_server client_addr helo_name sender in
+ let res = unbox_spf_response res in
+ cache.from_response <- Some res);
+ handle_from_response cache
+
+let sender_policy_framework attrs cache =
+ let client_addr = attrs.Postfix.client_address in
+ let helo_name = attrs.Postfix.helo_name in
+ let sender = attrs.Postfix.sender in
+ let addr = Unix.inet_addr_of_string client_addr in
+ match process_helo addr helo_name sender cache with
+ | Dunno -> process_from addr helo_name sender cache
+ | other -> other
+
+let handlers =
+ [ "exempt_localhost", exempt_localhost
+ ; "exempt_relay", exempt_relay
+ ; "sender_policy_framework", sender_policy_framework
+ ]
+
+let rec until p f z = function
+ | [] ->
+ z
+ | h::t ->
+ let x = f h in
+ if p x then x else until p f z t
+
+let get_cache instance =
+ match !results_cache with
+ | None ->
+ let cache = new_cache_entry instance in
+ results_cache := Some cache;
+ cache
+ | Some cache ->
+ if cache.instance = instance then begin
+ cache
+ end else begin
+ let cache = new_cache_entry instance in
+ results_cache := Some cache;
+ cache
+ end
+
+let handle attrs cache (name, handler) =
+ handler attrs cache
+
+let handle_attrs attrs =
+ let cache = get_cache attrs.Postfix.instance in
+ let not_default = ((<>) default_response) in
+ let response =
+ until not_default (handle attrs cache) default_response handlers in
+ string_of_response response
+
+let lookup_timeout =
+ string_of_response (Defer_if_permit "SPF-Result=Timeout handling SPF lookup")
View
194 src/policyd.ml
@@ -1,193 +1,7 @@
open Printf
-type response
- = Dunno
- | Prepend of string
- | Defer_if_permit of string
- | Five_zero_five of string
-
-type cache =
- { instance : string
- ; mutable helo_response : Spf.response option
- ; mutable from_response : Spf.response option
- ; mutable spf_header_added : bool
- ; mutable timestamp : float
- }
-
-type handler = string * (Postfix.attrs -> cache -> response)
-
-let new_cache_entry instance =
- { instance = instance
- ; helo_response = None
- ; from_response = None
- ; spf_header_added = false
- ; timestamp = Unix.time ()
- }
-
-let string_of_response = function
- | Dunno -> "DUNNO"
- | Prepend s -> sprintf "PREPEND %s" s
- | Defer_if_permit s -> sprintf "DEFER_IF_PERMIT %s" s
- | Five_zero_five s -> sprintf "550 %s" s
-
-let results_cache = ref None
-let default_response = Dunno
-
-let localhost_addresses =
- List.map
- (Unix.inet_addr_of_string)
- ["127.0.0.1"; "::1"]
-
-let exempt_localhost attrs cache =
- let addr = attrs.Postfix.client_address in
- if addr <> "" && List.mem (Unix.inet_addr_of_string addr) localhost_addresses
- then
- Prepend "X-Comment: SPF not applicable to localhost connection"
- else
- Dunno
-
-let relay_addresses =
- [ "187.73.32.128/25"
- ]
-
-let exempt_relay attrs cache =
- let addr = attrs.Postfix.client_address in
- if addr <> "" then
- let client_addr = Unix.inet_addr_of_string addr in
- let rec exempt = function
- | [] ->
- Dunno
- | relay::rest ->
- let net = Network.of_string relay in
- if Network.includes client_addr net then
- Prepend "X-Comment: SPF skipped for whitelisted relay"
- else
- exempt rest in
- exempt relay_addresses
- else
- Dunno
-
-let spf_server = Spf.server Spf.Dns_cache
-
-let unbox_spf_response = function
- | `Error e -> failwith (sprintf "error: %s" e)
- | `Response r -> r
-
-let some = function
- | None -> failwith "Option.some: None value"
- | Some x -> x
-
-let may_default z f = function
- | None -> z
- | Some x -> f x
-
-let fail_on_helo_temperror = true
-
-let handle_helo_response sender cache =
- let res = some cache.helo_response in
- match Spf.result res with
- | Spf.Fail comment ->
- Five_zero_five (Spf.smtp_comment comment)
- | Spf.Temperror ->
- if fail_on_helo_temperror then
- let comment = Spf.header_comment res in
- Defer_if_permit (sprintf "SPF-Result=%s" comment)
- else
- Dunno
- | _ ->
- if sender = "" && not cache.spf_header_added then begin
- cache.spf_header_added <- true;
- let expl = match Spf.result res with
- | Spf.Neutral c | Spf.Fail c
- | Spf.Softfail c ->
- sprintf " %s" (Spf.smtp_comment c)
- | _ ->
- "" in
- Prepend (sprintf "%s%s" (Spf.received_spf res) expl)
- end else
- Dunno
-
-let handle_from_response cache =
- let res = some cache.from_response in
- match Spf.result res with
- | Spf.Fail comment ->
- Five_zero_five (Spf.explanation comment)
- | Spf.Temperror ->
- let comment = Spf.header_comment res in
- Defer_if_permit (sprintf "SPF-Result=%s" comment)
- | _ ->
- if not cache.spf_header_added then begin
- cache.spf_header_added <- true;
- let expl = match Spf.result res with
- | Spf.Neutral c | Spf.Fail c
- | Spf.Softfail c ->
- sprintf " %s" (Spf.explanation c)
- | _ ->
- "" in
- Prepend (sprintf "%s%s" (Spf.received_spf res) expl)
- end else
- Dunno
-
-let process_helo client_addr helo_name sender cache =
- (if cache.helo_response = None then
- let res = Spf.check_helo spf_server client_addr helo_name in
- let res = unbox_spf_response res in
- cache.helo_response <- Some res);
- handle_helo_response sender cache
-
-let process_from client_addr helo_name sender cache =
- (if cache.from_response = None then
- let res = Spf.check_from spf_server client_addr helo_name sender in
- let res = unbox_spf_response res in
- cache.from_response <- Some res);
- handle_from_response cache
-
-let sender_policy_framework attrs cache =
- let client_addr = attrs.Postfix.client_address in
- let helo_name = attrs.Postfix.helo_name in
- let sender = attrs.Postfix.sender in
- let addr = Unix.inet_addr_of_string client_addr in
- match process_helo addr helo_name sender cache with
- | Dunno -> process_from addr helo_name sender cache
- | other -> other
-
-let handlers =
- [ "exempt_localhost", exempt_localhost
- ; "exempt_relay", exempt_relay
- ; "sender_policy_framework", sender_policy_framework
- ]
-
-let rec until p f z = function
- | [] ->
- z
- | h::t ->
- let x = f h in
- if p x then x else until p f z t
-
-let get_cache instance =
- match !results_cache with
- | None ->
- let cache = new_cache_entry instance in
- results_cache := Some cache;
- cache
- | Some cache ->
- if cache.instance = instance then begin
- cache
- end else begin
- let cache = new_cache_entry instance in
- results_cache := Some cache;
- cache
- end
-
-let handle attrs cache (name, handler) =
- handler attrs cache
-
-let handle_attrs handlers attrs =
- let cache = get_cache attrs.Postfix.instance in
- let not_default = ((<>) default_response) in
- let response =
- until not_default (handle attrs cache) default_response handlers in
- printf "action=%s\n\n%!" (string_of_response response)
-
let () =
- Postfix.with_attrs (handle_attrs handlers)
+ Postfix.with_attrs
+ (fun attrs ->
+ let action = Policy.handle_attrs attrs in
+ printf "action=%s\n\n%!" action)
View
14 src/postfix.ml
@@ -14,6 +14,9 @@ end)
type attr_map = string AttrMap.t
+let new_attr_map = AttrMap.empty
+let add_addr = AttrMap.add
+
let needs_attr = function
| "instance" | "client_address" | "helo_name" | "sender" -> true
| _ -> false
@@ -47,6 +50,17 @@ let parse_line line =
else
`Error
+let parse_lines lines =
+ let map = List.fold_left
+ (fun map line ->
+ match parse_line line with
+ | `Error -> map
+ | `Finished -> map
+ | `Parsed (k, v) -> if needs_attr k then AttrMap.add k v map else map)
+ AttrMap.empty
+ lines in
+ attrs_of_map map
+
let with_attrs f =
let attrs = ref AttrMap.empty in
try
View
80 src/spf_slave.ml
@@ -0,0 +1,80 @@
+open Lwt
+open Printf
+
+(* TODO configuration file *)
+
+type config =
+ { user : string
+ ; listen_address : Lwt_unix.sockaddr
+ ; log_level : Lwt_log.level
+ }
+
+let config =
+ { user = "andre"
+ ; listen_address = Lwt_unix.ADDR_UNIX "/tmp/spf.socket"
+ ; log_level = Lwt_log.Debug
+ }
+
+let set_log_level level =
+ Lwt_log.Section.set_level Lwt_log.Section.main level
+
+let handle_sigterm _ =
+ let log_t =
+ Lwt_log.notice "got sigterm" in
+ let cleanup_t =
+ match config.listen_address with
+ | Lwt_unix.ADDR_UNIX path -> Lwt_unix.unlink path
+ | _ -> return () in
+ Lwt_main.run (log_t >> cleanup_t);
+ exit 0
+
+module B = Release_buffer
+
+let read_postfix_attrs fd =
+ let siz = 1024 in
+ let buf = Release_buffer.create siz in
+ let rec read offset remain =
+ match_lwt Release_io.read_once fd buf offset remain with
+ | 0 ->
+ lwt () = Lwt_log.error "got eof on socket, closing" in
+ lwt () = Lwt_unix.close fd in
+ return None
+ | k ->
+ let len = B.length buf in
+ if B.get buf (len - 2) = '\n' && B.get buf (len - 1) = '\n' then
+ return (Some buf)
+ else
+ read (offset + k) (remain - k) in
+ lwt res = read 0 siz in
+ return res
+
+let parse_postfix_attrs fd =
+ match_lwt read_postfix_attrs fd with
+ | None ->
+ return None
+ | Some buf ->
+ let lines = Str.split (Str.regexp "\n") (B.to_string buf) in
+ return (Postfix.parse_lines lines)
+
+let spf_server = Spf.server Spf.Dns_cache
+
+let spf_handler fd =
+ match_lwt parse_postfix_attrs fd with
+ | None ->
+ return ()
+ | Some attrs ->
+ let action = sprintf "action=%s\n\n" (Policy.handle_attrs attrs) in
+ Release_io.write fd (B.of_string action)
+
+let main fd =
+ ignore (Lwt_unix.on_signal Sys.sigterm handle_sigterm);
+ Release_socket.accept_loop
+ ~timeout:30.0 (* DNS lookup may be slow *)
+ Lwt_unix.SOCK_STREAM
+ config.listen_address
+ spf_handler
+
+let () =
+ (* TODO let config = read_config_file "/etc/spfd.conf" in *)
+ set_log_level config.log_level;
+ Release.me ~syslog:false ~user:config.user ~main:main ()
View
17 src/spfd.ml
@@ -0,0 +1,17 @@
+open Lwt
+open Printf
+
+(* TODO configuration file *)
+let spf_exec = sprintf "%s/_build/src/spf-slave" (Unix.getcwd ())
+let lock_file = "/tmp/spfd.pid"
+let num_slaves = 4
+let listen_socket = "/tmp/spf.socket"
+let spf_ipc_handler fd = return ()
+
+let () =
+ Release.master_slave
+ ~background:false
+ ~syslog:false
+ ~lock_file:lock_file
+ ~slave:(spf_exec, spf_ipc_handler)
+ ()
Please sign in to comment.
Something went wrong with that request. Please try again.