From d29ffa3a0d1124a48ee11fd0fb7475cfc04a8e5b Mon Sep 17 00:00:00 2001
From: Valentin Perrelle <valentin.perrelle@cea.fr>
Date: Thu, 9 Jul 2020 15:36:11 +0200
Subject: [PATCH] [server] check fields declaration for name validity
---
src/plugins/server/data.ml | 10 ++++++++++
1 file changed, 10 insertions(+)
diff --git a/src/plugins/server/data.ml b/src/plugins/server/data.ml
index a298e490e43..13c0d528838 100644
--- a/src/plugins/server/data.ml
+++ b/src/plugins/server/data.ml
@@ -332,9 +332,18 @@ struct
if s.published then
raise (Invalid_argument "Server.Data.Record: already published")
+ let is_valid_field_name s name =
+ if List.exists (fun f -> String.equal f.Package.fd_name name) s.fields then
+ raise (Invalid_argument ("Server.Data.Record: a field with name '" ^ name
+ ^ "' already exists")) ;
+ if not (Str.string_match (Str.regexp "[a-zA-Z0-9 _-]+$") name 0) then
+ raise (Invalid_argument ("Server.Data.Record: field names must not be \
+ exotic ('" ^ name ^ "')"))
+
let field (type a r) (s : r signature)
~name ~descr ?default (d : a data) : (r,a) field =
not_published s ;
+ is_valid_field_name s name ;
let module D = (val d) in
begin match default with
| None -> ()
@@ -354,6 +363,7 @@ struct
let option (type a r) (s : r signature)
~name ~descr (d : a data) : (r,a option) field =
not_published s ;
+ is_valid_field_name s name ;
let module D = (val d) in
let field = Package.{
fd_name = name ;
--
GitLab