Permalink
Browse files

Change some signatures; don't hide SPF_error.

  • Loading branch information...
1 parent c2dfa1d commit ff2aa1316848cf84d9a0ee604cf40b94226b6869 @andrenth committed Aug 27, 2012
Showing with 47 additions and 24 deletions.
  1. +27 −13 lib/SPF.ml
  2. +4 −9 lib/SPF.mli
  3. +16 −2 lib_test/test.ml
View
@@ -48,8 +48,10 @@ exception SPF_error of string
let _ = Callback.register_exception "SPF.SPF_error" (SPF_error "")
external server : ?debug:bool -> dns -> server = "caml_spf_server_new"
+external free_server : server -> unit = "caml_spf_server_free"
external spf_request_new : server -> req = "caml_spf_request_new"
+external spf_free_request : req -> unit = "caml_spf_request_free"
external request_set_inet_addr : req -> Unix.inet_addr -> unit =
"caml_spf_request_set_inet_addr"
@@ -66,13 +68,16 @@ external request_set_helo_domain : req -> string -> unit =
external request_set_envelope_from : req -> string -> unit =
"caml_spf_request_set_env_from"
-external query_mailfrom : req -> response =
+external spf_query_mailfrom : req -> response =
"caml_spf_request_query_mailfrom"
let request server =
let req = spf_request_new server in
{ request = req; server = server }
+let free_request req =
+ spf_free_request req.request
+
let set_inet_addr req ip =
request_set_inet_addr req.request ip
@@ -88,24 +93,33 @@ let set_helo_domain req domain =
let set_envelope_from req from =
request_set_envelope_from req.request from
-let process req =
- try
- `Response (query_mailfrom req.request)
- with SPF_error err ->
- `Error err
+let finalize f g x =
+ try let r = f x in g x; r
+ with e -> g x; raise e
+
+let query_mailfrom req =
+ spf_query_mailfrom req.request
let check_helo server client_addr helo =
let req = request server in
- set_inet_addr req client_addr;
- set_helo_domain req helo;
- process req
+ let check req =
+ set_inet_addr req client_addr;
+ set_helo_domain req helo;
+ query_mailfrom req in
+ let close req =
+ free_request req in
+ finalize check close req
let check_from server client_addr helo from =
let req = request server in
- set_inet_addr req client_addr;
- set_helo_domain req helo;
- set_envelope_from req from;
- process req
+ let check req =
+ set_inet_addr req client_addr;
+ set_helo_domain req helo;
+ set_envelope_from req from;
+ query_mailfrom req in
+ let close req =
+ free_request req in
+ finalize check close req
let string_of_result = function
| Invalid -> "(invalid)"
View
@@ -23,19 +23,14 @@ type result
exception SPF_error of string
val server : ?debug:bool -> dns -> server
+val free_server : server -> unit
val request : server -> request
+val free_request : request -> unit
-val check_helo : server
- -> Unix.inet_addr
- -> string
- -> [`Response of response | `Error of string]
+val check_helo : server -> Unix.inet_addr -> string -> response
-val check_from : server
- -> Unix.inet_addr
- -> string
- -> string
- -> [`Response of response | `Error of string]
+val check_from : server -> Unix.inet_addr -> string -> string -> response
val result : response -> result
val reason : response -> reason
View
@@ -1,11 +1,25 @@
open Printf
+let check_from server client_addr helo from =
+ try
+ let r = SPF.check_from server client_addr helo from in
+ `Response r
+ with SPF.SPF_error e ->
+ `Error e
+
+let check_helo server client_addr helo =
+ try
+ let r = SPF.check_helo server client_addr helo in
+ `Response r
+ with SPF.SPF_error e ->
+ `Error e
+
let () =
let server = SPF.server SPF.Dns_cache in
let client_addr = Unix.inet_addr_of_string "187.73.32.159" in
let helo = "mta98.f1.k8.com.br" in
let from = "andre@andrenathan.com" in
- match SPF.check_from server client_addr helo from with
+ match check_from server client_addr helo from with
| `Error e ->
printf "SPF error: %s\n%!" e
| `Response r ->
@@ -29,7 +43,7 @@ let () =
let client_addr = Unix.inet_addr_of_string "189.57.226.93" in
let helo = "gwmail.bradescoseguros.com.br" in
let _from = "andre@bradescoseguros.com.br" in
- match SPF.check_helo server client_addr helo with
+ match check_helo server client_addr helo with
| `Error e ->
printf "SPF error: %s\n%!" e
| `Response r ->

0 comments on commit ff2aa13

Please sign in to comment.