Merge branch 'udp'

bin/main.ml

@@ -25,7 +25,10 @@ let handler req_inner =
     | None -> Lwt.return ()
     | Some path -> score >|= fun s -> Log.write_of_score path s
   in
-  log >>= fun () -> Serial.write_of_score score
+  let serial = log >>= fun () -> Serial.write_of_score score in
+  match Cli.udp_unix_addr () with
+  | None -> serial
+  | Some udp_addr -> serial >>= fun () -> Udp.write_of_score udp_addr score
 
 let () =
   Cli.arg_parse ();

lib/cli.ml

@@ -2,8 +2,8 @@ let usage_msg =
   "\n\
   \ Usage:\n\
   \ getting [-allow-select-backend] [-ignore-fd-limit] [-no-tls] \
-   [-serial-debug] [-rect-wave] [-l <log-dir>] [-p <serial-port>] [-h \
-   <host-file>] [-i <interval>] <uri> \n\n\
+   [-serial-debug] [-rect-wave] [-l <log-dir>] [-p <serial-port>] [-u \
+   <udp-address>] [-h <host-file>] [-i <interval>] <uri> \n\n\
   \ Example:\n\
   \ getting https://serving.local\n\n\
   \ Options:"
@@ -14,6 +14,8 @@ let tls = ref true
 let include_debug = ref false
 let rect_wave = ref false
 let serial_port = ref "/dev/stdout"
+let udp_address = ref ""
+let parsed_udp_address = ref None
 let log_dir = ref ""
 let host_file = ref ""
 let request_interval = ref 1.
@@ -51,6 +53,11 @@ let speclist =
       Arg.Set_string serial_port,
       ": Optionally set serial port to output successful response indicator, \
        defaults to '/dev/stdout'.\n" );
+    ( "-u",
+      Arg.Set_string udp_address,
+      ": Optionally set a UDP IP address and port to additionally output the \
+       successful response indicator over UDP. The expected format is e.g. \
+       '192.168.0.0:8081'. \n" );
     ( "-h",
       Arg.Set_string host_file,
       ": Optionally include the location of a .yaml file describing a list of \
@@ -66,6 +73,7 @@ let rectangular_wave () = !rect_wave
 let r_interval () = !request_interval
 let target_uri () = Uri.of_string !host
 let log_path () = if String.length !log_dir == 0 then None else Some !log_dir
+let udp_unix_addr () = !parsed_udp_address
 
 let arg_parse () =
   let anon_fun target_host = host := target_host in
@@ -77,4 +85,6 @@ let arg_parse () =
   let open System_checks in
   if Bool.not !allow_select then select_check ();
   if Bool.not !ignore_fd_limit then fd_limit_check ();
-  if String.length !host_file > 0 then Resolver.init_from_yaml !host_file
+  if String.length !host_file > 0 then Resolver.init_from_yaml !host_file;
+  if String.length !udp_address > 0 then
+    parsed_udp_address := Some (Udp.addr_of_string !udp_address)

lib/serial.ml

@@ -24,13 +24,6 @@ let set_baud fd rate =
           c_clocal = true;
         })
 
-(** Convenience function to map an ['a lwt.t] to an [('a, string) result lwt.t]. Rejected promises are mapped to [Error]; fulfilled promises to [Ok]. *)
-let result_lwt_of_lwt promise =
-  Lwt.try_bind
-    (fun () -> promise)
-    (fun inner -> inner |> Result.ok |> Lwt.return)
-    (fun e -> e |> Printexc.to_string |> Result.error |> Lwt.return)
-
 let serial_conn = ref None
 
 let init () =
@@ -40,9 +33,9 @@ let init () =
     Lwt_unix.openfile config.port [ Unix.O_RDWR; Unix.O_NONBLOCK ] 0o000
   in
   let chan_promise =
-    raw_fd >|= Lwt_io.of_fd ~mode:Lwt_io.output |> result_lwt_of_lwt
+    raw_fd >|= Lwt_io.of_fd ~mode:Lwt_io.output |> Utils.result_lwt_of_lwt
   in
-  let setup = set_baud raw_fd config.baud |> result_lwt_of_lwt in
+  let setup = set_baud raw_fd config.baud |> Utils.result_lwt_of_lwt in
   let conn = setup >>= fun _ -> chan_promise in
   serial_conn := Some conn
 

lib/udp.ml

@@ -0,0 +1,53 @@
+let sendto addr msg =
+  let open Lwt.Infix in
+  let fd = Lwt_unix.socket ~cloexec:true PF_INET SOCK_DGRAM 0 in
+  let write_ok =
+    Lwt_unix.sendto fd (String.to_bytes msg) 0 (String.length msg) [] addr
+    >|= fun code -> if code = -1 then Error "UDP: failed to send" else Ok ()
+  in
+  write_ok >>= fun _ ->
+  Lwt_unix.close fd >>= fun () -> write_ok
+
+module Warning =
+Once.Make ()
+(** Make a [Once] module (a stateful module for conveniently managing side-effects that should be executed only once). *)
+
+let write_of_score addr score =
+  let open Lwt.Infix in
+  score >|= Oracle.string_of_score ~debug:false >>= fun str ->
+  sendto addr str >>= function
+  | Ok () ->
+      Warning.reset ();
+      Lwt.return ()
+  | Error reason ->
+      Warning.once (fun () -> print_endline reason);
+      Lwt.return ()
+
+let addr_of_string addr_str =
+  let handle_err ?msg () =
+    match msg with
+    | None ->
+        failwith
+          (Printf.sprintf
+             "Failed parsing '%s' as a UDP address and port. Format should \
+              match e.g. '192.168.0.0:8081'"
+             addr_str)
+    | Some msg ->
+        failwith
+          (Printf.sprintf
+             "Failed parsing '%s' as a UDP address and port. Format should \
+              match e.g. '192.168.0.0:8081': %s"
+             addr_str msg)
+  in
+  let ip, port =
+    match String.split_on_char ':' addr_str with
+    | [ ip; port ] -> (ip, port)
+    | _ -> handle_err ()
+  in
+  let addr =
+    try Unix.inet_addr_of_string ip with Failure msg -> handle_err ~msg ()
+  in
+  let port_int =
+    try int_of_string port with Failure msg -> handle_err ~msg ()
+  in
+  Lwt_unix.ADDR_INET (addr, port_int)

lib/utils.ml

@@ -0,0 +1,6 @@
+(** Convenience function to map an ['a lwt.t] to an [('a, string) result lwt.t]. Rejected promises are mapped to [Error]; fulfilled promises to [Ok]. *)
+let result_lwt_of_lwt promise =
+  Lwt.try_bind
+    (fun () -> promise)
+    (fun inner -> inner |> Result.ok |> Lwt.return)
+    (fun e -> e |> Printexc.to_string |> Result.error |> Lwt.return)

test/delay.ml

@@ -1,5 +1,5 @@
 open Getting
-open Utils
+open TestUtils
 
 let delays () = Delay.of_delays_s [ 1.0; 3.0; 2.0 ]
 

test/pipe.ml

@@ -1,5 +1,5 @@
 open Getting
-open Utils
+open TestUtils
 
 let simulated_promises waits =
   let open Lwt.Infix in