From b7e458c0c4618c399ca63d376df9da2c31fb3082 Mon Sep 17 00:00:00 2001
From: Simon Cruanes <simon.cruanes.2007@m4x.org>
Date: Tue, 26 Nov 2019 18:02:18 -0600
Subject: [PATCH] feat: support ipv6 address

---
 src/Tiny_httpd.ml      | 8 ++++++--
 src/Tiny_httpd.mli     | 1 +
 src/bin/http_of_dir.ml | 5 ++++-
 3 files changed, 11 insertions(+), 3 deletions(-)

diff --git a/src/Tiny_httpd.ml b/src/Tiny_httpd.ml
index 15125286..2d353627 100644
--- a/src/Tiny_httpd.ml
+++ b/src/Tiny_httpd.ml
@@ -518,6 +518,7 @@ type cb_path_handler = string Request.t -> Response.t
 type t = {
   addr: string;
   port: int;
+  ipv6: bool;
   sem_max_connections: Sem_.t;
   new_thread: (unit -> unit) -> unit;
   masksigpipe: bool;
@@ -557,13 +558,14 @@ let add_path_handler
   self.path_handlers <- ph :: self.path_handlers
 
 let create
+    ?(ipv6=false)
     ?(masksigpipe=true)
     ?(max_connections=32)
     ?(new_thread=(fun f -> ignore (Thread.create f () : Thread.t)))
     ?(addr="127.0.0.1") ?(port=8080) () : t =
   let handler _req = Response.fail ~code:404 "no top handler" in
   let max_connections = max 4 max_connections in
-  { new_thread; addr; port; masksigpipe; handler;
+  { new_thread; addr; port; masksigpipe; handler; ipv6;
     running= true; sem_max_connections=Sem_.create max_connections;
     path_handlers=[];
     cb_encode_resp=[]; cb_decode_req=[];
@@ -659,7 +661,9 @@ let run (self:t) : (unit,_) result =
     if self.masksigpipe then (
       ignore (Unix.sigprocmask Unix.SIG_BLOCK [Sys.sigpipe] : _ list);
     );
-    let sock = Unix.socket PF_INET Unix.SOCK_STREAM 0 in
+    let sock =
+      Unix.socket (if self.ipv6 then Unix.PF_INET6 else Unix.PF_INET)
+        Unix.SOCK_STREAM 0 in
     Unix.clear_nonblock sock;
     Unix.setsockopt sock Unix.SO_REUSEADDR true;
     Unix.setsockopt_optint sock Unix.SO_LINGER None;
diff --git a/src/Tiny_httpd.mli b/src/Tiny_httpd.mli
index 9776f921..4adbbdcd 100644
--- a/src/Tiny_httpd.mli
+++ b/src/Tiny_httpd.mli
@@ -322,6 +322,7 @@ type t
 (** A HTTP server. See {!create} for more details. *)
 
 val create :
+  ?ipv6:bool ->
   ?masksigpipe:bool ->
   ?max_connections:int ->
   ?new_thread:((unit -> unit) -> unit) ->
diff --git a/src/bin/http_of_dir.ml b/src/bin/http_of_dir.ml
index 6171eb86..8eb84380 100644
--- a/src/bin/http_of_dir.ml
+++ b/src/bin/http_of_dir.ml
@@ -9,6 +9,7 @@ type config = {
   mutable max_upload_size: int;
   mutable delete: bool;
   mutable j: int;
+  mutable ipv6: bool;
 }
 
 let default_config () : config = {
@@ -18,6 +19,7 @@ let default_config () : config = {
   upload=true;
   max_upload_size = 10 * 1024 * 1024;
   j=32;
+  ipv6=false;
 }
 
 let contains_dot_dot s =
@@ -100,7 +102,7 @@ let date_of_time (f:float) : string =
 
 let serve ~config (dir:string) : _ result =
   Printf.printf "serve directory %s on http://%s:%d\n%!" dir config.addr config.port;
-  let server = S.create ~max_connections:config.j ~addr:config.addr ~port:config.port () in
+  let server = S.create ~ipv6:config.ipv6 ~max_connections:config.j ~addr:config.addr ~port:config.port () in
   if config.delete then (
     S.add_path_handler server ~meth:`DELETE "/%s"
       (fun path _req ->
@@ -209,6 +211,7 @@ let main () =
       "--delete", Unit (fun () -> config.delete <- true), " enable `delete` on files";
       "--no-delete", Unit (fun () -> config.delete <- false), " disable `delete` on files";
       "-j", Int (fun j->config.j <- j), " maximum number of simultaneous connections";
+      "-6", Unit (fun () -> config.ipv6 <- true), " allow ipv6";
     ]) (fun s -> dir_ := s) "http_of_dir [options] [dir]";
   match serve ~config !dir_ with
   | Ok () -> ()