From 12f02be6ab5ee45280c0b8714552e9ca78a4aad5 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Loi=CC=88c=20Correnson?= <loic.correnson@cea.fr>
Date: Wed, 30 Mar 2022 14:55:38 +0200
Subject: [PATCH] [server] maximal socket buffer size
---
src/plugins/server/server_socket.ml | 41 ++++++++++++++++++-----------
1 file changed, 25 insertions(+), 16 deletions(-)
diff --git a/src/plugins/server/server_socket.ml b/src/plugins/server/server_socket.ml
index b70df948852..9e7d1902ede 100644
--- a/src/plugins/server/server_socket.ml
+++ b/src/plugins/server/server_socket.ml
@@ -41,6 +41,15 @@ module Socket = Senv.String
Finally, the server is executed until shutdown."
end)
+let () = Parameter_customize.set_group socket_group
+module SocketSize = Senv.Int
+ (struct
+ let option_name = "-server-socket-size"
+ let arg_name = "n"
+ let default = 8192
+ let help = "Set the maximal size of socket buffers (default: 8192)"
+ end)
+
let _ = Server_doc.protocole
~title:"Unix Socket Protocol"
~readme:"server_socket.md"
@@ -237,9 +246,11 @@ let channel (s: socket) =
| None ->
try
let sock,_ = Unix.accept ~cloexec:true s.socket in
- let snd = Unix.getsockopt_int sock SO_SNDBUF in
- let rcv = Unix.getsockopt_int sock SO_RCVBUF in
- Senv.debug "Client connected" ;
+ Unix.set_nonblock sock ;
+ let size = max 256 (SocketSize.get ()) in
+ let rcv = min size @@ Unix.getsockopt_int sock SO_RCVBUF in
+ let snd = min size @@ Unix.getsockopt_int sock SO_SNDBUF in
+ Senv.debug "Client connected (in: %d) (out: %d)" rcv snd ;
let ch = Some {
sock ;
snd = Bytes.create snd ;
@@ -262,12 +273,10 @@ let fetch (s:socket) () =
Senv.warning "Socket: exn %s" (Printexc.to_string exn) ;
close s ; None
-let bind fd =
+let establish_server fd =
let socket = { socket = fd ; channel = None } in
try
- Unix.set_nonblock fd ;
Unix.listen fd 1 ;
- Unix.set_nonblock fd ;
ignore (Sys.signal Sys.sigpipe Signal_ignore) ;
let pretty = Format.pp_print_string in
let server = Main.create ~pretty ~fetch:(fetch socket) () in
@@ -293,17 +302,16 @@ let bind fd =
let server = ref None
let cmdline () =
- let addr = Socket.get () in
- match !server with
- | Some addr0 ->
- if Senv.debug_atleast 1 && addr <> addr0 then
+ let option = match Socket.get () with "" -> None | a -> Some a in
+ match !server, option with
+ | _ , None -> ()
+ | Some addr0, Some addr ->
+ if addr0 <> addr then
Senv.warning "Socket server already running on [%s]." addr0
- else
- Senv.feedback "Socket server already running."
- | None ->
- if addr <> "" then
+ | None, Some addr ->
+ begin
try
- server := Some addr ;
+ server := option ;
if Sys.file_exists addr then Unix.unlink addr ;
let fd = Unix.socket PF_UNIX SOCK_STREAM 0 in
Unix.bind fd (ADDR_UNIX addr) ;
@@ -311,10 +319,11 @@ let cmdline () =
Senv.feedback "Socket server running on [%s]." addr
else
Senv.feedback "Socket server running." ;
- bind fd
+ establish_server fd ;
with exn ->
Senv.fatal "Server socket failed.@\nError: %s@"
(Printexc.to_string exn)
+ end
let () = Db.Main.extend cmdline
--
GitLab