Skip to content
Browse files

spfd will be a separate project

  • Loading branch information...
1 parent de8720e commit 6cba16d23d2282396904e3df66b9a6fefd0f686e @andrenth committed Jul 10, 2012
View
49 _oasis
@@ -14,55 +14,6 @@ Library spf
CCLib: -lspf2
CCOpt: -Wall -Werror
-Executable "spfd"
- Path: src
- BuildTools: ocamlbuild
- MainIs: spfd.ml
- Install: true
- CompiledObject: best
- BuildDepends: str,
- release,
- lwt,
- lwt.unix,
- lwt.syntax
-
-Executable "spf-policyd"
- Path: src
- BuildTools: ocamlbuild
- MainIs: spf_policyd.ml
- Install: true
- CompiledObject: best
- BuildDepends: spf,
- str,
- unix,
- threads,
- uint.uint32,
- uint.uint128,
- release,
- lwt,
- lwt.unix,
- lwt.syntax,
- lwt.preemptive
-
-Executable "spf-milter"
- Path: src
- BuildTools: ocamlbuild
- MainIs: spf_milter.ml
- Install: true
- CompiledObject: best
- BuildDepends: spf,
- milter,
- str,
- unix,
- threads,
- uint.uint32,
- uint.uint128,
- release,
- lwt,
- lwt.unix,
- lwt.syntax,
- lwt.preemptive
-
Executable spf_test
Path: lib_test
BuildTools: ocamlbuild
View
50 _tags
@@ -1,5 +1,5 @@
# OASIS_START
-# DO NOT EDIT (digest: e048003be779e46cc3cbda2b41f971e1)
+# DO NOT EDIT (digest: 60709654e104d5cd41f09c4e273ec2d6)
# Ignore VCS directories, you can use the same kind of rule outside
# OASIS_START/STOP if you want to exclude directories that contains
# useless stuff for the build process
@@ -23,49 +23,6 @@
"lib/libspf_stubs.a": oasis_library_spf_cclib
"lib/dllspf_stubs.so": oasis_library_spf_cclib
<lib/spf.{cma,cmxa}>: use_libspf_stubs
-# Executable spfd
-<src/spfd.{native,byte}>: pkg_str
-<src/spfd.{native,byte}>: pkg_release
-<src/spfd.{native,byte}>: pkg_lwt
-<src/spfd.{native,byte}>: pkg_lwt.unix
-<src/spfd.{native,byte}>: pkg_lwt.syntax
-# Executable spf-policyd
-<src/spf_policyd.{native,byte}>: use_spf
-<src/spf_policyd.{native,byte}>: pkg_unix
-<src/spf_policyd.{native,byte}>: pkg_str
-<src/spf_policyd.{native,byte}>: pkg_threads
-<src/spf_policyd.{native,byte}>: pkg_uint.uint32
-<src/spf_policyd.{native,byte}>: pkg_uint.uint128
-<src/spf_policyd.{native,byte}>: pkg_release
-<src/spf_policyd.{native,byte}>: pkg_lwt
-<src/spf_policyd.{native,byte}>: pkg_lwt.unix
-<src/spf_policyd.{native,byte}>: pkg_lwt.syntax
-<src/spf_policyd.{native,byte}>: pkg_lwt.preemptive
-# Executable spf-milter
-<src/spf_milter.{native,byte}>: use_spf
-<src/spf_milter.{native,byte}>: pkg_unix
-<src/spf_milter.{native,byte}>: pkg_milter
-<src/spf_milter.{native,byte}>: pkg_str
-<src/spf_milter.{native,byte}>: pkg_threads
-<src/spf_milter.{native,byte}>: pkg_uint.uint32
-<src/spf_milter.{native,byte}>: pkg_uint.uint128
-<src/spf_milter.{native,byte}>: pkg_release
-<src/spf_milter.{native,byte}>: pkg_lwt
-<src/spf_milter.{native,byte}>: pkg_lwt.unix
-<src/spf_milter.{native,byte}>: pkg_lwt.syntax
-<src/spf_milter.{native,byte}>: pkg_lwt.preemptive
-<src/*.ml{,i}>: use_spf
-<src/*.ml{,i}>: pkg_unix
-<src/*.ml{,i}>: pkg_milter
-<src/*.ml{,i}>: pkg_str
-<src/*.ml{,i}>: pkg_threads
-<src/*.ml{,i}>: pkg_uint.uint32
-<src/*.ml{,i}>: pkg_uint.uint128
-<src/*.ml{,i}>: pkg_release
-<src/*.ml{,i}>: pkg_lwt
-<src/*.ml{,i}>: pkg_lwt.unix
-<src/*.ml{,i}>: pkg_lwt.syntax
-<src/*.ml{,i}>: pkg_lwt.preemptive
# Executable spf_test
<lib_test/test.{native,byte}>: use_spf
<lib_test/test.{native,byte}>: pkg_unix
@@ -74,8 +31,3 @@
# OASIS_STOP
<*/*.ml>: annot
<*/*.ml>: warn_error
-<src/policy.ml>: syntax_camlp4o
-<src/postfix.ml>: syntax_camlp4o
-<src/spfd.ml>: syntax_camlp4o
-<src/spf_policyd.ml>: syntax_camlp4o
-<src/spf_milter.ml>: syntax_camlp4o
View
12 lib_test/config.sh
@@ -1,12 +0,0 @@
-if [ ! `which milter-test-server` ]; then
- echo -n "Please install 'milter-test-server'"
- echo -n ' [http://milter-manager.sourceforge.net]'
- echo ' or add it to your PATH'
- exit 1
-fi
-
-runtest() {
- echo "$1" | grep -q "$2"
-}
-
-CONNSPEC=inet:9999@localhost
View
47 lib_test/miltertest.lua
@@ -1,47 +0,0 @@
--- Echo that the test is starting
-mt.echo("*** begin test")
--- start the filter
-binpath = mt.getcwd() .. "/_build/src"
-daemon = "spfd.native"
-filter = binpath .. "/" .. daemon
-
-mt.echo("*** executing " .. filter)
-mt.startfilter(filter)
-mt.sleep(2)
-
-conn = "inet:9999@127.0.0.1"
-envfrom = "andre@digirati.com.br"
-helofqdn = "mta112.f1.k8.com.br"
-heloaddr = "187.73.32.184"
-
-conn = mt.connect(conn)
-if conn == nil then
- error "mt.connect() failed"
-end
-
-if mt.conninfo(conn, helofqdn, heloaddr) ~= nil then
- error "mt.conninfo() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.conninfo() unexpected reply"
-end
-if mt.mailfrom(conn, envfrom) ~= nil then
- error "mt.mailfrom() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.mailfrom() unexpected reply"
-end
-
--- end of message; let the filter react
-if mt.eom(conn) ~= nil then
- error "mt.eom() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.eom() unexpected reply"
-end
-
-if not mt.eom_check(conn, MT_HDRADD, "Received-SPF") then
- error "no header added"
-end
-
-mt.disconnect(conn)
View
15 lib_test/test-fail.sh
@@ -1,15 +0,0 @@
-#!/bin/sh
-
-. `dirname $0`/config.sh
-
-ENVFROM="spf-test@openspf.net"
-HELOFQDN="`host -t mx openspf.net | awk '{ print $NF}'`"
-
-runtest "`milter-test-server \
- --connection-spec $CONNSPEC \
- --connect-address inet:8888@$HELOFQDN \
- --helo-fqdn $HELOFQDN \
- --envelope-from $ENVFROM`" \
- '^status: reject'
-
-exit $?
View
16 lib_test/test-pass.sh
@@ -1,16 +0,0 @@
-#!/bin/sh
-
-. `dirname $0`/config.sh
-
-ENVFROM=spf-test@digirati.com.br
-HELOADDR="`host mxz.f1.k8.com.br | head -n1 | awk '{ print $NF}'`"
-HELOFQDN="`host $HELOADDR | head -n1 | awk '{ print $NF}'`"
-
-runtest "`milter-test-server \
- --connection-spec $CONNSPEC \
- --connect-address inet:8888@$HELOADDR \
- --helo-fqdn $HELOFQDN \
- --envelope-from $ENVFROM`" \
- '^status: pass'
-
-exit $?
View
17 lib_test/test-temperror.sh
@@ -1,17 +0,0 @@
-#!/bin/sh
-
-. `dirname $0`/config.sh
-
-ENVFROM='spf-test@bradescoseguros.com.br'
-HELOFQDN='gwmail.bradescoseguros.com.br'
-
-runtest "`milter-test-server \
- --connection-spec $CONNSPEC \
- --connect-address inet:8888@$HELOFQDN \
- --helo-fqdn $HELOFQDN \
- --envelope-from $ENVFROM \
- --reading-timeout 30 \
- --writing-timeout 30`" \
- '^status: temporary-failure'
-
-exit $?
View
4 myocamlbuild.ml
@@ -1,5 +1,5 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 19321b07802ac40e0ade9d303475f179) *)
+(* DO NOT EDIT (digest: d9396bb3c93c63cad08e078f82e290cc) *)
module OASISGettext = struct
# 21 "/home/andre/src/oasis-0.3.0/src/oasis/OASISGettext.ml"
@@ -491,7 +491,7 @@ let package_default =
(["oasis_library_spf_cclib"; "ocamlmklib"; "c"],
[(OASISExpr.EBool true, S [A "-lspf2"])])
];
- includes = [("src", ["lib"]); ("lib_test", ["lib"])];
+ includes = [("lib_test", ["lib"])];
}
;;
View
109 setup.ml
@@ -1,7 +1,7 @@
(* setup.ml generated for the first time by OASIS v0.2.0 *)
(* OASIS_START *)
-(* DO NOT EDIT (digest: 38e3df07861572eab06a4b5f381256dd) *)
+(* DO NOT EDIT (digest: 9ae9e75968643d4d6fb3e09573d58311) *)
(*
Regenerated by OASIS v0.3.0
Visit http://oasis.forge.ocamlcore.org for more information and
@@ -5664,109 +5664,6 @@ let setup_t =
});
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 =
- [
- FindlibPackage ("str", 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"; });
- Executable
- ({
- cs_name = "spf-policyd";
- 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 ("threads", None);
- FindlibPackage ("uint.uint32", None);
- FindlibPackage ("uint.uint128", None);
- FindlibPackage ("release", None);
- FindlibPackage ("lwt", None);
- FindlibPackage ("lwt.unix", None);
- FindlibPackage ("lwt.syntax", None);
- FindlibPackage ("lwt.preemptive", 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_policyd.ml"; });
- Executable
- ({
- cs_name = "spf-milter";
- 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 ("milter", None);
- FindlibPackage ("str", None);
- FindlibPackage ("unix", None);
- FindlibPackage ("threads", None);
- FindlibPackage ("uint.uint32", None);
- FindlibPackage ("uint.uint128", None);
- FindlibPackage ("release", None);
- FindlibPackage ("lwt", None);
- FindlibPackage ("lwt.unix", None);
- FindlibPackage ("lwt.syntax", None);
- FindlibPackage ("lwt.preemptive", 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_milter.ml"; });
- Executable
- ({
cs_name = "spf_test";
cs_data = PropList.Data.create ();
cs_plugin_data = [];
@@ -5797,14 +5694,14 @@ let setup_t =
};
oasis_fn = Some "_oasis";
oasis_version = "0.3.0";
- oasis_digest = Some "\253\155\\\184\230ml{\018\170\241z\177\160\205\146";
+ oasis_digest = Some "\176\149k\\\129l\175\tx(M\176\205\210m\186";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false;
};;
let setup () = BaseSetup.setup setup_t;;
-# 5809 "setup.ml"
+# 5706 "setup.ml"
(* OASIS_STOP *)
let () = setup ();;
View
27 src/config.ml
@@ -1,27 +0,0 @@
-type t =
- { user : string
- ; listen_address : string
- ; log_level : Lwt_log.level
- ; local_addresses : Network.t list
- ; relay_addresses : Network.t list
- ; fail_on_helo_temperror : bool
- }
-
-let default_local_addresses =
- List.map Network.of_string
- [ "127.0.0.0/8"
- ; "::ffff:127.0.0.0/104"
- ]
-
-let default_relay_addresses =
- List.map Network.of_string
- []
-
-let default =
- { user = "andre"
- ; listen_address = "inet:9999@127.0.0.1"
- ; log_level = Lwt_log.Debug
- ; local_addresses = default_local_addresses
- ; relay_addresses = default_relay_addresses
- ; fail_on_helo_temperror = true
- }
View
180 src/milter_callbacks.ml
@@ -1,180 +0,0 @@
-open Printf
-open Util
-
-type result
- = No_result
- | Whitelisted of string
- | Spf_response of SPF.response
-
-type priv =
- { addr : Unix.inet_addr
- ; helo : string option
- ; result : result
- }
-
-let spf_server = SPF.server SPF.Dns_cache
-
-let config = Config.default
-
-let unbox_spf = function
- | `Error e -> failwith (sprintf "error: %s" e)
- | `Response r -> r
-
-let canonicalize a =
- let e = String.length a - 1 in
- let a = if a.[0] = '<' && a.[e] = '>' then String.sub a 1 (e-1) else a in
- let a = if a.[0] = '"' && a.[e] = '"' then String.sub a 1 (e-1) else a in
- let e = String.length a - 1 in
- try
- let t = String.rindex a '@' in
- let u = String.sub a 0 (t) in
- let d = String.sub a (t+1) (e-t) in
- let u = if u.[0] = '"' && u.[t-1] = '"' then String.sub u 1 (t-2) else u in
- try
- let v = String.rindex u ':' in
- let u = String.sub u (v+1) (String.length u - v - 1) in
- u ^ "@" ^ d
- with Not_found ->
- u ^ "@" ^ d
- with Not_found ->
- a
-
-let milter_reject ctx comment =
- Milter.setreply ctx "550" (Some "5.7.1") (Some comment);
- Milter.Reject
-
-let milter_tempfail ctx comment =
- Milter.setreply ctx "451" (Some "4.7.1") (Some comment);
- Milter.Tempfail
-
-let spf_check_helo ctx priv =
- let addr = priv.addr in
- let helo = some (priv.helo) in
- let spf_res = unbox_spf (SPF.check_helo spf_server addr helo) in
- let milter_res = match SPF.result spf_res with
- | SPF.Fail c ->
- milter_reject ctx (SPF.smtp_comment c)
- | SPF.Temperror ->
- if config.Config.fail_on_helo_temperror then
- milter_tempfail ctx (SPF.header_comment spf_res)
- else
- Milter.Continue
- | _ ->
- Milter.Continue in
- spf_res, milter_res
-
-let spf_check_from ctx priv from =
- let addr = priv.addr in
- let helo = some (priv.helo) in
- let spf_res = unbox_spf (SPF.check_from spf_server addr helo from) in
- let milter_res = match SPF.result spf_res with
- | SPF.Fail c -> milter_reject ctx (SPF.smtp_comment c)
- | SPF.Temperror -> milter_tempfail ctx (SPF.header_comment spf_res)
- | _ -> Milter.Continue in
- spf_res, milter_res
-
-let spf_check ctx priv from =
- let spf_res, milter_res = spf_check_helo ctx priv in
- match milter_res with
- | Milter.Continue -> spf_check_from ctx priv from
- | other -> spf_res, milter_res
-
-let milter_add_header ctx header =
- let sep = String.index header ':' in
- let field = String.sub header 0 sep in
- let value = String.sub header (sep + 2) (String.length header - sep - 2) in
- Milter.addheader ctx field value
-
-let with_priv_data z ctx f =
- match Milter.getpriv ctx with
- | None -> z
- | Some p -> let p', r = f p in Milter.setpriv ctx p'; r
-
-module FlagSet = SetOfList(struct
- type t = Milter.flag
- let compare = compare
-end)
-
-module StepSet = SetOfList(struct
- type t = Milter.step
- let compare = compare
-end)
-
-let whitelist s =
- Whitelisted s
-
-(* Callbacks *)
-
-let connect ctx host addr =
- let addr = default Unix.inet_addr_loopback inet_addr_of_sockaddr addr in
- let result = default No_result whitelist (Whitelist.check addr) in
- let priv =
- { addr = addr
- ; helo = None
- ; result = result
- } in
- Milter.setpriv ctx priv;
- Milter.Continue
-
-let helo ctx helo =
- match helo with
- | None ->
- Milter.setreply ctx "503" (Some "5.0.0") (Some "Please say HELO");
- Milter.Reject
- | Some name ->
- with_priv_data Milter.Tempfail ctx
- (fun priv -> { priv with helo = Some name }, Milter.Continue)
-
-let envfrom ctx from args =
- let is_auth = Milter.getsymval ctx "{auth_authen}" <> None in
- let verified = default false ((=)"OK") (Milter.getsymval ctx "{verify}") in
- with_priv_data Milter.Tempfail ctx
- (fun priv ->
- if is_auth || verified then
- let result = Whitelisted "X-Comment: authenticated client" in
- { priv with result = result }, Milter.Continue
- else
- match priv.result with
- | No_result ->
- let spf_res, milter_res = spf_check ctx priv (canonicalize from) in
- { priv with result = Spf_response spf_res }, milter_res
- | Whitelisted _ ->
- priv, Milter.Continue
- | Spf_response _ ->
- invalid_arg "envfrom") (* not possible here *)
-
-let eom ctx =
- with_priv_data Milter.Tempfail ctx
- (fun priv ->
- (match priv.result with
- | No_result -> ()
- | Whitelisted s -> milter_add_header ctx s
- | Spf_response r -> milter_add_header ctx (SPF.received_spf r));
- priv, Milter.Continue)
-
-let abort ctx =
- with_priv_data Milter.Continue ctx
- (fun priv ->
- { priv with result = No_result }, Milter.Continue)
-
-let close ctx =
- maybe (fun _ -> Milter.unsetpriv ctx) (Milter.getpriv ctx);
- Milter.Continue
-
-let negotiate ctx actions steps =
- let reqactions = [Milter.ADDHDRS] in
- if FlagSet.subset (FlagSet.of_list reqactions) (FlagSet.of_list actions) then
- let noreqsteps =
- StepSet.of_list
- [ Milter.NORCPT
- ; Milter.NOHDRS
- ; Milter.NOEOH
- ; Milter.NOBODY
- ; Milter.NOUNKNOWN
- ; Milter.NODATA
- ] in
- let steps = StepSet.of_list steps in
- let noreqsteps = StepSet.elements (StepSet.inter steps noreqsteps) in
- (Milter.Continue, reqactions, noreqsteps)
- else
- (Milter.Reject, [], [])
View
54 src/network.ml
@@ -1,54 +0,0 @@
-open Printf
-
-type t = Unix.inet_addr * int
-
-let of_string s =
- match Str.split (Str.regexp "\\/") s with
- | [prefix; len] ->
- let prefix' = Unix.inet_addr_of_string prefix in
- let len = int_of_string len in
- let maxlen = match String.length ((Obj.magic prefix') : string) with
- | 4 -> 32
- | 16 -> 128
- | _ -> invalid_arg "Network.of_string" in
- if len < 0 || len > maxlen then
- invalid_arg "Network.of_string";
- (Unix.inet_addr_of_string prefix, len)
- | _ -> invalid_arg "Network.of_string"
-
-let ipv4_mask = Uint32.of_int (-1)
-let ipv6_mask = Uint128.of_int (-1)
-
-let ipv4_of_string s =
- let ip = ref Uint32.zero in
- for i = 0 to 3 do
- let b = Uint32.of_int (int_of_char s.[i]) in
- ip := Uint32.logor !ip (Uint32.shift_left b (32 - (i + 1) * 8))
- done;
- !ip
-
-let ipv6_of_string s =
- let ip = ref Uint128.zero in
- for i = 0 to 16 do
- let b = Uint128.of_int (int_of_char s.[i]) in
- ip := Uint128.logor !ip (Uint128.shift_left b (128 - (i + 1) * 8))
- done;
- !ip
-
-let includes ip net =
- let prefix, len = net in
- let ip' : string = Obj.magic ip in
- let prefix' : string = Obj.magic prefix in
- match String.length prefix', String.length ip' with
- | 4, 4 ->
- let mask = Uint32.shift_left ipv4_mask (32 - len) in
- let prefix'' = ipv4_of_string prefix' in
- let ip'' = ipv4_of_string ip' in
- Uint32.logand prefix'' mask = Uint32.logand ip'' mask
- | 16, 16 ->
- let mask = Uint128.shift_left ipv6_mask (128 - len) in
- let prefix'' = ipv6_of_string prefix' in
- let ip'' = ipv6_of_string ip' in
- Uint128.logand prefix'' mask = Uint128.logand ip'' mask
- | _ ->
- false
View
197 src/policy.ml
@@ -1,197 +0,0 @@
-open Lwt
-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 = (SPF.server -> Postfix.attrs -> cache -> response Lwt.t)
-
-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 exempt_networks networks msg server attrs cache =
- let addr = Postfix.client_address attrs in
- if addr <> "" then
- let client_addr = Unix.inet_addr_of_string addr in
- let rec exempt = function
- | [] ->
- Dunno
- | net::rest ->
- let net = Network.of_string net in
- if Network.includes client_addr net then
- Prepend msg
- else
- exempt rest in
- return (exempt networks)
- else
- return Dunno
-
-let exempt_localhost =
- exempt_networks
- [ "127.0.0.0/8"; "::ffff:127.0.0.0/104" ]
- "SPF not applicable to localhost connection - skipped check"
-
-let exempt_relay =
- exempt_networks
- [ "187.73.32.128/25" ]
- "X-Comment: SPF skipped for whitelisted relay"
-
-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 check_helo server addr helo =
- Lwt_preemptive.detach (fun () -> SPF.check_helo server addr helo) ()
-
-let process_helo spf_server client_addr helo_name sender cache =
- lwt () = if cache.helo_response = None then begin
- lwt res = check_helo spf_server client_addr helo_name in
- let res' = unbox_spf_response res in
- cache.helo_response <- Some res';
- return ()
- end else
- return () in
- return (handle_helo_response sender cache)
-
-let check_from server addr helo sender =
- Lwt_preemptive.detach (fun () -> SPF.check_from server addr helo sender) ()
-
-let process_from spf_server client_addr helo_name sender cache =
- lwt () = if cache.from_response = None then begin
- lwt res = check_from spf_server client_addr helo_name sender in
- let res = unbox_spf_response res in
- cache.from_response <- Some res;
- return ()
- end else
- return () in
- return (handle_from_response cache)
-
-let sender_policy_framework spf_server attrs cache =
- let client_addr = Postfix.client_address attrs in
- let helo_name = Postfix.helo_name attrs in
- let sender = Postfix.sender attrs in
- let addr = Unix.inet_addr_of_string client_addr in
- match_lwt process_helo spf_server addr helo_name sender cache with
- | Dunno -> process_from spf_server addr helo_name sender cache
- | other -> return other
-
-let handlers =
- [ exempt_localhost
- ; exempt_relay
- ; sender_policy_framework
- ]
-
-let rec until p f z = function
- | [] ->
- return z
- | h::t ->
- lwt x = f h in
- if p x then return 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 spf_server attrs =
- let cache = get_cache (Postfix.instance attrs) in
- let not_default = ((<>) default_response) in
- lwt response =
- until not_default
- (fun handler -> handler spf_server attrs cache)
- default_response
- handlers in
- return (string_of_response response)
-
-let lookup_timeout =
- string_of_response (Defer_if_permit "SPF-Result=Timeout handling SPF lookup")
View
1 src/policy.mli
@@ -1 +0,0 @@
-val handle_attrs : SPF.server -> Postfix.attrs -> string Lwt.t
View
90 src/postfix.ml
@@ -1,90 +0,0 @@
-open Lwt
-open Printf
-
-type attrs =
- { instance : string
- ; client_address : string
- ; helo_name : string
- ; sender : string
- }
-
-let instance attrs = attrs.instance
-let client_address attrs = attrs.client_address
-let helo_name attrs = attrs.helo_name
-let sender attrs = attrs.sender
-
-module AttrMap = Map.Make(struct
- type t = string
- let compare = compare
-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
-
-let attrs_of_map m =
- try
- let attrs =
- { instance = AttrMap.find "instance" m
- ; client_address = AttrMap.find "client_address" m
- ; helo_name = AttrMap.find "helo_name" m
- ; sender = AttrMap.find "sender" m
- } in
- Some attrs
- with Not_found ->
- None
-
-let parse_line line =
- let re = Str.regexp "^\\([^=]+\\)=\\(.*\\)$" in
- if Str.string_match re line 0 then
- let k = Str.matched_group 1 line in
- let v = Str.matched_group 2 line in
- `Parsed (k, v)
- else if line = "" then
- `Finished
- 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
-
-module B = Release_buffer
-
-let read_attrs fd =
- let siz = 1024 in
- let buf = B.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_attrs fd =
- match_lwt read_attrs fd with
- | None ->
- return None
- | Some buf ->
- let lines = Str.split (Str.regexp "\n") (B.to_string buf) in
- return (parse_lines lines)
View
8 src/postfix.mli
@@ -1,8 +0,0 @@
-type attrs
-
-val instance : attrs -> string
-val client_address : attrs -> string
-val helo_name : attrs -> string
-val sender : attrs -> string
-
-val parse_attrs : Lwt_unix.file_descr -> attrs option Lwt.t
View
42 src/spf_milter.ml
@@ -1,42 +0,0 @@
-open Lwt
-open Printf
-
-(* TODO configuration file *)
-
-let context_mtx = Lwt_mutex.create ()
-
-let set_log_level level =
- Lwt_log.Section.set_level Lwt_log.Section.main level
-
-let filter =
- { Milter.name = "spfd"
- ; Milter.version = Milter.version_code
- ; Milter.flags = [Milter.ADDHDRS]
- ; Milter.connect = Some Milter_callbacks.connect
- ; Milter.helo = Some Milter_callbacks.helo
- ; Milter.envfrom = Some Milter_callbacks.envfrom
- ; Milter.envrcpt = None
- ; Milter.header = None
- ; Milter.eoh = None
- ; Milter.body = None
- ; Milter.eom = Some Milter_callbacks.eom
- ; Milter.abort = Some Milter_callbacks.abort
- ; Milter.close = Some Milter_callbacks.close
- ; Milter.unknown = None
- ; Milter.data = None
- ; Milter.negotiate = Some Milter_callbacks.negotiate
- }
-
-let config = Config.default
-
-let main fd =
- lwt () = Lwt_log.notice "starting up" in
- Milter.setconn config.Config.listen_address;
- Milter.register filter;
- Milter.main ();
- return ()
-
-let () =
- (* TODO let config = read_config_file "/etc/spfd.conf" in *)
- set_log_level config.Config.log_level;
- Release.me ~syslog:false ~user:config.Config.user ~main:main ()
View
52 src/spf_policyd.ml
@@ -1,52 +0,0 @@
-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
-
-let spf_handler fd =
- let spf_server = SPF.server SPF.Dns_cache in
- match_lwt Postfix.parse_attrs fd with
- | None ->
- return ()
- | Some attrs ->
- lwt action = Policy.handle_attrs spf_server attrs in
- let reply = sprintf "action=%s\n\n" action in
- Release_io.write fd (Release_buffer.of_string reply)
-
-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
18 src/spfd.ml
@@ -1,18 +0,0 @@
-open Lwt
-open Printf
-
-(* TODO configuration file *)
-let style = "milter"
-let spf_exec = sprintf "%s/_build/src/spf_%s.native" (Unix.getcwd ()) style
-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)
- ()
View
40 src/util.ml
@@ -1,40 +0,0 @@
-let some = function
- | None -> invalid_arg "some"
- | Some x -> x
-
-let maybe f = function
- | None -> ()
- | Some x -> f x
-
-let either g f = function
- | None -> g ()
- | Some x -> f x
-
-let default z f = function
- | None -> z
- | Some x -> f x
-
-let inet_addr_of_sockaddr = function
- | Unix.ADDR_INET (a, _) -> a
- | Unix.ADDR_UNIX s -> invalid_arg ("inet_addr_of_sockaddr "^s)
-
-let (<?>) opt z =
- match opt with
- | None -> z
- | Some x -> x
-
-let (<|>) opt1 opt2 =
- match opt1 with
- | None -> opt2
- | x -> x
-
-module type SETOFLIST = sig
- include Set.S
- val of_list : elt list -> t
-end
-
-module SetOfList (E : Set.OrderedType) : SETOFLIST with type elt = E.t = struct
- include Set.Make(E)
- let of_list =
- List.fold_left (fun s e -> add e s) empty
-end
View
31 src/whitelist.ml
@@ -1,31 +0,0 @@
-open Util
-
-type result = string option
-
-let check_networks networks msg addr =
- let rec check = function
- | [] ->
- None
- | net::rest ->
- if Network.includes addr net then
- Some ("X-Comment: " ^ msg)
- else
- check rest in
- check networks
-
-let config = Config.default
-
-let check_local addr =
- check_networks
- config.Config.local_addresses
- "SPF not applicable to localhost connection - skipped check"
- addr
-
-let check_relay addr =
- check_networks
- config.Config.relay_addresses
- "SPF skipped for whitelisted relay"
- addr
-
-let check addr =
- check_local addr <|> check_relay addr
View
13 test/config.sh
@@ -1,13 +0,0 @@
-if [ ! `which milter-test-server` ]; then
- echo -n "Please install 'milter-test-server'"
- echo -n ' [http://milter-manager.sourceforge.net]'
- echo ' or add it to your PATH'
- exit 1
-fi
-
-runtest() {
- [ -n "$DEBUG" ] && echo $1
- echo "$1" | grep -q "$2"
-}
-
-CONNSPEC=inet:9999@localhost
View
47 test/miltertest-fail.lua
@@ -1,47 +0,0 @@
--- Echo that the test is starting
-mt.echo("*** begin test")
--- start the filter
-binpath = mt.getcwd() .. "/_build/src"
-daemon = "spfd.native"
-filter = binpath .. "/" .. daemon
-
-mt.echo("*** executing " .. filter)
-mt.startfilter(filter)
-mt.sleep(2)
-
-conn = "inet:9999@127.0.0.1"
-envfrom = "spf-test@digirati.com.br"
-helofqdn = "mta90.f1.k8.com.br"
-heloaddr = "187.73.32.145"
-
-conn = mt.connect(conn)
-if conn == nil then
- error "mt.connect() failed"
-end
-
-if mt.conninfo(conn, helofqdn, heloaddr) ~= nil then
- error "mt.conninfo() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.conninfo() unexpected reply"
-end
-if mt.mailfrom(conn, envfrom) ~= nil then
- error "mt.mailfrom() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.mailfrom() unexpected reply"
-end
-
--- end of message; let the filter react
-if mt.eom(conn) ~= nil then
- error "mt.eom() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.eom() unexpected reply"
-end
-
-if not mt.eom_check(conn, MT_HDRADD, "Received-SPF") then
- error "no header added"
-end
-
-mt.disconnect(conn)
View
47 test/miltertest-pass.lua
@@ -1,47 +0,0 @@
--- Echo that the test is starting
-mt.echo("*** begin test")
--- start the filter
-binpath = mt.getcwd() .. "/_build/src"
-daemon = "spfd.native"
-filter = binpath .. "/" .. daemon
-
-mt.echo("*** executing " .. filter)
-mt.startfilter(filter)
-mt.sleep(2)
-
-conn = "inet:9999@127.0.0.1"
-envfrom = "andre@digirati.com.br"
-helofqdn = "mta112.f1.k8.com.br"
-heloaddr = "187.73.32.184"
-
-conn = mt.connect(conn)
-if conn == nil then
- error "mt.connect() failed"
-end
-
-if mt.conninfo(conn, helofqdn, heloaddr) ~= nil then
- error "mt.conninfo() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.conninfo() unexpected reply"
-end
-if mt.mailfrom(conn, envfrom) ~= nil then
- error "mt.mailfrom() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.mailfrom() unexpected reply"
-end
-
--- end of message; let the filter react
-if mt.eom(conn) ~= nil then
- error "mt.eom() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.eom() unexpected reply"
-end
-
-if not mt.eom_check(conn, MT_HDRADD, "Received-SPF") then
- error "no header added"
-end
-
-mt.disconnect(conn)
View
47 test/miltertest-temperror.lua
@@ -1,47 +0,0 @@
--- Echo that the test is starting
-mt.echo("*** begin test")
--- start the filter
-binpath = mt.getcwd() .. "/_build/src"
-daemon = "spfd.native"
-filter = binpath .. "/" .. daemon
-
-mt.echo("*** executing " .. filter)
-mt.startfilter(filter)
-mt.sleep(2)
-
-conn = "inet:9999@127.0.0.1"
-envfrom = "spf-test@bradescoseguros.com.br"
-helofqdn = "gwmail.bradescoseguros.com.br"
-heloaddr = "200.159.226.32"
-
-conn = mt.connect(conn)
-if conn == nil then
- error "mt.connect() failed"
-end
-
-if mt.conninfo(conn, helofqdn, heloaddr) ~= nil then
- error "mt.conninfo() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.conninfo() unexpected reply"
-end
-if mt.mailfrom(conn, envfrom) ~= nil then
- error "mt.mailfrom() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.mailfrom() unexpected reply"
-end
-
--- end of message; let the filter react
-if mt.eom(conn) ~= nil then
- error "mt.eom() failed"
-end
-if mt.getreply(conn) ~= SMFIR_CONTINUE then
- error "mt.eom() unexpected reply"
-end
-
-if not mt.eom_check(conn, MT_HDRADD, "Received-SPF") then
- error "no header added"
-end
-
-mt.disconnect(conn)
View
11 test/runner.sh
@@ -1,11 +0,0 @@
-#!/bin/sh
-
-dir=`dirname $0`
-for i in $dir/test-*.sh; do
- sh $i
- if [ $? = 0 ]; then
- echo "`basename $i`: OK"
- else
- echo "`basename $i`: FAIL"
- fi
-done
View
15 test/test-fail.sh
@@ -1,15 +0,0 @@
-#!/bin/sh
-
-. `dirname $0`/config.sh
-
-ENVFROM="spf-test@openspf.net"
-HELOFQDN="`host -t mx openspf.net | awk '{ print $NF}'`"
-
-runtest "`milter-test-server \
- --connection-spec $CONNSPEC \
- --connect-address inet:8888@$HELOFQDN \
- --helo-fqdn $HELOFQDN \
- --envelope-from $ENVFROM`" \
- '^status: reject'
-
-exit $?
View
16 test/test-pass.sh
@@ -1,16 +0,0 @@
-#!/bin/sh
-
-. `dirname $0`/config.sh
-
-ENVFROM=spf-test@digirati.com.br
-HELOADDR="`host mxz.f1.k8.com.br | head -n1 | awk '{ print $NF}'`"
-HELOFQDN="`host $HELOADDR | head -n1 | awk '{ print $NF}'`"
-
-runtest "`milter-test-server \
- --connection-spec $CONNSPEC \
- --connect-address inet:8888@$HELOADDR \
- --helo-fqdn $HELOFQDN \
- --envelope-from $ENVFROM`" \
- '^status: pass'
-
-exit $?
View
17 test/test-temperror.sh
@@ -1,17 +0,0 @@
-#!/bin/sh
-
-. `dirname $0`/config.sh
-
-ENVFROM='spf-test@bradescoseguros.com.br'
-HELOFQDN='gwmail.bradescoseguros.com.br'
-
-runtest "`milter-test-server \
- --connection-spec $CONNSPEC \
- --connect-address inet:8888@$HELOFQDN \
- --helo-fqdn $HELOFQDN \
- --envelope-from $ENVFROM \
- --reading-timeout 30 \
- --writing-timeout 30`" \
- '^status: temporary-failure'
-
-exit $?

0 comments on commit 6cba16d

Please sign in to comment.
Something went wrong with that request. Please try again.