From 4cedbaa67ebc3359dabf9f9c983b128c2ced6b12 Mon Sep 17 00:00:00 2001
From: Julien Sagot <julien.sagot@geneanet.org>
Date: Wed, 19 Jan 2022 10:43:22 +0100
Subject: [PATCH 1/3] Compile against new GeneWeb interface (safe user inputs)

---
 src/api_piqi_util.ml     |   8 +--
 src/api_saisie_read.ml   | 105 ++++++++++++++++++++-------------------
 src/api_saisie_write.ml  |  50 ++++++++++---------
 src/api_search.ml        |  18 +++----
 src/api_update_family.ml |  54 +++++++-------------
 src/api_update_person.ml |  17 +++----
 src/api_update_util.ml   |  44 +++++++++-------
 src/api_util.ml          |  13 +++--
 src/plugin_api.ml        |   2 +-
 9 files changed, 154 insertions(+), 157 deletions(-)

diff --git a/src/api_piqi_util.ml b/src/api_piqi_util.ml
index a66444e..9c1cbdd 100644
--- a/src/api_piqi_util.ml
+++ b/src/api_piqi_util.ml
@@ -4,7 +4,7 @@ open Config
 
 let p_getenvbin env label =
   let decode_varenv = Mutil.gen_decode false in
-  try Some (decode_varenv (List.assoc (decode_varenv label) env))
+  try Some (decode_varenv (List.assoc label env))
   with Not_found -> None
 
 module Date
@@ -87,12 +87,12 @@ module Date
         prec = None;
         dmy = None;
         dmy2 = None;
-        text = Some (Util.safe_html txt);
+        text = Some txt;
       }
 
   let date_of_piqi_date date =
     match date.M.Date.text with
-    | Some txt -> Dtext (Util.safe_html txt)
+    | Some txt -> Dtext txt
     | _ ->
       let cal =
         match date.M.Date.cal with
@@ -256,7 +256,7 @@ let print_result conf data =
   in
   let data = data output in
   Util.html ~content_type conf ;
-  Output.print_string conf data
+  Output.print_sstring conf data
 
 let from_piqi_status = function
   | `bad_request -> Def.Bad_Request
diff --git a/src/api_saisie_read.ml b/src/api_saisie_read.ml
index 840eab3..bfbaabe 100644
--- a/src/api_saisie_read.ml
+++ b/src/api_saisie_read.ml
@@ -87,6 +87,7 @@ let code_french_date conf d m y =
 
 
 let encode_dmy conf d m y is_long =
+  Adef.safe @@
   let date = if d != 0 then string_of_int d else "" in
   let date =
     if m != 0 then
@@ -105,9 +106,9 @@ let string_of_dmy conf d is_long =
     | OrYear d2 | YearInt d2 ->
         let d2 = Date.dmy_of_dmy2 d2 in
         encode_dmy conf d2.day d2.month d2.year is_long
-    | _ -> ""
+    | _ -> Adef.safe ""
   in
-  DateDisplay.string_of_prec_dmy conf sy sy2 d
+  !!(DateDisplay.string_of_prec_dmy conf sy sy2 d)
 
 (* ************************************************************************** *)
 (*  [Fonc] string_of_dmy_raw : Def.dmy -> string                              *)
@@ -151,7 +152,7 @@ let string_of_dmy_raw d =
 let string_of_date_raw conf d =
   match d with
   | Dgreg (d, _) -> string_of_dmy_raw d
-  | Dtext t -> Util.safe_html (string_with_macros conf [] t)
+  | Dtext t -> string_with_macros conf [] t
 
 let gregorian_precision conf d is_long =
   if d.delta = 0 then string_of_dmy conf d is_long
@@ -159,8 +160,10 @@ let gregorian_precision conf d is_long =
     let d2 =
       Calendar.gregorian_of_sdn d.prec (Calendar.sdn_of_gregorian d + d.delta)
     in
-    transl conf "between (date)" ^ " " ^ string_of_dmy conf d is_long ^ " " ^
-      transl_nth conf "and" 0 ^ " " ^ string_of_dmy conf d2 is_long
+    transl conf "between (date)"
+    ^ " " ^ string_of_dmy conf d is_long
+    ^ " " ^ transl_nth conf "and" 0
+    ^ " " ^ string_of_dmy conf d2 is_long
 
 let string_of_french_dmy conf d =
   code_french_date conf d.day d.month d.year
@@ -168,7 +171,6 @@ let string_of_french_dmy conf d =
 let string_of_hebrew_dmy conf d =
   DateDisplay.code_hebrew_date conf d.day d.month d.year
 
-
 (* ************************************************************************** *)
 (*  [Fonc] string_of_date_and_conv :
              ?bool -> config -> Def.date -> (string * string * cal)           *)
@@ -188,8 +190,7 @@ let string_of_date_and_conv conf d =
       let date = string_of_dmy conf d false in
       let date_long = string_of_dmy conf d true in
       let date_conv = date in
-      let date_conv_long = date_long
-      in
+      let date_conv_long = date_long in
       (date, date_long, date_conv, date_conv_long, Some `gregorian)
   | Dgreg (d, Djulian) ->
       let date_conv =
@@ -206,27 +207,26 @@ let string_of_date_and_conv conf d =
         else ""
       in
       let date =
-        DateDisplay.string_of_dmy conf d1 ^ year_prec ^ " " ^
-          transl_nth conf "gregorian/julian/french/hebrew" 1
+        !!(DateDisplay.string_of_dmy conf d1)
+        ^ year_prec
+        ^ " " ^ transl_nth conf "gregorian/julian/french/hebrew" 1
       in
       (date, date, date_conv, date_conv_long, Some `julian)
   | Dgreg (d, Dfrench) ->
       let d1 = Calendar.french_of_gregorian d in
       let date = string_of_french_dmy conf d1 in
-      let date_long = DateDisplay.string_of_on_french_dmy conf d1 in
+      let date_long = !!(DateDisplay.string_of_on_french_dmy conf d1) in
       let date_conv = gregorian_precision conf d false in
-      let date_conv_long = DateDisplay.string_of_dmy conf d
-      in
+      let date_conv_long = !!(DateDisplay.string_of_dmy conf d) in
       (date, date_long, date_conv, date_conv_long, Some `french)
   | Dgreg (d, Dhebrew) ->
       let d1 = Calendar.hebrew_of_gregorian d in
       let date = string_of_hebrew_dmy conf d1 in
-      let date_long = DateDisplay.string_of_on_hebrew_dmy conf d1 in
+      let date_long = !!(DateDisplay.string_of_on_hebrew_dmy conf d1) in
       let date_conv = gregorian_precision conf d false in
-      let date_conv_long = DateDisplay.string_of_dmy conf d
-      in
+      let date_conv_long = !!(DateDisplay.string_of_dmy conf d) in
       (date, date_long, date_conv, date_conv_long, Some `hebrew)
-  | Dtext t -> ("(" ^ Util.safe_html (string_with_macros conf [] t) ^ ")", "", "", "", None)
+  | Dtext t -> ("(" ^ string_with_macros conf [] t ^ ")", "", "", "", None)
 
 (**/**) (* Affichage nom/prénom *)
 
@@ -513,7 +513,7 @@ let pers_to_piqi_simple_person conf base p base_prefix =
         let (birth_date, death_date, _) = Gutil.get_birth_death_date p in
         let birth =
           match birth_date with
-          | Some d -> DateDisplay.string_slash_of_date conf d
+          | Some d -> !!(DateDisplay.string_slash_of_date conf d)
           | None -> ""
         in
         let birth_raw =
@@ -530,7 +530,7 @@ let pers_to_piqi_simple_person conf base p base_prefix =
         in
         let death =
           match death_date with
-          | Some d -> DateDisplay.string_slash_of_date conf d
+          | Some d -> !!(DateDisplay.string_slash_of_date conf d)
           | None -> ""
         in
         let death_raw =
@@ -545,7 +545,7 @@ let pers_to_piqi_simple_person conf base p base_prefix =
             let burial_place = sou base (get_burial_place p) in
             Util.string_of_place conf burial_place
         in
-        (birth, birth_raw, birth_place, death, death_raw, death_place)
+        (birth, birth_raw, !!birth_place, death, death_raw, !!death_place)
       else ("", "", "", "", "", "")
     in
     let image =
@@ -619,9 +619,9 @@ let fam_to_piqi_family_link conf base (ifath : Gwdb.iper) imoth sp ifam fam base
       (marriage_date, marriage_date_long, marriage_date_conv, marriage_date_conv_long, marriage_cal, string_of_date_raw conf d)
     | _ -> ("", "", "", "", None, "")
   in
-  let marriage_date_text = Perso.get_marriage_date_text conf fam p_auth in
+  let marriage_date_text = !!(Perso.get_marriage_date_text conf fam p_auth) in
   let marriage_place =
-    if m_auth then Util.string_of_place conf gen_f.marriage_place else ""
+    if m_auth then !!(Util.string_of_place conf gen_f.marriage_place) else ""
   in
   let marriage_src = if p_auth then gen_f.marriage_src else "" in
   let marriage_type =
@@ -710,8 +710,10 @@ let fill_events conf base p base_prefix p_auth pers_to_piqi witness_constructor
       (fun (name, date, place, note, src, w, isp) ->
         let (name, type_) =
           match name with
-          | Perso.Pevent name -> (Util.string_of_pevent_name conf base name, event_to_piqi_event (Some name) None)
-          | Perso.Fevent name -> (Util.string_of_fevent_name conf base name, event_to_piqi_event None (Some name))
+          | Perso.Pevent name -> ( !!(Util.string_of_pevent_name conf base name)
+                                 , event_to_piqi_event (Some name) None)
+          | Perso.Fevent name -> ( !!(Util.string_of_fevent_name conf base name)
+                                 , event_to_piqi_event None (Some name) )
         in
         let (date, date_long, date_conv, date_conv_long, date_cal, date_raw) =
           match Adef.od_of_cdate date with
@@ -720,7 +722,7 @@ let fill_events conf base p base_prefix p_auth pers_to_piqi witness_constructor
             (date, date_long, date_conv, date_conv_long, date_cal, string_of_date_raw conf d)
           | _ -> ("", "", "", "", None, "")
         in
-        let place = Util.string_of_place conf (sou base place) in
+        let place = !!(Util.string_of_place conf (sou base place)) in
         let note =
           if not conf.no_note then
             begin
@@ -882,9 +884,9 @@ let get_family_piqi base conf ifam p base_prefix spouse_to_piqi witnesses_to_piq
       (marriage_date, marriage_date_long, marriage_date_conv, marriage_date_conv_long, marriage_cal, string_of_date_raw conf d)
     | _ -> ("", "", "", "", None, "")
   in
-  let marriage_date_text = Perso.get_marriage_date_text conf fam p_auth in
+  let marriage_date_text = !!(Perso.get_marriage_date_text conf fam p_auth) in
   let marriage_place =
-    if m_auth then Util.string_of_place conf gen_f.marriage_place else ""
+    if m_auth then !!(Util.string_of_place conf gen_f.marriage_place) else ""
   in
   let marriage_src = if p_auth then gen_f.marriage_src else "" in
   let marriage_type =
@@ -1103,14 +1105,14 @@ let get_events_witnesses conf base p base_prefix gen_p p_auth has_relations pers
           let witnesses_name =
             match name with
             | Perso.Pevent name ->
-                if p_auth then Util.string_of_pevent_name conf base name
+                if p_auth then !!(Util.string_of_pevent_name conf base name)
                 else  ""
             | Perso.Fevent name ->
-                if p_auth then Util.string_of_fevent_name conf base name
+                if p_auth then !!(Util.string_of_fevent_name conf base name)
                 else  ""
           in
           let event_witness_type =
-            Utf8.capitalize_fst wk ^ witness_date ^ ": " ^ witnesses_name
+            Utf8.capitalize_fst !!(wk) ^ witness_date ^ ": " ^ witnesses_name
           in
           let husband = pers_to_piqi conf base p base_prefix in
           let wife =
@@ -1193,13 +1195,13 @@ let fill_image conf base p =
   else ""
 
 let fill_birth_place conf p_auth gen_p =
-  if p_auth then Util.string_of_place conf gen_p.birth_place else ""
+  if p_auth then !!(Util.string_of_place conf gen_p.birth_place) else ""
 
 let fill_baptism_place conf p_auth gen_p =
-  if p_auth then Util.string_of_place conf gen_p.baptism_place else ""
+  if p_auth then !!(Util.string_of_place conf gen_p.baptism_place) else ""
 
 let fill_death_place conf p_auth gen_p =
-  if p_auth then Util.string_of_place conf gen_p.death_place else ""
+  if p_auth then !!(Util.string_of_place conf gen_p.death_place) else ""
 
 let fill_birth_src p_auth gen_p =
   if p_auth then gen_p.birth_src else ""
@@ -1214,7 +1216,7 @@ let fill_baptism_src p_auth gen_p =
   if p_auth then gen_p.baptism_src else ""
 
 let fill_burial_place conf p_auth gen_p =
-  if p_auth then Util.string_of_place conf gen_p.burial_place else ""
+  if p_auth then !!(Util.string_of_place conf gen_p.burial_place) else ""
 
 let fill_death conf p_auth gen_p =
   match (p_auth, gen_p.death) with
@@ -1558,7 +1560,9 @@ let has_sources p_auth psources birth_src baptism_src death_src burial_src =
   else false
 
 let fill_titles conf base p =
-  List.map (Perso.string_of_title ~link:false conf base "" p) (Perso.nobility_titles_list conf base p)
+  List.map
+    (fun x -> !!(Perso.string_of_title ~link:false conf base (Adef.safe "") p x))
+    (Perso.nobility_titles_list conf base p)
 
 let transform_empty_string_to_None string =
   if string = "" then None else Some string
@@ -1592,19 +1596,19 @@ let fill_burial_date_raw_if_is_main_person conf p_auth gen_p is_main_person =
     ""
 
 let fill_birth_text conf p p_auth =
-  Perso.get_birth_text conf p p_auth
+  !!(Perso.get_birth_text conf p p_auth)
 
 let fill_baptism_text conf p p_auth =
-  Perso.get_baptism_text conf p p_auth
+  !!(Perso.get_baptism_text conf p p_auth)
 
 let fill_death_text conf p p_auth =
-  Perso.get_death_text conf p p_auth
+  !!(Perso.get_death_text conf p p_auth)
 
 let fill_burial_text conf p p_auth =
-  Perso.get_burial_text conf p p_auth
+  !!(Perso.get_burial_text conf p p_auth)
 
 let fill_cremation_text conf p p_auth =
-  Perso.get_cremation_text conf p p_auth
+  !!(Perso.get_cremation_text conf p p_auth)
 
 let fill_baptism_text_if_main_person_or_parent conf p p_auth is_main_person_or_father_or_mother =
   if (is_main_person_or_father_or_mother) then
@@ -1620,7 +1624,9 @@ let fill_burial_type p_auth gen_p =
   else `dont_know
 
 let fill_titles_with_links conf base p =
-  List.map (Perso.string_of_title ~link:true conf base "" p) (Perso.nobility_titles_list conf base p)
+  List.map
+    (fun x -> !!(Perso.string_of_title ~link:true conf base (Adef.safe "") p x))
+    (Perso.nobility_titles_list conf base p)
 
 let has_history_if_is_main_person conf base p p_auth is_main_person =
   if is_main_person then
@@ -1636,12 +1642,11 @@ let has_duplication_if_is_main_person conf base p is_main_person =
 
 let fill_linked_page_if_is_main_person conf base p is_main_person =
   if is_main_person then
-    (
-    Perso.get_linked_page conf base p "BIBLIO",
-    Perso.get_linked_page conf base p "BNOTE",
-    Perso.get_linked_page conf base p "DEATH",
-    Perso.get_linked_page conf base p "HEAD",
-    Perso.get_linked_page conf base p "OCCU"
+    ( !!(Perso.get_linked_page conf base p "BIBLIO")
+    , !!(Perso.get_linked_page conf base p "BNOTE")
+    , !!(Perso.get_linked_page conf base p "DEATH")
+    , !!(Perso.get_linked_page conf base p "HEAD")
+    , !!(Perso.get_linked_page conf base p "OCCU")
     )
   else
     ("", "", "", "", "")
@@ -1920,7 +1925,7 @@ let print_person_tree conf base =
   print_result conf data
   else begin
     Output.status conf Def.Not_Found ;
-    Output.print_string conf ""
+    Output.print_sstring conf ""
   end
 
 (* ********************************************************************* *)
@@ -1986,7 +1991,7 @@ let print_result_fiche_person conf base ip nb_asc_max nb_desc_max simple_graph_i
     print_result conf data
   end else begin
     Output.status conf Def.Not_Found ;
-    Output.print_string conf ""
+    Output.print_sstring conf ""
   end
 
 (* ********************************************************************* *)
@@ -2442,7 +2447,7 @@ let print_result_graph_tree conf base ip =
   print_result conf data
   else begin
     Output.status conf Def.Not_Found ;
-    Output.print_string conf ""
+    Output.print_sstring conf ""
   end
 
 (* ************************************************************************ *)
diff --git a/src/api_saisie_write.ml b/src/api_saisie_write.ml
index dc96ab2..fd747c2 100644
--- a/src/api_saisie_write.ml
+++ b/src/api_saisie_write.ml
@@ -247,7 +247,7 @@ let print_config conf base =
         in
         Mwrite.Transl_fevent_name.({
           pos = pos;
-          sval = sval;
+          sval = !!(sval);
         }))
       [ Efam_Marriage; Efam_NoMarriage; Efam_Engage;
         Efam_Divorce ; Efam_Separated;
@@ -268,7 +268,7 @@ let print_config conf base =
         in
         Mwrite.Transl_pevent_name.({
           pos = pos;
-          sval = sval;
+          sval = !!(sval);
         }))
       [ Epers_Birth; Epers_Baptism; Epers_Death; Epers_Burial ]
   in
@@ -281,7 +281,7 @@ let print_config conf base =
         in
         Mwrite.Transl_pevent_name.({
           pos = pos;
-          sval = sval;
+          sval = !!(sval);
         }))
       [ Epers_Accomplishment; Epers_Acquisition; Epers_Adhesion;
         Epers_BarMitzvah; Epers_BatMitzvah; Epers_Benediction; Epers_Cremation;
@@ -313,7 +313,7 @@ let print_config conf base =
         in
         Mwrite.Transl_pevent_name.({
           pos = pos;
-          sval = sval;
+          sval = !!(sval);
         }))
       [ Epers_BaptismLDS; Epers_ConfirmationLDS; Epers_DotationLDS;
         Epers_FamilyLinkLDS; Epers_ScellentChildLDS; Epers_ScellentParentLDS;
@@ -452,7 +452,7 @@ let print_config conf base =
   in
   let transl_hebrew_month = Mwrite.Config_transl_hebrew_month.({msg = transl_hebrew_month;}) in
   let (gwf_place_format, gwf_place_format_placeholder) =
-    match p_getenv conf.base_env "places_format" with
+    match List.assoc_opt "places_format" conf.base_env with
     | Some s ->
         let placeholder =
           (try
@@ -594,11 +594,11 @@ let compute_warnings conf base resp =
     sou base (get_first_name p) ^ " " ^ sou base (get_surname p)
   in
   let print_someone_dates p =
-    print_someone p ^ " " ^ DateDisplay.short_dates_text conf base p
+    print_someone p ^ " " ^ !!(DateDisplay.short_dates_text conf base p)
   in
   match resp with
   | Api_update_util.UpdateErrorConflict c -> (false, [], [], Some c, [])
-  | Api_update_util.UpdateError s -> (false, [Update.string_of_error conf s], [], None, [])
+  | Api_update_util.UpdateError s -> (false, [!!(Update.string_of_error conf s)], [], None, [])
   | Api_update_util.UpdateSuccess (wl, ml, hr) ->
       let warning =
         List.fold_right
@@ -612,7 +612,7 @@ let compute_warnings conf base resp =
                            "the difference of age between %t and %t is quite important"))
                      (fun _ -> print_someone p1)
                      (fun _ -> print_someone p2))
-                  ^ ": " ^ (DateDisplay.string_of_age conf a)
+                  ^ ": " ^ !!(DateDisplay.string_of_age conf a)
                 in
                 w :: wl
             | BirthAfterDeath p ->
@@ -696,7 +696,7 @@ let compute_warnings conf base resp =
                   (transl_nth
                      conf "died at an advanced age" (index_of_sex (get_sex p)))
                   ^ " " ^
-                  (DateDisplay.string_of_age conf a)
+                  !!(DateDisplay.string_of_age conf a)
                 in
                 w :: wl
             | DeadTooEarlyToBeFather (father, child) ->
@@ -713,8 +713,8 @@ let compute_warnings conf base resp =
                   Printf.sprintf
                     (ftransl conf "%t's %s before his/her %s")
                     (fun _ -> print_someone_dates p)
-                    (Util.string_of_fevent_name conf base e1.efam_name)
-                    (Util.string_of_fevent_name conf base e2.efam_name)
+                    !!(Util.string_of_fevent_name conf base e1.efam_name)
+                    !!(Util.string_of_fevent_name conf base e2.efam_name)
                 in
                 w :: wl
             | FWitnessEventAfterDeath (p, e, _) ->
@@ -722,7 +722,7 @@ let compute_warnings conf base resp =
                   Printf.sprintf
                     (ftransl conf "%t witnessed the %s after his/her death")
                     (fun _ -> print_someone_dates p)
-                    (Util.string_of_fevent_name conf base e.efam_name)
+                    !!(Util.string_of_fevent_name conf base e.efam_name)
                 in
                 w :: wl
             | FWitnessEventBeforeBirth (p, e, _) ->
@@ -730,7 +730,7 @@ let compute_warnings conf base resp =
                   Printf.sprintf
                     (ftransl conf "%t witnessed the %s before his/her birth")
                     (fun _ -> print_someone_dates p)
-                    (Util.string_of_fevent_name conf base e.efam_name)
+                    !!(Util.string_of_fevent_name conf base e.efam_name)
                 in
                 w :: wl
             | IncoherentSex (p, _, _) ->
@@ -781,7 +781,7 @@ let compute_warnings conf base resp =
                 let w =
                 Printf.sprintf "%s\n%s\n" (print_someone_dates p)
                   (transl conf "is a very young parent") ^
-                Printf.sprintf "(%s)" (DateDisplay.string_of_age conf a)
+                Printf.sprintf "(%s)" !!(DateDisplay.string_of_age conf a)
                 in
                 w :: wl
             | PossibleDuplicateFam (f1, _) ->
@@ -797,7 +797,7 @@ let compute_warnings conf base resp =
                 let w =
                 Printf.sprintf "%s\n%s\n" (print_someone p)
                   (transl conf "is a very old parent") ^
-                Printf.sprintf "(%s)" (DateDisplay.string_of_age conf a);
+                Printf.sprintf "(%s)" !!(DateDisplay.string_of_age conf a);
                 in
                 w :: wl
             | PEventOrder (p, e1, e2) ->
@@ -805,8 +805,8 @@ let compute_warnings conf base resp =
                   Printf.sprintf
                     (ftransl conf "%t's %s before his/her %s")
                     (fun _ -> print_someone_dates p)
-                    (Util.string_of_pevent_name conf base e1.epers_name)
-                    (Util.string_of_pevent_name conf base e2.epers_name)
+                    !!(Util.string_of_pevent_name conf base e1.epers_name)
+                    !!(Util.string_of_pevent_name conf base e2.epers_name)
                 in
                 w :: wl
             | PWitnessEventAfterDeath (p, e, _) ->
@@ -814,7 +814,7 @@ let compute_warnings conf base resp =
                   Printf.sprintf
                     (ftransl conf "%t witnessed the %s after his/her death")
                     (fun _ -> print_someone_dates p)
-                    (Util.string_of_pevent_name conf base e.epers_name)
+                    !!(Util.string_of_pevent_name conf base e.epers_name)
                 in
                 w :: wl
             | PWitnessEventBeforeBirth (p, e, _) ->
@@ -822,7 +822,7 @@ let compute_warnings conf base resp =
                   Printf.sprintf
                     (ftransl conf "%t witnessed the %s before his/her birth")
                     (fun _ -> print_someone_dates p)
-                    (Util.string_of_pevent_name conf base e.epers_name)
+                    !!(Util.string_of_pevent_name conf base e.epers_name)
                 in
                 w :: wl
             | TitleDatesError (p, t) ->
@@ -834,10 +834,10 @@ let compute_warnings conf base resp =
                      Printf.sprintf "%s %s %s-%s"
                        (sou base t.t_ident) (sou base t.t_place)
                        (match Adef.od_of_cdate t.t_date_start with
-                        | Some d -> DateDisplay.string_of_date conf d
+                        | Some d -> !!(DateDisplay.string_of_date conf d)
                         | _ -> "" )
                        (match Adef.od_of_cdate t.t_date_end with
-                        | Some d -> DateDisplay.string_of_date conf d
+                        | Some d -> !!(DateDisplay.string_of_date conf d)
                         | _ -> "" ))
                 in
                 w :: wl
@@ -854,7 +854,7 @@ let compute_warnings conf base resp =
                 print_someone p ^ " " ^
                   (Printf.sprintf
                      (ftransl conf "married at age %t")
-                     (fun _ -> DateDisplay.string_of_age conf a))
+                     (fun _ -> !!(DateDisplay.string_of_age conf a)))
                 in
                 w :: wl)
           wl []
@@ -1391,7 +1391,7 @@ let print_mod_family_request conf base =
          in
          let lastname = sou base (get_surname sp) in
          let firstname = sou base (get_first_name sp) in
-         let dates = Opt.of_string @@ Api_saisie_read.short_dates_text conf base sp in
+         let dates = Opt.of_string (Api_saisie_read.short_dates_text conf base sp) in
          let image =
            Opt.of_string @@
            let img = sou base (get_image sp) in
@@ -2186,9 +2186,11 @@ let check_input_person mod_p : 'unit_or_exn =
     end mod_p.Mwrite.Person.pevents ()
   else if s = "" then
     let designation = mod_p.Mwrite.Person.firstname ^ "." ^ string_of_int o ^ " ?" in
+    let designation = (Util.escape_html designation : Adef.escaped_string :> Adef.safe_string) in
     raise_ModErr (Update.UERR_missing_surname designation)
   else if f = "" then
     let designation = "?." ^ string_of_int o ^ " " ^ mod_p.Mwrite.Person.lastname in
+    let designation = (Util.escape_html designation : Adef.escaped_string :> Adef.safe_string) in
     raise_ModErr (Update.UERR_missing_first_name designation)
   else if mod_p.Mwrite.Person.sex = `unknown then
     raise_ModErr (Update.UERR_sex_undefined (f, s, o))
@@ -2352,7 +2354,7 @@ let print_add_first_fam conf =
   in
   let response =
     { Mwrite.Modification_status.is_base_updated
-    ; base_warnings = List.map (Update.string_of_error conf) warnings
+    ; base_warnings = List.map (fun s -> !!(Update.string_of_error conf s)) warnings
     ; base_miscs = miscs
     ; index_person = None
     ; lastname
diff --git a/src/api_search.ml b/src/api_search.ml
index dc3ac3d..d175180 100644
--- a/src/api_search.ml
+++ b/src/api_search.ml
@@ -175,14 +175,14 @@ let select_start_with conf base ini_n ini_p =
   in
   List.rev_append list_maj list_min
 
-let aux_ini s =
-  let rec loop s acc =
-    if String.contains s '+' then
-      let index = String.index s '+' in
+let aux_ini (s : string) : string list =
+  let rec loop (s : Adef.encoded_string) acc =
+    if String.contains (s :> string) '+' then
+      let index = String.index (s :> string) '+' in
       let start = index + 1 in
-      let len = String.length s - start in
-      let ns = String.sub s start len in
-      loop ns (Mutil.decode (String.sub s 0 index) :: acc)
+      let len = String.length (s :> string) - start in
+      let ns = Adef.encoded @@ String.sub (s :> string) start len in
+      loop ns (Mutil.decode (Adef.encoded @@ String.sub (s :> string) 0 index) :: acc)
     else (Mutil.decode s :: acc)
   in
   loop (Mutil.encode s) []
@@ -599,7 +599,7 @@ let complete_with_dico assets conf nb max mode ini list =
   match mode with
   | Some mode when !nb < max ->
     let format =
-      match p_getenv conf.base_env "places_format" with
+      match List.assoc_opt "places_format" conf.base_env with
       | None -> []
       | Some s ->
         List.map begin function
@@ -624,7 +624,7 @@ let complete_with_dico assets conf nb max mode ini list =
 
 let search_auto_complete assets conf base mode place_mode max n =
   let aux data compare =
-    let conf = { conf with env = ("data", data) :: conf.env } in
+    let conf = { conf with env = ("data", Mutil.encode data) :: conf.env } in
     UpdateData.get_all_data conf base
     |> List.rev_map (sou base)
     |> List.sort compare
diff --git a/src/api_update_family.ml b/src/api_update_family.ml
index 5d8dc02..d01c1ca 100644
--- a/src/api_update_family.ml
+++ b/src/api_update_family.ml
@@ -8,6 +8,14 @@ open Def
 open Util
 open Api_update_util
 
+let opt_only_printable = function
+  | Some s -> only_printable s
+  | None -> ""
+
+let opt_only_printable_or_nl_stripped = function
+  | Some x -> only_printable_or_nl (Mutil.strip_all_trailing_spaces x)
+  | None -> ""
+
 let reconstitute_family conf base mod_f =
   (* Attention, si witnesses est vide, on va supprimer des témoins (qui sont
      en double parce que dans GeneWeb, ils sont récupérés une fois dans fevents
@@ -32,7 +40,7 @@ let reconstitute_family conf base mod_f =
       (fun evt ->
         let name =
           match evt.Mwrite.Fevent.event_perso with
-          | Some n -> Efam_Name (no_html_tags (only_printable n))
+          | Some n -> Efam_Name (only_printable n)
           | _ ->
               match evt.Mwrite.Fevent.fevent_type with
               | Some `efam_marriage -> Efam_Marriage
@@ -51,30 +59,13 @@ let reconstitute_family conf base mod_f =
         in
         let date =
           match evt.Mwrite.Fevent.date with
-          | Some date -> Api_update_util.date_of_piqi_date conf date
+          | Some d -> Api_update_util.date_of_piqi_date conf d
           | None -> None
         in
-        let place =
-          match evt.Mwrite.Fevent.place with
-          | Some place -> no_html_tags (only_printable place)
-          | None -> ""
-        in
-        let reason =
-          match evt.Mwrite.Fevent.reason with
-          | Some reason -> no_html_tags (only_printable reason)
-          | None -> ""
-        in
-        let note =
-          match evt.Mwrite.Fevent.note with
-          | Some note ->
-              only_printable_or_nl (Mutil.strip_all_trailing_spaces note)
-          | None -> ""
-        in
-        let src =
-          match evt.Mwrite.Fevent.src with
-          | Some src -> only_printable src
-          | None -> ""
-        in
+        let place = opt_only_printable evt.Mwrite.Fevent.place in
+        let reason = opt_only_printable evt.Mwrite.Fevent.reason in
+        let note = opt_only_printable_or_nl_stripped evt.Mwrite.Fevent.note in
+        let src = opt_only_printable evt.Mwrite.Fevent.src  in
         let witnesses =
           List.fold_right
             (fun witness accu ->
@@ -97,21 +88,10 @@ let reconstitute_family conf base mod_f =
       mod_f.Mwrite.Family.fevents
   in
   let comment =
-    match mod_f.Mwrite.Family.comment with
-    | Some comment ->
-        only_printable_or_nl (Mutil.strip_all_trailing_spaces comment)
-    | None -> ""
-  in
-  let fsources =
-    match mod_f.Mwrite.Family.fsources with
-    | Some s -> only_printable s
-    | None -> ""
-  in
-  let origin_file =
-    match mod_f.Mwrite.Family.origin_file with
-    | Some s -> s
-    | None -> ""
+    opt_only_printable_or_nl_stripped mod_f.Mwrite.Family.comment
   in
+  let fsources = opt_only_printable mod_f.Mwrite.Family.fsources in
+  let origin_file = Opt.to_string mod_f.Mwrite.Family.origin_file in
   let fam_index = Gwdb.ifam_of_string @@ Int32.to_string mod_f.Mwrite.Family.index in
   let parents =
     let father = mod_f.Mwrite.Family.father in
diff --git a/src/api_update_person.ml b/src/api_update_person.ml
index 563f2b5..53ba29c 100644
--- a/src/api_update_person.ml
+++ b/src/api_update_person.ml
@@ -8,10 +8,9 @@ open Util
 open Api_update_util
 
 let reconstitute_person_aux conf fn_occ fn_rparents fn_pevt_witnesses mod_p =
-  let no_html_tags_only_printable s = no_html_tags (only_printable s) in
   let key_index = Gwdb.iper_of_string @@ Int32.to_string mod_p.Mwrite.Person.index in
-  let first_name = no_html_tags_only_printable mod_p.Mwrite.Person.firstname in
-  let surname = no_html_tags_only_printable mod_p.Mwrite.Person.lastname in
+  let first_name = only_printable mod_p.Mwrite.Person.firstname in
+  let surname = only_printable mod_p.Mwrite.Person.lastname in
   (* S'il y a des caractères interdits, on les supprime *)
   let (first_name, surname) =
     let contain_fn = String.contains first_name in
@@ -23,10 +22,10 @@ let reconstitute_person_aux conf fn_occ fn_rparents fn_pevt_witnesses mod_p =
   in
   let occ = fn_occ mod_p in
   let image = Opt.map_default "" only_printable mod_p.Mwrite.Person.image in
-  let strings_aux = List.map no_html_tags_only_printable in
+  let strings_aux = List.map only_printable in
   let first_names_aliases = strings_aux mod_p.Mwrite.Person.firstname_aliases in
   let surnames_aliases = strings_aux mod_p.Mwrite.Person.surname_aliases in
-  let public_name = Opt.to_string mod_p.Mwrite.Person.public_name |> no_html_tags_only_printable in
+  let public_name = Opt.to_string mod_p.Mwrite.Person.public_name |> only_printable in
   let qualifiers = strings_aux mod_p.Mwrite.Person.qualifiers in
   let aliases = strings_aux mod_p.Mwrite.Person.aliases in
   let titles =
@@ -88,7 +87,7 @@ let reconstitute_person_aux conf fn_occ fn_rparents fn_pevt_witnesses mod_p =
     List.map begin fun evt ->
       let name =
         match evt.Mwrite.Pevent.event_perso with
-        | Some n -> Epers_Name (no_html_tags (only_printable n))
+        | Some n -> Epers_Name (only_printable n)
         | _ ->
           match evt.Mwrite.Pevent.pevent_type with
           | Some x -> Api_piqi_util.pevent_name_of_piqi_pevent_name x
@@ -99,8 +98,8 @@ let reconstitute_person_aux conf fn_occ fn_rparents fn_pevt_witnesses mod_p =
         | Some date -> Api_update_util.date_of_piqi_date conf date
         | None -> None
       in
-      let place = Opt.map_default "" (fun p -> no_html_tags (only_printable p)) evt.Mwrite.Pevent.place in
-      let reason = Opt.map_default "" (fun r -> no_html_tags (only_printable r)) evt.Mwrite.Pevent.reason in
+      let place = Opt.map_default "" (fun p -> only_printable p) evt.Mwrite.Pevent.place in
+      let reason = Opt.map_default "" (fun r -> only_printable r) evt.Mwrite.Pevent.reason in
       let note =
         Opt.map_default
           "" (fun n -> only_printable_or_nl (Mutil.strip_all_trailing_spaces n))
@@ -306,7 +305,7 @@ let print_mod ?(no_check_name = false) ?(fexclude = []) conf base mod_p =
     begin
       let p =
         (* Do not check sex of married person *)
-        let conf = { conf with Config.env = ("nsck", "on") :: conf.Config.env } in
+        let conf = { conf with Config.env = ("nsck", Adef.encoded "on") :: conf.Config.env } in
         UpdateIndOk.effective_mod conf base p
       in
       let op = poi base p.key_index in
diff --git a/src/api_update_util.ml b/src/api_update_util.ml
index 3f71624..66e5550 100644
--- a/src/api_update_util.ml
+++ b/src/api_update_util.ml
@@ -485,9 +485,9 @@ let child_of_parent conf base p =
   (* alors on l'affiche, sinon on n'affiche que le prénom.   *)
   let print_father fath =
     if not (eq_istr (get_surname p) (get_surname fath)) then
-      person_text_no_html conf base fath
+      gen_person_text ~html:false conf base fath
     else
-      gen_person_text_no_html (p_first_name, (fun _ _ -> "")) conf base fath
+      gen_person_text ~html:false ~sn:false conf base fath
   in
   let a = pget conf base (get_iper p) in
   let ifam =
@@ -511,16 +511,19 @@ let child_of_parent conf base p =
       let s =
         match (fath, moth) with
         | (Some fath, None) -> print_father fath
-        | (None, Some moth) -> person_text_no_html conf base moth
+        | (None, Some moth) -> gen_person_text ~html:false conf base moth
         | (Some fath, Some moth) ->
-            print_father fath ^ " " ^ transl_nth conf "and" 0 ^ " " ^
-              person_text_no_html conf base moth
-        | _ -> ""
+            print_father fath
+            ^^^ " " ^<^ transl_nth conf "and" 0 ^<^ " "
+            ^<^ gen_person_text ~html:false conf base moth
+        | _ -> Adef.safe ""
       in
       let is = index_of_sex (get_sex p) in
       translate_eval
         (transl_a_of_gr_eq_gen_lev conf
-           (transl_nth conf "son/daughter/child" is) s s)
+           (transl_nth conf "son/daughter/child" is)
+           (s :> string)
+           (s :> string))
 
 let husband_wife conf base p =
   let rec loop i =
@@ -534,7 +537,8 @@ let husband_wife conf base p =
           Printf.sprintf (relation_txt conf (get_sex p) fam) (fun () -> "")
         in
         translate_eval
-          (relation ^ " " ^ (person_text_no_html conf base conjoint))
+          (relation ^<^ " " ^<^ (gen_person_text ~html:false conf base conjoint)
+           :> string)
       else loop (i + 1)
     else ""
   in
@@ -575,27 +579,29 @@ let pers_to_piqi_simple_person conf base p =
     let (birth, death, _) = Gutil.get_birth_death_date p in
     let birth =
       match birth with
-      | Some d -> DateDisplay.string_slash_of_date conf d
+      | Some d -> !!(DateDisplay.string_slash_of_date conf d)
       | None -> ""
     in
     let birth_place =
       let birth_place = sou base (get_birth_place p) in
-      if birth_place <> "" then Util.string_of_place conf birth_place
+      if birth_place <> ""
+      then !!(Util.string_of_place conf birth_place)
       else
         let baptism_place = sou base (get_baptism_place p) in
-        Util.string_of_place conf baptism_place
+        !!(Util.string_of_place conf baptism_place)
     in
     let death =
       match death with
-      | Some d -> DateDisplay.string_slash_of_date conf d
+      | Some d -> !!(DateDisplay.string_slash_of_date conf d)
       | None -> ""
     in
     let death_place =
       let death_place = sou base (get_death_place p) in
-      if death_place <> "" then Util.string_of_place conf death_place
+      if death_place <> ""
+      then !!(Util.string_of_place conf death_place)
       else
         let burial_place = sou base (get_burial_place p) in
-        Util.string_of_place conf burial_place
+        !!(Util.string_of_place conf burial_place)
     in
     (birth, birth_place, death, death_place)
   in
@@ -742,15 +748,15 @@ let pers_to_piqi_person_search_info conf base p =
       (fun (name, date, place, note, src, w, isp) ->
         let name =
           match name with
-          | Perso.Pevent name -> Util.string_of_pevent_name conf base name
-          | Perso.Fevent name -> Util.string_of_fevent_name conf base name
+          | Perso.Pevent name -> !!(Util.string_of_pevent_name conf base name)
+          | Perso.Fevent name -> !!(Util.string_of_fevent_name conf base name)
         in
         let (date, _, date_conv, _, date_cal) =
           match Adef.od_of_cdate date with
           | Some d -> Api_saisie_read.string_of_date_and_conv conf d
           | _ -> ("", "", "", "", None)
         in
-        let place = Util.string_of_place conf (sou base place) in
+        let place = !!(Util.string_of_place conf (sou base place)) in
         let note =
           let env = [('i', fun () -> Util.default_image_name base p)] in
           let s = sou base note in
@@ -842,7 +848,9 @@ let pers_to_piqi_person_search_info conf base p =
   let has_sources = psources <> "" in
   let titles = Perso.nobility_titles_list conf base p in
   let titles =
-    List.map (Perso.string_of_title ~link:false conf base "" p) titles
+    List.map (fun x ->
+        !!(Perso.string_of_title ~link:false conf base (Adef.safe "") p x)
+      ) titles
   in
   let related =
     let list =
diff --git a/src/api_util.ml b/src/api_util.ml
index 732c01a..8263680 100644
--- a/src/api_util.ml
+++ b/src/api_util.ml
@@ -11,7 +11,10 @@ open Def
 open Gwdb
 open Util
 open Api_def
-  
+
+(* Convert safe_string to string *)
+let (!!) (x : _ Adef.astring) : string = (Obj.magic x : string)
+
 (* ... utils ... *)
 
 let p_getenvbin = Api_piqi_util.p_getenvbin
@@ -125,7 +128,7 @@ let string_of_prec_dmy d =
 
 let string_of_date = function
     Dgreg (d, _) -> string_of_prec_dmy d
-  | Dtext t -> "(" ^ Util.safe_html t ^ ")"
+  | Dtext t -> "(" ^ t ^ ")"
 
 
 (* Lecture et écriture des dates, directement empruntées à gwcomp/gwu *)
@@ -177,7 +180,7 @@ let string_of_date2 date =
   | Dgreg (d, Djulian) -> string_of_dmy (Calendar.julian_of_gregorian d) ^ "J"
   | Dgreg (d, Dfrench) -> string_of_dmy (Calendar.french_of_gregorian d) ^ "F"
   | Dgreg (d, Dhebrew) -> string_of_dmy (Calendar.hebrew_of_gregorian d) ^ "H"
-  | Dtext t -> Printf.sprintf "0(%s)" (spaces_to_underscore @@ Util.safe_html t)
+  | Dtext t -> Printf.sprintf "0(%s)" (spaces_to_underscore t)
 
 
 let string_of_date_option date =
@@ -294,12 +297,12 @@ struct
         prec = None;
         dmy = None;
         dmy2 = None;
-        text = Some (Util.safe_html txt);
+        text = Some txt;
       }
 
   let date_of_piqi_date date =
     match date.M.Date.text with
-    | Some txt -> Dtext (Util.safe_html txt)
+    | Some txt -> Dtext txt
     | _ ->
       let cal =
         match date.M.Date.cal with
diff --git a/src/plugin_api.ml b/src/plugin_api.ml
index 15949d0..0656151 100644
--- a/src/plugin_api.ml
+++ b/src/plugin_api.ml
@@ -24,7 +24,7 @@ let w_lock =
   GWD.Request.w_lock
     ~onerror:(fun conf _ ->
         let err = Update.string_of_error conf Update.UERR_locked_base in
-        Api_util.print_error conf `conflict err
+        Api_util.print_error conf `conflict (err : Adef.safe_string :> string)
       )
 
 let w_base =

From 21acbdff329a262d1692f69f12b52c16b4154958 Mon Sep 17 00:00:00 2001
From: Julien Sagot <julien.sagot@geneanet.org>
Date: Wed, 30 Mar 2022 14:41:07 +0200
Subject: [PATCH 2/3] Used Notes.{note,source,person_note} instead of
 copy/pasting it.

---
 src/api_saisie_read.ml | 130 +++++++----------------------------------
 src/api_update_util.ml |  73 ++---------------------
 2 files changed, 27 insertions(+), 176 deletions(-)

diff --git a/src/api_saisie_read.ml b/src/api_saisie_read.ml
index bfbaabe..644deda 100644
--- a/src/api_saisie_read.ml
+++ b/src/api_saisie_read.ml
@@ -258,30 +258,6 @@ type graph_more_info =
   | Ancestor
   | Spouse
 
-(* ************************************************************************** *)
-(*  [Fonc] event_to_piqi_event : string -> event_type                         *)
-(** [Description] : Convertit les balises wiki des notes en html.
-    [Args] :
-      - conf
-      - base
-      - env
-      - wiki_notes       : les notes au format wiki
-      - separator_string : caractère de séparations entre les lignes
-    [Retour] :
-      - html_notes : les notes au format html                                 *)
-(* ************************************************************************** *)
-let convert_wiki_notes_to_html_notes conf base env wiki_notes separator_string =
-    let html_notes = string_with_macros conf env wiki_notes in
-    let lines = Wiki.html_of_tlsw conf html_notes in
-    let wi =
-        {Wiki.wi_mode = "NOTES";
-        Wiki.wi_file_path = Notes.file_path conf base;
-        Wiki.wi_person_exists = person_exists conf base;
-        Wiki.wi_always_show_link = conf.wizard || conf.friend}
-    in
-    let html_notes = Wiki.syntax_links conf wi (String.concat separator_string lines) in
-    html_notes
-
 (* ************************************************************************** *)
 (*  [Fonc] event_to_piqi_event : string -> event_type                         *)
 (** [Description] : Retourne à partir d'un évènement (gwdb) un évènement (piqi)
@@ -657,24 +633,13 @@ let fam_to_piqi_family_link conf base (ifath : Gwdb.iper) imoth sp ifam fam base
       gen_f.witnesses
   in
   let notes =
-    if m_auth && not conf.no_note then
-      let s = gen_f.comment in
-      convert_wiki_notes_to_html_notes conf base [] s "\n"
+    if m_auth && not conf.no_note
+    then !!(Notes.note conf base [] gen_f.comment)
     else ""
   in
   let fsources =
-    if m_auth then
-      let s = gen_f.fsources in
-      let s =
-        let wi =
-          {Wiki.wi_mode = "NOTES";
-           Wiki.wi_file_path = Notes.file_path conf base;
-           Wiki.wi_person_exists = person_exists conf base;
-           Wiki.wi_always_show_link = conf.wizard || conf.friend}
-        in
-        Wiki.syntax_links conf wi s
-      in
-      string_with_macros conf [] s
+    if m_auth
+    then !!(Notes.source conf base gen_f.fsources)
     else ""
   in
   let children =
@@ -724,28 +689,11 @@ let fill_events conf base p base_prefix p_auth pers_to_piqi witness_constructor
         in
         let place = !!(Util.string_of_place conf (sou base place)) in
         let note =
-          if not conf.no_note then
-            begin
-              let env = [('i', fun () -> Util.default_image_name base p)] in
-              let s = sou base note in
-              convert_wiki_notes_to_html_notes conf base env s "\n"
-            end
+          if not conf.no_note
+          then !!(Notes.person_note conf base p (sou base note))
           else ""
         in
-        let src =
-          let s = sou base src in
-          let env = [('i', fun () -> Util.default_image_name base p)] in
-          let s =
-            let wi =
-              {Wiki.wi_mode = "NOTES";
-               Wiki.wi_file_path = Notes.file_path conf base;
-               Wiki.wi_person_exists = person_exists conf base;
-               Wiki.wi_always_show_link = conf.wizard || conf.friend}
-            in
-            Wiki.syntax_links conf wi s
-          in
-          string_with_macros conf env s
-        in
+        let src = !!(Notes.source conf base (sou base src)) in
         let spouse =
           Opt.map (fun ip -> pers_to_piqi conf base (poi base ip) base_prefix) isp
         in
@@ -922,24 +870,13 @@ let get_family_piqi base conf ifam p base_prefix spouse_to_piqi witnesses_to_piq
       gen_f.witnesses
   in
   let notes =
-    if m_auth && not conf.no_note then
-      let s = gen_f.comment in
-      convert_wiki_notes_to_html_notes conf base [] s "\n"
+    if m_auth && not conf.no_note
+    then !!(Notes.note conf base [] gen_f.comment )
     else ""
   in
   let fsources =
-    if m_auth then
-      let s = gen_f.fsources in
-      let s =
-        let wi =
-          {Wiki.wi_mode = "NOTES";
-           Wiki.wi_file_path = Notes.file_path conf base;
-           Wiki.wi_person_exists = person_exists conf base;
-           Wiki.wi_always_show_link = conf.wizard || conf.friend}
-        in
-        Wiki.syntax_links conf wi s
-      in
-      string_with_macros conf [] s
+    if m_auth
+    then !!(Notes.source conf base gen_f.fsources)
     else ""
   in
   let children =
@@ -1250,19 +1187,9 @@ let fill_burial conf p_auth gen_p =
       | _ -> ("", "", "", "", None)
 
 let fill_occupation conf base p_auth gen_p =
-  if p_auth then
-        let s = gen_p.occupation in
-        let s =
-          let wi =
-            {Wiki.wi_mode = "NOTES";
-             Wiki.wi_file_path = Notes.file_path conf base;
-             Wiki.wi_person_exists = person_exists conf base;
-             Wiki.wi_always_show_link = conf.wizard || conf.friend}
-          in
-          Wiki.syntax_links conf wi s
-        in
-        string_with_macros conf [] s
-      else ""
+  if p_auth
+  then !!(Notes.source conf base gen_p.occupation)
+  else ""
 
 let fill_index conf p p_auth =
   if not p_auth && (is_hide_names conf p)
@@ -1271,21 +1198,10 @@ let fill_index conf p p_auth =
   else
     Int32.of_string @@ Gwdb.string_of_iper (get_iper p)
 
-let fill_sources conf base p p_auth gen_p is_main_person =
-  if p_auth && is_main_person then
-    let s = gen_p.psources in
-    let env = [('i', fun () -> Util.default_image_name base p)] in
-    let s =
-      let wi =
-        {Wiki.wi_mode = "NOTES";
-         Wiki.wi_file_path = Notes.file_path conf base;
-         Wiki.wi_person_exists = person_exists conf base;
-         Wiki.wi_always_show_link = conf.wizard || conf.friend}
-      in
-      Wiki.syntax_links conf wi s
-    in
-    string_with_macros conf env s
-    else ""
+let fill_sources conf base p_auth gen_p is_main_person =
+  if p_auth && is_main_person
+  then !!(Notes.source conf base gen_p.psources)
+  else ""
 
 let fill_parents conf base p base_prefix =
   match get_parents p with
@@ -1433,10 +1349,8 @@ let fiche_event_witness_constructor event_witness_type husband wife =
   })
 
 let fill_notes conf base p p_auth is_main_person gen_p =
-  if p_auth && not conf.no_note && is_main_person then
-    let env = [('i', fun () -> Util.default_image_name base p)] in
-    let s = gen_p.notes in
-    convert_wiki_notes_to_html_notes conf base env s "\n"
+  if p_auth && not conf.no_note && is_main_person
+  then !!(Notes.person_note conf base p gen_p.notes)
   else ""
 
 let simple_relation_person_constructor r_type p =
@@ -1681,7 +1595,7 @@ let pers_to_piqi_person conf base p base_prefix is_main_person =
 
     let (father, mother) = fill_parents conf base p base_prefix in
 
-    let psources = fill_sources conf base p p_auth gen_p is_main_person in
+    let psources = fill_sources conf base p_auth gen_p is_main_person in
     let birth_src = fill_birth_src p_auth gen_p in
     let baptism_src = fill_baptism_src p_auth gen_p in
     let death_src = fill_death_src p_auth gen_p in
@@ -1778,7 +1692,7 @@ let rec pers_to_piqi_fiche_person conf base p base_prefix is_main_person nb_asc
       let gen_p = Util.string_gen_person base (gen_person_of_person p) in
 
       (* Sources only returned for the main person. *)
-      let psources = if (is_main_person) then fill_sources conf base p p_auth gen_p is_main_person else "" in
+      let psources = if (is_main_person) then fill_sources conf base p_auth gen_p is_main_person else "" in
       let birth_src = if (is_main_person) then fill_birth_src p_auth gen_p else "" in
       let baptism_src = if (is_main_person) then fill_baptism_src p_auth gen_p else "" in
       let death_src = if (is_main_person) then fill_death_src p_auth gen_p else "" in
diff --git a/src/api_update_util.ml b/src/api_update_util.ml
index 66e5550..565f066 100644
--- a/src/api_update_util.ml
+++ b/src/api_update_util.ml
@@ -5,7 +5,6 @@ module Mwrite = Api_saisie_write_piqi
 module Mext_write = Api_saisie_write_piqi_ext
 
 open Geneweb
-open Config
 open Def
 open Gwdb
 open Util
@@ -730,19 +729,7 @@ let pers_to_piqi_person_search_info conf base p =
       | None -> ""
       *)
   in
-  let occupation =
-    let s = sou base (get_occupation p) in
-    let s =
-      let wi =
-        {Wiki.wi_mode = "NOTES";
-         Wiki.wi_file_path = Notes.file_path conf base;
-         Wiki.wi_person_exists = person_exists conf base;
-         Wiki.wi_always_show_link = conf.wizard || conf.friend}
-      in
-      Wiki.syntax_links conf wi s
-    in
-    string_with_macros conf [] s
-  in
+  let occupation = !!(Notes.source conf base (sou base (get_occupation p))) in
   let events =
     List.map
       (fun (name, date, place, note, src, w, isp) ->
@@ -757,33 +744,8 @@ let pers_to_piqi_person_search_info conf base p =
           | _ -> ("", "", "", "", None)
         in
         let place = !!(Util.string_of_place conf (sou base place)) in
-        let note =
-          let env = [('i', fun () -> Util.default_image_name base p)] in
-          let s = sou base note in
-          let s = string_with_macros conf env s in
-          let lines = Wiki.html_of_tlsw conf s in
-          let wi =
-            {Wiki.wi_mode = "NOTES";
-             Wiki.wi_file_path = Notes.file_path conf base;
-             Wiki.wi_person_exists = person_exists conf base;
-             Wiki.wi_always_show_link = conf.wizard || conf.friend}
-          in
-          Wiki.syntax_links conf wi (String.concat "\n" lines)
-        in
-        let src =
-          let s = sou base src in
-          let env = [('i', fun () -> Util.default_image_name base p)] in
-          let s =
-            let wi =
-              {Wiki.wi_mode = "NOTES";
-               Wiki.wi_file_path = Notes.file_path conf base;
-               Wiki.wi_person_exists = person_exists conf base;
-               Wiki.wi_always_show_link = conf.wizard || conf.friend}
-            in
-            Wiki.syntax_links conf wi s
-          in
-          string_with_macros conf env s
-        in
+        let note = !!(Notes.person_note conf base p (sou base note)) in
+        let src = !!(Notes.source conf base (sou base src)) in
         let spouse =
           match isp with
           | Some ip ->
@@ -818,33 +780,8 @@ let pers_to_piqi_person_search_info conf base p =
         })
       (Perso.events_list conf base p)
   in
-  let notes =
-    let env = [('i', fun () -> Util.default_image_name base p)] in
-    let s = sou base (get_notes p) in
-    let s = string_with_macros conf env s in
-    let lines = Wiki.html_of_tlsw conf s in
-    let wi =
-      {Wiki.wi_mode = "NOTES";
-       Wiki.wi_file_path = Notes.file_path conf base;
-       Wiki.wi_person_exists = person_exists conf base;
-       Wiki.wi_always_show_link = conf.wizard || conf.friend}
-    in
-    Wiki.syntax_links conf wi (String.concat "\n" lines)
-  in
-  let psources =
-    let s = sou base (get_psources p) in
-    let env = [('i', fun () -> Util.default_image_name base p)] in
-    let s =
-      let wi =
-        {Wiki.wi_mode = "NOTES";
-         Wiki.wi_file_path = Notes.file_path conf base;
-         Wiki.wi_person_exists = person_exists conf base;
-         Wiki.wi_always_show_link = conf.wizard || conf.friend}
-      in
-      Wiki.syntax_links conf wi s
-    in
-    string_with_macros conf env s
-  in
+  let notes = !!(Notes.person_note conf base p (sou base (get_notes p))) in
+  let psources = !!(Notes.source conf base (sou base (get_psources p))) in
   let has_sources = psources <> "" in
   let titles = Perso.nobility_titles_list conf base p in
   let titles =

From 0d4c2ea441c1c6080e7ed0de70aa161776818448 Mon Sep 17 00:00:00 2001
From: Julien Sagot <julien.sagot@geneanet.org>
Date: Wed, 30 Mar 2022 15:22:29 +0200
Subject: [PATCH 3/3] Sanitize primary events sources

---
 src/api_saisie_read.ml | 46 +++++++++++++++++++++++-------------------
 1 file changed, 25 insertions(+), 21 deletions(-)

diff --git a/src/api_saisie_read.ml b/src/api_saisie_read.ml
index 644deda..180d667 100644
--- a/src/api_saisie_read.ml
+++ b/src/api_saisie_read.ml
@@ -599,7 +599,9 @@ let fam_to_piqi_family_link conf base (ifath : Gwdb.iper) imoth sp ifam fam base
   let marriage_place =
     if m_auth then !!(Util.string_of_place conf gen_f.marriage_place) else ""
   in
-  let marriage_src = if p_auth then gen_f.marriage_src else "" in
+  let marriage_src =
+    if m_auth then !!(Notes.source conf base gen_f.marriage_src) else ""
+  in
   let marriage_type =
     match gen_f.relation with
     | Married -> `married
@@ -836,7 +838,9 @@ let get_family_piqi base conf ifam p base_prefix spouse_to_piqi witnesses_to_piq
   let marriage_place =
     if m_auth then !!(Util.string_of_place conf gen_f.marriage_place) else ""
   in
-  let marriage_src = if p_auth then gen_f.marriage_src else "" in
+  let marriage_src =
+    if m_auth then !!(Notes.source conf base gen_f.marriage_src) else ""
+  in
   let marriage_type =
     match gen_f.relation with
     | Married -> `married
@@ -1140,17 +1144,17 @@ let fill_baptism_place conf p_auth gen_p =
 let fill_death_place conf p_auth gen_p =
   if p_auth then !!(Util.string_of_place conf gen_p.death_place) else ""
 
-let fill_birth_src p_auth gen_p =
-  if p_auth then gen_p.birth_src else ""
+let fill_birth_src conf base p_auth gen_p =
+  if p_auth then !!(Notes.source conf base gen_p.birth_src) else ""
 
-let fill_burial_src p_auth gen_p =
-  if p_auth then gen_p.burial_src else ""
+let fill_burial_src conf base p_auth gen_p =
+  if p_auth then !!(Notes.source conf base gen_p.burial_src) else ""
 
-let fill_death_src p_auth gen_p =
-  if p_auth then gen_p.death_src else ""
+let fill_death_src conf base p_auth gen_p =
+  if p_auth then !!(Notes.source conf base gen_p.death_src) else ""
 
-let fill_baptism_src p_auth gen_p =
-  if p_auth then gen_p.baptism_src else ""
+let fill_baptism_src conf base p_auth gen_p =
+  if p_auth then !!(Notes.source conf base gen_p.baptism_src) else ""
 
 let fill_burial_place conf p_auth gen_p =
   if p_auth then !!(Util.string_of_place conf gen_p.burial_place) else ""
@@ -1596,10 +1600,10 @@ let pers_to_piqi_person conf base p base_prefix is_main_person =
     let (father, mother) = fill_parents conf base p base_prefix in
 
     let psources = fill_sources conf base p_auth gen_p is_main_person in
-    let birth_src = fill_birth_src p_auth gen_p in
-    let baptism_src = fill_baptism_src p_auth gen_p in
-    let death_src = fill_death_src p_auth gen_p in
-    let burial_src = fill_burial_src p_auth gen_p in
+    let birth_src = fill_birth_src conf base p_auth gen_p in
+    let baptism_src = fill_baptism_src conf base p_auth gen_p in
+    let death_src = fill_death_src conf base p_auth gen_p in
+    let burial_src = fill_burial_src conf base p_auth gen_p in
     let has_sources = has_sources p_auth psources birth_src baptism_src death_src burial_src in
 
     {
@@ -1621,7 +1625,7 @@ let pers_to_piqi_person conf base p base_prefix is_main_person =
       birth_date_conv = transform_empty_string_to_None birth_date_conv;
       birth_date_cal = birth_cal;
       birth_place = transform_empty_string_to_None (fill_birth_place conf p_auth gen_p);
-      birth_src = transform_empty_string_to_None (fill_birth_src p_auth gen_p);
+      birth_src = transform_empty_string_to_None (fill_birth_src conf base p_auth gen_p);
       baptism_date = transform_empty_string_to_None baptism_date;
       baptism_date_conv = transform_empty_string_to_None baptism_date_conv;
       baptism_date_cal = baptism_cal;
@@ -1692,12 +1696,12 @@ let rec pers_to_piqi_fiche_person conf base p base_prefix is_main_person nb_asc
       let gen_p = Util.string_gen_person base (gen_person_of_person p) in
 
       (* Sources only returned for the main person. *)
-      let psources = if (is_main_person) then fill_sources conf base p_auth gen_p is_main_person else "" in
-      let birth_src = if (is_main_person) then fill_birth_src p_auth gen_p else "" in
-      let baptism_src = if (is_main_person) then fill_baptism_src p_auth gen_p else "" in
-      let death_src = if (is_main_person) then fill_death_src p_auth gen_p else "" in
-      let burial_src = if (is_main_person) then fill_burial_src p_auth gen_p else "" in
-      let has_sources = if (is_main_person) then has_sources p_auth psources birth_src baptism_src death_src burial_src else false in
+      let psources = if is_main_person then fill_sources conf base p_auth gen_p is_main_person else "" in
+      let birth_src = if is_main_person then fill_birth_src conf base p_auth gen_p else "" in
+      let baptism_src = if is_main_person then fill_baptism_src conf base p_auth gen_p else "" in
+      let death_src = if is_main_person then fill_death_src conf base p_auth gen_p else "" in
+      let burial_src = if is_main_person then fill_burial_src conf base p_auth gen_p else "" in
+      let has_sources = if is_main_person then has_sources p_auth psources birth_src baptism_src death_src burial_src else false in
       let (death_type, death_date, death_date_conv, death_cal) = fill_death conf p_auth gen_p in
       (* Linked links (family book). *)
       let (linked_page_biblio, linked_page_bnote, linked_page_death, linked_page_head, linked_page_occu) = if not simple_graph_info then fill_linked_page_if_is_main_person conf base p is_main_person else ("", "", "", "", "") in