Add server tests

README.md

@@ -24,6 +24,16 @@ Build instructions:
 Local testings:
 ===============
 
+To run the automated tests, do:
+
+ * dune runtest --auto-promote
+
+ * this will update the files at test/extensions/*/run.t to reflect the
+   behavior of ocsigenserver. The test files don't change if the server did not
+   change behavior. Use Git to see the eventual changes.
+
+Alternatively, you can also test the 'ocsigenserver' program using a config file:
+
  * run "make run.local" or "make run.opt.local"
    in the ocsigen source directory.
 
@@ -32,6 +42,8 @@ Local testings:
  * if it does not work, look at the logs (see 'local/var/log/' in the
    ocsgigen source directory) or run ocsigen with options -v.
 
+ * this will use the config file at 'local/etc/ocsigenserver.conf'.
+
 ------------------------------------------------------------------
 
 Authors:

src/baselib/ocsigen_lib.ml

@@ -37,10 +37,6 @@ module Ip_address = struct
          else Lwt_unix.AI_FAMILY Lwt_unix.PF_INET) ]
     in
     Lwt.bind (Lwt_unix.getaddrinfo host "" options) aux
-
-  let of_sockaddr = function
-    | Unix.ADDR_INET (ip, _port) -> ip
-    | _ -> raise (Ocsigen_Internal_Error "ip of unix socket")
 end
 
 (*****************************************************************************)

src/baselib/ocsigen_lib.mli

@@ -40,7 +40,6 @@ module Ip_address : sig
   exception No_such_host
 
   val get_inet_addr : ?v6:bool -> string -> Unix.inet_addr Lwt.t
-  val of_sockaddr : Unix.sockaddr -> Unix.inet_addr
 end
 
 module Filename : sig

src/extensions/accesscontrol.ml

@@ -38,7 +38,11 @@ let ip s =
         Ocsigen_extensions.badconfig "Bad ip/netmask [%s] in <ip> condition" s)
   in
   fun ri ->
-    let r = Ipaddr.Prefix.mem (Ocsigen_request.remote_ip_parsed ri) prefix in
+    let r =
+      match Ocsigen_request.remote_ip_parsed ri with
+      | `Ip ip -> Ipaddr.Prefix.mem ip prefix
+      | `Unix _ -> false
+    in
     if r
     then
       Logs.info ~src:section (fun fmt ->
@@ -218,7 +222,9 @@ let allow_forward_for_handler ?(check_equal_ip = false) () =
             let last_proxy = List.last proxies in
             let proxy_ip = Ipaddr.of_string_exn last_proxy in
             let equal_ip =
-              proxy_ip = Ocsigen_request.remote_ip_parsed request_info
+              match Ocsigen_request.remote_ip_parsed request_info with
+              | `Ip r_ip -> Ipaddr.compare proxy_ip r_ip = 0
+              | `Unix _ -> false
             in
             if equal_ip || not check_equal_ip
             then

src/extensions/revproxy.ml

@@ -105,7 +105,7 @@ let gen dir = function
                let h =
                  let forward =
                    let address =
-                     Unix.string_of_inet_addr
+                     Ocsigen_config.Socket_type.to_string
                        (Ocsigen_request.address request_info)
                    in
                    String.concat ", "

src/server/ocsigen_cohttp.ml

@@ -224,22 +224,24 @@ let service ?ssl ~address ~port ~connector () =
     | None -> `None
   in
   (* We create a specific context for Conduit and Cohttp. *)
-  Conduit_lwt_unix.init
-    ~src:(Ocsigen_config.Socket_type.to_string address)
-    ~tls_own_key ()
-  >>= fun conduit_ctx ->
+  let src =
+    match address with
+    | `Unix _ -> None
+    | _ -> Some (Ocsigen_config.Socket_type.to_string address)
+  in
+  Conduit_lwt_unix.init ?src ~tls_own_key () >>= fun conduit_ctx ->
   Lwt.return (Cohttp_lwt_unix.Net.init ~ctx:conduit_ctx ()) >>= fun ctx ->
   (* We catch the INET_ADDR of the server *)
   let callback =
-    let address = Ocsigen_config.Socket_type.to_inet_addr address
-    and ssl = match ssl with Some _ -> true | None -> false in
+    let ssl = match ssl with Some _ -> true | None -> false in
     handler ~ssl ~address ~port ~connector
   in
   let config = Cohttp_lwt_unix.Server.make ~conn_closed ~callback () in
   let mode =
-    match tls_own_key with
-    | `None -> `TCP (`Port port)
-    | `TLS (crt, key, pass) -> `OpenSSL (crt, key, pass, `Port port)
+    match address, tls_own_key with
+    | `Unix f, _ -> `Unix_domain_socket (`File f)
+    | _, `None -> `TCP (`Port port)
+    | _, `TLS (crt, key, pass) -> `OpenSSL (crt, key, pass, `Port port)
   in
   Cohttp_lwt_unix.Server.create ~stop ~ctx ~mode config >>= fun () ->
   Lwt.return (Lwt.wakeup stop_wakener ())

src/server/ocsigen_config.ml

@@ -28,17 +28,14 @@ type ssl_info =
   ; ssl_curve : string option }
 
 module Socket_type = struct
-  type t = [`All | `IPv4 of Unix.inet_addr | `IPv6 of Unix.inet_addr]
+  type t =
+    [`All | `IPv4 of Unix.inet_addr | `IPv6 of Unix.inet_addr | `Unix of string]
 
   let to_string = function
     | `All -> Unix.string_of_inet_addr Unix.inet_addr_any
     | `IPv4 u -> Unix.string_of_inet_addr u
     | `IPv6 u -> Unix.string_of_inet_addr u
-
-  let to_inet_addr = function
-    | `All -> Unix.inet_addr_any
-    | `IPv4 u -> u
-    | `IPv6 u -> u
+    | `Unix s -> s
 end
 
 type socket_type = Socket_type.t

src/server/ocsigen_config.mli

@@ -28,10 +28,10 @@ type ssl_info =
   ; ssl_curve : string option }
 
 module Socket_type : sig
-  type t = [`All | `IPv4 of Unix.inet_addr | `IPv6 of Unix.inet_addr]
+  type t =
+    [`All | `IPv4 of Unix.inet_addr | `IPv6 of Unix.inet_addr | `Unix of string]
 
   val to_string : t -> string
-  val to_inet_addr : t -> Unix.inet_addr
 end
 
 type socket_type = Socket_type.t

src/server/ocsigen_request.ml

@@ -49,13 +49,13 @@ let make_uri u =
   {u_uri; u_get_params; u_get_params_flat; u_path; u_path_string}
 
 type t =
-  { r_address : Unix.inet_addr
+  { r_address : Ocsigen_config.Socket_type.t
   ; r_port : int
   ; r_ssl : bool
   ; r_filenames : string list ref
   ; r_sockaddr : Lwt_unix.sockaddr
   ; r_remote_ip : string Lazy.t
-  ; r_remote_ip_parsed : Ipaddr.t Lazy.t
+  ; r_remote_ip_parsed : [`Ip of Ipaddr.t | `Unix of string] Lazy.t
   ; r_forward_ip : string list
   ; r_uri : uri
   ; r_meth : Cohttp.Code.meth
@@ -88,10 +88,16 @@ let make
   =
   let r_remote_ip =
     lazy
-      (Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr))
+      (match sockaddr with
+      | Unix.ADDR_INET (ip, _port) -> Unix.string_of_inet_addr ip
+      | ADDR_UNIX f -> f)
   in
   let r_remote_ip_parsed =
-    lazy (Ipaddr.of_string_exn (Lazy.force r_remote_ip))
+    lazy
+      (match sockaddr with
+      | Unix.ADDR_INET (ip, _port) ->
+          `Ip (Ipaddr.of_string_exn (Unix.string_of_inet_addr ip))
+      | ADDR_UNIX f -> `Unix f)
   in
   { r_address = address
   ; r_port = port
@@ -146,7 +152,8 @@ let update
     match forward_ip with Some forward_ip -> forward_ip | None -> r_forward_ip
   and r_remote_ip, r_remote_ip_parsed =
     match remote_ip with
-    | Some remote_ip -> lazy remote_ip, lazy (Ipaddr.of_string_exn remote_ip)
+    | Some remote_ip ->
+        lazy remote_ip, lazy (`Ip (Ipaddr.of_string_exn remote_ip))
     | None -> r_remote_ip, r_remote_ip_parsed
   and r_sub_path = match sub_path with Some _ -> sub_path | None -> r_sub_path
   and r_body =

src/server/ocsigen_request.mli

@@ -15,7 +15,7 @@ val make :
   -> ?original_full_path:string
   -> ?request_cache:Polytables.t
   -> ?cookies_override:string Ocsigen_cookie_map.Map_inner.t
-  -> address:Unix.inet_addr
+  -> address:Ocsigen_config.Socket_type.t
   -> port:int
   -> ssl:bool
   -> filenames:string list ref
@@ -42,7 +42,7 @@ val update :
 val to_cohttp : t -> Cohttp.Request.t
 val uri : t -> Uri.t
 val body : t -> Cohttp_lwt.Body.t
-val address : t -> Unix.inet_addr
+val address : t -> Ocsigen_config.Socket_type.t
 val host : t -> string option
 val meth : t -> Cohttp.Code.meth
 val port : t -> int
@@ -75,7 +75,7 @@ val post_params :
   -> (string * string) list Lwt.t option
 
 val remote_ip : t -> string
-val remote_ip_parsed : t -> Ipaddr.t
+val remote_ip_parsed : t -> [`Ip of Ipaddr.t | `Unix of string]
 val forward_ip : t -> string list
 val content_type : t -> content_type option
 val request_cache : t -> Polytables.t

src/server/ocsigen_server.ml

@@ -38,17 +38,18 @@ let () =
         ("Uncaught Exception after lwt timeout" ^^ "@\n%s")
         (Printexc.to_string e)))
 
+let pp_sockaddr ppf = function
+  | Unix.ADDR_INET (ip, _port) ->
+      Format.fprintf ppf "%s" (Unix.string_of_inet_addr ip)
+  | ADDR_UNIX f -> Format.fprintf ppf "%s" f
+
 let _warn sockaddr s =
   Logs.warn ~src:section (fun fmt ->
-    fmt "While talking to %s:%s"
-      (Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr))
-      s)
+    fmt "While talking to %a:%s" pp_sockaddr sockaddr s)
 
 let _dbg sockaddr s =
   Logs.info ~src:section (fun fmt ->
-    fmt "While talking to %s:%s"
-      (Unix.string_of_inet_addr (Ocsigen_lib.Ip_address.of_sockaddr sockaddr))
-      s)
+    fmt "While talking to %a:%s" pp_sockaddr sockaddr s)
 
 (* fatal errors messages *)
 let errmsg = function

test/dune

@@ -0,0 +1,7 @@
+(subdir
+ extensions
+ (cram
+  (package ocsigenserver)
+  (deps
+   ../server-test-helpers.sh
+   (package ocsigenserver))))

test/extensions/deflatemod.t/dune

@@ -0,0 +1,3 @@
+(executable
+ (name test)
+ (libraries ocsigenserver ocsigenserver.ext.staticmod ocsigenserver.ext.deflatemod))

test/extensions/deflatemod.t/dune-project

@@ -0,0 +1 @@
+(lang dune 3.18)

test/extensions/deflatemod.t/index.html

@@ -0,0 +1 @@
+Hello world

test/extensions/deflatemod.t/run.t

@@ -0,0 +1,43 @@
+  $ source ../../server-test-helpers.sh
+  $ run_server ./test.exe
+  ocsigen:main: [WARNING] Command pipe created
+  ocsigen:access:  connection for local-test from  (curl/8.12.1): /index.html
+  ocsigen:ext: [INFO] host found! local-test:0 matches .* 
+  ocsigen:ext:staticmod: [INFO] Is it a static file?
+  ocsigen:local-file: [INFO] Testing "./index.html".
+  ocsigen:local-file: [INFO] checking if file index.html can be sent
+  ocsigen:ext: [INFO] Compiling exclusion regexp $^
+  ocsigen:local-file: [INFO] Returning "./index.html".
+  ocsigen:access:  connection for local-test from  (curl/8.12.1): /index.html
+  ocsigen:ext: [INFO] host found! local-test:0 matches .* 
+  ocsigen:ext:staticmod: [INFO] Is it a static file?
+  ocsigen:local-file: [INFO] Testing "./index.html".
+  ocsigen:local-file: [INFO] checking if file index.html can be sent
+  ocsigen:local-file: [INFO] Returning "./index.html".
+  ocsigen:ext:deflate: [INFO] Zlib stream initialized
+  ocsigen:ext:deflate: [INFO] End of stream: big cleaning for zlib
+  ocsigen:ext:deflate: [INFO] Zlib.deflate finished, last flush
+  ocsigen:ext:deflate: [INFO] Flushing!
+  ocsigen:ext:deflate: [INFO] Zlib stream closed
+  application: [WARNING] Command received: shutdown
+
+First response is not compressed:
+
+  $ curl_ "index.html"
+  HTTP/1.1 200 OK
+  content-type: text/html
+  server: Ocsigen
+  content-length: 12
+
+  Hello world
+
+Second response is compressed:
+
+  $ curl_ "index.html" --compressed
+  HTTP/1.1 200 OK
+  content-type: text/html
+  content-encoding: gzip
+  server: Ocsigen
+  transfer-encoding: chunked
+
+  Hello world

test/extensions/deflatemod.t/test.ml

@@ -0,0 +1,12 @@
+let () =
+  Logs.Src.set_level Deflatemod.section (Some Logs.Debug);
+  Logs.set_level ~all:true (Some Logs.Debug);
+  Ocsigen_server.start
+    ~ports:[ (`Unix "./local.sock", 0) ]
+    ~veryverbose:() ~debugmode:true ~logdir:"log" ~datadir:"data"
+    ~uploaddir:None ~usedefaulthostname:true ~command_pipe:"local.cmd"
+    ~default_charset:(Some "utf-8")
+    [
+      Ocsigen_server.host
+        [ Staticmod.run ~dir:"." (); Deflatemod.run ~mode:(`All_but []) () ];
+    ]

test/server-test-helpers.sh

@@ -0,0 +1,42 @@
+# Bash functions that help test ocsigenserver
+
+# Run the server using 'dune exec -- "$@"' and doing the necessary setup.
+# The server must listen on the unix-domain socket named "local.sock" and on
+# the command-pipe named "local.cmd".
+#
+# Usage:
+#   $ run_server ./test.exe
+#   $ curl_ "index.html"
+#
+run_server ()
+{
+  mkdir -p log data # Directories that might be required by the server
+  dune build "$1"
+  # Run the server in the background, cut the datetime out of the log output.
+  dune exec -- "$@" 2>&1 | cut -d ' ' -f 4- &
+  # Wait for the unix-domain socket and the command-pipe to be created
+  local timeout=50 # Don't wait more than 0.5s
+  while ! ( [[ -e ./local.sock ]] && [[ -e ./local.cmd ]] ) && (( timeout-- > 0 )); do
+    sleep 0.01
+  done
+  # Print an error if a file is missing
+  ls ./local.sock ./local.cmd >/dev/null || return 1
+  # Shutdown the server at the end of the test
+  trap 'echo shutdown > local.cmd && wait' EXIT
+}
+
+# Wrapper around 'curl' that connects to the server. First argument is the
+# request path, the other arguments are directly passed to 'curl'.
+#
+# Usage:
+#   $ curl_ ""
+#   $ curl_ "index.html"
+#   $ curl_ "index.html" --no-show-headers   # Supress the headers
+#
+curl_ ()
+{
+  local path=$1; shift
+  # Remove the 'date' header, which is unreproducible
+  curl --unix-socket ./local.sock -s -i "$@" "http://local-test/$path" | \
+    grep -v "^date: "
+}