ocaml/libs/http-svr/http_proxy.ml | 54 ------------------------------ ocaml/libs/http-svr/http_proxy.mli | 4 --- ocaml/libs/http-svr/http_svr.mli | 6 ---- 3 files changed, 64 deletions(-)
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA256
Xen Security Advisory CVE-2022-33749 / XSA-413
version 2
XAPI open file limit DoS
UPDATES IN VERSION 2
====================
Public release.
ISSUE DESCRIPTION
=================
It is possible for an unauthenticated client on the network to cause
XAPI to hit its file-descriptor limit. This causes XAPI to be unable
to accept new requests for other (trusted) clients, and blocks XAPI
from carrying out any tasks that require the opening of file
descriptors.
IMPACT
======
An attacker is capable of blocking connections to the XAPI HTTP
interface, and also interrupt ongoing operations, causing a XAPI
toolstack Denial of Service. Such DoS would also affect any guests
that require toolstack actions.
VULNERABLE SYSTEMS
==================
All versions of XAPI are vulnerable.
Systems which are not using the XAPI toolstack are not vulnerable.
MITIGATION
==========
Not exposing to untrusted clients the network interface XAPI is
listening on will prevent the issue.
RESOLUTION
==========
Applying the attached patches resolves this issue.
xsa413/xsa413-*.patch Xapi master
$ sha256sum xsa413*/*
63f72af7a92944700318add5cc200160ff7f834b6d304dd22441fa2de74c7b83 xsa413/xsa413-1.patch
6fbcbfb1915ebc4a726374d94e050406d8f1d52c3cb9afc06bcf7cec9e5a19c8 xsa413/xsa413-2.patch
c41de04ff2b63756e693c6c75ec4d7206a88db06c1da0b263c9d0644da90ef8b xsa413/xsa413-3.patch
6ee2dc09f6c5f64ce9627e9b4e314237817f7c0c2eebe30a2c83709d1faf0050 xsa413/xsa413-4.patch
360a5099ece45118488706acd76b6da3ca8e6f107cee24586dbf6ec7f5858aeb xsa413/xsa413-5.patch
cc79e086affcfd784ab8cd38e1d0acd6adb241c24141f3409161e417cc314b28 xsa413/xsa413-6.patch
$
DEPLOYMENT DURING EMBARGO
=========================
Deployment of the patches and/or mitigations described above (or
others which are substantially similar) is permitted during the
embargo, even on public-facing systems with untrusted guest users and
administrators.
But: Distribution of updated software is prohibited (except to other
members of the predisclosure list).
Predisclosure list members who wish to deploy significantly different
patches and/or mitigations, please contact the Xen Project Security
Team.
-----BEGIN PGP SIGNATURE-----
iQFABAEBCAAqFiEEI+MiLBRfRHX6gGCng/4UyVfoK9kFAmNFTAEMHHBncEB4ZW4u
b3JnAAoJEIP+FMlX6CvZmIMH/RBAGOrAi8NI7BBeGHwMW7WqyMfT6mTVUFkb2z9z
ZFtvPFvim5AobCUpAKFtUAWpSQoUEEPyTO83C2VDe9jQC37mRo/qAduX7wj8oaJv
Dq+QFECP95bsfmu0SwKYL7ZW+3lLxDVwtp88z4P/H/U0VYqG+bNrR569znBbn0wL
p7EKQG5A4PS0nLg8ehnxjwuKCn0dCgUIZibh3AIMOUDTFY/apVeDFbX7bKIoQgLV
/0B18MevryxqSRe3QpL2WW/kRGLLKF7i5SA7nAbOPMzPWHOLNDZb+b+Hq7/eYwzI
a2+6yUcBkWAqyi9M3fXkhslySA/WqLdPXBIkd47zZS9rIuU=
=Ih6z
-----END PGP SIGNATURE-----
From 93847b5eac0ac287dea9298f394d01a51eb962bb Mon Sep 17 00:00:00 2001
From: Rob Hoes <rob.hoes@citrix.com>
Date: Thu, 7 Jul 2022 13:40:56 +0000
Subject: [PATCH 1/6] Remove unused Http_proxy.http_proxy
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
ocaml/libs/http-svr/http_proxy.ml | 54 ------------------------------
ocaml/libs/http-svr/http_proxy.mli | 4 ---
ocaml/libs/http-svr/http_svr.mli | 6 ----
3 files changed, 64 deletions(-)
diff --git a/ocaml/libs/http-svr/http_proxy.ml b/ocaml/libs/http-svr/http_proxy.ml
index 0f474576d..4d7a1d82f 100644
--- a/ocaml/libs/http-svr/http_proxy.ml
+++ b/ocaml/libs/http-svr/http_proxy.ml
@@ -53,57 +53,3 @@ let one request fromfd s =
| m ->
error "Proxy doesn't support: %s" (Http.string_of_method_t m) ;
Http_svr.response_forbidden ~req:request fromfd
-
-let server = ref None
-
-let m = Mutex.create ()
-
-let http_proxy src_ip src_port transport =
- let tcp_connection _ fromfd =
- (* NB 'fromfd' is accepted within the server_io module and it expects us to close it *)
- finally
- (fun () ->
- let bio = Buf_io.of_fd fromfd in
- let request, _ = Http_svr.request_of_bio bio in
- Option.iter
- (fun request -> with_transport transport (one request fromfd))
- request
- )
- (fun () -> Unix.close fromfd)
- in
- try
- let addr = Unix.inet_addr_of_string src_ip in
- let sockaddr = Unix.ADDR_INET (addr, src_port) in
- Xapi_stdext_threads.Threadext.Mutex.execute m (fun () ->
- (* shutdown any server which currently exists *)
- Option.iter (fun server -> server.Server_io.shutdown ()) !server ;
- (* Make sure we don't try to double-close the server *)
- server := None ;
- let handler = {Server_io.name= "http_proxy"; body= tcp_connection} in
- let sock =
- Unix.socket (Unix.domain_of_sockaddr sockaddr) Unix.SOCK_STREAM 0
- in
- ( try
- (* Make sure exceptions cause the socket to be closed *)
- Unix.set_close_on_exec sock ;
- Unix.setsockopt sock Unix.SO_REUSEADDR true ;
- ( match sockaddr with
- | Unix.ADDR_INET _ ->
- Xapi_stdext_unix.Unixext.set_tcp_nodelay sock true
- | _ ->
- ()
- ) ;
- Unix.bind sock sockaddr ; Unix.listen sock 128
- with e ->
- debug "Caught exception in Http_svr.bind (closing socket): %s"
- (Printexc.to_string e) ;
- Unix.close sock ;
- raise e
- ) ;
- let s = Server_io.server handler sock in
- server := Some s
- )
- with e ->
- error "Caught exception setting up proxy from internal network: %s"
- (Printexc.to_string e) ;
- raise e
diff --git a/ocaml/libs/http-svr/http_proxy.mli b/ocaml/libs/http-svr/http_proxy.mli
index 43ef012de..a5161801d 100644
--- a/ocaml/libs/http-svr/http_proxy.mli
+++ b/ocaml/libs/http-svr/http_proxy.mli
@@ -15,7 +15,3 @@
val one : Http.Request.t -> Unix.file_descr -> Unix.file_descr -> unit
(** [one request input output] proxies the single HTTP request [request]
from [input] to [output] *)
-
-val http_proxy : string -> int -> Xmlrpc_client.transport -> unit
-(** [http_proxy ip port transport] establishes an HTTP proxy on [ip]:[port]
- which forwards all requests via [transport] *)
diff --git a/ocaml/libs/http-svr/http_svr.mli b/ocaml/libs/http-svr/http_svr.mli
index 8996e0203..6d9032ff4 100644
--- a/ocaml/libs/http-svr/http_svr.mli
+++ b/ocaml/libs/http-svr/http_svr.mli
@@ -125,9 +125,3 @@ val respond_to_options : Http.Request.t -> Unix.file_descr -> unit
val headers : Unix.file_descr -> string list -> unit
val read_body : ?limit:int -> Http.Request.t -> Buf_io.t -> string
-
-val request_of_bio :
- ?use_fastpath:bool
- -> ?proxy_seen:string
- -> Buf_io.t
- -> Http.Request.t option * string option
--
2.31.1
From db397b0c54405ed2341b6562df1c5a9f4ec8a827 Mon Sep 17 00:00:00 2001
From: Rob Hoes <rob.hoes@citrix.com>
Date: Thu, 7 Jul 2022 14:00:00 +0000
Subject: [PATCH 2/6] http-svr: remove "slow path"
Everything except a test already used the "fast path", so the slow
version was virtually unused (and slow).
Also removes some other dead code.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
ocaml/libs/http-svr/http.ml | 2 -
ocaml/libs/http-svr/http.mli | 2 -
ocaml/libs/http-svr/http_svr.ml | 140 +---------------------------
ocaml/libs/http-svr/http_svr.mli | 5 -
ocaml/libs/http-svr/test_server.ml | 7 +-
ocaml/xapi/xapi_http.ml | 1 -
ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml | 1 -
7 files changed, 5 insertions(+), 153 deletions(-)
diff --git a/ocaml/libs/http-svr/http.ml b/ocaml/libs/http-svr/http.ml
index 50e446573..4bca0f2f1 100644
--- a/ocaml/libs/http-svr/http.ml
+++ b/ocaml/libs/http-svr/http.ml
@@ -348,8 +348,6 @@ let read_up_to buf already_read marker fd =
done ;
!b
-let read_http_header buf fd = read_up_to buf 0 end_of_headers fd
-
let smallest_request = "GET / HTTP/1.0\r\n\r\n"
(* let smallest_response = "HTTP/1.0 200 OK\r\n\r\n" *)
diff --git a/ocaml/libs/http-svr/http.mli b/ocaml/libs/http-svr/http.mli
index c24a432e9..7463dd5f2 100644
--- a/ocaml/libs/http-svr/http.mli
+++ b/ocaml/libs/http-svr/http.mli
@@ -30,8 +30,6 @@ exception Forbidden
type authorization = Basic of string * string | UnknownAuth of string
-val read_http_header : bytes -> Unix.file_descr -> int
-
val make_frame_header : string -> string
val read_http_request_header : Unix.file_descr -> bool * string * string option
diff --git a/ocaml/libs/http-svr/http_svr.ml b/ocaml/libs/http-svr/http_svr.ml
index 71ed0f1e7..4c56f5be0 100644
--- a/ocaml/libs/http-svr/http_svr.ml
+++ b/ocaml/libs/http-svr/http_svr.ml
@@ -253,12 +253,10 @@ end)
module Server = struct
type 'a t = {
mutable handlers: 'a TE.t Radix_tree.t MethodMap.t
- ; mutable use_fastpath: bool
; default_context: 'a
}
- let empty default_context =
- {handlers= MethodMap.empty; use_fastpath= false; default_context}
+ let empty default_context = {handlers= MethodMap.empty; default_context}
let add_handler x ty uri handler =
let existing =
@@ -284,8 +282,6 @@ module Server = struct
MethodMap.fold
(fun m rt acc -> fold (fun k te acc -> (m, k, te.TE.stats) :: acc) acc rt)
x.handlers []
-
- let enable_fastpath x = x.use_fastpath <- true
end
let escape uri =
@@ -312,121 +308,10 @@ let escape uri =
]
uri
-exception Too_many_headers
-
exception Generic_error of string
-let request_of_bio_exn_slow ic =
- (* Try to keep the connection open for a while to prevent spurious End_of_file type
- problems under load *)
- let initial_timeout = 5. *. 60. in
- let content_length = ref (-1L) in
- let cookie = ref "" in
- let transfer_encoding = ref None in
- let accept = ref None in
- let auth = ref None in
- let task = ref None in
- let subtask_of = ref None in
- let content_type = ref None in
- let host = ref None in
- let user_agent = ref None in
- content_length := -1L ;
- cookie := "" ;
- let req =
- Buf_io.input_line ~timeout:initial_timeout ic
- |> Bytes.to_string
- |> Request.of_request_line
- in
- (* Default for HTTP/1.1 is persistent connections. Anything else closes *)
- (* the channel as soon as the request is processed *)
- if req.Request.version <> "1.1" then req.Request.close <- true ;
- let rec read_rest_of_headers left =
- let cl_hdr = lowercase Http.Hdr.content_length in
- let cookie_hdr = lowercase Http.Hdr.cookie in
- let connection_hdr = lowercase Http.Hdr.connection in
- let transfer_encoding_hdr = lowercase Http.Hdr.transfer_encoding in
- let accept_hdr = lowercase Http.Hdr.accept in
- let auth_hdr = lowercase Http.Hdr.authorization in
- let task_hdr = lowercase Http.Hdr.task_id in
- let subtask_of_hdr = lowercase Http.Hdr.subtask_of in
- let content_type_hdr = lowercase Http.Hdr.content_type in
- let host_hdr = lowercase Http.Hdr.host in
- let user_agent_hdr = lowercase Http.Hdr.user_agent in
- let r =
- Buf_io.input_line ~timeout:Buf_io.infinite_timeout ic |> Bytes.to_string
- in
- match Astring.String.cut ~sep:":" r with
- | Some (k, v) ->
- let k = lowercase k in
- let v = String.trim v in
- let absorbed =
- match k with
- | k when k = cl_hdr ->
- content_length := Int64.of_string v ;
- true
- | k when k = cookie_hdr ->
- cookie := v ;
- true
- | k when k = transfer_encoding_hdr ->
- transfer_encoding := Some v ;
- true
- | k when k = accept_hdr ->
- accept := Some v ;
- true
- | k when k = auth_hdr ->
- auth := Some (authorization_of_string v) ;
- true
- | k when k = task_hdr ->
- task := Some v ;
- true
- | k when k = subtask_of_hdr ->
- subtask_of := Some v ;
- true
- | k when k = content_type_hdr ->
- content_type := Some v ;
- true
- | k when k = host_hdr ->
- host := Some v ;
- true
- | k when k = user_agent_hdr ->
- user_agent := Some v ;
- true
- | k when k = connection_hdr ->
- req.Request.close <- lowercase v = "close" ;
- true
- | _ ->
- false
- in
- if (not absorbed) && left <= 0 then raise Too_many_headers ;
- if absorbed then
- read_rest_of_headers (left - 1)
- else
- (k, v) :: read_rest_of_headers (left - 1)
- | None ->
- []
- in
- let headers = read_rest_of_headers 242 in
- let request =
- {
- req with
- Request.cookie= Http.parse_keyvalpairs !cookie
- ; content_length=
- (if !content_length = -1L then None else Some !content_length)
- ; auth= !auth
- ; task= !task
- ; subtask_of= !subtask_of
- ; content_type= !content_type
- ; host= !host
- ; user_agent= !user_agent
- ; additional_headers= headers
- ; accept= !accept
- }
- in
- (request, None)
-
(** [request_of_bio_exn ic] reads a single Http.req from [ic] and returns it. On error
it simply throws an exception and doesn't touch the output stream. *)
-
let request_of_bio_exn ~proxy_seen bio =
let fd = Buf_io.fd_of bio in
let frame, headers, proxy' = Http.read_http_request_header fd in
@@ -505,20 +390,9 @@ let request_of_bio_exn ~proxy_seen bio =
(** [request_of_bio ic] returns [Some req] read from [ic], or [None]. If [None] it will have
already sent back a suitable error code and response to the client. *)
-let request_of_bio ?(use_fastpath = false) ?proxy_seen ic =
+let request_of_bio ?proxy_seen ic =
try
- let r, proxy =
- ( if use_fastpath then
- request_of_bio_exn ~proxy_seen
- else
- request_of_bio_exn_slow
- )
- ic
- in
- (*
- Printf.fprintf stderr "Parsed [%s]\n" (Http.Request.to_wire_string r);
- flush stderr;
-*)
+ let r, proxy = request_of_bio_exn ~proxy_seen ic in
(Some r, proxy)
with e ->
D.warn "%s (%s)" (Printexc.to_string e) __LOC__ ;
@@ -530,10 +404,6 @@ let request_of_bio ?(use_fastpath = false) ?proxy_seen ic =
response_internal_error ss
~extra:"The HTTP headers could not be parsed." ;
debug "Error parsing HTTP headers"
- | Too_many_headers ->
- (* don't log anything, since it could fill the log *)
- response_internal_error ss
- ~extra:"Too many HTTP headers were received."
| Buf_io.Timeout ->
()
(* Idle connection closed. NB infinite timeout used when headers are being read *)
@@ -623,9 +493,7 @@ let handle_connection (x : 'a Server.t) _ ss =
along in the loop below. *)
let rec loop proxy_seen =
(* 1. we must successfully parse a request *)
- let req, proxy =
- request_of_bio ~use_fastpath:x.Server.use_fastpath ?proxy_seen ic
- in
+ let req, proxy = request_of_bio ?proxy_seen ic in
(* 2. now we attempt to process the request *)
let finished =
Option.fold ~none:true
diff --git a/ocaml/libs/http-svr/http_svr.mli b/ocaml/libs/http-svr/http_svr.mli
index 6d9032ff4..3781c7eee 100644
--- a/ocaml/libs/http-svr/http_svr.mli
+++ b/ocaml/libs/http-svr/http_svr.mli
@@ -48,13 +48,8 @@ module Server : sig
val all_stats : 'a t -> (Http.method_t * uri_path * Stats.t) list
(** [all_stats x] returns a list of (method, uri, stats) triples *)
-
- val enable_fastpath : 'a t -> unit
- (** [enable_fastpath x] switches on experimental performance optimisations *)
end
-exception Too_many_headers
-
exception Generic_error of string
type socket
diff --git a/ocaml/libs/http-svr/test_server.ml b/ocaml/libs/http-svr/test_server.ml
index 1276a7dc7..2b398cfa7 100644
--- a/ocaml/libs/http-svr/test_server.ml
+++ b/ocaml/libs/http-svr/test_server.ml
@@ -10,17 +10,12 @@ let finished_c = Condition.create ()
let _ =
let port = ref 8080 in
- let use_fastpath = ref false in
Arg.parse
- [
- ("-p", Arg.Set_int port, "port to listen on")
- ; ("-fast", Arg.Set use_fastpath, "use HTTP fastpath")
- ]
+ [("-p", Arg.Set_int port, "port to listen on")]
(fun x -> Printf.fprintf stderr "Ignoring unexpected argument: %s\n" x)
"A simple test HTTP server" ;
let open Http_svr in
let server = Server.empty () in
- if !use_fastpath then Server.enable_fastpath server ;
Server.add_handler server Http.Get "/stop"
(FdIO
(fun _ s _ ->
diff --git a/ocaml/xapi/xapi_http.ml b/ocaml/xapi/xapi_http.ml
index 2c54a8d42..9eee46c3f 100644
--- a/ocaml/xapi/xapi_http.ml
+++ b/ocaml/xapi/xapi_http.ml
@@ -282,7 +282,6 @@ let with_context ?(dummy = false) label (req : Request.t) (s : Unix.file_descr)
let server =
let server = Http_svr.Server.empty () in
- Http_svr.Server.enable_fastpath server ;
server
let http_request = Http.Request.make ~user_agent:Constants.xapi_user_agent
diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
index fa6791842..49dc74131 100644
--- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
+++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
@@ -74,7 +74,6 @@ let accept_forever sock f =
(* Bind server to the file descriptor. *)
let start (xmlrpc_path, http_fwd_path) process =
let server = Http_svr.Server.empty () in
- Http_svr.Server.enable_fastpath server ;
let open Rrdd_http_handler in
Http_svr.Server.add_handler server Http.Post "/"
(Http_svr.BufIO (xmlrpc_handler process)) ;
--
2.31.1
From cb2450cf16a80438898c78cacb59f2f1e3aa94be Mon Sep 17 00:00:00 2001
From: Rob Hoes <rob.hoes@citrix.com>
Date: Mon, 11 Jul 2022 16:28:21 +0000
Subject: [PATCH 3/6] Limit concurrent connections with semaphore
To add some protection against overloading the server, and running out
of file descriptors and other resources, the number of concurrent
connections is now limited to 800 by default. Connections coming in when
the limit has been reached are put on hold, and not accepted until
another connection finishes.
There are three separate buckets for connections to the main unix
socket, the client-cert (unix) socket and the TCP socket.
This also add some more debug logging when connections are accepted and
disconnected. This is disabled by default along with other "http" logs,
but can be enabled in the conf file.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
ocaml/database/database_server_main.ml | 2 +-
ocaml/libs/http-svr/http_svr.ml | 26 ++++++++++++++++++++++----
ocaml/libs/http-svr/http_svr.mli | 2 +-
ocaml/libs/http-svr/server_io.ml | 17 +++++++++++------
ocaml/libs/http-svr/server_io.mli | 1 +
ocaml/libs/http-svr/test_server.ml | 2 +-
ocaml/xapi/xapi.ml | 6 +++++-
ocaml/xapi/xapi_globs.ml | 9 +++++++++
ocaml/xapi/xapi_mgmt_iface.ml | 7 +++++--
ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml | 2 +-
10 files changed, 57 insertions(+), 17 deletions(-)
diff --git a/ocaml/database/database_server_main.ml b/ocaml/database/database_server_main.ml
index 9778e4a39..4809bc7fd 100644
--- a/ocaml/database/database_server_main.ml
+++ b/ocaml/database/database_server_main.ml
@@ -81,7 +81,7 @@ let _ =
(Http_svr.BufIO remote_database_access_handler_v1) ;
Http_svr.Server.add_handler server Http.Post "/post_remote_db_access_v2"
(Http_svr.BufIO remote_database_access_handler_v2) ;
- Http_svr.start server socket ;
+ Http_svr.start ~conn_limit:1024 server socket ;
Printf.printf "server listening\n%!" ;
if !self_test then (
Printf.printf "Running unit-tests\n%!" ;
diff --git a/ocaml/libs/http-svr/http_svr.ml b/ocaml/libs/http-svr/http_svr.ml
index 4c56f5be0..9017f94bf 100644
--- a/ocaml/libs/http-svr/http_svr.ml
+++ b/ocaml/libs/http-svr/http_svr.ml
@@ -105,6 +105,7 @@ let response_fct req ?(hdrs = []) s (response_length : int64)
Http.Response.content_length= Some response_length
}
in
+ D.debug "Response %s" (Http.Response.to_string res) ;
Unixext.really_write_string s (Http.Response.to_wire_string res) ;
write_response_to_fd_fn s
@@ -122,6 +123,7 @@ let response_missing ?(hdrs = []) s body =
~headers:(connection :: cache :: hdrs)
~body "404" "Not Found"
in
+ D.debug "Response %s" (Http.Response.to_string res) ;
Unixext.really_write_string s (Http.Response.to_wire_string res)
let response_error_html ?(version = "1.1") s code message hdrs body =
@@ -133,6 +135,7 @@ let response_error_html ?(version = "1.1") s code message hdrs body =
~headers:(content_type :: connection :: cache :: hdrs)
~body code message
in
+ D.debug "Response %s" (Http.Response.to_string res) ;
Unixext.really_write_string s (Http.Response.to_wire_string res)
let response_unauthorised ?req label s =
@@ -484,7 +487,15 @@ let handle_one (x : 'a Server.t) ss context req =
) ;
!finished
-let handle_connection (x : 'a Server.t) _ ss =
+let handle_connection (x : 'a Server.t) caller ss =
+ ( match caller with
+ | Unix.ADDR_UNIX _ ->
+ debug "Accepted unix connection"
+ | Unix.ADDR_INET (addr, port) ->
+ debug "Accepted inet connection from %s:%d"
+ (Unix.string_of_inet_addr addr)
+ port
+ ) ;
let ic = Buf_io.of_fd ss in
(* For HTTPS requests, a PROXY header is sent by stunnel right at the beginning of
of its connection to the server, before HTTP requests are transferred, and
@@ -504,7 +515,7 @@ let handle_connection (x : 'a Server.t) _ ss =
if not finished then
loop proxy
in
- loop None ; Unix.close ss
+ loop None ; debug "Closing connection" ; Unix.close ss
let bind ?(listen_backlog = 128) sockaddr name =
let domain =
@@ -570,8 +581,15 @@ let socket_table = Hashtbl.create 10
type socket = Unix.file_descr * string
(* Start an HTTP server on a new socket *)
-let start (x : 'a Server.t) (socket, name) =
- let handler = {Server_io.name; body= handle_connection x} in
+let start ~conn_limit (x : 'a Server.t) (socket, name)
+ =
+let handler =
+ {
+ Server_io.name
+ ; body= handle_connection x
+ ; lock= Xapi_stdext_threads.Semaphore.create conn_limit
+ }
+ in
let server = Server_io.server handler socket in
Hashtbl.add socket_table socket server
diff --git a/ocaml/libs/http-svr/http_svr.mli b/ocaml/libs/http-svr/http_svr.mli
index 3781c7eee..d0c79e4d4 100644
--- a/ocaml/libs/http-svr/http_svr.mli
+++ b/ocaml/libs/http-svr/http_svr.mli
@@ -59,7 +59,7 @@ val bind : ?listen_backlog:int -> Unix.sockaddr -> string -> socket
(* [bind_retry]: like [bind] but will catch (possibly transient exceptions) and retry *)
val bind_retry : ?listen_backlog:int -> Unix.sockaddr -> socket
-val start : 'a Server.t -> socket -> unit
+val start : conn_limit:int -> 'a Server.t -> socket -> unit
val handle_one : 'a Server.t -> Unix.file_descr -> 'a -> Http.Request.t -> bool
diff --git a/ocaml/libs/http-svr/server_io.ml b/ocaml/libs/http-svr/server_io.ml
index 28fd584d1..9b2d33a0e 100644
--- a/ocaml/libs/http-svr/server_io.ml
+++ b/ocaml/libs/http-svr/server_io.ml
@@ -23,12 +23,17 @@ type handler = {
name: string
; (* body should close the provided fd *)
body: Unix.sockaddr -> Unix.file_descr -> unit
+ ; lock: Xapi_stdext_threads.Semaphore.t
}
let handler_by_thread (h : handler) (s : Unix.file_descr)
(caller : Unix.sockaddr) =
Thread.create
- (fun () -> Debug.with_thread_named h.name (fun () -> h.body caller s) ())
+ (fun () ->
+ Fun.protect
+ ~finally:(fun () -> Xapi_stdext_threads.Semaphore.release h.lock 1)
+ (Debug.with_thread_named h.name (fun () -> h.body caller s))
+ )
()
(** Function with the main accept loop *)
@@ -37,16 +42,17 @@ exception PleaseClose
let set_intersect a b = List.filter (fun x -> List.mem x b) a
-let establish_server ?(signal_fds = []) forker sock =
+let establish_server ?(signal_fds = []) forker handler sock =
while true do
try
let r, _, _ = Unix.select ([sock] @ signal_fds) [] [] (-1.) in
(* If any of the signal_fd is active then bail out *)
if set_intersect r signal_fds <> [] then raise PleaseClose ;
+ Xapi_stdext_threads.Semaphore.acquire handler.lock 1 ;
let s, caller = Unix.accept sock in
try
Unix.set_close_on_exec s ;
- ignore (forker s caller)
+ ignore (forker handler s caller)
with exc ->
(* NB provided 'forker' is configured to make a background thread then the
only way we can get here is if set_close_on_exec or Thread.create fails.
@@ -89,9 +95,8 @@ let server handler sock =
Debug.with_thread_named handler.name
(fun () ->
try
- establish_server ~signal_fds:[status_out]
- (handler_by_thread handler)
- sock
+ establish_server ~signal_fds:[status_out] handler_by_thread
+ handler sock
with PleaseClose -> debug "Server thread exiting"
)
()
diff --git a/ocaml/libs/http-svr/server_io.mli b/ocaml/libs/http-svr/server_io.mli
index b48952f89..3aca02347 100644
--- a/ocaml/libs/http-svr/server_io.mli
+++ b/ocaml/libs/http-svr/server_io.mli
@@ -16,6 +16,7 @@ type handler = {
name: string (** used for naming the thread *)
; body: Unix.sockaddr -> Unix.file_descr -> unit
(** function called in a thread for each connection*)
+ ; lock: Xapi_stdext_threads.Semaphore.t
}
type server = {
diff --git a/ocaml/libs/http-svr/test_server.ml b/ocaml/libs/http-svr/test_server.ml
index 2b398cfa7..51e4f559e 100644
--- a/ocaml/libs/http-svr/test_server.ml
+++ b/ocaml/libs/http-svr/test_server.ml
@@ -68,7 +68,7 @@ let _ =
let inet_addr = Unix.inet_addr_of_string ip in
let addr = Unix.ADDR_INET (inet_addr, !port) in
let socket = Http_svr.bind ~listen_backlog:5 addr "server" in
- start server socket ;
+ start ~conn_limit:1024 server socket ;
Printf.printf "Server started on %s:%d\n" ip !port ;
with_lock finished_m (fun () ->
while not !finished do
diff --git a/ocaml/xapi/xapi.ml b/ocaml/xapi/xapi.ml
index d0b71fb0f..3d83d6e39 100644
--- a/ocaml/xapi/xapi.ml
+++ b/ocaml/xapi/xapi.ml
@@ -844,7 +844,11 @@ let listen_unix_socket sock_path =
Unixext.mkdir_safe (Filename.dirname sock_path) 0o700 ;
Unixext.unlink_safe sock_path ;
let domain_sock = Xapi_http.bind (Unix.ADDR_UNIX sock_path) in
- ignore (Http_svr.start Xapi_http.server domain_sock)
+ ignore
+ (Http_svr.start
+ ~conn_limit:!Xapi_globs.conn_limit_unix
+ Xapi_http.server domain_sock
+ )
let set_stunnel_timeout () =
try
diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml
index d9c0c2b7b..8dfd98538 100644
--- a/ocaml/xapi/xapi_globs.ml
+++ b/ocaml/xapi/xapi_globs.ml
@@ -957,6 +957,12 @@ let sqlite3 = ref "/usr/bin/sqlite3"
let samba_dir = "/var/lib/samba"
+let conn_limit_tcp = ref 800
+
+let conn_limit_unix = ref 1024
+
+let conn_limit_clientcert = ref 800
+
let xapi_globs_spec =
[
( "master_connection_reset_timeout"
@@ -1030,6 +1036,9 @@ let xapi_globs_spec =
; ( "winbind_update_closest_kdc_interval"
, Float winbind_update_closest_kdc_interval
)
+ ; ("conn_limit_tcp", Int conn_limit_tcp)
+ ; ("conn_limit_unix", Int conn_limit_unix)
+ ; ("conn_limit_clientcert", Int conn_limit_clientcert)
]
let options_of_xapi_globs_spec =
diff --git a/ocaml/xapi/xapi_mgmt_iface.ml b/ocaml/xapi/xapi_mgmt_iface.ml
index be93ae258..381617f47 100644
--- a/ocaml/xapi/xapi_mgmt_iface.ml
+++ b/ocaml/xapi/xapi_mgmt_iface.ml
@@ -81,7 +81,8 @@ end = struct
ipv6_enabled := Unix.domain_of_sockaddr sockaddr = Unix.PF_INET6 ;
Xapi_http.bind sockaddr
in
- Http_svr.start Xapi_http.server socket ;
+ Http_svr.start ~conn_limit:!Xapi_globs.conn_limit_tcp Xapi_http.server
+ socket ;
management_servers := socket :: !management_servers ;
if Pool_role.is_master () && addr = None then
(* NB if we synchronously bring up the management interface on a master with a blank
@@ -139,7 +140,9 @@ module Client_certificate_auth_server = struct
Unixext.mkdir_safe (Filename.dirname sock_path) 0o700 ;
Unixext.unlink_safe sock_path ;
let domain_sock = Xapi_http.bind (Unix.ADDR_UNIX sock_path) in
- Http_svr.start Xapi_http.server domain_sock ;
+ Http_svr.start
+ ~conn_limit:!Xapi_globs.conn_limit_clientcert
+ Xapi_http.server domain_sock ;
management_server := Some domain_sock
)
diff --git a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
index 49dc74131..8d017d481 100644
--- a/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
+++ b/ocaml/xcp-rrdd/bin/rrdd/xcp_rrdd.ml
@@ -93,7 +93,7 @@ let start (xmlrpc_path, http_fwd_path) process =
Xapi_stdext_unix.Unixext.mkdir_safe (Filename.dirname xmlrpc_path) 0o700 ;
Xapi_stdext_unix.Unixext.unlink_safe xmlrpc_path ;
let xmlrpc_socket = Http_svr.bind (Unix.ADDR_UNIX xmlrpc_path) "unix_rpc" in
- Http_svr.start server xmlrpc_socket ;
+ Http_svr.start ~conn_limit:1024 server xmlrpc_socket ;
Xapi_stdext_unix.Unixext.unlink_safe http_fwd_path ;
let http_fwd_socket = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in
Unix.bind http_fwd_socket (Unix.ADDR_UNIX http_fwd_path) ;
--
2.31.1
From 1bbbe98e4b7a51b493e49408663cd6e657416061 Mon Sep 17 00:00:00 2001
From: Rob Hoes <rob.hoes@citrix.com>
Date: Fri, 8 Jul 2022 10:24:27 +0000
Subject: [PATCH 4/6] Receive timeout for TCP connections when first reading
HTTP headers
When a connection to xapi's TCP socket is established, no authentication
has taken place until the HTTP request has been received. We need to
treat these connections with some more care until then.
To protect against unauthenticated clients holding connections open
without actually making any calls, a read timeout (10 seconds by
default) is introduced for every read from the socket until all headers
have been read. An HTTP 408 "request timeout" response is returned and
the connection broken if a timeout occurs.
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
ocaml/libs/http-svr/http.ml | 10 ++++++++-
ocaml/libs/http-svr/http.mli | 3 ++-
ocaml/libs/http-svr/http_svr.ml | 38 ++++++++++++++++++++------------
ocaml/libs/http-svr/http_svr.mli | 3 ++-
ocaml/libs/http-svr/http_test.ml | 2 +-
ocaml/xapi/xapi_globs.ml | 4 ++++
ocaml/xapi/xapi_mgmt_iface.ml | 5 +++--
7 files changed, 45 insertions(+), 20 deletions(-)
diff --git a/ocaml/libs/http-svr/http.ml b/ocaml/libs/http-svr/http.ml
index 4bca0f2f1..a4d528d8c 100644
--- a/ocaml/libs/http-svr/http.ml
+++ b/ocaml/libs/http-svr/http.ml
@@ -363,7 +363,14 @@ let read_frame_header buf =
let prefix = Bytes.sub_string buf 0 frame_header_length in
try Scanf.sscanf prefix "FRAME %012d" (fun x -> Some x) with _ -> None
-let read_http_request_header fd =
+let set_socket_timeout fd t =
+ try Unix.(setsockopt_float fd SO_RCVTIMEO t)
+ with Unix.Unix_error (Unix.ENOTSOCK, _, _) ->
+ (* In the unit tests, the fd comes from a pipe... ignore *)
+ ()
+
+let read_http_request_header ~read_timeout fd =
+ Option.iter (fun t -> set_socket_timeout fd t) read_timeout ;
let buf = Bytes.create 1024 in
Unixext.really_read fd buf 0 6 ;
(* return PROXY header if it exists, and then read up to FRAME header length (which also may not exist) *)
@@ -387,6 +394,7 @@ let read_http_request_header fd =
Unixext.really_read fd buf 0 length ;
(true, length)
in
+ set_socket_timeout fd 0. ;
(frame, Bytes.sub_string buf 0 headers_length, proxy)
let read_http_response_header buf fd =
diff --git a/ocaml/libs/http-svr/http.mli b/ocaml/libs/http-svr/http.mli
index 7463dd5f2..b06ad105f 100644
--- a/ocaml/libs/http-svr/http.mli
+++ b/ocaml/libs/http-svr/http.mli
@@ -32,7 +32,8 @@ type authorization = Basic of string * string | UnknownAuth of string
val make_frame_header : string -> string
-val read_http_request_header : Unix.file_descr -> bool * string * string option
+val read_http_request_header :
+ read_timeout:float option -> Unix.file_descr -> bool * string * string option
val read_http_response_header : bytes -> Unix.file_descr -> int
diff --git a/ocaml/libs/http-svr/http_svr.ml b/ocaml/libs/http-svr/http_svr.ml
index 9017f94bf..77dea08bd 100644
--- a/ocaml/libs/http-svr/http_svr.ml
+++ b/ocaml/libs/http-svr/http_svr.ml
@@ -163,6 +163,13 @@ let response_badrequest ?req s =
in
response_error_html ?version s "400" "Bad Request" [] body
+let response_request_timeout s =
+ let body =
+ "<html><body><h1>HTTP 408 request timeout</h1>Timed out waiting for the \
+ request.</body></html>"
+ in
+ response_error_html s "408" "Request Timeout" [] body
+
let response_internal_error ?req ?extra s =
let version = Option.map get_return_version req in
let extra =
@@ -315,9 +322,9 @@ exception Generic_error of string
(** [request_of_bio_exn ic] reads a single Http.req from [ic] and returns it. On error
it simply throws an exception and doesn't touch the output stream. *)
-let request_of_bio_exn ~proxy_seen bio =
+let request_of_bio_exn ~proxy_seen ~read_timeout bio =
let fd = Buf_io.fd_of bio in
- let frame, headers, proxy' = Http.read_http_request_header fd in
+ let frame, headers, proxy' = Http.read_http_request_header ~read_timeout fd in
let proxy = match proxy' with None -> proxy_seen | x -> x in
let additional_headers =
proxy |> Option.fold ~none:[] ~some:(fun p -> [("STUNNEL_PROXY", p)])
@@ -393,9 +400,9 @@ let request_of_bio_exn ~proxy_seen bio =
(** [request_of_bio ic] returns [Some req] read from [ic], or [None]. If [None] it will have
already sent back a suitable error code and response to the client. *)
-let request_of_bio ?proxy_seen ic =
+let request_of_bio ?proxy_seen ~read_timeout ic =
try
- let r, proxy = request_of_bio_exn ~proxy_seen ic in
+ let r, proxy = request_of_bio_exn ~proxy_seen ~read_timeout ic in
(Some r, proxy)
with e ->
D.warn "%s (%s)" (Printexc.to_string e) __LOC__ ;
@@ -419,6 +426,8 @@ let request_of_bio ?proxy_seen ic =
(* Generic errors thrown during parsing *)
| End_of_file ->
()
+ | Unix.Unix_error (Unix.EAGAIN, _, _) ->
+ response_request_timeout ss
(* Premature termination of connection! *)
| Unix.Unix_error (a, b, c) ->
response_internal_error ss
@@ -487,7 +496,7 @@ let handle_one (x : 'a Server.t) ss context req =
) ;
!finished
-let handle_connection (x : 'a Server.t) caller ss =
+let handle_connection ~header_read_timeout (x : 'a Server.t) caller ss =
( match caller with
| Unix.ADDR_UNIX _ ->
debug "Accepted unix connection"
@@ -502,20 +511,22 @@ let handle_connection (x : 'a Server.t) caller ss =
just once per connection. To allow for the PROXY metadata (including e.g. the
client IP) to be added to all request records on a connection, it must be passed
along in the loop below. *)
- let rec loop proxy_seen =
+ let rec loop ~read_timeout proxy_seen =
(* 1. we must successfully parse a request *)
- let req, proxy = request_of_bio ?proxy_seen ic in
+ let req, proxy = request_of_bio ?proxy_seen ~read_timeout ic in
(* 2. now we attempt to process the request *)
let finished =
Option.fold ~none:true
~some:(handle_one x ss x.Server.default_context)
req
in
- (* 3. do it again if the connection is kept open *)
+ (* 3. do it again if the connection is kept open, but without timeouts *)
if not finished then
- loop proxy
+ loop ~read_timeout:None proxy
in
- loop None ; debug "Closing connection" ; Unix.close ss
+ loop ~read_timeout:header_read_timeout None ;
+ debug "Closing connection" ;
+ Unix.close ss
let bind ?(listen_backlog = 128) sockaddr name =
let domain =
@@ -581,12 +592,11 @@ let socket_table = Hashtbl.create 10
type socket = Unix.file_descr * string
(* Start an HTTP server on a new socket *)
-let start ~conn_limit (x : 'a Server.t) (socket, name)
- =
-let handler =
+let start ?header_read_timeout ~conn_limit (x : 'a Server.t) (socket, name) =
+ let handler =
{
Server_io.name
- ; body= handle_connection x
+ ; body= handle_connection ~header_read_timeout x
; lock= Xapi_stdext_threads.Semaphore.create conn_limit
}
in
diff --git a/ocaml/libs/http-svr/http_svr.mli b/ocaml/libs/http-svr/http_svr.mli
index d0c79e4d4..40a5074ea 100644
--- a/ocaml/libs/http-svr/http_svr.mli
+++ b/ocaml/libs/http-svr/http_svr.mli
@@ -59,7 +59,8 @@ val bind : ?listen_backlog:int -> Unix.sockaddr -> string -> socket
(* [bind_retry]: like [bind] but will catch (possibly transient exceptions) and retry *)
val bind_retry : ?listen_backlog:int -> Unix.sockaddr -> socket
-val start : conn_limit:int -> 'a Server.t -> socket -> unit
+val start :
+ ?header_read_timeout:float -> conn_limit:int -> 'a Server.t -> socket -> unit
val handle_one : 'a Server.t -> Unix.file_descr -> 'a -> Http.Request.t -> bool
diff --git a/ocaml/libs/http-svr/http_test.ml b/ocaml/libs/http-svr/http_test.ml
index 0633c58d1..e067a8b8a 100644
--- a/ocaml/libs/http-svr/http_test.ml
+++ b/ocaml/libs/http-svr/http_test.ml
@@ -200,7 +200,7 @@ let test_read_http_request_header _ =
|> List.iter (fun (frame, proxy, header) ->
with_fd (mk_header_string ~frame ~proxy ~header) (fun fd ->
let actual_frame, actual_header, actual_proxy =
- Http.read_http_request_header fd
+ Http.read_http_request_header ~read_timeout:None fd
in
assert (actual_frame = frame) ;
assert (actual_header = header) ;
diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml
index 8dfd98538..4c874ff65 100644
--- a/ocaml/xapi/xapi_globs.ml
+++ b/ocaml/xapi/xapi_globs.ml
@@ -957,6 +957,9 @@ let sqlite3 = ref "/usr/bin/sqlite3"
let samba_dir = "/var/lib/samba"
+let header_read_timeout_tcp = ref 10.
+(* Timeout in seconds for every read while reading HTTP headers (on TCP only) *)
+
let conn_limit_tcp = ref 800
let conn_limit_unix = ref 1024
@@ -1036,6 +1039,7 @@ let xapi_globs_spec =
; ( "winbind_update_closest_kdc_interval"
, Float winbind_update_closest_kdc_interval
)
+ ; ("header_read_timeout_tcp", Float header_read_timeout_tcp)
; ("conn_limit_tcp", Int conn_limit_tcp)
; ("conn_limit_unix", Int conn_limit_unix)
; ("conn_limit_clientcert", Int conn_limit_clientcert)
diff --git a/ocaml/xapi/xapi_mgmt_iface.ml b/ocaml/xapi/xapi_mgmt_iface.ml
index 381617f47..80a4852aa 100644
--- a/ocaml/xapi/xapi_mgmt_iface.ml
+++ b/ocaml/xapi/xapi_mgmt_iface.ml
@@ -81,8 +81,9 @@ end = struct
ipv6_enabled := Unix.domain_of_sockaddr sockaddr = Unix.PF_INET6 ;
Xapi_http.bind sockaddr
in
- Http_svr.start ~conn_limit:!Xapi_globs.conn_limit_tcp Xapi_http.server
- socket ;
+ Http_svr.start
+ ~header_read_timeout:!Xapi_globs.header_read_timeout_tcp
+ ~conn_limit:!Xapi_globs.conn_limit_tcp Xapi_http.server socket ;
management_servers := socket :: !management_servers ;
if Pool_role.is_master () && addr = None then
(* NB if we synchronously bring up the management interface on a master with a blank
--
2.31.1
From 7eb8821effdd37e9fcca0493962fae70dc8b5e98 Mon Sep 17 00:00:00 2001
From: Rob Hoes <rob.hoes@citrix.com>
Date: Tue, 26 Jul 2022 14:57:42 +0000
Subject: [PATCH 5/6] Total timeout for receiving HTTP headers
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
ocaml/libs/http-svr/http.ml | 42 ++++++++++++++++++++++++++------
ocaml/libs/http-svr/http.mli | 7 +++++-
ocaml/libs/http-svr/http_svr.ml | 33 ++++++++++++++++---------
ocaml/libs/http-svr/http_svr.mli | 7 +++++-
ocaml/libs/http-svr/http_test.ml | 3 ++-
ocaml/xapi/xapi_globs.ml | 4 +++
ocaml/xapi/xapi_mgmt_iface.ml | 1 +
7 files changed, 74 insertions(+), 23 deletions(-)
diff --git a/ocaml/libs/http-svr/http.ml b/ocaml/libs/http-svr/http.ml
index a4d528d8c..af8a56ee2 100644
--- a/ocaml/libs/http-svr/http.ml
+++ b/ocaml/libs/http-svr/http.ml
@@ -26,6 +26,8 @@ exception Method_not_implemented
exception Malformed_url of string
+exception Timeout
+
module D = Debug.Make (struct let name = "http" end)
open D
@@ -281,7 +283,7 @@ let header_len_header = Printf.sprintf "\r\n%s:" Hdr.header_len
let header_len_value_len = 5
-let read_up_to buf already_read marker fd =
+let read_up_to ?deadline buf already_read marker fd =
let marker = Scanner.make marker in
let hl_marker = Scanner.make header_len_header in
let b = ref 0 in
@@ -289,6 +291,12 @@ let read_up_to buf already_read marker fd =
let header_len = ref None in
let header_len_value_at = ref None in
while not (Scanner.matched marker) do
+ Option.iter
+ (fun d ->
+ if Mtime.Span.compare (Mtime_clock.elapsed ()) d > 0 then
+ raise Timeout
+ )
+ deadline ;
let safe_to_read =
match (!header_len_value_at, !header_len) with
| None, None ->
@@ -369,29 +377,47 @@ let set_socket_timeout fd t =
(* In the unit tests, the fd comes from a pipe... ignore *)
()
-let read_http_request_header ~read_timeout fd =
+let read_http_request_header ~read_timeout ~total_timeout fd =
Option.iter (fun t -> set_socket_timeout fd t) read_timeout ;
let buf = Bytes.create 1024 in
- Unixext.really_read fd buf 0 6 ;
+ let deadline =
+ Option.map
+ (fun t ->
+ let start = Mtime_clock.elapsed () in
+ let timeout_ns = int_of_float (t *. 1e9) in
+ Mtime.Span.(add start (timeout_ns * ns))
+ )
+ total_timeout
+ in
+ let check_timeout_and_read x y =
+ Option.iter
+ (fun d ->
+ if Mtime.Span.compare (Mtime_clock.elapsed ()) d > 0 then
+ raise Timeout
+ )
+ deadline ;
+ Unixext.really_read fd buf x y
+ in
+ check_timeout_and_read 0 6 ;
(* return PROXY header if it exists, and then read up to FRAME header length (which also may not exist) *)
let proxy =
match Bytes.sub_string buf 0 6 with
| "PROXY " ->
- let proxy_header_length = read_up_to buf 6 "\r\n" fd in
+ let proxy_header_length = read_up_to ?deadline buf 6 "\r\n" fd in
(* chop 'PROXY ' from the beginning, and '\r\n' from the end *)
let proxy = Bytes.sub_string buf 6 (proxy_header_length - 6 - 2) in
- Unixext.really_read fd buf 0 frame_header_length ;
+ check_timeout_and_read 0 frame_header_length ;
Some proxy
| _ ->
- Unixext.really_read fd buf 6 (frame_header_length - 6) ;
+ check_timeout_and_read 6 (frame_header_length - 6) ;
None
in
let frame, headers_length =
match read_frame_header buf with
| None ->
- (false, read_up_to buf frame_header_length end_of_headers fd)
+ (false, read_up_to ?deadline buf frame_header_length end_of_headers fd)
| Some length ->
- Unixext.really_read fd buf 0 length ;
+ check_timeout_and_read 0 length ;
(true, length)
in
set_socket_timeout fd 0. ;
diff --git a/ocaml/libs/http-svr/http.mli b/ocaml/libs/http-svr/http.mli
index b06ad105f..23e636a50 100644
--- a/ocaml/libs/http-svr/http.mli
+++ b/ocaml/libs/http-svr/http.mli
@@ -28,12 +28,17 @@ exception Method_not_implemented
exception Forbidden
+exception Timeout
+
type authorization = Basic of string * string | UnknownAuth of string
val make_frame_header : string -> string
val read_http_request_header :
- read_timeout:float option -> Unix.file_descr -> bool * string * string option
+ read_timeout:float option
+ -> total_timeout:float option
+ -> Unix.file_descr
+ -> bool * string * string option
val read_http_response_header : bytes -> Unix.file_descr -> int
diff --git a/ocaml/libs/http-svr/http_svr.ml b/ocaml/libs/http-svr/http_svr.ml
index 77dea08bd..155462d33 100644
--- a/ocaml/libs/http-svr/http_svr.ml
+++ b/ocaml/libs/http-svr/http_svr.ml
@@ -322,9 +322,11 @@ exception Generic_error of string
(** [request_of_bio_exn ic] reads a single Http.req from [ic] and returns it. On error
it simply throws an exception and doesn't touch the output stream. *)
-let request_of_bio_exn ~proxy_seen ~read_timeout bio =
+let request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout bio =
let fd = Buf_io.fd_of bio in
- let frame, headers, proxy' = Http.read_http_request_header ~read_timeout fd in
+ let frame, headers, proxy' =
+ Http.read_http_request_header ~read_timeout ~total_timeout fd
+ in
let proxy = match proxy' with None -> proxy_seen | x -> x in
let additional_headers =
proxy |> Option.fold ~none:[] ~some:(fun p -> [("STUNNEL_PROXY", p)])
@@ -400,9 +402,11 @@ let request_of_bio_exn ~proxy_seen ~read_timeout bio =
(** [request_of_bio ic] returns [Some req] read from [ic], or [None]. If [None] it will have
already sent back a suitable error code and response to the client. *)
-let request_of_bio ?proxy_seen ~read_timeout ic =
+let request_of_bio ?proxy_seen ~read_timeout ~total_timeout ic =
try
- let r, proxy = request_of_bio_exn ~proxy_seen ~read_timeout ic in
+ let r, proxy =
+ request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout ic
+ in
(Some r, proxy)
with e ->
D.warn "%s (%s)" (Printexc.to_string e) __LOC__ ;
@@ -426,7 +430,7 @@ let request_of_bio ?proxy_seen ~read_timeout ic =
(* Generic errors thrown during parsing *)
| End_of_file ->
()
- | Unix.Unix_error (Unix.EAGAIN, _, _) ->
+ | Unix.Unix_error (Unix.EAGAIN, _, _) | Http.Timeout ->
response_request_timeout ss
(* Premature termination of connection! *)
| Unix.Unix_error (a, b, c) ->
@@ -496,7 +500,8 @@ let handle_one (x : 'a Server.t) ss context req =
) ;
!finished
-let handle_connection ~header_read_timeout (x : 'a Server.t) caller ss =
+let handle_connection ~header_read_timeout ~header_total_timeout
+ (x : 'a Server.t) caller ss =
( match caller with
| Unix.ADDR_UNIX _ ->
debug "Accepted unix connection"
@@ -511,9 +516,11 @@ let handle_connection ~header_read_timeout (x : 'a Server.t) caller ss =
just once per connection. To allow for the PROXY metadata (including e.g. the
client IP) to be added to all request records on a connection, it must be passed
along in the loop below. *)
- let rec loop ~read_timeout proxy_seen =
+ let rec loop ~read_timeout ~total_timeout proxy_seen =
(* 1. we must successfully parse a request *)
- let req, proxy = request_of_bio ?proxy_seen ~read_timeout ic in
+ let req, proxy =
+ request_of_bio ?proxy_seen ~read_timeout ~total_timeout ic
+ in
(* 2. now we attempt to process the request *)
let finished =
Option.fold ~none:true
@@ -522,9 +529,10 @@ let handle_connection ~header_read_timeout (x : 'a Server.t) caller ss =
in
(* 3. do it again if the connection is kept open, but without timeouts *)
if not finished then
- loop ~read_timeout:None proxy
+ loop ~read_timeout:None ~total_timeout:None proxy
in
- loop ~read_timeout:header_read_timeout None ;
+ loop ~read_timeout:header_read_timeout ~total_timeout:header_total_timeout
+ None ;
debug "Closing connection" ;
Unix.close ss
@@ -592,11 +600,12 @@ let socket_table = Hashtbl.create 10
type socket = Unix.file_descr * string
(* Start an HTTP server on a new socket *)
-let start ?header_read_timeout ~conn_limit (x : 'a Server.t) (socket, name) =
+let start ?header_read_timeout ?header_total_timeout ~conn_limit
+ (x : 'a Server.t) (socket, name) =
let handler =
{
Server_io.name
- ; body= handle_connection ~header_read_timeout x
+ ; body= handle_connection ~header_read_timeout ~header_total_timeout x
; lock= Xapi_stdext_threads.Semaphore.create conn_limit
}
in
diff --git a/ocaml/libs/http-svr/http_svr.mli b/ocaml/libs/http-svr/http_svr.mli
index 40a5074ea..761e39436 100644
--- a/ocaml/libs/http-svr/http_svr.mli
+++ b/ocaml/libs/http-svr/http_svr.mli
@@ -60,7 +60,12 @@ val bind : ?listen_backlog:int -> Unix.sockaddr -> string -> socket
val bind_retry : ?listen_backlog:int -> Unix.sockaddr -> socket
val start :
- ?header_read_timeout:float -> conn_limit:int -> 'a Server.t -> socket -> unit
+ ?header_read_timeout:float
+ -> ?header_total_timeout:float
+ -> conn_limit:int
+ -> 'a Server.t
+ -> socket
+ -> unit
val handle_one : 'a Server.t -> Unix.file_descr -> 'a -> Http.Request.t -> bool
diff --git a/ocaml/libs/http-svr/http_test.ml b/ocaml/libs/http-svr/http_test.ml
index e067a8b8a..462f46066 100644
--- a/ocaml/libs/http-svr/http_test.ml
+++ b/ocaml/libs/http-svr/http_test.ml
@@ -200,7 +200,8 @@ let test_read_http_request_header _ =
|> List.iter (fun (frame, proxy, header) ->
with_fd (mk_header_string ~frame ~proxy ~header) (fun fd ->
let actual_frame, actual_header, actual_proxy =
- Http.read_http_request_header ~read_timeout:None fd
+ Http.read_http_request_header ~read_timeout:None
+ ~total_timeout:None fd
in
assert (actual_frame = frame) ;
assert (actual_header = header) ;
diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml
index 4c874ff65..69a4fae68 100644
--- a/ocaml/xapi/xapi_globs.ml
+++ b/ocaml/xapi/xapi_globs.ml
@@ -960,6 +960,9 @@ let samba_dir = "/var/lib/samba"
let header_read_timeout_tcp = ref 10.
(* Timeout in seconds for every read while reading HTTP headers (on TCP only) *)
+let header_total_timeout_tcp = ref 60.
+(* Timeout in seconds to receive all HTTP headers (on TCP only) *)
+
let conn_limit_tcp = ref 800
let conn_limit_unix = ref 1024
@@ -1040,6 +1043,7 @@ let xapi_globs_spec =
, Float winbind_update_closest_kdc_interval
)
; ("header_read_timeout_tcp", Float header_read_timeout_tcp)
+ ; ("header_total_timeout_tcp", Float header_total_timeout_tcp)
; ("conn_limit_tcp", Int conn_limit_tcp)
; ("conn_limit_unix", Int conn_limit_unix)
; ("conn_limit_clientcert", Int conn_limit_clientcert)
diff --git a/ocaml/xapi/xapi_mgmt_iface.ml b/ocaml/xapi/xapi_mgmt_iface.ml
index 80a4852aa..084b43531 100644
--- a/ocaml/xapi/xapi_mgmt_iface.ml
+++ b/ocaml/xapi/xapi_mgmt_iface.ml
@@ -83,6 +83,7 @@ end = struct
in
Http_svr.start
~header_read_timeout:!Xapi_globs.header_read_timeout_tcp
+ ~header_total_timeout:!Xapi_globs.header_total_timeout_tcp
~conn_limit:!Xapi_globs.conn_limit_tcp Xapi_http.server socket ;
management_servers := socket :: !management_servers ;
if Pool_role.is_master () && addr = None then
--
2.31.1
From 1a47417a14151469ae29143e14131cb2f0be04da Mon Sep 17 00:00:00 2001
From: Rob Hoes <rob.hoes@citrix.com>
Date: Tue, 26 Jul 2022 16:20:19 +0000
Subject: [PATCH 6/6] Maximum header length
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
---
ocaml/libs/http-svr/http.ml | 14 ++++++++++----
ocaml/libs/http-svr/http.mli | 3 +++
ocaml/libs/http-svr/http_svr.ml | 31 ++++++++++++++++++++++---------
ocaml/libs/http-svr/http_svr.mli | 1 +
ocaml/libs/http-svr/http_test.ml | 2 +-
ocaml/xapi/xapi_globs.ml | 4 ++++
ocaml/xapi/xapi_mgmt_iface.ml | 1 +
7 files changed, 42 insertions(+), 14 deletions(-)
diff --git a/ocaml/libs/http-svr/http.ml b/ocaml/libs/http-svr/http.ml
index af8a56ee2..08ac0c683 100644
--- a/ocaml/libs/http-svr/http.ml
+++ b/ocaml/libs/http-svr/http.ml
@@ -28,6 +28,8 @@ exception Malformed_url of string
exception Timeout
+exception Too_large
+
module D = Debug.Make (struct let name = "http" end)
open D
@@ -283,7 +285,7 @@ let header_len_header = Printf.sprintf "\r\n%s:" Hdr.header_len
let header_len_value_len = 5
-let read_up_to ?deadline buf already_read marker fd =
+let read_up_to ?deadline ?max buf already_read marker fd =
let marker = Scanner.make marker in
let hl_marker = Scanner.make header_len_header in
let b = ref 0 in
@@ -310,6 +312,7 @@ let read_up_to ?deadline buf already_read marker fd =
Printf.fprintf stderr "b = %d; safe_to_read = %d\n" !b safe_to_read;
flush stderr;
*)
+ Option.iter (fun m -> if !b + safe_to_read > m then raise Too_large) max ;
let n =
if !b < already_read then
min safe_to_read (already_read - !b)
@@ -377,9 +380,9 @@ let set_socket_timeout fd t =
(* In the unit tests, the fd comes from a pipe... ignore *)
()
-let read_http_request_header ~read_timeout ~total_timeout fd =
+let read_http_request_header ~read_timeout ~total_timeout ~max_length fd =
Option.iter (fun t -> set_socket_timeout fd t) read_timeout ;
- let buf = Bytes.create 1024 in
+ let buf = Bytes.create (Option.value ~default:1024 max_length) in
let deadline =
Option.map
(fun t ->
@@ -415,7 +418,10 @@ let read_http_request_header ~read_timeout ~total_timeout fd =
let frame, headers_length =
match read_frame_header buf with
| None ->
- (false, read_up_to ?deadline buf frame_header_length end_of_headers fd)
+ let max = Option.map (fun m -> m - frame_header_length) max_length in
+ ( false
+ , read_up_to ?deadline ?max buf frame_header_length end_of_headers fd
+ )
| Some length ->
check_timeout_and_read 0 length ;
(true, length)
diff --git a/ocaml/libs/http-svr/http.mli b/ocaml/libs/http-svr/http.mli
index 23e636a50..53dd5d96f 100644
--- a/ocaml/libs/http-svr/http.mli
+++ b/ocaml/libs/http-svr/http.mli
@@ -30,6 +30,8 @@ exception Forbidden
exception Timeout
+exception Too_large
+
type authorization = Basic of string * string | UnknownAuth of string
val make_frame_header : string -> string
@@ -37,6 +39,7 @@ val make_frame_header : string -> string
val read_http_request_header :
read_timeout:float option
-> total_timeout:float option
+ -> max_length:int option
-> Unix.file_descr
-> bool * string * string option
diff --git a/ocaml/libs/http-svr/http_svr.ml b/ocaml/libs/http-svr/http_svr.ml
index 155462d33..112c26a1e 100644
--- a/ocaml/libs/http-svr/http_svr.ml
+++ b/ocaml/libs/http-svr/http_svr.ml
@@ -170,6 +170,13 @@ let response_request_timeout s =
in
response_error_html s "408" "Request Timeout" [] body
+let response_request_header_fields_too_large s =
+ let body =
+ "<html><body><h1>HTTP 431 request header fields too large</h1>Exceeded the \
+ maximum header size.</body></html>"
+ in
+ response_error_html s "431" "Request Header Fields Too Large" [] body
+
let response_internal_error ?req ?extra s =
let version = Option.map get_return_version req in
let extra =
@@ -322,10 +329,11 @@ exception Generic_error of string
(** [request_of_bio_exn ic] reads a single Http.req from [ic] and returns it. On error
it simply throws an exception and doesn't touch the output stream. *)
-let request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout bio =
+let request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout ~max_length bio
+ =
let fd = Buf_io.fd_of bio in
let frame, headers, proxy' =
- Http.read_http_request_header ~read_timeout ~total_timeout fd
+ Http.read_http_request_header ~read_timeout ~total_timeout ~max_length fd
in
let proxy = match proxy' with None -> proxy_seen | x -> x in
let additional_headers =
@@ -402,10 +410,10 @@ let request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout bio =
(** [request_of_bio ic] returns [Some req] read from [ic], or [None]. If [None] it will have
already sent back a suitable error code and response to the client. *)
-let request_of_bio ?proxy_seen ~read_timeout ~total_timeout ic =
+let request_of_bio ?proxy_seen ~read_timeout ~total_timeout ~max_length ic =
try
let r, proxy =
- request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout ic
+ request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout ~max_length ic
in
(Some r, proxy)
with e ->
@@ -432,6 +440,8 @@ let request_of_bio ?proxy_seen ~read_timeout ~total_timeout ic =
()
| Unix.Unix_error (Unix.EAGAIN, _, _) | Http.Timeout ->
response_request_timeout ss
+ | Http.Too_large ->
+ response_request_header_fields_too_large ss
(* Premature termination of connection! *)
| Unix.Unix_error (a, b, c) ->
response_internal_error ss
@@ -501,7 +511,7 @@ let handle_one (x : 'a Server.t) ss context req =
!finished
let handle_connection ~header_read_timeout ~header_total_timeout
- (x : 'a Server.t) caller ss =
+ ~max_header_length (x : 'a Server.t) caller ss =
( match caller with
| Unix.ADDR_UNIX _ ->
debug "Accepted unix connection"
@@ -519,7 +529,8 @@ let handle_connection ~header_read_timeout ~header_total_timeout
let rec loop ~read_timeout ~total_timeout proxy_seen =
(* 1. we must successfully parse a request *)
let req, proxy =
- request_of_bio ?proxy_seen ~read_timeout ~total_timeout ic
+ request_of_bio ?proxy_seen ~read_timeout ~total_timeout
+ ~max_length:max_header_length ic
in
(* 2. now we attempt to process the request *)
let finished =
@@ -600,12 +611,14 @@ let socket_table = Hashtbl.create 10
type socket = Unix.file_descr * string
(* Start an HTTP server on a new socket *)
-let start ?header_read_timeout ?header_total_timeout ~conn_limit
- (x : 'a Server.t) (socket, name) =
+let start ?header_read_timeout ?header_total_timeout ?max_header_length
+ ~conn_limit (x : 'a Server.t) (socket, name) =
let handler =
{
Server_io.name
- ; body= handle_connection ~header_read_timeout ~header_total_timeout x
+ ; body=
+ handle_connection ~header_read_timeout ~header_total_timeout
+ ~max_header_length x
; lock= Xapi_stdext_threads.Semaphore.create conn_limit
}
in
diff --git a/ocaml/libs/http-svr/http_svr.mli b/ocaml/libs/http-svr/http_svr.mli
index 761e39436..323511bf4 100644
--- a/ocaml/libs/http-svr/http_svr.mli
+++ b/ocaml/libs/http-svr/http_svr.mli
@@ -62,6 +62,7 @@ val bind_retry : ?listen_backlog:int -> Unix.sockaddr -> socket
val start :
?header_read_timeout:float
-> ?header_total_timeout:float
+ -> ?max_header_length:int
-> conn_limit:int
-> 'a Server.t
-> socket
diff --git a/ocaml/libs/http-svr/http_test.ml b/ocaml/libs/http-svr/http_test.ml
index 462f46066..4dad98a36 100644
--- a/ocaml/libs/http-svr/http_test.ml
+++ b/ocaml/libs/http-svr/http_test.ml
@@ -201,7 +201,7 @@ let test_read_http_request_header _ =
with_fd (mk_header_string ~frame ~proxy ~header) (fun fd ->
let actual_frame, actual_header, actual_proxy =
Http.read_http_request_header ~read_timeout:None
- ~total_timeout:None fd
+ ~total_timeout:None ~max_length:None fd
in
assert (actual_frame = frame) ;
assert (actual_header = header) ;
diff --git a/ocaml/xapi/xapi_globs.ml b/ocaml/xapi/xapi_globs.ml
index 69a4fae68..505db0262 100644
--- a/ocaml/xapi/xapi_globs.ml
+++ b/ocaml/xapi/xapi_globs.ml
@@ -963,6 +963,9 @@ let header_read_timeout_tcp = ref 10.
let header_total_timeout_tcp = ref 60.
(* Timeout in seconds to receive all HTTP headers (on TCP only) *)
+let max_header_length_tcp = ref 1024
+(* Maximum accepted size of HTTP headers in bytes (on TCP only) *)
+
let conn_limit_tcp = ref 800
let conn_limit_unix = ref 1024
@@ -1044,6 +1047,7 @@ let xapi_globs_spec =
)
; ("header_read_timeout_tcp", Float header_read_timeout_tcp)
; ("header_total_timeout_tcp", Float header_total_timeout_tcp)
+ ; ("max_header_length_tcp", Int max_header_length_tcp)
; ("conn_limit_tcp", Int conn_limit_tcp)
; ("conn_limit_unix", Int conn_limit_unix)
; ("conn_limit_clientcert", Int conn_limit_clientcert)
diff --git a/ocaml/xapi/xapi_mgmt_iface.ml b/ocaml/xapi/xapi_mgmt_iface.ml
index 084b43531..3e82cc8eb 100644
--- a/ocaml/xapi/xapi_mgmt_iface.ml
+++ b/ocaml/xapi/xapi_mgmt_iface.ml
@@ -84,6 +84,7 @@ end = struct
Http_svr.start
~header_read_timeout:!Xapi_globs.header_read_timeout_tcp
~header_total_timeout:!Xapi_globs.header_total_timeout_tcp
+ ~max_header_length:!Xapi_globs.max_header_length_tcp
~conn_limit:!Xapi_globs.conn_limit_tcp Xapi_http.server socket ;
management_servers := socket :: !management_servers ;
if Pool_role.is_master () && addr = None then
--
2.31.1
© 2016 - 2024 Red Hat, Inc.