From 2847c36d34f342d919272b9e0885a900166c6aec Mon Sep 17 00:00:00 2001 From: Aleridia Date: Thu, 4 Jun 2020 17:05:41 +0200 Subject: [PATCH 001/161] Add token's indexation --- learn-ocaml-client.install | 11 ++++ src/state/bd.ml | 96 +++++++++++++++++++++++++++++++++++ src/state/bd.mli | 12 +++++ src/state/dune | 9 +++- src/state/learnocaml_store.ml | 29 ++--------- 5 files changed, 130 insertions(+), 27 deletions(-) create mode 100644 learn-ocaml-client.install create mode 100644 src/state/bd.ml create mode 100644 src/state/bd.mli diff --git a/learn-ocaml-client.install b/learn-ocaml-client.install new file mode 100644 index 000000000..b3ee36415 --- /dev/null +++ b/learn-ocaml-client.install @@ -0,0 +1,11 @@ +lib: [ + "_build/install/default/lib/learn-ocaml-client/META" {"META"} + "_build/install/default/lib/learn-ocaml-client/opam" {"opam"} +] +bin: [ + "_build/install/default/bin/learn-ocaml-client" {"learn-ocaml-client"} +] +doc: [ + "_build/install/default/doc/learn-ocaml-client/LICENSE" + "_build/install/default/doc/learn-ocaml-client/README.md" +] diff --git a/src/state/bd.ml b/src/state/bd.ml new file mode 100644 index 000000000..8ef37c3dd --- /dev/null +++ b/src/state/bd.ml @@ -0,0 +1,96 @@ +open Yojson +open Printf +open Lwt +open Learnocaml_data + +(** TODO : Ajouter "creer_index" lors de l'initialisation de lot + ajouter "ajouter_token" lors d'une création de token **) + +let sync_dir = ref (Filename.concat (Sys.getcwd ()) "sync") + +(* Unlocked *) +let mutex_json_token = Lwt_mutex.create () + +let cast_list list = (`List list) + +let to_json_string (value:string) = (`String value : Yojson.Basic.t) + +let token_to_string liste = List.map (fun t -> Token.to_string t) liste + +let string_to_token liste = List.map (fun t -> Token.parse t) liste + +let get () = + let base = !sync_dir in + let ( / ) dir f = if dir = "" then f else Filename.concat dir f in + let rec scan f d acc = + let rec aux s acc = + Lwt.catch (fun () -> + Lwt_stream.get s >>= function + | Some ("." | "..") -> aux s acc + | Some x -> scan f (d / x) acc >>= aux s + | None -> Lwt.return acc) + @@ function + | Unix.Unix_error (Unix.ENOTDIR, _, _) -> f d acc + | Unix.Unix_error _ -> Lwt.return acc + | e -> Lwt.fail e + in + aux (Lwt_unix.files_of_directory (base / d)) acc + in + scan (fun d acc -> + let d = + if Filename.basename d = "save.json" then Filename.dirname d + else d + in + let stok = String.map (function '/' | '\\' -> '-' | c -> c) d in + if Token.check stok then + Lwt.return (stok :: acc) + else + Lwt.return acc + ) "" [] + + +(* Récupère le fichier demandé, le créé s'il nexiste pas *) +let get_fichier nom () = if Sys.file_exists nom + then Yojson.Basic.from_file nom + else + (Lwt_mutex.lock mutex_json_token; + close_out @@ open_out nom; + Lwt_mutex.unlock mutex_json_token; + Yojson.Basic.from_file nom) +(* Token list *) +let get_token () = + let json = get_fichier "token.json" () in + List.map (fun e -> Yojson.Basic.Util.to_string e) @@ Yojson.Basic.Util.to_list json + +(* string List -> (`String: Yojson.Basic.t) List *) +let rec transformation_liste liste = + match liste with + | x::l -> to_json_string x :: transformation_liste l + | [] -> [] + +(* Create index *) +let ecrire_index liste = + let data = cast_list @@ transformation_liste liste in + Lwt_mutex.lock mutex_json_token >>= fun u -> u; + let oo = open_out "token.json" in + Yojson.Basic.pretty_to_channel oo data; + close_out oo; + Lwt_mutex.unlock mutex_json_token; + Lwt.return_unit + +let ajouter_token token () = + let json_list = Yojson.Basic.Util.to_list @@ get_fichier "token.json" () in + let token = to_json_string token in + Lwt_mutex.lock mutex_json_token >>= fun u -> u; + let oo = open_out "token.json" in + Yojson.Basic.pretty_to_channel oo @@ cast_list (token::json_list); + close_out oo; + Lwt_mutex.unlock mutex_json_token; + Lwt.return_unit + +let creer_index = (get () >>= fun l -> ecrire_index l;) + +let test () = + creer_index >|= fun u -> u; + (* Mettre un Lwt.ignore_result marche pas *) + string_to_token @@ get_token (); diff --git a/src/state/bd.mli b/src/state/bd.mli new file mode 100644 index 000000000..55d7df8b9 --- /dev/null +++ b/src/state/bd.mli @@ -0,0 +1,12 @@ +val sync_dir : string ref +val mutex_json_token : Lwt_mutex.t +val cast_list : 'a -> [> `List of 'a ] +val to_json_string : string -> Yojson.Basic.t +val token_to_string : Learnocaml_data.Token.t list -> string list +val get_fichier : string -> unit -> Yojson.Basic.t +val get_token : unit -> string list +val transformation_liste : string list -> Yojson.Basic.t list +val ecrire_index : string list -> unit Lwt.t +val creer_index : unit Lwt.t +val ajouter_token : string -> unit -> unit Lwt.t +val test : unit -> Learnocaml_data.Token.t list Lwt.t diff --git a/src/state/dune b/src/state/dune index 2f37a386d..a40325912 100644 --- a/src/state/dune +++ b/src/state/dune @@ -26,9 +26,16 @@ learnocaml_data) ) +(library + (name bd) + (wrapped false) + (modules Bd) + (libraries lwt lwt.unix yojson learnocaml_data) +) + (library (name learnocaml_store) (wrapped false) (modules Learnocaml_store) - (libraries lwt_utils learnocaml_api) + (libraries bd lwt_utils learnocaml_api) ) diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 20ca030e1..443bfca69 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -377,32 +377,9 @@ module Token = struct let enc = J.(list enc) - let get () = - let base = !sync_dir in - let ( / ) dir f = if dir = "" then f else Filename.concat dir f in - let rec scan f d acc = - let rec aux s acc = - Lwt.catch (fun () -> - Lwt_stream.get s >>= function - | Some ("." | "..") -> aux s acc - | Some x -> scan f (d / x) acc >>= aux s - | None -> Lwt.return acc) - @@ function - | Unix.Unix_error (Unix.ENOTDIR, _, _) -> f d acc - | Unix.Unix_error _ -> Lwt.return acc - | e -> Lwt.fail e - in - aux (Lwt_unix.files_of_directory (base / d)) acc - in - scan (fun d acc -> - let d = - if Filename.basename d = "save.json" then Filename.dirname d - else d - in - let stok = String.map (function '/' | '\\' -> '-' | c -> c) d in - try Lwt.return (Token.parse stok :: acc) - with Failure _ -> Lwt.return acc - ) "" [] + open Bd + + let get () = Bd.test () end From 23fc260e956cacfa07506da1e68a8cdabd71d0bb Mon Sep 17 00:00:00 2001 From: Aleridia Date: Fri, 5 Jun 2020 13:05:05 +0200 Subject: [PATCH 002/161] Token idexation completed --- src/state/bd.ml | 75 ++++++++++++++++------------------- src/state/bd.mli | 15 ++++--- src/state/learnocaml_store.ml | 8 ++-- 3 files changed, 46 insertions(+), 52 deletions(-) diff --git a/src/state/bd.ml b/src/state/bd.ml index 8ef37c3dd..30094f623 100644 --- a/src/state/bd.ml +++ b/src/state/bd.ml @@ -1,10 +1,7 @@ open Yojson -open Printf open Lwt open Learnocaml_data -(** TODO : Ajouter "creer_index" lors de l'initialisation de lot - ajouter "ajouter_token" lors d'une création de token **) let sync_dir = ref (Filename.concat (Sys.getcwd ()) "sync") @@ -13,7 +10,7 @@ let mutex_json_token = Lwt_mutex.create () let cast_list list = (`List list) -let to_json_string (value:string) = (`String value : Yojson.Basic.t) +let string_to_json (value:string) = (`String value : Yojson.Basic.t) let token_to_string liste = List.map (fun t -> Token.to_string t) liste @@ -49,48 +46,46 @@ let get () = ) "" [] -(* Récupère le fichier demandé, le créé s'il nexiste pas *) -let get_fichier nom () = if Sys.file_exists nom - then Yojson.Basic.from_file nom - else - (Lwt_mutex.lock mutex_json_token; - close_out @@ open_out nom; - Lwt_mutex.unlock mutex_json_token; - Yojson.Basic.from_file nom) -(* Token list *) -let get_token () = - let json = get_fichier "token.json" () in - List.map (fun e -> Yojson.Basic.Util.to_string e) @@ Yojson.Basic.Util.to_list json - (* string List -> (`String: Yojson.Basic.t) List *) -let rec transformation_liste liste = - match liste with - | x::l -> to_json_string x :: transformation_liste l +let rec list_cast list = + match list with + | x::l -> string_to_json x :: list_cast l | [] -> [] -(* Create index *) -let ecrire_index liste = - let data = cast_list @@ transformation_liste liste in - Lwt_mutex.lock mutex_json_token >>= fun u -> u; +(* Create and write index file *) +let write_index list = + (let data = cast_list @@ list_cast list in + Lwt_mutex.lock mutex_json_token >|= fun () -> let oo = open_out "token.json" in Yojson.Basic.pretty_to_channel oo data; close_out oo; - Lwt_mutex.unlock mutex_json_token; - Lwt.return_unit + Lwt_mutex.unlock mutex_json_token;) + +let create_index = (get () >>= write_index;) -let ajouter_token token () = - let json_list = Yojson.Basic.Util.to_list @@ get_fichier "token.json" () in - let token = to_json_string token in - Lwt_mutex.lock mutex_json_token >>= fun u -> u; - let oo = open_out "token.json" in - Yojson.Basic.pretty_to_channel oo @@ cast_list (token::json_list); - close_out oo; - Lwt_mutex.unlock mutex_json_token; - Lwt.return_unit -let creer_index = (get () >>= fun l -> ecrire_index l;) +(* if file doesn't exist, create it *) +let get_file nom () = + if Sys.file_exists nom then( + try + Lwt.return @@ Yojson.Basic.from_file nom + with + Json_error _ -> create_index >|= fun () -> Yojson.Basic.from_file nom) + else + create_index >|= fun () -> Yojson.Basic.from_file nom + -let test () = - creer_index >|= fun u -> u; - (* Mettre un Lwt.ignore_result marche pas *) - string_to_token @@ get_token (); + +(* Token list *) +let get_tokens () = + let json = get_file "token.json" () in + json >|= Yojson.Basic.Util.to_list >|= List.map (fun e -> Yojson.Basic.Util.to_string e) >|= string_to_token + +let add_token token () = + (let token = string_to_json @@ Token.to_string token in + let json_list = get_file "token.json" () >|= Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in + Lwt_mutex.lock mutex_json_token >>= fun () -> + (let oo = open_out "token.json" in + json_list >|= cast_list >|= Yojson.Basic.pretty_to_channel oo >|= fun () -> + close_out oo; + Lwt_mutex.unlock mutex_json_token;)) diff --git a/src/state/bd.mli b/src/state/bd.mli index 55d7df8b9..f528d22b1 100644 --- a/src/state/bd.mli +++ b/src/state/bd.mli @@ -1,12 +1,11 @@ val sync_dir : string ref val mutex_json_token : Lwt_mutex.t val cast_list : 'a -> [> `List of 'a ] -val to_json_string : string -> Yojson.Basic.t +val string_to_json : string -> Yojson.Basic.t val token_to_string : Learnocaml_data.Token.t list -> string list -val get_fichier : string -> unit -> Yojson.Basic.t -val get_token : unit -> string list -val transformation_liste : string list -> Yojson.Basic.t list -val ecrire_index : string list -> unit Lwt.t -val creer_index : unit Lwt.t -val ajouter_token : string -> unit -> unit Lwt.t -val test : unit -> Learnocaml_data.Token.t list Lwt.t +val get_file : string -> unit -> Yojson.Basic.t Lwt.t +val get_tokens : unit -> Learnocaml_data.Token.t list Lwt.t +val list_cast : string list -> Yojson.Basic.t list +val write_index : string list -> unit Lwt.t +val create_index : unit Lwt.t +val add_token : Learnocaml_data.Token.t -> unit -> unit Lwt.t diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 443bfca69..c3579234c 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -8,11 +8,13 @@ open Lwt.Infix open Learnocaml_data +open Bd module J = Json_encoding let static_dir = ref (Filename.concat (Sys.getcwd ()) "www") +(* Remember to change the sync_dir in Bd.ml *) let sync_dir = ref (Filename.concat (Sys.getcwd ()) "sync") module Json_codec = struct @@ -335,7 +337,7 @@ module Token = struct | Unix.Unix_error (Unix.EEXIST, _, _) -> aux () | e -> Lwt.fail e in - aux () + aux () >>= fun t -> Bd.add_token t () >>= fun u -> u; Lwt.return t let register ?(allow_teacher=false) token = if not allow_teacher && is_teacher token then @@ -377,9 +379,7 @@ module Token = struct let enc = J.(list enc) - open Bd - - let get () = Bd.test () + let get () = Bd.get_tokens () end From 447642abf55574686373e5f26943dd456789814c Mon Sep 17 00:00:00 2001 From: Aleridia Date: Fri, 5 Jun 2020 13:29:42 +0200 Subject: [PATCH 003/161] Change interface's name --- src/state/dune | 6 +++--- src/state/learnocaml_store.ml | 8 ++++---- src/state/{bd.ml => token_index.ml} | 0 src/state/{bd.mli => token_index.mli} | 0 4 files changed, 7 insertions(+), 7 deletions(-) rename src/state/{bd.ml => token_index.ml} (100%) rename src/state/{bd.mli => token_index.mli} (100%) diff --git a/src/state/dune b/src/state/dune index a40325912..439494fea 100644 --- a/src/state/dune +++ b/src/state/dune @@ -27,9 +27,9 @@ ) (library - (name bd) + (name token_index) (wrapped false) - (modules Bd) + (modules Token_index) (libraries lwt lwt.unix yojson learnocaml_data) ) @@ -37,5 +37,5 @@ (name learnocaml_store) (wrapped false) (modules Learnocaml_store) - (libraries bd lwt_utils learnocaml_api) + (libraries token_index lwt_utils learnocaml_api) ) diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index c3579234c..4ea21e441 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -8,13 +8,13 @@ open Lwt.Infix open Learnocaml_data -open Bd +open Token_index module J = Json_encoding let static_dir = ref (Filename.concat (Sys.getcwd ()) "www") -(* Remember to change the sync_dir in Bd.ml *) +(* Remember to change the sync_dir in token_index.ml *) let sync_dir = ref (Filename.concat (Sys.getcwd ()) "sync") module Json_codec = struct @@ -337,7 +337,7 @@ module Token = struct | Unix.Unix_error (Unix.EEXIST, _, _) -> aux () | e -> Lwt.fail e in - aux () >>= fun t -> Bd.add_token t () >>= fun u -> u; Lwt.return t + aux () >>= fun t -> Token_index.add_token t () >>= fun u -> u; Lwt.return t let register ?(allow_teacher=false) token = if not allow_teacher && is_teacher token then @@ -379,7 +379,7 @@ module Token = struct let enc = J.(list enc) - let get () = Bd.get_tokens () + let get () = Token_index.get_tokens () end diff --git a/src/state/bd.ml b/src/state/token_index.ml similarity index 100% rename from src/state/bd.ml rename to src/state/token_index.ml diff --git a/src/state/bd.mli b/src/state/token_index.mli similarity index 100% rename from src/state/bd.mli rename to src/state/token_index.mli From 7061166fb7f38b430c3968dce8469baabaa28849 Mon Sep 17 00:00:00 2001 From: Aleridia Date: Fri, 5 Jun 2020 13:44:54 +0200 Subject: [PATCH 004/161] Change token.json's location --- src/state/token_index.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 30094f623..072969d9a 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -4,6 +4,7 @@ open Learnocaml_data let sync_dir = ref (Filename.concat (Sys.getcwd ()) "sync") +let json_file = "sync/token.json" (* Unlocked *) let mutex_json_token = Lwt_mutex.create () @@ -56,7 +57,7 @@ let rec list_cast list = let write_index list = (let data = cast_list @@ list_cast list in Lwt_mutex.lock mutex_json_token >|= fun () -> - let oo = open_out "token.json" in + let oo = open_out json_file in Yojson.Basic.pretty_to_channel oo data; close_out oo; Lwt_mutex.unlock mutex_json_token;) @@ -78,14 +79,14 @@ let get_file nom () = (* Token list *) let get_tokens () = - let json = get_file "token.json" () in + let json = get_file json_file () in json >|= Yojson.Basic.Util.to_list >|= List.map (fun e -> Yojson.Basic.Util.to_string e) >|= string_to_token let add_token token () = (let token = string_to_json @@ Token.to_string token in - let json_list = get_file "token.json" () >|= Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in + let json_list = get_file json_file () >|= Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in Lwt_mutex.lock mutex_json_token >>= fun () -> - (let oo = open_out "token.json" in + (let oo = open_out json_file in json_list >|= cast_list >|= Yojson.Basic.pretty_to_channel oo >|= fun () -> close_out oo; Lwt_mutex.unlock mutex_json_token;)) From 79fb9502b291518c3e9de58d7bf924dabfc0d673 Mon Sep 17 00:00:00 2001 From: Aleridia Date: Fri, 5 Jun 2020 13:56:07 +0200 Subject: [PATCH 005/161] Minor changes --- src/state/learnocaml_store.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 4ea21e441..1ca87aeaa 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -337,7 +337,7 @@ module Token = struct | Unix.Unix_error (Unix.EEXIST, _, _) -> aux () | e -> Lwt.fail e in - aux () >>= fun t -> Token_index.add_token t () >>= fun u -> u; Lwt.return t + aux () >>= fun t -> Token_index.add_token t () >|= fun _ -> t let register ?(allow_teacher=false) token = if not allow_teacher && is_teacher token then From f375e0a5dc4d5c4a8cabde09f6f445b7aea9920a Mon Sep 17 00:00:00 2001 From: Aleridia Date: Mon, 8 Jun 2020 09:50:19 +0200 Subject: [PATCH 006/161] Update PR - Rename variable - Remove some useles brackets - Change sync_dir system for token_index.ml - Change token_index.mli - Little refactoring Co-authored-by: Erik Martin-Dorel --- src/state/learnocaml_store.ml | 4 +-- src/state/token_index.ml | 67 +++++++++++++++-------------------- src/state/token_index.mli | 29 +++++++++------ 3 files changed, 49 insertions(+), 51 deletions(-) diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 1ca87aeaa..c64366cf9 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -337,7 +337,7 @@ module Token = struct | Unix.Unix_error (Unix.EEXIST, _, _) -> aux () | e -> Lwt.fail e in - aux () >>= fun t -> Token_index.add_token t () >|= fun _ -> t + aux () >>= fun t -> Token_index.add_token t !sync_dir >|= fun _ -> t let register ?(allow_teacher=false) token = if not allow_teacher && is_teacher token then @@ -379,7 +379,7 @@ module Token = struct let enc = J.(list enc) - let get () = Token_index.get_tokens () + let get () = Token_index.get_tokens !sync_dir () end diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 072969d9a..43b4d42bb 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -3,22 +3,21 @@ open Lwt open Learnocaml_data -let sync_dir = ref (Filename.concat (Sys.getcwd ()) "sync") -let json_file = "sync/token.json" +let token_file = "sync/token.json" (* Unlocked *) -let mutex_json_token = Lwt_mutex.create () +let mutex_token = Lwt_mutex.create () -let cast_list list = (`List list) +let cast_list l = `List l let string_to_json (value:string) = (`String value : Yojson.Basic.t) -let token_to_string liste = List.map (fun t -> Token.to_string t) liste +let token_to_string l = List.map (fun t -> Token.to_string t) l -let string_to_token liste = List.map (fun t -> Token.parse t) liste +let string_to_token l = List.map (fun t -> Token.parse t) l -let get () = - let base = !sync_dir in +let get (sync_dir : string) () = + let base = sync_dir in let ( / ) dir f = if dir = "" then f else Filename.concat dir f in let rec scan f d acc = let rec aux s acc = @@ -47,46 +46,38 @@ let get () = ) "" [] -(* string List -> (`String: Yojson.Basic.t) List *) -let rec list_cast list = - match list with - | x::l -> string_to_json x :: list_cast l - | [] -> [] - -(* Create and write index file *) -let write_index list = - (let data = cast_list @@ list_cast list in - Lwt_mutex.lock mutex_json_token >|= fun () -> - let oo = open_out json_file in +let write_file file mutex data = + (Lwt_mutex.lock mutex >|= fun () -> + let oo = open_out file in Yojson.Basic.pretty_to_channel oo data; close_out oo; - Lwt_mutex.unlock mutex_json_token;) + Lwt_mutex.unlock mutex) -let create_index = (get () >>= write_index;) +let create_index (sync_dir : string) = + let l = get sync_dir () in + let data = l >|= List.map string_to_json >|= cast_list in + data >>= write_file token_file mutex_token (* if file doesn't exist, create it *) -let get_file nom () = - if Sys.file_exists nom then( +let get_file nom (sync_dir : string) = + if Sys.file_exists nom then begin try Lwt.return @@ Yojson.Basic.from_file nom with - Json_error _ -> create_index >|= fun () -> Yojson.Basic.from_file nom) + (* Note: this error handling could be adapted later on, to be "more conservative"? (this does not matter now, as the "sync/token.json" file is not critical and can be regenerated) *) + Json_error _ -> create_index sync_dir >|= fun () -> Yojson.Basic.from_file nom end else - create_index >|= fun () -> Yojson.Basic.from_file nom - + create_index sync_dir >|= fun () -> Yojson.Basic.from_file nom (* Token list *) -let get_tokens () = - let json = get_file json_file () in - json >|= Yojson.Basic.Util.to_list >|= List.map (fun e -> Yojson.Basic.Util.to_string e) >|= string_to_token - -let add_token token () = - (let token = string_to_json @@ Token.to_string token in - let json_list = get_file json_file () >|= Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in - Lwt_mutex.lock mutex_json_token >>= fun () -> - (let oo = open_out json_file in - json_list >|= cast_list >|= Yojson.Basic.pretty_to_channel oo >|= fun () -> - close_out oo; - Lwt_mutex.unlock mutex_json_token;)) +let get_tokens (sync_dir : string) () = + let json = get_file token_file sync_dir in + json >|= Yojson.Basic.Util.to_list >|= List.map Yojson.Basic.Util.to_string >|= string_to_token + + +let add_token token (sync_dir : string) = + let token = string_to_json @@ Token.to_string token in + let json_list = get_file token_file sync_dir >|= Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in + json_list >|= cast_list >>= write_file token_file mutex_token diff --git a/src/state/token_index.mli b/src/state/token_index.mli index f528d22b1..98a76fd6c 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -1,11 +1,18 @@ -val sync_dir : string ref -val mutex_json_token : Lwt_mutex.t -val cast_list : 'a -> [> `List of 'a ] -val string_to_json : string -> Yojson.Basic.t -val token_to_string : Learnocaml_data.Token.t list -> string list -val get_file : string -> unit -> Yojson.Basic.t Lwt.t -val get_tokens : unit -> Learnocaml_data.Token.t list Lwt.t -val list_cast : string list -> Yojson.Basic.t list -val write_index : string list -> unit Lwt.t -val create_index : unit Lwt.t -val add_token : Learnocaml_data.Token.t -> unit -> unit Lwt.t +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019-2020 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +(** Create or regenerate token index from sync/ and write sync/token.json. + This step may take a long time (up to several minutes). Automatically + called (once and for all) by [get_tokens] or [add_token] if need be. *) +val create_index : string -> unit Lwt.t + +(** Get the list of all tokens. *) +val get_tokens : string -> unit -> Learnocaml_data.Token.t list Lwt.t + +(** Add a registered token in the index. *) +val add_token : Learnocaml_data.Token.t -> string -> unit Lwt.t From a98351bf43b81fe948503915e58d73343ed0537e Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 9 Jun 2020 12:22:16 +0200 Subject: [PATCH 007/161] chore: Ignore learn-ocaml-client.install --- .gitignore | 1 + learn-ocaml-client.install | 11 ----------- 2 files changed, 1 insertion(+), 11 deletions(-) delete mode 100644 learn-ocaml-client.install diff --git a/.gitignore b/.gitignore index 2173ae39e..f1957e9d4 100644 --- a/.gitignore +++ b/.gitignore @@ -10,6 +10,7 @@ src/ppx-metaquot/ast_lifter.ml learnocaml-server.byte learn-ocaml.install +learn-ocaml-client.install src/grader/embedded_cmis.ml src/grader/embedded_grading_cmis.ml diff --git a/learn-ocaml-client.install b/learn-ocaml-client.install deleted file mode 100644 index b3ee36415..000000000 --- a/learn-ocaml-client.install +++ /dev/null @@ -1,11 +0,0 @@ -lib: [ - "_build/install/default/lib/learn-ocaml-client/META" {"META"} - "_build/install/default/lib/learn-ocaml-client/opam" {"opam"} -] -bin: [ - "_build/install/default/bin/learn-ocaml-client" {"learn-ocaml-client"} -] -doc: [ - "_build/install/default/doc/learn-ocaml-client/LICENSE" - "_build/install/default/doc/learn-ocaml-client/README.md" -] From 331072b76cd247c09ad44f5a2e00294b6d794476 Mon Sep 17 00:00:00 2001 From: Aleridia Date: Wed, 10 Jun 2020 09:49:29 +0200 Subject: [PATCH 008/161] Change files due to PR in ocaml-sf Rename string_to_json : it's now cast_string Delete useless function Delete token_to_string Refactor string_to_token Remove parens on write_file Update way to use sync_dir Delete the 'sync/' from the token_file, change it on functions --- learn-ocaml-client.opam | 1 + src/state/learnocaml_api.ml | 2 +- src/state/learnocaml_store.ml | 2 -- src/state/token_index.ml | 24 +++++++++++------------- 4 files changed, 13 insertions(+), 16 deletions(-) diff --git a/learn-ocaml-client.opam b/learn-ocaml-client.opam index f4e06fffc..2c652ba30 100644 --- a/learn-ocaml-client.opam +++ b/learn-ocaml-client.opam @@ -37,6 +37,7 @@ depends: [ "ppx_tools" "ppx_sexp_conv" {= "v0.9.0"} "ppx_fields_conv" {= "v0.9.0"} + "yojson" {>= "1.4.0" } ] build: [ ["dune" "build" "@install" "-p" name "-j" jobs] diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 63043e4c3..b4fa30ba7 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -344,7 +344,7 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct Static ["exercise.html"] |> k | _ -> Static ("static"::path) |> k) - | `GET, ("description"::_), _token -> + | `GET, ("description"::_path), _token -> (* match token with | None -> Invalid_request "Missing token" |> k *) Static ["description.html"] |> k diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index c64366cf9..3d63430d9 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -8,13 +8,11 @@ open Lwt.Infix open Learnocaml_data -open Token_index module J = Json_encoding let static_dir = ref (Filename.concat (Sys.getcwd ()) "www") -(* Remember to change the sync_dir in token_index.ml *) let sync_dir = ref (Filename.concat (Sys.getcwd ()) "sync") module Json_codec = struct diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 43b4d42bb..4fcd1f4e2 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -3,18 +3,16 @@ open Lwt open Learnocaml_data -let token_file = "sync/token.json" +let token_file = "token.json" (* Unlocked *) let mutex_token = Lwt_mutex.create () let cast_list l = `List l -let string_to_json (value:string) = (`String value : Yojson.Basic.t) +let cast_string (value:string) = `String value -let token_to_string l = List.map (fun t -> Token.to_string t) l - -let string_to_token l = List.map (fun t -> Token.parse t) l +let string_to_token l = List.map Token.parse l let get (sync_dir : string) () = let base = sync_dir in @@ -47,16 +45,16 @@ let get (sync_dir : string) () = let write_file file mutex data = - (Lwt_mutex.lock mutex >|= fun () -> + Lwt_mutex.lock mutex >|= fun () -> let oo = open_out file in Yojson.Basic.pretty_to_channel oo data; close_out oo; - Lwt_mutex.unlock mutex) + Lwt_mutex.unlock mutex let create_index (sync_dir : string) = let l = get sync_dir () in - let data = l >|= List.map string_to_json >|= cast_list in - data >>= write_file token_file mutex_token + let data = l >|= List.map cast_string >|= cast_list in + data >>= write_file (sync_dir ^ "/" ^ token_file) mutex_token (* if file doesn't exist, create it *) @@ -73,11 +71,11 @@ let get_file nom (sync_dir : string) = (* Token list *) let get_tokens (sync_dir : string) () = - let json = get_file token_file sync_dir in + let json = get_file (sync_dir ^ "/" ^ token_file) sync_dir in json >|= Yojson.Basic.Util.to_list >|= List.map Yojson.Basic.Util.to_string >|= string_to_token let add_token token (sync_dir : string) = - let token = string_to_json @@ Token.to_string token in - let json_list = get_file token_file sync_dir >|= Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in - json_list >|= cast_list >>= write_file token_file mutex_token + let token = cast_string @@ Token.to_string token in + let json_list = get_file (sync_dir ^ "/" ^ token_file) sync_dir >|= Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in + json_list >|= cast_list >>= write_file (sync_dir ^ "/" ^ token_file) mutex_token From 3d750ec72c3199a7d8dc6e2314d84d64fd3df48a Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 17 Jun 2020 01:04:01 +0200 Subject: [PATCH 009/161] refactor: Token_index --- src/state/learnocaml_store.ml | 2 +- src/state/token_index.ml | 58 +++++++++++++++++++---------------- src/state/token_index.mli | 5 +-- 3 files changed, 35 insertions(+), 30 deletions(-) diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 3d63430d9..03315db42 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -377,7 +377,7 @@ module Token = struct let enc = J.(list enc) - let get () = Token_index.get_tokens !sync_dir () + let get () = Token_index.get_tokens !sync_dir end diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 4fcd1f4e2..c60ab78d3 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -14,9 +14,9 @@ let cast_string (value:string) = `String value let string_to_token l = List.map Token.parse l -let get (sync_dir : string) () = - let base = sync_dir in - let ( / ) dir f = if dir = "" then f else Filename.concat dir f in +let ( / ) dir f = if dir = "" then f else Filename.concat dir f + +let get sync_dir () = let rec scan f d acc = let rec aux s acc = Lwt.catch (fun () -> @@ -29,7 +29,7 @@ let get (sync_dir : string) () = | Unix.Unix_error _ -> Lwt.return acc | e -> Lwt.fail e in - aux (Lwt_unix.files_of_directory (base / d)) acc + aux (Lwt_unix.files_of_directory (sync_dir / d)) acc in scan (fun d acc -> let d = @@ -43,7 +43,6 @@ let get (sync_dir : string) () = Lwt.return acc ) "" [] - let write_file file mutex data = Lwt_mutex.lock mutex >|= fun () -> let oo = open_out file in @@ -51,31 +50,36 @@ let write_file file mutex data = close_out oo; Lwt_mutex.unlock mutex -let create_index (sync_dir : string) = +let create_index sync_dir = + (* Note: we may want to write some line in the standard output telling that + the token index is being generated. *) let l = get sync_dir () in let data = l >|= List.map cast_string >|= cast_list in - data >>= write_file (sync_dir ^ "/" ^ token_file) mutex_token - - -(* if file doesn't exist, create it *) -let get_file nom (sync_dir : string) = - if Sys.file_exists nom then begin - try - Lwt.return @@ Yojson.Basic.from_file nom - with - (* Note: this error handling could be adapted later on, to be "more conservative"? (this does not matter now, as the "sync/token.json" file is not critical and can be regenerated) *) - Json_error _ -> create_index sync_dir >|= fun () -> Yojson.Basic.from_file nom end + data >>= write_file (sync_dir / token_file) mutex_token + +let get_file name sync_dir = + let create () = + create_index sync_dir >|= fun () -> Yojson.Basic.from_file name + in + if Sys.file_exists name then begin + try + Lwt.return @@ Yojson.Basic.from_file name + with + (* Note: this error handler may be adapted later to be more conservative? + it does not matter now as sync/token.json is not a critical file, and + can be regenerated. *) + Json_error _ -> create () end else - create_index sync_dir >|= fun () -> Yojson.Basic.from_file nom - - -(* Token list *) -let get_tokens (sync_dir : string) () = - let json = get_file (sync_dir ^ "/" ^ token_file) sync_dir in - json >|= Yojson.Basic.Util.to_list >|= List.map Yojson.Basic.Util.to_string >|= string_to_token + create () +let get_tokens sync_dir = + let json = get_file (sync_dir / token_file) sync_dir in + json >|= Yojson.Basic.Util.to_list >|= + List.map Yojson.Basic.Util.to_string >|= string_to_token -let add_token token (sync_dir : string) = +let add_token token sync_dir = let token = cast_string @@ Token.to_string token in - let json_list = get_file (sync_dir ^ "/" ^ token_file) sync_dir >|= Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in - json_list >|= cast_list >>= write_file (sync_dir ^ "/" ^ token_file) mutex_token + let json_list = + get_file (sync_dir / token_file) sync_dir >|= + Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in + json_list >|= cast_list >>= write_file (sync_dir / token_file) mutex_token diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 98a76fd6c..1dfa5ce6b 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -8,11 +8,12 @@ (** Create or regenerate token index from sync/ and write sync/token.json. This step may take a long time (up to several minutes). Automatically - called (once and for all) by [get_tokens] or [add_token] if need be. *) + called (once and for all) by [get_tokens] or [add_token] if need be. + The first argument denotes the sync directory path. *) val create_index : string -> unit Lwt.t (** Get the list of all tokens. *) -val get_tokens : string -> unit -> Learnocaml_data.Token.t list Lwt.t +val get_tokens : string -> Learnocaml_data.Token.t list Lwt.t (** Add a registered token in the index. *) val add_token : Learnocaml_data.Token.t -> string -> unit Lwt.t From 0e2a77a0903a5f10e796027936b8ed6b816f62ee Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 10 Jul 2020 22:55:57 +0200 Subject: [PATCH 010/161] token_index: rewrite to use Ezjsonm instead of Yojson We already use Ezjsonm, so there is no need to also depend on Yojson. Signed-off-by: Alban Gruin --- learn-ocaml-client.opam | 1 - learn-ocaml.opam | 1 - learn-ocaml.opam.locked | 1 - src/state/dune | 2 +- src/state/learnocaml_store.ml | 2 +- src/state/token_index.ml | 93 +++++++++++++++++++++-------------- src/state/token_index.mli | 2 +- 7 files changed, 60 insertions(+), 42 deletions(-) diff --git a/learn-ocaml-client.opam b/learn-ocaml-client.opam index 2c652ba30..f4e06fffc 100644 --- a/learn-ocaml-client.opam +++ b/learn-ocaml-client.opam @@ -37,7 +37,6 @@ depends: [ "ppx_tools" "ppx_sexp_conv" {= "v0.9.0"} "ppx_fields_conv" {= "v0.9.0"} - "yojson" {>= "1.4.0" } ] build: [ ["dune" "build" "@install" "-p" name "-j" jobs] diff --git a/learn-ocaml.opam b/learn-ocaml.opam index 19c67b877..05a13c2d2 100644 --- a/learn-ocaml.opam +++ b/learn-ocaml.opam @@ -51,7 +51,6 @@ depends: [ "ppx_cstruct" "ppx_tools" "uutf" {>= "1.0" } - "yojson" {>= "1.4.0" } "asak" {>= "0.1"} ] build: [ diff --git a/learn-ocaml.opam.locked b/learn-ocaml.opam.locked index 19f82d5f8..b3f823507 100644 --- a/learn-ocaml.opam.locked +++ b/learn-ocaml.opam.locked @@ -111,7 +111,6 @@ depends: [ "uchar" {= "0.0.2"} "uri" {= "1.9.7"} "uutf" {= "1.0.2"} - "yojson" {= "1.7.0"} ] build: [ [make "static"] diff --git a/src/state/dune b/src/state/dune index 439494fea..4e371d103 100644 --- a/src/state/dune +++ b/src/state/dune @@ -30,7 +30,7 @@ (name token_index) (wrapped false) (modules Token_index) - (libraries lwt lwt.unix yojson learnocaml_data) + (libraries lwt lwt.unix learnocaml_data) ) (library diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 03315db42..836373721 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -335,7 +335,7 @@ module Token = struct | Unix.Unix_error (Unix.EEXIST, _, _) -> aux () | e -> Lwt.fail e in - aux () >>= fun t -> Token_index.add_token t !sync_dir >|= fun _ -> t + aux () >>= fun t -> Token_index.add_token !sync_dir t >|= fun _ -> t let register ?(allow_teacher=false) token = if not allow_teacher && is_teacher token then diff --git a/src/state/token_index.ml b/src/state/token_index.ml index c60ab78d3..70fbefe85 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -1,20 +1,41 @@ -open Yojson open Lwt open Learnocaml_data - let token_file = "token.json" (* Unlocked *) let mutex_token = Lwt_mutex.create () -let cast_list l = `List l +let ( / ) dir f = if dir = "" then f else Filename.concat dir f -let cast_string (value:string) = `String value +module J = Json_encoding -let string_to_token l = List.map Token.parse l +module Json = struct + let decode enc s = + (match s with + | "" -> `O [] + | s -> Ezjsonm.from_string s) + |> J.destruct enc -let ( / ) dir f = if dir = "" then f else Filename.concat dir f + let encode ?minify enc x = + match J.construct enc x with + | `A _ | `O _ as json -> Ezjsonm.to_string ?minify json + | `Null -> "" + | _ -> assert false +end + +let enc = J.(list (string)) + +let parse data = + Json.decode enc data + |> List.map Learnocaml_data.Token.parse + +let serialise_str = + Json.encode ?minify:(Some(false)) enc + +let serialise data = + List.map Learnocaml_data.Token.to_string data + |> serialise_str let get sync_dir () = let rec scan f d acc = @@ -43,43 +64,43 @@ let get sync_dir () = Lwt.return acc ) "" [] -let write_file file mutex data = - Lwt_mutex.lock mutex >|= fun () -> - let oo = open_out file in - Yojson.Basic.pretty_to_channel oo data; - close_out oo; - Lwt_mutex.unlock mutex +let read_file filename parse = + Lwt_io.open_file ~mode:Lwt_io.Input filename >>= fun channel -> + Lwt_io.read channel >>= fun data -> + Lwt_io.close channel >>= fun () -> + Lwt.return @@ parse data + +let write_file mutex filename serialise data = + Lwt_mutex.lock mutex >>= fun () -> + Lwt_io.open_file ~mode:Lwt_io.Output filename >>= fun channel -> + Lwt_io.write channel (serialise data) >>= fun () -> + Lwt_io.close channel >>= fun () -> + Lwt.return @@ Lwt_mutex.unlock mutex let create_index sync_dir = (* Note: we may want to write some line in the standard output telling that the token index is being generated. *) - let l = get sync_dir () in - let data = l >|= List.map cast_string >|= cast_list in - data >>= write_file (sync_dir / token_file) mutex_token + get sync_dir () >>= write_file mutex_token (sync_dir / token_file) serialise_str -let get_file name sync_dir = +let get_file sync_dir name = + let filename = (sync_dir / name) in let create () = - create_index sync_dir >|= fun () -> Yojson.Basic.from_file name - in - if Sys.file_exists name then begin - try - Lwt.return @@ Yojson.Basic.from_file name - with - (* Note: this error handler may be adapted later to be more conservative? - it does not matter now as sync/token.json is not a critical file, and - can be regenerated. *) - Json_error _ -> create () end + create_index sync_dir >>= fun () -> + read_file filename parse in + if Sys.file_exists filename then + Lwt.catch + (fun () -> read_file filename parse) + (fun _exn -> + (* Note: this error handler may be adapted later to be more conservative? + it does not matter now as sync/token.json is not a critical file, and + can be regenerated. *) + create ()) else create () let get_tokens sync_dir = - let json = get_file (sync_dir / token_file) sync_dir in - json >|= Yojson.Basic.Util.to_list >|= - List.map Yojson.Basic.Util.to_string >|= string_to_token - -let add_token token sync_dir = - let token = cast_string @@ Token.to_string token in - let json_list = - get_file (sync_dir / token_file) sync_dir >|= - Yojson.Basic.Util.to_list >>= fun l -> Lwt.return @@ token::l in - json_list >|= cast_list >>= write_file (sync_dir / token_file) mutex_token + get_file sync_dir token_file + +let add_token sync_dir token = + get_tokens sync_dir >>= fun tokens -> + write_file mutex_token (sync_dir / token_file) serialise (token :: tokens) diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 1dfa5ce6b..b527938bc 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -16,4 +16,4 @@ val create_index : string -> unit Lwt.t val get_tokens : string -> Learnocaml_data.Token.t list Lwt.t (** Add a registered token in the index. *) -val add_token : Learnocaml_data.Token.t -> string -> unit Lwt.t +val add_token : string -> Learnocaml_data.Token.t -> unit Lwt.t From fee06ee027e2b0dd33902b4549b6b2b1cd1834e5 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 10 Jul 2020 22:21:08 +0200 Subject: [PATCH 011/161] token_index: rewrite using modules This transforms token_index to use modules, to allow to change the underlying storage (currently they are stored in flat files). Signed-off-by: Alban Gruin --- src/main/dune | 7 +- src/main/learnocaml_client.ml | 2 +- src/server/dune | 5 +- src/server/learnocaml_server.ml | 2 +- src/state/dune | 2 +- src/state/learnocaml_store.ml | 18 +---- src/state/learnocaml_store.mli | 2 - src/state/token_index.ml | 124 +++++++++++++++++--------------- src/state/token_index.mli | 33 ++++++--- 9 files changed, 103 insertions(+), 92 deletions(-) diff --git a/src/main/dune b/src/main/dune index 949b77c6b..bba93d7a4 100644 --- a/src/main/dune +++ b/src/main/dune @@ -32,14 +32,15 @@ (flags :standard -linkall) (modules Learnocaml_client) (libraries cmdliner - sha + sha lwt.unix lwt_utils cohttp.lwt grading_cli learnocaml_data - learnocaml_store - learnocaml_api) + learnocaml_store + learnocaml_api + token_index) ) (executable diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index d4518988c..10bb2c0f7 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -424,7 +424,7 @@ let console_report ?(verbose=false) ex report = List.iter (fun i -> print_endline (format_item i)) report; print_newline () -module Api_client = Learnocaml_api.Client (Learnocaml_store.Json_codec) +module Api_client = Learnocaml_api.Client (Token_index.Json_codec) let fetch server_url req = let url path args = diff --git a/src/server/dune b/src/server/dune index 6925512d6..1e5fcdee1 100644 --- a/src/server/dune +++ b/src/server/dune @@ -9,12 +9,13 @@ lwt_utils cohttp.lwt magic-mime - sha + sha checkseum.c decompress learnocaml_report learnocaml_data learnocaml_api learnocaml_store - learnocaml_partition_create) + token_index + learnocaml_partition_create) ) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 29b15c2df..549c96dd5 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -511,7 +511,7 @@ module Request_handler = struct end -module Api_server = Api.Server (Json_codec) (Request_handler) +module Api_server = Api.Server (Token_index.Json_codec) (Request_handler) let init_teacher_token () = Token.Index.get () >>= function tokens -> diff --git a/src/state/dune b/src/state/dune index 4e371d103..d99f05c87 100644 --- a/src/state/dune +++ b/src/state/dune @@ -30,7 +30,7 @@ (name token_index) (wrapped false) (modules Token_index) - (libraries lwt lwt.unix learnocaml_data) + (libraries lwt lwt.unix learnocaml_api learnocaml_data) ) (library diff --git a/src/state/learnocaml_store.ml b/src/state/learnocaml_store.ml index 836373721..eeed2043e 100644 --- a/src/state/learnocaml_store.ml +++ b/src/state/learnocaml_store.ml @@ -8,6 +8,7 @@ open Lwt.Infix open Learnocaml_data +open Token_index module J = Json_encoding @@ -15,19 +16,6 @@ let static_dir = ref (Filename.concat (Sys.getcwd ()) "www") let sync_dir = ref (Filename.concat (Sys.getcwd ()) "sync") -module Json_codec = struct - let decode enc s = - (match s with - | "" -> `O [] - | s -> Ezjsonm.from_string s) - |> J.destruct enc - - let encode ?minify enc x = - match J.construct enc x with - | `A _ | `O _ as json -> Ezjsonm.to_string ?minify json - | `Null -> "" - | _ -> assert false -end let get_from_file enc p = Lwt_io.(with_file ~mode: Input p read) >|= Json_codec.decode enc @@ -335,7 +323,7 @@ module Token = struct | Unix.Unix_error (Unix.EEXIST, _, _) -> aux () | e -> Lwt.fail e in - aux () >>= fun t -> Token_index.add_token !sync_dir t >|= fun _ -> t + aux () >>= fun t -> TokenIndex.add_token !sync_dir t >|= fun _ -> t let register ?(allow_teacher=false) token = if not allow_teacher && is_teacher token then @@ -377,7 +365,7 @@ module Token = struct let enc = J.(list enc) - let get () = Token_index.get_tokens !sync_dir + let get () = TokenIndex.get_tokens !sync_dir end diff --git a/src/state/learnocaml_store.mli b/src/state/learnocaml_store.mli index f6bbd440b..14aa8232a 100644 --- a/src/state/learnocaml_store.mli +++ b/src/state/learnocaml_store.mli @@ -18,8 +18,6 @@ val sync_dir: string ref (** {2 Utility server-side conversion functions} *) -(** Used both for file i/o and request handling *) -module Json_codec: Learnocaml_api.JSON_CODEC val get_from_file : 'a Json_encoding.encoding -> string -> 'a Lwt.t val write_to_file : 'a Json_encoding.encoding -> 'a -> string -> unit Lwt.t diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 70fbefe85..d69443f26 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -1,16 +1,11 @@ open Lwt open Learnocaml_data -let token_file = "token.json" - -(* Unlocked *) -let mutex_token = Lwt_mutex.create () - let ( / ) dir f = if dir = "" then f else Filename.concat dir f module J = Json_encoding -module Json = struct +module Json_codec = struct let decode enc s = (match s with | "" -> `O [] @@ -24,20 +19,46 @@ module Json = struct | _ -> assert false end -let enc = J.(list (string)) +module type IndexRW = sig + type t + + val init : unit -> t + val read : string -> (string -> 'a) -> 'a Lwt.t + val write : t -> string -> ('a -> string) -> 'a -> unit Lwt.t +end + +module IndexFile: IndexRW = struct + type t = Lwt_mutex.t -let parse data = - Json.decode enc data - |> List.map Learnocaml_data.Token.parse + (* Unlocked by default *) + let init = Lwt_mutex.create -let serialise_str = - Json.encode ?minify:(Some(false)) enc + let read filename parse = + Lwt_io.open_file ~mode:Lwt_io.Input filename >>= fun channel -> + Lwt_io.read channel >>= fun data -> + Lwt_io.close channel >>= fun () -> + Lwt.return @@ parse data -let serialise data = - List.map Learnocaml_data.Token.to_string data - |> serialise_str + let write mutex filename serialise data = + Lwt_mutex.lock mutex >>= fun () -> + Lwt_io.open_file ~mode:Lwt_io.Output filename >>= fun channel -> + Lwt_io.write channel (serialise data) >>= fun () -> + Lwt_io.close channel >>= fun () -> + Lwt.return @@ Lwt_mutex.unlock mutex +end -let get sync_dir () = +module BaseTokenIndex (RW: IndexRW) = struct + let rw = RW.init () + let file = "token.json" + + let enc = J.list Token.enc + + let parse = Json_codec.decode enc + let serialise_str = Json_codec.encode ?minify:(Some(false)) J.(list string) + let serialise = Json_codec.encode ?minify:(Some(false)) enc + + let create_index sync_dir = + let found_indexes = let rec scan f d acc = let rec aux s acc = Lwt.catch (fun () -> @@ -62,45 +83,32 @@ let get sync_dir () = Lwt.return (stok :: acc) else Lwt.return acc - ) "" [] - -let read_file filename parse = - Lwt_io.open_file ~mode:Lwt_io.Input filename >>= fun channel -> - Lwt_io.read channel >>= fun data -> - Lwt_io.close channel >>= fun () -> - Lwt.return @@ parse data - -let write_file mutex filename serialise data = - Lwt_mutex.lock mutex >>= fun () -> - Lwt_io.open_file ~mode:Lwt_io.Output filename >>= fun channel -> - Lwt_io.write channel (serialise data) >>= fun () -> - Lwt_io.close channel >>= fun () -> - Lwt.return @@ Lwt_mutex.unlock mutex - -let create_index sync_dir = - (* Note: we may want to write some line in the standard output telling that - the token index is being generated. *) - get sync_dir () >>= write_file mutex_token (sync_dir / token_file) serialise_str - -let get_file sync_dir name = - let filename = (sync_dir / name) in - let create () = - create_index sync_dir >>= fun () -> - read_file filename parse in - if Sys.file_exists filename then - Lwt.catch - (fun () -> read_file filename parse) - (fun _exn -> - (* Note: this error handler may be adapted later to be more conservative? - it does not matter now as sync/token.json is not a critical file, and - can be regenerated. *) - create ()) - else - create () - -let get_tokens sync_dir = - get_file sync_dir token_file - -let add_token sync_dir token = - get_tokens sync_dir >>= fun tokens -> - write_file mutex_token (sync_dir / token_file) serialise (token :: tokens) + ) "" [] in + Lwt_io.printl "Regenerating the token index..." >>= fun () -> + found_indexes >>= RW.write rw (sync_dir / file) serialise_str + + let get_file sync_dir name = + let filename = (sync_dir / name) in + let create () = + create_index sync_dir >>= fun () -> + RW.read filename parse in + if Sys.file_exists filename then + Lwt.catch + (fun () -> RW.read filename parse) + (fun _exn -> + (* Note: this error handler may be adapted later to be more conservative? + it does not matter now as sync/token.json is not a critical file, and + can be regenerated. *) + create ()) + else + create () + + let get_tokens sync_dir = + get_file sync_dir file + + let add_token sync_dir token = + get_tokens sync_dir >>= fun tokens -> + RW.write rw (sync_dir / file) serialise (token :: tokens) +end + +module TokenIndex = BaseTokenIndex (IndexFile) diff --git a/src/state/token_index.mli b/src/state/token_index.mli index b527938bc..773e22360 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -6,14 +6,29 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -(** Create or regenerate token index from sync/ and write sync/token.json. - This step may take a long time (up to several minutes). Automatically - called (once and for all) by [get_tokens] or [add_token] if need be. - The first argument denotes the sync directory path. *) -val create_index : string -> unit Lwt.t +(** Used both for file i/o and request handling *) +module Json_codec: Learnocaml_api.JSON_CODEC -(** Get the list of all tokens. *) -val get_tokens : string -> Learnocaml_data.Token.t list Lwt.t +module type IndexRW = sig + type t -(** Add a registered token in the index. *) -val add_token : string -> Learnocaml_data.Token.t -> unit Lwt.t + val init : unit -> t + val read : string -> (string -> 'a) -> 'a Lwt.t + val write : t -> string -> ('a -> string) -> 'a -> unit Lwt.t +end + +module IndexFile: IndexRW + +module TokenIndex: sig + (** Create or regenerate token index from sync/ and write sync/token.json. + This step may take a long time (up to several minutes). Automatically + called (once and for all) by [get_tokens] or [add_token] if need be. + The first argument denotes the sync directory path. *) + val create_index : string -> unit Lwt.t + + (** Get the list of all tokens. *) + val get_tokens : string -> Learnocaml_data.Token.t list Lwt.t + + (** Add a registered token in the index. *) + val add_token : string -> Learnocaml_data.Token.t -> unit Lwt.t +end From 7b899f146138e65bc23e6ed232570894493f843e Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Tue, 14 Jul 2020 17:18:00 +0200 Subject: [PATCH 012/161] token_index: add moodle index module Signed-off-by: Alban Gruin --- src/state/token_index.ml | 37 +++++++++++++++++++++++++++++++++++++ src/state/token_index.mli | 12 ++++++++++++ 2 files changed, 49 insertions(+) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index d69443f26..7064e9f58 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -112,3 +112,40 @@ module BaseTokenIndex (RW: IndexRW) = struct end module TokenIndex = BaseTokenIndex (IndexFile) + +module BaseMoodleIndex (RW: IndexRW) = struct + let rw = RW.init () + let file = "moodle_user.json" + + let enc = J.assoc Token.enc + + let parse = Json_codec.decode enc + let serialise = Json_codec.encode ?minify:(Some(false)) enc + + let create_index sync_dir = + RW.write rw (sync_dir / file) serialise [] + + let get_users sync_dir = + Lwt.catch + (fun () -> RW.read (sync_dir / file) parse) + (fun _exn -> Lwt.return []) + + let user_exists sync_dir id = + get_users sync_dir >|= + List.exists (fun (rid, _token) -> rid = id) + + let add_user sync_dir id token = + get_users sync_dir >>= fun users -> + if List.exists (fun (rid, _token) -> rid = id) users then + Lwt.return () + else + let users = (id, token) :: users in + RW.write rw (sync_dir / file) serialise users + + let get_user_token sync_dir id = + get_users sync_dir >|= fun users -> + List.find (fun (rid, _token) -> rid = id) users + |> snd +end + +module MoodleIndex = BaseMoodleIndex (IndexFile) diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 773e22360..ac7b52743 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -32,3 +32,15 @@ module TokenIndex: sig (** Add a registered token in the index. *) val add_token : string -> Learnocaml_data.Token.t -> unit Lwt.t end + +module MoodleIndex: sig + val create_index : string -> unit Lwt.t + + val add_user : string -> string -> Learnocaml_data.Token.t -> unit Lwt.t + + (** Get a Moodle user's token, create it if not exist *) + val get_user_token : string -> string -> Learnocaml_data.Token.t Lwt.t + + val get_users : string -> (string * Learnocaml_data.Token.t) list Lwt.t + val user_exists : string -> string -> bool Lwt.t +end From 140eb9544f558991d7740f69e85abcad743a9598 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Tue, 14 Jul 2020 17:19:00 +0200 Subject: [PATCH 013/161] token_index: add oauth index module Signed-off-by: Alban Gruin --- src/state/dune | 2 +- src/state/token_index.ml | 61 +++++++++++++++++++++++++++++++++++++++ src/state/token_index.mli | 10 +++++++ 3 files changed, 72 insertions(+), 1 deletion(-) diff --git a/src/state/dune b/src/state/dune index d99f05c87..359e27b3b 100644 --- a/src/state/dune +++ b/src/state/dune @@ -30,7 +30,7 @@ (name token_index) (wrapped false) (modules Token_index) - (libraries lwt lwt.unix learnocaml_api learnocaml_data) + (libraries lwt lwt.unix learnocaml_api learnocaml_data cryptokit) ) (library diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 7064e9f58..2bf634783 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -149,3 +149,64 @@ module BaseMoodleIndex (RW: IndexRW) = struct end module MoodleIndex = BaseMoodleIndex (IndexFile) + +module BaseOauthIndex (RW: IndexRW) = struct + let rw = RW.init () + let file = "oauth.json" + + let enc = J.(assoc (list string)) + + let parse = Json_codec.decode enc + let serialise = Json_codec.encode ?minify:(Some(false)) enc + + (* Copyright https://github.com/astrada/gapi-ocaml + Return a secret hexa encoded *) + let gen_secret len = + let hexa_encode s = + let transform = Cryptokit.Hexa.encode () in + transform#put_string s; + transform#finish; + transform#get_string + in + let secret = hexa_encode @@ Cryptokit.Random.string Cryptokit.Random.secure_rng len in + Printf.printf "Auto-generated secret : %s\n" secret; + secret + + let create_index sync_dir = + let secret = gen_secret 32 in + RW.write rw (sync_dir / file) serialise [(secret, [])] >|= fun () -> + secret + + let get_first_oauth sync_dir = + let create () = + create_index sync_dir >|= fun secret -> + (secret, []) in + Lwt.catch + (fun () -> + RW.read (sync_dir / file) parse >>= function + | oauth :: _ -> Lwt.return oauth + | [] -> create ()) + (fun _exn -> create ()) + + let get_current_secret sync_dir = + get_first_oauth sync_dir >|= fun (secret, _nonces) -> + secret + + let purge sync_dir = + get_first_oauth sync_dir >>= fun oauth -> + RW.write rw (sync_dir / file) serialise [oauth] + + let add_nonce sync_dir nonce = + RW.read (sync_dir / file) parse >>= fun oauth -> + let oauth = + match oauth with + | (secret, nonces) :: r -> (secret, nonce :: nonces) :: r + | [] -> [(gen_secret 32, [nonce])] in + RW.write rw (sync_dir / file) serialise oauth + + let check_nonce sync_dir nonce = + get_first_oauth sync_dir >|= fun (_secret, nonces) -> + List.exists ((=) nonce) nonces +end + +module OauthIndex = BaseOauthIndex (IndexFile) diff --git a/src/state/token_index.mli b/src/state/token_index.mli index ac7b52743..2f30f2972 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -44,3 +44,13 @@ module MoodleIndex: sig val get_users : string -> (string * Learnocaml_data.Token.t) list Lwt.t val user_exists : string -> string -> bool Lwt.t end + +module OauthIndex: sig + val create_index : string -> string Lwt.t + + val get_first_oauth : string -> (string * string list) Lwt.t + val get_current_secret : string -> string Lwt.t + + (** Delete all secrets + nonce associated excepted the current secret with its nonces *) + val purge : string -> unit Lwt.t +end From c504f6c6f1d3d7dd5a45c0f534a269b14013609e Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Wed, 15 Jul 2020 09:57:59 +0200 Subject: [PATCH 014/161] token_index: add oauth validation code Signed-off-by: Alban Gruin --- src/state/dune | 2 +- src/state/token_index.ml | 69 +++++++++++++++++++++++++++++++++++++++ src/state/token_index.mli | 2 ++ 3 files changed, 72 insertions(+), 1 deletion(-) diff --git a/src/state/dune b/src/state/dune index 359e27b3b..fa1ffd930 100644 --- a/src/state/dune +++ b/src/state/dune @@ -30,7 +30,7 @@ (name token_index) (wrapped false) (modules Token_index) - (libraries lwt lwt.unix learnocaml_api learnocaml_data cryptokit) + (libraries lwt lwt.unix learnocaml_api learnocaml_data cryptokit netstring) ) (library diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 2bf634783..f1a93b6dd 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -210,3 +210,72 @@ module BaseOauthIndex (RW: IndexRW) = struct end module OauthIndex = BaseOauthIndex (IndexFile) + +type oauth_args = { + signature: string; + timestamp: string; + nonce: string; + version: string; + consumer_key: string; + signature_method: string; + } + +let get_oauth_args args = + (* POST request handling *) + List.( + let signature = assoc "oauth_signature" args and + timestamp = assoc "oauth_timestamp" args and + nonce = assoc "oauth_nonce" args and + version = assoc "oauth_version" args and + consumer_key = assoc "oauth_consumer_key" args and + signature_method = assoc "oauth_signature_method" args in + {signature; timestamp; nonce; version; consumer_key; signature_method} + ) + +(* Based on gapi-ocaml + This function will build a signature by using hmac_sha1 algorithm.*) +let signature_oauth list_args http_method basic_uri secret = + let pair_encode = (* 1 : encode keys/values *) + List.filter (fun (k, _) -> k <> "oauth_signature") list_args + |> List.map (fun (k, v) -> + Netencoding.Url.(encode ~plus:false k, encode ~plus:false v)) in + let pair_sorted = List.sort compare pair_encode in + let list_concat = (* 3 : Form key=value&key2=value2*) + List.map (fun (k, v) -> k ^ "=" ^ v) pair_sorted + |> String.concat "&" in + let signature_base_string = (* 4 : Add HTTP method and URI *) + Printf.sprintf "%s&%s&%s" (String.uppercase_ascii http_method) + (Netencoding.Url.encode ~plus:false basic_uri) + (Netencoding.Url.encode ~plus:false list_concat) in + let signing_key = (Netencoding.Url.encode ~plus:false secret) ^ "&" in (* 5 : Build signing_key *) + let encoding = + let hash = Cryptokit.MAC.hmac_sha1 signing_key in + let _ = hash#add_string signature_base_string in + let result = hash#result in + hash#wipe; + B64.encode result + in encoding + +let oauth_signature_method = "HMAC-SHA1" + +(** Don't give the same oauth_consumer_key to differents LTI consumer **) +(* Deal with the request to check OAuth autenticity and return Moodle user's token*) +let check_oauth sync_dir url args = + try + let oauth_args = get_oauth_args args in + if oauth_args.signature_method <> oauth_signature_method then + Lwt.return (Error "Not implemented") + else + OauthIndex.check_nonce sync_dir oauth_args.nonce >>= fun exists -> + if exists then + Lwt.return (Error "Nonce already used") + else + OauthIndex.add_nonce sync_dir oauth_args.nonce >>= fun () -> + OauthIndex.get_current_secret sync_dir >|= + signature_oauth args "post" url >>= fun s -> + if Eqaf.equal s oauth_args.signature then + Lwt.return (Ok (oauth_args.consumer_key ^ (List.assoc "user_id" args))) + else + Lwt.return (Error "Wrong signature") + with Not_found -> + Lwt.return (Error "Missing args") diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 2f30f2972..0295ae3b9 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -54,3 +54,5 @@ module OauthIndex: sig (** Delete all secrets + nonce associated excepted the current secret with its nonces *) val purge : string -> unit Lwt.t end + +val check_oauth : string -> string -> (string * string) list -> (string, string) result Lwt.t From fd5058de0f04110dadbda21ccafaff74805b164f Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Wed, 10 Jun 2020 17:09:03 +0200 Subject: [PATCH 015/161] app: add an interface to link a moodle account to a learn-ocaml account Signed-off-by: Alban Gruin --- src/app/dune | 22 ++++++++++++++- src/app/learnocaml_lti_main.ml | 47 ++++++++++++++++++++++++++++++++ src/state/learnocaml_api.ml | 1 + static/lti.html | 50 ++++++++++++++++++++++++++++++++++ 4 files changed, 119 insertions(+), 1 deletion(-) create mode 100644 src/app/learnocaml_lti_main.ml create mode 100644 static/lti.html diff --git a/src/app/dune b/src/app/dune index e48a6d160..d9e8d077f 100644 --- a/src/app/dune +++ b/src/app/dune @@ -143,6 +143,25 @@ (javascript_files ../ace-lib/ace_bindings.js)) ) +(executable + (name learnocaml_lti_main) + (modes byte) + (flags :standard -warn-error -6-9-27-33-39) + (libraries ezjsonm + ace + sha + learnocaml_repository + learnocaml_app_common + learnocaml_toplevel + js_of_ocaml.ppx + ocplib_i18n) + (modules Learnocaml_lti_main) + (preprocess (pps ppx_ocplib_i18n js_of_ocaml.ppx)) + (js_of_ocaml + (flags :standard +cstruct/cstruct.js) + (javascript_files ../ace-lib/ace_bindings.js)) +) + (install (package learn-ocaml) (section share) @@ -151,6 +170,7 @@ (learnocaml_student_view.bc.js as www/js/learnocaml-student-view.js) (learnocaml_description_main.bc.js as www/js/learnocaml-description.js) (learnocaml_partition_view.bc.js as www/js/learnocaml-partition-view.js) - (learnocaml_playground_main.bc.js as www/js/learnocaml-playground.js)) + (learnocaml_playground_main.bc.js as www/js/learnocaml-playground.js) + (learnocaml_lti_main.bc.js as www/js/learnocaml-lti.js)) ) diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml new file mode 100644 index 000000000..985e47d77 --- /dev/null +++ b/src/app/learnocaml_lti_main.ml @@ -0,0 +1,47 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2020 Alban Gruin + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +open Js_utils +open Learnocaml_data +open Learnocaml_common + +let id s = s, find_component s + +let login_overlay_id, login_overlay = id "login-overlay" +let login_new_id, login_new = id "login-new" +let login_returning_id, login_returning = id "login-returning" +let button_yes_id, button_yes = id "first-connection-yes" +let button_no_id, button_no = id "first-connection-no" + +let set_string_translations = + List.iter + (fun (id, text) -> + Manip.setInnerHtml (find_component id) text) + +let init_dialogs () = + hide login_returning; + Manip.SetCss.display login_overlay "block"; + Manip.Ev.onclick button_yes (fun _ -> + hide login_new; + Manip.SetCss.display login_returning "block"; + true); + Manip.Ev.onclick button_no (fun _ -> + Dom_html.window##.location##assign (Js.string "/"); + true) + +let () = + (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); + init_dialogs (); + set_string_translations [ + "txt_first_connection_dialog", [%i"First connection"]; + "txt_first_connection_question", [%i"Do you have a Learn OCaml account?"]; + "txt_button_yes", [%i"Yes"]; + "txt_button_no", [%i"No"]; + "txt_returning_token", [%i"Enter your token"]; + "txt_returning_token_label", [%i"Token"]; + "txt_button_connect", [%i"Connect"] + ] diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index b4fa30ba7..389ce9b38 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -401,6 +401,7 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct | ["student-view.html"] | ["description.html"] | ["partition-view.html"] + | ["lti.html"] | ("js"|"fonts"|"icons"|"css"|"static") :: _ as path), _ -> Static path |> k diff --git a/static/lti.html b/static/lti.html new file mode 100644 index 000000000..4bfa6c158 --- /dev/null +++ b/static/lti.html @@ -0,0 +1,50 @@ + + + + + Learn OCaml + + + + + + + + +
+
+

+
+
+
+
+ + +
+
+
+

+
+
+
+ +
+
+ +
+
+
+ + From 2a51fc99451da05e97157937dd1a25aac1031c68 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 12 Jun 2020 16:09:24 +0200 Subject: [PATCH 016/161] lti: use a form to properly send the token Signed-off-by: Alban Gruin --- static/lti.html | 30 ++++++++++++++++-------------- 1 file changed, 16 insertions(+), 14 deletions(-) diff --git a/static/lti.html b/static/lti.html index 4bfa6c158..bfefa7fee 100644 --- a/static/lti.html +++ b/static/lti.html @@ -14,7 +14,7 @@ text-align: center; } - #login-overlay > div > div:last-child { + #login-overlay div > div:last-child { padding: 0; } @@ -31,20 +31,22 @@

-
-

-
-
-
- -
-
- +
+
+

+
+
+
+ +
+
+ +
-
+
From 185fec834be6830d8debf6836d816f559f7118fe Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Wed, 24 Jun 2020 17:19:12 +0200 Subject: [PATCH 017/161] CSRF Signed-off-by: Alban Gruin --- src/app/learnocaml_lti_main.ml | 24 +++++++++++- src/server/dune | 3 +- src/server/learnocaml_server.ml | 65 +++++++++++++++++++++++++-------- static/lti.html | 1 + 4 files changed, 75 insertions(+), 18 deletions(-) diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 985e47d77..4ea5d5b89 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -6,7 +6,6 @@ * included LICENSE file for details. *) open Js_utils -open Learnocaml_data open Learnocaml_common let id s = s, find_component s @@ -17,6 +16,20 @@ let login_returning_id, login_returning = id "login-returning" let button_yes_id, button_yes = id "first-connection-yes" let button_no_id, button_no = id "first-connection-no" +let get_cookie name = + Js.(to_array (str_array (Dom_html.document##.cookie##split (string ";")))) + |> Array.fold_left + (fun res v -> + match res with + | Some _ -> res + | None -> let cookie = Js.to_string v + |> String.trim + |> String.split_on_char '=' in + match cookie with + | n :: v when n = name -> Some (String.concat "=" v) + | _ -> None) + None + let set_string_translations = List.iter (fun (id, text) -> @@ -33,6 +46,12 @@ let init_dialogs () = Dom_html.window##.location##assign (Js.string "/"); true) +let setup_csrf_token () = + let csrf_input = Dom_html.getElementById "login-csrf-input" in + match get_cookie "csrf" with + | Some csrf -> csrf_input##setAttribute (Js.string "value") (Js.string csrf) + | None -> () + let () = (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); init_dialogs (); @@ -44,4 +63,5 @@ let () = "txt_returning_token", [%i"Enter your token"]; "txt_returning_token_label", [%i"Token"]; "txt_button_connect", [%i"Connect"] - ] + ]; + setup_csrf_token () diff --git a/src/server/dune b/src/server/dune index 1e5fcdee1..3b6a58c21 100644 --- a/src/server/dune +++ b/src/server/dune @@ -17,5 +17,6 @@ learnocaml_api learnocaml_store token_index - learnocaml_partition_create) + learnocaml_partition_create + cryptokit) ) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 549c96dd5..5d3f28c6d 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -68,12 +68,14 @@ type cached_response = { deflated_body: string option; content_type: string; caching: caching; + cookies: Cohttp.Cookie.Set_cookie_hdr.t list } type 'a response = | Response of { contents: 'a; content_type: string; - caching: caching } + caching: caching; + cookies: Cohttp.Cookie.Set_cookie_hdr.t list } | Cached of cached_response type error = (Cohttp.Code.status_code * string) @@ -108,21 +110,22 @@ let lwt_option_fail x e f = | Some x -> f x | None -> lwt_fail e -let respond_static caching path = +let respond_static ?(cookies=[]) caching path = lwt_catch_fail (fun () -> read_static_file path >>= fun contents -> let content_type = Magic_mime.lookup (List.fold_left (fun _ r -> r) "" path) in - lwt_ok @@ Response { contents; content_type; caching }) + lwt_ok @@ Response { contents; content_type; caching; cookies }) (fun e -> (`Not_found, Printexc.to_string e)) -let respond_json caching contents = +let respond_json ?(cookies=[]) caching contents = lwt_ok @@ Response { contents; content_type = "application/json"; - caching } + caching; + cookies } let verify_teacher_token token = Token.check_teacher token >>= function @@ -168,6 +171,11 @@ let check_report exo report grade = let score, _ = Learnocaml_report.result report in score * 100 / max_grade = grade +let generate_csrf_token length = + let random_bytes = Bytes.make length '\000' in + Cryptokit.Random.secure_rng#random_bytes random_bytes 0 length; + B64.encode (Bytes.to_string random_bytes) + module Memory_cache = struct let (tbl: (cache_request_hash, cached_response) Hashtbl.t) = @@ -224,6 +232,14 @@ module Request_handler = struct fun conn config cache -> function | Api.Version () -> respond_json cache (Api.version, config.ServerData.server_id) + | Api.Static ["lti.html"] -> + (* 32 bytes of entropy, same as RoR as of 2020. *) + let csrf_token = generate_csrf_token 32 in + let cookies = [Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 3600)) + ~path:"/" ~http_only:true + ("csrf", csrf_token)] in + respond_static ~cookies cache ["lti.html"] | Api.Static path -> respond_static cache path | Api.Nonce () -> @@ -287,7 +303,8 @@ module Request_handler = struct Lwt_process.pread ~stdin:stdout cmd >>= fun contents -> lwt_ok @@ Response { contents = contents; content_type = "application/zip"; - caching = Nocache } + caching = Nocache; + cookies = [] } | Api.Update_save (token, save) -> let save = Save.fix_mtimes save in let exercise_states = SMap.bindings save.Save.all_exercise_states in @@ -326,7 +343,8 @@ module Request_handler = struct lwt_ok @@ Response { contents; content_type = "application/octet-stream"; - caching = Nocache }) + caching = Nocache; + cookies = [] }) (fun e -> (`Not_found, Printexc.to_string e)) | Api.Students_list token -> @@ -413,7 +431,8 @@ module Request_handler = struct lwt_ok @@ Response {contents = Buffer.contents buf; content_type = "text/csv"; - caching = Nocache} + caching = Nocache; + cookies = []} | Api.Exercise_index (Some token) -> Exercise.Index.get () >>= fun index -> @@ -595,8 +614,8 @@ let launch () = (Cohttp.Header.get_acceptable_encodings req.Request.headers) in let respond = function - | Response {contents=body; content_type; caching; _} - | Cached {body; content_type; caching; _} as resp -> + | Response {contents=body; content_type; caching; cookies; _} + | Cached {body; content_type; caching; cookies; _} as resp -> let headers = Cohttp.Header.init_with "Content-Type" content_type in let headers = match caching with | Longcache _ -> @@ -611,10 +630,12 @@ let launch () = | Nocache -> Cohttp.Header.add headers "Cache-Control" "no-cache" in + let cookies_hdr = List.rev_map Cohttp.Cookie.Set_cookie_hdr.serialize cookies in + let headers = Cohttp.Header.add_list headers cookies_hdr in let resp = match resp, caching with | Response _, (Longcache key | Shortcache (Some key)) -> let cached = - {body; deflated_body = None; content_type; caching} + {body; deflated_body = None; content_type; caching; cookies = []} in Memory_cache.add key cached; Cached cached @@ -655,10 +676,24 @@ let launch () = | `GET -> lwt_ok {Api.meth = `GET; path; args} | `POST -> begin - string_of_stream (Cohttp_lwt.Body.to_stream body) - >>= function - | Some s -> lwt_ok {Api.meth = `POST s; path; args} - | None -> lwt_fail (`Bad_request, "Missing POST body") + Cohttp_lwt.Body.to_string body + >>= fun params -> + let param_list = Uri.query_of_encoded params in + if param_list = [] then + lwt_fail (`Bad_request, "Missing POST body") + else + let cookies = Cohttp.Cookie.Cookie_hdr.extract req.Request.headers in + match List.assoc_opt "csrf" param_list, + List.assoc_opt "csrf" cookies with + | Some (param_csrf :: _), Some cookie_csrf -> + if Eqaf.equal param_csrf cookie_csrf then + lwt_ok {Api.meth = `POST params; path; args} + else + lwt_fail (`Forbidden, "CSRF token mismatch") + | None, None | None, Some _ -> + lwt_ok {Api.meth = `POST params; path; args} + | _, _ -> + lwt_fail (`Forbidden, "Bad CSRF token") end | _ -> lwt_fail (`Bad_request, "Unsupported method")) >?= (fun req -> diff --git a/static/lti.html b/static/lti.html index bfefa7fee..5d5c08baa 100644 --- a/static/lti.html +++ b/static/lti.html @@ -42,6 +42,7 @@

id="login-token-input" autocomplete="off"> +
From 68da792fe86b6d7f41f3b0a214a97c37ba208e14 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Mon, 6 Jul 2020 15:23:51 +0200 Subject: [PATCH 018/161] learnocaml_server: add a mechanism to redirect to another page Signed-off-by: Alban Gruin --- src/server/learnocaml_server.ml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 5d3f28c6d..94ef0162d 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -76,6 +76,9 @@ type 'a response = content_type: string; caching: caching; cookies: Cohttp.Cookie.Set_cookie_hdr.t list } + | Redirect of { code: Cohttp.Code.status_code; + url: string; + cookies: Cohttp.Cookie.Set_cookie_hdr.t list } | Cached of cached_response type error = (Cohttp.Code.status_code * string) @@ -196,6 +199,7 @@ module Request_handler = struct let map_ret f r = r >?= function | Response ({contents; _} as r) -> lwt_ok @@ Response {r with contents = f contents} + | (Redirect _) as r -> lwt_ok r | (Cached _) as r -> lwt_ok r let alphanum = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" @@ -667,6 +671,11 @@ let launch () = (fun e -> Server.respond_error ~status:`Internal_server_error ~body:(Printexc.to_string e) ()) + | Redirect { code; url; cookies } -> + let headers = Cohttp.Header.init_with "Location" url in + let cookies_hdr = List.rev_map Cohttp.Cookie.Set_cookie_hdr.serialize cookies in + let headers = Cohttp.Header.add_list headers cookies_hdr in + Server.respond_string ~headers ~status:code ~body:"" () in if Cohttp.Header.get req.Request.headers "If-Modified-Since" = Some last_modified From 0ad40607649b914488415e6cfce1b55b025025ae Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Mon, 6 Jul 2020 16:14:57 +0200 Subject: [PATCH 019/161] /launch: let the server fill the form in launch.html itself For the association to an existing account to work, the user id given by the LTI application should be forwarded to the page doing the work. Let the csrf token be filled too, while we're at it. The used-id field is not secured, an attacker could associate an account that doesn't exist yet with a specific token. An HMAC could fix this issue. Signed-off-by: Alban Gruin --- src/app/learnocaml_lti_main.ml | 23 +------------ src/server/dune | 3 +- src/server/learnocaml_server.ml | 60 +++++++++++++++++++++++++++++++-- src/state/learnocaml_api.ml | 19 ++++++++++- src/state/learnocaml_api.mli | 4 +++ static/lti.html | 4 ++- 6 files changed, 86 insertions(+), 27 deletions(-) diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 4ea5d5b89..f63c7ceb7 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -16,20 +16,6 @@ let login_returning_id, login_returning = id "login-returning" let button_yes_id, button_yes = id "first-connection-yes" let button_no_id, button_no = id "first-connection-no" -let get_cookie name = - Js.(to_array (str_array (Dom_html.document##.cookie##split (string ";")))) - |> Array.fold_left - (fun res v -> - match res with - | Some _ -> res - | None -> let cookie = Js.to_string v - |> String.trim - |> String.split_on_char '=' in - match cookie with - | n :: v when n = name -> Some (String.concat "=" v) - | _ -> None) - None - let set_string_translations = List.iter (fun (id, text) -> @@ -46,12 +32,6 @@ let init_dialogs () = Dom_html.window##.location##assign (Js.string "/"); true) -let setup_csrf_token () = - let csrf_input = Dom_html.getElementById "login-csrf-input" in - match get_cookie "csrf" with - | Some csrf -> csrf_input##setAttribute (Js.string "value") (Js.string csrf) - | None -> () - let () = (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); init_dialogs (); @@ -63,5 +43,4 @@ let () = "txt_returning_token", [%i"Enter your token"]; "txt_returning_token_label", [%i"Token"]; "txt_button_connect", [%i"Connect"] - ]; - setup_csrf_token () + ] diff --git a/src/server/dune b/src/server/dune index 3b6a58c21..80682c5fc 100644 --- a/src/server/dune +++ b/src/server/dune @@ -18,5 +18,6 @@ learnocaml_store token_index learnocaml_partition_create - cryptokit) + cryptokit + markup) ) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 94ef0162d..43ab4efa9 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -236,14 +236,70 @@ module Request_handler = struct fun conn config cache -> function | Api.Version () -> respond_json cache (Api.version, config.ServerData.server_id) - | Api.Static ["lti.html"] -> + | Api.Launch body -> (* 32 bytes of entropy, same as RoR as of 2020. *) let csrf_token = generate_csrf_token 32 in let cookies = [Cohttp.Cookie.Set_cookie_hdr.make ~expiration:(`Max_age (Int64.of_int 3600)) ~path:"/" ~http_only:true ("csrf", csrf_token)] in - respond_static ~cookies cache ["lti.html"] + let params = Uri.query_of_encoded body + |> List.map (fun (a, b) -> a, String.concat "," b) in + Token_index.check_oauth !sync_dir "http://localhost:8080/launch" params >>= + (function + | Ok id -> + Token_index.MoodleIndex.user_exists !sync_dir id >>= fun exists -> + if exists then + Token_index.MoodleIndex.get_user_token !sync_dir id >>= fun token -> + let cookies = [Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 60)) + ~path:"/" + ("token", Token.to_string token)] in + lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } + else + (read_static_file ["launch.html"] >|= fun s -> + Markup.string s + |> Markup.parse_html + |> Markup.signals + |> Markup.map (function + | `Start_element ((e, "input"), attrs) -> + (match List.assoc_opt ("", "type") attrs, + List.assoc_opt ("", "name") attrs with + | Some "hidden", Some "csrf" -> + `Start_element ((e, "input"), (("", "value"), csrf_token) :: attrs) + | Some "hidden", Some "user-id" -> + `Start_element ((e, "input"), (("", "value"), id) :: attrs) + | _ -> `Start_element ((e, "input"), attrs)) + | t -> t) + |> Markup.pretty_print + |> Markup.write_html + |> Markup.to_string) >>= fun contents -> + lwt_ok @@ Response { contents; content_type="text/html"; caching=Nocache; cookies } + | Error e -> lwt_fail (`Forbidden, e)) + | Api.Launch_login body -> + let params = Uri.query_of_encoded body + |> List.map (fun (a, b) -> a, String.concat "," b) in + let cookies = [Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 60)) + ~path:"/" ~http_only:true + ("csrf", "expired")] in + let token = Token.parse (List.assoc "token" params) and + user_id = List.assoc "user-id" params in + Token_index.MoodleIndex.user_exists !sync_dir user_id >>= fun exists -> + if exists then + (* This can only happen if the user launched twice at the + same time and completed the form twice, but as the CSRF + in the cookies has changed twice (once for the second + form, once for the invalidation), this should not happen + at all. *) + lwt_fail (`Forbidden, "user exists") + else + Token_index.MoodleIndex.add_user !sync_dir user_id token >>= fun () -> + let cookies = (Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 60)) + ~path:"/" + ("token", Token.to_string token)) :: cookies in + lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | Api.Static path -> respond_static cache path | Api.Nonce () -> diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 389ce9b38..73f78ebbc 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -28,6 +28,10 @@ type _ request = | Update_save: 'a token * Save.t -> Save.t request | Git: 'a token * string list -> string request + | Launch: + string -> string request + | Launch_login: + string -> string request | Students_list: teacher token -> Student.t list request @@ -112,6 +116,8 @@ module Conversions (Json: JSON_CODEC) = struct | Update_save _ -> json Save.enc | Git _ -> str + | Launch _ -> str + | Launch_login _ -> str | Students_list _ -> json (J.list Student.enc) | Set_students_list _ -> @@ -187,7 +193,11 @@ module Conversions (Json: JSON_CODEC) = struct | Update_save (token, save) -> post ~token ["sync"] (Json.encode Save.enc save) | Git _ -> - assert false (* Reserved for the [git] client *) + assert false (* Reserved for the [git] client *) + | Launch _ -> + assert false (* Reserved for an LTI application *) + | Launch_login _ -> + assert false (* Reserved for an LTI application *) | Students_list token -> assert (Token.is_teacher token); @@ -344,6 +354,13 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct Static ["exercise.html"] |> k | _ -> Static ("static"::path) |> k) + + | `POST body, ["launch"], _token -> + Launch body |> k + + | `POST body, ["launch"; "login"], _token -> + Launch_login body |> k + | `GET, ("description"::_path), _token -> (* match token with | None -> Invalid_request "Missing token" |> k *) diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index b51db4eb2..9bdf72039 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -42,6 +42,10 @@ type _ request = 'a token * Save.t -> Save.t request | Git: 'a token * string list -> string request + | Launch: + string -> string request + | Launch_login: + string -> string request | Students_list: teacher token -> Student.t list request diff --git a/static/lti.html b/static/lti.html index 5d5c08baa..f00410f47 100644 --- a/static/lti.html +++ b/static/lti.html @@ -31,7 +31,7 @@

-
+

@@ -40,9 +40,11 @@

+
From b4a144a8d8f3701be06c7cbe705055d6a20a59ef Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Mon, 6 Jul 2020 16:52:14 +0200 Subject: [PATCH 020/161] learnocaml_index_main: read the token in the cookies if it is set As the front-end cannot access to POST parameters, one reliable way to pass parameters from the back-end to the front-end is by using cookies. The page /launch and /launch/login both set the cookie `token' if the token is correct, so instead of asking the user for its token once again, try to retrieve it from the cookies before asking it to the user. Signed-off-by: Alban Gruin --- src/app/learnocaml_index_main.ml | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index cf67f896c..df8423b02 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -597,12 +597,35 @@ let init_token_dialog () = Manip.SetCss.display login_overlay "none"; token +let get_cookie name = + Js.(to_array (str_array (Dom_html.document##.cookie##split (string ";")))) + |> Array.fold_left + (fun res v -> + match res with + | Some _ -> res + | None -> let cookie = Js.to_string v + |> String.trim + |> String.split_on_char '=' in + match cookie with + | n :: v when n = name -> Some (String.concat "=" v) + | _ -> None) + None + let init_sync_token button_group = catch (fun () -> begin try Lwt.return Learnocaml_local_storage.(retrieve sync_token) - with Not_found -> init_token_dialog () + with Not_found -> + match get_cookie "token" with + | None -> init_token_dialog () + | Some token -> + let token = Learnocaml_data.Token.parse token in + Server_caller.request (Learnocaml_api.Fetch_save token) >>= function + | Ok save -> + set_state_from_save_file ~token save; + Lwt.return token + | Error _ -> init_token_dialog () end >>= fun token -> enable_button_group button_group ; Lwt.return (Some token)) @@ -640,7 +663,6 @@ let set_string_translations () = (Tyxml_js.To_dom.of_input el)##.placeholder := Js.string text) placeholder_translations - let () = Lwt.async_exception_hook := begin fun e -> Firebug.console##log (Js.string From 759c60d9fe082f94594b535b6c5c8eb941a26171 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Tue, 7 Jul 2020 16:34:09 +0200 Subject: [PATCH 021/161] server: generate an HMAC to validate a first login with LTI This adds an HMAC to cryptographically check that the user_id has not been tampered with, which would allow to register a token with an LTI user that does not exist yet. The HMAC is generated this way: hmac_sha256(secret_key, csrf ^ user_id) The comparison is performed in constant-time with Eqaf. Signed-off-by: Alban Gruin --- src/server/learnocaml_server.ml | 45 +++++++++++++++++++++++---------- static/lti.html | 1 + 2 files changed, 33 insertions(+), 13 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 43ab4efa9..bb5675ecc 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -179,6 +179,14 @@ let generate_csrf_token length = Cryptokit.Random.secure_rng#random_bytes random_bytes 0 length; B64.encode (Bytes.to_string random_bytes) +let generate_hmac secret csrf user_id = + let decoder = Cryptokit.Hexa.decode () in + let secret = Cryptokit.transform_string decoder secret in + let hmac = Cryptokit.MAC.hmac_sha256 secret and + encoder = Cryptokit.Hexa.encode () in + Cryptokit.hash_string hmac (csrf ^ user_id) + |> Cryptokit.transform_string encoder + module Memory_cache = struct let (tbl: (cache_request_hash, cached_response) Hashtbl.t) = @@ -257,7 +265,9 @@ module Request_handler = struct ("token", Token.to_string token)] in lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } else - (read_static_file ["launch.html"] >|= fun s -> + (Token_index.OauthIndex.get_current_secret !sync_dir >>= fun secret -> + let hmac = generate_hmac secret csrf_token id in + read_static_file ["launch.html"] >|= fun s -> Markup.string s |> Markup.parse_html |> Markup.signals @@ -269,6 +279,8 @@ module Request_handler = struct `Start_element ((e, "input"), (("", "value"), csrf_token) :: attrs) | Some "hidden", Some "user-id" -> `Start_element ((e, "input"), (("", "value"), id) :: attrs) + | Some "hidden", Some "hmac" -> + `Start_element ((e, "input"), (("", "value"), hmac) :: attrs) | _ -> `Start_element ((e, "input"), attrs)) | t -> t) |> Markup.pretty_print @@ -284,22 +296,29 @@ module Request_handler = struct ~path:"/" ~http_only:true ("csrf", "expired")] in let token = Token.parse (List.assoc "token" params) and - user_id = List.assoc "user-id" params in - Token_index.MoodleIndex.user_exists !sync_dir user_id >>= fun exists -> - if exists then - (* This can only happen if the user launched twice at the + user_id = List.assoc "user-id" params and + csrf = List.assoc "csrf" params and + hmac = List.assoc "hmac" params in + Token_index.OauthIndex.get_current_secret !sync_dir >>= fun secret -> + let new_hmac = generate_hmac secret csrf user_id in + if not (Eqaf.equal hmac new_hmac) then + lwt_fail (`Forbidden, "bad hmac") + else + Token_index.MoodleIndex.user_exists !sync_dir user_id >>= fun exists -> + if exists then + (* This can only happen if the user launched twice at the same time and completed the form twice, but as the CSRF in the cookies has changed twice (once for the second form, once for the invalidation), this should not happen at all. *) - lwt_fail (`Forbidden, "user exists") - else - Token_index.MoodleIndex.add_user !sync_dir user_id token >>= fun () -> - let cookies = (Cohttp.Cookie.Set_cookie_hdr.make - ~expiration:(`Max_age (Int64.of_int 60)) - ~path:"/" - ("token", Token.to_string token)) :: cookies in - lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } + lwt_fail (`Forbidden, "user exists") + else + Token_index.MoodleIndex.add_user !sync_dir user_id token >>= fun () -> + let cookies = (Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 60)) + ~path:"/" + ("token", Token.to_string token)) :: cookies in + lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | Api.Static path -> respond_static cache path | Api.Nonce () -> diff --git a/static/lti.html b/static/lti.html index f00410f47..4070cc130 100644 --- a/static/lti.html +++ b/static/lti.html @@ -45,6 +45,7 @@

+
From 6b9fef3cef1341a0ae59d8425417d098d888c5bd Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Tue, 7 Jul 2020 16:38:23 +0200 Subject: [PATCH 022/161] launch.html: does not request credentials if a user is already authenticated Signed-off-by: Alban Gruin --- src/app/learnocaml_lti_main.ml | 48 +++++++++++++++++++++++++++------- 1 file changed, 38 insertions(+), 10 deletions(-) diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index f63c7ceb7..6c80d8d1c 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -16,6 +16,10 @@ let login_returning_id, login_returning = id "login-returning" let button_yes_id, button_yes = id "first-connection-yes" let button_no_id, button_no = id "first-connection-no" +let login_csrf_input_id, login_csrf_input = id "login-csrf-input" +let login_id_input_id, login_id_input = id "login-id-input" +let login_hmac_input_id, login_hmac_input = id "login-hmac-input" + let set_string_translations = List.iter (fun (id, text) -> @@ -32,15 +36,39 @@ let init_dialogs () = Dom_html.window##.location##assign (Js.string "/"); true) +let try_stored_token () = + try + let token = Learnocaml_local_storage.(retrieve sync_token) in + let parameters = + [("token", [Learnocaml_data.Token.to_string token]); + ("csrf", [Js.to_string (Tyxml_js.To_dom.of_input login_csrf_input)##.value]); + ("user-id", [Js.to_string (Tyxml_js.To_dom.of_input login_id_input)##.value]); + ("hmac", [Js.to_string (Tyxml_js.To_dom.of_input login_hmac_input)##.value])] + |> Uri.encoded_of_query |> Js.string |> Js.some in + let request = Js_of_ocaml.XmlHttpRequest.create () in + request##(_open (Js.string "POST") (Js.string "/launch/login") (Js._false)); + request##(setRequestHeader (Js.string "Content-type") + (Js.string "application/x-www-form-urlencoded")); + request##(send parameters); + if request##.status = 200 then + Ok () + else + Error () + with Not_found -> + Error () + let () = (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); - init_dialogs (); - set_string_translations [ - "txt_first_connection_dialog", [%i"First connection"]; - "txt_first_connection_question", [%i"Do you have a Learn OCaml account?"]; - "txt_button_yes", [%i"Yes"]; - "txt_button_no", [%i"No"]; - "txt_returning_token", [%i"Enter your token"]; - "txt_returning_token_label", [%i"Token"]; - "txt_button_connect", [%i"Connect"] - ] + match try_stored_token () with + | Ok () -> Dom_html.window##.location##assign (Js.string "/") + | Error () -> + init_dialogs (); + set_string_translations [ + "txt_first_connection_dialog", [%i"First connection"]; + "txt_first_connection_question", [%i"Do you have a Learn OCaml account?"]; + "txt_button_yes", [%i"Yes"]; + "txt_button_no", [%i"No"]; + "txt_returning_token", [%i"Enter your token"]; + "txt_returning_token_label", [%i"Token"]; + "txt_button_connect", [%i"Connect"] + ] From f7c25eab9043217fdef402ae4ab7e8c37dfc88e6 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Wed, 8 Jul 2020 14:46:42 +0200 Subject: [PATCH 023/161] launch: add a way to create a new user during an LTI launch Signed-off-by: Alban Gruin --- src/app/learnocaml_lti_main.ml | 108 +++++++++++++++++++++++++++------ static/css/learnocaml_main.css | 8 +-- static/lti.html | 26 ++++++-- 3 files changed, 114 insertions(+), 28 deletions(-) diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 6c80d8d1c..b0bd42650 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -6,16 +6,25 @@ * included LICENSE file for details. *) open Js_utils +open Lwt +open Learnocaml_data open Learnocaml_common +module H = Tyxml_js.Html5 + let id s = s, find_component s let login_overlay_id, login_overlay = id "login-overlay" +let login_question_id, login_question = id "login-question" let login_new_id, login_new = id "login-new" let login_returning_id, login_returning = id "login-returning" let button_yes_id, button_yes = id "first-connection-yes" let button_no_id, button_no = id "first-connection-no" +let login_nickname_input_id, login_nickname_input = id "login-nickname-input" +let login_secret_input_id, login_secret_input = id "login-secret-input" +let login_new_button_id, login_new_button = id "login-new-button" + let login_csrf_input_id, login_csrf_input = id "login-csrf-input" let login_id_input_id, login_id_input = id "login-id-input" let login_hmac_input_id, login_hmac_input = id "login-hmac-input" @@ -25,35 +34,90 @@ let set_string_translations = (fun (id, text) -> Manip.setInnerHtml (find_component id) text) +let send_sync_request token = + let parameters = + [("token", [Token.to_string token]); + ("csrf", [Manip.value login_csrf_input]); + ("user-id", [Manip.value login_id_input]); + ("hmac", [Manip.value login_hmac_input])] + |> Uri.encoded_of_query |> Js.string |> Js.some in + let request = Js_of_ocaml.XmlHttpRequest.create () in + request##(_open (Js.string "POST") (Js.string "/launch/login") (Js._false)); + request##(setRequestHeader (Js.string "Content-type") + (Js.string "application/x-www-form-urlencoded")); + request##(send parameters); + if request##.status = 200 then + Ok () + else + Error () + +let token_disp_div token = + H.input ~a: [ + H.a_input_type `Text; + H.a_size 17; + H.a_style "font-size: 110%; font-weight: bold;"; + H.a_class ["learnocaml_token"]; + H.a_readonly (); + H.a_value (Token.to_string token); + ] () + +let show_token_dialog token = + let close_button = H.button ~a: [ + H.a_onclick (fun _ -> + send_sync_request token; + Dom_html.window##.location##assign (Js.string "/"); + false + ) + ] [ H.pcdata [%i"OK"] ] in + let buttons = Some([close_button]) in + ext_alert ~title:[%i"Your Learn-OCaml token"] ?buttons [ + H.p [H.pcdata [%i"Your token is displayed below. It identifies you and \ + allows to share your workspace between devices."]]; + H.p [H.pcdata [%i"Please write it down."]]; + H.div ~a:[H.a_style "text-align: center;"] [token_disp_div token]; + ] + +let create_token () = + let nickname = String.trim (Manip.value login_nickname_input) in + if Token.check nickname || String.length nickname < 2 then + (Manip.SetCss.borderColor login_nickname_input "#f44"; + Lwt.return_none) + else + let secret = Sha.sha512 (String.trim (Manip.value login_secret_input)) in + retrieve (Learnocaml_api.Nonce ()) + >>= fun nonce -> + let secret = Sha.sha512 (nonce ^ secret) in + (Learnocaml_local_storage.(store nickname) nickname; + retrieve + (Learnocaml_api.Create_token (secret, None, Some nickname)) + >>= fun token -> + Learnocaml_local_storage.(store sync_token) token; + show_token_dialog token; + Lwt.return_some (token, nickname)) + let init_dialogs () = + hide login_new; hide login_returning; Manip.SetCss.display login_overlay "block"; Manip.Ev.onclick button_yes (fun _ -> - hide login_new; + hide login_question; Manip.SetCss.display login_returning "block"; true); Manip.Ev.onclick button_no (fun _ -> - Dom_html.window##.location##assign (Js.string "/"); + hide login_question; + Manip.SetCss.display login_new "block"; + true); + Manip.Ev.onclick login_new_button (fun _ -> + Lwt.async (fun _ -> + create_token () >>= function + | Some (token, _nickname) -> + Lwt.return (show_token_dialog token) + | None -> Lwt.return_unit); true) let try_stored_token () = try - let token = Learnocaml_local_storage.(retrieve sync_token) in - let parameters = - [("token", [Learnocaml_data.Token.to_string token]); - ("csrf", [Js.to_string (Tyxml_js.To_dom.of_input login_csrf_input)##.value]); - ("user-id", [Js.to_string (Tyxml_js.To_dom.of_input login_id_input)##.value]); - ("hmac", [Js.to_string (Tyxml_js.To_dom.of_input login_hmac_input)##.value])] - |> Uri.encoded_of_query |> Js.string |> Js.some in - let request = Js_of_ocaml.XmlHttpRequest.create () in - request##(_open (Js.string "POST") (Js.string "/launch/login") (Js._false)); - request##(setRequestHeader (Js.string "Content-type") - (Js.string "application/x-www-form-urlencoded")); - request##(send parameters); - if request##.status = 200 then - Ok () - else - Error () + send_sync_request Learnocaml_local_storage.(retrieve sync_token) with Not_found -> Error () @@ -64,10 +128,14 @@ let () = | Error () -> init_dialogs (); set_string_translations [ - "txt_first_connection_dialog", [%i"First connection"]; - "txt_first_connection_question", [%i"Do you have a Learn OCaml account?"]; + "txt_dialog", [%i"First connection"]; + "txt_question", [%i"Do you have a Learn OCaml account?"]; "txt_button_yes", [%i"Yes"]; "txt_button_no", [%i"No"]; + "txt_first_connection", [%i"First connection"]; + "txt_first_connection_dialog", [%i"Choose a nickname"]; + "txt_first_connection_secret", [%i"Enter the secret"]; + "txt_login_new", [%i"Create new token"]; "txt_returning_token", [%i"Enter your token"]; "txt_returning_token_label", [%i"Token"]; "txt_button_connect", [%i"Connect"] diff --git a/static/css/learnocaml_main.css b/static/css/learnocaml_main.css index 54cf03a26..1c55ab0c3 100644 --- a/static/css/learnocaml_main.css +++ b/static/css/learnocaml_main.css @@ -921,7 +921,7 @@ div#login-overlay > h1 { text-align: center; margin-bottom: 50px; } -#login-new, #login-returning { +#login-question, #login-new, #login-returning { margin: 30px auto; background-color: #666; border-radius: 3px; @@ -931,7 +931,7 @@ div#login-overlay > h1 { flex-direction: column; } @media (min-width: 1000px) { - #login-new, #login-returning { + #login-question, #login-new, #login-returning { width: 30vw; } } @@ -946,12 +946,12 @@ div#login-overlay > h1 { color: black; border-radius: 3px 3px 0 0; } -#login-new > div, #login-returning > div { +#login-question > div, #login-new > div, #login-returning > div { padding: 20px; display: flex; flex-direction: row; } -#login-new > div > div, #login-returning > div > div { +#login-question > div > div, #login-new > div > div, #login-returning > div > div { line-height: 30px; } div#login-overlay input { diff --git a/static/lti.html b/static/lti.html index 4070cc130..c2b39c081 100644 --- a/static/lti.html +++ b/static/lti.html @@ -9,7 +9,7 @@ + + +
+ +
+

+
+
+
+ +
+ + +
+ +
+
+ +
+ + From 4f65b5fe5856c2c08daa2ede73184a335743f991 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Wed, 29 Jul 2020 23:14:18 +0200 Subject: [PATCH 049/161] server: add an enpoint to initiate a password change from a token Signed-off-by: Alban Gruin --- src/server/learnocaml_server.ml | 74 ++++++++++++++++++++------------- src/state/learnocaml_api.ml | 18 ++++++++ src/state/learnocaml_api.mli | 5 +++ src/state/token_index.ml | 7 ++++ src/state/token_index.mli | 1 + 5 files changed, 76 insertions(+), 29 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index db9c82eb8..088a3e880 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -218,6 +218,13 @@ let create_student conn (config: Learnocaml_data.Server.config) cache Token_index.UserIndex.add !sync_dir auth >>= fun () -> respond_json cache tok +let initiate_password_change token address cache = + Token_index.UpgradeIndex.reset_password !sync_dir token >>= fun handle -> + Learnocaml_sendmail.reset_password + ~url:("http://localhost:8080/reset_password/" ^ handle) + address; + respond_json cache () + module Memory_cache = struct let (tbl: (cache_request_hash, cached_response) Hashtbl.t) = @@ -296,27 +303,28 @@ module Request_handler = struct ("token", Token.to_string token)] in lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } else - (Token_index.OauthIndex.get_current_secret !sync_dir >>= fun secret -> - let hmac = generate_hmac secret csrf_token id in - read_static_file ["lti.html"] >|= fun s -> - Markup.string s - |> Markup.parse_html - |> Markup.signals - |> Markup.map (function - | `Start_element ((e, "input"), attrs) -> - (match List.assoc_opt ("", "type") attrs, - List.assoc_opt ("", "name") attrs with - | Some "hidden", Some "csrf" -> - `Start_element ((e, "input"), (("", "value"), csrf_token) :: attrs) - | Some "hidden", Some "user-id" -> - `Start_element ((e, "input"), (("", "value"), id) :: attrs) - | Some "hidden", Some "hmac" -> - `Start_element ((e, "input"), (("", "value"), hmac) :: attrs) - | _ -> `Start_element ((e, "input"), attrs)) - | t -> t) - |> Markup.pretty_print - |> Markup.write_html - |> Markup.to_string) >>= fun contents -> + Token_index.OauthIndex.get_current_secret !sync_dir >>= fun secret -> + let hmac = generate_hmac secret csrf_token id in + read_static_file ["lti.html"] >>= fun s -> + let contents = + Markup.string s + |> Markup.parse_html + |> Markup.signals + |> Markup.map (function + | `Start_element ((e, "input"), attrs) as elt -> + (match List.assoc_opt ("", "type") attrs, + List.assoc_opt ("", "name") attrs with + | Some "hidden", Some "csrf" -> + `Start_element ((e, "input"), (("", "value"), csrf_token) :: attrs) + | Some "hidden", Some "user-id" -> + `Start_element ((e, "input"), (("", "value"), id) :: attrs) + | Some "hidden", Some "hmac" -> + `Start_element ((e, "input"), (("", "value"), hmac) :: attrs) + | _ -> elt) + | t -> t) + |> Markup.pretty_print + |> Markup.write_html + |> Markup.to_string in lwt_ok @@ Response { contents; content_type="text/html"; caching=Nocache; cookies } | Error e -> lwt_fail (`Forbidden, e)) | Api.Launch_login body when config.ServerData.use_moodle -> @@ -375,7 +383,7 @@ module Request_handler = struct MoodleIndex.add_user !sync_dir user_id token >>= fun () -> UserIndex.add !sync_dir auth) >>= fun () -> let cookies = [make_cookie ("token", Token.to_string token); - make_cookie ("csrf", "expired")] in + make_cookie ~http_only:true ("csrf", "expired")] in lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | Api.Launch _ -> lwt_fail (`Forbidden, "LTI is disabled on this instance.") @@ -673,13 +681,13 @@ module Request_handler = struct Token_index.UserIndex.token_of_email !sync_dir address >>= (function | Some token -> - Token_index.UpgradeIndex.reset_password !sync_dir token >>= fun handle -> - begin - Learnocaml_sendmail.reset_password - ~url:("http://localhost:8080/reset_password/" ^ handle) - address; - respond_json cache () - end + initiate_password_change token address cache + | None -> lwt_fail (`Not_found, "Unknown user.")) + | Api.Change_password token when config.ServerData.use_passwd -> + Token_index.UserIndex.email_of_token !sync_dir token >>= + (function + | Some address -> + initiate_password_change token address cache | None -> lwt_fail (`Not_found, "Unknown user.")) | Api.Reset_password handle when config.ServerData.use_passwd -> Token_index.UpgradeIndex.can_reset_password !sync_dir handle >>= @@ -735,11 +743,19 @@ module Request_handler = struct lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Send_reset_password _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Change_password _ -> + lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Reset_password _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Do_reset_password _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Is_account token when config.ServerData.use_passwd -> + Token_index.UserIndex.email_of_token !sync_dir token >>= fun email -> + respond_json cache (email <> None) + | Api.Is_account _ -> + lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Invalid_request body -> lwt_fail (`Bad_request, body) diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 47496ff65..479de8eb6 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -82,11 +82,16 @@ type _ request = string -> string request | Send_reset_password: string -> unit request + | Change_password: + Token.t -> unit request | Reset_password: string -> string request | Do_reset_password: string -> string request + | Is_account: + Token.t -> bool request + | Invalid_request: string -> string request @@ -178,9 +183,12 @@ module Conversions (Json: JSON_CODEC) = struct | Confirm_email _ -> str | Send_reset_password _ -> json J.unit + | Change_password _ -> json J.unit | Reset_password _ -> str | Do_reset_password _ -> str + | Is_account _ -> json J.bool + | Invalid_request _ -> str @@ -304,11 +312,16 @@ module Conversions (Json: JSON_CODEC) = struct assert false (* Reserved for a link *) | Send_reset_password address -> post ["send_reset"] (Json.encode J.(tup1 string) address) + | Change_password token -> + get ~token ["send_reset"] | Reset_password _ -> assert false (* Reserved for a link *) | Do_reset_password _ -> assert false (* Reserved for a link *) + | Is_account token -> + get ~token ["is_account"] + | Invalid_request s -> failwith ("Error request "^s) @@ -467,11 +480,16 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct (match Json.decode J.(tup1 string) body with | address -> Send_reset_password address |> k | exception e -> Invalid_request (Printexc.to_string e) |> k) + | `GET, ["send_reset"], Some token -> + Change_password token |> k | `GET, ["reset_password"; handle], _ -> Reset_password handle |> k | `POST body, ["reset_password"], _ -> Do_reset_password body |> k + | `GET, ["is_account"], Some token -> + Is_account token |> k + | `GET, ["teacher"; "exercise-status.json"], Some token when Token.is_teacher token -> Exercise_status_index token |> k diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 6d4daaf38..439732f55 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -101,11 +101,16 @@ type _ request = string -> string request | Send_reset_password: string -> unit request + | Change_password: + Token.t -> unit request | Reset_password: string -> string request | Do_reset_password: string -> string request + | Is_account: + Token.t -> bool request + | Invalid_request: string -> string request (** Only for server-side handling: bound to requests not matching any case diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 9512f1a99..8c4f3b53b 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -386,6 +386,13 @@ module BaseUserIndex (RW: IndexRW) = struct match res, elt with | None, Password (token, found_email, _, _) when found_email = email -> Some token | _ -> res) None + + let email_of_token sync_dir token = + RW.read (sync_dir / indexes_subdir / file) parse >|= + List.fold_left (fun res elt -> + match res, elt with + | None, Password (found_token, email, _, _) when found_token = token -> Some email + | _ -> res) None end module UserIndex = BaseUserIndex (IndexFile) diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 4f7346cc4..3e5f8e1c2 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -74,6 +74,7 @@ module UserIndex: sig val confirm_email : string -> Learnocaml_data.Token.t -> unit Lwt.t val can_login : string -> Learnocaml_data.Token.t -> bool Lwt.t val token_of_email : string -> string -> Learnocaml_data.Token.t option Lwt.t + val email_of_token : string -> Learnocaml_data.Token.t -> string option Lwt.t end module UpgradeIndex: sig From 4ea449eede4e155ee7d009e990b5bf2114604c4a Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 30 Jul 2020 11:27:34 +0200 Subject: [PATCH 050/161] server: add an endpoint to initiate an email address change --- src/server/learnocaml_server.ml | 17 +++++++++++++++++ src/state/learnocaml_api.ml | 9 +++++++++ src/state/learnocaml_api.mli | 2 ++ src/state/token_index.ml | 8 ++++++++ src/state/token_index.mli | 1 + 5 files changed, 37 insertions(+) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 088a3e880..35160cc3f 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -668,6 +668,21 @@ module Request_handler = struct ) (fun exn -> (`Not_found, Printexc.to_string exn)) + | Api.Change_email (token, address) when config.ServerData.use_passwd -> + Token_index.UserIndex.email_of_token !sync_dir token >>= + (function + | Some old_address -> + Token_index.UserIndex.exists !sync_dir address >>= fun exists -> + if exists then + lwt_fail (`Forbidden, "Address already in use.") + else + Token_index.UserIndex.change_email !sync_dir token address >>= fun () -> + Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> + Learnocaml_sendmail.change_email + ~url:("http://localhost:8080/confirm/" ^ handle) + old_address address; + respond_json cache () + | None -> lwt_fail (`Not_found, "Unknown user.")) | Api.Confirm_email handle when config.ServerData.use_passwd -> Token_index.UpgradeIndex.can_change_email !sync_dir handle >>= (function @@ -739,6 +754,8 @@ module Request_handler = struct | None -> lwt_fail (`Forbidden, "Nothing to do.")) + | Api.Change_email _ -> + lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Confirm_email _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Send_reset_password _ -> diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 479de8eb6..d28f56927 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -78,6 +78,8 @@ type _ request = | Partition: teacher token * Exercise.id * string * int -> Partition.t request + | Change_email: + (Token.t * string) -> unit request | Confirm_email: string -> string request | Send_reset_password: @@ -181,6 +183,7 @@ module Conversions (Json: JSON_CODEC) = struct | Partition _ -> json Partition.enc + | Change_email _ -> json J.unit | Confirm_email _ -> str | Send_reset_password _ -> json J.unit | Change_password _ -> json J.unit @@ -308,6 +311,8 @@ module Conversions (Json: JSON_CODEC) = struct get ~token ["partition"; eid; fid; string_of_int prof] + | Change_email (token, address) -> + post ~token ["change_email"] (Json.encode J.(tup1 string) address) | Confirm_email _ -> assert false (* Reserved for a link *) | Send_reset_password address -> @@ -474,6 +479,10 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct when Token.is_teacher token -> Partition (token, eid, fid, int_of_string prof) |> k + | `POST body, ["change_email"], Some token -> + (match Json.decode J.(tup1 string) body with + | address -> Change_email (token, address) |> k + | exception e -> Invalid_request (Printexc.to_string e) |> k) | `GET, ["confirm"; handle], _ -> Confirm_email handle |> k | `POST body, ["send_reset"], _ -> diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 439732f55..c4cb51376 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -97,6 +97,8 @@ type _ request = | Partition: teacher token * Exercise.id * string * int -> Partition.t request + | Change_email: + (Token.t * string) -> unit request | Confirm_email: string -> string request | Send_reset_password: diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 8c4f3b53b..dfc8a513a 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -393,6 +393,14 @@ module BaseUserIndex (RW: IndexRW) = struct match res, elt with | None, Password (found_token, email, _, _) when found_token = token -> Some email | _ -> res) None + + let change_email sync_dir token email = + RW.read (sync_dir / indexes_subdir / file) parse >|= + List.map (function + | Password (found_token, name, passwd, _) when found_token = token -> + Password (found_token, name, passwd, Some email) + | elt -> elt) >>= + RW.write rw (sync_dir / indexes_subdir / file) serialise end module UserIndex = BaseUserIndex (IndexFile) diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 3e5f8e1c2..c7a53ee7e 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -75,6 +75,7 @@ module UserIndex: sig val can_login : string -> Learnocaml_data.Token.t -> bool Lwt.t val token_of_email : string -> string -> Learnocaml_data.Token.t option Lwt.t val email_of_token : string -> Learnocaml_data.Token.t -> string option Lwt.t + val change_email : string -> Learnocaml_data.Token.t -> string -> unit Lwt.t end module UpgradeIndex: sig From 341f3b692f7da4b95f9d9032008cf37acd265cf5 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 30 Jul 2020 11:33:11 +0200 Subject: [PATCH 051/161] learnocaml_index_main: add buttons and forms to change email and password Signed-off-by: Alban Gruin --- src/app/learnocaml_index_main.ml | 79 ++++++++++++++++++++++++-------- static/index.html | 3 ++ 2 files changed, 63 insertions(+), 19 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index bfc554170..b40d60ceb 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -35,6 +35,9 @@ module El = struct let tab_buttons_container_id, tab_buttons_container = id "learnocaml-tab-buttons-container" + let op_buttons_container_id, op_buttons_container = + id "learnocaml-op-buttons-container" + let sync_buttons_id, sync_buttons = id "learnocaml-sync-buttons" let show_panel_id, show_panel = id "learnocaml-show-panel" @@ -572,6 +575,24 @@ let show_token_dialog token = H.div ~a:[H.a_style "text-align: center;"] [token_disp_div token]; ] +let complete_reset_password cb = function + | Ok () -> + alert ~title:[%i"RESET REQUEST SENT"] + [%i"A reset link has been sent to the specified address."]; + Lwt.return_none + | Error (`Not_found _) -> + alert ~title:[%i"USER NOT FOUND"] + [%i"The entered email couldn't be recognised."]; + Lwt.return_none + | Error e -> + lwt_alert ~title:[%i"REQUEST ERROR"] [ + H.p [H.pcdata [%i"Could not retrieve data from server"]]; + H.code [H.pcdata (Server_caller.string_of_error e)]; + ] ~buttons:[ + [%i"Retry"], (fun () -> cb ()); + [%i"Cancel"], (fun () -> Lwt.return_none); + ] + let init_token_dialog () = let open El.Login_overlay in Manip.SetCss.display login_overlay "block"; @@ -701,23 +722,8 @@ let init_token_dialog () = let rec reset_password () = if get_opt config##.enablePasswd then let email = Manip.value login_input_email in - Server_caller.request (Learnocaml_api.Send_reset_password email) >>= function - | Ok () -> - alert ~title:[%i"RESET REQUEST SENT"] - [%i"A reset link has been sent to the specified address."]; - Lwt.return_none - | Error (`Not_found _) -> - alert ~title:[%i"USER NOT FOUND"] - [%i"The entered email couldn't be recognised."]; - Lwt.return_none - | Error e -> - lwt_alert ~title:[%i"REQUEST ERROR"] [ - H.p [H.pcdata [%i"Could not retrieve data from server"]]; - H.code [H.pcdata (Server_caller.string_of_error e)]; - ] ~buttons:[ - [%i"Retry"], (fun () -> reset_password ()); - [%i"Cancel"], (fun () -> Lwt.return_none); - ] + Server_caller.request (Learnocaml_api.Send_reset_password email) + >>= complete_reset_password reset_password else Lwt.return_none in @@ -856,6 +862,33 @@ let () = Manip.appendChild El.content div ; delete_arg "activity" in + let init_op kind = + let buttons = + (match kind with + | `Logged -> + let rec change_password () = + Server_caller.request (Learnocaml_api.Change_password + Learnocaml_local_storage.(retrieve sync_token)) + >>= complete_reset_password change_password in + let rec change_email () = + ask_string ~title:[%i"New email address"] + [H.txt [%i"Enter your new email address: "]] >>= fun address -> + Server_caller.request + (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), + address)) + >>= complete_reset_password change_email in + [[%i"Change password"], change_password; + [%i"Change email"], change_email] + | `With_token -> + let upgrade_account () = Lwt.return_none in + [[%i"Upgrade account"], upgrade_account]) in + let container = El.op_buttons_container in + Manip.removeChildren container; + List.iter (fun (name, callback) -> + let btn = Tyxml_js.Html5.(button [txt name]) in + Manip.Ev.onclick btn (fun _ -> Lwt.async callback; true); + Manip.appendChild container btn) buttons + in let init_tabs token = let tabs = (if get_opt config##.enableTryocaml @@ -1053,8 +1086,16 @@ let () = | Ok _ -> init_sync_token sync_button_group >|= init_tabs >>= fun tabs -> can_show_token () >>= fun show_token -> - if not show_token then - disable_button show_token_button_state; + (if not show_token then + Server_caller.request (Learnocaml_api.Is_account (get_stored_token ())) >|= + (function + | Ok true -> init_op `Logged + | _ -> init_op `With_token) >|= fun () -> + disable_button show_token_button_state + else if get_opt config##.enablePasswd then + Lwt.return @@ init_op `With_token + else + Lwt.return_unit) >>= fun () -> Lwt.return tabs | Error _ -> Lwt.return (init_tabs None)) >>= fun tabs -> try diff --git a/static/index.html b/static/index.html index b23b063fc..dad33ac16 100644 --- a/static/index.html +++ b/static/index.html @@ -42,6 +42,9 @@

Activities

--> + +
+
From a6de9798e952a1fc955d96b3612fbf95c394a021 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 30 Jul 2020 15:40:25 +0200 Subject: [PATCH 052/161] fix: Add gmp (alpine dependency) for cryptokit --- Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Dockerfile b/Dockerfile index f20548640..14849b93e 100644 --- a/Dockerfile +++ b/Dockerfile @@ -77,7 +77,7 @@ LABEL org.label-schema.build-date="${BUILD_DATE}" \ org.label-schema.schema-version="1.0" RUN apk update \ - && apk add ncurses-libs libev dumb-init git \ + && apk add ncurses-libs libev gmp dumb-init git \ && addgroup learn-ocaml \ && adduser learn-ocaml -DG learn-ocaml From 27bd23d4c84014e337c9537c087804186588fbaa Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 30 Jul 2020 16:51:34 +0200 Subject: [PATCH 053/161] feature: add a form to upgrade a token to an account Signed-off-by: Alban Gruin --- src/app/dune | 18 +++++++++- src/app/learnocaml_index_main.ml | 51 +++++++++++++------------- src/app/learnocaml_upgrade_main.ml | 28 +++++++++++++++ src/server/learnocaml_server.ml | 58 ++++++++++++++++++++++++++++++ src/state/learnocaml_api.ml | 18 ++++++++++ src/state/learnocaml_api.mli | 5 +++ static/css/learnocaml_main.css | 17 +++++---- static/index.html | 6 ++++ static/upgrade.html | 43 ++++++++++++++++++++++ 9 files changed, 212 insertions(+), 32 deletions(-) create mode 100644 src/app/learnocaml_upgrade_main.ml create mode 100644 static/upgrade.html diff --git a/src/app/dune b/src/app/dune index 7bc20383c..d65189978 100644 --- a/src/app/dune +++ b/src/app/dune @@ -177,6 +177,21 @@ (javascript_files ../ace-lib/ace_bindings.js)) ) +(executable + (name learnocaml_upgrade_main) + (modes byte) + (flags :standard -warn-error -6-9-27-33-39) + (libraries ace + learnocaml_app_common + js_of_ocaml.ppx + ocplib_i18n) + (modules Learnocaml_upgrade_main) + (preprocess (pps ppx_ocplib_i18n js_of_ocaml.ppx)) + (js_of_ocaml + (flags :standard +cstruct/cstruct.js) + (javascript_files ../ace-lib/ace_bindings.js)) +) + (install (package learn-ocaml) (section share) @@ -187,6 +202,7 @@ (learnocaml_partition_view.bc.js as www/js/learnocaml-partition-view.js) (learnocaml_playground_main.bc.js as www/js/learnocaml-playground.js) (learnocaml_lti_main.bc.js as www/js/learnocaml-lti.js) - (learnocaml_reset_main.bc.js as www/js/learnocaml-reset.js)) + (learnocaml_reset_main.bc.js as www/js/learnocaml-reset.js) + (learnocaml_upgrade_main.bc.js as www/js/learnocaml-upgrade.js)) ) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index b40d60ceb..e19e807a0 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -768,7 +768,9 @@ let delete_cookie name = let init_sync_token button_group = catch (fun () -> - begin try + begin try + if get_cookie "token" <> None then + Learnocaml_local_storage.(store can_show_token) false; Lwt.return Learnocaml_local_storage.(retrieve sync_token) with Not_found -> match get_cookie "token" with @@ -816,6 +818,7 @@ let set_string_translations () = "txt_returning_with_token", [%i"Login with a token"]; "txt_returning_token", [%i"Token"]; "txt_token_returning", [%i"Connect"]; + "txt_upgrade", [%i"Upgrade account"]; ] in List.iter (fun (id, text) -> @@ -862,26 +865,26 @@ let () = Manip.appendChild El.content div ; delete_arg "activity" in - let init_op kind = - let buttons = - (match kind with - | `Logged -> - let rec change_password () = - Server_caller.request (Learnocaml_api.Change_password - Learnocaml_local_storage.(retrieve sync_token)) - >>= complete_reset_password change_password in - let rec change_email () = - ask_string ~title:[%i"New email address"] - [H.txt [%i"Enter your new email address: "]] >>= fun address -> - Server_caller.request - (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), - address)) - >>= complete_reset_password change_email in - [[%i"Change password"], change_password; - [%i"Change email"], change_email] - | `With_token -> - let upgrade_account () = Lwt.return_none in - [[%i"Upgrade account"], upgrade_account]) in + let show_upgrade_button () = + let token = Learnocaml_local_storage.(retrieve sync_token) and + input = Js.Unsafe.coerce @@ H.toelt (find_component "upgrade-token") in + input##.value := Js.string @@ Token.to_string token; + Manip.SetCss.display (find_component "learnocaml-upgrade-container") "block" + in + let init_op () = + let rec change_password () = + Server_caller.request (Learnocaml_api.Change_password + Learnocaml_local_storage.(retrieve sync_token)) + >>= complete_reset_password change_password in + let rec change_email () = + ask_string ~title:[%i"New email address"] + [H.txt [%i"Enter your new email address: "]] >>= fun address -> + Server_caller.request + (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), + address)) + >>= complete_reset_password change_email in + let buttons = [[%i"Change password"], change_password; + [%i"Change email"], change_email] in let container = El.op_buttons_container in Manip.removeChildren container; List.iter (fun (name, callback) -> @@ -1089,11 +1092,11 @@ let () = (if not show_token then Server_caller.request (Learnocaml_api.Is_account (get_stored_token ())) >|= (function - | Ok true -> init_op `Logged - | _ -> init_op `With_token) >|= fun () -> + | Ok true -> init_op () + | _ -> show_upgrade_button ()) >|= fun () -> disable_button show_token_button_state else if get_opt config##.enablePasswd then - Lwt.return @@ init_op `With_token + Lwt.return @@ show_upgrade_button () else Lwt.return_unit) >>= fun () -> Lwt.return tabs diff --git a/src/app/learnocaml_upgrade_main.ml b/src/app/learnocaml_upgrade_main.ml new file mode 100644 index 000000000..6c895bb43 --- /dev/null +++ b/src/app/learnocaml_upgrade_main.ml @@ -0,0 +1,28 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2020 Alban Gruin + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +open Js_utils +open Learnocaml_common + +let set_string_translations = + List.iter + (fun (id, text) -> + Manip.setInnerHtml (find_component id) text) + +let () = + (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); + try + Manip.SetCss.display (find_component "login-overlay") "block"; + set_string_translations [ + "txt_upgrade", [%i"Upgrade account"]; + "txt_upgrade_email", [%i"Email address"]; + "txt_upgrade_password", [%i"Password"]; + "txt_do_upgrade", [%i"Upgrade"]; + "txt_info", [%i"An email will be sent to your address to confirm it."]; + ] + with Not_found -> + Learnocaml_common.alert ~title:[%i"NO TOKEN"] [%i"You are not logged in"] diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 35160cc3f..1b3389078 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -773,6 +773,64 @@ module Request_handler = struct | Api.Is_account _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Upgrade_form body when config.ServerData.use_passwd -> + let params = Uri.query_of_encoded body + |> List.map (fun (a, b) -> a, String.concat "," b) in + let token = Token.parse @@ List.assoc "token" params in + Token_index.UserIndex.email_of_token !sync_dir token >>= + (function + | None -> + let csrf_token = generate_csrf_token 32 in + let cookies = [Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 3600)) + ~path:"/" ~http_only:true ("csrf", csrf_token)] in + read_static_file ["upgrade.html"] >>= fun s -> + let contents = + Markup.string s + |> Markup.parse_html + |> Markup.signals + |> Markup.map (function + | `Start_element ((e, "input"), attrs) as elt -> + (match List.assoc_opt ("", "type") attrs, + List.assoc_opt ("", "name") attrs with + | Some "hidden", Some "csrf" -> + `Start_element ((e, "input"), (("", "value"), csrf_token) :: attrs) + | Some "hidden", Some "token" -> + `Start_element ((e, "input"), (("", "value"), Token.to_string token) :: attrs) + | _ -> elt) + | t -> t) + |> Markup.pretty_print + |> Markup.write_html + |> Markup.to_string in + lwt_ok @@ Response { contents; content_type="text/html"; caching=Nocache; cookies } + | Some _ -> lwt_fail (`Forbidden, "Already an account.")) + | Api.Upgrade body when config.ServerData.use_passwd -> + let params = Uri.query_of_encoded body + |> List.map (fun (a, b) -> a, String.concat "," b) in + let token = Token.parse @@ List.assoc "token" params in + Token_index.UserIndex.email_of_token !sync_dir token >>= + (function + | None -> + let make_cookie = Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in + let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and + email = List.assoc "email" params and + passwd = List.assoc "passwd" params in + if String.(length email < 5 || length passwd < 8 || not @@ contains email '@') then + lwt_ok @@ Redirect { code=`See_other; url="/upgrade"; cookies } + else + let cookies = make_cookie ("token", Token.to_string token) :: cookies in + Token_index.UserIndex.upgrade !sync_dir token email passwd >>= fun () -> + Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> + Learnocaml_sendmail.confirm_email ~url:("http://localhost:8080/confirm/" ^ handle) email; + lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } + | Some _ -> lwt_fail (`Forbidden, "Already an account.")) + + | Api.Upgrade_form _ -> + lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Upgrade _ -> + lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Invalid_request body -> lwt_fail (`Bad_request, body) diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index d28f56927..915b08c05 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -94,6 +94,11 @@ type _ request = | Is_account: Token.t -> bool request + | Upgrade_form: + string -> string request + | Upgrade: + string -> string request + | Invalid_request: string -> string request @@ -192,6 +197,9 @@ module Conversions (Json: JSON_CODEC) = struct | Is_account _ -> json J.bool + | Upgrade_form _ -> str + | Upgrade _ -> str + | Invalid_request _ -> str @@ -327,6 +335,11 @@ module Conversions (Json: JSON_CODEC) = struct | Is_account token -> get ~token ["is_account"] + | Upgrade_form _ -> + assert false (* Reserved for a link *) + | Upgrade _ -> + assert false (* Reserved for a form *) + | Invalid_request s -> failwith ("Error request "^s) @@ -499,6 +512,11 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct | `GET, ["is_account"], Some token -> Is_account token |> k + | `POST body, ["upgrade"], _ -> + Upgrade_form body |> k + | `POST body, ["do_upgrade"], _ -> + Upgrade body |> k + | `GET, ["teacher"; "exercise-status.json"], Some token when Token.is_teacher token -> Exercise_status_index token |> k diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index c4cb51376..1a55ee043 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -113,6 +113,11 @@ type _ request = | Is_account: Token.t -> bool request + | Upgrade_form: + string -> string request + | Upgrade: + string -> string request + | Invalid_request: string -> string request (** Only for server-side handling: bound to requests not matching any case diff --git a/static/css/learnocaml_main.css b/static/css/learnocaml_main.css index 114337ad0..6214cb593 100644 --- a/static/css/learnocaml_main.css +++ b/static/css/learnocaml_main.css @@ -100,12 +100,12 @@ body { // box-shadow: 0 0 10px 0px #9bd, inset 5px 5px 10px 2px rgba(0,0,0,0.2) ; text-align: center; } -#learnocaml-main-panel > div.tabs { +#learnocaml-main-panel div.tabs { margin: 10px 0 5px 0; display: flex; flex-direction: column; } -#learnocaml-main-panel > div.tabs > button { +#learnocaml-main-panel div.tabs > button { flex: 0 0 auto; display: block; left:0; right:0; @@ -121,14 +121,14 @@ body { margin: 0; box-shadow: 0 0 10px 2px rgba(0,0,0,0.4); } -#learnocaml-main-panel > div.tabs > button + button { +#learnocaml-main-panel div.tabs > button + button { margin: 10px 0 0 0; } -#learnocaml-main-panel > div.tabs > button.active { +#learnocaml-main-panel div.tabs > button.active { background: linear-gradient(to bottom, #f29100 0%, #ec670f 100%); } -#learnocaml-main-panel > div.tabs > button::before, -#learnocaml-main-panel > div.tabs > button::after { +#learnocaml-main-panel div.tabs > button::before, +#learnocaml-main-panel div.tabs > button::after { border-radius: 5px; } #learnocaml-main-panel > .footer { @@ -291,7 +291,7 @@ body { #learnocaml-main-toolbar > button > .label { display: none; } - #learnocaml-main-panel > div.tabs > button { + #learnocaml-main-panel div.tabs > button { padding: 5px; font-size: 18px; line-height: 22px; @@ -1066,3 +1066,6 @@ div#logout-overlay button { text-align: center; font-family: 'Inconsolata'; } +#learnocaml-upgrade-container { + display: none; +} diff --git a/static/index.html b/static/index.html index dad33ac16..5167606c7 100644 --- a/static/index.html +++ b/static/index.html @@ -46,6 +46,12 @@

Activities

+
+
+ + +
+
diff --git a/static/upgrade.html b/static/upgrade.html new file mode 100644 index 000000000..9d44c068b --- /dev/null +++ b/static/upgrade.html @@ -0,0 +1,43 @@ + + + + + Learn OCaml + + + + + + + + +
+
+
+

+
+
+
+ +
+
+
+
+ +
+ + + + +
+
+
+ + From 34a2e3cdd2f7fc021fa12a6a69e8c65f98d5a402 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 30 Jul 2020 16:52:29 +0200 Subject: [PATCH 054/161] server: advertise the `use_passwd' and `use_moodle' options when starting Signed-off-by: Alban Gruin --- src/server/learnocaml_server.ml | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 1b3389078..c4ead4ca7 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -922,7 +922,13 @@ let launch () = Learnocaml_store.Server.get () >>= fun config -> if config.Learnocaml_data.Server.use_moodle && not config.Learnocaml_data.Server.use_passwd then - failwith "Cannot enable Moodle/LTI without enabling passwords."; + failwith "Cannot enable Moodle/LTI without enabling passwords." + else if not config.Learnocaml_data.Server.use_passwd then + print_endline "You may want to enable passwords and LTI with the \ + config options `use_passwd' and `use_moodle'." + else if not config.Learnocaml_data.Server.use_moodle then + print_endline "You may want to enable LTI with the config option \ + `use_moodle'."; let callback conn req body = let uri = Request.uri req in let path = Uri.path uri in From ccb6e64c0ad1c5392e178b280c62a5f91b63976c Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 30 Jul 2020 17:01:58 +0200 Subject: [PATCH 055/161] Add a clean dialog box to indicate that an address has been confirmed Signed-off-by: Alban Gruin --- src/app/dune | 18 +++++++++++++++++- src/app/learnocaml_validate_main.ml | 13 +++++++++++++ src/server/learnocaml_server.ml | 2 +- static/validate.html | 13 +++++++++++++ 4 files changed, 44 insertions(+), 2 deletions(-) create mode 100644 src/app/learnocaml_validate_main.ml create mode 100644 static/validate.html diff --git a/src/app/dune b/src/app/dune index d65189978..48d7dc033 100644 --- a/src/app/dune +++ b/src/app/dune @@ -192,6 +192,21 @@ (javascript_files ../ace-lib/ace_bindings.js)) ) +(executable + (name learnocaml_validate_main) + (modes byte) + (flags :standard -warn-error -6-9-27-33-39) + (libraries ace + learnocaml_app_common + js_of_ocaml.ppx + ocplib_i18n) + (modules Learnocaml_validate_main) + (preprocess (pps ppx_ocplib_i18n js_of_ocaml.ppx)) + (js_of_ocaml + (flags :standard +cstruct/cstruct.js) + (javascript_files ../ace-lib/ace_bindings.js)) +) + (install (package learn-ocaml) (section share) @@ -203,6 +218,7 @@ (learnocaml_playground_main.bc.js as www/js/learnocaml-playground.js) (learnocaml_lti_main.bc.js as www/js/learnocaml-lti.js) (learnocaml_reset_main.bc.js as www/js/learnocaml-reset.js) - (learnocaml_upgrade_main.bc.js as www/js/learnocaml-upgrade.js)) + (learnocaml_upgrade_main.bc.js as www/js/learnocaml-upgrade.js) + (learnocaml_validate_main.bc.js as www/js/learnocaml-validate.js)) ) diff --git a/src/app/learnocaml_validate_main.ml b/src/app/learnocaml_validate_main.ml new file mode 100644 index 000000000..e043aaec6 --- /dev/null +++ b/src/app/learnocaml_validate_main.ml @@ -0,0 +1,13 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2020 Alban Gruin + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + +open Js_utils +open Learnocaml_common + +let () = + (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); + alert ~title:[%i"EMAIL CONFIRMED"] [%i"Your email address has been confirmed"] diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index c4ead4ca7..576b13a93 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -689,7 +689,7 @@ module Request_handler = struct | Some token -> Token_index.UserIndex.confirm_email !sync_dir token >>= fun () -> Token_index.UpgradeIndex.revoke_operation !sync_dir handle >>= fun () -> - respond_json cache "Ok." + respond_static cache ["validate.html"] | None -> lwt_fail (`Forbidden, "Nothing to do.")) | Api.Send_reset_password address when config.ServerData.use_passwd -> diff --git a/static/validate.html b/static/validate.html new file mode 100644 index 000000000..54d969c19 --- /dev/null +++ b/static/validate.html @@ -0,0 +1,13 @@ + + + + + Learn OCaml + + + + + + + + From cee8896df8374761056ce15ec824ba3f6764d367 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 31 Jul 2020 11:15:39 +0200 Subject: [PATCH 056/161] feature: validate consent checkboxes Signed-off-by: Alban Gruin --- src/app/learnocaml_index_main.ml | 10 ++++++++-- src/app/learnocaml_lti_main.ml | 10 ++++++++-- src/utils/js_utils.ml | 12 ++++++++++++ src/utils/js_utils.mli | 1 + 4 files changed, 29 insertions(+), 4 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index e19e807a0..dabb4a297 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -57,6 +57,7 @@ module El = struct let reg_input_nick_id, reg_input_nick = id "register-nick-input" let reg_input_password_id, reg_input_password = id "register-password-input" let input_secret_id, input_secret = id "register-secret-input" + let input_consent_id, input_consent = id "first-connection-consent" let button_new_id, button_new = id "login-new-button" let login_input_email_id, login_input_email = id "login-email-input" let login_input_password_id, login_input_password = id "login-password-input" @@ -629,18 +630,23 @@ let init_token_dialog () = let create_token () = if get_opt config##.enablePasswd then let email = Manip.value reg_input_email and - password = Manip.value reg_input_password in + password = Manip.value reg_input_password and + consent = Manip.checked input_consent and + consent_label = find_component "txt_first_connection_consent" in (* 5 for a character, @, character, dot, character. *) let email_criteria = String.length email < 5 || not (String.contains email '@') and passwd_criteria = String.length password < 8 in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; - if email_criteria || passwd_criteria then + Manip.SetCss.fontWeight consent_label ""; + if email_criteria || passwd_criteria || not consent then begin if email_criteria then Manip.SetCss.borderColor reg_input_email "#f44"; if passwd_criteria then Manip.SetCss.borderColor reg_input_password "#f44"; + if not consent then + Manip.SetCss.fontWeight consent_label "bold"; Lwt.return_none end else diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 71ac64350..0380365a8 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -22,6 +22,7 @@ let reg_input_email_id, reg_input_email = id "register-email-input" let reg_input_nick_id, reg_input_nick = id "register-nick-input" let reg_input_password_id, reg_input_password = id "register-password-input" let input_secret_id, input_secret = id "register-secret-input" +let input_consent_id, input_consent = id "first-connection-consent" let login_new_button_id, login_new_button = id "login-new-button" let login_email_input_id, login_email_input = id "login-email-input" @@ -58,18 +59,23 @@ let send_sync_request () = let create_token () = let email = Manip.value reg_input_email and - password = Manip.value reg_input_password in + password = Manip.value reg_input_password and + consent = Manip.checked input_consent and + consent_label = find_component "txt_first_connection_consent" in (* 5 for a character, @, character, dot, character. *) let email_criteria = String.length email < 5 || not (String.contains email '@') and passwd_criteria = String.length password < 8 in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; - if email_criteria || passwd_criteria then + Manip.SetCss.fontWeight consent_label ""; + if email_criteria || passwd_criteria || not consent then begin if email_criteria then Manip.SetCss.borderColor reg_input_email "#f44"; if passwd_criteria then Manip.SetCss.borderColor reg_input_password "#f44"; + if not consent then + Manip.SetCss.fontWeight consent_label "bold"; Lwt.return_none end else diff --git a/src/utils/js_utils.ml b/src/utils/js_utils.ml index ea6d9be6e..8ed084e84 100644 --- a/src/utils/js_utils.ml +++ b/src/utils/js_utils.ml @@ -351,6 +351,18 @@ module Manip = struct let elt = get_blur_elt "blur" elt in elt##blur + type checked = < checked: bool Js.t Js.prop > + let get_checked_elt name elt : checked Js.t = + if Js.undefined == (Js.Unsafe.coerce @@ Html5.toelt elt)##.checked then + manip_error + "Cannot call %s on a node without a 'checked' property" + name; + Js.Unsafe.coerce @@ Html5.toelt elt + + let checked elt = + let elt = get_checked_elt "checked" elt in + Js.to_bool elt##.checked + type value = < value: Js.js_string Js.t Js.prop > let get_value_elt name elt : value Js.t = if Js.undefined == (Js.Unsafe.coerce @@ Html5.toelt elt)##.value then diff --git a/src/utils/js_utils.mli b/src/utils/js_utils.mli index f3195027a..d03ea3333 100644 --- a/src/utils/js_utils.mli +++ b/src/utils/js_utils.mli @@ -71,6 +71,7 @@ module Manip : sig val disable: 'a elt -> unit val enable: 'a elt -> unit + val checked: 'a elt -> bool val value: 'a elt -> string val hasClass: 'a elt -> string -> bool From e34f78485e59ccfbf380bbafa08eb1e8d80c7169 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 31 Jul 2020 11:54:40 +0200 Subject: [PATCH 057/161] Add a text to clarify the secret on both register forms Signed-off-by: Alban Gruin --- src/app/learnocaml_index_main.ml | 2 ++ src/app/learnocaml_lti_main.ml | 2 ++ static/css/learnocaml_main.css | 3 +++ static/index.html | 1 + static/lti.html | 1 + 5 files changed, 9 insertions(+) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index dabb4a297..afcdeb7d9 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -812,6 +812,8 @@ let set_string_translations () = "txt_first_connection_nickname", [%i"Nickname"]; "txt_first_connection_password", [%i"Password"]; "txt_first_connection_secret", [%i"Secret"]; + "txt_secret_label", [%i"The secret is the passphrase provided by \ + your teacher to sign-up."]; "txt_login_new", [%i"Create new token"]; "txt_returning", [%i"Returning user"]; "txt_returning_email", [%i"Email address"]; diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 0380365a8..8e6d2d0df 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -112,6 +112,8 @@ let () = "txt_first_connection_nickname", [%i"Nickname"]; "txt_first_connection_password", [%i"Password"]; "txt_first_connection_secret", [%i"Enter the secret"]; + "txt_secret_label", [%i"The secret is the passphrase provided by \ + your teacher to sign-up."]; "txt_first_connection_consent", [%i"By submitting this form, I accept that the \ information entered will be used in the \ context of the Learn-OCaml plateform."]; diff --git a/static/css/learnocaml_main.css b/static/css/learnocaml_main.css index 6214cb593..8949f473c 100644 --- a/static/css/learnocaml_main.css +++ b/static/css/learnocaml_main.css @@ -917,6 +917,9 @@ body { z-index: 22220; overflow: auto; } +#login-overlay > div > span { + text-align: center; +} div#login-overlay > h1 { text-align: center; margin-bottom: 50px; diff --git a/static/index.html b/static/index.html index 5167606c7..5ad8cb2c8 100644 --- a/static/index.html +++ b/static/index.html @@ -114,6 +114,7 @@

+
diff --git a/static/lti.html b/static/lti.html index 7105eb364..b0f31fb61 100644 --- a/static/lti.html +++ b/static/lti.html @@ -38,6 +38,7 @@

+
From 5b09899db5b9b5e6a17da23ab12d3886d4a62023 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 31 Jul 2020 14:35:30 +0200 Subject: [PATCH 058/161] server: remove references to "http://localhost:8080" This removes the references to "http://localhost:8080" by passing the host to the callback. Signed-off-by: Alban Gruin --- src/app/server_caller.ml | 4 +-- src/main/learnocaml_client.ml | 4 +-- src/server/learnocaml_server.ml | 49 +++++++++++++++++++++------------ src/state/learnocaml_api.ml | 7 +++-- src/state/learnocaml_api.mli | 3 +- 5 files changed, 42 insertions(+), 25 deletions(-) diff --git a/src/app/server_caller.ml b/src/app/server_caller.ml index 4b1837588..5ffb44eb9 100644 --- a/src/app/server_caller.ml +++ b/src/app/server_caller.ml @@ -77,9 +77,9 @@ let urlpath p = let request req = let do_req = function - | { Learnocaml_api.meth = `GET; path; args } -> + | { Learnocaml_api.meth = `GET; path; args; _ } -> Lwt_request.get ?headers:None ~url:(urlpath path) ~args:args - | { Learnocaml_api.meth = `POST body; path; args } -> + | { Learnocaml_api.meth = `POST body; path; args; _ } -> let get_args = match args with [] -> None | a -> Some a in Lwt_request.post ?headers:None ?get_args ~url:(urlpath path) ~body:(Some body) diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index ebd9bb475..82f15b86c 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -463,9 +463,9 @@ let fetch server_url req = let open Cohttp in let open Cohttp_lwt_unix in let do_req = function - | { Learnocaml_api.meth = `GET; path; args } -> + | { Learnocaml_api.meth = `GET; path; args; _ } -> Client.get (url path args) - | { Learnocaml_api.meth = `POST body; path; args } -> + | { Learnocaml_api.meth = `POST body; path; args; _ } -> Client.post ~body:(Cohttp_lwt.Body.of_string body) (url path args) in Api_client.make_request diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 576b13a93..f4f568a55 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -187,7 +187,7 @@ let generate_hmac secret csrf user_id = Cryptokit.hash_string hmac (csrf ^ user_id) |> Cryptokit.transform_string encoder -let create_student conn (config: Learnocaml_data.Server.config) cache +let create_student conn (config: Learnocaml_data.Server.config) cache req nonce_req secret_candidate nick base_auth = let module ServerData = Learnocaml_data.Server in lwt_option_fail @@ -213,15 +213,15 @@ let create_student conn (config: Learnocaml_data.Server.config) cache Lwt.return (Token_index.Token (tok, use_moodle)) | `Password (email, password) -> Token_index.UpgradeIndex.change_email !sync_dir tok >|= (fun handle -> - Learnocaml_sendmail.confirm_email ~url:("http://localhost:8080/confirm/" ^ handle) email; + Learnocaml_sendmail.confirm_email ~url:(req.Api.host ^ "/confirm/" ^ handle) email; Token_index.Password (tok, email, password, Some(email)))) >>= fun auth -> Token_index.UserIndex.add !sync_dir auth >>= fun () -> respond_json cache tok -let initiate_password_change token address cache = +let initiate_password_change token address cache req = Token_index.UpgradeIndex.reset_password !sync_dir token >>= fun handle -> Learnocaml_sendmail.reset_password - ~url:("http://localhost:8080/reset_password/" ^ handle) + ~url:(req.Api.host ^ "/reset_password/" ^ handle) address; respond_json cache () @@ -276,10 +276,10 @@ module Request_handler = struct lwt_ok let callback_raw: type resp. Conduit.endp -> Learnocaml_data.Server.config -> - caching -> resp Api.request -> + caching -> Api.http_request -> resp Api.request -> (resp response, error) result Lwt.t = let module ServerData = Learnocaml_data.Server in - fun conn config cache -> function + fun conn config cache req -> function | Api.Version () -> respond_json cache (Api.version, config.ServerData.server_id) | Api.Launch body when config.ServerData.use_moodle -> @@ -291,7 +291,7 @@ module Request_handler = struct ("csrf", csrf_token)] in let params = Uri.query_of_encoded body |> List.map (fun (a, b) -> a, String.concat "," b) in - Token_index.check_oauth !sync_dir "http://localhost:8080/launch" params >>= + Token_index.check_oauth !sync_dir (req.Api.host ^ "/launch") params >>= (function | Ok id -> Token_index.MoodleIndex.user_exists !sync_dir id >>= fun exists -> @@ -409,7 +409,7 @@ module Request_handler = struct | Api.Create_token (secret_candidate, None, nick) -> valid_string_of_endp conn >?= fun conn -> - create_student conn config cache nonce_req secret_candidate nick (`Token false) + create_student conn config cache req nonce_req secret_candidate nick (`Token false) | Api.Create_token (_secret_candidate, Some token, _nick) -> lwt_catch_fail (fun () -> Token.register token >>= fun () -> @@ -435,7 +435,7 @@ module Request_handler = struct else if String.length password < 8 then lwt_fail (`Bad_request, "Password must be at least 8 characters long") else - create_student conn config cache nonce_req secret (Some nick) (`Password (email, password)) + create_student conn config cache req nonce_req secret (Some nick) (`Password (email, password)) | Api.Login (nick, password) when config.ServerData.use_passwd -> Token_index.UserIndex.authenticate !sync_dir (Token_index.Passwd (nick, password)) >>= (function @@ -679,7 +679,7 @@ module Request_handler = struct Token_index.UserIndex.change_email !sync_dir token address >>= fun () -> Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> Learnocaml_sendmail.change_email - ~url:("http://localhost:8080/confirm/" ^ handle) + ~url:(req.Api.host ^ "/confirm/" ^ handle) old_address address; respond_json cache () | None -> lwt_fail (`Not_found, "Unknown user.")) @@ -696,13 +696,13 @@ module Request_handler = struct Token_index.UserIndex.token_of_email !sync_dir address >>= (function | Some token -> - initiate_password_change token address cache + initiate_password_change token address cache req | None -> lwt_fail (`Not_found, "Unknown user.")) | Api.Change_password token when config.ServerData.use_passwd -> Token_index.UserIndex.email_of_token !sync_dir token >>= (function | Some address -> - initiate_password_change token address cache + initiate_password_change token address cache req | None -> lwt_fail (`Not_found, "Unknown user.")) | Api.Reset_password handle when config.ServerData.use_passwd -> Token_index.UpgradeIndex.can_reset_password !sync_dir handle >>= @@ -822,7 +822,7 @@ module Request_handler = struct let cookies = make_cookie ("token", Token.to_string token) :: cookies in Token_index.UserIndex.upgrade !sync_dir token email passwd >>= fun () -> Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> - Learnocaml_sendmail.confirm_email ~url:("http://localhost:8080/confirm/" ^ handle) email; + Learnocaml_sendmail.confirm_email ~url:(req.Api.host ^ "/confirm/" ^ handle) email; lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | Some _ -> lwt_fail (`Forbidden, "Already an account.")) @@ -836,12 +836,13 @@ module Request_handler = struct let callback: type resp. Conduit.endp -> Learnocaml_data.Server.config -> + Api.http_request -> resp Api.request -> resp ret - = fun conn config req -> + = fun conn config http_req req -> let cache = caching req in let respond () = Lwt.catch - (fun () -> callback_raw conn config cache req) + (fun () -> callback_raw conn config cache http_req req) (function | Not_found -> lwt_fail (`Not_found, "Component not found") @@ -886,6 +887,18 @@ let last_modified = (* server startup time *) (tm.tm_year + 1900) tm.tm_hour tm.tm_min tm.tm_sec +let get_base_url req = + let uri = Request.uri req in + match Uri.(scheme uri, host uri, port uri) with + | Some ("http" as scheme), Some host, Some 80 + | Some ("https" as scheme), Some host, Some 443 -> + Uri.to_string @@ Uri.make ~scheme ~host () + | Some scheme, Some host, Some port -> Uri.to_string @@ Uri.make ~scheme ~host ~port () + | _, Some host, Some 80 -> Uri.to_string @@ Uri.make ~scheme:("http") ~host () + | _, Some host, Some 443 -> Uri.to_string @@ Uri.make ~scheme:("https") ~host () + | _, Some host, Some port -> Uri.to_string @@ Uri.make ~scheme:("http") ~host ~port () + | _ -> failwith "Bad request" + (* Taken from the source of "decompress", from bin/easy.ml *) let compress ?(level = 4) data = let input_buffer = Bytes.create 0xFFFF in @@ -1013,7 +1026,7 @@ let launch () = then Server.respond ~status:`Not_modified ~body:Cohttp_lwt.Body.empty () else (match req.Request.meth with - | `GET -> lwt_ok {Api.meth = `GET; path; args} + | `GET -> lwt_ok {Api.meth = `GET; host = get_base_url req; path; args} | `POST -> begin Cohttp_lwt.Body.to_string body @@ -1027,11 +1040,11 @@ let launch () = List.assoc_opt "csrf" cookies with | Some (param_csrf :: _), Some cookie_csrf -> if Eqaf.equal param_csrf cookie_csrf then - lwt_ok {Api.meth = `POST params; path; args} + lwt_ok {Api.meth = `POST params; host = get_base_url req; path; args} else lwt_fail (`Forbidden, "CSRF token mismatch") | None, None | None, Some _ -> - lwt_ok {Api.meth = `POST params; path; args} + lwt_ok {Api.meth = `POST params; host = get_base_url req; path; args} | _, _ -> lwt_fail (`Forbidden, "Bad CSRF token") end diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 915b08c05..6c45fcfa6 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -105,6 +105,7 @@ type _ request = type http_request = { meth: [ `GET | `POST of string]; + host: string; path: string list; args: (string * string) list; } @@ -212,11 +213,13 @@ module Conversions (Json: JSON_CODEC) = struct = let get ?token path = { meth = `GET; + host = ""; path; args = match token with None -> [] | Some t -> ["token", Token.to_string t]; } in let post ?token path body = { meth = `POST body; + host = ""; path; args = match token with None -> [] | Some t -> ["token", Token.to_string t]; } in @@ -350,7 +353,7 @@ module type REQUEST_HANDLER = sig val map_ret: ('a -> 'b) -> 'a ret -> 'b ret val callback: Conduit.endp -> - Learnocaml_data.Server.config -> 'resp request -> 'resp ret + Learnocaml_data.Server.config -> http_request -> 'resp request -> 'resp ret end module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct @@ -362,7 +365,7 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct let handler conn config request = let k req = - Rh.callback conn config req |> Rh.map_ret (C.response_encode req) + Rh.callback conn config request req |> Rh.map_ret (C.response_encode req) in let token = match List.assoc_opt "token" request.args with diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 1a55ee043..1034cedee 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -125,6 +125,7 @@ type _ request = type http_request = { meth: [ `GET | `POST of string]; + host: string; path: string list; args: (string * string) list; } @@ -140,7 +141,7 @@ module type REQUEST_HANDLER = sig val map_ret: ('a -> 'b) -> 'a ret -> 'b ret val callback: Conduit.endp -> - Learnocaml_data.Server.config -> 'resp request -> 'resp ret + Learnocaml_data.Server.config -> http_request -> 'resp request -> 'resp ret end module Server: functor (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) -> sig From 731b361fa3ef6db692fdd034892f48db2edf592a Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 31 Jul 2020 15:21:50 +0200 Subject: [PATCH 059/161] po: update french translations Signed-off-by: Alban Gruin --- translations/fr.po | 737 +++++++++++++++++++++++++++------------------ 1 file changed, 441 insertions(+), 296 deletions(-) diff --git a/translations/fr.po b/translations/fr.po index 9b1fdb7b1..4b8c5c14a 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-01-01 19:29+0100\n" +"PO-Revision-Date: 2020-07-31 15:21+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -13,297 +13,249 @@ msgstr "" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" -#: src/grader/learnocaml_report.ml:240,50--66 -#: src/grader/learnocaml_report.ml:595,59--75 -msgid "(minimum mark)" -msgstr "(note minimale)" - -#: src/grader/learnocaml_report.ml:250,55--74 -msgid "Completed, %d pts" -msgstr "Terminé, %d pts" - -#: src/grader/learnocaml_report.ml:254,38--46 -#: src/grader/learnocaml_report.ml:258,67--75 -msgid "Failed" -msgstr "Échoué" - -#: src/grader/learnocaml_report.ml:262,55--75 -msgid "Incomplete, %d pts" -msgstr "Incomplet, %d pts" - -#: src/grader/learnocaml_report.ml:287,26--43 -msgid "Exercise failed" -msgstr "Exercice échoué" - -#: src/grader/learnocaml_report.ml:289,31--37 -msgid "0 pt" -msgstr "0 pt" - -#: src/grader/learnocaml_report.ml:291,26--45 -msgid "Exercise complete" -msgstr "Exercice terminé" - -#: src/grader/learnocaml_report.ml:293,49--57 -#: src/grader/learnocaml_report.ml:297,49--57 -msgid "%d pts" -msgstr "%d pts" - -#: src/grader/learnocaml_report.ml:295,26--47 -msgid "Exercise incomplete" -msgstr "Exercice incomplet" - -#: src/grader/learnocaml_report.ml:563,56--78 -msgid "@[Failure: %a@]" -msgstr "@[Échec: %a@]" - -#: src/grader/learnocaml_report.ml:564,56--78 -msgid "@[Warning: %a@]" -msgstr "@[Avertissement: %a@]" - -#: src/grader/learnocaml_report.ml:566,58--82 -msgid "@[Important: %a@]" -msgstr "@[Important: %a@]" - -#: src/grader/learnocaml_report.ml:567,58--83 -msgid "@[Success %d: %a@]" -msgstr "@[Réussite %d: %a@]" - -#: src/grader/learnocaml_report.ml:568,58--83 -msgid "@[Penalty %d: %a@]" -msgstr "@[Pénalité %d: %a@]" - -#: src/app/learnocaml_common.ml:67,21--37 +#: src/app/learnocaml_common.ml:68,21--37 msgid "INTERNAL ERROR" msgstr "ERREUR INTERNE" -#: src/app/learnocaml_common.ml:102,50--54 -#: src/app/learnocaml_common.ml:136,33--37 -#: src/app/learnocaml_common.ml:142,36--40 +#: src/app/learnocaml_common.ml:103,50--54 +#: src/app/learnocaml_common.ml:137,33--37 +#: src/app/learnocaml_common.ml:143,36--40 msgid "OK" msgstr "OK" -#: src/app/learnocaml_common.ml:133,21--28 +#: src/app/learnocaml_common.ml:134,21--28 +#: src/app/learnocaml_index_main.ml:668,25--32 msgid "ERROR" msgstr "ERREUR" -#: src/app/learnocaml_common.ml:136,58--66 -#: src/app/learnocaml_common.ml:414,12--20 -#: src/app/learnocaml_index_main.ml:574,17--25 +#: src/app/learnocaml_common.ml:137,58--66 +#: src/app/learnocaml_common.ml:415,12--20 +#: src/app/learnocaml_index_main.ml:588,12--20 +#: src/app/learnocaml_index_main.ml:686,19--27 +#: src/app/learnocaml_index_main.ml:719,20--28 msgid "Cancel" msgstr "Annuler" -#: src/app/learnocaml_common.ml:406,26--41 -#: src/app/learnocaml_index_main.ml:569,32--47 +#: src/app/learnocaml_common.ml:407,26--41 +#: src/app/learnocaml_index_main.ml:583,25--40 +#: src/app/learnocaml_index_main.ml:681,32--47 +#: src/app/learnocaml_index_main.ml:714,33--48 msgid "REQUEST ERROR" msgstr "ERREUR DE REQUÊTE" -#: src/app/learnocaml_common.ml:407,25--62 -#: src/app/learnocaml_index_main.ml:570,31--68 +#: src/app/learnocaml_common.ml:408,22--59 +#: src/app/learnocaml_index_main.ml:584,26--63 +#: src/app/learnocaml_index_main.ml:682,30--67 +#: src/app/learnocaml_index_main.ml:715,34--71 msgid "Could not retrieve data from server" msgstr "Échec lors du téléchargement des données du serveur" -#: src/app/learnocaml_common.ml:410,12--19 -#: src/app/learnocaml_common.ml:450,11--18 -#: src/app/learnocaml_index_main.ml:573,17--24 +#: src/app/learnocaml_common.ml:411,12--19 +#: src/app/learnocaml_common.ml:451,11--18 +#: src/app/learnocaml_index_main.ml:587,12--19 +#: src/app/learnocaml_index_main.ml:685,19--26 +#: src/app/learnocaml_index_main.ml:718,20--27 msgid "Retry" msgstr "Réessayer" -#: src/app/learnocaml_common.ml:413,25--33 -#: src/app/learnocaml_common.ml:451,11--19 +#: src/app/learnocaml_common.ml:414,25--33 +#: src/app/learnocaml_common.ml:452,11--19 msgid "Ignore" msgstr "Ignorer" -#: src/app/learnocaml_common.ml:446,26--39 +#: src/app/learnocaml_common.ml:447,26--39 msgid "SYNC FAILED" msgstr "ECHEC DE LA SYNCHRONISATION" -#: src/app/learnocaml_common.ml:447,25--69 +#: src/app/learnocaml_common.ml:448,22--66 msgid "Could not synchronise save with the server" msgstr "Les données n'ont pas pu être synchronisées avec le serveur" -#: src/app/learnocaml_common.ml:499,39--50 +#: src/app/learnocaml_common.ml:500,39--50 msgid "%dd %02dh" msgstr "%dj %02dh" -#: src/app/learnocaml_common.ml:500,40--51 +#: src/app/learnocaml_common.ml:501,40--51 msgid "%02d:%02d" msgstr "%02d:%02d" -#: src/app/learnocaml_common.ml:501,23--36 +#: src/app/learnocaml_common.ml:502,23--36 msgid "0:%02d:%02d" msgstr "0:%02d:%02d" -#: src/app/learnocaml_common.ml:532,34--55 -#: src/app/learnocaml_common.ml:1015,38--59 +#: src/app/learnocaml_common.ml:533,34--55 +#: src/app/learnocaml_common.ml:1016,38--59 msgid "difficulty: %d / 40" msgstr "difficulté: %d / 40" -#: src/app/learnocaml_common.ml:567,30--75 +#: src/app/learnocaml_common.ml:568,30--75 msgid "No description available for this exercise." msgstr "Aucune description pour cet exercice." -#: src/app/learnocaml_common.ml:589,32--41 -#: src/app/learnocaml_index_main.ml:123,57--66 +#: src/app/learnocaml_common.ml:590,32--41 +#: src/app/learnocaml_index_main.ml:155,54--63 msgid "project" msgstr "projet" -#: src/app/learnocaml_common.ml:590,32--41 -#: src/app/learnocaml_index_main.ml:124,57--66 +#: src/app/learnocaml_common.ml:591,32--41 +#: src/app/learnocaml_index_main.ml:156,54--63 msgid "problem" msgstr "problème" -#: src/app/learnocaml_common.ml:591,33--43 -#: src/app/learnocaml_index_main.ml:125,58--68 +#: src/app/learnocaml_common.ml:592,33--43 +#: src/app/learnocaml_index_main.ml:157,55--65 msgid "exercise" msgstr "exercice" -#: src/app/learnocaml_common.ml:743,26--33 +#: src/app/learnocaml_common.ml:744,26--33 msgid "Clear" msgstr "Effacer" -#: src/app/learnocaml_common.ml:748,25--32 -#: src/app/learnocaml_common.ml:869,24--31 +#: src/app/learnocaml_common.ml:749,25--32 +#: src/app/learnocaml_common.ml:870,24--31 msgid "Reset" msgstr "Réinitialiser" -#: src/app/learnocaml_common.ml:753,22--35 +#: src/app/learnocaml_common.ml:754,22--35 msgid "Eval phrase" msgstr "Évaluer la phrase" -#: src/app/learnocaml_common.ml:768,24--51 +#: src/app/learnocaml_common.ml:769,24--51 msgid "Preparing the environment" msgstr "Préparation de l'environnement" -#: src/app/learnocaml_common.ml:769,39--47 -#: src/app/learnocaml_common.ml:774,37--45 +#: src/app/learnocaml_common.ml:770,39--47 +#: src/app/learnocaml_common.ml:775,37--45 msgid "Editor" msgstr "Éditeur" -#: src/app/learnocaml_common.ml:770,41--51 -#: src/app/learnocaml_index_main.ml:692,30--40 +#: src/app/learnocaml_common.ml:771,41--51 +#: src/app/learnocaml_index_main.ml:907,30--40 msgid "Toplevel" msgstr "Toplevel" -#: src/app/learnocaml_common.ml:771,39--47 -#: src/app/learnocaml_common.ml:783,39--47 -#: src/app/learnocaml_exercise_main.ml:51,33--41 -#: src/app/learnocaml_exercise_main.ml:55,33--41 -#: src/app/learnocaml_exercise_main.ml:60,33--41 -#: src/app/learnocaml_student_view.ml:381,31--39 -#: src/app/learnocaml_student_view.ml:394,33--41 -#: src/app/learnocaml_student_view.ml:398,33--41 -#: src/app/learnocaml_student_view.ml:403,33--41 +#: src/app/learnocaml_common.ml:772,39--47 +#: src/app/learnocaml_common.ml:784,39--47 +#: src/app/learnocaml_exercise_main.ml:52,30--38 +#: src/app/learnocaml_exercise_main.ml:56,30--38 +#: src/app/learnocaml_exercise_main.ml:61,30--38 +#: src/app/learnocaml_student_view.ml:382,28--36 +#: src/app/learnocaml_student_view.ml:395,30--38 +#: src/app/learnocaml_student_view.ml:399,30--38 +#: src/app/learnocaml_student_view.ml:404,30--38 msgid "Report" msgstr "Rapport" -#: src/app/learnocaml_common.ml:772,37--47 +#: src/app/learnocaml_common.ml:773,37--47 msgid "Exercise" msgstr "Exercice" -#: src/app/learnocaml_common.ml:773,37--46 +#: src/app/learnocaml_common.ml:774,37--46 msgid "Details" msgstr "Détails" -#: src/app/learnocaml_common.ml:775,27--70 +#: src/app/learnocaml_common.ml:776,27--70 msgid "Click the Grade button to get your report" msgstr "Cliquez sur le bouton Noter pour obtenir votre rapport" -#: src/app/learnocaml_common.ml:780,22--44 +#: src/app/learnocaml_common.ml:781,22--44 msgid "Loading student data" msgstr "Chargement des informations sur les étudiants" -#: src/app/learnocaml_common.ml:781,38--45 +#: src/app/learnocaml_common.ml:782,38--45 msgid "Stats" msgstr "Statistiques" -#: src/app/learnocaml_common.ml:782,37--48 -#: src/app/learnocaml_exercise_main.ml:195,23--34 -#: src/app/learnocaml_index_main.ml:689,48--59 -#: src/app/learnocaml_teacher_tab.ml:327,21--32 +#: src/app/learnocaml_common.ml:783,37--48 +#: src/app/learnocaml_exercise_main.ml:196,23--34 +#: src/app/learnocaml_index_main.ml:904,48--59 +#: src/app/learnocaml_teacher_tab.ml:328,18--29 msgid "Exercises" msgstr "Exercices" -#: src/app/learnocaml_common.ml:784,37--46 +#: src/app/learnocaml_common.ml:785,37--46 msgid "Subject" msgstr "Énoncé" -#: src/app/learnocaml_common.ml:785,39--47 +#: src/app/learnocaml_common.ml:786,39--47 msgid "Answer" msgstr "Réponse" -#: src/app/learnocaml_common.ml:870,22--42 +#: src/app/learnocaml_common.ml:871,22--42 msgid "START FROM SCRATCH" msgstr "TOUT RECOMMENCER" -#: src/app/learnocaml_common.ml:871,19--68 +#: src/app/learnocaml_common.ml:872,16--65 msgid "This will discard all your edits. Are you sure?" msgstr "Toutes vos modifications seront perdues. Vous êtes sûr·e ?" -#: src/app/learnocaml_common.ml:878,27--37 +#: src/app/learnocaml_common.ml:879,27--37 msgid "Download" msgstr "Télécharger" -#: src/app/learnocaml_common.ml:886,22--33 +#: src/app/learnocaml_common.ml:887,22--33 msgid "Eval code" msgstr "Évaluer le code" -#: src/app/learnocaml_common.ml:893,23--29 +#: src/app/learnocaml_common.ml:894,23--29 msgid "Sync" msgstr "Sync" -#: src/app/learnocaml_common.ml:946,37--52 +#: src/app/learnocaml_common.ml:947,34--49 msgid "OCaml prelude" msgstr "Prélude OCaml" -#: src/app/learnocaml_common.ml:953,62--68 +#: src/app/learnocaml_common.ml:954,59--65 msgid "Hide" msgstr "Cacher" -#: src/app/learnocaml_common.ml:960,62--68 +#: src/app/learnocaml_common.ml:961,59--65 msgid "Show" msgstr "Montrer" -#: src/app/learnocaml_common.ml:981,19--37 +#: src/app/learnocaml_common.ml:982,16--34 +#: src/app/learnocaml_lti_main.ml:114,40--58 +#: src/app/learnocaml_index_main.ml:802,27--45 msgid "Enter the secret" msgstr "Entrez le secret" -#: src/app/learnocaml_common.ml:1021,25--38 +#: src/app/learnocaml_common.ml:1022,22--35 msgid "Difficulty:" msgstr "Difficulté :" -#: src/app/learnocaml_common.ml:1035,42--52 +#: src/app/learnocaml_common.ml:1036,39--49 msgid "Kind: %s" msgstr "Type : %s" -#: src/app/learnocaml_common.ml:1176,46--59 +#: src/app/learnocaml_common.ml:1177,46--59 msgid "Identifier:" msgstr "Identifiant de l'exercice :" -#: src/app/learnocaml_common.ml:1180,48--57 +#: src/app/learnocaml_common.ml:1181,48--57 msgid "Author:" msgstr "Auteur :" -#: src/app/learnocaml_common.ml:1181,47--57 +#: src/app/learnocaml_common.ml:1182,47--57 msgid "Authors:" msgstr "Auteurs :" -#: src/app/learnocaml_common.ml:1186,31--48 +#: src/app/learnocaml_common.ml:1187,31--48 msgid "Skills trained:" msgstr "Compétences pratiquées :" -#: src/app/learnocaml_common.ml:1190,31--49 +#: src/app/learnocaml_common.ml:1191,31--49 msgid "Skills required:" msgstr "Compétences requises :" -#: src/app/learnocaml_common.ml:1195,36--57 +#: src/app/learnocaml_common.ml:1196,36--57 msgid "Previous exercises:" msgstr "Exercices précédents :" -#: src/app/learnocaml_common.ml:1198,35--52 +#: src/app/learnocaml_common.ml:1199,35--52 msgid "Next exercises:" msgstr "Exercices suivants :" -#: src/app/learnocaml_common.ml:1203,29--39 +#: src/app/learnocaml_common.ml:1204,26--36 msgid "Metadata" msgstr "Métadonnées" @@ -315,36 +267,36 @@ msgstr "Le toplevel a été nettoyé.\n" msgid "%d seconds!" msgstr "%d secondes !" -#: src/toplevel/learnocaml_toplevel.ml:267,23--33 +#: src/toplevel/learnocaml_toplevel.ml:267,20--30 msgid "Kill it!" msgstr "Le terminer !" -#: src/toplevel/learnocaml_toplevel.ml:277,27--43 +#: src/toplevel/learnocaml_toplevel.ml:277,24--40 msgid "Infinite loop?" msgstr "Boucle infinie ?" -#: src/toplevel/learnocaml_toplevel.ml:279,26--69 +#: src/toplevel/learnocaml_toplevel.ml:279,23--66 msgid "The toplevel has not been responding for " msgstr "Le toplevel ne répond plus depuis " -#: src/toplevel/learnocaml_toplevel.ml:281,26--37 -#: src/toplevel/learnocaml_toplevel.ml:285,26--37 +#: src/toplevel/learnocaml_toplevel.ml:281,23--34 +#: src/toplevel/learnocaml_toplevel.ml:285,23--34 msgid " seconds." msgstr " secondes." -#: src/toplevel/learnocaml_toplevel.ml:283,26--49 +#: src/toplevel/learnocaml_toplevel.ml:283,23--46 msgid "It will be killed in " msgstr "Il sera terminé dans " -#: src/toplevel/learnocaml_toplevel.ml:314,23--37 +#: src/toplevel/learnocaml_toplevel.ml:314,20--34 msgid "Show anyway!" msgstr "Afficher quand même !" -#: src/toplevel/learnocaml_toplevel.ml:316,23--37 +#: src/toplevel/learnocaml_toplevel.ml:316,20--34 msgid "Hide output!" msgstr "Masquer la sortie !" -#: src/toplevel/learnocaml_toplevel.ml:325,27--44 +#: src/toplevel/learnocaml_toplevel.ml:325,24--41 msgid "Flooded output!" msgstr "La sortie déborde !" @@ -352,11 +304,11 @@ msgstr "La sortie déborde !" msgid "Your code is flooding the %s channel." msgstr "Votre code submerge le canal %s." -#: src/toplevel/learnocaml_toplevel.ml:330,26--51 +#: src/toplevel/learnocaml_toplevel.ml:330,23--48 msgid "It has already printed " msgstr "Il a déjà affiché " -#: src/toplevel/learnocaml_toplevel.ml:332,26--35 +#: src/toplevel/learnocaml_toplevel.ml:332,23--32 msgid " bytes." msgstr " octets." @@ -394,20 +346,20 @@ msgstr "" msgid "The toplevel has been reset.\n" msgstr "Le toplevel a été redémarré.\n" -#: src/app/learnocaml_exercise_main.ml:24,20--79 +#: src/app/learnocaml_exercise_main.ml:25,20--79 msgid "WARNING: You have an older grader version than the server" msgstr "" "ATTENTION: La version locale du grader est plus ancienne que celle du serveur" -#: src/app/learnocaml_exercise_main.ml:25,23--41 +#: src/app/learnocaml_exercise_main.ml:26,23--41 msgid "Refresh the page" msgstr "Actualiser la page" -#: src/app/learnocaml_exercise_main.ml:27,27--49 +#: src/app/learnocaml_exercise_main.ml:28,27--49 msgid "I will do it myself!" msgstr "Je sais le faire moi-même!" -#: src/app/learnocaml_exercise_main.ml:28,22--178 +#: src/app/learnocaml_exercise_main.ml:29,22--178 msgid "" "The server has been updated, please refresh the page to make sure you are " "using the latest version of Learn-OCaml server (none of your work will be " @@ -417,11 +369,11 @@ msgstr "" "d'utiliser la dernière version du serveur Learn-OCaml (votre travail ne sera " "pas perdu)." -#: src/app/learnocaml_exercise_main.ml:85,18--29 +#: src/app/learnocaml_exercise_main.ml:86,18--29 msgid "TIME'S UP" msgstr "TEMPS ÉCOULÉ" -#: src/app/learnocaml_exercise_main.ml:86,7--119 +#: src/app/learnocaml_exercise_main.ml:87,7--119 msgid "" "The deadline for this exercise has expired. Any changes you make from now on " "will remain local only." @@ -429,58 +381,58 @@ msgstr "" "La date limite de rendu de cet exercice est passée. Vos changements ne " "seront plus sauvegardés sur le serveur." -#: src/app/learnocaml_exercise_main.ml:123,25--49 -#: src/app/learnocaml_playground_main.ml:40,19--43 +#: src/app/learnocaml_exercise_main.ml:124,25--49 +#: src/app/learnocaml_playground_main.ml:41,19--43 msgid "loading the prelude..." msgstr "Chargement du prélude..." -#: src/app/learnocaml_exercise_main.ml:128,41--59 -#: src/app/learnocaml_playground_main.ml:43,31--49 +#: src/app/learnocaml_exercise_main.ml:129,41--59 +#: src/app/learnocaml_playground_main.ml:44,31--49 msgid "error in prelude" msgstr "erreur dans le prélude" -#: src/app/learnocaml_exercise_main.ml:207,28--37 -#: src/app/learnocaml_playground_main.ml:77,28--37 +#: src/app/learnocaml_exercise_main.ml:208,28--37 +#: src/app/learnocaml_playground_main.ml:78,28--37 msgid "Compile" msgstr "Compiler" -#: src/app/learnocaml_exercise_main.ml:211,25--33 +#: src/app/learnocaml_exercise_main.ml:212,25--33 msgid "Grade!" msgstr "Noter!" -#: src/app/learnocaml_exercise_main.ml:216,51--58 +#: src/app/learnocaml_exercise_main.ml:217,48--55 msgid "abort" msgstr "abandonner" -#: src/app/learnocaml_exercise_main.ml:220,38--73 +#: src/app/learnocaml_exercise_main.ml:221,35--70 msgid "Grading is taking a lot of time, " msgstr "La notation prend longtemps, " -#: src/app/learnocaml_exercise_main.ml:226,38--60 +#: src/app/learnocaml_exercise_main.ml:227,35--57 msgid "Launching the grader" msgstr "Lancement de la notation" -#: src/app/learnocaml_exercise_main.ml:249,60--86 +#: src/app/learnocaml_exercise_main.ml:250,60--86 msgid "Grading aborted by user." msgstr "Notation annulée par l'utilisateur." -#: src/app/learnocaml_exercise_main.ml:270,38--59 +#: src/app/learnocaml_exercise_main.ml:271,38--59 msgid "Error in your code." msgstr "Erreur dans le code." -#: src/app/learnocaml_exercise_main.ml:271,27--85 +#: src/app/learnocaml_exercise_main.ml:272,27--85 msgid "Cannot start the grader if your code does not typecheck." msgstr "La notation ne peut être lancée si le code ne type pas." -#: src/grader/grader_jsoo_worker.ml:49,17--44 +#: src/grader/grader_jsoo_worker.ml:51,17--44 msgid "Error in your solution:\n" msgstr "Erreur dans votre solution:\n" -#: src/grader/grader_jsoo_worker.ml:51,17--41 +#: src/grader/grader_jsoo_worker.ml:53,17--41 msgid "Error in the exercise " msgstr "Erreur dans l'exercice " -#: src/grader/grader_jsoo_worker.ml:53,17--71 +#: src/grader/grader_jsoo_worker.ml:55,17--71 msgid "" "Internal error:\n" "The grader did not return a report." @@ -488,65 +440,133 @@ msgstr "" "Erreur interne:\n" "Le moteur de notation n'a pas retourné de rapport." -#: src/grader/grader_jsoo_worker.ml:55,17--38 +#: src/grader/grader_jsoo_worker.ml:57,17--38 msgid "Unexpected error:\n" msgstr "Erreur inattendue:\n" -#: src/app/learnocaml_index_main.ml:64,18--37 +#: src/app/learnocaml_lti_main.ml:110,33--51 +#: src/app/learnocaml_index_main.ml:800,37--55 +#: src/app/learnocaml_index_main.ml:804,31--49 +msgid "First connection" +msgstr "Première connexion" + +#: src/app/learnocaml_lti_main.ml:111,39--54 +#: src/app/learnocaml_lti_main.ml:122,32--47 +#: src/app/learnocaml_index_main.ml:805,37--52 +#: src/app/learnocaml_index_main.ml:813,30--45 +#: src/app/learnocaml_upgrade_main.ml:22,32--47 +msgid "Email address" +msgstr "Adresse email" + +#: src/app/learnocaml_lti_main.ml:112,42--52 +#: src/app/learnocaml_index_main.ml:806,40--50 +#: src/app/learnocaml_index_main.ml:831,9--19 +#: src/app/learnocaml_teacher_tab.ml:557,22--32 +msgid "Nickname" +msgstr "Pseudonyme" + +#: src/app/learnocaml_lti_main.ml:113,42--52 +#: src/app/learnocaml_lti_main.ml:123,35--45 +#: src/app/learnocaml_index_main.ml:807,40--50 +#: src/app/learnocaml_index_main.ml:814,33--43 +#: src/app/learnocaml_upgrade_main.ml:23,35--45 +msgid "Password" +msgstr "Mot de passe" + +#: src/app/learnocaml_lti_main.ml:115,29--126 +#: src/app/learnocaml_index_main.ml:809,27--124 +msgid "The secret is the passphrase provided by your teacher to sign-up." +msgstr "Le secret est une phrase de passe fournie par votre enseignant au moment de l'inscription." + +#: src/app/learnocaml_lti_main.ml:117,41--251 +#: src/app/learnocaml_index_main.ml:817,39--244 +msgid "" +"By submitting this form, I accept that the information entered will be used " +"in the context of the Learn-OCaml plateform." +msgstr "En validant ce formulaire, j'accepte que les informations entrées puissent être utilisées dans le contexte de la plateforme Learn-OCaml." + +#: src/app/learnocaml_lti_main.ml:120,26--44 +#: src/app/learnocaml_index_main.ml:803,24--42 +#: src/app/learnocaml_index_main.ml:811,24--42 +msgid "Create new token" +msgstr "Nouveau token" + +#: src/app/learnocaml_lti_main.ml:121,26--42 +#: src/app/learnocaml_index_main.ml:812,24--40 +msgid "Returning user" +msgstr "Utilisateur existant" + +#: src/app/learnocaml_lti_main.ml:124,32--41 +#: src/app/learnocaml_index_main.ml:815,31--40 +#: src/app/learnocaml_index_main.ml:822,30--39 +msgid "Connect" +msgstr "Se connecter" + +#: src/app/learnocaml_lti_main.ml:125,32--55 +#: src/app/learnocaml_index_main.ml:816,30--53 +msgid "Forgot your password?" +msgstr "Mot de passe oublié ?" + +#: src/app/learnocaml_lti_main.ml:126,29--43 +#: src/app/learnocaml_lti_main.ml:127,36--50 +msgid "Direct login" +msgstr "Connexion directe" + +#: src/app/learnocaml_index_main.ml:96,18--37 msgid "Loading exercises" msgstr "Chargement des exercices" -#: src/app/learnocaml_index_main.ml:97,32--49 +#: src/app/learnocaml_index_main.ml:129,32--49 msgid "Exercise closed" msgstr "Exercice fermé" -#: src/app/learnocaml_index_main.ml:98,47--62 +#: src/app/learnocaml_index_main.ml:130,47--62 msgid "Time left: %s" msgstr "Temps restant: %s" -#: src/app/learnocaml_index_main.ml:145,31--64 +#: src/app/learnocaml_index_main.ml:177,28--61 msgid "No open exercises at the moment" msgstr "Aucun exercice n'est encore ouvert" -#: src/app/learnocaml_index_main.ml:152,18--38 +#: src/app/learnocaml_index_main.ml:184,18--38 msgid "Loading playground" msgstr "Chargement du bac-à-sable" -#: src/app/learnocaml_index_main.ml:178,18--35 +#: src/app/learnocaml_index_main.ml:210,18--35 msgid "Loading lessons" msgstr "Chargement des cours" -#: src/app/learnocaml_index_main.ml:211,37--61 +#: src/app/learnocaml_index_main.ml:243,37--61 msgid "Running OCaml examples" msgstr "Lancement des exemples d'OCaml" -#: src/app/learnocaml_index_main.ml:252,39--45 -#: src/app/learnocaml_index_main.ml:441,39--45 +#: src/app/learnocaml_index_main.ml:284,39--45 +#: src/app/learnocaml_index_main.ml:473,39--45 msgid "Prev" msgstr "Prec." -#: src/app/learnocaml_index_main.ml:268,40--46 -#: src/app/learnocaml_index_main.ml:458,40--46 +#: src/app/learnocaml_index_main.ml:300,40--46 +#: src/app/learnocaml_index_main.ml:490,40--46 msgid "Next" msgstr "Suiv." -#: src/app/learnocaml_index_main.ml:325,18--37 +#: src/app/learnocaml_index_main.ml:357,18--37 msgid "Loading tutorials" msgstr "Chargement des tutoriels" -#: src/app/learnocaml_index_main.ml:491,18--35 +#: src/app/learnocaml_index_main.ml:523,18--35 msgid "Launching OCaml" msgstr "Démarrage d'OCaml" -#: src/app/learnocaml_index_main.ml:504,18--40 +#: src/app/learnocaml_index_main.ml:536,18--40 msgid "Loading student info" msgstr "Chargement des informations sur les étudiants" -#: src/app/learnocaml_index_main.ml:524,22--46 +#: src/app/learnocaml_index_main.ml:566,22--46 msgid "Your Learn-OCaml token" msgstr "Votre token Learn-OCaml" -#: src/app/learnocaml_index_main.ml:525,21--147 +#: src/app/learnocaml_index_main.ml:567,20--145 msgid "" "Your token is displayed below. It identifies you and allows to share your " "workspace between devices." @@ -554,90 +574,120 @@ msgstr "" "Votre token est affiché ci-dessous. Il vous identifie et permet de partager " "un même espace de travail entre plusieurs machines." -#: src/app/learnocaml_index_main.ml:527,21--44 +#: src/app/learnocaml_index_main.ml:569,20--43 msgid "Please write it down." msgstr "Notez-le !" -#: src/app/learnocaml_index_main.ml:565,28--45 +#: src/app/learnocaml_index_main.ml:575,21--41 +msgid "RESET REQUEST SENT" +msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" + +#: src/app/learnocaml_index_main.ml:576,10--64 +msgid "A reset link has been sent to the specified address." +msgstr "Un lien de réinitialisation a été envoyé à l'adresse spécifiée." + +#: src/app/learnocaml_index_main.ml:579,21--37 +#, fuzzy +msgid "USER NOT FOUND" +msgstr "TOKEN NON TROUVÉ" + +#: src/app/learnocaml_index_main.ml:580,10--53 +#, fuzzy +msgid "The entered email couldn't be recognised." +msgstr "Le token entré n'a pas été reconnu." + +#: src/app/learnocaml_index_main.ml:677,28--45 +#: src/app/learnocaml_index_main.ml:700,26--43 +#: src/app/learnocaml_index_main.ml:710,29--46 msgid "TOKEN NOT FOUND" msgstr "TOKEN NON TROUVÉ" -#: src/app/learnocaml_index_main.ml:566,17--60 +#: src/app/learnocaml_index_main.ml:678,17--60 +#: src/app/learnocaml_index_main.ml:701,15--58 +#: src/app/learnocaml_index_main.ml:711,18--61 msgid "The entered token couldn't be recognised." msgstr "Le token entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:620,7--21 +#: src/app/learnocaml_index_main.ml:795,7--21 msgid "Connected as" msgstr "Connecté en tant que" -#: src/app/learnocaml_index_main.ml:622,7--19 +#: src/app/learnocaml_index_main.ml:797,7--19 msgid "Activities" msgstr "Activités" -#: src/app/learnocaml_index_main.ml:624,9--33 +#: src/app/learnocaml_index_main.ml:799,9--33 msgid "Welcome to Learn OCaml" msgstr "Bienvenue sur Learn OCaml" -#: src/app/learnocaml_index_main.ml:625,31--49 -msgid "First connection" -msgstr "Première connexion" - -#: src/app/learnocaml_index_main.ml:626,38--57 +#: src/app/learnocaml_index_main.ml:801,44--63 msgid "Choose a nickname" msgstr "Choisissez un identifiant" -#: src/app/learnocaml_index_main.ml:627,38--46 +#: src/app/learnocaml_index_main.ml:808,38--46 msgid "Secret" msgstr "Secret" -#: src/app/learnocaml_index_main.ml:628,24--42 -msgid "Create new token" -msgstr "Nouveau token" +#: src/app/learnocaml_index_main.ml:820,35--55 +msgid "Login with a token" +msgstr "Connexion avec un token" -#: src/app/learnocaml_index_main.ml:629,24--40 -msgid "Returning user" -msgstr "Utilisateur existant" - -#: src/app/learnocaml_index_main.ml:630,31--49 -msgid "Enter your token" -msgstr "Entrez votre token" - -#: src/app/learnocaml_index_main.ml:631,31--40 -msgid "Connect" -msgstr "Se connecter" +#: src/app/learnocaml_index_main.ml:821,30--37 +#: src/app/learnocaml_teacher_tab.ml:559,22--29 +msgid "Token" +msgstr "Token" -#: src/app/learnocaml_index_main.ml:639,9--19 -#: src/app/learnocaml_index_main.ml:641,9--19 -#: src/app/learnocaml_teacher_tab.ml:556,25--35 -msgid "Nickname" -msgstr "Pseudonyme" +#: src/app/learnocaml_index_main.ml:823,22--39 +#: src/app/learnocaml_upgrade_main.ml:21,26--43 +msgid "Upgrade account" +msgstr "Passer à un compte" -#: src/app/learnocaml_index_main.ml:676,41--62 +#: src/app/learnocaml_index_main.ml:865,38--59 msgid "Choose an activity." msgstr "Sélectionnez une activité." -#: src/app/learnocaml_index_main.ml:685,30--41 +#: src/app/learnocaml_index_main.ml:882,27--46 +msgid "New email address" +msgstr "Nouvelle adresse email" + +#: src/app/learnocaml_index_main.ml:883,18--50 +msgid "Enter your new email address: " +msgstr "Entrez votre nouvelle adresse email :" + +#: src/app/learnocaml_index_main.ml:888,22--39 +msgid "Change password" +msgstr "Changer de mot de passe" + +#: src/app/learnocaml_index_main.ml:889,22--36 +msgid "Change email" +msgstr "Changer d'adresse email" + +#: src/app/learnocaml_index_main.ml:900,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:687,29--38 +#: src/app/learnocaml_index_main.ml:902,29--38 msgid "Lessons" msgstr "Cours" -#: src/app/learnocaml_index_main.ml:694,32--44 -#: src/app/learnocaml_playground_main.ml:70,23--35 +#: src/app/learnocaml_index_main.ml:909,32--44 +#: src/app/learnocaml_playground_main.ml:71,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:697,28--35 +#: src/app/learnocaml_index_main.ml:912,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:795,15--69 +#: src/app/learnocaml_index_main.ml:1012,17--71 msgid "Be sure to write down your token before logging out:" msgstr "Assurez-vous d'avoir noté votre token :" -#: src/app/learnocaml_index_main.ml:797,15--186 +#: src/app/learnocaml_index_main.ml:1014,17--51 +msgid "Are you sure you want to logout?" +msgstr "Êtes-vous sûr de vouloir vous déconnecter ?" + +#: src/app/learnocaml_index_main.ml:1016,15--186 msgid "" "WARNING: the data could not be synchronised with the server. Logging out " "will lose your local changes, be sure you exported a backup." @@ -646,41 +696,41 @@ msgstr "" "En vous déconnectant, vous perdrez tous les changements locaux, à moins " "d'avoir exporté votre espace de travail au préalable." -#: src/app/learnocaml_index_main.ml:801,22--30 -#: src/app/learnocaml_index_main.ml:801,45--53 -#: src/app/learnocaml_index_main.ml:823,9--17 +#: src/app/learnocaml_index_main.ml:1027,22--30 +#: src/app/learnocaml_index_main.ml:1027,45--53 +#: src/app/learnocaml_index_main.ml:1049,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:814,9--21 +#: src/app/learnocaml_index_main.ml:1040,9--21 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:817,9--25 +#: src/app/learnocaml_index_main.ml:1043,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:820,9--25 +#: src/app/learnocaml_index_main.ml:1046,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:821,9--17 +#: src/app/learnocaml_index_main.ml:1047,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:822,9--36 +#: src/app/learnocaml_index_main.ml:1048,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:828,38--44 +#: src/app/learnocaml_index_main.ml:1054,38--44 msgid "Menu" msgstr "Menu" -#: src/app/learnocaml_teacher_tab.ml:73,20--35 +#: src/app/learnocaml_teacher_tab.ml:74,20--35 msgid "TEACHER TOKEN" msgstr "TOKEN PROF." -#: src/app/learnocaml_teacher_tab.ml:74,26--105 +#: src/app/learnocaml_teacher_tab.ml:75,26--105 msgid "" "New teacher token created:\n" "%s\n" @@ -692,184 +742,276 @@ msgstr "" "\n" "Notez-le !" -#: src/app/learnocaml_teacher_tab.ml:255,48--54 +#: src/app/learnocaml_teacher_tab.ml:256,48--54 msgid "Open" msgstr "Ouvert" -#: src/app/learnocaml_teacher_tab.ml:256,52--60 +#: src/app/learnocaml_teacher_tab.ml:257,52--60 msgid "Closed" msgstr "Fermé" -#: src/app/learnocaml_teacher_tab.ml:257,58--68 -#: src/app/learnocaml_teacher_tab.ml:258,42--52 +#: src/app/learnocaml_teacher_tab.ml:258,58--68 +#: src/app/learnocaml_teacher_tab.ml:259,42--52 msgid "Assigned" msgstr "Devoir" -#: src/app/learnocaml_teacher_tab.ml:318,52--64 -#: src/app/learnocaml_teacher_tab.ml:338,51--63 +#: src/app/learnocaml_teacher_tab.ml:319,49--61 +#: src/app/learnocaml_teacher_tab.ml:339,48--60 msgid "Loading..." msgstr "Chargement..." -#: src/app/learnocaml_teacher_tab.ml:392,20--41 +#: src/app/learnocaml_teacher_tab.ml:393,17--38 msgid "any future students" msgstr "tout nouvel étudiant" -#: src/app/learnocaml_teacher_tab.ml:540,21--31 +#: src/app/learnocaml_teacher_tab.ml:541,18--28 msgid "Students" msgstr "Étudiants" -#: src/app/learnocaml_teacher_tab.ml:550,23--32 +#: src/app/learnocaml_teacher_tab.ml:551,20--29 msgid "Sort by" msgstr "Tri par" -#: src/app/learnocaml_teacher_tab.ml:558,25--32 -msgid "Token" -msgstr "Token" - -#: src/app/learnocaml_teacher_tab.ml:560,25--40 +#: src/app/learnocaml_teacher_tab.ml:561,22--37 msgid "Creation date" msgstr "Date d'entrée" -#: src/app/learnocaml_teacher_tab.ml:562,25--31 +#: src/app/learnocaml_teacher_tab.ml:563,22--28 msgid "Tags" msgstr "Tags" -#: src/app/learnocaml_teacher_tab.ml:567,46--52 +#: src/app/learnocaml_teacher_tab.ml:568,46--52 msgid "tags" msgstr "tags" -#: src/app/learnocaml_teacher_tab.ml:643,16--28 +#: src/app/learnocaml_teacher_tab.ml:644,16--28 msgid "1 exercise" msgstr "1 exercice" -#: src/app/learnocaml_teacher_tab.ml:644,32--46 +#: src/app/learnocaml_teacher_tab.ml:645,32--46 msgid "%d exercises" msgstr "%d exercices" -#: src/app/learnocaml_teacher_tab.ml:647,23--34 +#: src/app/learnocaml_teacher_tab.ml:648,23--34 msgid "1 student" msgstr "1 étudiant" -#: src/app/learnocaml_teacher_tab.ml:648,39--52 +#: src/app/learnocaml_teacher_tab.ml:649,39--52 msgid "%d students" msgstr "%d étudiants" -#: src/app/learnocaml_teacher_tab.ml:649,38--52 +#: src/app/learnocaml_teacher_tab.ml:650,38--52 msgid "%d+ students" msgstr "%d+ étudiants" -#: src/app/learnocaml_teacher_tab.ml:716,48--64 +#: src/app/learnocaml_teacher_tab.ml:717,45--61 msgid "New assignment" msgstr "Nouveau devoir" -#: src/app/learnocaml_teacher_tab.ml:819,19--31 +#: src/app/learnocaml_teacher_tab.ml:820,16--28 msgid "Open/Close" msgstr "Ouvrir/Fermer" -#: src/app/learnocaml_teacher_tab.ml:825,47--64 +#: src/app/learnocaml_teacher_tab.ml:826,47--64 msgid "required skills" msgstr "comp. requises" -#: src/app/learnocaml_teacher_tab.ml:829,47--63 +#: src/app/learnocaml_teacher_tab.ml:830,47--63 msgid "trained skills" msgstr "comp. travaillées" -#: src/app/learnocaml_teacher_tab.ml:838,39--52 +#: src/app/learnocaml_teacher_tab.ml:839,36--49 msgid "Assignments" msgstr "Devoirs" -#: src/app/learnocaml_teacher_tab.ml:921,21--28 +#: src/app/learnocaml_teacher_tab.ml:922,18--25 msgid "Apply" msgstr "Appliquer" -#: src/app/learnocaml_teacher_tab.ml:922,57--66 +#: src/app/learnocaml_teacher_tab.ml:923,54--63 msgid "Actions" msgstr "Actions" -#: src/app/learnocaml_teacher_tab.ml:925,26--52 +#: src/app/learnocaml_teacher_tab.ml:926,23--49 msgid "Create new teacher token" msgstr "Créer un nouveau token enseignant" -#: src/app/learnocaml_teacher_tab.ml:927,26--56 +#: src/app/learnocaml_teacher_tab.ml:928,23--53 msgid "Download student data as CSV" msgstr "Exporter les données étudiants en CSV" -#: src/app/learnocaml_teacher_tab.ml:1099,58--75 +#: src/app/learnocaml_teacher_tab.ml:1100,55--72 msgid "Unsaved changes" msgstr "Modifications non sauvegardées" -#: src/app/learnocaml_student_view.ml:211,27--57 +#: src/app/learnocaml_reset_main.ml:20,29--45 +msgid "Reset password" +msgstr "Réinitialiser le mot de passe" + +#: src/app/learnocaml_reset_main.ml:21,27--41 +msgid "New password" +msgstr "Nouveau mot de passe" + +#: src/app/learnocaml_reset_main.ml:22,23--31 +msgid "Submit" +msgstr "Envoyer" + +#: src/app/learnocaml_student_view.ml:212,24--54 msgid "Future assignment (starting " msgstr "Devoir à venir (à partir du " -#: src/app/learnocaml_student_view.ml:215,27--52 +#: src/app/learnocaml_student_view.ml:216,24--49 msgid "Terminated assignment (" msgstr "Devoir terminé (" -#: src/app/learnocaml_student_view.ml:219,27--53 +#: src/app/learnocaml_student_view.ml:220,24--50 msgid "Ongoing assignment (due " msgstr "Devoir en cours (à rendre le " -#: src/app/learnocaml_student_view.ml:223,27--43 +#: src/app/learnocaml_student_view.ml:224,24--40 msgid "Open exercises" msgstr "Exercices ouverts" -#: src/app/learnocaml_student_view.ml:304,22--37 +#: src/app/learnocaml_student_view.ml:305,19--34 msgid "Student stats" msgstr "Statistiques de l'étudiant" -#: src/app/learnocaml_student_view.ml:307,16--28 +#: src/app/learnocaml_student_view.ml:308,16--28 msgid "completion" msgstr "complétion" -#: src/app/learnocaml_student_view.ml:308,13--62 +#: src/app/learnocaml_student_view.ml:309,13--62 msgid "The average grade over all accessible exercises" msgstr "Note moyenne sur tous les exercices accessibles" -#: src/app/learnocaml_student_view.ml:310,16--27 +#: src/app/learnocaml_student_view.ml:311,16--27 msgid "attempted" msgstr "commencés" -#: src/app/learnocaml_student_view.ml:311,13--74 +#: src/app/learnocaml_student_view.ml:312,13--74 msgid "The amount of accessible exercises that have been attempted" msgstr "La proportion d'exercices accessibles qui ont été commencés" -#: src/app/learnocaml_student_view.ml:313,16--25 +#: src/app/learnocaml_student_view.ml:314,16--25 msgid "success" msgstr "réussite" -#: src/app/learnocaml_student_view.ml:314,13--57 +#: src/app/learnocaml_student_view.ml:315,13--57 msgid "The average grade over attempted exercises" msgstr "La note moyenne sur les exercices commencés" -#: src/app/learnocaml_student_view.ml:320,28--68 +#: src/app/learnocaml_student_view.ml:321,25--65 msgid "success over exercises training skills" msgstr "moyenne sur les exercices entraînant les compétences" -#: src/app/learnocaml_student_view.ml:324,19--59 +#: src/app/learnocaml_student_view.ml:325,19--59 msgid "Success over exercises training skill " msgstr "Moyenne sur les exercices entraînant la compétence " -#: src/app/learnocaml_student_view.ml:334,28--69 +#: src/app/learnocaml_student_view.ml:335,25--66 msgid "success over exercises requiring skills" msgstr "moyenne sur les exercices requérant les compétences" -#: src/app/learnocaml_student_view.ml:338,19--60 +#: src/app/learnocaml_student_view.ml:339,19--60 msgid "Success over exercises requiring skill " msgstr "Moyenne sur les exercices requérant la compétence " -#: src/app/learnocaml_student_view.ml:441,29--70 +#: src/app/learnocaml_student_view.ml:442,26--67 msgid "GRADE DOESN'T MATCH: cheating suspected" msgstr "NOTE INCOHÉRENTE: suspicion de triche" -#: src/app/learnocaml_student_view.ml:445,28--49 +#: src/app/learnocaml_student_view.ml:446,25--46 msgid "No report available" msgstr "Aucun rapport" -#: src/app/learnocaml_student_view.ml:472,8--29 +#: src/app/learnocaml_student_view.ml:473,8--29 msgid "Status of student: " msgstr "Suivi étudiant: " +#: src/app/learnocaml_upgrade_main.ml:24,29--38 +#, fuzzy +msgid "Upgrade" +msgstr "Noter!" + +#: src/app/learnocaml_upgrade_main.ml:25,23--77 +msgid "An email will be sent to your address to confirm it." +msgstr "Un courriel sera envoyé à votre adresse pour la confirmer." + +#: src/app/learnocaml_upgrade_main.ml:28,38--48 +msgid "NO TOKEN" +msgstr "PAS DE TOKEN" + +#: src/app/learnocaml_upgrade_main.ml:28,53--76 +msgid "You are not logged in" +msgstr "Vous n'êtes pas connecté" + +#: src/app/learnocaml_validate_main.ml:13,18--35 +msgid "EMAIL CONFIRMED" +msgstr "ADRESSE EMAIL CONFIRMÉE" + +#: src/app/learnocaml_validate_main.ml:13,40--79 +msgid "Your email address has been confirmed" +msgstr "Votre adresse email a été confirmée" + +#: src/grader/learnocaml_report.ml:240,50--66 +#: src/grader/learnocaml_report.ml:595,59--75 +msgid "(minimum mark)" +msgstr "(note minimale)" + +#: src/grader/learnocaml_report.ml:250,55--74 +msgid "Completed, %d pts" +msgstr "Terminé, %d pts" + +#: src/grader/learnocaml_report.ml:254,38--46 +#: src/grader/learnocaml_report.ml:258,67--75 +msgid "Failed" +msgstr "Échoué" + +#: src/grader/learnocaml_report.ml:262,55--75 +msgid "Incomplete, %d pts" +msgstr "Incomplet, %d pts" + +#: src/grader/learnocaml_report.ml:287,26--43 +msgid "Exercise failed" +msgstr "Exercice échoué" + +#: src/grader/learnocaml_report.ml:289,31--37 +msgid "0 pt" +msgstr "0 pt" + +#: src/grader/learnocaml_report.ml:291,26--45 +msgid "Exercise complete" +msgstr "Exercice terminé" + +#: src/grader/learnocaml_report.ml:293,49--57 +#: src/grader/learnocaml_report.ml:297,49--57 +msgid "%d pts" +msgstr "%d pts" + +#: src/grader/learnocaml_report.ml:295,26--47 +msgid "Exercise incomplete" +msgstr "Exercice incomplet" + +#: src/grader/learnocaml_report.ml:563,56--78 +msgid "@[Failure: %a@]" +msgstr "@[Échec: %a@]" + +#: src/grader/learnocaml_report.ml:564,56--78 +msgid "@[Warning: %a@]" +msgstr "@[Avertissement: %a@]" + +#: src/grader/learnocaml_report.ml:566,58--82 +msgid "@[Important: %a@]" +msgstr "@[Important: %a@]" + +#: src/grader/learnocaml_report.ml:567,58--83 +msgid "@[Success %d: %a@]" +msgstr "@[Réussite %d: %a@]" + +#: src/grader/learnocaml_report.ml:568,58--83 +msgid "@[Penalty %d: %a@]" +msgstr "@[Pénalité %d: %a@]" + #: src/grader/grading.ml:16,27--66 msgid "" "Exercise definition error %s:\n" @@ -929,18 +1071,21 @@ msgstr "Préparation du lancement des tests." msgid "Launching the test bench." msgstr "Lancement du banc de test." -#: src/grader/grading.ml:145,38--67 +#: src/grader/grading.ml:173,45--78 +msgid "while loading user dependencies" +msgstr "lors du chargement des dépendances" + +#: src/grader/grading.ml:189,38--67 msgid "while testing your solution" msgstr "lors du test de la solution utilisateur" -#: src/grader/grading.ml:173,43--80 -msgid "while loading user dependencies" -msgstr "lors du chargement des dépendances" +#~ msgid "Enter your token" +#~ msgstr "Entrez votre token" -msgid "Failed to download archive. Please try again later!" -msgstr "" -"Le téléchargement de l'archive a échoué. Veuillez réessayer " -"ulterieurement!" +#~ msgid "Failed to download archive. Please try again later!" +#~ msgstr "" +#~ "Le téléchargement de l'archive a échoué. Veuillez réessayer " +#~ "ulterieurement!" #~ msgid "No description available." #~ msgstr "Aucune description." From 630d7edadad030d1c1daca6933553957c4c702f9 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 31 Jul 2020 16:04:07 +0200 Subject: [PATCH 060/161] doc: first draft for the password and LTI modes Signed-off-by: Alban Gruin --- docs/howto-deploy-a-learn-ocaml-instance.md | 26 +++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/docs/howto-deploy-a-learn-ocaml-instance.md b/docs/howto-deploy-a-learn-ocaml-instance.md index a2a190a45..4577fab6b 100644 --- a/docs/howto-deploy-a-learn-ocaml-instance.md +++ b/docs/howto-deploy-a-learn-ocaml-instance.md @@ -68,3 +68,29 @@ make && make opaminstall ``` learn-ocaml serve --port 8080 ``` + +## Enabling passwords + +By default, authentication is performed with a token instead of a more +traditionnal email/password pair, but this can now be enabled by +setting the `use_passwd` option to `true` (by default, it is set to +`false`). + +## Integration with Moodle and other teaching tools + +If you enabled passwords, you can also enable LTI, enabling to login +in Learn-OCaml from Moodle and other teaching tools. + +> *Warning* +> +> Passwords must be enabled to use the LTI integration. + +The option `use_moodle` must be set to `true` in the config file (by +default, it is set to `false`). When running `learn-ocaml build`, +Learn-OCaml generate a private key for LTI authentication if there is +none yet, and print it to the standard output. + +This key can be then inserted as the secret in the LTI-compatible +application (eg. Moodle). You can set any value you want as the +consumer key, but take care to not reuse the value between multiple +applications. From a219669d660a4be3181f6da3faed1a0a13d105c9 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Fri, 31 Jul 2020 17:06:26 +0200 Subject: [PATCH 061/161] learnocaml_index_main: allow user to cancel the change email dialog Signed-off-by: Alban Gruin --- src/app/learnocaml_common.ml | 17 ++++++++++------- src/app/learnocaml_common.mli | 1 + src/app/learnocaml_index_main.ml | 15 +++++++++------ src/app/learnocaml_teacher_tab.ml | 2 +- 4 files changed, 21 insertions(+), 14 deletions(-) diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index bd9c10aff..94aca5941 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -141,16 +141,19 @@ let confirm ~title ?(ok_label=[%i"OK"]) ?(cancel_label=[%i"Cancel"]) contents f close_button cancel_label; ] -let ask_string ~title ?(ok_label=[%i"OK"]) contents = +let ask_string ~title ?(ok_label=[%i"OK"]) ?(cancel_label=Some [%i"Cancel"]) contents = let input_field = H.input ~a:[ H.a_input_type `Text; ] () in let result_t, up = Lwt.wait () in - ext_alert ~title (contents @ [input_field]) ~buttons:[ - box_button ok_label (fun () -> Lwt.wakeup up @@ Manip.value input_field) - ]; + let buttons = + box_button ok_label (fun () -> Lwt.wakeup up @@ Manip.value input_field) :: + match cancel_label with + | Some label -> [box_button label (fun () -> Lwt.fail_with "Cancelled by user")] + | _ -> [] in + ext_alert ~title (contents @ [input_field]) ~buttons; result_t let default_exn_printer = function @@ -979,7 +982,7 @@ let setup_prelude_pane ace prelude = (fun _ -> state := not !state ; update () ; true) ; Manip.appendChildren prelude_pane [ prelude_title ; prelude_container ] - + let get_token ?(has_server = true) () = if not has_server then Lwt.return None @@ -990,7 +993,7 @@ let get_token ?(has_server = true) () = with Not_found -> retrieve (Learnocaml_api.Nonce ()) >>= fun nonce -> - ask_string ~title:"Secret" + ask_string ~title:"Secret" ~cancel_label:None [H.txt [%i"Enter the secret"]] >>= fun secret -> retrieve @@ -998,7 +1001,7 @@ let get_token ?(has_server = true) () = >|= fun token -> Learnocaml_local_storage.(store sync_token) token; Some token - + module Display_exercise = functor ( Q: sig diff --git a/src/app/learnocaml_common.mli b/src/app/learnocaml_common.mli index 275f2c8cf..25f63c4fa 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -44,6 +44,7 @@ val confirm : val ask_string : title: string -> ?ok_label: string -> + ?cancel_label: string option -> [< Html_types.div_content > `Input] Tyxml_js.Html.elt list -> string Lwt.t diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index afcdeb7d9..2a65db0d0 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -885,12 +885,15 @@ let () = Learnocaml_local_storage.(retrieve sync_token)) >>= complete_reset_password change_password in let rec change_email () = - ask_string ~title:[%i"New email address"] - [H.txt [%i"Enter your new email address: "]] >>= fun address -> - Server_caller.request - (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), - address)) - >>= complete_reset_password change_email in + Lwt.catch + (fun () -> + ask_string ~title:[%i"New email address"] + [H.txt [%i"Enter your new email address: "]] >>= fun address -> + Server_caller.request + (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), + address)) + >>= complete_reset_password change_email) + (fun _exn -> Lwt.return_none) in let buttons = [[%i"Change password"], change_password; [%i"Change email"], change_email] in let container = El.op_buttons_container in diff --git a/src/app/learnocaml_teacher_tab.ml b/src/app/learnocaml_teacher_tab.ml index db47f5eaa..b7c0d7f6e 100644 --- a/src/app/learnocaml_teacher_tab.ml +++ b/src/app/learnocaml_teacher_tab.ml @@ -210,7 +210,7 @@ let rec teacher_tab token _select _params () = in let open_partition_ () = Lwt.async (fun () -> - ask_string ~title:"Choose a function name" + ask_string ~title:"Choose a function name" ~cancel_label:None [H.txt @@ "Choose a function name to partition codes from "^ id ^": "] >|= fun funname -> let _win = From d622ef6c99ac7d926d683f13ff6d5131343fd06d Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Fri, 31 Jul 2020 16:49:46 +0200 Subject: [PATCH 062/161] feat: Add support for sendmail Rely on: * the ocamlnet netstring library (CLI wrapper) * the msmtp Alpine package (Mail Submission Agent) * a Dockerized SMTP relay (e.g., based on postfix) that is available at hostname $SMTPSERVER. Two extra variables are read by OCaml: * $EMAIL (the From: address) * $FROM_DOMAIN (learn-ocaml's hostname, i.e., .) --- Dockerfile | 2 +- src/utils/dune | 2 +- src/utils/learnocaml_sendmail.ml | 115 ++++++++++++++++++++++++++++--- 3 files changed, 108 insertions(+), 11 deletions(-) diff --git a/Dockerfile b/Dockerfile index 14849b93e..3d1a50ced 100644 --- a/Dockerfile +++ b/Dockerfile @@ -77,7 +77,7 @@ LABEL org.label-schema.build-date="${BUILD_DATE}" \ org.label-schema.schema-version="1.0" RUN apk update \ - && apk add ncurses-libs libev gmp dumb-init git \ + && apk add ncurses-libs libev gmp dumb-init msmtp git \ && addgroup learn-ocaml \ && adduser learn-ocaml -DG learn-ocaml diff --git a/src/utils/dune b/src/utils/dune index 1cb96addd..5ba9f5bfc 100644 --- a/src/utils/dune +++ b/src/utils/dune @@ -61,6 +61,6 @@ (name learnocaml_sendmail) (wrapped false) (flags :standard -warn-error A-4-42-44-45-48) - (libraries netclient) + (libraries threads netstring) (modules learnocaml_sendmail) ) diff --git a/src/utils/learnocaml_sendmail.ml b/src/utils/learnocaml_sendmail.ml index 193b02e90..e23807c1f 100644 --- a/src/utils/learnocaml_sendmail.ml +++ b/src/utils/learnocaml_sendmail.ml @@ -7,17 +7,114 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -(* open Netsendmail *) +let smtp_enabled_returnpath_email = + match Sys.getenv_opt "SMTPSERVER" with + | None -> None + | Some _ -> + match Sys.getenv_opt "EMAIL" with + | None -> None + | Some email -> Some email -(* let mailer = "/usr/lib/sendmail" *) -(* TODO: specify the SMTP relay hostname (SMTPHOST) *) +(* Don't use /usr/sbin/sendmail but msmtp *) -let confirm_email ~(url:string) email = - let () = Printf.printf "[confirm_email]\nTo: %s (%s)\n%!" email url in () +let mailer = "/usr/bin/msmtp" ^ + begin match Sys.getenv_opt "FROM_DOMAIN" with + | Some domain -> " --domain " ^ domain + | None -> "" + end + +open Netsendmail + +(* todo: replace to_name with the Nickname *) +let send_email + ?(from_name="Learn-OCaml") ?(to_name="") + ~to_addr ~subject ?(pretext="") ~text (url:string) = + match smtp_enabled_returnpath_email with + | Some returnpath_email -> + let str = pretext ^ Format.sprintf text url in + let body = wrap_attachment + ~content_disposition:("inline", []) + ~content_type: ("text/plain", + ["charset", Netmime_string.mk_param "utf-8"]) + (new Netmime.memory_mime_body str) in + let mail = wrap_mail + (* REM: as Netsendmail doesn't support Reply-To, we use From *) + ~from_addr: (from_name, returnpath_email) + ~to_addrs: [(to_name, to_addr)] + ~subject + body in + sendmail ~mailer ~crlf:false mail + | None -> Printf.printf "mailto:%s?subject=%s (%s)\n%!" to_addr subject url + +(* If need be +let check_email email = + try match Netaddress.parse email with + | [`Mailbox _] (* a single mail *) -> () + | _ -> invalid_arg "check_email: no single email" + with + | Netaddress.Parse_error (_i, str) -> invalid_arg ("check_email: " ^ str) + *) + +let confirm_text : (string -> string, unit, string) format = + {|Hello, + +Please follow the link below to confirm your e-mail address: + +%s + +The Learn-OCaml server.|} + +let change_common : (string -> string -> string, unit, string) format = + {|Hello, + +You requested to change your e-mail address on the server. +Old address: %s +New address: %s +|} + +let change_old : (string -> string, unit, string) format = + {| +An e-mail has been sent to the new address for you to confirm it. +Please check your corresponding mailbox (%s). + +The Learn-OCaml server.|} + +let change_new : (string -> string, unit, string) format = + {| +Please follow the link below to confirm this change: + +%s + +The Learn-OCaml server.|} + +let reset_text : (string -> string, unit, string) format = + {|Hello, + +Someone (probably you) requested changing your Learn-OCaml password. + +Please follow the following link to do so: + +%s + +Otherwise, no further action is required. + +The Learn-OCaml server.|} + +let confirm_email ~(url:string) to_addr = + send_email ~to_addr ~subject:"Confirm your e-mail address" + ~text:confirm_text url let change_email ~(url:string) old_email new_email = - let () = Printf.printf "[change_email]\nNew: %s (%s)\n%!" new_email url in - let () = Printf.printf "Old: %s\n%!" old_email in () + let () = send_email ~to_addr:new_email + ~subject:"Confirm your new e-mail address" + ~pretext:(Printf.sprintf change_common old_email new_email) + ~text:change_new url in + let () = send_email ~to_addr:old_email + ~subject:"Changing your e-mail address" + ~pretext:(Printf.sprintf change_common old_email new_email) + ~text:change_old new_email in + () -let reset_password ~(url:string) email = - let () = Printf.printf "[reset_password]\nTo: %s (%s)\n%!" email url in () +let reset_password ~(url:string) to_addr = + send_email ~to_addr ~subject:"Change your password" + ~text:reset_text url From 48485ab4cff71370c603f873c6870ceccb0af3c3 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Fri, 31 Jul 2020 17:24:58 +0200 Subject: [PATCH 063/161] feat: Add docker-compose.dev.yml file to test the sendmail feature --- docker-compose.dev.yml | 60 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 60 insertions(+) create mode 100644 docker-compose.dev.yml diff --git a/docker-compose.dev.yml b/docker-compose.dev.yml new file mode 100644 index 000000000..c71990133 --- /dev/null +++ b/docker-compose.dev.yml @@ -0,0 +1,60 @@ +version: '3.7' + +services: + learnocaml: + container_name: backend + # image: ocamlsf/learn-ocaml:0.13 + build: . + ports: + - '8080:8080' + environment: + # (ocaml variable) .: + FROM_DOMAIN: "backend.localdomain" + # (alpine msmtp variable) hostname of the SMTP server: + SMTPSERVER: "maildev" + # SMTPSERVER: "postfix" + # (ocaml + alpine msmtp variable) Reply-To = Return-Path: + EMAIL: "noreply@example.com" + depends_on: + - maildev + # - postfix + volumes: + - ./demo-repository:/repository:ro + - ./sync:/sync + networks: + - learnocaml-net + restart: unless-stopped + networks: + - learnocaml-net + +# To uncomment for prod +# postfix: +# # container_name: postfix +# image: juanluisbaptiste/postfix +# environment: +# # (postfix variables) remote MTA credentials: +# SMTP_SERVER: "smtp.example.com" +# SMTP_USERNAME: "user@example.com" +# SMTP_PASSWORD_FILE: "/secrets/smtp_password" +# # (postfix variable) DNS of myself, the server sending mails: +# SERVER_HOSTNAME: "mail.localdomain" +# volumes: +# - "./secrets:/secrets" +# # DO NOT EXPOSE THESE PORTS! +# # ports: +# # - "25:25" +# networks: +# - learnocaml-net + + # Only useful for dev + maildev: + image: maildev/maildev + ports: + - "1080:80" + networks: + - learnocaml-net + +networks: + learnocaml-net: + driver: bridge + name: localdomain From 896b6093ca32725a96159cafa4bb40eb8145e58b Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 26 Aug 2020 11:07:48 +0200 Subject: [PATCH 064/161] Set ALWAYS_ADD_MISSING_HEADERS := yes (given ocamlnet.Netsendmail does not include the "Message-ID:" header) --- docker-compose.dev.yml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/docker-compose.dev.yml b/docker-compose.dev.yml index c71990133..5114cdcf2 100644 --- a/docker-compose.dev.yml +++ b/docker-compose.dev.yml @@ -29,7 +29,7 @@ services: # To uncomment for prod # postfix: -# # container_name: postfix +# container_name: postfix # image: juanluisbaptiste/postfix # environment: # # (postfix variables) remote MTA credentials: @@ -38,6 +38,7 @@ services: # SMTP_PASSWORD_FILE: "/secrets/smtp_password" # # (postfix variable) DNS of myself, the server sending mails: # SERVER_HOSTNAME: "mail.localdomain" +# ALWAYS_ADD_MISSING_HEADERS: "yes" # volumes: # - "./secrets:/secrets" # # DO NOT EXPOSE THESE PORTS! From 1131d5983cc0599b48f3fed724db471c22b5d072 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 26 Aug 2020 13:53:36 +0200 Subject: [PATCH 065/161] docs: Add hyperlink to docker-compose.yml template --- docker-compose.dev.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/docker-compose.dev.yml b/docker-compose.dev.yml index 5114cdcf2..d7594f786 100644 --- a/docker-compose.dev.yml +++ b/docker-compose.dev.yml @@ -27,7 +27,9 @@ services: networks: - learnocaml-net -# To uncomment for prod +# To uncomment for prod, see also: +# https://github.com/pfitaxel/docker-learn-ocaml/blob/master/docker-compose.yml +# # postfix: # container_name: postfix # image: juanluisbaptiste/postfix From adc9729a2a4a8a88adca860fb60a3f0d3304017a Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 26 Aug 2020 14:35:04 +0200 Subject: [PATCH 066/161] refactor: Rename file to docker-compose.yml --- docker-compose.dev.yml => docker-compose.yml | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename docker-compose.dev.yml => docker-compose.yml (100%) diff --git a/docker-compose.dev.yml b/docker-compose.yml similarity index 100% rename from docker-compose.dev.yml rename to docker-compose.yml From 474223f686d4db3d9488df3a5dbd8ed00328b877 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 26 Aug 2020 14:35:24 +0200 Subject: [PATCH 067/161] feat: Add Moodle containers in dev docker-compose.yml --- docker-compose.yml | 44 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 44 insertions(+) diff --git a/docker-compose.yml b/docker-compose.yml index d7594f786..f1fa65f8e 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -1,3 +1,7 @@ +# Note: this file is dev-specific. +# To deploy learn-ocaml, see e.g.: +# https://github.com/pfitaxel/docker-learn-ocaml/blob/master/docker-compose.yml + version: '3.7' services: @@ -57,6 +61,46 @@ services: networks: - learnocaml-net +# BEGIN https://github.com/bitnami/bitnami-docker-moodle/blob/ffa8007ebb0ebc501eeeba62804d10b0efef3673/docker-compose.yml + + mariadb: + image: 'docker.io/bitnami/mariadb:10.3-debian-10' + environment: + - ALLOW_EMPTY_PASSWORD=yes + - MARIADB_USER=bn_moodle + - MARIADB_DATABASE=bitnami_moodle + volumes: + - 'mariadb_data:/bitnami/mariadb' + moodle: + image: 'docker.io/bitnami/moodle:3-debian-10' + ports: + - '9090:8080' + # - '80:8080' + # - '443:8443' + environment: + - MOODLE_DATABASE_HOST=mariadb + - MOODLE_DATABASE_PORT_NUMBER=3306 + - MOODLE_DATABASE_USER=bn_moodle + - MOODLE_DATABASE_NAME=bitnami_moodle + - ALLOW_EMPTY_PASSWORD=yes + volumes: + - 'moodle_data:/bitnami/moodle' + - 'moodledata_data:/bitnami/moodledata' + depends_on: + - mariadb + +volumes: + mariadb_data: + driver: local + moodle_data: + driver: local + moodledata_data: + driver: local + +# END https://github.com/bitnami/bitnami-docker-moodle/blob/ffa8007ebb0ebc501eeeba62804d10b0efef3673/docker-compose.yml +# @ https://github.com/bitnami/bitnami-docker-moodle#readme +# @ https://github.com/bitnami/bitnami-docker-moodle#configuration + networks: learnocaml-net: driver: bridge From 86bb1b064e64d063d89dcbc129fd463d67a827c2 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 26 Aug 2020 20:09:31 +0200 Subject: [PATCH 068/161] feat: Add nickname in emails openings & Refactor Learnocaml_sendmail --- src/server/learnocaml_server.ml | 22 ++++- src/utils/learnocaml_sendmail.ml | 138 ++++++++++++++++-------------- src/utils/learnocaml_sendmail.mli | 18 ++-- 3 files changed, 105 insertions(+), 73 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index f4f568a55..b29c8c35d 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -213,14 +213,26 @@ let create_student conn (config: Learnocaml_data.Server.config) cache req Lwt.return (Token_index.Token (tok, use_moodle)) | `Password (email, password) -> Token_index.UpgradeIndex.change_email !sync_dir tok >|= (fun handle -> - Learnocaml_sendmail.confirm_email ~url:(req.Api.host ^ "/confirm/" ^ handle) email; + Learnocaml_sendmail.confirm_email + ~nick + ~url:(req.Api.host ^ "/confirm/" ^ handle) + email; Token_index.Password (tok, email, password, Some(email)))) >>= fun auth -> Token_index.UserIndex.add !sync_dir auth >>= fun () -> respond_json cache tok +(** [get_nickname] is used to show the user name in emails openings. + (Cost some filesystem read; we might want to always return None) *) +let get_nickname token = + Save.get token >>= function + | None -> Lwt.return_none + | Some save -> Lwt.return_some save.Save.nickname + let initiate_password_change token address cache req = Token_index.UpgradeIndex.reset_password !sync_dir token >>= fun handle -> + get_nickname token >>= fun nick -> Learnocaml_sendmail.reset_password + ~nick ~url:(req.Api.host ^ "/reset_password/" ^ handle) address; respond_json cache () @@ -678,7 +690,9 @@ module Request_handler = struct else Token_index.UserIndex.change_email !sync_dir token address >>= fun () -> Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> + get_nickname token >>= fun nick -> Learnocaml_sendmail.change_email + ~nick ~url:(req.Api.host ^ "/confirm/" ^ handle) old_address address; respond_json cache () @@ -822,7 +836,11 @@ module Request_handler = struct let cookies = make_cookie ("token", Token.to_string token) :: cookies in Token_index.UserIndex.upgrade !sync_dir token email passwd >>= fun () -> Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> - Learnocaml_sendmail.confirm_email ~url:(req.Api.host ^ "/confirm/" ^ handle) email; + get_nickname token >>= fun nick -> + Learnocaml_sendmail.confirm_email + ~nick + ~url:(req.Api.host ^ "/confirm/" ^ handle) + email; lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | Some _ -> lwt_fail (`Forbidden, "Already an account.")) diff --git a/src/utils/learnocaml_sendmail.ml b/src/utils/learnocaml_sendmail.ml index e23807c1f..67259f9bf 100644 --- a/src/utils/learnocaml_sendmail.ml +++ b/src/utils/learnocaml_sendmail.ml @@ -7,6 +7,8 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) +open Netsendmail + let smtp_enabled_returnpath_email = match Sys.getenv_opt "SMTPSERVER" with | None -> None @@ -23,50 +25,23 @@ let mailer = "/usr/bin/msmtp" ^ | None -> "" end -open Netsendmail - -(* todo: replace to_name with the Nickname *) -let send_email - ?(from_name="Learn-OCaml") ?(to_name="") - ~to_addr ~subject ?(pretext="") ~text (url:string) = - match smtp_enabled_returnpath_email with - | Some returnpath_email -> - let str = pretext ^ Format.sprintf text url in - let body = wrap_attachment - ~content_disposition:("inline", []) - ~content_type: ("text/plain", - ["charset", Netmime_string.mk_param "utf-8"]) - (new Netmime.memory_mime_body str) in - let mail = wrap_mail - (* REM: as Netsendmail doesn't support Reply-To, we use From *) - ~from_addr: (from_name, returnpath_email) - ~to_addrs: [(to_name, to_addr)] - ~subject - body in - sendmail ~mailer ~crlf:false mail - | None -> Printf.printf "mailto:%s?subject=%s (%s)\n%!" to_addr subject url - -(* If need be -let check_email email = - try match Netaddress.parse email with - | [`Mailbox _] (* a single mail *) -> () - | _ -> invalid_arg "check_email: no single email" - with - | Netaddress.Parse_error (_i, str) -> invalid_arg ("check_email: " ^ str) - *) - -let confirm_text : (string -> string, unit, string) format = - {|Hello, +let hello : (string -> string, unit, string) format = + {|Hello%s, +|} +let confirm : (string -> string, unit, string) format = + {| Please follow the link below to confirm your e-mail address: %s +|} -The Learn-OCaml server.|} +let confirm_subject = "Confirm your e-mail address" +let change_new_subject = "Confirm your new e-mail address" +let change_old_subject = "Changing your e-mail address" let change_common : (string -> string -> string, unit, string) format = - {|Hello, - + {| You requested to change your e-mail address on the server. Old address: %s New address: %s @@ -76,20 +51,17 @@ let change_old : (string -> string, unit, string) format = {| An e-mail has been sent to the new address for you to confirm it. Please check your corresponding mailbox (%s). - -The Learn-OCaml server.|} +|} let change_new : (string -> string, unit, string) format = {| Please follow the link below to confirm this change: %s +|} -The Learn-OCaml server.|} - -let reset_text : (string -> string, unit, string) format = - {|Hello, - +let reset : (string -> string, unit, string) format = + {| Someone (probably you) requested changing your Learn-OCaml password. Please follow the following link to do so: @@ -97,24 +69,66 @@ Please follow the following link to do so: %s Otherwise, no further action is required. +|} + +let reset_subject = "Change your password" +let closing : string = + {| The Learn-OCaml server.|} -let confirm_email ~(url:string) to_addr = - send_email ~to_addr ~subject:"Confirm your e-mail address" - ~text:confirm_text url - -let change_email ~(url:string) old_email new_email = - let () = send_email ~to_addr:new_email - ~subject:"Confirm your new e-mail address" - ~pretext:(Printf.sprintf change_common old_email new_email) - ~text:change_new url in - let () = send_email ~to_addr:old_email - ~subject:"Changing your e-mail address" - ~pretext:(Printf.sprintf change_common old_email new_email) - ~text:change_old new_email in - () - -let reset_password ~(url:string) to_addr = - send_email ~to_addr ~subject:"Change your password" - ~text:reset_text url +let send_email + ?(from_name="Learn-OCaml") + ~(nick : string option) ~to_addr ~subject + ?(hello=hello) ?(pretext="") ~text ?(posttext=closing) url = + let padding, nickname = + match nick with + | None -> "", "" + | Some nickname -> " ", nickname + in + match smtp_enabled_returnpath_email with + | Some returnpath_email -> + let str = Format.sprintf hello (padding ^ nickname) + ^ pretext + ^ Format.sprintf text url + ^ posttext in + let body = wrap_attachment + ~content_disposition:("inline", []) + ~content_type: ("text/plain", + ["charset", Netmime_string.mk_param "utf-8"]) + (new Netmime.memory_mime_body str) in + let mail = wrap_mail + (* REM: as Netsendmail doesn't support Reply-To, we use From *) + ~from_addr: (from_name, returnpath_email) + ~to_addrs: [(nickname, to_addr)] + ~subject + body in + sendmail ~mailer ~crlf:false mail + | None -> Printf.printf "mailto:%s?subject=%s (%s)\n%!" to_addr subject url + +(* If need be +let check_email email = + try match Netaddress.parse email with + | [`Mailbox _] (* a single mail *) -> () + | _ -> invalid_arg "check_email: no single email" + with + | Netaddress.Parse_error (_i, str) -> invalid_arg ("check_email: " ^ str) + *) + +let confirm_email ~(nick:string option) ~(url:string) to_addr = + send_email ~nick ~to_addr ~subject:confirm_subject + ~text:confirm url + +let change_email ~(nick:string option) ~(url:string) old_email new_email = + send_email ~nick ~to_addr:new_email + ~subject:change_new_subject + ~pretext:(Printf.sprintf change_common old_email new_email) + ~text:change_new url; + send_email ~nick ~to_addr:old_email + ~subject:change_old_subject + ~pretext:(Printf.sprintf change_common old_email new_email) + ~text:change_old new_email + +let reset_password ~(nick:string option) ~(url:string) to_addr = + send_email ~nick ~to_addr ~subject:reset_subject + ~text:reset url diff --git a/src/utils/learnocaml_sendmail.mli b/src/utils/learnocaml_sendmail.mli index 6b1dc88b5..988723d7e 100644 --- a/src/utils/learnocaml_sendmail.mli +++ b/src/utils/learnocaml_sendmail.mli @@ -6,14 +6,14 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -(** [confim_email ~url address] will send an email to confirm the user - indeed owns this email address, e.g., at account creation. *) -val confirm_email: url:string -> string -> unit +(** [confim_email ~nick ~url addr] will send an email to confirm that + the user indeed owns this email address, e.g., at account creation. *) +val confirm_email: nick:string option -> url:string -> string -> unit -(** [change_email ~url old new] will send 2 emails so (1) the user can - confirm it indeed owns the new email address, and (2) it receives - a message to the old email address, for informative purposes. *) -val change_email: url:string -> string -> string -> unit +(** [change_email ~nick ~url old new] will send 2 emails, so (1) the + user can confirm to indeed own the new email address and (2) the + old email account also receives a message for informative purposes. *) +val change_email: nick:string option -> url:string -> string -> string -> unit -(** [reset_password ~url email] helps users that forgot their password. *) -val reset_password: url:string -> string -> unit +(** [reset_password ~nick ~url addr] helps users change their password. *) +val reset_password: nick:string option -> url:string -> string -> unit From e3d4a254094a205d3408518d160eaebd76905db1 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 26 Aug 2020 22:00:55 +0200 Subject: [PATCH 069/161] feat: Switch to HTML5 emails (Content-Type: multipart/alternative) --- src/utils/learnocaml_sendmail.ml | 76 ++++++++++++++++++++++++++------ 1 file changed, 62 insertions(+), 14 deletions(-) diff --git a/src/utils/learnocaml_sendmail.ml b/src/utils/learnocaml_sendmail.ml index 67259f9bf..301ba5bb2 100644 --- a/src/utils/learnocaml_sendmail.ml +++ b/src/utils/learnocaml_sendmail.ml @@ -8,6 +8,7 @@ * included LICENSE file for details. *) open Netsendmail +(* href: https://gitlab.com/gerdstolpmann/lib-ocamlnet3/-/blob/master/code/src/netstring/netsendmail_tut.txt *) let smtp_enabled_returnpath_email = match Sys.getenv_opt "SMTPSERVER" with @@ -17,14 +18,16 @@ let smtp_enabled_returnpath_email = | None -> None | Some email -> Some email -(* Don't use /usr/sbin/sendmail but msmtp *) - +(* We don't use /usr/sbin/sendmail but msmtp (alpine package) *) let mailer = "/usr/bin/msmtp" ^ begin match Sys.getenv_opt "FROM_DOMAIN" with | Some domain -> " --domain " ^ domain | None -> "" end +(* XXX The following format strings must not contain unsafe HTML chars + ('<', '>', '"', '&'), as they are not escaped *) + let hello : (string -> string, unit, string) format = {|Hello%s, |} @@ -77,28 +80,73 @@ let closing : string = {| The Learn-OCaml server.|} +(***************************************************************) +(* Now the following helper strings & functions deal with HTML *) + +let encode_html_utf8 = + Netencoding.Html.encode + ~in_enc:`Enc_utf8 + ~out_enc:`Enc_utf8 + ~prefer_name:true + ~unsafe_chars:Netencoding.Html.unsafe_chars_html4 () + +(* If need be +let encode_url = Netencoding.Url.encode ~plus:false *) + +let link_format : (string -> string -> string, unit, string) format = + {|%s|} + +(* XXX The message language is hardcoded here: "en" *) +let html_format : (string -> string -> string, unit, string) format = + {| + +%s + +

%s

+ +|} + +let wrap_url url = + Format.sprintf link_format url (encode_html_utf8 url) + +let wrap_html ~title text = + let lines = Str.global_replace (Str.regexp "$") "
" text in + Format.sprintf html_format ((*encode_html_utf8*) title) lines + let send_email ?(from_name="Learn-OCaml") ~(nick : string option) ~to_addr ~subject ?(hello=hello) ?(pretext="") ~text ?(posttext=closing) url = let padding, nickname = match nick with - | None -> "", "" + | None | Some "" -> "", "" | Some nickname -> " ", nickname in match smtp_enabled_returnpath_email with | Some returnpath_email -> - let str = Format.sprintf hello (padding ^ nickname) - ^ pretext - ^ Format.sprintf text url - ^ posttext in - let body = wrap_attachment - ~content_disposition:("inline", []) - ~content_type: ("text/plain", - ["charset", Netmime_string.mk_param "utf-8"]) - (new Netmime.memory_mime_body str) in + let str_plain = Format.sprintf hello (padding ^ nickname) + ^ pretext + ^ Format.sprintf text url + ^ posttext in + let str_html = + wrap_html ~title:subject + (Format.sprintf hello (padding ^ nickname) + ^ pretext + ^ Format.sprintf text (wrap_url url) + ^ posttext) in + let charset = ["charset", Netmime_string.mk_param "utf-8"] in + let body = + (wrap_parts + ~content_type:("multipart/alternative", []) + [ wrap_attachment + ~content_type: ("text/plain", charset) + (new Netmime.memory_mime_body str_plain); + wrap_attachment + ~content_type: ("text/html", charset) + (new Netmime.memory_mime_body str_html) + ]) in let mail = wrap_mail - (* REM: as Netsendmail doesn't support Reply-To, we use From *) + (* XXX as Netsendmail doesn't support Reply-To, we use From *) ~from_addr: (from_name, returnpath_email) ~to_addrs: [(nickname, to_addr)] ~subject @@ -127,7 +175,7 @@ let change_email ~(nick:string option) ~(url:string) old_email new_email = send_email ~nick ~to_addr:old_email ~subject:change_old_subject ~pretext:(Printf.sprintf change_common old_email new_email) - ~text:change_old new_email + ~text:change_old ("mailto:" ^ new_email) let reset_password ~(nick:string option) ~(url:string) to_addr = send_email ~nick ~to_addr ~subject:reset_subject From df97f042dbfc08af02b3d7671e69d030d3b0e249 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 27 Aug 2020 00:00:31 +0200 Subject: [PATCH 070/161] refactor: s/Format/Printf/ & Improve log * Warn the admin if SMTPSERVER/EMAIL is unset & Dump the message text. * Don't print the unique URL in the log if SMTPSERVER & EMAIL are set. --- src/utils/learnocaml_sendmail.ml | 43 +++++++++++++++++++------------- 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/src/utils/learnocaml_sendmail.ml b/src/utils/learnocaml_sendmail.ml index 301ba5bb2..b02f78bcc 100644 --- a/src/utils/learnocaml_sendmail.ml +++ b/src/utils/learnocaml_sendmail.ml @@ -107,11 +107,11 @@ let html_format : (string -> string -> string, unit, string) format = |} let wrap_url url = - Format.sprintf link_format url (encode_html_utf8 url) + Printf.sprintf link_format url (encode_html_utf8 url) let wrap_html ~title text = let lines = Str.global_replace (Str.regexp "$") "
" text in - Format.sprintf html_format ((*encode_html_utf8*) title) lines + Printf.sprintf html_format ((*encode_html_utf8*) title) lines let send_email ?(from_name="Learn-OCaml") @@ -120,19 +120,18 @@ let send_email let padding, nickname = match nick with | None | Some "" -> "", "" - | Some nickname -> " ", nickname - in + | Some nickname -> " ", nickname in + let str_plain = Printf.sprintf hello (padding ^ nickname) + ^ pretext + ^ Printf.sprintf text url + ^ posttext in match smtp_enabled_returnpath_email with | Some returnpath_email -> - let str_plain = Format.sprintf hello (padding ^ nickname) - ^ pretext - ^ Format.sprintf text url - ^ posttext in let str_html = wrap_html ~title:subject - (Format.sprintf hello (padding ^ nickname) + (Printf.sprintf hello (padding ^ nickname) ^ pretext - ^ Format.sprintf text (wrap_url url) + ^ Printf.sprintf text (wrap_url url) ^ posttext) in let charset = ["charset", Netmime_string.mk_param "utf-8"] in let body = @@ -145,14 +144,22 @@ let send_email ~content_type: ("text/html", charset) (new Netmime.memory_mime_body str_html) ]) in - let mail = wrap_mail - (* XXX as Netsendmail doesn't support Reply-To, we use From *) - ~from_addr: (from_name, returnpath_email) - ~to_addrs: [(nickname, to_addr)] - ~subject - body in - sendmail ~mailer ~crlf:false mail - | None -> Printf.printf "mailto:%s?subject=%s (%s)\n%!" to_addr subject url + let mail = wrap_mail + (* XXX as Netsendmail doesn't support Reply-To, we use From *) + ~from_addr: (from_name, returnpath_email) + ~to_addrs: [(nickname, to_addr)] + ~subject + body in + sendmail ~mailer ~crlf:false mail; + Printf.printf {|(* INFO => mailto:%s?subject="%s" *) +%!|} to_addr subject + | None -> + Printf.printf {| +(* WARNING => environment variables SMTPSERVER and EMAIL must be set! +Can't mailto:%s?subject="%s" with body """ +%s +""" *) +%!|} to_addr subject str_plain (* If need be let check_email email = From c90259863bf7b649ec099ced35388bec3db24d85 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 27 Aug 2020 00:41:59 +0200 Subject: [PATCH 071/161] feat: Display the (new) email address on {password, email}-change --- src/app/learnocaml_index_main.ml | 26 +++++++++++++++++++++++--- src/server/learnocaml_server.ml | 2 +- src/state/learnocaml_api.ml | 16 +++++++++------- src/state/learnocaml_api.mli | 8 +++++--- 4 files changed, 38 insertions(+), 14 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 2a65db0d0..5b8f298fb 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -577,13 +577,33 @@ let show_token_dialog token = ] let complete_reset_password cb = function + | Ok email -> + alert ~title:[%i"RESET REQUEST SENT"] + ([%i"A reset link has been sent to the following address: "] + ^ email); + Lwt.return_none + | Error (`Not_found _) -> + alert ~title:[%i"USER NOT FOUND"] + [%i"The entered e-mail couldn't be recognised."]; + Lwt.return_none + | Error e -> + lwt_alert ~title:[%i"REQUEST ERROR"] [ + H.p [H.pcdata [%i"Could not retrieve data from server"]]; + H.code [H.pcdata (Server_caller.string_of_error e)]; + ] ~buttons:[ + [%i"Retry"], (fun () -> cb ()); + [%i"Cancel"], (fun () -> Lwt.return_none); + ] + +let complete_change_email cb new_email = function | Ok () -> alert ~title:[%i"RESET REQUEST SENT"] - [%i"A reset link has been sent to the specified address."]; + ([%i"A confirmation e-mail has been sent to the address: "] + ^ new_email); Lwt.return_none | Error (`Not_found _) -> alert ~title:[%i"USER NOT FOUND"] - [%i"The entered email couldn't be recognised."]; + [%i"The entered e-mail couldn't be recognised."]; Lwt.return_none | Error e -> lwt_alert ~title:[%i"REQUEST ERROR"] [ @@ -892,7 +912,7 @@ let () = Server_caller.request (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), address)) - >>= complete_reset_password change_email) + >>= complete_change_email change_email address) (fun _exn -> Lwt.return_none) in let buttons = [[%i"Change password"], change_password; [%i"Change email"], change_email] in diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index b29c8c35d..855fdb342 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -235,7 +235,7 @@ let initiate_password_change token address cache req = ~nick ~url:(req.Api.host ^ "/reset_password/" ^ handle) address; - respond_json cache () + respond_json cache address module Memory_cache = struct diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 6c45fcfa6..428ed06e3 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -82,10 +82,12 @@ type _ request = (Token.t * string) -> unit request | Confirm_email: string -> string request - | Send_reset_password: - string -> unit request | Change_password: - Token.t -> unit request + Token.t -> string request + (* change password and return the current email *) + | Send_reset_password: + string -> string request + (* idem (change password and return the current email) *) | Reset_password: string -> string request | Do_reset_password: @@ -191,8 +193,8 @@ module Conversions (Json: JSON_CODEC) = struct | Change_email _ -> json J.unit | Confirm_email _ -> str - | Send_reset_password _ -> json J.unit - | Change_password _ -> json J.unit + | Change_password _ -> str + | Send_reset_password _ -> str | Reset_password _ -> str | Do_reset_password _ -> str @@ -326,10 +328,10 @@ module Conversions (Json: JSON_CODEC) = struct post ~token ["change_email"] (Json.encode J.(tup1 string) address) | Confirm_email _ -> assert false (* Reserved for a link *) - | Send_reset_password address -> - post ["send_reset"] (Json.encode J.(tup1 string) address) | Change_password token -> get ~token ["send_reset"] + | Send_reset_password address -> + post ["send_reset"] (Json.encode J.(tup1 string) address) | Reset_password _ -> assert false (* Reserved for a link *) | Do_reset_password _ -> diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 1034cedee..751a8dfcb 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -101,10 +101,12 @@ type _ request = (Token.t * string) -> unit request | Confirm_email: string -> string request - | Send_reset_password: - string -> unit request | Change_password: - Token.t -> unit request + Token.t -> string request + (* change password and return the current email *) + | Send_reset_password: + string -> string request + (* idem (change password and return the current email) *) | Reset_password: string -> string request | Do_reset_password: From eb1f66926191792b07d6b6c489b651f6e70c64ed Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 27 Aug 2020 01:13:47 +0200 Subject: [PATCH 072/161] fix: Make strings uniform: s/email/e-mail/ * Translations should be updated later on though --- src/app/learnocaml_index_main.ml | 10 +++++----- src/app/learnocaml_lti_main.ml | 4 ++-- src/app/learnocaml_upgrade_main.ml | 4 ++-- src/app/learnocaml_validate_main.ml | 2 +- src/main/learnocaml_client.ml | 4 ++-- src/server/learnocaml_server.ml | 2 +- 6 files changed, 13 insertions(+), 13 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 5b8f298fb..c09fd188f 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -828,7 +828,7 @@ let set_string_translations () = "txt_token_secret", [%i"Enter the secret"]; "txt_token_new", [%i"Create new token"]; "txt_first_connection", [%i"First connection"]; - "txt_first_connection_email", [%i"Email address"]; + "txt_first_connection_email", [%i"E-mail address"]; "txt_first_connection_nickname", [%i"Nickname"]; "txt_first_connection_password", [%i"Password"]; "txt_first_connection_secret", [%i"Secret"]; @@ -836,7 +836,7 @@ let set_string_translations () = your teacher to sign-up."]; "txt_login_new", [%i"Create new token"]; "txt_returning", [%i"Returning user"]; - "txt_returning_email", [%i"Email address"]; + "txt_returning_email", [%i"E-mail address"]; "txt_returning_password", [%i"Password"]; "txt_login_returning", [%i"Connect"]; "txt_login_forgotten", [%i"Forgot your password?"]; @@ -907,15 +907,15 @@ let () = let rec change_email () = Lwt.catch (fun () -> - ask_string ~title:[%i"New email address"] - [H.txt [%i"Enter your new email address: "]] >>= fun address -> + ask_string ~title:[%i"New e-mail address"] + [H.txt [%i"Enter your new e-mail address: "]] >>= fun address -> Server_caller.request (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), address)) >>= complete_change_email change_email address) (fun _exn -> Lwt.return_none) in let buttons = [[%i"Change password"], change_password; - [%i"Change email"], change_email] in + [%i"Change e-mail"], change_email] in let container = El.op_buttons_container in Manip.removeChildren container; List.iter (fun (name, callback) -> diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 8e6d2d0df..66bd4c557 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -108,7 +108,7 @@ let () = init_dialogs (); set_string_translations [ "txt_first_connection", [%i"First connection"]; - "txt_first_connection_email", [%i"Email address"]; + "txt_first_connection_email", [%i"E-mail address"]; "txt_first_connection_nickname", [%i"Nickname"]; "txt_first_connection_password", [%i"Password"]; "txt_first_connection_secret", [%i"Enter the secret"]; @@ -119,7 +119,7 @@ let () = context of the Learn-OCaml plateform."]; "txt_login_new", [%i"Create new token"]; "txt_returning", [%i"Returning user"]; - "txt_returning_email", [%i"Email address"]; + "txt_returning_email", [%i"E-mail address"]; "txt_returning_password", [%i"Password"]; "txt_login_returning", [%i"Connect"]; "txt_login_forgotten", [%i"Forgot your password?"]; diff --git a/src/app/learnocaml_upgrade_main.ml b/src/app/learnocaml_upgrade_main.ml index 6c895bb43..520fe8658 100644 --- a/src/app/learnocaml_upgrade_main.ml +++ b/src/app/learnocaml_upgrade_main.ml @@ -19,10 +19,10 @@ let () = Manip.SetCss.display (find_component "login-overlay") "block"; set_string_translations [ "txt_upgrade", [%i"Upgrade account"]; - "txt_upgrade_email", [%i"Email address"]; + "txt_upgrade_email", [%i"E-mail address"]; "txt_upgrade_password", [%i"Password"]; "txt_do_upgrade", [%i"Upgrade"]; - "txt_info", [%i"An email will be sent to your address to confirm it."]; + "txt_info", [%i"An e-mail will be sent to your address to confirm it."]; ] with Not_found -> Learnocaml_common.alert ~title:[%i"NO TOKEN"] [%i"You are not logged in"] diff --git a/src/app/learnocaml_validate_main.ml b/src/app/learnocaml_validate_main.ml index e043aaec6..8bee16f62 100644 --- a/src/app/learnocaml_validate_main.ml +++ b/src/app/learnocaml_validate_main.ml @@ -10,4 +10,4 @@ open Learnocaml_common let () = (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); - alert ~title:[%i"EMAIL CONFIRMED"] [%i"Your email address has been confirmed"] + alert ~title:[%i"EMAIL CONFIRMED"] [%i"Your e-mail address has been confirmed."] diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index 82f15b86c..677eb5989 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -728,13 +728,13 @@ module Init_user = struct user_login server email password | {email; password; nickname=Some(nickname); secret=Some(secret)} -> if String.length email < 5 || not (String.contains email '@') then - Lwt.fail_with "Invalid email address" + Lwt.fail_with "Invalid e-mail address" else if String.length password < 8 then Lwt.fail_with "Password must be at least 8 characters long" else get_nonce_and_create_user server email password nickname secret | _ -> - Lwt.fail_with "You must provide an email address, a password, a nickname and a secret." + Lwt.fail_with "You must provide an e-mail address, a password, a nickname and a secret." in let get_server () = match global_args.server_url with diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 855fdb342..712aa6b32 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -443,7 +443,7 @@ module Request_handler = struct if exists then lwt_fail (`Forbidden, "User already exists") else if String.length email < 5 || not (String.contains email '@') then - lwt_fail (`Bad_request, "Invalid email address") + lwt_fail (`Bad_request, "Invalid e-mail address") else if String.length password < 8 then lwt_fail (`Bad_request, "Password must be at least 8 characters long") else From 5d531a5f4352d8162d94a5ef4056e3ce9202f29d Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 27 Aug 2020 01:19:05 +0200 Subject: [PATCH 073/161] docs: Rename some labels --- src/app/learnocaml_index_main.ml | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index c09fd188f..11decf69f 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -583,7 +583,7 @@ let complete_reset_password cb = function ^ email); Lwt.return_none | Error (`Not_found _) -> - alert ~title:[%i"USER NOT FOUND"] + alert ~title:[%i"ERROR"] [%i"The entered e-mail couldn't be recognised."]; Lwt.return_none | Error e -> @@ -602,7 +602,7 @@ let complete_change_email cb new_email = function ^ new_email); Lwt.return_none | Error (`Not_found _) -> - alert ~title:[%i"USER NOT FOUND"] + alert ~title:[%i"ERROR"] [%i"The entered e-mail couldn't be recognised."]; Lwt.return_none | Error e -> @@ -843,7 +843,7 @@ let set_string_translations () = "txt_first_connection_consent", [%i"By submitting this form, I accept that the \ information entered will be used in the \ context of the Learn-OCaml plateform."]; - "txt_returning_with_token", [%i"Login with a token"]; + "txt_returning_with_token", [%i"Login with a legacy token"]; "txt_returning_token", [%i"Token"]; "txt_token_returning", [%i"Connect"]; "txt_upgrade", [%i"Upgrade account"]; From f4d0a9d40e6d5cf7a52be55ce6d50249097b8503 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 27 Aug 2020 01:36:32 +0200 Subject: [PATCH 074/161] feat: Make the upgrade-button more visible --- static/index.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/static/index.html b/static/index.html index 5ad8cb2c8..1bb8fb5a8 100644 --- a/static/index.html +++ b/static/index.html @@ -49,7 +49,7 @@

Activities

- +
From 0296f6c7516f4c211a522d8528038eb05d62a6f4 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 27 Aug 2020 13:46:33 +0200 Subject: [PATCH 075/161] fix: Make email validation check more strict and uniform (a FIXME remains in app/learnocaml_index_main.ml though) --- src/app/learnocaml_index_main.ml | 32 +++++++++++++++++++++++++------- src/app/learnocaml_lti_main.ml | 6 +++++- src/main/learnocaml_client.ml | 6 +++++- src/server/learnocaml_server.ml | 8 ++++++-- src/state/learnocaml_data.ml | 10 ++++++++++ src/state/learnocaml_data.mli | 7 +++++++ 6 files changed, 58 insertions(+), 11 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 11decf69f..9b7c0e1a6 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -614,6 +614,21 @@ let complete_change_email cb new_email = function [%i"Cancel"], (fun () -> Lwt.return_none); ] +let check_email_js email = + let re = Regexp.regexp Learnocaml_data.email_regexp_js in + match Regexp.string_match re email 0 with + | Some _ -> true + | None -> false + +let validate_email email = + if check_email_js email then Lwt.return_some email + (* FIXME: the dialog does not show up *) + else begin + alert ~title:[%i"ERROR"] + ([%i"The entered e-mail is invalid: "] ^ email); + Lwt.return_none + end + let init_token_dialog () = let open El.Login_overlay in Manip.SetCss.display login_overlay "block"; @@ -653,8 +668,7 @@ let init_token_dialog () = password = Manip.value reg_input_password and consent = Manip.checked input_consent and consent_label = find_component "txt_first_connection_consent" in - (* 5 for a character, @, character, dot, character. *) - let email_criteria = String.length email < 5 || not (String.contains email '@') and + let email_criteria = not (check_email_js email) and passwd_criteria = String.length password < 8 in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; @@ -908,11 +922,15 @@ let () = Lwt.catch (fun () -> ask_string ~title:[%i"New e-mail address"] - [H.txt [%i"Enter your new e-mail address: "]] >>= fun address -> - Server_caller.request - (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), - address)) - >>= complete_change_email change_email address) + [H.txt [%i"Enter your new e-mail address: "]] + >>= validate_email + >>= function + | Some address -> + Server_caller.request + (Learnocaml_api.Change_email (Learnocaml_local_storage.(retrieve sync_token), + address)) + >>= complete_change_email change_email address + | None -> Lwt.return_none) (fun _exn -> Lwt.return_none) in let buttons = [[%i"Change password"], change_password; [%i"Change e-mail"], change_email] in diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 66bd4c557..cd5b10ed6 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -12,6 +12,10 @@ open Learnocaml_common module H = Tyxml_js.Html5 +let check_email_ml email = + let regexp = Str.regexp Learnocaml_data.email_regexp_ml in + Str.string_match regexp email 0 + let id s = s, find_component s let login_overlay_id, login_overlay = id "login-overlay" @@ -63,7 +67,7 @@ let create_token () = consent = Manip.checked input_consent and consent_label = find_component "txt_first_connection_consent" in (* 5 for a character, @, character, dot, character. *) - let email_criteria = String.length email < 5 || not (String.contains email '@') and + let email_criteria = not (check_email_ml email) and passwd_criteria = String.length password < 8 in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index 677eb5989..c6462eafc 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -15,6 +15,10 @@ open Arg let version = Api.version +let check_email_ml email = + let regexp = Str.regexp Learnocaml_data.email_regexp_ml in + Str.string_match regexp email 0 + let url_conv = conv ~docv:"URL" ( (fun s -> @@ -727,7 +731,7 @@ module Init_user = struct | {email; password; nickname=None; secret=None} -> user_login server email password | {email; password; nickname=Some(nickname); secret=Some(secret)} -> - if String.length email < 5 || not (String.contains email '@') then + if not (check_email_ml email) then Lwt.fail_with "Invalid e-mail address" else if String.length password < 8 then Lwt.fail_with "Password must be at least 8 characters long" diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 712aa6b32..96469d9f7 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -9,6 +9,10 @@ open Learnocaml_data open Learnocaml_store +let check_email_ml email = + let regexp = Str.regexp Learnocaml_data.email_regexp_ml in + Str.string_match regexp email 0 + let port = ref 8080 let cert_key_files = ref None @@ -442,7 +446,7 @@ module Request_handler = struct Token_index.UserIndex.exists !sync_dir email >>= fun exists -> if exists then lwt_fail (`Forbidden, "User already exists") - else if String.length email < 5 || not (String.contains email '@') then + else if not (check_email_ml email) then lwt_fail (`Bad_request, "Invalid e-mail address") else if String.length password < 8 then lwt_fail (`Bad_request, "Password must be at least 8 characters long") @@ -830,7 +834,7 @@ module Request_handler = struct let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and email = List.assoc "email" params and passwd = List.assoc "passwd" params in - if String.(length email < 5 || length passwd < 8 || not @@ contains email '@') then + if String.length passwd < 8 || not (check_email_ml email) then lwt_ok @@ Redirect { code=`See_other; url="/upgrade"; cookies } else let cookies = make_cookie ("token", Token.to_string token) :: cookies in diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index ad381a23a..6dd869b95 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -6,6 +6,16 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) +(* Regexp strings compatible with: + * https://ocsigen.org/js_of_ocaml/3.1.0/api/Regexp + * https://caml.inria.fr/pub/docs/manual-ocaml/libref/Str.html +(* inspired from https://www.w3.org/TR/html52/sec-forms.html#valid-e-mail-address *) + *) +let email_regexp_js = + "^[a-zA-Z0-9.+_~-]+@[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?(?:\\.[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?)+$" +let email_regexp_ml = + "^[a-zA-Z0-9.+_~-]+@[a-zA-Z0-9]\\([a-zA-Z0-9-]*[a-zA-Z0-9]\\)?\\(\\.[a-zA-Z0-9]\\([a-zA-Z0-9-]*[a-zA-Z0-9]\\)?\\)+$" + module J = Json_encoding module SMap = struct diff --git a/src/state/learnocaml_data.mli b/src/state/learnocaml_data.mli index a73083968..c115b8c16 100644 --- a/src/state/learnocaml_data.mli +++ b/src/state/learnocaml_data.mli @@ -6,6 +6,13 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) +(** Regexp strings compatible with: + * https://ocsigen.org/js_of_ocaml/3.1.0/api/Regexp + * https://caml.inria.fr/pub/docs/manual-ocaml/libref/Str.html + *) +val email_regexp_js : string +val email_regexp_ml : string + module SMap: sig include Map.S with type key = string From 81030915b8631dbb8c4d64756803d8142161b672 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Aug 2020 16:04:22 +0200 Subject: [PATCH 076/161] refactor: Uniformize message prefix in log --- src/server/learnocaml_server.ml | 8 ++++---- src/utils/learnocaml_sendmail.ml | 4 ++-- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 96469d9f7..76b0d0a24 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -959,11 +959,11 @@ let launch () = && not config.Learnocaml_data.Server.use_passwd then failwith "Cannot enable Moodle/LTI without enabling passwords." else if not config.Learnocaml_data.Server.use_passwd then - print_endline "You may want to enable passwords and LTI with the \ - config options `use_passwd' and `use_moodle'." + print_endline "[INFO] You may want to enable passwords and LTI \ + with the config options `use_passwd' and `use_moodle'." else if not config.Learnocaml_data.Server.use_moodle then - print_endline "You may want to enable LTI with the config option \ - `use_moodle'."; + print_endline "[INFO] You may want to enable LTI with the config \ + option `use_moodle'."; let callback conn req body = let uri = Request.uri req in let path = Uri.path uri in diff --git a/src/utils/learnocaml_sendmail.ml b/src/utils/learnocaml_sendmail.ml index b02f78bcc..54ecdb869 100644 --- a/src/utils/learnocaml_sendmail.ml +++ b/src/utils/learnocaml_sendmail.ml @@ -151,11 +151,11 @@ let send_email ~subject body in sendmail ~mailer ~crlf:false mail; - Printf.printf {|(* INFO => mailto:%s?subject="%s" *) + Printf.printf {|[INFO] mailto:%s?subject="%s" %!|} to_addr subject | None -> Printf.printf {| -(* WARNING => environment variables SMTPSERVER and EMAIL must be set! +[WARNING] Environment variables SMTPSERVER and EMAIL must be set! (* Can't mailto:%s?subject="%s" with body """ %s """ *) From fbf2d957ac58f320aab0b4af792a030d00005961 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Aug 2020 17:01:45 +0200 Subject: [PATCH 077/161] refactor: Split BaseUserIndex.upgrade in two functions * Avoids dummy arg (UserIndex.upgrade !sync_dir token "" passwd) * Allows for the upcoming invariant-hardening commit --- src/server/learnocaml_server.ml | 2 +- src/state/token_index.ml | 16 +++++++++++++--- src/state/token_index.mli | 6 ++++++ 3 files changed, 20 insertions(+), 4 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 76b0d0a24..70facc1bc 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -766,7 +766,7 @@ module Request_handler = struct if String.length passwd < 8 then lwt_ok @@ Redirect { code=`See_other; url="/reset_password/" ^ handle; cookies } else - Token_index.UserIndex.upgrade !sync_dir token "" passwd >>= fun () -> + Token_index.UserIndex.update !sync_dir token passwd >>= fun () -> Token_index.UpgradeIndex.revoke_operation !sync_dir handle >>= fun () -> lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | None -> diff --git a/src/state/token_index.ml b/src/state/token_index.ml index dfc8a513a..988328f53 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -354,18 +354,28 @@ module BaseUserIndex (RW: IndexRW) = struct Password (token, name, hash, verify_email) in RW.write rw (sync_dir / indexes_subdir / file) serialise (new_user :: users) - let upgrade sync_dir token name passwd = + let update sync_dir token passwd = get_data sync_dir >|= List.map (function | Token (found_token, _use_moodle) when found_token = token -> - let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in - Password (token, name, hash, Some(name)) + failwith "BaseUserIndex.update: invalid action" | Password (found_token, name, _passwd, verify) when found_token = token -> let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in Password (token, name, hash, verify) | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise + let upgrade sync_dir token name passwd = + get_data sync_dir >|= + List.map (function + | Token (found_token, _use_moodle) when found_token = token -> + let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in + Password (token, name, hash, Some(name)) + | Password (found_token, _name, _passwd, _verify) when found_token = token -> + failwith "BaseUserIndex.upgrade: invalid action" + | elt -> elt) >>= + RW.write rw (sync_dir / indexes_subdir / file) serialise + let confirm_email sync_dir token = get_data sync_dir >|= List.map (function diff --git a/src/state/token_index.mli b/src/state/token_index.mli index c7a53ee7e..b7b71faa0 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -70,7 +70,13 @@ module UserIndex: sig val authenticate : string -> authentication -> Learnocaml_data.Token.t option Lwt.t val exists : string -> string -> bool Lwt.t val add : string -> user -> unit Lwt.t + + (** Upgrade account from TOKEN to password *) val upgrade : string -> Learnocaml_data.Token.t -> string -> string -> unit Lwt.t + + (** Update password *) + val update : string -> Learnocaml_data.Token.t -> string -> unit Lwt.t + val confirm_email : string -> Learnocaml_data.Token.t -> unit Lwt.t val can_login : string -> Learnocaml_data.Token.t -> bool Lwt.t val token_of_email : string -> string -> Learnocaml_data.Token.t option Lwt.t From b3a5e4501a7ce23a9b3868f20b106a215ba57771 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Aug 2020 17:11:15 +0200 Subject: [PATCH 078/161] fix(low-level module BaseUserIndex): Document/Check email invariants --- src/state/token_index.ml | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 988328f53..6976d5fbb 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -277,6 +277,11 @@ let check_oauth sync_dir url args = with Not_found -> Lwt.return (Error "Missing args") +(** Invariants: + * [Password (_, email, _, Some email)]: init state, unverified email + * [Password (_, email, _, None)]: verified email + * [Password (_, email, _, Some other_email)]: pending email change + *) type user = | Token of (Token.t * bool) | Password of (Token.t * string * string * string option) @@ -287,6 +292,9 @@ type authentication = module BaseUserIndex (RW: IndexRW) = struct let rw = RW.init () + + (** Invariant: all emails are pairwise different (except possibly in + the initial account state: [Password (_, email, _, Some email)]). *) let file = "user.json" let enc = J.( @@ -366,6 +374,9 @@ module BaseUserIndex (RW: IndexRW) = struct RW.write rw (sync_dir / indexes_subdir / file) serialise let upgrade sync_dir token name passwd = + (exists sync_dir name >|= fun exists -> + if exists then failwith "BaseUserIndex.upgrade: duplicate email") + >>= fun () -> get_data sync_dir >|= List.map (function | Token (found_token, _use_moodle) when found_token = token -> @@ -405,6 +416,9 @@ module BaseUserIndex (RW: IndexRW) = struct | _ -> res) None let change_email sync_dir token email = + (exists sync_dir email >|= fun exists -> + if exists then failwith "BaseUserIndex.change_email: duplicate email") + >>= fun () -> RW.read (sync_dir / indexes_subdir / file) parse >|= List.map (function | Password (found_token, name, passwd, _) when found_token = token -> From 67d87856e6a5f86ded875f73beda0a80adae05b5 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Aug 2020 17:16:54 +0200 Subject: [PATCH 079/161] refactor(token_index.ml): s/name/email/ for readability --- src/state/token_index.ml | 48 +++++++++++++++++++++------------------- 1 file changed, 25 insertions(+), 23 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 6976d5fbb..99e8154bb 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -305,11 +305,11 @@ module BaseUserIndex (RW: IndexRW) = struct (fun (token, using_moodle) -> Token (token, using_moodle)); case (tup4 Token.enc string string (option string)) (function - | Password (token, username, passwd, verify_email) -> - Some (token, username, passwd, verify_email) + | Password (token, email, passwd, verify_email) -> + Some (token, email, passwd, verify_email) | _ -> None) - (fun (token, username, passwd, verify_email) -> - Password (token, username, passwd, verify_email))])) + (fun (token, email, passwd, verify_email) -> + Password (token, email, passwd, verify_email))])) let parse = Json_codec.decode enc let serialise = Json_codec.encode ~minify:false enc @@ -338,28 +338,28 @@ module BaseUserIndex (RW: IndexRW) = struct | AuthToken token, Token (found_tok, use_moodle) when not use_moodle && found_tok = token -> Some (token) - | Passwd (name, passwd), Password (token, found_name, found_passwd, _) - when found_name = name && Bcrypt.verify passwd (Bcrypt.hash_of_string found_passwd) -> + | Passwd (email, passwd), Password (token, found_email, found_passwd, _) + when found_email = email && Bcrypt.verify passwd (Bcrypt.hash_of_string found_passwd) -> Some (token) | _ -> None else res) None - let exists sync_dir name = + let exists sync_dir email = get_data sync_dir >|= List.exists (function - | Password (_token, found_name, _passwd, None) -> found_name = name - | Password (_token, found_name, _passwd, Some verify_email) -> - found_name = name || verify_email = name + | Password (_token, found_email, _passwd, None) -> found_email = email + | Password (_token, found_email, _passwd, Some verify_email) -> + found_email = email || verify_email = email | _ -> false) let add sync_dir auth = get_data sync_dir >>= fun users -> let new_user = match auth with | Token _ -> auth - | Password (token, name, passwd, verify_email) -> + | Password (token, email, passwd, verify_email) -> let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in - Password (token, name, hash, verify_email) in + Password (token, email, hash, verify_email) in RW.write rw (sync_dir / indexes_subdir / file) serialise (new_user :: users) let update sync_dir token passwd = @@ -367,22 +367,23 @@ module BaseUserIndex (RW: IndexRW) = struct List.map (function | Token (found_token, _use_moodle) when found_token = token -> failwith "BaseUserIndex.update: invalid action" - | Password (found_token, name, _passwd, verify) when found_token = token -> + | Password (found_token, email, _passwd, verify) when found_token = token -> let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in - Password (token, name, hash, verify) + Password (token, email, hash, verify) | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise - let upgrade sync_dir token name passwd = - (exists sync_dir name >|= fun exists -> + let upgrade sync_dir token email passwd = + (exists sync_dir email >|= fun exists -> if exists then failwith "BaseUserIndex.upgrade: duplicate email") >>= fun () -> get_data sync_dir >|= List.map (function | Token (found_token, _use_moodle) when found_token = token -> let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in - Password (token, name, hash, Some(name)) - | Password (found_token, _name, _passwd, _verify) when found_token = token -> + Password (token, email, hash, Some(email)) + | Password (found_token, _email, _passwd, _verify) + when found_token = token -> failwith "BaseUserIndex.upgrade: invalid action" | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise @@ -390,7 +391,8 @@ module BaseUserIndex (RW: IndexRW) = struct let confirm_email sync_dir token = get_data sync_dir >|= List.map (function - | Password (found_token, _name, passwd, Some verify) when found_token = token -> + | Password (found_token, _email, passwd, Some verify) + when found_token = token -> Password (found_token, verify, passwd, None) | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise @@ -415,14 +417,14 @@ module BaseUserIndex (RW: IndexRW) = struct | None, Password (found_token, email, _, _) when found_token = token -> Some email | _ -> res) None - let change_email sync_dir token email = - (exists sync_dir email >|= fun exists -> + let change_email sync_dir token new_email = + (exists sync_dir new_email >|= fun exists -> if exists then failwith "BaseUserIndex.change_email: duplicate email") >>= fun () -> RW.read (sync_dir / indexes_subdir / file) parse >|= List.map (function - | Password (found_token, name, passwd, _) when found_token = token -> - Password (found_token, name, passwd, Some email) + | Password (found_token, email, passwd, _) when found_token = token -> + Password (found_token, email, passwd, Some new_email) | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise end From 1ab9a05a5d6eb92456af41ae2d6eb8f63b31a640 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 29 Aug 2020 17:54:21 +0200 Subject: [PATCH 080/161] fix(Api.Upgrade): check (at high-level) if E-mail already used --- src/server/learnocaml_server.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 70facc1bc..71b7eb25d 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -834,7 +834,9 @@ module Request_handler = struct let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and email = List.assoc "email" params and passwd = List.assoc "passwd" params in - if String.length passwd < 8 || not (check_email_ml email) then + Token_index.UserIndex.exists !sync_dir email >>= fun exists -> + if exists then lwt_fail (`Forbidden, "E-mail already used") + else if String.length passwd < 8 || not (check_email_ml email) then lwt_ok @@ Redirect { code=`See_other; url="/upgrade"; cookies } else let cookies = make_cookie ("token", Token.to_string token) :: cookies in From c52678e2e8fcd1d099e1efa880e318f6212f020a Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Mon, 31 Aug 2020 11:15:28 +0200 Subject: [PATCH 081/161] fix: check email length --- src/app/learnocaml_index_main.ml | 7 ++++--- src/app/learnocaml_lti_main.ml | 3 ++- src/main/learnocaml_client.ml | 3 ++- src/server/learnocaml_server.ml | 3 ++- src/state/learnocaml_data.ml | 2 ++ src/state/learnocaml_data.mli | 3 +++ 6 files changed, 15 insertions(+), 6 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 9b7c0e1a6..c039d0852 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -616,9 +616,10 @@ let complete_change_email cb new_email = function let check_email_js email = let re = Regexp.regexp Learnocaml_data.email_regexp_js in - match Regexp.string_match re email 0 with - | Some _ -> true - | None -> false + Learnocaml_data.email_check_length email + && match Regexp.string_match re email 0 with + | Some _ -> true + | None -> false let validate_email email = if check_email_js email then Lwt.return_some email diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index cd5b10ed6..f9156506b 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -14,7 +14,8 @@ module H = Tyxml_js.Html5 let check_email_ml email = let regexp = Str.regexp Learnocaml_data.email_regexp_ml in - Str.string_match regexp email 0 + Learnocaml_data.email_check_length email + && Str.string_match regexp email 0 let id s = s, find_component s diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index c6462eafc..7c7a3de2d 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -17,7 +17,8 @@ let version = Api.version let check_email_ml email = let regexp = Str.regexp Learnocaml_data.email_regexp_ml in - Str.string_match regexp email 0 + Learnocaml_data.email_check_length email + && Str.string_match regexp email 0 let url_conv = conv ~docv:"URL" ( diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 71b7eb25d..2fa05074b 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -11,7 +11,8 @@ open Learnocaml_store let check_email_ml email = let regexp = Str.regexp Learnocaml_data.email_regexp_ml in - Str.string_match regexp email 0 + Learnocaml_data.email_check_length email + && Str.string_match regexp email 0 let port = ref 8080 diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 6dd869b95..706a84df9 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -15,6 +15,8 @@ let email_regexp_js = "^[a-zA-Z0-9.+_~-]+@[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?(?:\\.[a-zA-Z0-9](?:[a-zA-Z0-9-]*[a-zA-Z0-9])?)+$" let email_regexp_ml = "^[a-zA-Z0-9.+_~-]+@[a-zA-Z0-9]\\([a-zA-Z0-9-]*[a-zA-Z0-9]\\)?\\(\\.[a-zA-Z0-9]\\([a-zA-Z0-9-]*[a-zA-Z0-9]\\)?\\)+$" +let email_check_length email = + String.length email <= 254 && try String.index email '@' <= 64 with _ -> false module J = Json_encoding diff --git a/src/state/learnocaml_data.mli b/src/state/learnocaml_data.mli index c115b8c16..9ee1e4a1d 100644 --- a/src/state/learnocaml_data.mli +++ b/src/state/learnocaml_data.mli @@ -13,6 +13,9 @@ val email_regexp_js : string val email_regexp_ml : string +(** "local-part@domain" must have upto 254 chars, "local-part" upto 64 chars. *) +val email_check_length : string -> bool + module SMap: sig include Map.S with type key = string From 9fba3fc2c91db879cb76b6c2864c2a786ddb7df5 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 1 Sep 2020 11:16:03 +0200 Subject: [PATCH 082/161] fix: Avoid error if "/sync" does not exist > Regenerating the token index... > SERVER CRASH in mkdir(./sync/data): > No such file or directory --- src/state/token_index.ml | 9 ++------- 1 file changed, 2 insertions(+), 7 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 99e8154bb..1be295ad7 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -47,12 +47,7 @@ module IndexFile: IndexRW = struct let write mutex filename serialise data = Lwt_mutex.lock mutex >>= fun () -> - let path = Filename.dirname filename in - Lwt_utils.is_directory path >>= fun is_directory -> - (if is_directory then - Lwt.return_unit - else - Lwt_unix.mkdir path 0o755) >>= fun () -> + Lwt_utils.mkdir_p ~perm:0o700 (Filename.dirname filename) >>= fun () -> Lwt_io.open_file ~mode:Lwt_io.Output filename >>= fun channel -> Lwt_io.write channel (serialise data) >>= fun () -> Lwt_io.close channel >>= fun () -> @@ -109,7 +104,7 @@ module BaseTokenIndex (RW: IndexRW) = struct (fun () -> RW.read filename parse) (fun _exn -> (* Note: this error handler may be adapted later to be more conservative? - it does not matter now as sync/token.json is not a critical file, and + it does not matter now as sync/data/token.json is not a critical file, and can be regenerated. *) create ()) else From 8f30481f893e2eab529e6764c7473769f1237135 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 1 Sep 2020 12:49:55 +0200 Subject: [PATCH 083/161] fix: Avoid "TOKEN NOT FOUND" error (when sign-in with the first generated teacher token) --- src/state/token_index.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 1be295ad7..009224e81 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -393,7 +393,7 @@ module BaseUserIndex (RW: IndexRW) = struct RW.write rw (sync_dir / indexes_subdir / file) serialise let can_login sync_dir token = - RW.read (sync_dir / indexes_subdir / file) parse >|= fun users -> + get_data sync_dir >|= fun users -> List.find_opt (function | Token (found_token, use_moodle) -> found_token = token && not use_moodle | _ -> false) users <> None From 83ee3b74bba61af63ede32ff1c66df4f2b3e904c Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 1 Sep 2020 13:20:17 +0200 Subject: [PATCH 084/161] fix: Make messages uniform for email-based login and password reset MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Also: * learnocaml_index_main.ml: Change some strings (→recognized, +"if applicable") * learnocaml_sendmail.ml: Remove one newline --- src/app/learnocaml_index_main.ml | 25 +++++++++++-------------- src/server/learnocaml_server.ml | 12 ++++++++++-- src/utils/learnocaml_sendmail.ml | 3 +-- 3 files changed, 22 insertions(+), 18 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index c039d0852..d27597ac4 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -576,15 +576,12 @@ let show_token_dialog token = H.div ~a:[H.a_style "text-align: center;"] [token_disp_div token]; ] -let complete_reset_password cb = function +let complete_reset_password ?(sayif = true) cb = function | Ok email -> - alert ~title:[%i"RESET REQUEST SENT"] - ([%i"A reset link has been sent to the following address: "] - ^ email); - Lwt.return_none - | Error (`Not_found _) -> - alert ~title:[%i"ERROR"] - [%i"The entered e-mail couldn't be recognised."]; + alert ~title:[%i"RESET REQUEST"] + ([%i"A reset link was sent to the address: "] + ^ email ^ if sayif then [%i"\n(if it is associated with an account)"] + else ""); Lwt.return_none | Error e -> lwt_alert ~title:[%i"REQUEST ERROR"] [ @@ -603,7 +600,7 @@ let complete_change_email cb new_email = function Lwt.return_none | Error (`Not_found _) -> alert ~title:[%i"ERROR"] - [%i"The entered e-mail couldn't be recognised."]; + [%i"The entered e-mail couldn't be recognized."]; Lwt.return_none | Error e -> lwt_alert ~title:[%i"REQUEST ERROR"] [ @@ -716,7 +713,7 @@ let init_token_dialog () = Lwt.return_some (token, save.Save.nickname) | Error (`Not_found _) -> alert ~title:[%i"TOKEN NOT FOUND"] - [%i"The entered token couldn't be recognised."]; + [%i"The entered token couldn't be recognized."]; Lwt.return_none | Error e -> lwt_alert ~title:[%i"REQUEST ERROR"] [ @@ -739,7 +736,7 @@ let init_token_dialog () = Server_caller.request (Learnocaml_api.Can_login token) >>= function | Error _ | Ok false -> alert ~title:[%i"TOKEN NOT FOUND"] - [%i"The entered token couldn't be recognised."]; + [%i"The entered token couldn't be recognized."]; Lwt.return_none | _ -> Server_caller.request (Learnocaml_api.Fetch_save token) >>= function @@ -749,7 +746,7 @@ let init_token_dialog () = Lwt.return_some (token, save.Save.nickname) | Error (`Not_found _) -> alert ~title:[%i"TOKEN NOT FOUND"] - [%i"The entered token couldn't be recognised."]; + [%i"The entered token couldn't be recognized."]; Lwt.return_none | Error e -> lwt_alert ~title:[%i"REQUEST ERROR"] [ @@ -848,7 +845,7 @@ let set_string_translations () = "txt_first_connection_password", [%i"Password"]; "txt_first_connection_secret", [%i"Secret"]; "txt_secret_label", [%i"The secret is the passphrase provided by \ - your teacher to sign-up."]; + your teacher to sign-up (if applicable)."]; "txt_login_new", [%i"Create new token"]; "txt_returning", [%i"Returning user"]; "txt_returning_email", [%i"E-mail address"]; @@ -918,7 +915,7 @@ let () = let rec change_password () = Server_caller.request (Learnocaml_api.Change_password Learnocaml_local_storage.(retrieve sync_token)) - >>= complete_reset_password change_password in + >>= complete_reset_password ~sayif:false change_password in let rec change_email () = Lwt.catch (fun () -> diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 2fa05074b..f824a4021 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -457,7 +457,10 @@ module Request_handler = struct Token_index.UserIndex.authenticate !sync_dir (Token_index.Passwd (nick, password)) >>= (function | Some token -> respond_json cache token - | _ -> lwt_fail (`Forbidden, "bad login/password")) + | _ -> + Lwt.return (Printf.printf "[WARNING] Bad login or password for: %s\n%!" nick) + >>= fun () -> + lwt_fail (`Forbidden, "Bad login or password")) | Api.Create_user _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Login _ -> @@ -716,7 +719,12 @@ module Request_handler = struct (function | Some token -> initiate_password_change token address cache req - | None -> lwt_fail (`Not_found, "Unknown user.")) + | None -> + Lwt.return + (Printf.printf "[INFO] attempt to reset password for unknown email: %s\n%!" + address) + >>= fun () -> + respond_json cache address) | Api.Change_password token when config.ServerData.use_passwd -> Token_index.UserIndex.email_of_token !sync_dir token >>= (function diff --git a/src/utils/learnocaml_sendmail.ml b/src/utils/learnocaml_sendmail.ml index 54ecdb869..b27ccffae 100644 --- a/src/utils/learnocaml_sendmail.ml +++ b/src/utils/learnocaml_sendmail.ml @@ -154,8 +154,7 @@ let send_email Printf.printf {|[INFO] mailto:%s?subject="%s" %!|} to_addr subject | None -> - Printf.printf {| -[WARNING] Environment variables SMTPSERVER and EMAIL must be set! (* + Printf.printf {|[WARNING] Environment variables SMTPSERVER and EMAIL must be set! (* Can't mailto:%s?subject="%s" with body """ %s """ *) From abe19d3c3c48b3881d1624335dc063c370527e76 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 1 Sep 2020 16:24:18 +0200 Subject: [PATCH 085/161] refactor(index.html): Move "login-returning" before "login-new" --- static/index.html | 30 +++++++++++++++--------------- 1 file changed, 15 insertions(+), 15 deletions(-) diff --git a/static/index.html b/static/index.html index 1bb8fb5a8..7d8007792 100644 --- a/static/index.html +++ b/static/index.html @@ -92,6 +92,21 @@

+
+

+
+
+
+ +
+
+
+
+ +
+ + +

@@ -121,21 +136,6 @@

-
-

-
-
-
- -
-
-
-
- -
- - -

From d2659bb5e5a8af51566f438245fe4f0a97db5a2f Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 1 Sep 2020 16:33:04 +0200 Subject: [PATCH 086/161] refactor(_main.ml): Change two strings --- src/app/learnocaml_index_main.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index d27597ac4..47e9c54f8 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -838,14 +838,15 @@ let set_string_translations () = "txt_token_first_connection", [%i"First connection"]; "txt_token_first_connection_dialog", [%i"Choose a nickname"]; "txt_token_secret", [%i"Enter the secret"]; - "txt_token_new", [%i"Create new token"]; + "txt_token_new", [%i"Create account"]; "txt_first_connection", [%i"First connection"]; "txt_first_connection_email", [%i"E-mail address"]; "txt_first_connection_nickname", [%i"Nickname"]; "txt_first_connection_password", [%i"Password"]; "txt_first_connection_secret", [%i"Secret"]; - "txt_secret_label", [%i"The secret is the passphrase provided by \ - your teacher to sign-up (if applicable)."]; + "txt_secret_label", [%i"The secret is an optional passphrase \ + provided by your teacher. It may be \ + required to create an account."]; "txt_login_new", [%i"Create new token"]; "txt_returning", [%i"Returning user"]; "txt_returning_email", [%i"E-mail address"]; From eea254f7af448fd8c09db9ae6f10b6b8a68182dd Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 1 Sep 2020 18:59:50 +0200 Subject: [PATCH 087/161] fix: Add check_email_ml test --- src/app/learnocaml_index_main.ml | 4 ++++ src/server/learnocaml_server.ml | 4 +++- 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 47e9c54f8..9581ed742 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -583,6 +583,10 @@ let complete_reset_password ?(sayif = true) cb = function ^ email ^ if sayif then [%i"\n(if it is associated with an account)"] else ""); Lwt.return_none + | Error (`Http_error (400, _)) -> + alert ~title:[%i"ERROR"] + [%i"The entered e-mail was invalid."]; + Lwt.return_none | Error e -> lwt_alert ~title:[%i"REQUEST ERROR"] [ H.p [H.pcdata [%i"Could not retrieve data from server"]]; diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index f824a4021..47966658b 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -715,7 +715,9 @@ module Request_handler = struct | None -> lwt_fail (`Forbidden, "Nothing to do.")) | Api.Send_reset_password address when config.ServerData.use_passwd -> - Token_index.UserIndex.token_of_email !sync_dir address >>= + if not (check_email_ml address) then + lwt_fail (`Bad_request, "Invalid e-mail address") + else Token_index.UserIndex.token_of_email !sync_dir address >>= (function | Some token -> initiate_password_change token address cache req From 966f1689418dd4409070023f7e498ff8c62b59bc Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Tue, 1 Sep 2020 18:01:30 +0200 Subject: [PATCH 088/161] api: don't return the token of a newly created account This requires one to confirm its email address before login in for the first time. + fix: learnocaml_lti_main wrongly used the OCaml way to perform regex matching instead of the JS way. This has been fixed. Signed-off-by: Alban Gruin --- src/app/learnocaml_index_main.ml | 7 +++-- src/app/learnocaml_lti_main.ml | 27 ++++++++------------ src/main/learnocaml_client.ml | 44 +++++++++++++++++--------------- src/server/learnocaml_server.ml | 11 +++++--- src/state/learnocaml_api.ml | 5 ++-- src/state/learnocaml_api.mli | 2 +- src/state/token_index.ml | 3 +++ 7 files changed, 50 insertions(+), 49 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 9581ed742..b744aa11c 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -694,10 +694,9 @@ let init_token_dialog () = (Learnocaml_local_storage.(store nickname) nickname; retrieve (Learnocaml_api.Create_user (email, nickname, password, secret)) - >>= fun token -> - Learnocaml_local_storage.(store sync_token) token; - Learnocaml_local_storage.(store can_show_token) false; - Lwt.return_some (token, nickname)) + >>= fun () -> + alert ~title:[%i"VALIDATION REQUIRED"] [%i"A confirmation e-mail has been sent to your address."]; + Lwt.return_none) else Lwt.return_none in diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index f9156506b..ae808ca10 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -12,10 +12,12 @@ open Learnocaml_common module H = Tyxml_js.Html5 -let check_email_ml email = - let regexp = Str.regexp Learnocaml_data.email_regexp_ml in +let check_email_js email = + let re = Regexp.regexp Learnocaml_data.email_regexp_js in Learnocaml_data.email_check_length email - && Str.string_match regexp email 0 + && match Regexp.string_match re email 0 with + | Some _ -> true + | None -> false let id s = s, find_component s @@ -68,7 +70,7 @@ let create_token () = consent = Manip.checked input_consent and consent_label = find_component "txt_first_connection_consent" in (* 5 for a character, @, character, dot, character. *) - let email_criteria = not (check_email_ml email) and + let email_criteria = not (check_email_js email) and passwd_criteria = String.length password < 8 in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; @@ -81,7 +83,7 @@ let create_token () = Manip.SetCss.borderColor reg_input_password "#f44"; if not consent then Manip.SetCss.fontWeight consent_label "bold"; - Lwt.return_none + Lwt.return_unit end else let nickname = String.trim (Manip.value reg_input_nick) and @@ -91,21 +93,14 @@ let create_token () = let secret = Sha.sha512 (nonce ^ secret) in (Learnocaml_local_storage.(store nickname) nickname; retrieve - (Learnocaml_api.Create_user (email, nickname, password, secret)) - >>= fun token -> - Learnocaml_local_storage.(store sync_token) token; - Lwt.return_some (token, nickname)) + (Learnocaml_api.Create_user (email, nickname, password, secret)) >>= fun () -> + alert ~title:[%i"VALIDATION REQUIRED"] [%i"A confirmation e-mail has been sent to your address."]; + Lwt.return_unit) let init_dialogs () = Manip.SetCss.display login_overlay "block"; Manip.Ev.onclick login_new_button (fun _ -> - Lwt.async (fun _ -> - create_token () >>= function - | Some (_token, _nickname) -> - send_sync_request (); - Dom_html.window##.location##assign (Js.string "/"); - Lwt.return () - | None -> Lwt.return_unit); + Lwt.async create_token; true) let () = diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index 7c7a3de2d..73c416287 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -724,22 +724,11 @@ module Init_user = struct let init global_args create_user_args = let path = if global_args.local then ConfigFile.local_path else ConfigFile.user_path in - let get_token server = - match global_args.token with - | Some token -> Lwt.return token - | None -> - match create_user_args with - | {email; password; nickname=None; secret=None} -> - user_login server email password - | {email; password; nickname=Some(nickname); secret=Some(secret)} -> - if not (check_email_ml email) then - Lwt.fail_with "Invalid e-mail address" - else if String.length password < 8 then - Lwt.fail_with "Password must be at least 8 characters long" - else - get_nonce_and_create_user server email password nickname secret - | _ -> - Lwt.fail_with "You must provide an e-mail address, a password, a nickname and a secret." + let save_token server token = + let config = { ConfigFile. server; token=Some(token)} in + ConfigFile.write path config >|= fun () -> + Printf.eprintf "Configuration written to %s.\n%!" path; + 0 in let get_server () = match global_args.server_url with @@ -748,11 +737,24 @@ module Init_user = struct in get_server () >>= fun server -> check_server_version server >>= fun _ -> - get_token server >>= fun token -> - let config = { ConfigFile. server; token=Some(token) } in - ConfigFile.write path config >|= fun () -> - Printf.eprintf "Configuration written to %s.\n%!" path; - 0 + match global_args.token with + | Some token -> save_token server token + | None -> + match create_user_args with + | {email; password; nickname=None; secret=None} -> + user_login server email password >>= + save_token server + | {email; password; nickname=Some(nickname); secret=Some(secret)} -> + if not (check_email_ml email) then + Lwt.fail_with "Invalid e-mail address" + else if String.length password < 8 then + Lwt.fail_with "Password must be at least 8 characters long" + else + get_nonce_and_create_user server email password nickname secret >>= fun () -> + Printf.eprintf "A confirmation e-mail has been sent to your address."; + Lwt.return 0 + | _ -> + Lwt.fail_with "You must provide an e-mail address, a password, a nickname and a secret." let man = man "Initialize the configuration file with the server, \ and a token, or login with an email+password pair, or \ diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 47966658b..ad664a024 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -192,7 +192,7 @@ let generate_hmac secret csrf user_id = Cryptokit.hash_string hmac (csrf ^ user_id) |> Cryptokit.transform_string encoder -let create_student conn (config: Learnocaml_data.Server.config) cache req +let create_student conn (config: Learnocaml_data.Server.config) req nonce_req secret_candidate nick base_auth = let module ServerData = Learnocaml_data.Server in lwt_option_fail @@ -224,7 +224,7 @@ let create_student conn (config: Learnocaml_data.Server.config) cache req email; Token_index.Password (tok, email, password, Some(email)))) >>= fun auth -> Token_index.UserIndex.add !sync_dir auth >>= fun () -> - respond_json cache tok + lwt_ok tok (** [get_nickname] is used to show the user name in emails openings. (Cost some filesystem read; we might want to always return None) *) @@ -426,7 +426,8 @@ module Request_handler = struct | Api.Create_token (secret_candidate, None, nick) -> valid_string_of_endp conn >?= fun conn -> - create_student conn config cache req nonce_req secret_candidate nick (`Token false) + create_student conn config req nonce_req secret_candidate nick (`Token false) >?= + respond_json cache | Api.Create_token (_secret_candidate, Some token, _nick) -> lwt_catch_fail (fun () -> Token.register token >>= fun () -> @@ -452,7 +453,9 @@ module Request_handler = struct else if String.length password < 8 then lwt_fail (`Bad_request, "Password must be at least 8 characters long") else - create_student conn config cache req nonce_req secret (Some nick) (`Password (email, password)) + create_student conn config req nonce_req secret (Some nick) (`Password (email, password)) >?= fun _ -> + respond_json cache () + | Api.Login (nick, password) when config.ServerData.use_passwd -> Token_index.UserIndex.authenticate !sync_dir (Token_index.Passwd (nick, password)) >>= (function diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 428ed06e3..5cfeb2399 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -22,7 +22,7 @@ type _ request = | Create_teacher_token: teacher token -> teacher token request | Create_user: - string * string * string * string -> student token request + string * string * string * string -> unit request | Login: string * string -> student token request | Can_login: @@ -142,8 +142,7 @@ module Conversions (Json: JSON_CODEC) = struct json J.(obj1 (req "token" string)) +> Token.(to_string, parse) | Create_user _ -> - json J.(obj1 (req "token" string)) +> - Token.(to_string, parse) + json J.unit | Login _ -> json J.(obj1 (req "token" string)) +> Token.(to_string, parse) diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 751a8dfcb..46c04c527 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -35,7 +35,7 @@ type _ request = | Create_teacher_token: teacher token -> teacher token request | Create_user: - string * string * string * string -> student token request + string * string * string * string -> unit request | Login: string * string -> student token request | Can_login: diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 009224e81..89edd6eed 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -333,6 +333,9 @@ module BaseUserIndex (RW: IndexRW) = struct | AuthToken token, Token (found_tok, use_moodle) when not use_moodle && found_tok = token -> Some (token) + | Passwd (email, _), Password (_, found_email, _, Some new_email) + when found_email = email && found_email = new_email -> + None | Passwd (email, passwd), Password (token, found_email, found_passwd, _) when found_email = email && Bcrypt.verify passwd (Bcrypt.hash_of_string found_passwd) -> Some (token) From ecdc59fc1029c22df5fef0f1d97b2fd05ebf4746 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Tue, 1 Sep 2020 22:19:29 +0200 Subject: [PATCH 089/161] learnocaml_common: hide the dialog box first, then call the callback MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit When creating dialog boxes with buttons, the provided callback is called before hiding the box. This is not a problem most of the time, but it becomes one when the callback implies Lwt threads and other dialog boxes. Take `ask_string', for instance: its validation button wakes up another Lwt thread, and if it happens to create another dialog box (which reuses the same basic
to show its components as the one created by `ask_string'), when the button's callback is awoken again, it will hide the newly created box. Such a sequence didn't exist until recently, with 0296f6c (fix: Make email validation check more strict and uniform, 2020-08-27). It introduces a sequence like this: ask_string … >>= fun str -> if is_valid str then Lwt.return_some str else begin alert …; Lwt.return_none end Here, the callback of the "Ok" button will wake up `ask_string', and if alert is called, it will show up for a fraction of second before the button's callback is in charge again and hide this dialog. This fix this issue by hiding the dialog box first, then calling the callback. Signed-off-by: Alban Gruin --- src/app/learnocaml_common.ml | 10 +++++++--- src/app/learnocaml_index_main.ml | 1 - 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index 94aca5941..3840c7176 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -92,10 +92,14 @@ let dialog_layer_id = "ocp-dialog-layer" let box_button txt f = H.button ~a: [ H.a_onclick (fun _ -> + begin + match Manip.by_id dialog_layer_id with + | Some div -> Manip.removeChild Manip.Elt.body div + | None -> () + end; f (); - match Manip.by_id dialog_layer_id with - | Some div -> Manip.removeChild Manip.Elt.body div; false - | None -> (); false) + false + ) ] [ H.txt txt ] let close_button txt = diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index b744aa11c..59186ca94 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -624,7 +624,6 @@ let check_email_js email = let validate_email email = if check_email_js email then Lwt.return_some email - (* FIXME: the dialog does not show up *) else begin alert ~title:[%i"ERROR"] ([%i"The entered e-mail is invalid: "] ^ email); From efeb1088767bd3758900868304ecf34943d8d9b0 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Wed, 2 Sep 2020 18:42:48 +0200 Subject: [PATCH 090/161] index_main: the token cookie has priority over the local storage If a user is logged in and uses the LTI launch page to log in with another user, the user will be logged as the first user, not the second one. Fix that by checking that if the cookie exists, it has priority over the local storage. Signed-off-by: Alban Gruin --- src/app/learnocaml_index_main.ml | 42 ++++++++++++++++++-------------- 1 file changed, 24 insertions(+), 18 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 59186ca94..1e2443947 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -808,24 +808,30 @@ let delete_cookie name = let init_sync_token button_group = catch (fun () -> - begin try - if get_cookie "token" <> None then - Learnocaml_local_storage.(store can_show_token) false; - Lwt.return Learnocaml_local_storage.(retrieve sync_token) - with Not_found -> - match get_cookie "token" with - | None -> init_token_dialog () - | Some token -> - let token = Learnocaml_data.Token.parse token in - Server_caller.request (Learnocaml_api.Fetch_save token) >>= function - | Ok save -> - set_state_from_save_file ~token save; - Learnocaml_local_storage.(store can_show_token) false; - Lwt.return token - | Error _ -> init_token_dialog () - end >>= fun token -> - enable_button_group button_group ; - Lwt.return (Some token)) + begin + match get_cookie "token" with + | None -> + begin + try Lwt.return Learnocaml_local_storage.(retrieve sync_token) + with Not_found -> init_token_dialog () + end + | Some token -> + let token = Learnocaml_data.Token.parse token in + Server_caller.request (Learnocaml_api.Fetch_save token) >>= function + | Ok save -> + set_state_from_save_file ~token save; + Learnocaml_local_storage.(store can_show_token) false; + Lwt.return token + | Error _ -> init_token_dialog () + end >>= fun token -> + enable_button_group button_group; + begin + try + let nickname = Learnocaml_local_storage.(retrieve nickname) in + (Tyxml_js.To_dom.of_input El.nickname_field)##.value := Js.string nickname + with _ -> () + end; + Lwt.return (Some token)) (fun _ -> Lwt.return None) let set_string_translations () = From c6cddda1067a52ca372d21041c43808682c5f2cb Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 3 Sep 2020 11:27:13 +0200 Subject: [PATCH 091/161] index.html: Uniformize type="email", type="password" & "Nickname" inputs --- static/index.html | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/static/index.html b/static/index.html index 7d8007792..96bfa075f 100644 --- a/static/index.html +++ b/static/index.html @@ -97,12 +97,12 @@

- +
- +
@@ -117,7 +117,7 @@

- +
From 82e9d68c8e8c83c2dc79b55eb0090f27d443dfac Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 3 Sep 2020 11:40:55 +0200 Subject: [PATCH 092/161] index_main: make reset_password use check_email_js before calling server --- src/app/learnocaml_index_main.ml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 1e2443947..048492c72 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -762,6 +762,13 @@ let init_token_dialog () = let rec reset_password () = if get_opt config##.enablePasswd then let email = Manip.value login_input_email in + let email_criteria = not (check_email_js email) in + Manip.SetCss.borderColor login_input_email ""; + if email_criteria then begin + Manip.SetCss.borderColor login_input_email "#f44"; + alert ~title:[%i"ERROR"] [%i"The entered e-mail was invalid."]; + Lwt.return_none end + else Server_caller.request (Learnocaml_api.Send_reset_password email) >>= complete_reset_password reset_password else From 5f615ddd2a00f8941e9bbc895c9360f692691a4f Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 3 Sep 2020 12:38:47 +0200 Subject: [PATCH 093/161] fix(MoodleIndex): Add a colon to avoid any potentiel clash --- src/state/token_index.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 89edd6eed..3f21652ae 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -266,7 +266,7 @@ let check_oauth sync_dir url args = OauthIndex.get_current_secret sync_dir >|= signature_oauth args "post" url >>= fun s -> if Eqaf.equal s oauth_args.signature then - Lwt.return (Ok (oauth_args.consumer_key ^ (List.assoc "user_id" args))) + Lwt.return (Ok (oauth_args.consumer_key ^ ":" ^ (List.assoc "user_id" args))) else Lwt.return (Error "Wrong signature") with Not_found -> From 0052474a3fd9a5440f88d26700230cf9f360583e Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 3 Sep 2020 13:12:55 +0200 Subject: [PATCH 094/161] lti-main: Refactor /launch page * Move direct-login section up * Request nickname for direct-login * Add txt_indirect_label * Update txt_secret_label like index-main --- src/app/learnocaml_lti_main.ml | 11 ++++++++--- src/server/learnocaml_server.ml | 6 +++++- static/lti.html | 31 +++++++++++++++++++------------ 3 files changed, 32 insertions(+), 16 deletions(-) diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index ae808ca10..a90d36ffd 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -111,9 +111,10 @@ let () = "txt_first_connection_email", [%i"E-mail address"]; "txt_first_connection_nickname", [%i"Nickname"]; "txt_first_connection_password", [%i"Password"]; - "txt_first_connection_secret", [%i"Enter the secret"]; - "txt_secret_label", [%i"The secret is the passphrase provided by \ - your teacher to sign-up."]; + "txt_first_connection_secret", [%i"Secret"]; + "txt_secret_label", [%i"The secret is an optional passphrase \ + provided by your teacher. It may be \ + required to create an account."]; "txt_first_connection_consent", [%i"By submitting this form, I accept that the \ information entered will be used in the \ context of the Learn-OCaml plateform."]; @@ -123,6 +124,10 @@ let () = "txt_returning_password", [%i"Password"]; "txt_login_returning", [%i"Connect"]; "txt_login_forgotten", [%i"Forgot your password?"]; + "txt_direct_login_nickname", [%i"Choose a nickname"]; "txt_direct_login", [%i"Direct login"]; + "txt_indirect_label", [%i"Or to be able to login independently of Moodle, \ + you might want to setup a password below \ + (or upgrade your account later)"]; "txt_button_direct_login", [%i"Direct login"]; ] diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index ad664a024..7cf37a7d7 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -387,13 +387,17 @@ module Request_handler = struct ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in let user_id = List.assoc "user-id" params and csrf = List.assoc "csrf" params and - hmac = List.assoc "hmac" params in + hmac = List.assoc "hmac" params and + nickname = List.assoc "nick" params in Token_index.OauthIndex.get_current_secret !sync_dir >>= fun secret -> let new_hmac = generate_hmac secret csrf user_id in if not (Eqaf.equal hmac new_hmac) then lwt_fail (`Forbidden, "bad hmac") else Token.create_student () >>= fun token -> + (if nickname = "" then Lwt.return_unit + else Save.set token Save.{empty with nickname}) + >>= fun () -> let auth = Token_index.Token (token, true) in Token_index.( TokenIndex.add_token !sync_dir token >>= fun () -> diff --git a/static/lti.html b/static/lti.html index b0f31fb61..cc78917b5 100644 --- a/static/lti.html +++ b/static/lti.html @@ -16,6 +16,22 @@
+
+
+

+
+
+
+ +
+ + + + +
+ +
+

@@ -26,7 +42,7 @@

- +
@@ -51,12 +67,12 @@

- +
- +
@@ -67,15 +83,6 @@

-
-
-

- - - - -
-
From 55b2ea10a36796df136127ebac51b5c4483df3b8 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 3 Sep 2020 13:35:35 +0200 Subject: [PATCH 095/161] docs: s/OAuth token/LTI shared secret/ --- src/main/learnocaml_main.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 09ca86ccb..43d63b980 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -331,7 +331,7 @@ let main o = Lwt.return_unit) >>= fun () -> (if preconfig.ServerData.use_moodle then Token_index.OauthIndex.get_first_oauth o.server.Server.sync_dir >>= fun (secret, _) -> - Lwt_io.printf "OAuth token: %s\n" secret + Lwt_io.printf "LTI shared secret: %s\n" secret else Lwt.return_unit) >>= fun () -> From 3a6cdabca34c2e3d70a8381db09c2e87ada3b2ef Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 3 Sep 2020 17:13:02 +0200 Subject: [PATCH 096/161] token_index: reset password operations older than 4 hours are invalid Signed-off-by: Alban Gruin --- src/state/token_index.ml | 15 +++++++++++---- 1 file changed, 11 insertions(+), 4 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 3f21652ae..cc2e346a2 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -438,8 +438,9 @@ module BaseUpgradeIndex (RW: IndexRW) = struct | ResetPassword let enc = J.( - assoc (tup2 Token.enc (string_enum ["change_email", ChangeEmail; - "reset_password", ResetPassword]))) + assoc (tup3 Token.enc float + (string_enum ["change_email", ChangeEmail; + "reset_password", ResetPassword]))) let parse = Json_codec.decode enc let serialise = Json_codec.encode ~minify:false enc @@ -456,7 +457,7 @@ module BaseUpgradeIndex (RW: IndexRW) = struct let create_upgrade_operation kind sync_dir token = get_data sync_dir >>= fun operations -> let id = generate_random_hex 32 in - (id, (token, kind)) :: operations + (id, (token, Unix.time (), kind)) :: operations |> RW.write rw (sync_dir / indexes_subdir / file) serialise >|= fun () -> id @@ -465,8 +466,14 @@ module BaseUpgradeIndex (RW: IndexRW) = struct let check_upgrade_operation kind sync_dir handle = get_data sync_dir >|= fun operations -> + let expiration_threshold, _ = + Unix.( + let dt = localtime @@ time () in + mktime {dt with tm_hour = dt.tm_hour + 4}) in match List.assoc_opt handle operations with - | Some (token, found_kind) when found_kind = kind -> Some token + | Some (token, date, ResetPassword) + when kind = ResetPassword && date >= expiration_threshold -> Some token + | Some (token, _date, ChangeEmail) when kind = ChangeEmail -> Some token | _ -> None let can_change_email = check_upgrade_operation ChangeEmail From b58b0f5f2efd22d3735270abb2bfa33ad567e3e3 Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 3 Sep 2020 17:22:02 +0200 Subject: [PATCH 097/161] server: revoke reset password operations older than 1 month Signed-off-by: Alban Gruin --- src/server/learnocaml_server.ml | 6 ++++++ src/state/token_index.ml | 10 ++++++++++ src/state/token_index.mli | 1 + 3 files changed, 17 insertions(+) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 7cf37a7d7..0114cd0da 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -1105,6 +1105,12 @@ let launch () = | Some (crt, key) -> `TLS (`Crt_file_path crt, `Key_file_path key, `No_password, `Port !port) in + begin + if config.Learnocaml_data.Server.use_passwd then + Token_index.UpgradeIndex.filter_old_operations !sync_dir + else + Lwt.return_unit + end >>= fun () -> init_teacher_token () >>= fun () -> Lwt.catch (fun () -> Server.create diff --git a/src/state/token_index.ml b/src/state/token_index.ml index cc2e346a2..6f27b490e 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -483,6 +483,16 @@ module BaseUpgradeIndex (RW: IndexRW) = struct get_data sync_dir >|= List.filter (fun (found_handle, _operation) -> found_handle <> handle) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise + + let filter_old_operations sync_dir = + get_data sync_dir >>= fun operations -> + let expiration_threshold, _ = + Unix.( + let dt = localtime @@ time () in + mktime {dt with tm_mon = dt.tm_mon + 1}) in + List.filter (fun (_id, (_token, date, operation)) -> + operation = ChangeEmail || date >= expiration_threshold) operations + |> RW.write rw (sync_dir / indexes_subdir / file) serialise end module UpgradeIndex = BaseUpgradeIndex (IndexFile) diff --git a/src/state/token_index.mli b/src/state/token_index.mli index b7b71faa0..36b6181bb 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -94,4 +94,5 @@ module UpgradeIndex: sig val can_reset_password : string -> string -> Learnocaml_data.Token.t option Lwt.t val revoke_operation : string -> string -> unit Lwt.t + val filter_old_operations : string -> unit Lwt.t end From 4c36a999efd9fd6ca2b033605b89df6cc77adc6b Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 3 Sep 2020 19:11:27 +0200 Subject: [PATCH 098/161] server_config.json: allow bool values to be specified with strings This allow system administrators to specify boolean values (ie. `use_moodle' and `use_passwd') with strings (ie. "true" or "false") instead of "genuine" booleans (ie. `true' or `false') to be more graceful with mistakes. Note that while no string should cause a hard crash, if it is not strictly equal to "true", the value will be interpreted as false (even "True"), since this is the behaviour of `bool_of_string_opt'. Signed-off-by: Alban Gruin --- src/state/learnocaml_data.ml | 13 +++++++++---- 1 file changed, 9 insertions(+), 4 deletions(-) diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 706a84df9..10bc07b94 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -401,6 +401,11 @@ module Server = struct | Some b -> b | None -> false + let errorable_bool = + J.(union [case bool (fun b -> Some b) (fun b -> b); + case string (fun s -> Some (string_of_bool s)) + (fun s -> bool_of_option @@ bool_of_string_opt s)]) + let preconfig_enc = J.conv (fun (c : preconfig) -> (c.secret, Some(c.use_moodle), Some(c.use_passwd))) @@ -409,8 +414,8 @@ module Server = struct use_moodle = bool_of_option use_moodle; use_passwd = bool_of_option use_passwd}) @@ J.obj3 (J.opt "secret" J.string) - (J.opt "use_moodle" J.bool) - (J.opt "use_passwd" J.bool) + (J.opt "use_moodle" errorable_bool) + (J.opt "use_passwd" errorable_bool) type config = { secret : string option; @@ -440,8 +445,8 @@ module Server = struct use_passwd = bool_of_option use_passwd; server_id}) @@ J.obj4 (J.opt "secret" J.string) - (J.opt "use_moodle" J.bool) - (J.opt "use_passwd" J.bool) + (J.opt "use_moodle" errorable_bool) + (J.opt "use_passwd" errorable_bool) (J.req "server_id" J.int) end From 2f3aea3fe6a8567b5ca2c7c2ffb01bf5e62bb6fe Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 3 Sep 2020 22:15:59 +0200 Subject: [PATCH 099/161] config: add an `enableMoodle' value to `learnocaml_config' This adds an `enableMoodle' value to `learnocaml_config' to allow the front-end to know about the status of Moodle. This will be useful later when a message relying on this will be added. Furthermore, the `learnocaml_config' in learnocaml_index_main.ml has been removed, and `get_opt' is moved to learnocaml_config.ml. Signed-off-by: Alban Gruin --- src/app/learnocaml_config.ml | 3 +++ src/app/learnocaml_config.mli | 3 +++ src/app/learnocaml_index_main.ml | 14 -------------- src/main/learnocaml_main.ml | 6 ++++-- 4 files changed, 10 insertions(+), 16 deletions(-) diff --git a/src/app/learnocaml_config.ml b/src/app/learnocaml_config.ml index 89914f87a..f3f78d3ea 100644 --- a/src/app/learnocaml_config.ml +++ b/src/app/learnocaml_config.ml @@ -10,6 +10,8 @@ class type learnocaml_config = object method enableLessons: bool Js.optdef_prop method enableExercises: bool Js.optdef_prop method enableToplevel: bool Js.optdef_prop + method enablePasswd: bool Js.optdef_prop + method enableMoodle: bool Js.optdef_prop method enablePlayground: bool Js.optdef_prop method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop method txtNickname: Js.js_string Js.t Js.optdef_prop @@ -18,3 +20,4 @@ end let config : learnocaml_config Js.t = Js.Unsafe.js_expr "learnocaml_config" let api_server = Js.(to_string (Optdef.get config##.root (fun () -> string ""))) +let get_opt o = Js.Optdef.get o (fun () -> false) diff --git a/src/app/learnocaml_config.mli b/src/app/learnocaml_config.mli index 8950e1227..6c6ae6cdc 100644 --- a/src/app/learnocaml_config.mli +++ b/src/app/learnocaml_config.mli @@ -14,6 +14,8 @@ class type learnocaml_config = object method enableLessons: bool Js.optdef_prop method enableExercises: bool Js.optdef_prop method enableToplevel: bool Js.optdef_prop + method enablePasswd: bool Js.optdef_prop + method enableMoodle: bool Js.optdef_prop method enablePlayground: bool Js.optdef_prop method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop method txtNickname: Js.js_string Js.t Js.optdef_prop @@ -22,3 +24,4 @@ end val config : learnocaml_config Js.t val api_server : string +val get_opt : bool Js.optdef -> bool diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 048492c72..e107766a2 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -77,20 +77,6 @@ module El = struct end end -class type learnocaml_config = object - method enableTryocaml: bool Js.optdef_prop - method enableLessons: bool Js.optdef_prop - method enableExercises: bool Js.optdef_prop - method enableToplevel: bool Js.optdef_prop - method enablePasswd: bool Js.optdef_prop - method enablePlayground: bool Js.optdef_prop - method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop - method txtNickname: Js.js_string Js.t Js.optdef_prop -end - -let config : learnocaml_config Js.t = Js.Unsafe.js_expr "learnocaml_config" -let get_opt o = Js.Optdef.get o (fun () -> false) - let show_loading msg = show_loading ~id:El.loading_id H.[ul [li [txt msg]]] let get_url token dynamic_url static_url id = diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 43d63b980..a224b43a5 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -370,7 +370,8 @@ let main o = \ enableExercises: %b,\n\ \ enableToplevel: %b,\n\ \ root: \"%s\",\n\ - \ enablePasswd: %b\n\ + \ enablePasswd: %b,\n\ + \ enableMoodle: %b\n\ }\n" (tutorials_ret <> None) (playground_ret <> None) @@ -378,7 +379,8 @@ let main o = (exercises_ret <> None) (o.builder.Builder.toplevel <> Some false) o.builder.Builder.root - preconfig.ServerData.use_passwd >>= fun () -> + preconfig.ServerData.use_passwd + preconfig.ServerData.use_moodle >>= fun () -> Lwt.return (tutorials_ret <> Some false && exercises_ret <> Some false))) else Lwt.return true From b5b9fade08718ddca10f4476f7e7df4d783d489a Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 3 Sep 2020 22:26:28 +0200 Subject: [PATCH 100/161] index: change the message when trying to login with an upgraded token Signed-off-by: Alban Gruin --- src/app/learnocaml_index_main.ml | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index e107766a2..e1dfe5268 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -723,8 +723,11 @@ let init_token_dialog () = | token -> Server_caller.request (Learnocaml_api.Can_login token) >>= function | Error _ | Ok false -> - alert ~title:[%i"TOKEN NOT FOUND"] - [%i"The entered token couldn't be recognized."]; + alert ~title:[%i"INVALID TOKEN"] @@ + Printf.sprintf [%if"This token is associated to an upgraded \ + account, which only allows \ + password-based%s authentication."] + (if get_opt config##.enableMoodle then [%i" or Moodle/LTI"] else ""); Lwt.return_none | _ -> Server_caller.request (Learnocaml_api.Fetch_save token) >>= function From 7224bd5974842934971e35fe0733564ba2c2f07c Mon Sep 17 00:00:00 2001 From: Alban Gruin Date: Thu, 3 Sep 2020 23:02:06 +0200 Subject: [PATCH 101/161] translations/fr.po: update translations Signed-off-by: Alban Gruin --- translations/fr.po | 519 ++++++++++++++++++++++++++------------------- 1 file changed, 305 insertions(+), 214 deletions(-) diff --git a/translations/fr.po b/translations/fr.po index 4b8c5c14a..7c74ff685 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-07-31 15:21+0200\n" +"PO-Revision-Date: 2020-09-03 22:46+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -13,132 +13,141 @@ msgstr "" "Content-Type: text/plain; charset=utf-8\n" "Content-Transfer-Encoding: 8bit\n" -#: src/app/learnocaml_common.ml:68,21--37 +#: src/app/learnocaml_common.ml:69,21--37 msgid "INTERNAL ERROR" msgstr "ERREUR INTERNE" -#: src/app/learnocaml_common.ml:103,50--54 -#: src/app/learnocaml_common.ml:137,33--37 -#: src/app/learnocaml_common.ml:143,36--40 +#: src/app/learnocaml_common.ml:108,50--54 +#: src/app/learnocaml_common.ml:142,33--37 +#: src/app/learnocaml_common.ml:148,36--40 msgid "OK" msgstr "OK" -#: src/app/learnocaml_common.ml:134,21--28 -#: src/app/learnocaml_index_main.ml:668,25--32 +#: src/app/learnocaml_common.ml:139,21--28 +#: src/app/learnocaml_index_main.ml:573,21--28 +#: src/app/learnocaml_index_main.ml:592,21--28 +#: src/app/learnocaml_index_main.ml:614,22--29 +#: src/app/learnocaml_index_main.ml:694,25--32 +#: src/app/learnocaml_index_main.ml:758,26--33 msgid "ERROR" msgstr "ERREUR" -#: src/app/learnocaml_common.ml:137,58--66 -#: src/app/learnocaml_common.ml:415,12--20 -#: src/app/learnocaml_index_main.ml:588,12--20 -#: src/app/learnocaml_index_main.ml:686,19--27 -#: src/app/learnocaml_index_main.ml:719,20--28 +#: src/app/learnocaml_common.ml:142,58--66 +#: src/app/learnocaml_common.ml:148,66--74 +#: src/app/learnocaml_common.ml:423,12--20 +#: src/app/learnocaml_index_main.ml:582,12--20 +#: src/app/learnocaml_index_main.ml:601,12--20 +#: src/app/learnocaml_index_main.ml:712,19--27 +#: src/app/learnocaml_index_main.ml:748,20--28 msgid "Cancel" msgstr "Annuler" -#: src/app/learnocaml_common.ml:407,26--41 -#: src/app/learnocaml_index_main.ml:583,25--40 -#: src/app/learnocaml_index_main.ml:681,32--47 -#: src/app/learnocaml_index_main.ml:714,33--48 +#: src/app/learnocaml_common.ml:415,26--41 +#: src/app/learnocaml_index_main.ml:577,25--40 +#: src/app/learnocaml_index_main.ml:596,25--40 +#: src/app/learnocaml_index_main.ml:707,32--47 +#: src/app/learnocaml_index_main.ml:743,33--48 msgid "REQUEST ERROR" msgstr "ERREUR DE REQUÊTE" -#: src/app/learnocaml_common.ml:408,22--59 -#: src/app/learnocaml_index_main.ml:584,26--63 -#: src/app/learnocaml_index_main.ml:682,30--67 -#: src/app/learnocaml_index_main.ml:715,34--71 +#: src/app/learnocaml_common.ml:416,22--59 +#: src/app/learnocaml_index_main.ml:578,26--63 +#: src/app/learnocaml_index_main.ml:597,26--63 +#: src/app/learnocaml_index_main.ml:708,30--67 +#: src/app/learnocaml_index_main.ml:744,34--71 msgid "Could not retrieve data from server" msgstr "Échec lors du téléchargement des données du serveur" -#: src/app/learnocaml_common.ml:411,12--19 -#: src/app/learnocaml_common.ml:451,11--18 -#: src/app/learnocaml_index_main.ml:587,12--19 -#: src/app/learnocaml_index_main.ml:685,19--26 -#: src/app/learnocaml_index_main.ml:718,20--27 +#: src/app/learnocaml_common.ml:419,12--19 +#: src/app/learnocaml_common.ml:459,11--18 +#: src/app/learnocaml_index_main.ml:581,12--19 +#: src/app/learnocaml_index_main.ml:600,12--19 +#: src/app/learnocaml_index_main.ml:711,19--26 +#: src/app/learnocaml_index_main.ml:747,20--27 msgid "Retry" msgstr "Réessayer" -#: src/app/learnocaml_common.ml:414,25--33 -#: src/app/learnocaml_common.ml:452,11--19 +#: src/app/learnocaml_common.ml:422,25--33 +#: src/app/learnocaml_common.ml:460,11--19 msgid "Ignore" msgstr "Ignorer" -#: src/app/learnocaml_common.ml:447,26--39 +#: src/app/learnocaml_common.ml:455,26--39 msgid "SYNC FAILED" msgstr "ECHEC DE LA SYNCHRONISATION" -#: src/app/learnocaml_common.ml:448,22--66 +#: src/app/learnocaml_common.ml:456,22--66 msgid "Could not synchronise save with the server" msgstr "Les données n'ont pas pu être synchronisées avec le serveur" -#: src/app/learnocaml_common.ml:500,39--50 +#: src/app/learnocaml_common.ml:515,39--50 msgid "%dd %02dh" msgstr "%dj %02dh" -#: src/app/learnocaml_common.ml:501,40--51 +#: src/app/learnocaml_common.ml:516,40--51 msgid "%02d:%02d" msgstr "%02d:%02d" -#: src/app/learnocaml_common.ml:502,23--36 +#: src/app/learnocaml_common.ml:517,23--36 msgid "0:%02d:%02d" msgstr "0:%02d:%02d" -#: src/app/learnocaml_common.ml:533,34--55 -#: src/app/learnocaml_common.ml:1016,38--59 +#: src/app/learnocaml_common.ml:548,34--55 +#: src/app/learnocaml_common.ml:1035,38--59 msgid "difficulty: %d / 40" msgstr "difficulté: %d / 40" -#: src/app/learnocaml_common.ml:568,30--75 +#: src/app/learnocaml_common.ml:583,30--75 msgid "No description available for this exercise." msgstr "Aucune description pour cet exercice." -#: src/app/learnocaml_common.ml:590,32--41 -#: src/app/learnocaml_index_main.ml:155,54--63 +#: src/app/learnocaml_common.ml:606,32--41 +#: src/app/learnocaml_index_main.ml:147,54--63 msgid "project" msgstr "projet" -#: src/app/learnocaml_common.ml:591,32--41 -#: src/app/learnocaml_index_main.ml:156,54--63 +#: src/app/learnocaml_common.ml:607,32--41 +#: src/app/learnocaml_index_main.ml:148,54--63 msgid "problem" msgstr "problème" -#: src/app/learnocaml_common.ml:592,33--43 -#: src/app/learnocaml_index_main.ml:157,55--65 +#: src/app/learnocaml_common.ml:608,33--43 +#: src/app/learnocaml_index_main.ml:149,55--65 msgid "exercise" msgstr "exercice" -#: src/app/learnocaml_common.ml:744,26--33 +#: src/app/learnocaml_common.ml:760,26--33 msgid "Clear" msgstr "Effacer" -#: src/app/learnocaml_common.ml:749,25--32 -#: src/app/learnocaml_common.ml:870,24--31 +#: src/app/learnocaml_common.ml:765,25--32 +#: src/app/learnocaml_common.ml:886,24--31 msgid "Reset" msgstr "Réinitialiser" -#: src/app/learnocaml_common.ml:754,22--35 +#: src/app/learnocaml_common.ml:770,22--35 msgid "Eval phrase" msgstr "Évaluer la phrase" -#: src/app/learnocaml_common.ml:769,24--51 +#: src/app/learnocaml_common.ml:785,24--51 msgid "Preparing the environment" msgstr "Préparation de l'environnement" -#: src/app/learnocaml_common.ml:770,39--47 -#: src/app/learnocaml_common.ml:775,37--45 +#: src/app/learnocaml_common.ml:786,39--47 +#: src/app/learnocaml_common.ml:791,37--45 msgid "Editor" msgstr "Éditeur" -#: src/app/learnocaml_common.ml:771,41--51 -#: src/app/learnocaml_index_main.ml:907,30--40 +#: src/app/learnocaml_common.ml:787,41--51 +#: src/app/learnocaml_index_main.ml:957,30--40 msgid "Toplevel" msgstr "Toplevel" -#: src/app/learnocaml_common.ml:772,39--47 -#: src/app/learnocaml_common.ml:784,39--47 -#: src/app/learnocaml_exercise_main.ml:52,30--38 +#: src/app/learnocaml_common.ml:788,39--47 +#: src/app/learnocaml_common.ml:800,39--47 #: src/app/learnocaml_exercise_main.ml:56,30--38 -#: src/app/learnocaml_exercise_main.ml:61,30--38 +#: src/app/learnocaml_exercise_main.ml:60,30--38 +#: src/app/learnocaml_exercise_main.ml:65,30--38 #: src/app/learnocaml_student_view.ml:382,28--36 #: src/app/learnocaml_student_view.ml:395,30--38 #: src/app/learnocaml_student_view.ml:399,30--38 @@ -146,116 +155,115 @@ msgstr "Toplevel" msgid "Report" msgstr "Rapport" -#: src/app/learnocaml_common.ml:773,37--47 +#: src/app/learnocaml_common.ml:789,37--47 msgid "Exercise" msgstr "Exercice" -#: src/app/learnocaml_common.ml:774,37--46 +#: src/app/learnocaml_common.ml:790,37--46 msgid "Details" msgstr "Détails" -#: src/app/learnocaml_common.ml:776,27--70 +#: src/app/learnocaml_common.ml:792,27--70 msgid "Click the Grade button to get your report" msgstr "Cliquez sur le bouton Noter pour obtenir votre rapport" -#: src/app/learnocaml_common.ml:781,22--44 +#: src/app/learnocaml_common.ml:797,22--44 msgid "Loading student data" msgstr "Chargement des informations sur les étudiants" -#: src/app/learnocaml_common.ml:782,38--45 +#: src/app/learnocaml_common.ml:798,38--45 msgid "Stats" msgstr "Statistiques" -#: src/app/learnocaml_common.ml:783,37--48 -#: src/app/learnocaml_exercise_main.ml:196,23--34 -#: src/app/learnocaml_index_main.ml:904,48--59 +#: src/app/learnocaml_common.ml:799,37--48 +#: src/app/learnocaml_exercise_main.ml:200,23--34 +#: src/app/learnocaml_index_main.ml:954,29--40 #: src/app/learnocaml_teacher_tab.ml:328,18--29 msgid "Exercises" msgstr "Exercices" -#: src/app/learnocaml_common.ml:785,37--46 +#: src/app/learnocaml_common.ml:801,37--46 msgid "Subject" msgstr "Énoncé" -#: src/app/learnocaml_common.ml:786,39--47 +#: src/app/learnocaml_common.ml:802,39--47 msgid "Answer" msgstr "Réponse" -#: src/app/learnocaml_common.ml:871,22--42 +#: src/app/learnocaml_common.ml:887,22--42 msgid "START FROM SCRATCH" msgstr "TOUT RECOMMENCER" -#: src/app/learnocaml_common.ml:872,16--65 +#: src/app/learnocaml_common.ml:888,16--65 msgid "This will discard all your edits. Are you sure?" msgstr "Toutes vos modifications seront perdues. Vous êtes sûr·e ?" -#: src/app/learnocaml_common.ml:879,27--37 +#: src/app/learnocaml_common.ml:895,27--37 msgid "Download" msgstr "Télécharger" -#: src/app/learnocaml_common.ml:887,22--33 +#: src/app/learnocaml_common.ml:903,22--33 msgid "Eval code" msgstr "Évaluer le code" -#: src/app/learnocaml_common.ml:894,23--29 +#: src/app/learnocaml_common.ml:910,23--29 msgid "Sync" msgstr "Sync" -#: src/app/learnocaml_common.ml:947,34--49 +#: src/app/learnocaml_common.ml:963,34--49 msgid "OCaml prelude" msgstr "Prélude OCaml" -#: src/app/learnocaml_common.ml:954,59--65 +#: src/app/learnocaml_common.ml:970,59--65 msgid "Hide" msgstr "Cacher" -#: src/app/learnocaml_common.ml:961,59--65 +#: src/app/learnocaml_common.ml:977,59--65 msgid "Show" msgstr "Montrer" -#: src/app/learnocaml_common.ml:982,16--34 -#: src/app/learnocaml_lti_main.ml:114,40--58 -#: src/app/learnocaml_index_main.ml:802,27--45 +#: src/app/learnocaml_common.ml:1001,18--36 +#: src/app/learnocaml_index_main.ml:844,27--45 msgid "Enter the secret" msgstr "Entrez le secret" -#: src/app/learnocaml_common.ml:1022,22--35 +#: src/app/learnocaml_common.ml:1041,22--35 msgid "Difficulty:" msgstr "Difficulté :" -#: src/app/learnocaml_common.ml:1036,39--49 +#: src/app/learnocaml_common.ml:1055,39--49 msgid "Kind: %s" msgstr "Type : %s" -#: src/app/learnocaml_common.ml:1177,46--59 +#: src/app/learnocaml_common.ml:1196,46--59 msgid "Identifier:" msgstr "Identifiant de l'exercice :" -#: src/app/learnocaml_common.ml:1181,48--57 +#: src/app/learnocaml_common.ml:1200,48--57 msgid "Author:" msgstr "Auteur :" -#: src/app/learnocaml_common.ml:1182,47--57 +#: src/app/learnocaml_common.ml:1201,47--57 msgid "Authors:" msgstr "Auteurs :" -#: src/app/learnocaml_common.ml:1187,31--48 +#: src/app/learnocaml_common.ml:1206,31--48 msgid "Skills trained:" msgstr "Compétences pratiquées :" -#: src/app/learnocaml_common.ml:1191,31--49 +#: src/app/learnocaml_common.ml:1210,31--49 msgid "Skills required:" msgstr "Compétences requises :" -#: src/app/learnocaml_common.ml:1196,36--57 +#: src/app/learnocaml_common.ml:1215,36--57 msgid "Previous exercises:" msgstr "Exercices précédents :" -#: src/app/learnocaml_common.ml:1199,35--52 +#: src/app/learnocaml_common.ml:1218,35--52 msgid "Next exercises:" msgstr "Exercices suivants :" -#: src/app/learnocaml_common.ml:1204,26--36 +#: src/app/learnocaml_common.ml:1223,26--36 msgid "Metadata" msgstr "Métadonnées" @@ -346,20 +354,20 @@ msgstr "" msgid "The toplevel has been reset.\n" msgstr "Le toplevel a été redémarré.\n" -#: src/app/learnocaml_exercise_main.ml:25,20--79 +#: src/app/learnocaml_exercise_main.ml:27,22--81 msgid "WARNING: You have an older grader version than the server" msgstr "" "ATTENTION: La version locale du grader est plus ancienne que celle du serveur" -#: src/app/learnocaml_exercise_main.ml:26,23--41 +#: src/app/learnocaml_exercise_main.ml:28,25--43 msgid "Refresh the page" msgstr "Actualiser la page" -#: src/app/learnocaml_exercise_main.ml:28,27--49 +#: src/app/learnocaml_exercise_main.ml:30,29--51 msgid "I will do it myself!" msgstr "Je sais le faire moi-même!" -#: src/app/learnocaml_exercise_main.ml:29,22--178 +#: src/app/learnocaml_exercise_main.ml:31,24--180 msgid "" "The server has been updated, please refresh the page to make sure you are " "using the latest version of Learn-OCaml server (none of your work will be " @@ -369,11 +377,11 @@ msgstr "" "d'utiliser la dernière version du serveur Learn-OCaml (votre travail ne sera " "pas perdu)." -#: src/app/learnocaml_exercise_main.ml:86,18--29 +#: src/app/learnocaml_exercise_main.ml:90,18--29 msgid "TIME'S UP" msgstr "TEMPS ÉCOULÉ" -#: src/app/learnocaml_exercise_main.ml:87,7--119 +#: src/app/learnocaml_exercise_main.ml:91,7--119 msgid "" "The deadline for this exercise has expired. Any changes you make from now on " "will remain local only." @@ -381,46 +389,46 @@ msgstr "" "La date limite de rendu de cet exercice est passée. Vos changements ne " "seront plus sauvegardés sur le serveur." -#: src/app/learnocaml_exercise_main.ml:124,25--49 -#: src/app/learnocaml_playground_main.ml:41,19--43 +#: src/app/learnocaml_exercise_main.ml:128,25--49 +#: src/app/learnocaml_playground_main.ml:42,19--43 msgid "loading the prelude..." msgstr "Chargement du prélude..." -#: src/app/learnocaml_exercise_main.ml:129,41--59 -#: src/app/learnocaml_playground_main.ml:44,31--49 +#: src/app/learnocaml_exercise_main.ml:133,41--59 +#: src/app/learnocaml_playground_main.ml:45,31--49 msgid "error in prelude" msgstr "erreur dans le prélude" -#: src/app/learnocaml_exercise_main.ml:208,28--37 -#: src/app/learnocaml_playground_main.ml:78,28--37 +#: src/app/learnocaml_exercise_main.ml:212,28--37 +#: src/app/learnocaml_playground_main.ml:79,28--37 msgid "Compile" msgstr "Compiler" -#: src/app/learnocaml_exercise_main.ml:212,25--33 +#: src/app/learnocaml_exercise_main.ml:216,29--37 msgid "Grade!" msgstr "Noter!" -#: src/app/learnocaml_exercise_main.ml:217,48--55 +#: src/app/learnocaml_exercise_main.ml:220,48--55 msgid "abort" msgstr "abandonner" -#: src/app/learnocaml_exercise_main.ml:221,35--70 +#: src/app/learnocaml_exercise_main.ml:224,35--70 msgid "Grading is taking a lot of time, " msgstr "La notation prend longtemps, " -#: src/app/learnocaml_exercise_main.ml:227,35--57 +#: src/app/learnocaml_exercise_main.ml:230,35--57 msgid "Launching the grader" msgstr "Lancement de la notation" -#: src/app/learnocaml_exercise_main.ml:250,60--86 +#: src/app/learnocaml_exercise_main.ml:253,60--86 msgid "Grading aborted by user." msgstr "Notation annulée par l'utilisateur." -#: src/app/learnocaml_exercise_main.ml:271,38--59 +#: src/app/learnocaml_exercise_main.ml:274,38--59 msgid "Error in your code." msgstr "Erreur dans le code." -#: src/app/learnocaml_exercise_main.ml:272,27--85 +#: src/app/learnocaml_exercise_main.ml:275,27--85 msgid "Cannot start the grader if your code does not typecheck." msgstr "La notation ne peut être lancée si le code ne type pas." @@ -444,129 +452,166 @@ msgstr "" msgid "Unexpected error:\n" msgstr "Erreur inattendue:\n" +#: src/app/learnocaml_lti_main.ml:97,21--42 +#: src/app/learnocaml_index_main.ml:683,25--46 +msgid "VALIDATION REQUIRED" +msgstr "VALIDATION REQUISE" + +#: src/app/learnocaml_lti_main.ml:97,47--101 +#: src/app/learnocaml_index_main.ml:683,51--105 +#, fuzzy +msgid "A confirmation e-mail has been sent to your address." +msgstr "Un courriel sera envoyé à votre adresse pour la confirmer." + #: src/app/learnocaml_lti_main.ml:110,33--51 -#: src/app/learnocaml_index_main.ml:800,37--55 -#: src/app/learnocaml_index_main.ml:804,31--49 +#: src/app/learnocaml_index_main.ml:842,37--55 +#: src/app/learnocaml_index_main.ml:846,31--49 msgid "First connection" msgstr "Première connexion" -#: src/app/learnocaml_lti_main.ml:111,39--54 -#: src/app/learnocaml_lti_main.ml:122,32--47 -#: src/app/learnocaml_index_main.ml:805,37--52 -#: src/app/learnocaml_index_main.ml:813,30--45 -#: src/app/learnocaml_upgrade_main.ml:22,32--47 -msgid "Email address" +#: src/app/learnocaml_lti_main.ml:111,39--55 +#: src/app/learnocaml_lti_main.ml:123,32--48 +#: src/app/learnocaml_index_main.ml:847,37--53 +#: src/app/learnocaml_index_main.ml:856,30--46 +#: src/app/learnocaml_upgrade_main.ml:22,32--48 +#, fuzzy +msgid "E-mail address" msgstr "Adresse email" #: src/app/learnocaml_lti_main.ml:112,42--52 -#: src/app/learnocaml_index_main.ml:806,40--50 -#: src/app/learnocaml_index_main.ml:831,9--19 +#: src/app/learnocaml_index_main.ml:848,40--50 +#: src/app/learnocaml_index_main.ml:874,9--19 #: src/app/learnocaml_teacher_tab.ml:557,22--32 msgid "Nickname" msgstr "Pseudonyme" #: src/app/learnocaml_lti_main.ml:113,42--52 -#: src/app/learnocaml_lti_main.ml:123,35--45 -#: src/app/learnocaml_index_main.ml:807,40--50 -#: src/app/learnocaml_index_main.ml:814,33--43 +#: src/app/learnocaml_lti_main.ml:124,35--45 +#: src/app/learnocaml_index_main.ml:849,40--50 +#: src/app/learnocaml_index_main.ml:857,33--43 #: src/app/learnocaml_upgrade_main.ml:23,35--45 msgid "Password" msgstr "Mot de passe" -#: src/app/learnocaml_lti_main.ml:115,29--126 -#: src/app/learnocaml_index_main.ml:809,27--124 -msgid "The secret is the passphrase provided by your teacher to sign-up." -msgstr "Le secret est une phrase de passe fournie par votre enseignant au moment de l'inscription." +#: src/app/learnocaml_lti_main.ml:114,40--48 +#: src/app/learnocaml_index_main.ml:850,38--46 +msgid "Secret" +msgstr "Secret" + +#: src/app/learnocaml_lti_main.ml:115,29--198 +#: src/app/learnocaml_index_main.ml:851,27--192 +#, fuzzy +msgid "" +"The secret is an optional passphrase provided by your teacher. It may be " +"required to create an account." +msgstr "" +"Le secret est une phrase de passe fournie par votre enseignant au moment de " +"l'inscription." -#: src/app/learnocaml_lti_main.ml:117,41--251 -#: src/app/learnocaml_index_main.ml:817,39--244 +#: src/app/learnocaml_lti_main.ml:118,41--251 +#: src/app/learnocaml_index_main.ml:860,39--244 msgid "" "By submitting this form, I accept that the information entered will be used " "in the context of the Learn-OCaml plateform." -msgstr "En validant ce formulaire, j'accepte que les informations entrées puissent être utilisées dans le contexte de la plateforme Learn-OCaml." +msgstr "" +"En validant ce formulaire, j'accepte que les informations entrées puissent " +"être utilisées dans le contexte de la plateforme Learn-OCaml." -#: src/app/learnocaml_lti_main.ml:120,26--44 -#: src/app/learnocaml_index_main.ml:803,24--42 -#: src/app/learnocaml_index_main.ml:811,24--42 +#: src/app/learnocaml_lti_main.ml:121,26--44 +#: src/app/learnocaml_index_main.ml:854,24--42 msgid "Create new token" msgstr "Nouveau token" -#: src/app/learnocaml_lti_main.ml:121,26--42 -#: src/app/learnocaml_index_main.ml:812,24--40 +#: src/app/learnocaml_lti_main.ml:122,26--42 +#: src/app/learnocaml_index_main.ml:855,24--40 msgid "Returning user" msgstr "Utilisateur existant" -#: src/app/learnocaml_lti_main.ml:124,32--41 -#: src/app/learnocaml_index_main.ml:815,31--40 -#: src/app/learnocaml_index_main.ml:822,30--39 +#: src/app/learnocaml_lti_main.ml:125,32--41 +#: src/app/learnocaml_index_main.ml:858,31--40 +#: src/app/learnocaml_index_main.ml:865,30--39 msgid "Connect" msgstr "Se connecter" -#: src/app/learnocaml_lti_main.ml:125,32--55 -#: src/app/learnocaml_index_main.ml:816,30--53 +#: src/app/learnocaml_lti_main.ml:126,32--55 +#: src/app/learnocaml_index_main.ml:859,30--53 msgid "Forgot your password?" msgstr "Mot de passe oublié ?" -#: src/app/learnocaml_lti_main.ml:126,29--43 -#: src/app/learnocaml_lti_main.ml:127,36--50 +#: src/app/learnocaml_lti_main.ml:127,38--57 +#: src/app/learnocaml_index_main.ml:843,44--63 +msgid "Choose a nickname" +msgstr "Choisissez un identifiant" + +#: src/app/learnocaml_lti_main.ml:128,29--43 +#: src/app/learnocaml_lti_main.ml:132,36--50 msgid "Direct login" msgstr "Connexion directe" -#: src/app/learnocaml_index_main.ml:96,18--37 +#: src/app/learnocaml_lti_main.ml:129,31--221 +msgid "" +"Or to be able to login independently of Moodle, you might want to setup a " +"password below (or upgrade your account later)" +msgstr "" +"Ou pour pouvoir vous connecter sans passer par Moodle, vous pouvez " +"créer un compte avec un mot de passe en dessous (ou en définir un plus " +"tard)" + +#: src/app/learnocaml_index_main.ml:88,18--37 msgid "Loading exercises" msgstr "Chargement des exercices" -#: src/app/learnocaml_index_main.ml:129,32--49 +#: src/app/learnocaml_index_main.ml:121,32--49 msgid "Exercise closed" msgstr "Exercice fermé" -#: src/app/learnocaml_index_main.ml:130,47--62 +#: src/app/learnocaml_index_main.ml:122,47--62 msgid "Time left: %s" msgstr "Temps restant: %s" -#: src/app/learnocaml_index_main.ml:177,28--61 +#: src/app/learnocaml_index_main.ml:169,28--61 msgid "No open exercises at the moment" msgstr "Aucun exercice n'est encore ouvert" -#: src/app/learnocaml_index_main.ml:184,18--38 +#: src/app/learnocaml_index_main.ml:176,18--38 msgid "Loading playground" msgstr "Chargement du bac-à-sable" -#: src/app/learnocaml_index_main.ml:210,18--35 +#: src/app/learnocaml_index_main.ml:202,18--35 msgid "Loading lessons" msgstr "Chargement des cours" -#: src/app/learnocaml_index_main.ml:243,37--61 +#: src/app/learnocaml_index_main.ml:235,37--61 msgid "Running OCaml examples" msgstr "Lancement des exemples d'OCaml" -#: src/app/learnocaml_index_main.ml:284,39--45 -#: src/app/learnocaml_index_main.ml:473,39--45 +#: src/app/learnocaml_index_main.ml:276,39--45 +#: src/app/learnocaml_index_main.ml:465,39--45 msgid "Prev" msgstr "Prec." -#: src/app/learnocaml_index_main.ml:300,40--46 -#: src/app/learnocaml_index_main.ml:490,40--46 +#: src/app/learnocaml_index_main.ml:292,40--46 +#: src/app/learnocaml_index_main.ml:482,40--46 msgid "Next" msgstr "Suiv." -#: src/app/learnocaml_index_main.ml:357,18--37 +#: src/app/learnocaml_index_main.ml:349,18--37 msgid "Loading tutorials" msgstr "Chargement des tutoriels" -#: src/app/learnocaml_index_main.ml:523,18--35 +#: src/app/learnocaml_index_main.ml:515,18--35 msgid "Launching OCaml" msgstr "Démarrage d'OCaml" -#: src/app/learnocaml_index_main.ml:536,18--40 +#: src/app/learnocaml_index_main.ml:528,18--40 msgid "Loading student info" msgstr "Chargement des informations sur les étudiants" -#: src/app/learnocaml_index_main.ml:566,22--46 +#: src/app/learnocaml_index_main.ml:558,22--46 msgid "Your Learn-OCaml token" msgstr "Votre token Learn-OCaml" -#: src/app/learnocaml_index_main.ml:567,20--145 +#: src/app/learnocaml_index_main.ml:559,20--145 msgid "" "Your token is displayed below. It identifies you and allows to share your " "workspace between devices." @@ -574,120 +619,162 @@ msgstr "" "Votre token est affiché ci-dessous. Il vous identifie et permet de partager " "un même espace de travail entre plusieurs machines." -#: src/app/learnocaml_index_main.ml:569,20--43 +#: src/app/learnocaml_index_main.ml:561,20--43 msgid "Please write it down." msgstr "Notez-le !" -#: src/app/learnocaml_index_main.ml:575,21--41 +#: src/app/learnocaml_index_main.ml:567,21--36 +#, fuzzy +msgid "RESET REQUEST" +msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" + +#: src/app/learnocaml_index_main.ml:568,11--51 +#, fuzzy +msgid "A reset link was sent to the address: " +msgstr "Un lien de réinitialisation a été envoyé à l'adresse spécifiée." + +#: src/app/learnocaml_index_main.ml:569,35--76 +msgid "" +"\n" +"(if it is associated with an account)" +msgstr "" +"\n" +"(si il est associé à un compte)" + +#: src/app/learnocaml_index_main.ml:574,10--43 +#: src/app/learnocaml_index_main.ml:758,38--71 +#, fuzzy +msgid "The entered e-mail was invalid." +msgstr "Le token entré n'a pas été reconnu." + +#: src/app/learnocaml_index_main.ml:587,21--41 msgid "RESET REQUEST SENT" msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" -#: src/app/learnocaml_index_main.ml:576,10--64 -msgid "A reset link has been sent to the specified address." +#: src/app/learnocaml_index_main.ml:588,11--65 +#, fuzzy +msgid "A confirmation e-mail has been sent to the address: " msgstr "Un lien de réinitialisation a été envoyé à l'adresse spécifiée." -#: src/app/learnocaml_index_main.ml:579,21--37 +#: src/app/learnocaml_index_main.ml:593,10--54 #, fuzzy -msgid "USER NOT FOUND" -msgstr "TOKEN NON TROUVÉ" +msgid "The entered e-mail couldn't be recognized." +msgstr "Le token entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:580,10--53 +#: src/app/learnocaml_index_main.ml:615,12--45 #, fuzzy -msgid "The entered email couldn't be recognised." +msgid "The entered e-mail is invalid: " msgstr "Le token entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:677,28--45 -#: src/app/learnocaml_index_main.ml:700,26--43 -#: src/app/learnocaml_index_main.ml:710,29--46 +#: src/app/learnocaml_index_main.ml:703,28--45 +#: src/app/learnocaml_index_main.ml:739,29--46 msgid "TOKEN NOT FOUND" msgstr "TOKEN NON TROUVÉ" -#: src/app/learnocaml_index_main.ml:678,17--60 -#: src/app/learnocaml_index_main.ml:701,15--58 -#: src/app/learnocaml_index_main.ml:711,18--61 -msgid "The entered token couldn't be recognised." +#: src/app/learnocaml_index_main.ml:704,17--60 +#: src/app/learnocaml_index_main.ml:740,18--61 +#, fuzzy +msgid "The entered token couldn't be recognized." msgstr "Le token entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:795,7--21 +#: src/app/learnocaml_index_main.ml:726,26--41 +#, fuzzy +msgid "INVALID TOKEN" +msgstr "PSEUDONYME INVALIDE" + +#: src/app/learnocaml_index_main.ml:727,31--200 +msgid "" +"This token is associated to an upgraded account, which only allows password-" +"based%s authentication." +msgstr "" +"Ce token est associé à un compte, autorisant uniquement " +"l'authentification par mot de passe%s." + +#: src/app/learnocaml_index_main.ml:730,54--70 +msgid " or Moodle/LTI" +msgstr " ou avec Moodle/LTI" + +#: src/app/learnocaml_index_main.ml:837,7--21 msgid "Connected as" msgstr "Connecté en tant que" -#: src/app/learnocaml_index_main.ml:797,7--19 +#: src/app/learnocaml_index_main.ml:839,7--19 msgid "Activities" msgstr "Activités" -#: src/app/learnocaml_index_main.ml:799,9--33 +#: src/app/learnocaml_index_main.ml:841,9--33 msgid "Welcome to Learn OCaml" msgstr "Bienvenue sur Learn OCaml" -#: src/app/learnocaml_index_main.ml:801,44--63 -msgid "Choose a nickname" -msgstr "Choisissez un identifiant" - -#: src/app/learnocaml_index_main.ml:808,38--46 -msgid "Secret" -msgstr "Secret" +#: src/app/learnocaml_index_main.ml:845,24--40 +#, fuzzy +msgid "Create account" +msgstr "Passer à un compte" -#: src/app/learnocaml_index_main.ml:820,35--55 -msgid "Login with a token" +#: src/app/learnocaml_index_main.ml:863,35--62 +#, fuzzy +msgid "Login with a legacy token" msgstr "Connexion avec un token" -#: src/app/learnocaml_index_main.ml:821,30--37 +#: src/app/learnocaml_index_main.ml:864,30--37 #: src/app/learnocaml_teacher_tab.ml:559,22--29 msgid "Token" msgstr "Token" -#: src/app/learnocaml_index_main.ml:823,22--39 +#: src/app/learnocaml_index_main.ml:866,22--39 #: src/app/learnocaml_upgrade_main.ml:21,26--43 msgid "Upgrade account" msgstr "Passer à un compte" -#: src/app/learnocaml_index_main.ml:865,38--59 +#: src/app/learnocaml_index_main.ml:908,38--59 msgid "Choose an activity." msgstr "Sélectionnez une activité." -#: src/app/learnocaml_index_main.ml:882,27--46 -msgid "New email address" +#: src/app/learnocaml_index_main.ml:927,31--51 +#, fuzzy +msgid "New e-mail address" msgstr "Nouvelle adresse email" -#: src/app/learnocaml_index_main.ml:883,18--50 -msgid "Enter your new email address: " +#: src/app/learnocaml_index_main.ml:928,22--55 +#, fuzzy +msgid "Enter your new e-mail address: " msgstr "Entrez votre nouvelle adresse email :" -#: src/app/learnocaml_index_main.ml:888,22--39 +#: src/app/learnocaml_index_main.ml:938,22--39 msgid "Change password" msgstr "Changer de mot de passe" -#: src/app/learnocaml_index_main.ml:889,22--36 -msgid "Change email" +#: src/app/learnocaml_index_main.ml:939,22--37 +#, fuzzy +msgid "Change e-mail" msgstr "Changer d'adresse email" -#: src/app/learnocaml_index_main.ml:900,30--41 +#: src/app/learnocaml_index_main.ml:950,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:902,29--38 +#: src/app/learnocaml_index_main.ml:952,29--38 msgid "Lessons" msgstr "Cours" -#: src/app/learnocaml_index_main.ml:909,32--44 -#: src/app/learnocaml_playground_main.ml:71,23--35 +#: src/app/learnocaml_index_main.ml:959,32--44 +#: src/app/learnocaml_playground_main.ml:72,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:912,28--35 +#: src/app/learnocaml_index_main.ml:962,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:1012,17--71 +#: src/app/learnocaml_index_main.ml:1062,17--71 msgid "Be sure to write down your token before logging out:" msgstr "Assurez-vous d'avoir noté votre token :" -#: src/app/learnocaml_index_main.ml:1014,17--51 +#: src/app/learnocaml_index_main.ml:1064,17--51 msgid "Are you sure you want to logout?" msgstr "Êtes-vous sûr de vouloir vous déconnecter ?" -#: src/app/learnocaml_index_main.ml:1016,15--186 +#: src/app/learnocaml_index_main.ml:1066,15--186 msgid "" "WARNING: the data could not be synchronised with the server. Logging out " "will lose your local changes, be sure you exported a backup." @@ -696,33 +783,33 @@ msgstr "" "En vous déconnectant, vous perdrez tous les changements locaux, à moins " "d'avoir exporté votre espace de travail au préalable." -#: src/app/learnocaml_index_main.ml:1027,22--30 -#: src/app/learnocaml_index_main.ml:1027,45--53 -#: src/app/learnocaml_index_main.ml:1049,9--17 +#: src/app/learnocaml_index_main.ml:1077,22--30 +#: src/app/learnocaml_index_main.ml:1077,45--53 +#: src/app/learnocaml_index_main.ml:1099,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:1040,9--21 +#: src/app/learnocaml_index_main.ml:1090,9--21 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:1043,9--25 +#: src/app/learnocaml_index_main.ml:1093,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:1046,9--25 +#: src/app/learnocaml_index_main.ml:1096,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:1047,9--17 +#: src/app/learnocaml_index_main.ml:1097,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:1048,9--36 +#: src/app/learnocaml_index_main.ml:1098,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:1054,38--44 +#: src/app/learnocaml_index_main.ml:1104,38--44 msgid "Menu" msgstr "Menu" @@ -933,8 +1020,9 @@ msgstr "Suivi étudiant: " msgid "Upgrade" msgstr "Noter!" -#: src/app/learnocaml_upgrade_main.ml:25,23--77 -msgid "An email will be sent to your address to confirm it." +#: src/app/learnocaml_upgrade_main.ml:25,23--78 +#, fuzzy +msgid "An e-mail will be sent to your address to confirm it." msgstr "Un courriel sera envoyé à votre adresse pour la confirmer." #: src/app/learnocaml_upgrade_main.ml:28,38--48 @@ -949,8 +1037,9 @@ msgstr "Vous n'êtes pas connecté" msgid "EMAIL CONFIRMED" msgstr "ADRESSE EMAIL CONFIRMÉE" -#: src/app/learnocaml_validate_main.ml:13,40--79 -msgid "Your email address has been confirmed" +#: src/app/learnocaml_validate_main.ml:13,40--81 +#, fuzzy +msgid "Your e-mail address has been confirmed." msgstr "Votre adresse email a été confirmée" #: src/grader/learnocaml_report.ml:240,50--66 @@ -1079,6 +1168,10 @@ msgstr "lors du chargement des dépendances" msgid "while testing your solution" msgstr "lors du test de la solution utilisateur" +#, fuzzy +#~ msgid "USER NOT FOUND" +#~ msgstr "TOKEN NON TROUVÉ" + #~ msgid "Enter your token" #~ msgstr "Entrez votre token" @@ -1165,9 +1258,6 @@ msgstr "lors du test de la solution utilisateur" #~ msgid "Remove tags" #~ msgstr "Retirer les tags" -#~ msgid "INVALID NICKNAME" -#~ msgstr "PSEUDONYME INVALIDE" - #~ msgid "You must provide a nickname" #~ msgstr "Un pseudonyme est requis" @@ -1180,3 +1270,4 @@ msgstr "lors du test de la solution utilisateur" #~ msgid "This session has been closed. You can close this tab." #~ msgstr "La session a été fermée. Vous pouvez fermer cet onglet." + From 1166e31650e7cf17d98899ed05d414400e3e7ee5 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 8 Sep 2020 21:06:03 +0200 Subject: [PATCH 102/161] feat: Add simple password strength evaluation In learnocaml_data.ml: * Define passwd_check_length to factor-out the tests ensuring that `String.length password >= 8` * Define passwd_check_strength, and use it in learn-ocaml-client and sign-up forms. In learnocaml_*_main.ml: * Display an alert popup if the email, resp. password, is rejected. --- src/app/learnocaml_index_main.ml | 23 ++++++++++++++++++++--- src/app/learnocaml_lti_main.ml | 23 ++++++++++++++++++++--- src/main/learnocaml_client.ml | 6 +++++- src/server/learnocaml_server.ml | 19 ++++++++++--------- src/state/learnocaml_data.ml | 21 +++++++++++++++++++++ src/state/learnocaml_data.mli | 9 +++++++++ 6 files changed, 85 insertions(+), 16 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index e1dfe5268..779699681 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -656,18 +656,35 @@ let init_token_dialog () = consent = Manip.checked input_consent and consent_label = find_component "txt_first_connection_consent" in let email_criteria = not (check_email_js email) and - passwd_criteria = String.length password < 8 in + passwd_crit1 = not (Learnocaml_data.passwd_check_length password) and + passwd_crit2 = not (Learnocaml_data.passwd_check_strength password) in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; Manip.SetCss.fontWeight consent_label ""; - if email_criteria || passwd_criteria || not consent then + if email_criteria || passwd_crit1 || passwd_crit2 || not consent then begin if email_criteria then Manip.SetCss.borderColor reg_input_email "#f44"; - if passwd_criteria then + if passwd_crit1 || passwd_crit2 then Manip.SetCss.borderColor reg_input_password "#f44"; if not consent then Manip.SetCss.fontWeight consent_label "bold"; + if email_criteria then begin + alert ~title:[%i"ERROR"] + [%i"The entered e-mail was invalid."]; + (* ; we could also do [Manip.focus reg_input_email] + but this would be broken when closing the dialog. *) + end + else if passwd_crit1 then begin + alert ~title:[%i"ERROR"] + [%i"Password must be at least 8 characters long"]; + end + else if passwd_crit2 then begin + alert ~title:[%i"ERROR"] + [%i"Password must contain at least one digit, \ + one lower and upper letter, \ + and one non-alphanumeric char."]; + end; Lwt.return_none end else diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index a90d36ffd..7aca6e908 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -71,18 +71,35 @@ let create_token () = consent_label = find_component "txt_first_connection_consent" in (* 5 for a character, @, character, dot, character. *) let email_criteria = not (check_email_js email) and - passwd_criteria = String.length password < 8 in + passwd_crit1 = not (Learnocaml_data.passwd_check_length password) and + passwd_crit2 = not (Learnocaml_data.passwd_check_strength password) in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; Manip.SetCss.fontWeight consent_label ""; - if email_criteria || passwd_criteria || not consent then + if email_criteria || passwd_crit1 || passwd_crit2 || not consent then begin if email_criteria then Manip.SetCss.borderColor reg_input_email "#f44"; - if passwd_criteria then + if passwd_crit1 || passwd_crit2 then Manip.SetCss.borderColor reg_input_password "#f44"; if not consent then Manip.SetCss.fontWeight consent_label "bold"; + if email_criteria then begin + alert ~title:[%i"ERROR"] + [%i"The entered e-mail was invalid."]; + (* ; we could also do [Manip.focus reg_input_email] + but this would be broken when closing the dialog. *) + end + else if passwd_crit1 then begin + alert ~title:[%i"ERROR"] + [%i"Password must be at least 8 characters long"]; + end + else if passwd_crit2 then begin + alert ~title:[%i"ERROR"] + [%i"Password must contain at least one digit, \ + one lower and upper letter, \ + and one non-alphanumeric char."]; + end; Lwt.return_unit end else diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index 73c416287..b1183b438 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -747,8 +747,12 @@ module Init_user = struct | {email; password; nickname=Some(nickname); secret=Some(secret)} -> if not (check_email_ml email) then Lwt.fail_with "Invalid e-mail address" - else if String.length password < 8 then + else if not (Learnocaml_data.passwd_check_length password) then Lwt.fail_with "Password must be at least 8 characters long" + else if not (Learnocaml_data.passwd_check_strength password) then + Lwt.fail_with "Password must contain at least one digit, \ + one lower and upper letter, \ + and one non-alphanumeric char." else get_nonce_and_create_user server email password nickname secret >>= fun () -> Printf.eprintf "A confirmation e-mail has been sent to your address."; diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 0114cd0da..d7238e1d7 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -352,11 +352,11 @@ module Request_handler = struct ~path:"/" ~http_only:true ("csrf", "expired")] in let email = List.assoc "email" params and - passwd = List.assoc "passwd" params and + password = List.assoc "passwd" params and user_id = List.assoc "user-id" params and csrf = List.assoc "csrf" params and hmac = List.assoc "hmac" params in - Token_index.UserIndex.authenticate !sync_dir (Token_index.Passwd (email, passwd)) >>= + Token_index.UserIndex.authenticate !sync_dir (Token_index.Passwd (email, password)) >>= (function | None -> lwt_fail (`Forbidden, "incorrect password") | Some token -> @@ -454,7 +454,7 @@ module Request_handler = struct lwt_fail (`Forbidden, "User already exists") else if not (check_email_ml email) then lwt_fail (`Bad_request, "Invalid e-mail address") - else if String.length password < 8 then + else if not (Learnocaml_data.passwd_check_length password) then lwt_fail (`Bad_request, "Password must be at least 8 characters long") else create_student conn config req nonce_req secret (Some nick) (`Password (email, password)) >?= fun _ -> @@ -777,14 +777,14 @@ module Request_handler = struct Token_index.UpgradeIndex.can_reset_password !sync_dir handle >>= (function | Some token -> - let passwd = List.assoc "passwd" params and + let password = List.assoc "passwd" params and cookies = [Cohttp.Cookie.Set_cookie_hdr.make ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" ~http_only:true ("csrf", "expired")] in - if String.length passwd < 8 then + if not (Learnocaml_data.passwd_check_length password) then lwt_ok @@ Redirect { code=`See_other; url="/reset_password/" ^ handle; cookies } else - Token_index.UserIndex.update !sync_dir token passwd >>= fun () -> + Token_index.UserIndex.update !sync_dir token password >>= fun () -> Token_index.UpgradeIndex.revoke_operation !sync_dir handle >>= fun () -> lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | None -> @@ -851,14 +851,15 @@ module Request_handler = struct ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and email = List.assoc "email" params and - passwd = List.assoc "passwd" params in + password = List.assoc "passwd" params in Token_index.UserIndex.exists !sync_dir email >>= fun exists -> if exists then lwt_fail (`Forbidden, "E-mail already used") - else if String.length passwd < 8 || not (check_email_ml email) then + else if not (Learnocaml_data.passwd_check_length password) + || not (check_email_ml email) then lwt_ok @@ Redirect { code=`See_other; url="/upgrade"; cookies } else let cookies = make_cookie ("token", Token.to_string token) :: cookies in - Token_index.UserIndex.upgrade !sync_dir token email passwd >>= fun () -> + Token_index.UserIndex.upgrade !sync_dir token email password >>= fun () -> Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> get_nickname token >>= fun nick -> Learnocaml_sendmail.confirm_email diff --git a/src/state/learnocaml_data.ml b/src/state/learnocaml_data.ml index 10bc07b94..d95d0067b 100644 --- a/src/state/learnocaml_data.ml +++ b/src/state/learnocaml_data.ml @@ -18,6 +18,27 @@ let email_regexp_ml = let email_check_length email = String.length email <= 254 && try String.index email '@' <= 64 with _ -> false +let passwd_check_length passwd = + String.length passwd >= 8 + +let passwd_check_strength passwd = + let digit c = '0' <= c && c <= '9' in + let upper c = 'A' <= c && c <= 'Z' in + let lower c = 'a' <= c && c <= 'z' in + let other c = (not @@ digit c) && (not @@ upper c) && (not @@ lower c) in + let one_digit = ref false in + let one_upper = ref false in + let one_lower = ref false in + let one_other = ref false in + let inspect c = begin + if digit c then one_digit := true; + if upper c then one_upper := true; + if lower c then one_lower := true; + if other c then one_other := true + end in + let () = String.iter inspect passwd in + !one_digit && !one_upper && !one_lower && !one_other + module J = Json_encoding module SMap = struct diff --git a/src/state/learnocaml_data.mli b/src/state/learnocaml_data.mli index 9ee1e4a1d..7f6786e8e 100644 --- a/src/state/learnocaml_data.mli +++ b/src/state/learnocaml_data.mli @@ -16,6 +16,15 @@ val email_regexp_ml : string (** "local-part@domain" must have upto 254 chars, "local-part" upto 64 chars. *) val email_check_length : string -> bool +(** Passwords must have at least 8 chars. Return false if this doesn't hold. + Function used in frontend/backend. *) +val passwd_check_length : string -> bool + +(** Naive evaluation of password strength, independently of its length + (require at least one digit, lower, upper, non-alphanumeric char). + Especially intended to be used in frontend. *) +val passwd_check_strength : string -> bool + module SMap: sig include Map.S with type key = string From 46505b00117e7854f2e221df16d40216b38a1def Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 8 Sep 2020 22:37:26 +0200 Subject: [PATCH 103/161] fix(token_index.ml): Simplify & Fix the expiration check --- src/state/token_index.ml | 16 ++++++---------- 1 file changed, 6 insertions(+), 10 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 6f27b490e..e58e018c6 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -466,13 +466,11 @@ module BaseUpgradeIndex (RW: IndexRW) = struct let check_upgrade_operation kind sync_dir handle = get_data sync_dir >|= fun operations -> - let expiration_threshold, _ = - Unix.( - let dt = localtime @@ time () in - mktime {dt with tm_hour = dt.tm_hour + 4}) in + (* expires after 4 hours *) + let expiration_threshold = floor (Unix.time ()) +. 4. *. 3600. in match List.assoc_opt handle operations with | Some (token, date, ResetPassword) - when kind = ResetPassword && date >= expiration_threshold -> Some token + when kind = ResetPassword && date <= expiration_threshold -> Some token | Some (token, _date, ChangeEmail) when kind = ChangeEmail -> Some token | _ -> None @@ -486,12 +484,10 @@ module BaseUpgradeIndex (RW: IndexRW) = struct let filter_old_operations sync_dir = get_data sync_dir >>= fun operations -> - let expiration_threshold, _ = - Unix.( - let dt = localtime @@ time () in - mktime {dt with tm_mon = dt.tm_mon + 1}) in + (* expires after 4 weeks *) + let expiration_threshold = floor (Unix.time ()) +. 4. *. 604800. in List.filter (fun (_id, (_token, date, operation)) -> - operation = ChangeEmail || date >= expiration_threshold) operations + operation = ChangeEmail || date <= expiration_threshold) operations |> RW.write rw (sync_dir / indexes_subdir / file) serialise end From 562ae5e8b7e65363f99b9cb753de1601cdb6285a Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 8 Sep 2020 22:27:03 +0200 Subject: [PATCH 104/161] [learnocaml_sendmail.ml] Mention that the reset-password link expires --- src/utils/learnocaml_sendmail.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/utils/learnocaml_sendmail.ml b/src/utils/learnocaml_sendmail.ml index b27ccffae..60aa02483 100644 --- a/src/utils/learnocaml_sendmail.ml +++ b/src/utils/learnocaml_sendmail.ml @@ -72,6 +72,8 @@ Please follow the following link to do so: %s Otherwise, no further action is required. + +Note: the reset link will expire in 4 hours. |} let reset_subject = "Change your password" From 831001a4f6a95107e0a5f563343412ee5a3fe491 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 8 Sep 2020 22:54:41 +0200 Subject: [PATCH 105/161] fix: Check password strength at server side as well * Otherwise the reset and upgrade forms would not check it * Also, add some remark items in these two forms --- src/app/learnocaml_reset_main.ml | 4 ++++ src/app/learnocaml_upgrade_main.ml | 4 ++++ src/server/learnocaml_server.ml | 5 +++++ static/reset.html | 4 ++++ static/upgrade.html | 4 ++++ 5 files changed, 21 insertions(+) diff --git a/src/app/learnocaml_reset_main.ml b/src/app/learnocaml_reset_main.ml index c67ea1041..822e9780e 100644 --- a/src/app/learnocaml_reset_main.ml +++ b/src/app/learnocaml_reset_main.ml @@ -17,6 +17,10 @@ let () = (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); Manip.SetCss.display (find_component "login-overlay") "block"; set_string_translations [ + "txt_password_length", [%i"Password must be at least 8 characters long"]; + "txt_password_strength", [%i"Password must contain at least one digit, \ + one lower and upper letter, \ + and one non-alphanumeric char."]; "txt_passwd_reset", [%i"Reset password"]; "txt_new_passwd", [%i"New password"]; "txt_submit", [%i"Submit"] diff --git a/src/app/learnocaml_upgrade_main.ml b/src/app/learnocaml_upgrade_main.ml index 520fe8658..c812ec84c 100644 --- a/src/app/learnocaml_upgrade_main.ml +++ b/src/app/learnocaml_upgrade_main.ml @@ -18,6 +18,10 @@ let () = try Manip.SetCss.display (find_component "login-overlay") "block"; set_string_translations [ + "txt_password_length", [%i"Password must be at least 8 characters long"]; + "txt_password_strength", [%i"Password must contain at least one digit, \ + one lower and upper letter, \ + and one non-alphanumeric char."]; "txt_upgrade", [%i"Upgrade account"]; "txt_upgrade_email", [%i"E-mail address"]; "txt_upgrade_password", [%i"Password"]; diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index d7238e1d7..e0b3d1367 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -456,6 +456,8 @@ module Request_handler = struct lwt_fail (`Bad_request, "Invalid e-mail address") else if not (Learnocaml_data.passwd_check_length password) then lwt_fail (`Bad_request, "Password must be at least 8 characters long") + else if not (Learnocaml_data.passwd_check_strength password) then + lwt_fail (`Bad_request, "Password too weak") else create_student conn config req nonce_req secret (Some nick) (`Password (email, password)) >?= fun _ -> respond_json cache () @@ -783,6 +785,8 @@ module Request_handler = struct ~http_only:true ("csrf", "expired")] in if not (Learnocaml_data.passwd_check_length password) then lwt_ok @@ Redirect { code=`See_other; url="/reset_password/" ^ handle; cookies } + else if not (Learnocaml_data.passwd_check_strength password) then + lwt_ok @@ Redirect { code=`See_other; url="/reset_password/" ^ handle; cookies } else Token_index.UserIndex.update !sync_dir token password >>= fun () -> Token_index.UpgradeIndex.revoke_operation !sync_dir handle >>= fun () -> @@ -855,6 +859,7 @@ module Request_handler = struct Token_index.UserIndex.exists !sync_dir email >>= fun exists -> if exists then lwt_fail (`Forbidden, "E-mail already used") else if not (Learnocaml_data.passwd_check_length password) + || not (Learnocaml_data.passwd_check_strength password) || not (check_email_ml email) then lwt_ok @@ Redirect { code=`See_other; url="/upgrade"; cookies } else diff --git a/static/reset.html b/static/reset.html index cd49ad48c..fb9a92abd 100644 --- a/static/reset.html +++ b/static/reset.html @@ -19,6 +19,10 @@

+
    +
    • +
    • +
diff --git a/static/upgrade.html b/static/upgrade.html index 9d44c068b..68cd14b1c 100644 --- a/static/upgrade.html +++ b/static/upgrade.html @@ -32,6 +32,10 @@

+
    +
    • +
    • +
From b1422b7c2c5e58a72629be304660b2f48be2f0b2 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 8 Sep 2020 17:57:11 +0200 Subject: [PATCH 106/161] fix: Update translations/fr.po --- translations/fr.po | 305 +++++++++++++++++++++++---------------------- 1 file changed, 155 insertions(+), 150 deletions(-) diff --git a/translations/fr.po b/translations/fr.po index 7c74ff685..eb10373a0 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-03 22:46+0200\n" +"PO-Revision-Date: 2020-09-08 23:02+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -24,11 +24,17 @@ msgid "OK" msgstr "OK" #: src/app/learnocaml_common.ml:139,21--28 +#: src/app/learnocaml_lti_main.ml:88,26--33 +#: src/app/learnocaml_lti_main.ml:94,26--33 +#: src/app/learnocaml_lti_main.ml:98,26--33 #: src/app/learnocaml_index_main.ml:573,21--28 #: src/app/learnocaml_index_main.ml:592,21--28 #: src/app/learnocaml_index_main.ml:614,22--29 -#: src/app/learnocaml_index_main.ml:694,25--32 -#: src/app/learnocaml_index_main.ml:758,26--33 +#: src/app/learnocaml_index_main.ml:673,30--37 +#: src/app/learnocaml_index_main.ml:679,30--37 +#: src/app/learnocaml_index_main.ml:683,30--37 +#: src/app/learnocaml_index_main.ml:711,25--32 +#: src/app/learnocaml_index_main.ml:775,26--33 msgid "ERROR" msgstr "ERREUR" @@ -37,24 +43,24 @@ msgstr "ERREUR" #: src/app/learnocaml_common.ml:423,12--20 #: src/app/learnocaml_index_main.ml:582,12--20 #: src/app/learnocaml_index_main.ml:601,12--20 -#: src/app/learnocaml_index_main.ml:712,19--27 -#: src/app/learnocaml_index_main.ml:748,20--28 +#: src/app/learnocaml_index_main.ml:729,19--27 +#: src/app/learnocaml_index_main.ml:765,20--28 msgid "Cancel" msgstr "Annuler" #: src/app/learnocaml_common.ml:415,26--41 #: src/app/learnocaml_index_main.ml:577,25--40 #: src/app/learnocaml_index_main.ml:596,25--40 -#: src/app/learnocaml_index_main.ml:707,32--47 -#: src/app/learnocaml_index_main.ml:743,33--48 +#: src/app/learnocaml_index_main.ml:724,32--47 +#: src/app/learnocaml_index_main.ml:760,33--48 msgid "REQUEST ERROR" msgstr "ERREUR DE REQUÊTE" #: src/app/learnocaml_common.ml:416,22--59 #: src/app/learnocaml_index_main.ml:578,26--63 #: src/app/learnocaml_index_main.ml:597,26--63 -#: src/app/learnocaml_index_main.ml:708,30--67 -#: src/app/learnocaml_index_main.ml:744,34--71 +#: src/app/learnocaml_index_main.ml:725,30--67 +#: src/app/learnocaml_index_main.ml:761,34--71 msgid "Could not retrieve data from server" msgstr "Échec lors du téléchargement des données du serveur" @@ -62,8 +68,8 @@ msgstr "Échec lors du téléchargement des données du serveur" #: src/app/learnocaml_common.ml:459,11--18 #: src/app/learnocaml_index_main.ml:581,12--19 #: src/app/learnocaml_index_main.ml:600,12--19 -#: src/app/learnocaml_index_main.ml:711,19--26 -#: src/app/learnocaml_index_main.ml:747,20--27 +#: src/app/learnocaml_index_main.ml:728,19--26 +#: src/app/learnocaml_index_main.ml:764,20--27 msgid "Retry" msgstr "Réessayer" @@ -139,7 +145,7 @@ msgid "Editor" msgstr "Éditeur" #: src/app/learnocaml_common.ml:787,41--51 -#: src/app/learnocaml_index_main.ml:957,30--40 +#: src/app/learnocaml_index_main.ml:974,30--40 msgid "Toplevel" msgstr "Toplevel" @@ -177,7 +183,7 @@ msgstr "Statistiques" #: src/app/learnocaml_common.ml:799,37--48 #: src/app/learnocaml_exercise_main.ml:200,23--34 -#: src/app/learnocaml_index_main.ml:954,29--40 +#: src/app/learnocaml_index_main.ml:971,29--40 #: src/app/learnocaml_teacher_tab.ml:328,18--29 msgid "Exercises" msgstr "Exercices" @@ -223,7 +229,7 @@ msgid "Show" msgstr "Montrer" #: src/app/learnocaml_common.ml:1001,18--36 -#: src/app/learnocaml_index_main.ml:844,27--45 +#: src/app/learnocaml_index_main.ml:861,27--45 msgid "Enter the secret" msgstr "Entrez le secret" @@ -365,7 +371,7 @@ msgstr "Actualiser la page" #: src/app/learnocaml_exercise_main.ml:30,29--51 msgid "I will do it myself!" -msgstr "Je sais le faire moi-même!" +msgstr "Je sais le faire moi-même !" #: src/app/learnocaml_exercise_main.ml:31,24--180 msgid "" @@ -414,7 +420,7 @@ msgstr "abandonner" #: src/app/learnocaml_exercise_main.ml:224,35--70 msgid "Grading is taking a lot of time, " -msgstr "La notation prend longtemps, " +msgstr "La notation prend beaucoup de temps, " #: src/app/learnocaml_exercise_main.ml:230,35--57 msgid "Launching the grader" @@ -430,11 +436,12 @@ msgstr "Erreur dans le code." #: src/app/learnocaml_exercise_main.ml:275,27--85 msgid "Cannot start the grader if your code does not typecheck." -msgstr "La notation ne peut être lancée si le code ne type pas." +msgstr "" +"La notation ne peut être lancée si le code n'est pas correctement typé." #: src/grader/grader_jsoo_worker.ml:51,17--44 msgid "Error in your solution:\n" -msgstr "Erreur dans votre solution:\n" +msgstr "Erreur dans votre solution :\n" #: src/grader/grader_jsoo_worker.ml:53,17--41 msgid "Error in the exercise " @@ -450,66 +457,88 @@ msgstr "" #: src/grader/grader_jsoo_worker.ml:57,17--38 msgid "Unexpected error:\n" -msgstr "Erreur inattendue:\n" +msgstr "Erreur inattendue :\n" -#: src/app/learnocaml_lti_main.ml:97,21--42 -#: src/app/learnocaml_index_main.ml:683,25--46 +#: src/app/learnocaml_lti_main.ml:89,15--48 +#: src/app/learnocaml_index_main.ml:574,10--43 +#: src/app/learnocaml_index_main.ml:674,19--52 +#: src/app/learnocaml_index_main.ml:775,38--71 +msgid "The entered e-mail was invalid." +msgstr "L'e-mail entré est invalide." + +#: src/app/learnocaml_lti_main.ml:95,15--60 +#: src/app/learnocaml_index_main.ml:680,19--64 +#: src/app/learnocaml_reset_main.ml:20,32--77 +#: src/app/learnocaml_upgrade_main.ml:21,34--79 +msgid "Password must be at least 8 characters long" +msgstr "Le mot de passe doit comporter au moins 8 caractères" + +#: src/app/learnocaml_lti_main.ml:99,15--153 +#: src/app/learnocaml_index_main.ml:684,19--165 +#: src/app/learnocaml_reset_main.ml:21,34--210 +#: src/app/learnocaml_upgrade_main.ml:22,36--216 +msgid "" +"Password must contain at least one digit, one lower and upper letter, and " +"one non-alphanumeric char." +msgstr "" +"Le mot de passe doit contenir au moins un chiffre, une lettre minuscule et " +"majuscule, et un caractère non-alphanumérique." + +#: src/app/learnocaml_lti_main.ml:114,21--42 +#: src/app/learnocaml_index_main.ml:700,25--46 msgid "VALIDATION REQUIRED" msgstr "VALIDATION REQUISE" -#: src/app/learnocaml_lti_main.ml:97,47--101 -#: src/app/learnocaml_index_main.ml:683,51--105 -#, fuzzy +#: src/app/learnocaml_lti_main.ml:114,47--101 +#: src/app/learnocaml_index_main.ml:700,51--105 msgid "A confirmation e-mail has been sent to your address." -msgstr "Un courriel sera envoyé à votre adresse pour la confirmer." +msgstr "Un courriel a été envoyé à votre adresse pour la confirmer." -#: src/app/learnocaml_lti_main.ml:110,33--51 -#: src/app/learnocaml_index_main.ml:842,37--55 -#: src/app/learnocaml_index_main.ml:846,31--49 +#: src/app/learnocaml_lti_main.ml:127,33--51 +#: src/app/learnocaml_index_main.ml:859,37--55 +#: src/app/learnocaml_index_main.ml:863,31--49 msgid "First connection" msgstr "Première connexion" -#: src/app/learnocaml_lti_main.ml:111,39--55 -#: src/app/learnocaml_lti_main.ml:123,32--48 -#: src/app/learnocaml_index_main.ml:847,37--53 -#: src/app/learnocaml_index_main.ml:856,30--46 -#: src/app/learnocaml_upgrade_main.ml:22,32--48 -#, fuzzy +#: src/app/learnocaml_lti_main.ml:128,39--55 +#: src/app/learnocaml_lti_main.ml:140,32--48 +#: src/app/learnocaml_index_main.ml:864,37--53 +#: src/app/learnocaml_index_main.ml:873,30--46 +#: src/app/learnocaml_upgrade_main.ml:26,32--48 msgid "E-mail address" -msgstr "Adresse email" +msgstr "Adresse e-mail" -#: src/app/learnocaml_lti_main.ml:112,42--52 -#: src/app/learnocaml_index_main.ml:848,40--50 -#: src/app/learnocaml_index_main.ml:874,9--19 +#: src/app/learnocaml_lti_main.ml:129,42--52 +#: src/app/learnocaml_index_main.ml:865,40--50 +#: src/app/learnocaml_index_main.ml:891,9--19 #: src/app/learnocaml_teacher_tab.ml:557,22--32 msgid "Nickname" msgstr "Pseudonyme" -#: src/app/learnocaml_lti_main.ml:113,42--52 -#: src/app/learnocaml_lti_main.ml:124,35--45 -#: src/app/learnocaml_index_main.ml:849,40--50 -#: src/app/learnocaml_index_main.ml:857,33--43 -#: src/app/learnocaml_upgrade_main.ml:23,35--45 +#: src/app/learnocaml_lti_main.ml:130,42--52 +#: src/app/learnocaml_lti_main.ml:141,35--45 +#: src/app/learnocaml_index_main.ml:866,40--50 +#: src/app/learnocaml_index_main.ml:874,33--43 +#: src/app/learnocaml_upgrade_main.ml:27,35--45 msgid "Password" msgstr "Mot de passe" -#: src/app/learnocaml_lti_main.ml:114,40--48 -#: src/app/learnocaml_index_main.ml:850,38--46 +#: src/app/learnocaml_lti_main.ml:131,40--48 +#: src/app/learnocaml_index_main.ml:867,38--46 msgid "Secret" msgstr "Secret" -#: src/app/learnocaml_lti_main.ml:115,29--198 -#: src/app/learnocaml_index_main.ml:851,27--192 -#, fuzzy +#: src/app/learnocaml_lti_main.ml:132,29--198 +#: src/app/learnocaml_index_main.ml:868,27--192 msgid "" "The secret is an optional passphrase provided by your teacher. It may be " "required to create an account." msgstr "" -"Le secret est une phrase de passe fournie par votre enseignant au moment de " -"l'inscription." +"Le secret est une phrase de passe pouvant être fournie par votre enseignant. " +"Celle-ci est alors requise pour s'inscrire." -#: src/app/learnocaml_lti_main.ml:118,41--251 -#: src/app/learnocaml_index_main.ml:860,39--244 +#: src/app/learnocaml_lti_main.ml:135,41--251 +#: src/app/learnocaml_index_main.ml:877,39--244 msgid "" "By submitting this form, I accept that the information entered will be used " "in the context of the Learn-OCaml plateform." @@ -517,45 +546,44 @@ msgstr "" "En validant ce formulaire, j'accepte que les informations entrées puissent " "être utilisées dans le contexte de la plateforme Learn-OCaml." -#: src/app/learnocaml_lti_main.ml:121,26--44 -#: src/app/learnocaml_index_main.ml:854,24--42 +#: src/app/learnocaml_lti_main.ml:138,26--44 +#: src/app/learnocaml_index_main.ml:871,24--42 msgid "Create new token" msgstr "Nouveau token" -#: src/app/learnocaml_lti_main.ml:122,26--42 -#: src/app/learnocaml_index_main.ml:855,24--40 +#: src/app/learnocaml_lti_main.ml:139,26--42 +#: src/app/learnocaml_index_main.ml:872,24--40 msgid "Returning user" msgstr "Utilisateur existant" -#: src/app/learnocaml_lti_main.ml:125,32--41 -#: src/app/learnocaml_index_main.ml:858,31--40 -#: src/app/learnocaml_index_main.ml:865,30--39 +#: src/app/learnocaml_lti_main.ml:142,32--41 +#: src/app/learnocaml_index_main.ml:875,31--40 +#: src/app/learnocaml_index_main.ml:882,30--39 msgid "Connect" msgstr "Se connecter" -#: src/app/learnocaml_lti_main.ml:126,32--55 -#: src/app/learnocaml_index_main.ml:859,30--53 +#: src/app/learnocaml_lti_main.ml:143,32--55 +#: src/app/learnocaml_index_main.ml:876,30--53 msgid "Forgot your password?" msgstr "Mot de passe oublié ?" -#: src/app/learnocaml_lti_main.ml:127,38--57 -#: src/app/learnocaml_index_main.ml:843,44--63 +#: src/app/learnocaml_lti_main.ml:144,38--57 +#: src/app/learnocaml_index_main.ml:860,44--63 msgid "Choose a nickname" msgstr "Choisissez un identifiant" -#: src/app/learnocaml_lti_main.ml:128,29--43 -#: src/app/learnocaml_lti_main.ml:132,36--50 +#: src/app/learnocaml_lti_main.ml:145,29--43 +#: src/app/learnocaml_lti_main.ml:149,36--50 msgid "Direct login" msgstr "Connexion directe" -#: src/app/learnocaml_lti_main.ml:129,31--221 +#: src/app/learnocaml_lti_main.ml:146,31--221 msgid "" "Or to be able to login independently of Moodle, you might want to setup a " "password below (or upgrade your account later)" msgstr "" -"Ou pour pouvoir vous connecter sans passer par Moodle, vous pouvez " -"créer un compte avec un mot de passe en dessous (ou en définir un plus " -"tard)" +"Ou pour pouvoir vous connecter sans passer par Moodle, vous pouvez créer un " +"compte avec un mot de passe ci-dessous (ou en définir un plus tard)" #: src/app/learnocaml_index_main.ml:88,18--37 msgid "Loading exercises" @@ -624,14 +652,12 @@ msgid "Please write it down." msgstr "Notez-le !" #: src/app/learnocaml_index_main.ml:567,21--36 -#, fuzzy msgid "RESET REQUEST" msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" #: src/app/learnocaml_index_main.ml:568,11--51 -#, fuzzy msgid "A reset link was sent to the address: " -msgstr "Un lien de réinitialisation a été envoyé à l'adresse spécifiée." +msgstr "Un lien de réinitialisation a été envoyé à l'adresse : " #: src/app/learnocaml_index_main.ml:569,35--76 msgid "" @@ -639,142 +665,126 @@ msgid "" "(if it is associated with an account)" msgstr "" "\n" -"(si il est associé à un compte)" - -#: src/app/learnocaml_index_main.ml:574,10--43 -#: src/app/learnocaml_index_main.ml:758,38--71 -#, fuzzy -msgid "The entered e-mail was invalid." -msgstr "Le token entré n'a pas été reconnu." +"(s'il est associé à un compte)" #: src/app/learnocaml_index_main.ml:587,21--41 msgid "RESET REQUEST SENT" msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" #: src/app/learnocaml_index_main.ml:588,11--65 -#, fuzzy msgid "A confirmation e-mail has been sent to the address: " -msgstr "Un lien de réinitialisation a été envoyé à l'adresse spécifiée." +msgstr "Un lien de confirmation a été envoyé à l'adresse : " #: src/app/learnocaml_index_main.ml:593,10--54 -#, fuzzy msgid "The entered e-mail couldn't be recognized." -msgstr "Le token entré n'a pas été reconnu." +msgstr "L'e-mail entré n'a pas été reconnu." #: src/app/learnocaml_index_main.ml:615,12--45 -#, fuzzy msgid "The entered e-mail is invalid: " -msgstr "Le token entré n'a pas été reconnu." +msgstr "L'e-mail entré est invalide." -#: src/app/learnocaml_index_main.ml:703,28--45 -#: src/app/learnocaml_index_main.ml:739,29--46 +#: src/app/learnocaml_index_main.ml:720,28--45 +#: src/app/learnocaml_index_main.ml:756,29--46 msgid "TOKEN NOT FOUND" msgstr "TOKEN NON TROUVÉ" -#: src/app/learnocaml_index_main.ml:704,17--60 -#: src/app/learnocaml_index_main.ml:740,18--61 -#, fuzzy +#: src/app/learnocaml_index_main.ml:721,17--60 +#: src/app/learnocaml_index_main.ml:757,18--61 msgid "The entered token couldn't be recognized." msgstr "Le token entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:726,26--41 -#, fuzzy +#: src/app/learnocaml_index_main.ml:743,26--41 msgid "INVALID TOKEN" msgstr "PSEUDONYME INVALIDE" -#: src/app/learnocaml_index_main.ml:727,31--200 +#: src/app/learnocaml_index_main.ml:744,31--200 msgid "" "This token is associated to an upgraded account, which only allows password-" "based%s authentication." msgstr "" -"Ce token est associé à un compte, autorisant uniquement " -"l'authentification par mot de passe%s." +"Ce token est associé à un compte, autorisant uniquement l'authentification " +"par mot de passe%s." -#: src/app/learnocaml_index_main.ml:730,54--70 +#: src/app/learnocaml_index_main.ml:747,54--70 msgid " or Moodle/LTI" msgstr " ou avec Moodle/LTI" -#: src/app/learnocaml_index_main.ml:837,7--21 +#: src/app/learnocaml_index_main.ml:854,7--21 msgid "Connected as" msgstr "Connecté en tant que" -#: src/app/learnocaml_index_main.ml:839,7--19 +#: src/app/learnocaml_index_main.ml:856,7--19 msgid "Activities" msgstr "Activités" -#: src/app/learnocaml_index_main.ml:841,9--33 +#: src/app/learnocaml_index_main.ml:858,9--33 msgid "Welcome to Learn OCaml" msgstr "Bienvenue sur Learn OCaml" -#: src/app/learnocaml_index_main.ml:845,24--40 -#, fuzzy +#: src/app/learnocaml_index_main.ml:862,24--40 msgid "Create account" -msgstr "Passer à un compte" +msgstr "Créer un compte" -#: src/app/learnocaml_index_main.ml:863,35--62 -#, fuzzy +#: src/app/learnocaml_index_main.ml:880,35--62 msgid "Login with a legacy token" -msgstr "Connexion avec un token" +msgstr "Connexion avec un ancien token" -#: src/app/learnocaml_index_main.ml:864,30--37 +#: src/app/learnocaml_index_main.ml:881,30--37 #: src/app/learnocaml_teacher_tab.ml:559,22--29 msgid "Token" msgstr "Token" -#: src/app/learnocaml_index_main.ml:866,22--39 -#: src/app/learnocaml_upgrade_main.ml:21,26--43 +#: src/app/learnocaml_index_main.ml:883,22--39 +#: src/app/learnocaml_upgrade_main.ml:25,26--43 msgid "Upgrade account" msgstr "Passer à un compte" -#: src/app/learnocaml_index_main.ml:908,38--59 +#: src/app/learnocaml_index_main.ml:925,38--59 msgid "Choose an activity." msgstr "Sélectionnez une activité." -#: src/app/learnocaml_index_main.ml:927,31--51 -#, fuzzy +#: src/app/learnocaml_index_main.ml:944,31--51 msgid "New e-mail address" -msgstr "Nouvelle adresse email" +msgstr "Nouvelle adresse e-mail" -#: src/app/learnocaml_index_main.ml:928,22--55 -#, fuzzy +#: src/app/learnocaml_index_main.ml:945,22--55 msgid "Enter your new e-mail address: " -msgstr "Entrez votre nouvelle adresse email :" +msgstr "Entrez votre nouvelle adresse e-mail : " -#: src/app/learnocaml_index_main.ml:938,22--39 +#: src/app/learnocaml_index_main.ml:955,22--39 msgid "Change password" msgstr "Changer de mot de passe" -#: src/app/learnocaml_index_main.ml:939,22--37 -#, fuzzy +#: src/app/learnocaml_index_main.ml:956,22--37 msgid "Change e-mail" -msgstr "Changer d'adresse email" +msgstr "Changer d'adresse e-mail" -#: src/app/learnocaml_index_main.ml:950,30--41 +#: src/app/learnocaml_index_main.ml:967,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:952,29--38 +#: src/app/learnocaml_index_main.ml:969,29--38 msgid "Lessons" msgstr "Cours" -#: src/app/learnocaml_index_main.ml:959,32--44 +#: src/app/learnocaml_index_main.ml:976,32--44 #: src/app/learnocaml_playground_main.ml:72,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:962,28--35 +#: src/app/learnocaml_index_main.ml:979,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:1062,17--71 +#: src/app/learnocaml_index_main.ml:1079,17--71 msgid "Be sure to write down your token before logging out:" msgstr "Assurez-vous d'avoir noté votre token :" -#: src/app/learnocaml_index_main.ml:1064,17--51 +#: src/app/learnocaml_index_main.ml:1081,17--51 msgid "Are you sure you want to logout?" msgstr "Êtes-vous sûr de vouloir vous déconnecter ?" -#: src/app/learnocaml_index_main.ml:1066,15--186 +#: src/app/learnocaml_index_main.ml:1083,15--186 msgid "" "WARNING: the data could not be synchronised with the server. Logging out " "will lose your local changes, be sure you exported a backup." @@ -783,33 +793,33 @@ msgstr "" "En vous déconnectant, vous perdrez tous les changements locaux, à moins " "d'avoir exporté votre espace de travail au préalable." -#: src/app/learnocaml_index_main.ml:1077,22--30 -#: src/app/learnocaml_index_main.ml:1077,45--53 -#: src/app/learnocaml_index_main.ml:1099,9--17 +#: src/app/learnocaml_index_main.ml:1094,22--30 +#: src/app/learnocaml_index_main.ml:1094,45--53 +#: src/app/learnocaml_index_main.ml:1116,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:1090,9--21 +#: src/app/learnocaml_index_main.ml:1107,9--21 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:1093,9--25 +#: src/app/learnocaml_index_main.ml:1110,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:1096,9--25 +#: src/app/learnocaml_index_main.ml:1113,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:1097,9--17 +#: src/app/learnocaml_index_main.ml:1114,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:1098,9--36 +#: src/app/learnocaml_index_main.ml:1115,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:1104,38--44 +#: src/app/learnocaml_index_main.ml:1121,38--44 msgid "Menu" msgstr "Menu" @@ -824,7 +834,7 @@ msgid "" "\n" "write it down." msgstr "" -"Nouveau token prof. créé:\n" +"Nouveau token prof. créé :\n" "%s\n" "\n" "Notez-le !" @@ -931,15 +941,15 @@ msgstr "Exporter les données étudiants en CSV" msgid "Unsaved changes" msgstr "Modifications non sauvegardées" -#: src/app/learnocaml_reset_main.ml:20,29--45 +#: src/app/learnocaml_reset_main.ml:24,29--45 msgid "Reset password" msgstr "Réinitialiser le mot de passe" -#: src/app/learnocaml_reset_main.ml:21,27--41 +#: src/app/learnocaml_reset_main.ml:25,27--41 msgid "New password" msgstr "Nouveau mot de passe" -#: src/app/learnocaml_reset_main.ml:22,23--31 +#: src/app/learnocaml_reset_main.ml:26,23--31 msgid "Submit" msgstr "Envoyer" @@ -1013,23 +1023,21 @@ msgstr "Aucun rapport" #: src/app/learnocaml_student_view.ml:473,8--29 msgid "Status of student: " -msgstr "Suivi étudiant: " +msgstr "Suivi étudiant : " -#: src/app/learnocaml_upgrade_main.ml:24,29--38 -#, fuzzy +#: src/app/learnocaml_upgrade_main.ml:28,29--38 msgid "Upgrade" msgstr "Noter!" -#: src/app/learnocaml_upgrade_main.ml:25,23--78 -#, fuzzy +#: src/app/learnocaml_upgrade_main.ml:29,23--78 msgid "An e-mail will be sent to your address to confirm it." msgstr "Un courriel sera envoyé à votre adresse pour la confirmer." -#: src/app/learnocaml_upgrade_main.ml:28,38--48 +#: src/app/learnocaml_upgrade_main.ml:32,38--48 msgid "NO TOKEN" msgstr "PAS DE TOKEN" -#: src/app/learnocaml_upgrade_main.ml:28,53--76 +#: src/app/learnocaml_upgrade_main.ml:32,53--76 msgid "You are not logged in" msgstr "Vous n'êtes pas connecté" @@ -1038,9 +1046,8 @@ msgid "EMAIL CONFIRMED" msgstr "ADRESSE EMAIL CONFIRMÉE" #: src/app/learnocaml_validate_main.ml:13,40--81 -#, fuzzy msgid "Your e-mail address has been confirmed." -msgstr "Votre adresse email a été confirmée" +msgstr "Votre adresse e-mail a été confirmée." #: src/grader/learnocaml_report.ml:240,50--66 #: src/grader/learnocaml_report.ml:595,59--75 @@ -1269,5 +1276,3 @@ msgstr "lors du test de la solution utilisateur" #~ msgid "This session has been closed. You can close this tab." #~ msgstr "La session a été fermée. Vous pouvez fermer cet onglet." - - From 0492d7a566d66e39f8876484af238fb96bfb1d72 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 8 Sep 2020 23:07:33 +0200 Subject: [PATCH 107/161] fix: fr.po & spacing issue --- src/app/learnocaml_index_main.ml | 10 +++++----- translations/fr.po | 24 ++++++++++++------------ 2 files changed, 17 insertions(+), 17 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 779699681..c1266b59d 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -565,8 +565,8 @@ let show_token_dialog token = let complete_reset_password ?(sayif = true) cb = function | Ok email -> alert ~title:[%i"RESET REQUEST"] - ([%i"A reset link was sent to the address: "] - ^ email ^ if sayif then [%i"\n(if it is associated with an account)"] + ([%i"A reset link was sent to the address:"] + ^ " " ^ email ^ if sayif then [%i"\n(if it is associated with an account)"] else ""); Lwt.return_none | Error (`Http_error (400, _)) -> @@ -585,8 +585,8 @@ let complete_reset_password ?(sayif = true) cb = function let complete_change_email cb new_email = function | Ok () -> alert ~title:[%i"RESET REQUEST SENT"] - ([%i"A confirmation e-mail has been sent to the address: "] - ^ new_email); + ([%i"A confirmation e-mail has been sent to the address:"] + ^ " " ^ new_email); Lwt.return_none | Error (`Not_found _) -> alert ~title:[%i"ERROR"] @@ -942,7 +942,7 @@ let () = Lwt.catch (fun () -> ask_string ~title:[%i"New e-mail address"] - [H.txt [%i"Enter your new e-mail address: "]] + [H.txt [%i"Enter your new e-mail address:"]] >>= validate_email >>= function | Some address -> diff --git a/translations/fr.po b/translations/fr.po index eb10373a0..161f94417 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-08 23:02+0200\n" +"PO-Revision-Date: 2020-09-08 23:10+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -655,25 +655,25 @@ msgstr "Notez-le !" msgid "RESET REQUEST" msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" -#: src/app/learnocaml_index_main.ml:568,11--51 -msgid "A reset link was sent to the address: " -msgstr "Un lien de réinitialisation a été envoyé à l'adresse : " +#: src/app/learnocaml_index_main.ml:568,11--50 +msgid "A reset link was sent to the address:" +msgstr "Un lien de réinitialisation a été envoyé à l'adresse :" -#: src/app/learnocaml_index_main.ml:569,35--76 +#: src/app/learnocaml_index_main.ml:569,41--82 msgid "" "\n" "(if it is associated with an account)" msgstr "" "\n" -"(s'il est associé à un compte)" +"(si elle est associée à un compte)" #: src/app/learnocaml_index_main.ml:587,21--41 msgid "RESET REQUEST SENT" msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" -#: src/app/learnocaml_index_main.ml:588,11--65 -msgid "A confirmation e-mail has been sent to the address: " -msgstr "Un lien de confirmation a été envoyé à l'adresse : " +#: src/app/learnocaml_index_main.ml:588,11--64 +msgid "A confirmation e-mail has been sent to the address:" +msgstr "Un lien de confirmation a été envoyé à l'adresse :" #: src/app/learnocaml_index_main.ml:593,10--54 msgid "The entered e-mail couldn't be recognized." @@ -747,9 +747,9 @@ msgstr "Sélectionnez une activité." msgid "New e-mail address" msgstr "Nouvelle adresse e-mail" -#: src/app/learnocaml_index_main.ml:945,22--55 -msgid "Enter your new e-mail address: " -msgstr "Entrez votre nouvelle adresse e-mail : " +#: src/app/learnocaml_index_main.ml:945,22--54 +msgid "Enter your new e-mail address:" +msgstr "Entrez votre nouvelle adresse e-mail :" #: src/app/learnocaml_index_main.ml:955,22--39 msgid "Change password" From d94258780918e3660937efa52924204da054e687 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 8 Sep 2020 23:23:49 +0200 Subject: [PATCH 108/161] fix: translation bug; s/Upgrade account/Setup a password/ --- src/app/learnocaml_index_main.ml | 2 +- src/app/learnocaml_upgrade_main.ml | 2 +- translations/fr.po | 12 ++++++------ 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index c1266b59d..832e3414b 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -880,7 +880,7 @@ let set_string_translations () = "txt_returning_with_token", [%i"Login with a legacy token"]; "txt_returning_token", [%i"Token"]; "txt_token_returning", [%i"Connect"]; - "txt_upgrade", [%i"Upgrade account"]; + "txt_upgrade", [%i"Setup a password"]; ] in List.iter (fun (id, text) -> diff --git a/src/app/learnocaml_upgrade_main.ml b/src/app/learnocaml_upgrade_main.ml index c812ec84c..a9e791fc3 100644 --- a/src/app/learnocaml_upgrade_main.ml +++ b/src/app/learnocaml_upgrade_main.ml @@ -22,7 +22,7 @@ let () = "txt_password_strength", [%i"Password must contain at least one digit, \ one lower and upper letter, \ and one non-alphanumeric char."]; - "txt_upgrade", [%i"Upgrade account"]; + "txt_upgrade", [%i"Setup a password"]; "txt_upgrade_email", [%i"E-mail address"]; "txt_upgrade_password", [%i"Password"]; "txt_do_upgrade", [%i"Upgrade"]; diff --git a/translations/fr.po b/translations/fr.po index 161f94417..6239afb82 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-08 23:10+0200\n" +"PO-Revision-Date: 2020-09-08 23:29+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -734,10 +734,10 @@ msgstr "Connexion avec un ancien token" msgid "Token" msgstr "Token" -#: src/app/learnocaml_index_main.ml:883,22--39 -#: src/app/learnocaml_upgrade_main.ml:25,26--43 -msgid "Upgrade account" -msgstr "Passer à un compte" +#: src/app/learnocaml_index_main.ml:883,22--40 +#: src/app/learnocaml_upgrade_main.ml:25,26--44 +msgid "Setup a password" +msgstr "Définir un mot de passe" #: src/app/learnocaml_index_main.ml:925,38--59 msgid "Choose an activity." @@ -1027,7 +1027,7 @@ msgstr "Suivi étudiant : " #: src/app/learnocaml_upgrade_main.ml:28,29--38 msgid "Upgrade" -msgstr "Noter!" +msgstr "Mettre à jour" #: src/app/learnocaml_upgrade_main.ml:29,23--78 msgid "An e-mail will be sent to your address to confirm it." From fd520f1b02f9fb2057e2f960ab3d5851d9fae485 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 8 Sep 2020 23:37:46 +0200 Subject: [PATCH 109/161] refactor: s/token/account/ --- src/app/learnocaml_index_main.ml | 4 ++-- src/app/learnocaml_lti_main.ml | 2 +- translations/fr.po | 20 ++++++++++++-------- 3 files changed, 15 insertions(+), 11 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 832e3414b..28ceb64a4 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -859,7 +859,7 @@ let set_string_translations () = "txt_token_first_connection", [%i"First connection"]; "txt_token_first_connection_dialog", [%i"Choose a nickname"]; "txt_token_secret", [%i"Enter the secret"]; - "txt_token_new", [%i"Create account"]; + "txt_token_new", [%i"Create new token"]; "txt_first_connection", [%i"First connection"]; "txt_first_connection_email", [%i"E-mail address"]; "txt_first_connection_nickname", [%i"Nickname"]; @@ -868,7 +868,7 @@ let set_string_translations () = "txt_secret_label", [%i"The secret is an optional passphrase \ provided by your teacher. It may be \ required to create an account."]; - "txt_login_new", [%i"Create new token"]; + "txt_login_new", [%i"Create new account"]; "txt_returning", [%i"Returning user"]; "txt_returning_email", [%i"E-mail address"]; "txt_returning_password", [%i"Password"]; diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 7aca6e908..9a6e086d2 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -135,7 +135,7 @@ let () = "txt_first_connection_consent", [%i"By submitting this form, I accept that the \ information entered will be used in the \ context of the Learn-OCaml plateform."]; - "txt_login_new", [%i"Create new token"]; + "txt_login_new", [%i"Create new account"]; "txt_returning", [%i"Returning user"]; "txt_returning_email", [%i"E-mail address"]; "txt_returning_password", [%i"Password"]; diff --git a/translations/fr.po b/translations/fr.po index 6239afb82..ed5f58455 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-08 23:29+0200\n" +"PO-Revision-Date: 2020-09-08 23:37+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -546,10 +546,10 @@ msgstr "" "En validant ce formulaire, j'accepte que les informations entrées puissent " "être utilisées dans le contexte de la plateforme Learn-OCaml." -#: src/app/learnocaml_lti_main.ml:138,26--44 -#: src/app/learnocaml_index_main.ml:871,24--42 -msgid "Create new token" -msgstr "Nouveau token" +#: src/app/learnocaml_lti_main.ml:138,26--46 +#: src/app/learnocaml_index_main.ml:871,24--44 +msgid "Create new account" +msgstr "Créer un compte" #: src/app/learnocaml_lti_main.ml:139,26--42 #: src/app/learnocaml_index_main.ml:872,24--40 @@ -721,9 +721,9 @@ msgstr "Activités" msgid "Welcome to Learn OCaml" msgstr "Bienvenue sur Learn OCaml" -#: src/app/learnocaml_index_main.ml:862,24--40 -msgid "Create account" -msgstr "Créer un compte" +#: src/app/learnocaml_index_main.ml:862,24--42 +msgid "Create new token" +msgstr "Nouveau token" #: src/app/learnocaml_index_main.ml:880,35--62 msgid "Login with a legacy token" @@ -1175,6 +1175,9 @@ msgstr "lors du chargement des dépendances" msgid "while testing your solution" msgstr "lors du test de la solution utilisateur" +#~ msgid "Create account" +#~ msgstr "Créer un compte" + #, fuzzy #~ msgid "USER NOT FOUND" #~ msgstr "TOKEN NON TROUVÉ" @@ -1276,3 +1279,4 @@ msgstr "lors du test de la solution utilisateur" #~ msgid "This session has been closed. You can close this tab." #~ msgstr "La session a été fermée. Vous pouvez fermer cet onglet." + From 94d15b0fb028669f343d0af05462fc84a0efcfb5 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 9 Sep 2020 00:29:48 +0200 Subject: [PATCH 110/161] docs: further document the semantics of user.json --- src/state/token_index.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index e58e018c6..e91210583 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -289,7 +289,11 @@ module BaseUserIndex (RW: IndexRW) = struct let rw = RW.init () (** Invariant: all emails are pairwise different (except possibly in - the initial account state: [Password (_, email, _, Some email)]). *) + the initial account state: [Password (_, email, _, Some email)]). + + Also, users can login directly with their (legacy) token only if + a password is not yet defined, and the token has not yet been + associated with some Moodle credential: [Token (_, false)]. *) let file = "user.json" let enc = J.( From 3aeb65bbc2be99c225fe4db3347fcf54bc5ab134 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 9 Sep 2020 00:55:23 +0200 Subject: [PATCH 111/161] feat(token_index.ml): Add some simple, future-proof file-format versioning --- src/state/token_index.ml | 41 ++++++++++++++++++++++++++++++++++------ 1 file changed, 35 insertions(+), 6 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index e91210583..b6207a966 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -1,3 +1,11 @@ +(* This file is part of Learn-OCaml. + * + * Copyright (C) 2019-2020 OCaml Software Foundation. + * Copyright (C) 2016-2018 OCamlPro. + * + * Learn-OCaml is distributed under the terms of the MIT license. See the + * included LICENSE file for details. *) + open Lwt open Learnocaml_data @@ -54,14 +62,31 @@ module IndexFile: IndexRW = struct Lwt.return @@ Lwt_mutex.unlock mutex end +(* inspired from learnocaml_data.ml *) +let enc_check_version_1 file enc = + J.conv + (fun data -> ("1", data)) + (fun (version, data) -> + begin + match version with + | "1" -> () + | _ -> + let msg = Format.asprintf "%s: unknown version %s" file version in + raise (J.Cannot_destruct ([], Failure msg)) + end ; + data) + (J.merge_objs (J.obj1 (J.req "learnocaml_version" J.string)) + (J.obj1 (J.req file enc))) + module BaseTokenIndex (RW: IndexRW) = struct let rw = RW.init () let file = "token.json" - let enc = J.list Token.enc + let enc = enc_check_version_1 file @@ J.list Token.enc let parse = Json_codec.decode enc - let serialise_str = Json_codec.encode ~minify:false J.(list string) + let serialise_str = Json_codec.encode ~minify:false + (enc_check_version_1 file J.(list string)) let serialise = Json_codec.encode ~minify:false enc let create_index sync_dir = @@ -124,7 +149,7 @@ module BaseMoodleIndex (RW: IndexRW) = struct let rw = RW.init () let file = "moodle_user.json" - let enc = J.assoc Token.enc + let enc = enc_check_version_1 file @@ J.assoc Token.enc let parse = Json_codec.decode enc let serialise = Json_codec.encode ~minify:false enc @@ -161,7 +186,7 @@ module BaseOauthIndex (RW: IndexRW) = struct let rw = RW.init () let file = "oauth.json" - let enc = J.(assoc (list string)) + let enc = enc_check_version_1 file @@ J.(assoc (list string)) let parse = Json_codec.decode enc let serialise = Json_codec.encode ~minify:false enc @@ -296,7 +321,9 @@ module BaseUserIndex (RW: IndexRW) = struct associated with some Moodle credential: [Token (_, false)]. *) let file = "user.json" - let enc = J.( + let enc = + enc_check_version_1 file + @@ J.( list (union [case (tup2 Token.enc bool) (function | Token (token, using_moodle) -> Some (token, using_moodle) @@ -441,7 +468,9 @@ module BaseUpgradeIndex (RW: IndexRW) = struct | ChangeEmail | ResetPassword - let enc = J.( + let enc = + enc_check_version_1 file + @@ J.( assoc (tup3 Token.enc float (string_enum ["change_email", ChangeEmail; "reset_password", ResetPassword]))) From 921d1005613d9c5616818b3ac1e81a1f9ba55c7e Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 9 Sep 2020 01:39:11 +0200 Subject: [PATCH 112/161] feat: Make the need for email confirmation (and error) more explicit --- src/server/learnocaml_server.ml | 2 +- static/upgrade.html | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index e0b3d1367..387ec3b60 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -469,7 +469,7 @@ module Request_handler = struct | _ -> Lwt.return (Printf.printf "[WARNING] Bad login or password for: %s\n%!" nick) >>= fun () -> - lwt_fail (`Forbidden, "Bad login or password")) + lwt_fail (`Forbidden, "Bad login or password (or e-mail not confirmed)")) | Api.Create_user _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Login _ -> diff --git a/static/upgrade.html b/static/upgrade.html index 68cd14b1c..f90730f29 100644 --- a/static/upgrade.html +++ b/static/upgrade.html @@ -22,6 +22,7 @@

+
@@ -36,7 +37,6 @@

    • - From 98267b467ad479af0669fab4b0198a14b80d8174 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 9 Sep 2020 01:45:23 +0200 Subject: [PATCH 113/161] refactor: Improve validation message --- src/app/learnocaml_validate_main.ml | 2 +- translations/fr.po | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/app/learnocaml_validate_main.ml b/src/app/learnocaml_validate_main.ml index 8bee16f62..79fefbd8b 100644 --- a/src/app/learnocaml_validate_main.ml +++ b/src/app/learnocaml_validate_main.ml @@ -10,4 +10,4 @@ open Learnocaml_common let () = (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); - alert ~title:[%i"EMAIL CONFIRMED"] [%i"Your e-mail address has been confirmed."] + alert ~title:[%i"EMAIL CONFIRMED"] [%i"Your e-mail address has been confirmed. You can now login."] diff --git a/translations/fr.po b/translations/fr.po index ed5f58455..9f5251e46 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -1046,8 +1046,8 @@ msgid "EMAIL CONFIRMED" msgstr "ADRESSE EMAIL CONFIRMÉE" #: src/app/learnocaml_validate_main.ml:13,40--81 -msgid "Your e-mail address has been confirmed." -msgstr "Votre adresse e-mail a été confirmée." +msgid "Your e-mail address has been confirmed. You can now login." +msgstr "Votre adresse e-mail a été confirmée. Vous pouvez maintenant vous connecter." #: src/grader/learnocaml_report.ml:240,50--66 #: src/grader/learnocaml_report.ml:595,59--75 From 08137becaf13aea916c2b1f6e2d9979d7315fe21 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Fri, 11 Sep 2020 01:12:24 +0200 Subject: [PATCH 114/161] fix: run the user-already-exists check after the secret passphrase check * This patch thus contributes to enhance users' e-mail non-disclosure. --- src/server/learnocaml_server.ml | 28 ++++++++++++++++------------ 1 file changed, 16 insertions(+), 12 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 387ec3b60..31bd7a843 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -193,7 +193,7 @@ let generate_hmac secret csrf user_id = |> Cryptokit.transform_string encoder let create_student conn (config: Learnocaml_data.Server.config) req - nonce_req secret_candidate nick base_auth = + nonce_req secret_candidate ?(post_check = Lwt.return_ok ()) nick base_auth = let module ServerData = Learnocaml_data.Server in lwt_option_fail (Hashtbl.find_opt nonce_req conn) @@ -207,6 +207,8 @@ let create_student conn (config: Learnocaml_data.Server.config) req if not know_secret then lwt_fail (`Forbidden, "Bad secret") else + post_check + >?= fun () -> Token.create_student () >>= fun tok -> (match nick with @@ -449,17 +451,19 @@ module Request_handler = struct | Api.Create_user (email, nick, password, secret) when config.ServerData.use_passwd -> valid_string_of_endp conn >?= fun conn -> - Token_index.UserIndex.exists !sync_dir email >>= fun exists -> - if exists then - lwt_fail (`Forbidden, "User already exists") - else if not (check_email_ml email) then - lwt_fail (`Bad_request, "Invalid e-mail address") - else if not (Learnocaml_data.passwd_check_length password) then - lwt_fail (`Bad_request, "Password must be at least 8 characters long") - else if not (Learnocaml_data.passwd_check_strength password) then - lwt_fail (`Bad_request, "Password too weak") - else - create_student conn config req nonce_req secret (Some nick) (`Password (email, password)) >?= fun _ -> + Token_index.UserIndex.exists !sync_dir email >>= fun exists -> + let post_check = + if exists then + lwt_fail (`Forbidden, "User already exists") + else if not (check_email_ml email) then + lwt_fail (`Bad_request, "Invalid e-mail address") + else if not (Learnocaml_data.passwd_check_length password) then + lwt_fail (`Bad_request, "Password must be at least 8 characters long") + else if not (Learnocaml_data.passwd_check_strength password) then + lwt_fail (`Bad_request, "Password too weak") + else + lwt_ok () in + create_student conn config req nonce_req secret ~post_check (Some nick) (`Password (email, password)) >?= fun _ -> respond_json cache () | Api.Login (nick, password) when config.ServerData.use_passwd -> From 87622c85a1dc2cbf315cd0556465601cd4353ec0 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 12 Sep 2020 18:08:54 +0200 Subject: [PATCH 115/161] refactor: Always display the "Show token" button * This reverts part of fbc8666010941de55796ba2d0f25cfd43a37d7c8 and prepares the upcoming commit; * Rename this button to "Show login" if use_passwd holds. --- src/app/learnocaml_index_main.ml | 45 ++++++++++++++++++-------------- translations/fr.po | 26 ++++++++++-------- 2 files changed, 40 insertions(+), 31 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 28ceb64a4..bf4c664de 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -555,12 +555,17 @@ let token_disp_div token = ] () let show_token_dialog token = - ext_alert ~title:[%i"Your Learn-OCaml token"] [ - H.p [H.txt [%i"Your token is displayed below. It identifies you and \ - allows to share your workspace between devices."]]; - H.p [H.txt [%i"Please write it down."]]; - H.div ~a:[H.a_style "text-align: center;"] [token_disp_div token]; - ] + can_show_token () >>= fun show_token -> + if show_token then + Lwt.return @@ + ext_alert ~title:[%i"Your Learn-OCaml token"] [ + H.p [H.txt [%i"Your token is displayed below. It identifies you and \ + allows to share your workspace between devices."]]; + H.p [H.txt [%i"Please write it down."]]; + H.div ~a:[H.a_style "text-align: center;"] [token_disp_div token]; + ] + else + Lwt.return_unit let complete_reset_password ?(sayif = true) cb = function | Ok email -> @@ -644,7 +649,8 @@ let init_token_dialog () = >>= fun token -> Learnocaml_local_storage.(store sync_token) token; Learnocaml_local_storage.(store can_show_token) true; - show_token_dialog token; + show_token_dialog token + >>= fun () -> Lwt.return_some (token, nickname)) else Lwt.return_none @@ -1100,20 +1106,20 @@ let () = reload (); Lwt.return_unit) in - let show_token_button_state = button_state () in - List.iter (fun (text, icon, state, f) -> - button ~container:El.sync_buttons ~theme:"white" ~group:sync_button_group ?state:state ~icon text f) + List.iter (fun (text, icon, f) -> + button ~container:El.sync_buttons ~theme:"white" ~group:sync_button_group ~icon text f) [ - [%i"Show token"], "token", Some show_token_button_state, (fun () -> - show_token_dialog (get_stored_token ()); - Lwt.return_unit); - [%i"Sync workspace"], "sync", None, (fun () -> + (if get_opt config##.enablePasswd + then [%i"Show login"] + else [%i"Show token"]), "token", (fun () -> + show_token_dialog (get_stored_token ())); + [%i"Sync workspace"], "sync", (fun () -> catch_with_alert @@ fun () -> sync () >>= fun _ -> Lwt.return_unit); - [%i"Export to file"], "download", None, download_save; - [%i"Import"], "upload", None, import_save; - [%i"Download all source files"], "download", None, download_all; - [%i"Logout"], "logout", None, + [%i"Export to file"], "download", download_save; + [%i"Import"], "upload", import_save; + [%i"Download all source files"], "download", download_all; + [%i"Logout"], "logout", (fun () -> Lwt.async logout_dialog; Lwt.return_unit); ]; begin button @@ -1162,8 +1168,7 @@ let () = Server_caller.request (Learnocaml_api.Is_account (get_stored_token ())) >|= (function | Ok true -> init_op () - | _ -> show_upgrade_button ()) >|= fun () -> - disable_button show_token_button_state + | _ -> show_upgrade_button ()) else if get_opt config##.enablePasswd then Lwt.return @@ show_upgrade_button () else diff --git a/translations/fr.po b/translations/fr.po index 9f5251e46..11eb408ad 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-08 23:37+0200\n" +"PO-Revision-Date: 2020-09-12 18:08+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -795,31 +795,35 @@ msgstr "" #: src/app/learnocaml_index_main.ml:1094,22--30 #: src/app/learnocaml_index_main.ml:1094,45--53 -#: src/app/learnocaml_index_main.ml:1116,9--17 +#: src/app/learnocaml_index_main.ml:1117,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:1107,9--21 +#: src/app/learnocaml_index_main.ml:1107,15--27 +msgid "Show login" +msgstr "Afficher votre login" + +#: src/app/learnocaml_index_main.ml:1108,15--27 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:1110,9--25 +#: src/app/learnocaml_index_main.ml:1111,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:1113,9--25 +#: src/app/learnocaml_index_main.ml:1114,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:1114,9--17 +#: src/app/learnocaml_index_main.ml:1115,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:1115,9--36 +#: src/app/learnocaml_index_main.ml:1116,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:1121,38--44 +#: src/app/learnocaml_index_main.ml:1122,38--44 msgid "Menu" msgstr "Menu" @@ -1045,9 +1049,10 @@ msgstr "Vous n'êtes pas connecté" msgid "EMAIL CONFIRMED" msgstr "ADRESSE EMAIL CONFIRMÉE" -#: src/app/learnocaml_validate_main.ml:13,40--81 +#: src/app/learnocaml_validate_main.ml:13,40--100 msgid "Your e-mail address has been confirmed. You can now login." -msgstr "Votre adresse e-mail a été confirmée. Vous pouvez maintenant vous connecter." +msgstr "" +"Votre adresse e-mail a été confirmée. Vous pouvez maintenant vous connecter." #: src/grader/learnocaml_report.ml:240,50--66 #: src/grader/learnocaml_report.ml:595,59--75 @@ -1279,4 +1284,3 @@ msgstr "lors du test de la solution utilisateur" #~ msgid "This session has been closed. You can close this tab." #~ msgstr "La session a été fermée. Vous pouvez fermer cet onglet." - From d6c5cc71af42486d9e533bfb7fefaf6c0ca637f8 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 12 Sep 2020 20:01:35 +0200 Subject: [PATCH 116/161] feat: fully implement the "Show login" dialog * Api: Add Is_moodle_account => bool * Api: Replace Is_account with Get_emails => (string * string option) option * Token_index.UserIndex: Replace email_of_token with emails_of_token as well * Update translations accordingly --- src/app/learnocaml_index_main.ml | 38 ++++- src/server/learnocaml_server.ml | 26 ++-- src/state/learnocaml_api.ml | 29 +++- src/state/learnocaml_api.mli | 6 +- src/state/token_index.ml | 9 +- src/state/token_index.mli | 10 +- translations/fr.po | 231 ++++++++++++++++++------------- 7 files changed, 225 insertions(+), 124 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index bf4c664de..ff3350a3f 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -533,6 +533,7 @@ let get_stored_token () = Learnocaml_local_storage.(retrieve sync_token) let can_show_token () = + (* Is this localStorage caching really useful? *) try Lwt.return Learnocaml_local_storage.(retrieve can_show_token) with Not_found -> @@ -542,6 +543,18 @@ let can_show_token () = Learnocaml_local_storage.(store can_show_token) res; res +let has_moodle () = + (* could be put in localStorage, but a server change wouldn't be propagated *) + Server_caller.request (Learnocaml_api.Is_moodle_account (get_stored_token ())) >|= function + | Error _ -> false + | Ok res -> res + +let get_emails () = + (* could be put in localStorage, but a server change wouldn't be propagated *) + Server_caller.request (Learnocaml_api.Get_emails (get_stored_token ())) >|= function + | Error _ -> None + | Ok res -> res + let sync () = sync (get_stored_token ()) let token_disp_div token = @@ -565,7 +578,26 @@ let show_token_dialog token = H.div ~a:[H.a_style "text-align: center;"] [token_disp_div token]; ] else - Lwt.return_unit + begin if get_opt config##.enableMoodle + then has_moodle () >>= fun moodle -> + if moodle then return [[%i"Moodle/LTI authentication is enabled for your account."]] + else return [[%i"You might also want to associate your account with Moodle/LTI. Ask your teacher if need be."]] + else return [] + end >>= fun end_lines -> + begin get_emails () >|= function + | None -> [[%i"No e-mail registered."]] + | Some (email, None) -> + [[%i"Your e-mail:"] ^ " " ^ email] + | Some (email, Some email2) when email = email2 -> + [[%i"Your e-mail:"] ^ " " ^ email ^ " " ^ [%i"(to be confirmed)"]] + | Some (email, Some email2) -> + [[%i"Your e-mail:"] ^ " " ^ email; + [%i"Pending change:"] ^ " " ^ email2 ^ " " ^ [%i"(to be confirmed)"]] + end >>= fun begin_lines -> + let lines = begin_lines @ end_lines in + Lwt.return @@ + ext_alert ~title:[%i"Your Learn-OCaml login"] + (List.map (fun para -> H.p [H.txt para]) lines) let complete_reset_password ?(sayif = true) cb = function | Ok email -> @@ -1165,9 +1197,9 @@ let () = init_sync_token sync_button_group >|= init_tabs >>= fun tabs -> can_show_token () >>= fun show_token -> (if not show_token then - Server_caller.request (Learnocaml_api.Is_account (get_stored_token ())) >|= + Server_caller.request (Learnocaml_api.Get_emails (get_stored_token ())) >|= (function - | Ok true -> init_op () + | Ok (Some _) -> init_op () | _ -> show_upgrade_button ()) else if get_opt config##.enablePasswd then Lwt.return @@ show_upgrade_button () diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 31bd7a843..57ccff774 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -701,10 +701,16 @@ module Request_handler = struct ) (fun exn -> (`Not_found, Printexc.to_string exn)) + | Api.Is_moodle_account token when config.ServerData.use_moodle -> + Token_index.MoodleIndex.token_exists !sync_dir token >>= fun has_moodle -> + respond_json cache has_moodle + | Api.Is_moodle_account _ -> + lwt_fail (`Forbidden, "LTI disabled on this instance.") + | Api.Change_email (token, address) when config.ServerData.use_passwd -> - Token_index.UserIndex.email_of_token !sync_dir token >>= + Token_index.UserIndex.emails_of_token !sync_dir token >>= (function - | Some old_address -> + | Some (old_address, _pending) -> Token_index.UserIndex.exists !sync_dir address >>= fun exists -> if exists then lwt_fail (`Forbidden, "Address already in use.") @@ -741,9 +747,9 @@ module Request_handler = struct >>= fun () -> respond_json cache address) | Api.Change_password token when config.ServerData.use_passwd -> - Token_index.UserIndex.email_of_token !sync_dir token >>= + Token_index.UserIndex.emails_of_token !sync_dir token >>= (function - | Some address -> + | Some (address, _pending) -> initiate_password_change token address cache req | None -> lwt_fail (`Not_found, "Unknown user.")) | Api.Reset_password handle when config.ServerData.use_passwd -> @@ -811,17 +817,17 @@ module Request_handler = struct | Api.Do_reset_password _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") - | Api.Is_account token when config.ServerData.use_passwd -> - Token_index.UserIndex.email_of_token !sync_dir token >>= fun email -> - respond_json cache (email <> None) - | Api.Is_account _ -> + | Api.Get_emails token when config.ServerData.use_passwd -> + Token_index.UserIndex.emails_of_token !sync_dir token >>= fun emails -> + respond_json cache emails + | Api.Get_emails _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Upgrade_form body when config.ServerData.use_passwd -> let params = Uri.query_of_encoded body |> List.map (fun (a, b) -> a, String.concat "," b) in let token = Token.parse @@ List.assoc "token" params in - Token_index.UserIndex.email_of_token !sync_dir token >>= + Token_index.UserIndex.emails_of_token !sync_dir token >>= (function | None -> let csrf_token = generate_csrf_token 32 in @@ -852,7 +858,7 @@ module Request_handler = struct let params = Uri.query_of_encoded body |> List.map (fun (a, b) -> a, String.concat "," b) in let token = Token.parse @@ List.assoc "token" params in - Token_index.UserIndex.email_of_token !sync_dir token >>= + Token_index.UserIndex.emails_of_token !sync_dir token >>= (function | None -> let make_cookie = Cohttp.Cookie.Set_cookie_hdr.make diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 5cfeb2399..0204e3b27 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -78,6 +78,8 @@ type _ request = | Partition: teacher token * Exercise.id * string * int -> Partition.t request + | Is_moodle_account: + Token.t -> bool request | Change_email: (Token.t * string) -> unit request | Confirm_email: @@ -93,8 +95,14 @@ type _ request = | Do_reset_password: string -> string request - | Is_account: - Token.t -> bool request + | Get_emails: + Token.t -> (string * string option) option request + (* Four cases for the result (see token_index.mli): + * [None]: not found + * [Some (email, Some email)]: init state, unverified email + * [Some (email, None)]: verified email + * [Some (email, Some other_email)]: pending email change + *) | Upgrade_form: string -> string request @@ -190,6 +198,7 @@ module Conversions (Json: JSON_CODEC) = struct | Partition _ -> json Partition.enc + | Is_moodle_account _ -> json J.bool | Change_email _ -> json J.unit | Confirm_email _ -> str | Change_password _ -> str @@ -197,7 +206,9 @@ module Conversions (Json: JSON_CODEC) = struct | Reset_password _ -> str | Do_reset_password _ -> str - | Is_account _ -> json J.bool + | Get_emails _ -> json J.(obj1 (opt "email" + (tup2 string + (obj1 (opt "pending" string))))) | Upgrade_form _ -> str | Upgrade _ -> str @@ -323,6 +334,8 @@ module Conversions (Json: JSON_CODEC) = struct get ~token ["partition"; eid; fid; string_of_int prof] + | Is_moodle_account token -> + get ~token ["is_moodle_account"] | Change_email (token, address) -> post ~token ["change_email"] (Json.encode J.(tup1 string) address) | Confirm_email _ -> @@ -336,8 +349,8 @@ module Conversions (Json: JSON_CODEC) = struct | Do_reset_password _ -> assert false (* Reserved for a link *) - | Is_account token -> - get ~token ["is_account"] + | Get_emails token -> + get ~token ["get_emails"] | Upgrade_form _ -> assert false (* Reserved for a link *) @@ -496,6 +509,8 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct when Token.is_teacher token -> Partition (token, eid, fid, int_of_string prof) |> k + | `GET, ["is_moodle_account"], Some token -> + Is_moodle_account token |> k | `POST body, ["change_email"], Some token -> (match Json.decode J.(tup1 string) body with | address -> Change_email (token, address) |> k @@ -513,8 +528,8 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct | `POST body, ["reset_password"], _ -> Do_reset_password body |> k - | `GET, ["is_account"], Some token -> - Is_account token |> k + | `GET, ["get_emails"], Some token -> + Get_emails token |> k | `POST body, ["upgrade"], _ -> Upgrade_form body |> k diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 46c04c527..908d16923 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -97,6 +97,8 @@ type _ request = | Partition: teacher token * Exercise.id * string * int -> Partition.t request + | Is_moodle_account: + Token.t -> bool request | Change_email: (Token.t * string) -> unit request | Confirm_email: @@ -112,8 +114,8 @@ type _ request = | Do_reset_password: string -> string request - | Is_account: - Token.t -> bool request + | Get_emails: + Token.t -> (string * string option) option request | Upgrade_form: string -> string request diff --git a/src/state/token_index.ml b/src/state/token_index.ml index b6207a966..15ba8e8b6 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -166,6 +166,10 @@ module BaseMoodleIndex (RW: IndexRW) = struct get_users sync_dir >|= List.exists (fun (rid, _token) -> rid = id) + let token_exists sync_dir token = + get_users sync_dir >|= + List.exists (fun (_id, rtoken) -> rtoken = token) + let add_user sync_dir id token = get_users sync_dir >>= fun users -> if List.exists (fun (rid, _token) -> rid = id) users then @@ -439,11 +443,12 @@ module BaseUserIndex (RW: IndexRW) = struct | None, Password (token, found_email, _, _) when found_email = email -> Some token | _ -> res) None - let email_of_token sync_dir token = + let emails_of_token sync_dir token = RW.read (sync_dir / indexes_subdir / file) parse >|= List.fold_left (fun res elt -> match res, elt with - | None, Password (found_token, email, _, _) when found_token = token -> Some email + | None, Password (found_token, email, _, pending) when found_token = token -> + Some (email, pending) | _ -> res) None let change_email sync_dir token new_email = diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 36b6181bb..dae9d7f0a 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -43,6 +43,7 @@ module MoodleIndex: sig val get_users : string -> (string * Learnocaml_data.Token.t) list Lwt.t val user_exists : string -> string -> bool Lwt.t + val token_exists : string -> Learnocaml_data.Token.t -> bool Lwt.t end module OauthIndex: sig @@ -80,7 +81,14 @@ module UserIndex: sig val confirm_email : string -> Learnocaml_data.Token.t -> unit Lwt.t val can_login : string -> Learnocaml_data.Token.t -> bool Lwt.t val token_of_email : string -> string -> Learnocaml_data.Token.t option Lwt.t - val email_of_token : string -> Learnocaml_data.Token.t -> string option Lwt.t + + (** Four cases for the result: + * [None]: not found + * [Some (email, Some email)]: init state, unverified email + * [Some (email, None)]: verified email + * [Some (email, Some other_email)]: pending email change + *) + val emails_of_token : string -> Learnocaml_data.Token.t -> ((string * string option) option) Lwt.t val change_email : string -> Learnocaml_data.Token.t -> string -> unit Lwt.t end diff --git a/translations/fr.po b/translations/fr.po index 11eb408ad..101a5d7b6 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-12 18:08+0200\n" +"PO-Revision-Date: 2020-09-12 20:01+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -27,49 +27,49 @@ msgstr "OK" #: src/app/learnocaml_lti_main.ml:88,26--33 #: src/app/learnocaml_lti_main.ml:94,26--33 #: src/app/learnocaml_lti_main.ml:98,26--33 -#: src/app/learnocaml_index_main.ml:573,21--28 -#: src/app/learnocaml_index_main.ml:592,21--28 -#: src/app/learnocaml_index_main.ml:614,22--29 -#: src/app/learnocaml_index_main.ml:673,30--37 -#: src/app/learnocaml_index_main.ml:679,30--37 -#: src/app/learnocaml_index_main.ml:683,30--37 -#: src/app/learnocaml_index_main.ml:711,25--32 -#: src/app/learnocaml_index_main.ml:775,26--33 +#: src/app/learnocaml_index_main.ml:610,21--28 +#: src/app/learnocaml_index_main.ml:629,21--28 +#: src/app/learnocaml_index_main.ml:651,22--29 +#: src/app/learnocaml_index_main.ml:711,30--37 +#: src/app/learnocaml_index_main.ml:717,30--37 +#: src/app/learnocaml_index_main.ml:721,30--37 +#: src/app/learnocaml_index_main.ml:749,25--32 +#: src/app/learnocaml_index_main.ml:813,26--33 msgid "ERROR" msgstr "ERREUR" #: src/app/learnocaml_common.ml:142,58--66 #: src/app/learnocaml_common.ml:148,66--74 #: src/app/learnocaml_common.ml:423,12--20 -#: src/app/learnocaml_index_main.ml:582,12--20 -#: src/app/learnocaml_index_main.ml:601,12--20 -#: src/app/learnocaml_index_main.ml:729,19--27 -#: src/app/learnocaml_index_main.ml:765,20--28 +#: src/app/learnocaml_index_main.ml:619,12--20 +#: src/app/learnocaml_index_main.ml:638,12--20 +#: src/app/learnocaml_index_main.ml:767,19--27 +#: src/app/learnocaml_index_main.ml:803,20--28 msgid "Cancel" msgstr "Annuler" #: src/app/learnocaml_common.ml:415,26--41 -#: src/app/learnocaml_index_main.ml:577,25--40 -#: src/app/learnocaml_index_main.ml:596,25--40 -#: src/app/learnocaml_index_main.ml:724,32--47 -#: src/app/learnocaml_index_main.ml:760,33--48 +#: src/app/learnocaml_index_main.ml:614,25--40 +#: src/app/learnocaml_index_main.ml:633,25--40 +#: src/app/learnocaml_index_main.ml:762,32--47 +#: src/app/learnocaml_index_main.ml:798,33--48 msgid "REQUEST ERROR" msgstr "ERREUR DE REQUÊTE" #: src/app/learnocaml_common.ml:416,22--59 -#: src/app/learnocaml_index_main.ml:578,26--63 -#: src/app/learnocaml_index_main.ml:597,26--63 -#: src/app/learnocaml_index_main.ml:725,30--67 -#: src/app/learnocaml_index_main.ml:761,34--71 +#: src/app/learnocaml_index_main.ml:615,26--63 +#: src/app/learnocaml_index_main.ml:634,26--63 +#: src/app/learnocaml_index_main.ml:763,30--67 +#: src/app/learnocaml_index_main.ml:799,34--71 msgid "Could not retrieve data from server" msgstr "Échec lors du téléchargement des données du serveur" #: src/app/learnocaml_common.ml:419,12--19 #: src/app/learnocaml_common.ml:459,11--18 -#: src/app/learnocaml_index_main.ml:581,12--19 -#: src/app/learnocaml_index_main.ml:600,12--19 -#: src/app/learnocaml_index_main.ml:728,19--26 -#: src/app/learnocaml_index_main.ml:764,20--27 +#: src/app/learnocaml_index_main.ml:618,12--19 +#: src/app/learnocaml_index_main.ml:637,12--19 +#: src/app/learnocaml_index_main.ml:766,19--26 +#: src/app/learnocaml_index_main.ml:802,20--27 msgid "Retry" msgstr "Réessayer" @@ -145,7 +145,7 @@ msgid "Editor" msgstr "Éditeur" #: src/app/learnocaml_common.ml:787,41--51 -#: src/app/learnocaml_index_main.ml:974,30--40 +#: src/app/learnocaml_index_main.ml:1012,30--40 msgid "Toplevel" msgstr "Toplevel" @@ -183,7 +183,7 @@ msgstr "Statistiques" #: src/app/learnocaml_common.ml:799,37--48 #: src/app/learnocaml_exercise_main.ml:200,23--34 -#: src/app/learnocaml_index_main.ml:971,29--40 +#: src/app/learnocaml_index_main.ml:1009,29--40 #: src/app/learnocaml_teacher_tab.ml:328,18--29 msgid "Exercises" msgstr "Exercices" @@ -229,7 +229,7 @@ msgid "Show" msgstr "Montrer" #: src/app/learnocaml_common.ml:1001,18--36 -#: src/app/learnocaml_index_main.ml:861,27--45 +#: src/app/learnocaml_index_main.ml:899,27--45 msgid "Enter the secret" msgstr "Entrez le secret" @@ -460,21 +460,21 @@ msgid "Unexpected error:\n" msgstr "Erreur inattendue :\n" #: src/app/learnocaml_lti_main.ml:89,15--48 -#: src/app/learnocaml_index_main.ml:574,10--43 -#: src/app/learnocaml_index_main.ml:674,19--52 -#: src/app/learnocaml_index_main.ml:775,38--71 +#: src/app/learnocaml_index_main.ml:611,10--43 +#: src/app/learnocaml_index_main.ml:712,19--52 +#: src/app/learnocaml_index_main.ml:813,38--71 msgid "The entered e-mail was invalid." msgstr "L'e-mail entré est invalide." #: src/app/learnocaml_lti_main.ml:95,15--60 -#: src/app/learnocaml_index_main.ml:680,19--64 +#: src/app/learnocaml_index_main.ml:718,19--64 #: src/app/learnocaml_reset_main.ml:20,32--77 #: src/app/learnocaml_upgrade_main.ml:21,34--79 msgid "Password must be at least 8 characters long" msgstr "Le mot de passe doit comporter au moins 8 caractères" #: src/app/learnocaml_lti_main.ml:99,15--153 -#: src/app/learnocaml_index_main.ml:684,19--165 +#: src/app/learnocaml_index_main.ml:722,19--165 #: src/app/learnocaml_reset_main.ml:21,34--210 #: src/app/learnocaml_upgrade_main.ml:22,36--216 msgid "" @@ -485,51 +485,51 @@ msgstr "" "majuscule, et un caractère non-alphanumérique." #: src/app/learnocaml_lti_main.ml:114,21--42 -#: src/app/learnocaml_index_main.ml:700,25--46 +#: src/app/learnocaml_index_main.ml:738,25--46 msgid "VALIDATION REQUIRED" msgstr "VALIDATION REQUISE" #: src/app/learnocaml_lti_main.ml:114,47--101 -#: src/app/learnocaml_index_main.ml:700,51--105 +#: src/app/learnocaml_index_main.ml:738,51--105 msgid "A confirmation e-mail has been sent to your address." msgstr "Un courriel a été envoyé à votre adresse pour la confirmer." #: src/app/learnocaml_lti_main.ml:127,33--51 -#: src/app/learnocaml_index_main.ml:859,37--55 -#: src/app/learnocaml_index_main.ml:863,31--49 +#: src/app/learnocaml_index_main.ml:897,37--55 +#: src/app/learnocaml_index_main.ml:901,31--49 msgid "First connection" msgstr "Première connexion" #: src/app/learnocaml_lti_main.ml:128,39--55 #: src/app/learnocaml_lti_main.ml:140,32--48 -#: src/app/learnocaml_index_main.ml:864,37--53 -#: src/app/learnocaml_index_main.ml:873,30--46 +#: src/app/learnocaml_index_main.ml:902,37--53 +#: src/app/learnocaml_index_main.ml:911,30--46 #: src/app/learnocaml_upgrade_main.ml:26,32--48 msgid "E-mail address" msgstr "Adresse e-mail" #: src/app/learnocaml_lti_main.ml:129,42--52 -#: src/app/learnocaml_index_main.ml:865,40--50 -#: src/app/learnocaml_index_main.ml:891,9--19 +#: src/app/learnocaml_index_main.ml:903,40--50 +#: src/app/learnocaml_index_main.ml:929,9--19 #: src/app/learnocaml_teacher_tab.ml:557,22--32 msgid "Nickname" msgstr "Pseudonyme" #: src/app/learnocaml_lti_main.ml:130,42--52 #: src/app/learnocaml_lti_main.ml:141,35--45 -#: src/app/learnocaml_index_main.ml:866,40--50 -#: src/app/learnocaml_index_main.ml:874,33--43 +#: src/app/learnocaml_index_main.ml:904,40--50 +#: src/app/learnocaml_index_main.ml:912,33--43 #: src/app/learnocaml_upgrade_main.ml:27,35--45 msgid "Password" msgstr "Mot de passe" #: src/app/learnocaml_lti_main.ml:131,40--48 -#: src/app/learnocaml_index_main.ml:867,38--46 +#: src/app/learnocaml_index_main.ml:905,38--46 msgid "Secret" msgstr "Secret" #: src/app/learnocaml_lti_main.ml:132,29--198 -#: src/app/learnocaml_index_main.ml:868,27--192 +#: src/app/learnocaml_index_main.ml:906,27--192 msgid "" "The secret is an optional passphrase provided by your teacher. It may be " "required to create an account." @@ -538,7 +538,7 @@ msgstr "" "Celle-ci est alors requise pour s'inscrire." #: src/app/learnocaml_lti_main.ml:135,41--251 -#: src/app/learnocaml_index_main.ml:877,39--244 +#: src/app/learnocaml_index_main.ml:915,39--244 msgid "" "By submitting this form, I accept that the information entered will be used " "in the context of the Learn-OCaml plateform." @@ -547,28 +547,28 @@ msgstr "" "être utilisées dans le contexte de la plateforme Learn-OCaml." #: src/app/learnocaml_lti_main.ml:138,26--46 -#: src/app/learnocaml_index_main.ml:871,24--44 +#: src/app/learnocaml_index_main.ml:909,24--44 msgid "Create new account" msgstr "Créer un compte" #: src/app/learnocaml_lti_main.ml:139,26--42 -#: src/app/learnocaml_index_main.ml:872,24--40 +#: src/app/learnocaml_index_main.ml:910,24--40 msgid "Returning user" msgstr "Utilisateur existant" #: src/app/learnocaml_lti_main.ml:142,32--41 -#: src/app/learnocaml_index_main.ml:875,31--40 -#: src/app/learnocaml_index_main.ml:882,30--39 +#: src/app/learnocaml_index_main.ml:913,31--40 +#: src/app/learnocaml_index_main.ml:920,30--39 msgid "Connect" msgstr "Se connecter" #: src/app/learnocaml_lti_main.ml:143,32--55 -#: src/app/learnocaml_index_main.ml:876,30--53 +#: src/app/learnocaml_index_main.ml:914,30--53 msgid "Forgot your password?" msgstr "Mot de passe oublié ?" #: src/app/learnocaml_lti_main.ml:144,38--57 -#: src/app/learnocaml_index_main.ml:860,44--63 +#: src/app/learnocaml_index_main.ml:898,44--63 msgid "Choose a nickname" msgstr "Choisissez un identifiant" @@ -635,11 +635,11 @@ msgstr "Démarrage d'OCaml" msgid "Loading student info" msgstr "Chargement des informations sur les étudiants" -#: src/app/learnocaml_index_main.ml:558,22--46 +#: src/app/learnocaml_index_main.ml:574,26--50 msgid "Your Learn-OCaml token" msgstr "Votre token Learn-OCaml" -#: src/app/learnocaml_index_main.ml:559,20--145 +#: src/app/learnocaml_index_main.ml:575,24--153 msgid "" "Your token is displayed below. It identifies you and allows to share your " "workspace between devices." @@ -647,19 +647,52 @@ msgstr "" "Votre token est affiché ci-dessous. Il vous identifie et permet de partager " "un même espace de travail entre plusieurs machines." -#: src/app/learnocaml_index_main.ml:561,20--43 +#: src/app/learnocaml_index_main.ml:577,24--47 msgid "Please write it down." msgstr "Notez-le !" -#: src/app/learnocaml_index_main.ml:567,21--36 +#: src/app/learnocaml_index_main.ml:583,41--97 +msgid "Moodle/LTI authentication is enabled for your account." +msgstr "L'authentification par Moodle/LTI est activée pour votre compte." + +#: src/app/learnocaml_index_main.ml:584,31--124 +msgid "" +"You might also want to associate your account with Moodle/LTI. Ask your " +"teacher if need be." +msgstr "Vous pourriez aussi vouloir associer votre compte à Moodle/LTI. Demandez à votre enseignant le cas échéant." + +#: src/app/learnocaml_index_main.ml:588,24--47 +msgid "No e-mail registered." +msgstr "Pas d'e-mail enregistré." + +#: src/app/learnocaml_index_main.ml:590,17--31 +#: src/app/learnocaml_index_main.ml:592,17--31 +#: src/app/learnocaml_index_main.ml:594,17--31 +msgid "Your e-mail:" +msgstr "Votre e-mail :" + +#: src/app/learnocaml_index_main.ml:592,58--77 +#: src/app/learnocaml_index_main.ml:595,62--81 +msgid "(to be confirmed)" +msgstr "(à confirmer)" + +#: src/app/learnocaml_index_main.ml:595,17--34 +msgid "Pending change:" +msgstr "Changement en cours :" + +#: src/app/learnocaml_index_main.ml:599,26--50 +msgid "Your Learn-OCaml login" +msgstr "Votre login Learn-OCaml" + +#: src/app/learnocaml_index_main.ml:604,21--36 msgid "RESET REQUEST" msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" -#: src/app/learnocaml_index_main.ml:568,11--50 +#: src/app/learnocaml_index_main.ml:605,11--50 msgid "A reset link was sent to the address:" msgstr "Un lien de réinitialisation a été envoyé à l'adresse :" -#: src/app/learnocaml_index_main.ml:569,41--82 +#: src/app/learnocaml_index_main.ml:606,41--82 msgid "" "\n" "(if it is associated with an account)" @@ -667,37 +700,37 @@ msgstr "" "\n" "(si elle est associée à un compte)" -#: src/app/learnocaml_index_main.ml:587,21--41 +#: src/app/learnocaml_index_main.ml:624,21--41 msgid "RESET REQUEST SENT" msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" -#: src/app/learnocaml_index_main.ml:588,11--64 +#: src/app/learnocaml_index_main.ml:625,11--64 msgid "A confirmation e-mail has been sent to the address:" msgstr "Un lien de confirmation a été envoyé à l'adresse :" -#: src/app/learnocaml_index_main.ml:593,10--54 +#: src/app/learnocaml_index_main.ml:630,10--54 msgid "The entered e-mail couldn't be recognized." msgstr "L'e-mail entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:615,12--45 +#: src/app/learnocaml_index_main.ml:652,12--45 msgid "The entered e-mail is invalid: " msgstr "L'e-mail entré est invalide." -#: src/app/learnocaml_index_main.ml:720,28--45 -#: src/app/learnocaml_index_main.ml:756,29--46 +#: src/app/learnocaml_index_main.ml:758,28--45 +#: src/app/learnocaml_index_main.ml:794,29--46 msgid "TOKEN NOT FOUND" msgstr "TOKEN NON TROUVÉ" -#: src/app/learnocaml_index_main.ml:721,17--60 -#: src/app/learnocaml_index_main.ml:757,18--61 +#: src/app/learnocaml_index_main.ml:759,17--60 +#: src/app/learnocaml_index_main.ml:795,18--61 msgid "The entered token couldn't be recognized." msgstr "Le token entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:743,26--41 +#: src/app/learnocaml_index_main.ml:781,26--41 msgid "INVALID TOKEN" msgstr "PSEUDONYME INVALIDE" -#: src/app/learnocaml_index_main.ml:744,31--200 +#: src/app/learnocaml_index_main.ml:782,31--200 msgid "" "This token is associated to an upgraded account, which only allows password-" "based%s authentication." @@ -705,86 +738,86 @@ msgstr "" "Ce token est associé à un compte, autorisant uniquement l'authentification " "par mot de passe%s." -#: src/app/learnocaml_index_main.ml:747,54--70 +#: src/app/learnocaml_index_main.ml:785,54--70 msgid " or Moodle/LTI" msgstr " ou avec Moodle/LTI" -#: src/app/learnocaml_index_main.ml:854,7--21 +#: src/app/learnocaml_index_main.ml:892,7--21 msgid "Connected as" msgstr "Connecté en tant que" -#: src/app/learnocaml_index_main.ml:856,7--19 +#: src/app/learnocaml_index_main.ml:894,7--19 msgid "Activities" msgstr "Activités" -#: src/app/learnocaml_index_main.ml:858,9--33 +#: src/app/learnocaml_index_main.ml:896,9--33 msgid "Welcome to Learn OCaml" msgstr "Bienvenue sur Learn OCaml" -#: src/app/learnocaml_index_main.ml:862,24--42 +#: src/app/learnocaml_index_main.ml:900,24--42 msgid "Create new token" msgstr "Nouveau token" -#: src/app/learnocaml_index_main.ml:880,35--62 +#: src/app/learnocaml_index_main.ml:918,35--62 msgid "Login with a legacy token" msgstr "Connexion avec un ancien token" -#: src/app/learnocaml_index_main.ml:881,30--37 +#: src/app/learnocaml_index_main.ml:919,30--37 #: src/app/learnocaml_teacher_tab.ml:559,22--29 msgid "Token" msgstr "Token" -#: src/app/learnocaml_index_main.ml:883,22--40 +#: src/app/learnocaml_index_main.ml:921,22--40 #: src/app/learnocaml_upgrade_main.ml:25,26--44 msgid "Setup a password" msgstr "Définir un mot de passe" -#: src/app/learnocaml_index_main.ml:925,38--59 +#: src/app/learnocaml_index_main.ml:963,38--59 msgid "Choose an activity." msgstr "Sélectionnez une activité." -#: src/app/learnocaml_index_main.ml:944,31--51 +#: src/app/learnocaml_index_main.ml:982,31--51 msgid "New e-mail address" msgstr "Nouvelle adresse e-mail" -#: src/app/learnocaml_index_main.ml:945,22--54 +#: src/app/learnocaml_index_main.ml:983,22--54 msgid "Enter your new e-mail address:" msgstr "Entrez votre nouvelle adresse e-mail :" -#: src/app/learnocaml_index_main.ml:955,22--39 +#: src/app/learnocaml_index_main.ml:993,22--39 msgid "Change password" msgstr "Changer de mot de passe" -#: src/app/learnocaml_index_main.ml:956,22--37 +#: src/app/learnocaml_index_main.ml:994,22--37 msgid "Change e-mail" msgstr "Changer d'adresse e-mail" -#: src/app/learnocaml_index_main.ml:967,30--41 +#: src/app/learnocaml_index_main.ml:1005,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:969,29--38 +#: src/app/learnocaml_index_main.ml:1007,29--38 msgid "Lessons" msgstr "Cours" -#: src/app/learnocaml_index_main.ml:976,32--44 +#: src/app/learnocaml_index_main.ml:1014,32--44 #: src/app/learnocaml_playground_main.ml:72,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:979,28--35 +#: src/app/learnocaml_index_main.ml:1017,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:1079,17--71 +#: src/app/learnocaml_index_main.ml:1117,17--71 msgid "Be sure to write down your token before logging out:" msgstr "Assurez-vous d'avoir noté votre token :" -#: src/app/learnocaml_index_main.ml:1081,17--51 +#: src/app/learnocaml_index_main.ml:1119,17--51 msgid "Are you sure you want to logout?" msgstr "Êtes-vous sûr de vouloir vous déconnecter ?" -#: src/app/learnocaml_index_main.ml:1083,15--186 +#: src/app/learnocaml_index_main.ml:1121,15--186 msgid "" "WARNING: the data could not be synchronised with the server. Logging out " "will lose your local changes, be sure you exported a backup." @@ -793,37 +826,37 @@ msgstr "" "En vous déconnectant, vous perdrez tous les changements locaux, à moins " "d'avoir exporté votre espace de travail au préalable." -#: src/app/learnocaml_index_main.ml:1094,22--30 -#: src/app/learnocaml_index_main.ml:1094,45--53 -#: src/app/learnocaml_index_main.ml:1117,9--17 +#: src/app/learnocaml_index_main.ml:1132,22--30 +#: src/app/learnocaml_index_main.ml:1132,45--53 +#: src/app/learnocaml_index_main.ml:1154,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:1107,15--27 +#: src/app/learnocaml_index_main.ml:1145,15--27 msgid "Show login" msgstr "Afficher votre login" -#: src/app/learnocaml_index_main.ml:1108,15--27 +#: src/app/learnocaml_index_main.ml:1146,15--27 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:1111,9--25 +#: src/app/learnocaml_index_main.ml:1148,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:1114,9--25 +#: src/app/learnocaml_index_main.ml:1151,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:1115,9--17 +#: src/app/learnocaml_index_main.ml:1152,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:1116,9--36 +#: src/app/learnocaml_index_main.ml:1153,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:1122,38--44 +#: src/app/learnocaml_index_main.ml:1159,38--44 msgid "Menu" msgstr "Menu" @@ -1185,7 +1218,7 @@ msgstr "lors du test de la solution utilisateur" #, fuzzy #~ msgid "USER NOT FOUND" -#~ msgstr "TOKEN NON TROUVÉ" +#~ msgstr "UTILISATEUR NON TROUVÉ" #~ msgid "Enter your token" #~ msgstr "Entrez votre token" From d785f20d4ebadd68698db7522c5e3ebfa29d66a0 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 00:07:53 +0200 Subject: [PATCH 117/161] refactor(learnocaml_api.ml): Simplify response_codec/Get_emails --- src/state/learnocaml_api.ml | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 0204e3b27..14d44e781 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -206,9 +206,7 @@ module Conversions (Json: JSON_CODEC) = struct | Reset_password _ -> str | Do_reset_password _ -> str - | Get_emails _ -> json J.(obj1 (opt "email" - (tup2 string - (obj1 (opt "pending" string))))) + | Get_emails _ -> json J.(option (tup2 string (option string))) | Upgrade_form _ -> str | Upgrade _ -> str From a1ed4d74829b51ea2cec3c5017851cfe7d04d814 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 01:39:38 +0200 Subject: [PATCH 118/161] feat: make it possible to reuse a legacy-token account from lti.html --- src/app/learnocaml_lti_main.ml | 6 +++ src/server/learnocaml_server.ml | 32 ++++++++++++++- src/state/learnocaml_api.ml | 8 ++++ src/state/learnocaml_api.mli | 2 + src/state/token_index.ml | 11 +++++ src/state/token_index.mli | 3 ++ static/css/learnocaml_main.css | 8 ++-- static/lti.html | 20 ++++++++- translations/fr.po | 72 ++++++++++++++++++--------------- 9 files changed, 123 insertions(+), 39 deletions(-) diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index 9a6e086d2..d7415e42f 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -21,6 +21,7 @@ let check_email_js email = let id s = s, find_component s +(* XXX there is dead code among these variables *) let login_overlay_id, login_overlay = id "login-overlay" let login_new_id, login_new = id "login-new" let login_returning_id, login_returning = id "login-returning" @@ -41,6 +42,8 @@ let login_connect_button_id, login_connect_button = id "login-connect-button" let login_direct_button_id, login_direct_button = id "login-direct-login" +let login_token_button_id, login_token_button = id "login-token-button" + let set_string_translations = List.iter (fun (id, text) -> @@ -147,4 +150,7 @@ let () = you might want to setup a password below \ (or upgrade your account later)"]; "txt_button_direct_login", [%i"Direct login"]; + "txt_token_returning", [%i"Connect"]; + "txt_returning_with_token", [%i"Reuse an account with a legacy token"]; + "txt_returning_token", [%i"Token"]; ] diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 57ccff774..c591720aa 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -346,6 +346,32 @@ module Request_handler = struct |> Markup.to_string in lwt_ok @@ Response { contents; content_type="text/html"; caching=Nocache; cookies } | Error e -> lwt_fail (`Forbidden, e)) + | Api.Launch_token body when config.ServerData.use_moodle -> + (* code similar to: + | Api.Launch_direct body when config.ServerData.use_moodle + | Api.Upgrade body when config.ServerData.use_passwd *) + let params = Uri.query_of_encoded body + |> List.map (fun (a, b) -> a, String.concat "," b) in + let make_cookie = Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in + let user_id = List.assoc "user-id" params and + csrf = List.assoc "csrf" params and + hmac = List.assoc "hmac" params and + token = Token.parse @@ List.assoc "token" params in + Token_index.OauthIndex.get_current_secret !sync_dir >>= fun secret -> + let new_hmac = generate_hmac secret csrf user_id in + if not (Eqaf.equal hmac new_hmac) then + lwt_fail (`Forbidden, "bad hmac") + else + Token_index.UserIndex.can_login !sync_dir token >>= fun canlogin -> + if not canlogin then + lwt_fail (`Forbidden, "Bad token (or token already used by an upgraded account)") + else + Token_index.MoodleIndex.add_user !sync_dir user_id token >>= fun () -> + Token_index.UserIndex.upgrade_moodle !sync_dir token >>= fun () -> + let cookies = [make_cookie ("token", Token.to_string token); + make_cookie ~http_only:true ("csrf", "expired")] in + lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | Api.Launch_login body when config.ServerData.use_moodle -> let params = Uri.query_of_encoded body |> List.map (fun (a, b) -> a, String.concat "," b) in @@ -384,8 +410,8 @@ module Request_handler = struct lwt_ok @@ Redirect { code=`See_other; url="/"; cookies }) | Api.Launch_direct body when config.ServerData.use_moodle -> let params = Uri.query_of_encoded body - |> List.map (fun (a, b) -> a, String.concat "," b) and - make_cookie = Cohttp.Cookie.Set_cookie_hdr.make + |> List.map (fun (a, b) -> a, String.concat "," b) in + let make_cookie = Cohttp.Cookie.Set_cookie_hdr.make ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in let user_id = List.assoc "user-id" params and csrf = List.assoc "csrf" params and @@ -410,6 +436,8 @@ module Request_handler = struct lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | Api.Launch _ -> lwt_fail (`Forbidden, "LTI is disabled on this instance.") + | Api.Launch_token _ -> + lwt_fail (`Forbidden, "LTI is disabled on this instance.") | Api.Launch_login _ -> lwt_fail (`Forbidden, "LTI is disabled on this instance.") | Api.Launch_direct _ -> diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 14d44e781..afb4a8d54 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -36,6 +36,8 @@ type _ request = | Git: 'a token * string list -> string request | Launch: string -> string request + | Launch_token: + string -> string request | Launch_login: string -> string request | Launch_direct: @@ -163,6 +165,7 @@ module Conversions (Json: JSON_CODEC) = struct json Save.enc | Git _ -> str | Launch _ -> str + | Launch_token _ -> str | Launch_login _ -> str | Launch_direct _ -> str | Students_list _ -> @@ -268,6 +271,8 @@ module Conversions (Json: JSON_CODEC) = struct assert false (* Reserved for the [git] client *) | Launch _ -> assert false (* Reserved for an LTI application *) + | Launch_token _ -> + assert false (* Reserved for an LTI application *) | Launch_login _ -> assert false (* Reserved for an LTI application *) | Launch_direct _ -> @@ -467,6 +472,9 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct | `POST body, ["launch"], _token -> Launch body |> k + | `POST body, ["launch"; "token"], _ -> + Launch_token body |> k + | `POST body, ["launch"; "login"], _token -> Launch_login body |> k diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 908d16923..a8a085cc0 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -50,6 +50,8 @@ type _ request = 'a token * string list -> string request | Launch: string -> string request + | Launch_token: + string -> string request | Launch_login: string -> string request | Launch_direct: diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 15ba8e8b6..98555bf41 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -406,6 +406,17 @@ module BaseUserIndex (RW: IndexRW) = struct | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise + let upgrade_moodle sync_dir token = + get_data sync_dir >|= + List.map (function + | Token (found_token, _use_moodle) when found_token = token -> + Token (token, true) + | Password (found_token, _email, _passwd, _verify) + when found_token = token -> + failwith "BaseUserIndex.upgrade_moodle: invalid action" + | elt -> elt) >>= + RW.write rw (sync_dir / indexes_subdir / file) serialise + let upgrade sync_dir token email passwd = (exists sync_dir email >|= fun exists -> if exists then failwith "BaseUserIndex.upgrade: duplicate email") diff --git a/src/state/token_index.mli b/src/state/token_index.mli index dae9d7f0a..5525ff735 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -72,6 +72,9 @@ module UserIndex: sig val exists : string -> string -> bool Lwt.t val add : string -> user -> unit Lwt.t + (** Upgrade account from TOKEN to Moodle/LTI *) + val upgrade_moodle : string -> Learnocaml_data.Token.t -> unit Lwt.t + (** Upgrade account from TOKEN to password *) val upgrade : string -> Learnocaml_data.Token.t -> string -> string -> unit Lwt.t diff --git a/static/css/learnocaml_main.css b/static/css/learnocaml_main.css index 8949f473c..cdda05ea7 100644 --- a/static/css/learnocaml_main.css +++ b/static/css/learnocaml_main.css @@ -924,7 +924,7 @@ div#login-overlay > h1 { text-align: center; margin-bottom: 50px; } -#login-new-token, #login-new, #login-returning, #login-token { +#login-new-token, #login-new, #login-returning, #login-token, #login-direct { margin: 30px auto; background-color: #666; border-radius: 3px; @@ -934,7 +934,7 @@ div#login-overlay > h1 { flex-direction: column; } @media (min-width: 1000px) { - #login-new-token, #login-new, #login-returning, #login-token { + #login-new-token, #login-new, #login-returning, #login-token, #login-direct { width: 30vw; } } @@ -949,12 +949,12 @@ div#login-overlay > h1 { color: black; border-radius: 3px 3px 0 0; } -#login-new-token > div, #login-new > div, #login-returning > div, #login-token > div { +#login-new-token > div, #login-new > div, #login-returning > div, #login-token > div, #login-direct > div { padding: 20px; display: flex; flex-direction: row; } -#login-new-token > dir > div, #login-new > div > div, #login-returning > div > div, #login-token > div > div { +#login-new-token > dir > div, #login-new > div > div, #login-returning > div > div, #login-token > div > div, #login-direct > div > div { line-height: 30px; } div#login-overlay input { diff --git a/static/lti.html b/static/lti.html index cc78917b5..6b9930aff 100644 --- a/static/lti.html +++ b/static/lti.html @@ -17,7 +17,7 @@
    -
    +

    @@ -28,6 +28,24 @@

    +
    + +
    +
    +

    +
    +
    +
    + +
    + + + +
    diff --git a/translations/fr.po b/translations/fr.po index 101a5d7b6..083b86c4e 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-12 20:01+0200\n" +"PO-Revision-Date: 2020-09-13 01:39+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -24,9 +24,9 @@ msgid "OK" msgstr "OK" #: src/app/learnocaml_common.ml:139,21--28 -#: src/app/learnocaml_lti_main.ml:88,26--33 -#: src/app/learnocaml_lti_main.ml:94,26--33 -#: src/app/learnocaml_lti_main.ml:98,26--33 +#: src/app/learnocaml_lti_main.ml:91,26--33 +#: src/app/learnocaml_lti_main.ml:97,26--33 +#: src/app/learnocaml_lti_main.ml:101,26--33 #: src/app/learnocaml_index_main.ml:610,21--28 #: src/app/learnocaml_index_main.ml:629,21--28 #: src/app/learnocaml_index_main.ml:651,22--29 @@ -459,21 +459,21 @@ msgstr "" msgid "Unexpected error:\n" msgstr "Erreur inattendue :\n" -#: src/app/learnocaml_lti_main.ml:89,15--48 +#: src/app/learnocaml_lti_main.ml:92,15--48 #: src/app/learnocaml_index_main.ml:611,10--43 #: src/app/learnocaml_index_main.ml:712,19--52 #: src/app/learnocaml_index_main.ml:813,38--71 msgid "The entered e-mail was invalid." msgstr "L'e-mail entré est invalide." -#: src/app/learnocaml_lti_main.ml:95,15--60 +#: src/app/learnocaml_lti_main.ml:98,15--60 #: src/app/learnocaml_index_main.ml:718,19--64 #: src/app/learnocaml_reset_main.ml:20,32--77 #: src/app/learnocaml_upgrade_main.ml:21,34--79 msgid "Password must be at least 8 characters long" msgstr "Le mot de passe doit comporter au moins 8 caractères" -#: src/app/learnocaml_lti_main.ml:99,15--153 +#: src/app/learnocaml_lti_main.ml:102,15--153 #: src/app/learnocaml_index_main.ml:722,19--165 #: src/app/learnocaml_reset_main.ml:21,34--210 #: src/app/learnocaml_upgrade_main.ml:22,36--216 @@ -484,51 +484,51 @@ msgstr "" "Le mot de passe doit contenir au moins un chiffre, une lettre minuscule et " "majuscule, et un caractère non-alphanumérique." -#: src/app/learnocaml_lti_main.ml:114,21--42 +#: src/app/learnocaml_lti_main.ml:117,21--42 #: src/app/learnocaml_index_main.ml:738,25--46 msgid "VALIDATION REQUIRED" msgstr "VALIDATION REQUISE" -#: src/app/learnocaml_lti_main.ml:114,47--101 +#: src/app/learnocaml_lti_main.ml:117,47--101 #: src/app/learnocaml_index_main.ml:738,51--105 msgid "A confirmation e-mail has been sent to your address." msgstr "Un courriel a été envoyé à votre adresse pour la confirmer." -#: src/app/learnocaml_lti_main.ml:127,33--51 +#: src/app/learnocaml_lti_main.ml:130,33--51 #: src/app/learnocaml_index_main.ml:897,37--55 #: src/app/learnocaml_index_main.ml:901,31--49 msgid "First connection" msgstr "Première connexion" -#: src/app/learnocaml_lti_main.ml:128,39--55 -#: src/app/learnocaml_lti_main.ml:140,32--48 +#: src/app/learnocaml_lti_main.ml:131,39--55 +#: src/app/learnocaml_lti_main.ml:143,32--48 #: src/app/learnocaml_index_main.ml:902,37--53 #: src/app/learnocaml_index_main.ml:911,30--46 #: src/app/learnocaml_upgrade_main.ml:26,32--48 msgid "E-mail address" msgstr "Adresse e-mail" -#: src/app/learnocaml_lti_main.ml:129,42--52 +#: src/app/learnocaml_lti_main.ml:132,42--52 #: src/app/learnocaml_index_main.ml:903,40--50 #: src/app/learnocaml_index_main.ml:929,9--19 #: src/app/learnocaml_teacher_tab.ml:557,22--32 msgid "Nickname" msgstr "Pseudonyme" -#: src/app/learnocaml_lti_main.ml:130,42--52 -#: src/app/learnocaml_lti_main.ml:141,35--45 +#: src/app/learnocaml_lti_main.ml:133,42--52 +#: src/app/learnocaml_lti_main.ml:144,35--45 #: src/app/learnocaml_index_main.ml:904,40--50 #: src/app/learnocaml_index_main.ml:912,33--43 #: src/app/learnocaml_upgrade_main.ml:27,35--45 msgid "Password" msgstr "Mot de passe" -#: src/app/learnocaml_lti_main.ml:131,40--48 +#: src/app/learnocaml_lti_main.ml:134,40--48 #: src/app/learnocaml_index_main.ml:905,38--46 msgid "Secret" msgstr "Secret" -#: src/app/learnocaml_lti_main.ml:132,29--198 +#: src/app/learnocaml_lti_main.ml:135,29--198 #: src/app/learnocaml_index_main.ml:906,27--192 msgid "" "The secret is an optional passphrase provided by your teacher. It may be " @@ -537,7 +537,7 @@ msgstr "" "Le secret est une phrase de passe pouvant être fournie par votre enseignant. " "Celle-ci est alors requise pour s'inscrire." -#: src/app/learnocaml_lti_main.ml:135,41--251 +#: src/app/learnocaml_lti_main.ml:138,41--251 #: src/app/learnocaml_index_main.ml:915,39--244 msgid "" "By submitting this form, I accept that the information entered will be used " @@ -546,38 +546,39 @@ msgstr "" "En validant ce formulaire, j'accepte que les informations entrées puissent " "être utilisées dans le contexte de la plateforme Learn-OCaml." -#: src/app/learnocaml_lti_main.ml:138,26--46 +#: src/app/learnocaml_lti_main.ml:141,26--46 #: src/app/learnocaml_index_main.ml:909,24--44 msgid "Create new account" msgstr "Créer un compte" -#: src/app/learnocaml_lti_main.ml:139,26--42 +#: src/app/learnocaml_lti_main.ml:142,26--42 #: src/app/learnocaml_index_main.ml:910,24--40 msgid "Returning user" msgstr "Utilisateur existant" -#: src/app/learnocaml_lti_main.ml:142,32--41 +#: src/app/learnocaml_lti_main.ml:145,32--41 +#: src/app/learnocaml_lti_main.ml:153,32--41 #: src/app/learnocaml_index_main.ml:913,31--40 #: src/app/learnocaml_index_main.ml:920,30--39 msgid "Connect" msgstr "Se connecter" -#: src/app/learnocaml_lti_main.ml:143,32--55 +#: src/app/learnocaml_lti_main.ml:146,32--55 #: src/app/learnocaml_index_main.ml:914,30--53 msgid "Forgot your password?" msgstr "Mot de passe oublié ?" -#: src/app/learnocaml_lti_main.ml:144,38--57 +#: src/app/learnocaml_lti_main.ml:147,38--57 #: src/app/learnocaml_index_main.ml:898,44--63 msgid "Choose a nickname" msgstr "Choisissez un identifiant" -#: src/app/learnocaml_lti_main.ml:145,29--43 -#: src/app/learnocaml_lti_main.ml:149,36--50 +#: src/app/learnocaml_lti_main.ml:148,29--43 +#: src/app/learnocaml_lti_main.ml:152,36--50 msgid "Direct login" msgstr "Connexion directe" -#: src/app/learnocaml_lti_main.ml:146,31--221 +#: src/app/learnocaml_lti_main.ml:149,31--221 msgid "" "Or to be able to login independently of Moodle, you might want to setup a " "password below (or upgrade your account later)" @@ -585,6 +586,16 @@ msgstr "" "Ou pour pouvoir vous connecter sans passer par Moodle, vous pouvez créer un " "compte avec un mot de passe ci-dessous (ou en définir un plus tard)" +#: src/app/learnocaml_lti_main.ml:154,37--75 +msgid "Reuse an account with a legacy token" +msgstr "Réutiliser un compte avec un ancien token" + +#: src/app/learnocaml_lti_main.ml:155,32--39 +#: src/app/learnocaml_index_main.ml:919,30--37 +#: src/app/learnocaml_teacher_tab.ml:559,22--29 +msgid "Token" +msgstr "Token" + #: src/app/learnocaml_index_main.ml:88,18--37 msgid "Loading exercises" msgstr "Chargement des exercices" @@ -659,7 +670,9 @@ msgstr "L'authentification par Moodle/LTI est activée pour votre compte." msgid "" "You might also want to associate your account with Moodle/LTI. Ask your " "teacher if need be." -msgstr "Vous pourriez aussi vouloir associer votre compte à Moodle/LTI. Demandez à votre enseignant le cas échéant." +msgstr "" +"Vous pourriez aussi vouloir associer votre compte à Moodle/LTI. Demandez à " +"votre enseignant le cas échéant." #: src/app/learnocaml_index_main.ml:588,24--47 msgid "No e-mail registered." @@ -762,11 +775,6 @@ msgstr "Nouveau token" msgid "Login with a legacy token" msgstr "Connexion avec un ancien token" -#: src/app/learnocaml_index_main.ml:919,30--37 -#: src/app/learnocaml_teacher_tab.ml:559,22--29 -msgid "Token" -msgstr "Token" - #: src/app/learnocaml_index_main.ml:921,22--40 #: src/app/learnocaml_upgrade_main.ml:25,26--44 msgid "Setup a password" From 4ee7ecab2e0e9d9a2cc8b69672553e6ad3c71101 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 01:58:02 +0200 Subject: [PATCH 119/161] fix: one translation --- translations/fr.po | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/translations/fr.po b/translations/fr.po index 083b86c4e..7f56a040a 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-13 01:39+0200\n" +"PO-Revision-Date: 2020-09-13 01:57+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -741,7 +741,7 @@ msgstr "Le token entré n'a pas été reconnu." #: src/app/learnocaml_index_main.ml:781,26--41 msgid "INVALID TOKEN" -msgstr "PSEUDONYME INVALIDE" +msgstr "TOKEN INVALIDE" #: src/app/learnocaml_index_main.ml:782,31--200 msgid "" From 69ac357de9f7043fc6db873ca0792725f72f088c Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 02:10:44 +0200 Subject: [PATCH 120/161] feat: Add text advertising Moodle login if it is enabled --- src/app/learnocaml_index_main.ml | 5 +++ static/index.html | 2 ++ translations/fr.po | 57 +++++++++++++++++--------------- 3 files changed, 38 insertions(+), 26 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index ff3350a3f..861815df4 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -919,6 +919,11 @@ let set_string_translations () = "txt_returning_token", [%i"Token"]; "txt_token_returning", [%i"Connect"]; "txt_upgrade", [%i"Setup a password"]; + "txt_moodle_label", (if get_opt config##.enableMoodle + then [%i"Or you may want to login \ + directly from Moodle \ + (ask your teacher for details)"] + else ""); ] in List.iter (fun (id, text) -> diff --git a/static/index.html b/static/index.html index 96bfa075f..faf8dca23 100644 --- a/static/index.html +++ b/static/index.html @@ -106,6 +106,8 @@

    +
    +

    diff --git a/translations/fr.po b/translations/fr.po index 7f56a040a..40d605fcb 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-13 01:57+0200\n" +"PO-Revision-Date: 2020-09-13 02:10+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -145,7 +145,7 @@ msgid "Editor" msgstr "Éditeur" #: src/app/learnocaml_common.ml:787,41--51 -#: src/app/learnocaml_index_main.ml:1012,30--40 +#: src/app/learnocaml_index_main.ml:1017,30--40 msgid "Toplevel" msgstr "Toplevel" @@ -183,7 +183,7 @@ msgstr "Statistiques" #: src/app/learnocaml_common.ml:799,37--48 #: src/app/learnocaml_exercise_main.ml:200,23--34 -#: src/app/learnocaml_index_main.ml:1009,29--40 +#: src/app/learnocaml_index_main.ml:1014,29--40 #: src/app/learnocaml_teacher_tab.ml:328,18--29 msgid "Exercises" msgstr "Exercices" @@ -510,7 +510,7 @@ msgstr "Adresse e-mail" #: src/app/learnocaml_lti_main.ml:132,42--52 #: src/app/learnocaml_index_main.ml:903,40--50 -#: src/app/learnocaml_index_main.ml:929,9--19 +#: src/app/learnocaml_index_main.ml:934,9--19 #: src/app/learnocaml_teacher_tab.ml:557,22--32 msgid "Nickname" msgstr "Pseudonyme" @@ -780,52 +780,57 @@ msgstr "Connexion avec un ancien token" msgid "Setup a password" msgstr "Définir un mot de passe" -#: src/app/learnocaml_index_main.ml:963,38--59 +#: src/app/learnocaml_index_main.ml:923,33--183 +msgid "" +"Or you may want to login directly from Moodle (ask your teacher for details)" +msgstr "Ou vous pouvez vous connecter directement depuis Moodle (demandez à votre enseignant pour plus de détails)" + +#: src/app/learnocaml_index_main.ml:968,38--59 msgid "Choose an activity." msgstr "Sélectionnez une activité." -#: src/app/learnocaml_index_main.ml:982,31--51 +#: src/app/learnocaml_index_main.ml:987,31--51 msgid "New e-mail address" msgstr "Nouvelle adresse e-mail" -#: src/app/learnocaml_index_main.ml:983,22--54 +#: src/app/learnocaml_index_main.ml:988,22--54 msgid "Enter your new e-mail address:" msgstr "Entrez votre nouvelle adresse e-mail :" -#: src/app/learnocaml_index_main.ml:993,22--39 +#: src/app/learnocaml_index_main.ml:998,22--39 msgid "Change password" msgstr "Changer de mot de passe" -#: src/app/learnocaml_index_main.ml:994,22--37 +#: src/app/learnocaml_index_main.ml:999,22--37 msgid "Change e-mail" msgstr "Changer d'adresse e-mail" -#: src/app/learnocaml_index_main.ml:1005,30--41 +#: src/app/learnocaml_index_main.ml:1010,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:1007,29--38 +#: src/app/learnocaml_index_main.ml:1012,29--38 msgid "Lessons" msgstr "Cours" -#: src/app/learnocaml_index_main.ml:1014,32--44 +#: src/app/learnocaml_index_main.ml:1019,32--44 #: src/app/learnocaml_playground_main.ml:72,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:1017,28--35 +#: src/app/learnocaml_index_main.ml:1022,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:1117,17--71 +#: src/app/learnocaml_index_main.ml:1122,17--71 msgid "Be sure to write down your token before logging out:" msgstr "Assurez-vous d'avoir noté votre token :" -#: src/app/learnocaml_index_main.ml:1119,17--51 +#: src/app/learnocaml_index_main.ml:1124,17--51 msgid "Are you sure you want to logout?" msgstr "Êtes-vous sûr de vouloir vous déconnecter ?" -#: src/app/learnocaml_index_main.ml:1121,15--186 +#: src/app/learnocaml_index_main.ml:1126,15--186 msgid "" "WARNING: the data could not be synchronised with the server. Logging out " "will lose your local changes, be sure you exported a backup." @@ -834,37 +839,37 @@ msgstr "" "En vous déconnectant, vous perdrez tous les changements locaux, à moins " "d'avoir exporté votre espace de travail au préalable." -#: src/app/learnocaml_index_main.ml:1132,22--30 -#: src/app/learnocaml_index_main.ml:1132,45--53 -#: src/app/learnocaml_index_main.ml:1154,9--17 +#: src/app/learnocaml_index_main.ml:1137,22--30 +#: src/app/learnocaml_index_main.ml:1137,45--53 +#: src/app/learnocaml_index_main.ml:1159,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:1145,15--27 +#: src/app/learnocaml_index_main.ml:1150,15--27 msgid "Show login" msgstr "Afficher votre login" -#: src/app/learnocaml_index_main.ml:1146,15--27 +#: src/app/learnocaml_index_main.ml:1151,15--27 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:1148,9--25 +#: src/app/learnocaml_index_main.ml:1153,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:1151,9--25 +#: src/app/learnocaml_index_main.ml:1156,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:1152,9--17 +#: src/app/learnocaml_index_main.ml:1157,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:1153,9--36 +#: src/app/learnocaml_index_main.ml:1158,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:1159,38--44 +#: src/app/learnocaml_index_main.ml:1164,38--44 msgid "Menu" msgstr "Menu" From 48fb42b5fd4ee734bc3c48642efe3f593e35f334 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 02:56:26 +0200 Subject: [PATCH 121/161] feat: Resend confirmation email on passwd_reset if unconfirmed email --- src/server/learnocaml_server.ml | 31 ++++++++++++++++++++++++++++--- src/state/token_index.ml | 13 +++++++++++++ src/state/token_index.mli | 3 +++ 3 files changed, 44 insertions(+), 3 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index c591720aa..5a899a5f4 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -235,6 +235,18 @@ let get_nickname token = | None -> Lwt.return_none | Some save -> Lwt.return_some save.Save.nickname +let resend_confirmation_email token email req = + begin Token_index.UpgradeIndex.ongoing_change_email !sync_dir token >>= function + | Some handle -> Lwt.return handle + | None -> Token_index.UpgradeIndex.change_email !sync_dir token + end >>= fun handle -> + get_nickname token >>= fun nick -> + Learnocaml_sendmail.confirm_email + ~nick + ~url:(req.Api.host ^ "/confirm/" ^ handle) + email; + Lwt.return_unit + let initiate_password_change token address cache req = Token_index.UpgradeIndex.reset_password !sync_dir token >>= fun handle -> get_nickname token >>= fun nick -> @@ -767,7 +779,16 @@ module Request_handler = struct else Token_index.UserIndex.token_of_email !sync_dir address >>= (function | Some token -> - initiate_password_change token address cache req + Token_index.UserIndex.emails_of_token !sync_dir token >>= + (function + | Some (address, pending) -> + begin if pending = Some address (* same email -> unconfirmed *) + then resend_confirmation_email token address req + else Lwt.return_unit + end >>= fun () -> + initiate_password_change token address cache req + | None -> + initiate_password_change token address cache req) | None -> Lwt.return (Printf.printf "[INFO] attempt to reset password for unknown email: %s\n%!" @@ -777,8 +798,12 @@ module Request_handler = struct | Api.Change_password token when config.ServerData.use_passwd -> Token_index.UserIndex.emails_of_token !sync_dir token >>= (function - | Some (address, _pending) -> - initiate_password_change token address cache req + | Some (address, pending) -> + begin if pending = Some address (* same email -> unconfirmed *) + then resend_confirmation_email token address req + else Lwt.return_unit + end >>= fun () -> + initiate_password_change token address cache req | None -> lwt_fail (`Not_found, "Unknown user.")) | Api.Reset_password handle when config.ServerData.use_passwd -> Token_index.UpgradeIndex.can_reset_password !sync_dir handle >>= diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 98555bf41..146de3fe3 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -526,6 +526,19 @@ module BaseUpgradeIndex (RW: IndexRW) = struct let can_change_email = check_upgrade_operation ChangeEmail let can_reset_password = check_upgrade_operation ResetPassword + let ongoing_change_email sync_dir token = + get_data sync_dir >>= fun operations -> + List.map fst @@ + List.filter (fun (_handle, (found_token, _date, operation)) -> + operation = ChangeEmail && token = found_token) operations + |> function + | [] -> Lwt.return_none + | handle :: [] -> Lwt.return_some handle + | handle :: _ -> + Printf.printf {|[WARNING] several ChangeEmail handles for %s|} + (Token.to_string token); + Lwt.return_some handle + let revoke_operation sync_dir handle = get_data sync_dir >|= List.filter (fun (found_handle, _operation) -> found_handle <> handle) >>= diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 5525ff735..3999fa4ee 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -100,6 +100,9 @@ module UpgradeIndex: sig val change_email : string -> Learnocaml_data.Token.t -> string Lwt.t val reset_password : string -> Learnocaml_data.Token.t -> string Lwt.t + (* return a ChangeEmail handle if it exists *) + val ongoing_change_email : string -> Learnocaml_data.Token.t -> string option Lwt.t + (* takes a handle *) val can_change_email : string -> string -> Learnocaml_data.Token.t option Lwt.t val can_reset_password : string -> string -> Learnocaml_data.Token.t option Lwt.t From 6f339430b59fc5896a02b7a85322a6b7eebf748b Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 03:07:48 +0200 Subject: [PATCH 122/161] feat(index-main): Make login-connect-button check email syntax first --- src/app/learnocaml_index_main.ml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 861815df4..7b6273106 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -741,10 +741,11 @@ let init_token_dialog () = Lwt.return_none in let rec login_passwd () = - let input = Manip.value login_input_email and + let email = Manip.value login_input_email and password = Manip.value login_input_password in if get_opt config##.enablePasswd then - Server_caller.request (Learnocaml_api.Login (input, password)) >>= function + validate_email email >>= fun _email -> + Server_caller.request (Learnocaml_api.Login (email, password)) >>= function | Error e -> alert ~title:[%i"ERROR"] (Server_caller.string_of_error e); Lwt.return_none From d09037ed85ad1854c5758ab62e5eb313e38b8d8e Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 14:15:05 +0200 Subject: [PATCH 123/161] refactor(learnocaml_common.mli): Expose box_button & close_button --- src/app/learnocaml_common.mli | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/src/app/learnocaml_common.mli b/src/app/learnocaml_common.mli index 25f63c4fa..152def4e8 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -23,6 +23,11 @@ val fatal : ?title: string -> string -> unit val alert : ?title: string -> ?buttons: Html_types.div_content Tyxml_js.Html.elt list -> string -> unit +val box_button : string Tyxml_js.Html.wrap -> (unit -> 'a) -> [> Html_types.button ] Tyxml_js.Html.elt + +(* [close_button txt] is defined as [box_button txt @@ fun () -> ()] *) +val close_button : string Tyxml_js.Html.wrap -> [> Html_types.button ] Tyxml_js.Html.elt + val ext_alert : title: string -> ?buttons: Html_types.div_content_fun Tyxml_js.Html.elt list -> From 8f235f4b8aa12d34e7330db93d86c01c1615d1ef Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 14:27:33 +0200 Subject: [PATCH 124/161] feat(learnocaml_validate_main.ml): Redirect when closing confim dialog --- src/app/learnocaml_validate_main.ml | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) diff --git a/src/app/learnocaml_validate_main.ml b/src/app/learnocaml_validate_main.ml index 79fefbd8b..d4bfb3d3d 100644 --- a/src/app/learnocaml_validate_main.ml +++ b/src/app/learnocaml_validate_main.ml @@ -5,9 +5,30 @@ * Learn-OCaml is distributed under the terms of the MIT license. See the * included LICENSE file for details. *) -open Js_utils open Learnocaml_common +let rec drop_2_trailing = function + | [] | [_] | [_; _] -> [] + | x :: l -> x :: drop_2_trailing l + +(* Replace location: from [http://localhost:8080/confirm/...handle...] + to [http://localhost:8080] *) +let redirect () = + let open Js_of_ocaml__Url in + match Url.Current.get () with + | Some (Http http_url) -> + let new_url = {http_url with hu_path = drop_2_trailing http_url.hu_path} in + Url.Current.set (Http new_url) + | Some (Https http_url) -> + let new_url = {http_url with hu_path = drop_2_trailing http_url.hu_path} in + Url.Current.set (Https new_url) + | Some _ | None -> () + let () = (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); - alert ~title:[%i"EMAIL CONFIRMED"] [%i"Your e-mail address has been confirmed. You can now login."] + let message = + [%i"Your e-mail address has been confirmed. You can now login."] in + let module H =Tyxml_js.Html in + ext_alert ~title:[%i"EMAIL CONFIRMED"] + ~buttons: [box_button [%i"OK"] @@ redirect] + [ H.p [H.txt (String.trim message)] ] From 37a3e664534b5e0833cbdef259318ad72d8139a5 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 14:46:26 +0200 Subject: [PATCH 125/161] refactor(learnocaml_validate_main.ml): Define and Use cb_alert --- src/app/learnocaml_common.ml | 4 ++++ src/app/learnocaml_common.mli | 2 ++ src/app/learnocaml_validate_main.ml | 5 +---- 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/src/app/learnocaml_common.ml b/src/app/learnocaml_common.ml index 3840c7176..a16cd83d5 100644 --- a/src/app/learnocaml_common.ml +++ b/src/app/learnocaml_common.ml @@ -139,6 +139,10 @@ let lwt_alert ~title ~buttons message = let alert ?(title=[%i"ERROR"]) ?buttons message = ext_alert ~title ?buttons [ H.p [H.txt (String.trim message)] ] +let cb_alert ?(title=[%i"ERROR"]) message f = + ext_alert ~title ~buttons:[box_button [%i"OK"] @@ f] + [ H.p [H.txt (String.trim message)] ] + let confirm ~title ?(ok_label=[%i"OK"]) ?(cancel_label=[%i"Cancel"]) contents f = ext_alert ~title contents ~buttons:[ box_button ok_label f; diff --git a/src/app/learnocaml_common.mli b/src/app/learnocaml_common.mli index 152def4e8..43b2ef606 100644 --- a/src/app/learnocaml_common.mli +++ b/src/app/learnocaml_common.mli @@ -23,6 +23,8 @@ val fatal : ?title: string -> string -> unit val alert : ?title: string -> ?buttons: Html_types.div_content Tyxml_js.Html.elt list -> string -> unit +val cb_alert :?title:string -> string -> (unit -> 'a) -> unit + val box_button : string Tyxml_js.Html.wrap -> (unit -> 'a) -> [> Html_types.button ] Tyxml_js.Html.elt (* [close_button txt] is defined as [box_button txt @@ fun () -> ()] *) diff --git a/src/app/learnocaml_validate_main.ml b/src/app/learnocaml_validate_main.ml index d4bfb3d3d..0e5b1461f 100644 --- a/src/app/learnocaml_validate_main.ml +++ b/src/app/learnocaml_validate_main.ml @@ -28,7 +28,4 @@ let () = (match Js_utils.get_lang () with Some l -> Ocplib_i18n.set_lang l | None -> ()); let message = [%i"Your e-mail address has been confirmed. You can now login."] in - let module H =Tyxml_js.Html in - ext_alert ~title:[%i"EMAIL CONFIRMED"] - ~buttons: [box_button [%i"OK"] @@ redirect] - [ H.p [H.txt (String.trim message)] ] + cb_alert ~title:[%i"EMAIL CONFIRMED"] message redirect From 2a02b6a1f8670e64389f339758bf45c1dcca8a57 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 14:47:17 +0200 Subject: [PATCH 126/161] feat(index-main): Do Manip.focus, relying on cb_alert --- src/app/learnocaml_index_main.ml | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 7b6273106..9afc65358 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -708,20 +708,21 @@ let init_token_dialog () = if not consent then Manip.SetCss.fontWeight consent_label "bold"; if email_criteria then begin - alert ~title:[%i"ERROR"] - [%i"The entered e-mail was invalid."]; - (* ; we could also do [Manip.focus reg_input_email] - but this would be broken when closing the dialog. *) + cb_alert ~title:[%i"ERROR"] + [%i"The entered e-mail was invalid."] + (fun () -> Manip.focus reg_input_email) end else if passwd_crit1 then begin - alert ~title:[%i"ERROR"] - [%i"Password must be at least 8 characters long"]; + cb_alert ~title:[%i"ERROR"] + [%i"Password must be at least 8 characters long"] + (fun () -> Manip.focus reg_input_password) end else if passwd_crit2 then begin - alert ~title:[%i"ERROR"] + cb_alert ~title:[%i"ERROR"] [%i"Password must contain at least one digit, \ one lower and upper letter, \ - and one non-alphanumeric char."]; + and one non-alphanumeric char."] + (fun () -> Manip.focus reg_input_password) end; Lwt.return_none end @@ -811,7 +812,8 @@ let init_token_dialog () = Manip.SetCss.borderColor login_input_email ""; if email_criteria then begin Manip.SetCss.borderColor login_input_email "#f44"; - alert ~title:[%i"ERROR"] [%i"The entered e-mail was invalid."]; + cb_alert ~title:[%i"ERROR"] [%i"The entered e-mail was invalid."] + (fun () -> Manip.focus login_input_email); Lwt.return_none end else Server_caller.request (Learnocaml_api.Send_reset_password email) From a04c74d57297c81581d3b49369173a985437cf95 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 14:50:11 +0200 Subject: [PATCH 127/161] feat(index-main): Reload the page when registered --- src/app/learnocaml_index_main.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 9afc65358..ee22e2440 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -736,7 +736,9 @@ let init_token_dialog () = retrieve (Learnocaml_api.Create_user (email, nickname, password, secret)) >>= fun () -> - alert ~title:[%i"VALIDATION REQUIRED"] [%i"A confirmation e-mail has been sent to your address."]; + cb_alert ~title:[%i"VALIDATION REQUIRED"] + [%i"A confirmation e-mail has been sent to your address."] + Js_utils.reload; Lwt.return_none) else Lwt.return_none From 83024c7f397e42fe322ef9f8a707fd15c9d66545 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 14:52:15 +0200 Subject: [PATCH 128/161] fix(index.html): Set autocomplete="off" for the checkbox --- static/index.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/static/index.html b/static/index.html index faf8dca23..0403eea7f 100644 --- a/static/index.html +++ b/static/index.html @@ -133,7 +133,7 @@

    - +
    From 08929e74fc426c1df1ea59274d0187c7f1c691b6 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 15:30:56 +0200 Subject: [PATCH 129/161] feat: Allow the user to abort a pending e-mail change * Update translation, frontend, and backend code --- src/app/learnocaml_index_main.ml | 42 +++-- src/server/learnocaml_server.ml | 13 ++ src/state/learnocaml_api.ml | 7 + src/state/learnocaml_api.mli | 2 + src/state/token_index.ml | 17 ++ src/state/token_index.mli | 2 + translations/fr.po | 295 ++++++++++++++++--------------- 7 files changed, 221 insertions(+), 157 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index ee22e2440..f0572ecbb 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -601,7 +601,7 @@ let show_token_dialog token = let complete_reset_password ?(sayif = true) cb = function | Ok email -> - alert ~title:[%i"RESET REQUEST"] + alert ~title:[%i"RESET REQUEST SENT"] ([%i"A reset link was sent to the address:"] ^ " " ^ email ^ if sayif then [%i"\n(if it is associated with an account)"] else ""); @@ -621,9 +621,10 @@ let complete_reset_password ?(sayif = true) cb = function let complete_change_email cb new_email = function | Ok () -> - alert ~title:[%i"RESET REQUEST SENT"] + cb_alert ~title:[%i"RESET REQUEST SENT"] ([%i"A confirmation e-mail has been sent to the address:"] - ^ " " ^ new_email); + ^ " " ^ new_email) + Js_utils.reload; Lwt.return_none | Error (`Not_found _) -> alert ~title:[%i"ERROR"] @@ -986,6 +987,10 @@ let () = Server_caller.request (Learnocaml_api.Change_password Learnocaml_local_storage.(retrieve sync_token)) >>= complete_reset_password ~sayif:false change_password in + let abort_email_change () = + Server_caller.request + (Learnocaml_api.Abort_email_change (Learnocaml_local_storage.(retrieve sync_token))) + >>= fun _ -> Lwt_js.sleep 1.0 >>= fun () -> Js_utils.reload (); Lwt.return_none in let rec change_email () = Lwt.catch (fun () -> @@ -1000,14 +1005,25 @@ let () = >>= complete_change_email change_email address | None -> Lwt.return_none) (fun _exn -> Lwt.return_none) in - let buttons = [[%i"Change password"], change_password; - [%i"Change e-mail"], change_email] in - let container = El.op_buttons_container in - Manip.removeChildren container; - List.iter (fun (name, callback) -> - let btn = Tyxml_js.Html5.(button [txt name]) in - Manip.Ev.onclick btn (fun _ -> Lwt.async callback; true); - Manip.appendChild container btn) buttons + get_emails () >>= fun res -> + let buttons = + match res with + | Some (cur_email, Some new_email) when cur_email <> new_email -> + [[%i"Change password"], change_password; + [%i"Abort e-mail change"], abort_email_change] + | Some (_email, Some _) -> + [[%i"Change password"], change_password] + | Some (_email, None) -> + [[%i"Change password"], change_password; + [%i"Change e-mail"], change_email] + | None -> [] in + let container = El.op_buttons_container in + Manip.removeChildren container; + List.iter (fun (name, callback) -> + let btn = Tyxml_js.Html5.(button [txt name]) in + Manip.Ev.onclick btn (fun _ -> Lwt.async callback; true); + Manip.appendChild container btn) buttons; + Lwt.return_unit in let init_tabs token = let tabs = @@ -1207,10 +1223,10 @@ let () = init_sync_token sync_button_group >|= init_tabs >>= fun tabs -> can_show_token () >>= fun show_token -> (if not show_token then - Server_caller.request (Learnocaml_api.Get_emails (get_stored_token ())) >|= + Server_caller.request (Learnocaml_api.Get_emails (get_stored_token ())) >>= (function | Ok (Some _) -> init_op () - | _ -> show_upgrade_button ()) + | _ -> Lwt.return @@ show_upgrade_button ()) else if get_opt config##.enablePasswd then Lwt.return @@ show_upgrade_button () else diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 5a899a5f4..d1986e68d 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -764,6 +764,17 @@ module Request_handler = struct old_address address; respond_json cache () | None -> lwt_fail (`Not_found, "Unknown user.")) + + | Api.Abort_email_change token when config.ServerData.use_passwd -> + Token_index.UserIndex.emails_of_token !sync_dir token >>= + (function + | Some (cur_email, Some new_email) when cur_email <> new_email -> + Token_index.UserIndex.abort_email_change !sync_dir token >>= fun () -> + Token_index.UpgradeIndex.abort_email_change !sync_dir token >>= fun () -> + respond_json cache () + | Some _ -> lwt_fail (`Forbidden, "Invalid action.") + | None -> lwt_fail (`Not_found, "Unknown user.")) + | Api.Confirm_email handle when config.ServerData.use_passwd -> Token_index.UpgradeIndex.can_change_email !sync_dir handle >>= (function @@ -859,6 +870,8 @@ module Request_handler = struct | Api.Change_email _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Abort_email_change _ -> + lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Confirm_email _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Send_reset_password _ -> diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index afb4a8d54..54f30744d 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -84,6 +84,8 @@ type _ request = Token.t -> bool request | Change_email: (Token.t * string) -> unit request + | Abort_email_change: + Token.t -> unit request | Confirm_email: string -> string request | Change_password: @@ -203,6 +205,7 @@ module Conversions (Json: JSON_CODEC) = struct | Is_moodle_account _ -> json J.bool | Change_email _ -> json J.unit + | Abort_email_change _ -> json J.unit | Confirm_email _ -> str | Change_password _ -> str | Send_reset_password _ -> str @@ -341,6 +344,8 @@ module Conversions (Json: JSON_CODEC) = struct get ~token ["is_moodle_account"] | Change_email (token, address) -> post ~token ["change_email"] (Json.encode J.(tup1 string) address) + | Abort_email_change token -> + post ~token ["abort_email_change"] "" | Confirm_email _ -> assert false (* Reserved for a link *) | Change_password token -> @@ -521,6 +526,8 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct (match Json.decode J.(tup1 string) body with | address -> Change_email (token, address) |> k | exception e -> Invalid_request (Printexc.to_string e) |> k) + | `POST _body, ["abort_email_change"], Some token -> + Abort_email_change token |> k | `GET, ["confirm"; handle], _ -> Confirm_email handle |> k | `POST body, ["send_reset"], _ -> diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index a8a085cc0..2a9723365 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -103,6 +103,8 @@ type _ request = Token.t -> bool request | Change_email: (Token.t * string) -> unit request + | Abort_email_change: + Token.t -> unit request | Confirm_email: string -> string request | Change_password: diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 146de3fe3..ccb337e41 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -472,6 +472,17 @@ module BaseUserIndex (RW: IndexRW) = struct Password (found_token, email, passwd, Some new_email) | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise + + let abort_email_change sync_dir token = + RW.read (sync_dir / indexes_subdir / file) parse >|= + List.map (function + | Password (found_token, email, passwd, Some pending) + when found_token = token && email <> pending -> + Password (found_token, email, passwd, None) + | Token (found_token, _moodle) when found_token = token -> + failwith "BaseUserIndex.abort_email_change: invalid action" + | elt -> elt) >>= + RW.write rw (sync_dir / indexes_subdir / file) serialise end module UserIndex = BaseUserIndex (IndexFile) @@ -539,6 +550,12 @@ module BaseUpgradeIndex (RW: IndexRW) = struct (Token.to_string token); Lwt.return_some handle + let abort_email_change sync_dir token = + get_data sync_dir >>= fun operations -> + List.filter (fun (_handle, (found_token, _date, operation)) -> + operation = ResetPassword || token <> found_token) operations + |> RW.write rw (sync_dir / indexes_subdir / file) serialise + let revoke_operation sync_dir handle = get_data sync_dir >|= List.filter (fun (found_handle, _operation) -> found_handle <> handle) >>= diff --git a/src/state/token_index.mli b/src/state/token_index.mli index 3999fa4ee..c2676a597 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -93,6 +93,7 @@ module UserIndex: sig *) val emails_of_token : string -> Learnocaml_data.Token.t -> ((string * string option) option) Lwt.t val change_email : string -> Learnocaml_data.Token.t -> string -> unit Lwt.t + val abort_email_change : string -> Learnocaml_data.Token.t -> unit Lwt.t end module UpgradeIndex: sig @@ -109,4 +110,5 @@ module UpgradeIndex: sig val revoke_operation : string -> string -> unit Lwt.t val filter_old_operations : string -> unit Lwt.t + val abort_email_change : string -> Learnocaml_data.Token.t -> unit Lwt.t end diff --git a/translations/fr.po b/translations/fr.po index 40d605fcb..58a7bea16 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-13 02:10+0200\n" +"PO-Revision-Date: 2020-09-13 15:37+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -18,139 +18,141 @@ msgid "INTERNAL ERROR" msgstr "ERREUR INTERNE" #: src/app/learnocaml_common.ml:108,50--54 -#: src/app/learnocaml_common.ml:142,33--37 -#: src/app/learnocaml_common.ml:148,36--40 +#: src/app/learnocaml_common.ml:143,43--47 +#: src/app/learnocaml_common.ml:146,33--37 +#: src/app/learnocaml_common.ml:152,36--40 msgid "OK" msgstr "OK" #: src/app/learnocaml_common.ml:139,21--28 +#: src/app/learnocaml_common.ml:142,24--31 #: src/app/learnocaml_lti_main.ml:91,26--33 #: src/app/learnocaml_lti_main.ml:97,26--33 #: src/app/learnocaml_lti_main.ml:101,26--33 #: src/app/learnocaml_index_main.ml:610,21--28 #: src/app/learnocaml_index_main.ml:629,21--28 #: src/app/learnocaml_index_main.ml:651,22--29 -#: src/app/learnocaml_index_main.ml:711,30--37 -#: src/app/learnocaml_index_main.ml:717,30--37 -#: src/app/learnocaml_index_main.ml:721,30--37 -#: src/app/learnocaml_index_main.ml:749,25--32 -#: src/app/learnocaml_index_main.ml:813,26--33 +#: src/app/learnocaml_index_main.ml:711,33--40 +#: src/app/learnocaml_index_main.ml:716,33--40 +#: src/app/learnocaml_index_main.ml:721,33--40 +#: src/app/learnocaml_index_main.ml:753,25--32 +#: src/app/learnocaml_index_main.ml:817,29--36 msgid "ERROR" msgstr "ERREUR" -#: src/app/learnocaml_common.ml:142,58--66 -#: src/app/learnocaml_common.ml:148,66--74 -#: src/app/learnocaml_common.ml:423,12--20 +#: src/app/learnocaml_common.ml:146,58--66 +#: src/app/learnocaml_common.ml:152,66--74 +#: src/app/learnocaml_common.ml:427,12--20 #: src/app/learnocaml_index_main.ml:619,12--20 #: src/app/learnocaml_index_main.ml:638,12--20 -#: src/app/learnocaml_index_main.ml:767,19--27 -#: src/app/learnocaml_index_main.ml:803,20--28 +#: src/app/learnocaml_index_main.ml:771,19--27 +#: src/app/learnocaml_index_main.ml:807,20--28 msgid "Cancel" msgstr "Annuler" -#: src/app/learnocaml_common.ml:415,26--41 +#: src/app/learnocaml_common.ml:419,26--41 #: src/app/learnocaml_index_main.ml:614,25--40 #: src/app/learnocaml_index_main.ml:633,25--40 -#: src/app/learnocaml_index_main.ml:762,32--47 -#: src/app/learnocaml_index_main.ml:798,33--48 +#: src/app/learnocaml_index_main.ml:766,32--47 +#: src/app/learnocaml_index_main.ml:802,33--48 msgid "REQUEST ERROR" msgstr "ERREUR DE REQUÊTE" -#: src/app/learnocaml_common.ml:416,22--59 +#: src/app/learnocaml_common.ml:420,22--59 #: src/app/learnocaml_index_main.ml:615,26--63 #: src/app/learnocaml_index_main.ml:634,26--63 -#: src/app/learnocaml_index_main.ml:763,30--67 -#: src/app/learnocaml_index_main.ml:799,34--71 +#: src/app/learnocaml_index_main.ml:767,30--67 +#: src/app/learnocaml_index_main.ml:803,34--71 msgid "Could not retrieve data from server" msgstr "Échec lors du téléchargement des données du serveur" -#: src/app/learnocaml_common.ml:419,12--19 -#: src/app/learnocaml_common.ml:459,11--18 +#: src/app/learnocaml_common.ml:423,12--19 +#: src/app/learnocaml_common.ml:463,11--18 #: src/app/learnocaml_index_main.ml:618,12--19 #: src/app/learnocaml_index_main.ml:637,12--19 -#: src/app/learnocaml_index_main.ml:766,19--26 -#: src/app/learnocaml_index_main.ml:802,20--27 +#: src/app/learnocaml_index_main.ml:770,19--26 +#: src/app/learnocaml_index_main.ml:806,20--27 msgid "Retry" msgstr "Réessayer" -#: src/app/learnocaml_common.ml:422,25--33 -#: src/app/learnocaml_common.ml:460,11--19 +#: src/app/learnocaml_common.ml:426,25--33 +#: src/app/learnocaml_common.ml:464,11--19 msgid "Ignore" msgstr "Ignorer" -#: src/app/learnocaml_common.ml:455,26--39 +#: src/app/learnocaml_common.ml:459,26--39 msgid "SYNC FAILED" msgstr "ECHEC DE LA SYNCHRONISATION" -#: src/app/learnocaml_common.ml:456,22--66 +#: src/app/learnocaml_common.ml:460,22--66 msgid "Could not synchronise save with the server" msgstr "Les données n'ont pas pu être synchronisées avec le serveur" -#: src/app/learnocaml_common.ml:515,39--50 +#: src/app/learnocaml_common.ml:519,39--50 msgid "%dd %02dh" msgstr "%dj %02dh" -#: src/app/learnocaml_common.ml:516,40--51 +#: src/app/learnocaml_common.ml:520,40--51 msgid "%02d:%02d" msgstr "%02d:%02d" -#: src/app/learnocaml_common.ml:517,23--36 +#: src/app/learnocaml_common.ml:521,23--36 msgid "0:%02d:%02d" msgstr "0:%02d:%02d" -#: src/app/learnocaml_common.ml:548,34--55 -#: src/app/learnocaml_common.ml:1035,38--59 +#: src/app/learnocaml_common.ml:552,34--55 +#: src/app/learnocaml_common.ml:1039,38--59 msgid "difficulty: %d / 40" msgstr "difficulté: %d / 40" -#: src/app/learnocaml_common.ml:583,30--75 +#: src/app/learnocaml_common.ml:587,30--75 msgid "No description available for this exercise." msgstr "Aucune description pour cet exercice." -#: src/app/learnocaml_common.ml:606,32--41 +#: src/app/learnocaml_common.ml:610,32--41 #: src/app/learnocaml_index_main.ml:147,54--63 msgid "project" msgstr "projet" -#: src/app/learnocaml_common.ml:607,32--41 +#: src/app/learnocaml_common.ml:611,32--41 #: src/app/learnocaml_index_main.ml:148,54--63 msgid "problem" msgstr "problème" -#: src/app/learnocaml_common.ml:608,33--43 +#: src/app/learnocaml_common.ml:612,33--43 #: src/app/learnocaml_index_main.ml:149,55--65 msgid "exercise" msgstr "exercice" -#: src/app/learnocaml_common.ml:760,26--33 +#: src/app/learnocaml_common.ml:764,26--33 msgid "Clear" msgstr "Effacer" -#: src/app/learnocaml_common.ml:765,25--32 -#: src/app/learnocaml_common.ml:886,24--31 +#: src/app/learnocaml_common.ml:769,25--32 +#: src/app/learnocaml_common.ml:890,24--31 msgid "Reset" msgstr "Réinitialiser" -#: src/app/learnocaml_common.ml:770,22--35 +#: src/app/learnocaml_common.ml:774,22--35 msgid "Eval phrase" msgstr "Évaluer la phrase" -#: src/app/learnocaml_common.ml:785,24--51 +#: src/app/learnocaml_common.ml:789,24--51 msgid "Preparing the environment" msgstr "Préparation de l'environnement" -#: src/app/learnocaml_common.ml:786,39--47 -#: src/app/learnocaml_common.ml:791,37--45 +#: src/app/learnocaml_common.ml:790,39--47 +#: src/app/learnocaml_common.ml:795,37--45 msgid "Editor" msgstr "Éditeur" -#: src/app/learnocaml_common.ml:787,41--51 -#: src/app/learnocaml_index_main.ml:1017,30--40 +#: src/app/learnocaml_common.ml:791,41--51 +#: src/app/learnocaml_index_main.ml:1037,30--40 msgid "Toplevel" msgstr "Toplevel" -#: src/app/learnocaml_common.ml:788,39--47 -#: src/app/learnocaml_common.ml:800,39--47 +#: src/app/learnocaml_common.ml:792,39--47 +#: src/app/learnocaml_common.ml:804,39--47 #: src/app/learnocaml_exercise_main.ml:56,30--38 #: src/app/learnocaml_exercise_main.ml:60,30--38 #: src/app/learnocaml_exercise_main.ml:65,30--38 @@ -161,115 +163,115 @@ msgstr "Toplevel" msgid "Report" msgstr "Rapport" -#: src/app/learnocaml_common.ml:789,37--47 +#: src/app/learnocaml_common.ml:793,37--47 msgid "Exercise" msgstr "Exercice" -#: src/app/learnocaml_common.ml:790,37--46 +#: src/app/learnocaml_common.ml:794,37--46 msgid "Details" msgstr "Détails" -#: src/app/learnocaml_common.ml:792,27--70 +#: src/app/learnocaml_common.ml:796,27--70 msgid "Click the Grade button to get your report" msgstr "Cliquez sur le bouton Noter pour obtenir votre rapport" -#: src/app/learnocaml_common.ml:797,22--44 +#: src/app/learnocaml_common.ml:801,22--44 msgid "Loading student data" msgstr "Chargement des informations sur les étudiants" -#: src/app/learnocaml_common.ml:798,38--45 +#: src/app/learnocaml_common.ml:802,38--45 msgid "Stats" msgstr "Statistiques" -#: src/app/learnocaml_common.ml:799,37--48 +#: src/app/learnocaml_common.ml:803,37--48 #: src/app/learnocaml_exercise_main.ml:200,23--34 -#: src/app/learnocaml_index_main.ml:1014,29--40 +#: src/app/learnocaml_index_main.ml:1034,29--40 #: src/app/learnocaml_teacher_tab.ml:328,18--29 msgid "Exercises" msgstr "Exercices" -#: src/app/learnocaml_common.ml:801,37--46 +#: src/app/learnocaml_common.ml:805,37--46 msgid "Subject" msgstr "Énoncé" -#: src/app/learnocaml_common.ml:802,39--47 +#: src/app/learnocaml_common.ml:806,39--47 msgid "Answer" msgstr "Réponse" -#: src/app/learnocaml_common.ml:887,22--42 +#: src/app/learnocaml_common.ml:891,22--42 msgid "START FROM SCRATCH" msgstr "TOUT RECOMMENCER" -#: src/app/learnocaml_common.ml:888,16--65 +#: src/app/learnocaml_common.ml:892,16--65 msgid "This will discard all your edits. Are you sure?" msgstr "Toutes vos modifications seront perdues. Vous êtes sûr·e ?" -#: src/app/learnocaml_common.ml:895,27--37 +#: src/app/learnocaml_common.ml:899,27--37 msgid "Download" msgstr "Télécharger" -#: src/app/learnocaml_common.ml:903,22--33 +#: src/app/learnocaml_common.ml:907,22--33 msgid "Eval code" msgstr "Évaluer le code" -#: src/app/learnocaml_common.ml:910,23--29 +#: src/app/learnocaml_common.ml:914,23--29 msgid "Sync" msgstr "Sync" -#: src/app/learnocaml_common.ml:963,34--49 +#: src/app/learnocaml_common.ml:967,34--49 msgid "OCaml prelude" msgstr "Prélude OCaml" -#: src/app/learnocaml_common.ml:970,59--65 +#: src/app/learnocaml_common.ml:974,59--65 msgid "Hide" msgstr "Cacher" -#: src/app/learnocaml_common.ml:977,59--65 +#: src/app/learnocaml_common.ml:981,59--65 msgid "Show" msgstr "Montrer" -#: src/app/learnocaml_common.ml:1001,18--36 -#: src/app/learnocaml_index_main.ml:899,27--45 +#: src/app/learnocaml_common.ml:1005,18--36 +#: src/app/learnocaml_index_main.ml:904,27--45 msgid "Enter the secret" msgstr "Entrez le secret" -#: src/app/learnocaml_common.ml:1041,22--35 +#: src/app/learnocaml_common.ml:1045,22--35 msgid "Difficulty:" msgstr "Difficulté :" -#: src/app/learnocaml_common.ml:1055,39--49 +#: src/app/learnocaml_common.ml:1059,39--49 msgid "Kind: %s" msgstr "Type : %s" -#: src/app/learnocaml_common.ml:1196,46--59 +#: src/app/learnocaml_common.ml:1200,46--59 msgid "Identifier:" msgstr "Identifiant de l'exercice :" -#: src/app/learnocaml_common.ml:1200,48--57 +#: src/app/learnocaml_common.ml:1204,48--57 msgid "Author:" msgstr "Auteur :" -#: src/app/learnocaml_common.ml:1201,47--57 +#: src/app/learnocaml_common.ml:1205,47--57 msgid "Authors:" msgstr "Auteurs :" -#: src/app/learnocaml_common.ml:1206,31--48 +#: src/app/learnocaml_common.ml:1210,31--48 msgid "Skills trained:" msgstr "Compétences pratiquées :" -#: src/app/learnocaml_common.ml:1210,31--49 +#: src/app/learnocaml_common.ml:1214,31--49 msgid "Skills required:" msgstr "Compétences requises :" -#: src/app/learnocaml_common.ml:1215,36--57 +#: src/app/learnocaml_common.ml:1219,36--57 msgid "Previous exercises:" msgstr "Exercices précédents :" -#: src/app/learnocaml_common.ml:1218,35--52 +#: src/app/learnocaml_common.ml:1222,35--52 msgid "Next exercises:" msgstr "Exercices suivants :" -#: src/app/learnocaml_common.ml:1223,26--36 +#: src/app/learnocaml_common.ml:1227,26--36 msgid "Metadata" msgstr "Métadonnées" @@ -462,12 +464,12 @@ msgstr "Erreur inattendue :\n" #: src/app/learnocaml_lti_main.ml:92,15--48 #: src/app/learnocaml_index_main.ml:611,10--43 #: src/app/learnocaml_index_main.ml:712,19--52 -#: src/app/learnocaml_index_main.ml:813,38--71 +#: src/app/learnocaml_index_main.ml:817,41--74 msgid "The entered e-mail was invalid." msgstr "L'e-mail entré est invalide." #: src/app/learnocaml_lti_main.ml:98,15--60 -#: src/app/learnocaml_index_main.ml:718,19--64 +#: src/app/learnocaml_index_main.ml:717,19--64 #: src/app/learnocaml_reset_main.ml:20,32--77 #: src/app/learnocaml_upgrade_main.ml:21,34--79 msgid "Password must be at least 8 characters long" @@ -485,51 +487,51 @@ msgstr "" "majuscule, et un caractère non-alphanumérique." #: src/app/learnocaml_lti_main.ml:117,21--42 -#: src/app/learnocaml_index_main.ml:738,25--46 +#: src/app/learnocaml_index_main.ml:739,28--49 msgid "VALIDATION REQUIRED" msgstr "VALIDATION REQUISE" #: src/app/learnocaml_lti_main.ml:117,47--101 -#: src/app/learnocaml_index_main.ml:738,51--105 +#: src/app/learnocaml_index_main.ml:740,14--68 msgid "A confirmation e-mail has been sent to your address." msgstr "Un courriel a été envoyé à votre adresse pour la confirmer." #: src/app/learnocaml_lti_main.ml:130,33--51 -#: src/app/learnocaml_index_main.ml:897,37--55 -#: src/app/learnocaml_index_main.ml:901,31--49 +#: src/app/learnocaml_index_main.ml:902,37--55 +#: src/app/learnocaml_index_main.ml:906,31--49 msgid "First connection" msgstr "Première connexion" #: src/app/learnocaml_lti_main.ml:131,39--55 #: src/app/learnocaml_lti_main.ml:143,32--48 -#: src/app/learnocaml_index_main.ml:902,37--53 -#: src/app/learnocaml_index_main.ml:911,30--46 +#: src/app/learnocaml_index_main.ml:907,37--53 +#: src/app/learnocaml_index_main.ml:916,30--46 #: src/app/learnocaml_upgrade_main.ml:26,32--48 msgid "E-mail address" msgstr "Adresse e-mail" #: src/app/learnocaml_lti_main.ml:132,42--52 -#: src/app/learnocaml_index_main.ml:903,40--50 -#: src/app/learnocaml_index_main.ml:934,9--19 +#: src/app/learnocaml_index_main.ml:908,40--50 +#: src/app/learnocaml_index_main.ml:939,9--19 #: src/app/learnocaml_teacher_tab.ml:557,22--32 msgid "Nickname" msgstr "Pseudonyme" #: src/app/learnocaml_lti_main.ml:133,42--52 #: src/app/learnocaml_lti_main.ml:144,35--45 -#: src/app/learnocaml_index_main.ml:904,40--50 -#: src/app/learnocaml_index_main.ml:912,33--43 +#: src/app/learnocaml_index_main.ml:909,40--50 +#: src/app/learnocaml_index_main.ml:917,33--43 #: src/app/learnocaml_upgrade_main.ml:27,35--45 msgid "Password" msgstr "Mot de passe" #: src/app/learnocaml_lti_main.ml:134,40--48 -#: src/app/learnocaml_index_main.ml:905,38--46 +#: src/app/learnocaml_index_main.ml:910,38--46 msgid "Secret" msgstr "Secret" #: src/app/learnocaml_lti_main.ml:135,29--198 -#: src/app/learnocaml_index_main.ml:906,27--192 +#: src/app/learnocaml_index_main.ml:911,27--192 msgid "" "The secret is an optional passphrase provided by your teacher. It may be " "required to create an account." @@ -538,7 +540,7 @@ msgstr "" "Celle-ci est alors requise pour s'inscrire." #: src/app/learnocaml_lti_main.ml:138,41--251 -#: src/app/learnocaml_index_main.ml:915,39--244 +#: src/app/learnocaml_index_main.ml:920,39--244 msgid "" "By submitting this form, I accept that the information entered will be used " "in the context of the Learn-OCaml plateform." @@ -547,29 +549,29 @@ msgstr "" "être utilisées dans le contexte de la plateforme Learn-OCaml." #: src/app/learnocaml_lti_main.ml:141,26--46 -#: src/app/learnocaml_index_main.ml:909,24--44 +#: src/app/learnocaml_index_main.ml:914,24--44 msgid "Create new account" msgstr "Créer un compte" #: src/app/learnocaml_lti_main.ml:142,26--42 -#: src/app/learnocaml_index_main.ml:910,24--40 +#: src/app/learnocaml_index_main.ml:915,24--40 msgid "Returning user" msgstr "Utilisateur existant" #: src/app/learnocaml_lti_main.ml:145,32--41 #: src/app/learnocaml_lti_main.ml:153,32--41 -#: src/app/learnocaml_index_main.ml:913,31--40 -#: src/app/learnocaml_index_main.ml:920,30--39 +#: src/app/learnocaml_index_main.ml:918,31--40 +#: src/app/learnocaml_index_main.ml:925,30--39 msgid "Connect" msgstr "Se connecter" #: src/app/learnocaml_lti_main.ml:146,32--55 -#: src/app/learnocaml_index_main.ml:914,30--53 +#: src/app/learnocaml_index_main.ml:919,30--53 msgid "Forgot your password?" msgstr "Mot de passe oublié ?" #: src/app/learnocaml_lti_main.ml:147,38--57 -#: src/app/learnocaml_index_main.ml:898,44--63 +#: src/app/learnocaml_index_main.ml:903,44--63 msgid "Choose a nickname" msgstr "Choisissez un identifiant" @@ -591,7 +593,7 @@ msgid "Reuse an account with a legacy token" msgstr "Réutiliser un compte avec un ancien token" #: src/app/learnocaml_lti_main.ml:155,32--39 -#: src/app/learnocaml_index_main.ml:919,30--37 +#: src/app/learnocaml_index_main.ml:924,30--37 #: src/app/learnocaml_teacher_tab.ml:559,22--29 msgid "Token" msgstr "Token" @@ -697,10 +699,6 @@ msgstr "Changement en cours :" msgid "Your Learn-OCaml login" msgstr "Votre login Learn-OCaml" -#: src/app/learnocaml_index_main.ml:604,21--36 -msgid "RESET REQUEST" -msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" - #: src/app/learnocaml_index_main.ml:605,11--50 msgid "A reset link was sent to the address:" msgstr "Un lien de réinitialisation a été envoyé à l'adresse :" @@ -713,6 +711,7 @@ msgstr "" "\n" "(si elle est associée à un compte)" +#: src/app/learnocaml_index_main.ml:604,21--36 #: src/app/learnocaml_index_main.ml:624,21--41 msgid "RESET REQUEST SENT" msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" @@ -729,21 +728,21 @@ msgstr "L'e-mail entré n'a pas été reconnu." msgid "The entered e-mail is invalid: " msgstr "L'e-mail entré est invalide." -#: src/app/learnocaml_index_main.ml:758,28--45 -#: src/app/learnocaml_index_main.ml:794,29--46 +#: src/app/learnocaml_index_main.ml:762,28--45 +#: src/app/learnocaml_index_main.ml:798,29--46 msgid "TOKEN NOT FOUND" msgstr "TOKEN NON TROUVÉ" -#: src/app/learnocaml_index_main.ml:759,17--60 -#: src/app/learnocaml_index_main.ml:795,18--61 +#: src/app/learnocaml_index_main.ml:763,17--60 +#: src/app/learnocaml_index_main.ml:799,18--61 msgid "The entered token couldn't be recognized." msgstr "Le token entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:781,26--41 +#: src/app/learnocaml_index_main.ml:785,26--41 msgid "INVALID TOKEN" msgstr "TOKEN INVALIDE" -#: src/app/learnocaml_index_main.ml:782,31--200 +#: src/app/learnocaml_index_main.ml:786,31--200 msgid "" "This token is associated to an upgraded account, which only allows password-" "based%s authentication." @@ -751,86 +750,94 @@ msgstr "" "Ce token est associé à un compte, autorisant uniquement l'authentification " "par mot de passe%s." -#: src/app/learnocaml_index_main.ml:785,54--70 +#: src/app/learnocaml_index_main.ml:789,54--70 msgid " or Moodle/LTI" msgstr " ou avec Moodle/LTI" -#: src/app/learnocaml_index_main.ml:892,7--21 +#: src/app/learnocaml_index_main.ml:897,7--21 msgid "Connected as" msgstr "Connecté en tant que" -#: src/app/learnocaml_index_main.ml:894,7--19 +#: src/app/learnocaml_index_main.ml:899,7--19 msgid "Activities" msgstr "Activités" -#: src/app/learnocaml_index_main.ml:896,9--33 +#: src/app/learnocaml_index_main.ml:901,9--33 msgid "Welcome to Learn OCaml" msgstr "Bienvenue sur Learn OCaml" -#: src/app/learnocaml_index_main.ml:900,24--42 +#: src/app/learnocaml_index_main.ml:905,24--42 msgid "Create new token" msgstr "Nouveau token" -#: src/app/learnocaml_index_main.ml:918,35--62 +#: src/app/learnocaml_index_main.ml:923,35--62 msgid "Login with a legacy token" msgstr "Connexion avec un ancien token" -#: src/app/learnocaml_index_main.ml:921,22--40 +#: src/app/learnocaml_index_main.ml:926,22--40 #: src/app/learnocaml_upgrade_main.ml:25,26--44 msgid "Setup a password" msgstr "Définir un mot de passe" -#: src/app/learnocaml_index_main.ml:923,33--183 +#: src/app/learnocaml_index_main.ml:928,33--183 msgid "" "Or you may want to login directly from Moodle (ask your teacher for details)" -msgstr "Ou vous pouvez vous connecter directement depuis Moodle (demandez à votre enseignant pour plus de détails)" +msgstr "" +"Ou vous pouvez vous connecter directement depuis Moodle (demandez à votre " +"enseignant pour plus de détails)" -#: src/app/learnocaml_index_main.ml:968,38--59 +#: src/app/learnocaml_index_main.ml:973,38--59 msgid "Choose an activity." msgstr "Sélectionnez une activité." -#: src/app/learnocaml_index_main.ml:987,31--51 +#: src/app/learnocaml_index_main.ml:996,31--51 msgid "New e-mail address" msgstr "Nouvelle adresse e-mail" -#: src/app/learnocaml_index_main.ml:988,22--54 +#: src/app/learnocaml_index_main.ml:997,22--54 msgid "Enter your new e-mail address:" msgstr "Entrez votre nouvelle adresse e-mail :" -#: src/app/learnocaml_index_main.ml:998,22--39 +#: src/app/learnocaml_index_main.ml:1011,14--31 +#: src/app/learnocaml_index_main.ml:1014,15--32 +#: src/app/learnocaml_index_main.ml:1016,14--31 msgid "Change password" msgstr "Changer de mot de passe" -#: src/app/learnocaml_index_main.ml:999,22--37 +#: src/app/learnocaml_index_main.ml:1012,14--35 +msgid "Abort e-mail change" +msgstr "Annuler le changement d'e-mail" + +#: src/app/learnocaml_index_main.ml:1017,14--29 msgid "Change e-mail" msgstr "Changer d'adresse e-mail" -#: src/app/learnocaml_index_main.ml:1010,30--41 +#: src/app/learnocaml_index_main.ml:1030,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:1012,29--38 +#: src/app/learnocaml_index_main.ml:1032,29--38 msgid "Lessons" msgstr "Cours" -#: src/app/learnocaml_index_main.ml:1019,32--44 +#: src/app/learnocaml_index_main.ml:1039,32--44 #: src/app/learnocaml_playground_main.ml:72,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:1022,28--35 +#: src/app/learnocaml_index_main.ml:1042,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:1122,17--71 +#: src/app/learnocaml_index_main.ml:1142,17--71 msgid "Be sure to write down your token before logging out:" msgstr "Assurez-vous d'avoir noté votre token :" -#: src/app/learnocaml_index_main.ml:1124,17--51 +#: src/app/learnocaml_index_main.ml:1144,17--51 msgid "Are you sure you want to logout?" msgstr "Êtes-vous sûr de vouloir vous déconnecter ?" -#: src/app/learnocaml_index_main.ml:1126,15--186 +#: src/app/learnocaml_index_main.ml:1146,15--186 msgid "" "WARNING: the data could not be synchronised with the server. Logging out " "will lose your local changes, be sure you exported a backup." @@ -839,37 +846,37 @@ msgstr "" "En vous déconnectant, vous perdrez tous les changements locaux, à moins " "d'avoir exporté votre espace de travail au préalable." -#: src/app/learnocaml_index_main.ml:1137,22--30 -#: src/app/learnocaml_index_main.ml:1137,45--53 -#: src/app/learnocaml_index_main.ml:1159,9--17 +#: src/app/learnocaml_index_main.ml:1157,22--30 +#: src/app/learnocaml_index_main.ml:1157,45--53 +#: src/app/learnocaml_index_main.ml:1179,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:1150,15--27 +#: src/app/learnocaml_index_main.ml:1170,15--27 msgid "Show login" msgstr "Afficher votre login" -#: src/app/learnocaml_index_main.ml:1151,15--27 +#: src/app/learnocaml_index_main.ml:1171,15--27 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:1153,9--25 +#: src/app/learnocaml_index_main.ml:1173,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:1156,9--25 +#: src/app/learnocaml_index_main.ml:1176,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:1157,9--17 +#: src/app/learnocaml_index_main.ml:1177,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:1158,9--36 +#: src/app/learnocaml_index_main.ml:1178,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:1164,38--44 +#: src/app/learnocaml_index_main.ml:1184,38--44 msgid "Menu" msgstr "Menu" @@ -1091,15 +1098,15 @@ msgstr "PAS DE TOKEN" msgid "You are not logged in" msgstr "Vous n'êtes pas connecté" -#: src/app/learnocaml_validate_main.ml:13,18--35 -msgid "EMAIL CONFIRMED" -msgstr "ADRESSE EMAIL CONFIRMÉE" - -#: src/app/learnocaml_validate_main.ml:13,40--100 +#: src/app/learnocaml_validate_main.ml:30,7--67 msgid "Your e-mail address has been confirmed. You can now login." msgstr "" "Votre adresse e-mail a été confirmée. Vous pouvez maintenant vous connecter." +#: src/app/learnocaml_validate_main.ml:31,21--38 +msgid "EMAIL CONFIRMED" +msgstr "ADRESSE EMAIL CONFIRMÉE" + #: src/grader/learnocaml_report.ml:240,50--66 #: src/grader/learnocaml_report.ml:595,59--75 msgid "(minimum mark)" From 41309e83d914c0eebde0c7b2be65d66b0762c160 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 15:54:42 +0200 Subject: [PATCH 130/161] fix: learnocaml_index_main.ml * Don't display upgrade-button if use_passwd=false * Do GET "/get_emails" only once --- src/app/learnocaml_index_main.ml | 21 +++++++++------------ 1 file changed, 9 insertions(+), 12 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index f0572ecbb..7dceca169 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -1005,9 +1005,15 @@ let () = >>= complete_change_email change_email address | None -> Lwt.return_none) (fun _exn -> Lwt.return_none) in - get_emails () >>= fun res -> + can_show_token () >>= fun show_token -> + if show_token then + if get_opt config##.enablePasswd + then Lwt.return @@ show_upgrade_button () + else Lwt.return_unit + else + get_emails () >>= fun emails -> let buttons = - match res with + match emails with | Some (cur_email, Some new_email) when cur_email <> new_email -> [[%i"Change password"], change_password; [%i"Abort e-mail change"], abort_email_change] @@ -1221,16 +1227,7 @@ let () = (function | Ok _ -> init_sync_token sync_button_group >|= init_tabs >>= fun tabs -> - can_show_token () >>= fun show_token -> - (if not show_token then - Server_caller.request (Learnocaml_api.Get_emails (get_stored_token ())) >>= - (function - | Ok (Some _) -> init_op () - | _ -> Lwt.return @@ show_upgrade_button ()) - else if get_opt config##.enablePasswd then - Lwt.return @@ show_upgrade_button () - else - Lwt.return_unit) >>= fun () -> + init_op () >>= fun () -> Lwt.return tabs | Error _ -> Lwt.return (init_tabs None)) >>= fun tabs -> try From 44bfe9e47650464cd4608506e0283c3658e05a5e Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 16:15:14 +0200 Subject: [PATCH 131/161] fix: Learnocaml_local_storage.(can_show_token) * GET "/sync/canlogin": now returns true if use_passwd=false * show_token_dialog: now forces a refresh of the localStorage value --- src/app/learnocaml_index_main.ml | 43 ++++++++++++++++++-------------- src/server/learnocaml_server.ml | 8 +++--- 2 files changed, 29 insertions(+), 22 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 7dceca169..a196d57e5 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -532,16 +532,17 @@ let teacher_tab token a b () = let get_stored_token () = Learnocaml_local_storage.(retrieve sync_token) -let can_show_token () = +let can_show_token ?(force=false) () = (* Is this localStorage caching really useful? *) - try - Lwt.return Learnocaml_local_storage.(retrieve can_show_token) - with Not_found -> - Server_caller.request (Learnocaml_api.Can_login (get_stored_token ())) >|= function - | Error _ -> false - | Ok res -> - Learnocaml_local_storage.(store can_show_token) res; - res + let do_request () = + Server_caller.request (Learnocaml_api.Can_login (get_stored_token ())) >|= function + | Error _ -> false + | Ok res -> + Learnocaml_local_storage.(store can_show_token) res; + res in + if force then do_request () + else try Lwt.return Learnocaml_local_storage.(retrieve can_show_token) + with Not_found -> do_request () let has_moodle () = (* could be put in localStorage, but a server change wouldn't be propagated *) @@ -568,7 +569,7 @@ let token_disp_div token = ] () let show_token_dialog token = - can_show_token () >>= fun show_token -> + can_show_token ~force:true () >>= fun show_token -> if show_token then Lwt.return @@ ext_alert ~title:[%i"Your Learn-OCaml token"] [ @@ -584,15 +585,19 @@ let show_token_dialog token = else return [[%i"You might also want to associate your account with Moodle/LTI. Ask your teacher if need be."]] else return [] end >>= fun end_lines -> - begin get_emails () >|= function - | None -> [[%i"No e-mail registered."]] - | Some (email, None) -> - [[%i"Your e-mail:"] ^ " " ^ email] - | Some (email, Some email2) when email = email2 -> - [[%i"Your e-mail:"] ^ " " ^ email ^ " " ^ [%i"(to be confirmed)"]] - | Some (email, Some email2) -> - [[%i"Your e-mail:"] ^ " " ^ email; - [%i"Pending change:"] ^ " " ^ email2 ^ " " ^ [%i"(to be confirmed)"]] + begin if get_opt config##.enablePasswd + then get_emails () >|= function + | None -> [[%i"No e-mail registered."]] + | Some (email, None) -> + [[%i"Your e-mail:"] ^ " " ^ email] + | Some (email, Some email2) when email = email2 -> + [[%i"Your e-mail:"] ^ " " ^ email ^ " " ^ [%i"(to be confirmed)"]] + | Some (email, Some email2) -> + [[%i"Your e-mail:"] ^ " " ^ email; + [%i"Pending change:"] ^ " " ^ email2 ^ " " ^ [%i"(to be confirmed)"]] + else + (* shouldn't occur, because use_passwd=false -> can_show_token=true *) + return [] end >>= fun begin_lines -> let lines = begin_lines @ end_lines in Lwt.return @@ diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index d1986e68d..c9842d6d9 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -519,9 +519,11 @@ module Request_handler = struct | Api.Login _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Can_login token -> - Token_index.UserIndex.can_login !sync_dir token >>= - respond_json cache - + if config.ServerData.use_passwd then + Token_index.UserIndex.can_login !sync_dir token >>= + respond_json cache + else + respond_json cache true | Api.Fetch_save token -> lwt_catch_fail (fun () -> From 00bf2b6542e196d82c5fbe11fdf61f06563b1d6f Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 16:38:38 +0200 Subject: [PATCH 132/161] fix(index-main): upgrade-button * Show this button if logged-in by Moodle/LTI, but not with class="active" --- src/app/learnocaml_index_main.ml | 53 +++++++++++++++++--------------- static/index.html | 2 +- 2 files changed, 29 insertions(+), 26 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index a196d57e5..1a4f39686 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -981,10 +981,13 @@ let () = Manip.appendChild El.content div ; delete_arg "activity" in - let show_upgrade_button () = + let show_upgrade_button ?(critical=true) () = let token = Learnocaml_local_storage.(retrieve sync_token) and input = Js.Unsafe.coerce @@ H.toelt (find_component "upgrade-token") in input##.value := Js.string @@ Token.to_string token; + if critical + then Manip.addClass (find_component "upgrade-button") "active" + else Manip.removeClass (find_component "upgrade-button") "active"; Manip.SetCss.display (find_component "learnocaml-upgrade-container") "block" in let init_op () = @@ -1010,31 +1013,31 @@ let () = >>= complete_change_email change_email address | None -> Lwt.return_none) (fun _exn -> Lwt.return_none) in - can_show_token () >>= fun show_token -> - if show_token then - if get_opt config##.enablePasswd + if get_opt config##.enablePasswd then + can_show_token () >>= fun show_token -> + if show_token then Lwt.return @@ show_upgrade_button () - else Lwt.return_unit - else - get_emails () >>= fun emails -> - let buttons = - match emails with - | Some (cur_email, Some new_email) when cur_email <> new_email -> - [[%i"Change password"], change_password; - [%i"Abort e-mail change"], abort_email_change] - | Some (_email, Some _) -> - [[%i"Change password"], change_password] - | Some (_email, None) -> - [[%i"Change password"], change_password; - [%i"Change e-mail"], change_email] - | None -> [] in - let container = El.op_buttons_container in - Manip.removeChildren container; - List.iter (fun (name, callback) -> - let btn = Tyxml_js.Html5.(button [txt name]) in - Manip.Ev.onclick btn (fun _ -> Lwt.async callback; true); - Manip.appendChild container btn) buttons; - Lwt.return_unit + else get_emails () >>= fun emails -> + let buttons = + match emails with + | Some (cur_email, Some new_email) when cur_email <> new_email -> + [[%i"Change password"], change_password; + [%i"Abort e-mail change"], abort_email_change] + | Some (_email, Some _) -> + [[%i"Change password"], change_password] + | Some (_email, None) -> + [[%i"Change password"], change_password; + [%i"Change e-mail"], change_email] + | None -> (* Upgrade is not critical as the user logged-in by LTI *) + show_upgrade_button ~critical:false (); [] in + let container = El.op_buttons_container in + Manip.removeChildren container; + List.iter (fun (name, callback) -> + let btn = Tyxml_js.Html5.(button [txt name]) in + Manip.Ev.onclick btn (fun _ -> Lwt.async callback; true); + Manip.appendChild container btn) buttons; + Lwt.return_unit + else Lwt.return_unit in let init_tabs token = let tabs = diff --git a/static/index.html b/static/index.html index 0403eea7f..395e8241a 100644 --- a/static/index.html +++ b/static/index.html @@ -49,7 +49,7 @@

    Activities

    - +
    From e06b380ea972fd93d02e2ff9e329ba8615212aec Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 18:48:19 +0200 Subject: [PATCH 133/161] fix(TokenIndex): Ensure add_token doesn't introduce duplicates --- src/state/token_index.ml | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index ccb337e41..f67ba4fb6 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -140,7 +140,10 @@ module BaseTokenIndex (RW: IndexRW) = struct let add_token sync_dir token = get_tokens sync_dir >>= fun tokens -> - RW.write rw (sync_dir / indexes_subdir / file) serialise (token :: tokens) + if not (List.exists (fun found_token -> found_token = token) tokens) then + RW.write rw (sync_dir / indexes_subdir / file) serialise (token :: tokens) + else + Lwt.return_unit end module TokenIndex = BaseTokenIndex (IndexFile) From 70235d1ea7b4b8c634a4e239270f32d30d64ef93 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 19:06:46 +0200 Subject: [PATCH 134/161] fix(Launch_direct): don't create duplicate user items * Also make UserIndex.add fail if attempts to create a duplicate token --- src/server/learnocaml_server.ml | 4 +--- src/state/token_index.ml | 18 ++++++++++++++---- 2 files changed, 15 insertions(+), 7 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index c9842d6d9..ae0bbd13b 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -438,11 +438,9 @@ module Request_handler = struct (if nickname = "" then Lwt.return_unit else Save.set token Save.{empty with nickname}) >>= fun () -> - let auth = Token_index.Token (token, true) in Token_index.( - TokenIndex.add_token !sync_dir token >>= fun () -> MoodleIndex.add_user !sync_dir user_id token >>= fun () -> - UserIndex.add !sync_dir auth) >>= fun () -> + UserIndex.upgrade_moodle !sync_dir token) >>= fun () -> let cookies = [make_cookie ("token", Token.to_string token); make_cookie ~http_only:true ("csrf", "expired")] in lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } diff --git a/src/state/token_index.ml b/src/state/token_index.ml index f67ba4fb6..69900a33a 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -389,14 +389,24 @@ module BaseUserIndex (RW: IndexRW) = struct found_email = email || verify_email = email | _ -> false) + (* private function; might be exposed in the .mli if need be *) + let exists_token token user_list = + List.exists (function + | Token (found_token, _moodle) -> found_token = token + | Password (found_token, _email, _passwd, _pending) -> found_token = token) + user_list + let add sync_dir auth = get_data sync_dir >>= fun users -> - let new_user = match auth with - | Token _ -> auth + let token, new_user = match auth with + | Token (token, _) -> (token, auth) | Password (token, email, passwd, verify_email) -> let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in - Password (token, email, hash, verify_email) in - RW.write rw (sync_dir / indexes_subdir / file) serialise (new_user :: users) + (token, Password (token, email, hash, verify_email)) in + if exists_token token users then + failwith "BaseUserIndex.add: duplicate token" + else + RW.write rw (sync_dir / indexes_subdir / file) serialise (new_user :: users) let update sync_dir token passwd = get_data sync_dir >|= From edbb5103234dc352833cb4c71187ecb2f83bffc3 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 19:19:44 +0200 Subject: [PATCH 135/161] refactor(token_index.ml): Replace failwith with printf-then-failwith --- src/state/token_index.ml | 20 +++++++++++++------- 1 file changed, 13 insertions(+), 7 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 69900a33a..e4503d9eb 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -12,6 +12,10 @@ open Learnocaml_data let ( / ) dir f = if dir = "" then f else Filename.concat dir f let indexes_subdir = "data" +let logfailwith str arg = + Printf.printf "[WARNING] %s (%s)\n%!" str arg; + failwith str + let generate_random_hex len = Cryptokit.Random.string Cryptokit.Random.secure_rng len |> Cryptokit.transform_string @@ Cryptokit.Hexa.encode () @@ -404,7 +408,7 @@ module BaseUserIndex (RW: IndexRW) = struct let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in (token, Password (token, email, hash, verify_email)) in if exists_token token users then - failwith "BaseUserIndex.add: duplicate token" + logfailwith "BaseUserIndex.add: duplicate token" (Token.to_string token) else RW.write rw (sync_dir / indexes_subdir / file) serialise (new_user :: users) @@ -412,7 +416,7 @@ module BaseUserIndex (RW: IndexRW) = struct get_data sync_dir >|= List.map (function | Token (found_token, _use_moodle) when found_token = token -> - failwith "BaseUserIndex.update: invalid action" + logfailwith "BaseUserIndex.update: invalid action" (Token.to_string token) | Password (found_token, email, _passwd, verify) when found_token = token -> let hash = Bcrypt.string_of_hash @@ Bcrypt.hash passwd in Password (token, email, hash, verify) @@ -426,13 +430,14 @@ module BaseUserIndex (RW: IndexRW) = struct Token (token, true) | Password (found_token, _email, _passwd, _verify) when found_token = token -> - failwith "BaseUserIndex.upgrade_moodle: invalid action" + logfailwith "BaseUserIndex.upgrade_moodle: invalid action" (Token.to_string token) | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise let upgrade sync_dir token email passwd = (exists sync_dir email >|= fun exists -> - if exists then failwith "BaseUserIndex.upgrade: duplicate email") + if exists then + logfailwith "BaseUserIndex.upgrade: duplicate email" email) >>= fun () -> get_data sync_dir >|= List.map (function @@ -441,7 +446,7 @@ module BaseUserIndex (RW: IndexRW) = struct Password (token, email, hash, Some(email)) | Password (found_token, _email, _passwd, _verify) when found_token = token -> - failwith "BaseUserIndex.upgrade: invalid action" + logfailwith "BaseUserIndex.upgrade: invalid action" (Token.to_string token) | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise @@ -477,7 +482,8 @@ module BaseUserIndex (RW: IndexRW) = struct let change_email sync_dir token new_email = (exists sync_dir new_email >|= fun exists -> - if exists then failwith "BaseUserIndex.change_email: duplicate email") + if exists then + logfailwith "BaseUserIndex.change_email: duplicate email" new_email) >>= fun () -> RW.read (sync_dir / indexes_subdir / file) parse >|= List.map (function @@ -493,7 +499,7 @@ module BaseUserIndex (RW: IndexRW) = struct when found_token = token && email <> pending -> Password (found_token, email, passwd, None) | Token (found_token, _moodle) when found_token = token -> - failwith "BaseUserIndex.abort_email_change: invalid action" + logfailwith "BaseUserIndex.abort_email_change: invalid action" (Token.to_string token) | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise end From e362d8582d0fb640d9690aa299c818a37d485194 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sun, 13 Sep 2020 20:16:19 +0200 Subject: [PATCH 136/161] fix: missing dependencies in learn-ocaml-client.opam --- learn-ocaml-client.opam | 3 +++ 1 file changed, 3 insertions(+) diff --git a/learn-ocaml-client.opam b/learn-ocaml-client.opam index f4e06fffc..e3c1a8a61 100644 --- a/learn-ocaml-client.opam +++ b/learn-ocaml-client.opam @@ -21,6 +21,7 @@ depends: [ "asak" "cohttp" {>= "1.0.0" & < "2.0.0"} "cohttp-lwt-unix" {>= "1.0.0" & < "2.0.0"} + "cryptokit" "ssl" {= "0.5.5"} "digestif" {>= "0.7.1"} "dune" {= "2.0.1"} @@ -28,6 +29,7 @@ depends: [ "lwt" {>= "4.0.0"} "lwt_ssl" "ocaml" {= "4.05.0"} + "ocamlnet" {> "4.1"} "ocamlfind" {build} "ocp-indent-nlfork" "ocp-ocamlres" {>= "0.4"} @@ -37,6 +39,7 @@ depends: [ "ppx_tools" "ppx_sexp_conv" {= "v0.9.0"} "ppx_fields_conv" {= "v0.9.0"} + "safepass" ] build: [ ["dune" "build" "@install" "-p" name "-j" jobs] From 534103c5c9772ccfc19734c68957a0b791e0cd35 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Mon, 14 Sep 2020 02:47:24 +0200 Subject: [PATCH 137/161] fix: Print "LTI shared secret" only at "serve" phase (not "build") --- src/main/learnocaml_main.ml | 6 ------ src/server/learnocaml_server.ml | 15 +++++++++++---- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index a224b43a5..eed5c0291 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -329,12 +329,6 @@ let main o = (o.app_dir/file) o.builder.Builder.root else Lwt.return_unit) >>= fun () -> - (if preconfig.ServerData.use_moodle then - Token_index.OauthIndex.get_first_oauth o.server.Server.sync_dir >>= fun (secret, _) -> - Lwt_io.printf "LTI shared secret: %s\n" secret - else - Lwt.return_unit) - >>= fun () -> let if_enabled opt dir f = (match opt with | None -> Lwt.catch (fun () -> diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index ae0bbd13b..e52f0dab3 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -1057,15 +1057,22 @@ let compress ?(level = 4) data = let launch () = Random.self_init () ; Learnocaml_store.Server.get () >>= fun config -> - if config.Learnocaml_data.Server.use_moodle - && not config.Learnocaml_data.Server.use_passwd then + let module ServerData = Learnocaml_data.Server in + if config.ServerData.use_moodle + && not config.ServerData.use_passwd then failwith "Cannot enable Moodle/LTI without enabling passwords." - else if not config.Learnocaml_data.Server.use_passwd then + else if not config.ServerData.use_passwd then print_endline "[INFO] You may want to enable passwords and LTI \ with the config options `use_passwd' and `use_moodle'." - else if not config.Learnocaml_data.Server.use_moodle then + else if not config.ServerData.use_moodle then print_endline "[INFO] You may want to enable LTI with the config \ option `use_moodle'."; + (if config.ServerData.use_moodle then + Token_index.OauthIndex.get_first_oauth !sync_dir >>= fun (secret, _) -> + Lwt_io.printf "LTI shared secret: %s\n" secret + else + Lwt.return_unit) + >>= fun () -> let callback conn req body = let uri = Request.uri req in let path = Uri.path uri in From cf4241cfd54fb776ce891f9afa213cf90dcd27a4 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 15 Sep 2020 19:41:58 +0200 Subject: [PATCH 138/161] refactor: Rename one CLI option (s/--root/--root-url/) BREAKING CHANGE: Previously, the CLI option was named `--root`. Fortunately, no version of learn-ocaml has been released yet with that previous option naming. --- src/app/learnocaml_config.ml | 4 ++-- src/app/learnocaml_config.mli | 2 +- src/main/learnocaml_main.ml | 24 ++++++++++++------------ 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/src/app/learnocaml_config.ml b/src/app/learnocaml_config.ml index f3f78d3ea..a3fec02b2 100644 --- a/src/app/learnocaml_config.ml +++ b/src/app/learnocaml_config.ml @@ -15,9 +15,9 @@ class type learnocaml_config = object method enablePlayground: bool Js.optdef_prop method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop method txtNickname: Js.js_string Js.t Js.optdef_prop - method root: Js.js_string Js.t Js.optdef_prop + method rootUrl: Js.js_string Js.t Js.optdef_prop end let config : learnocaml_config Js.t = Js.Unsafe.js_expr "learnocaml_config" -let api_server = Js.(to_string (Optdef.get config##.root (fun () -> string ""))) +let api_server = Js.(to_string (Optdef.get config##.rootUrl (fun () -> string ""))) let get_opt o = Js.Optdef.get o (fun () -> false) diff --git a/src/app/learnocaml_config.mli b/src/app/learnocaml_config.mli index 6c6ae6cdc..691ca0277 100644 --- a/src/app/learnocaml_config.mli +++ b/src/app/learnocaml_config.mli @@ -19,7 +19,7 @@ class type learnocaml_config = object method enablePlayground: bool Js.optdef_prop method txtLoginWelcome: Js.js_string Js.t Js.optdef_prop method txtNickname: Js.js_string Js.t Js.optdef_prop - method root: Js.js_string Js.t Js.optdef_prop + method rootUrl: Js.js_string Js.t Js.optdef_prop end val config : learnocaml_config Js.t diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index eed5c0291..cdecdb0f8 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -180,9 +180,9 @@ module Args = struct value & opt int 1 & info ["jobs";"j"] ~docv:"INT" ~doc: "Number of building jobs to run in parallel" - let root = - value & opt string "" & info ["root"] ~docv:"ROOT" ~doc: - "Set the root of all documents. Use only for static deployment.\ + let root_url = + value & opt string "" & info ["root-url"] ~docv:"ROOT_URL" ~doc: + "Set the root URL of all documents. Use only for static deployment. \ Should not end with a trailing slash." type t = { @@ -192,15 +192,15 @@ module Args = struct exercises: bool option; playground: bool option; toplevel: bool option; - root: string + root_url: string } let builder_conf = let apply - contents_dir try_ocaml lessons exercises playground toplevel root - = { contents_dir; try_ocaml; lessons; exercises; playground; toplevel; root } + contents_dir try_ocaml lessons exercises playground toplevel root_url + = { contents_dir; try_ocaml; lessons; exercises; playground; toplevel; root_url } in - Term.(const apply $contents_dir $try_ocaml $lessons $exercises $playground $toplevel $root) + Term.(const apply $contents_dir $try_ocaml $lessons $exercises $playground $toplevel $root_url) let repo_conf = let apply repo_dir exercises_filtered jobs = @@ -246,11 +246,11 @@ end open Args -let process_html_file orig_file dest_file root = +let process_html_file orig_file dest_file root_url = let transform_tag e tag attrs attr = let attr_pair = ("", attr) in match List.assoc_opt attr_pair attrs with - | Some url -> `Start_element ((e, tag), (attr_pair, root ^ url) :: (List.remove_assoc attr_pair attrs)) + | Some url -> `Start_element ((e, tag), (attr_pair, root_url ^ url) :: (List.remove_assoc attr_pair attrs)) | None -> `Start_element ((e, tag), attrs) in Lwt_io.open_file ~mode:Lwt_io.Input orig_file >>= fun ofile -> Lwt_io.open_file ~mode:Lwt_io.Output dest_file >>= fun wfile -> @@ -326,7 +326,7 @@ let main o = |> Lwt_stream.iter_s (fun file -> if Filename.extension file = ".html" then process_html_file (o.builder.Builder.contents_dir/file) - (o.app_dir/file) o.builder.Builder.root + (o.app_dir/file) o.builder.Builder.root_url else Lwt.return_unit) >>= fun () -> let if_enabled opt dir f = (match opt with @@ -363,7 +363,7 @@ let main o = \ enableLessons: %b,\n\ \ enableExercises: %b,\n\ \ enableToplevel: %b,\n\ - \ root: \"%s\",\n\ + \ rootUrl: \"%s\",\n\ \ enablePasswd: %b,\n\ \ enableMoodle: %b\n\ }\n" @@ -372,7 +372,7 @@ let main o = (lessons_ret <> None) (exercises_ret <> None) (o.builder.Builder.toplevel <> Some false) - o.builder.Builder.root + o.builder.Builder.root_url preconfig.ServerData.use_passwd preconfig.ServerData.use_moodle >>= fun () -> Lwt.return (tutorials_ret <> Some false && exercises_ret <> Some false))) From ca0bd135da3d0793b407ea99f504ed159a415bcf Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 15 Sep 2020 20:35:52 +0200 Subject: [PATCH 139/161] feat: Add LEARNOCAML_ROOT_URL env var --- src/main/learnocaml_main.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index cdecdb0f8..8f191d967 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -181,7 +181,8 @@ module Args = struct "Number of building jobs to run in parallel" let root_url = - value & opt string "" & info ["root-url"] ~docv:"ROOT_URL" ~doc: + value & opt string "" & + info ["root-url"] ~docv:"ROOT_URL" ~env:(Arg.env_var "LEARNOCAML_ROOT_URL") ~doc: "Set the root URL of all documents. Use only for static deployment. \ Should not end with a trailing slash." From d75a57af2a50b85c27fe16ba104593a238902050 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 15 Sep 2020 20:40:27 +0200 Subject: [PATCH 140/161] fix(learnocaml_server): function get_base_url was broken * cf. Failure "Bad request" in docker-compose context (+ TLS termination proxy) * Use CLI argument --root-url / env. var. LEARNOCAML_ROOT_URL instead * This patch reverts part of 5b09899db5b9b5e6a17da23ab12d3886d4a62023 --- docker-compose.yml | 2 ++ src/main/learnocaml_main.ml | 21 +++++++++++++-------- src/main/learnocaml_server_args.ml | 12 +++++++----- src/main/learnocaml_server_args.mli | 5 +++-- src/main/learnocaml_server_main.ml | 11 ++++++++++- src/server/learnocaml_server.ml | 24 +++++++++--------------- src/server/learnocaml_server.mli | 1 + 7 files changed, 45 insertions(+), 31 deletions(-) diff --git a/docker-compose.yml b/docker-compose.yml index f1fa65f8e..c179e9aeb 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -12,6 +12,8 @@ services: ports: - '8080:8080' environment: + # (ocaml variable) root URL: + LEARNOCAML_ROOT_URL: "http://localhost:8080" # (ocaml variable) .: FROM_DOMAIN: "backend.localdomain" # (alpine msmtp variable) hostname of the SMTP server: diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 8f191d967..1e129b7c6 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -47,6 +47,15 @@ module Args = struct "Directory where the app should be generated for the $(i,build) command, \ and from where it is served by the $(i,serve) command." + let root_url = + value & opt string "" & + info ["root-url"] ~docv:"ROOT_URL" ~env:(Arg.env_var "LEARNOCAML_ROOT_URL") ~doc: + "Set the root URL of the website. \ + Should not end with a trailing slash. \ + Mandatory when the site is not hosted in path '/', \ + which typically occurs for static deployment, \ + or when use_moodle=true." + module Grader = struct let info = info ~docs:"GRADER OPTIONS" @@ -180,12 +189,6 @@ module Args = struct value & opt int 1 & info ["jobs";"j"] ~docv:"INT" ~doc: "Number of building jobs to run in parallel" - let root_url = - value & opt string "" & - info ["root-url"] ~docv:"ROOT_URL" ~env:(Arg.env_var "LEARNOCAML_ROOT_URL") ~doc: - "Set the root URL of all documents. Use only for static deployment. \ - Should not end with a trailing slash." - type t = { contents_dir: string; try_ocaml: bool option; @@ -242,7 +245,7 @@ module Args = struct { commands; app_dir; repo_dir; grader; builder; server } in Term.(const apply $commands $app_dir $repo_dir - $Grader.term $Builder.term $Server.term app_dir) + $Grader.term $Builder.term $Server.term app_dir root_url) end open Args @@ -388,12 +391,14 @@ let main o = let open Server in ("--app-dir="^o.app_dir) :: ("--sync-dir="^o.server.sync_dir) :: + ("--root-url="^o.builder.Builder.root_url) :: ("--port="^string_of_int o.server.port) :: (match o.server.cert with None -> [] | Some c -> ["--cert="^c]) in Unix.execv native_server (Array.of_list (native_server::server_args)) else - Printf.printf "Starting server on port %d\n%!" + Printf.printf {|ROOT_URL: "%s"\n%!|} o.builder.Builder.root_url; + Printf.printf "Starting server on port %d\n%!" !Learnocaml_server.port; Learnocaml_server.launch () else diff --git a/src/main/learnocaml_server_args.ml b/src/main/learnocaml_server_args.ml index 715d9aa00..f91209dfa 100644 --- a/src/main/learnocaml_server_args.ml +++ b/src/main/learnocaml_server_args.ml @@ -34,12 +34,13 @@ let port = type t = { sync_dir: string; - cert: string option; + root_url: string; port: int; + cert: string option; } -let term app_dir = - let apply app_dir sync_dir port cert = +let term app_dir root_url = + let apply app_dir sync_dir root_url port cert = Learnocaml_store.static_dir := app_dir; Learnocaml_store.sync_dir := sync_dir; let port = match port, cert with @@ -52,8 +53,9 @@ let term app_dir = | Some base -> Some (base ^ ".pem", base ^ ".key"); | None -> None); Learnocaml_server.port := port; - { sync_dir; port; cert } + Learnocaml_server.root_url := root_url; + { sync_dir; root_url; port; cert } in (* warning: if you add any options here, remember to pass them through when calling the native server from learn-ocaml main *) - Term.(const apply $app_dir $sync_dir $port $cert) + Term.(const apply $ app_dir $ sync_dir $ root_url $ port $ cert) diff --git a/src/main/learnocaml_server_args.mli b/src/main/learnocaml_server_args.mli index 6cf943494..c30200bad 100644 --- a/src/main/learnocaml_server_args.mli +++ b/src/main/learnocaml_server_args.mli @@ -8,8 +8,9 @@ type t = { sync_dir: string; - cert: string option; + root_url: string; port: int; + cert: string option; } -val term: string Cmdliner.Term.t -> t Cmdliner.Term.t +val term: string Cmdliner.Term.t -> string Cmdliner.Term.t -> t Cmdliner.Term.t diff --git a/src/main/learnocaml_server_main.ml b/src/main/learnocaml_server_main.ml index f0dfdc3e8..7ab7136fc 100644 --- a/src/main/learnocaml_server_main.ml +++ b/src/main/learnocaml_server_main.ml @@ -22,6 +22,7 @@ let signal_waiter = waiter let main o = + Printf.printf {|ROOT_URL: "%s"\n%!|} o.root_url; Printf.printf "Learnocaml server v.%s starting on port %d\n%!" Learnocaml_api.version o.port; let rec run () = @@ -68,9 +69,17 @@ let app_dir = "Directory where the app has been generated by the $(b,learn-ocaml build) \ command, and from where it will be served." +let root_url = + let open Cmdliner.Arg in + value & opt string "" & + info ["root-url"] ~docv:"ROOT_URL" ~env:(env_var "LEARNOCAML_ROOT_URL") ~doc: + "Set the root URL of the website. \ + Should not end with a trailing slash. \ + Mandatory when the site is not hosted in path '/' \ + or when use_moodle=true." let main_cmd = - Cmdliner.Term.(const main $ Learnocaml_server_args.term app_dir), + Cmdliner.Term.(const main $ Learnocaml_server_args.term app_dir root_url), Cmdliner.Term.info ~man ~doc:"Learn-ocaml web-app manager" diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index e52f0dab3..79319dd51 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -20,11 +20,17 @@ let cert_key_files = ref None let log_channel = ref (Some stdout) +let root_url = ref "" + let args = Arg.align @@ [ "-static-dir", Arg.Set_string static_dir, "PATH where static files should be found (./www)" ; "-sync-dir", Arg.Set_string sync_dir, "PATH where sync tokens are stored (./sync)" ; + "-root-url", Arg.Set_string root_url, + "ROOT_URL of the website. \ + Should not end with a trailing slash. + Mandatory when the site is not hosted in path '/'." ; "-port", Arg.Set_int port, "PORT the TCP port (8080)" ] @@ -1011,18 +1017,6 @@ let last_modified = (* server startup time *) (tm.tm_year + 1900) tm.tm_hour tm.tm_min tm.tm_sec -let get_base_url req = - let uri = Request.uri req in - match Uri.(scheme uri, host uri, port uri) with - | Some ("http" as scheme), Some host, Some 80 - | Some ("https" as scheme), Some host, Some 443 -> - Uri.to_string @@ Uri.make ~scheme ~host () - | Some scheme, Some host, Some port -> Uri.to_string @@ Uri.make ~scheme ~host ~port () - | _, Some host, Some 80 -> Uri.to_string @@ Uri.make ~scheme:("http") ~host () - | _, Some host, Some 443 -> Uri.to_string @@ Uri.make ~scheme:("https") ~host () - | _, Some host, Some port -> Uri.to_string @@ Uri.make ~scheme:("http") ~host ~port () - | _ -> failwith "Bad request" - (* Taken from the source of "decompress", from bin/easy.ml *) let compress ?(level = 4) data = let input_buffer = Bytes.create 0xFFFF in @@ -1157,7 +1151,7 @@ let launch () = then Server.respond ~status:`Not_modified ~body:Cohttp_lwt.Body.empty () else (match req.Request.meth with - | `GET -> lwt_ok {Api.meth = `GET; host = get_base_url req; path; args} + | `GET -> lwt_ok {Api.meth = `GET; host = !root_url; path; args} | `POST -> begin Cohttp_lwt.Body.to_string body @@ -1171,11 +1165,11 @@ let launch () = List.assoc_opt "csrf" cookies with | Some (param_csrf :: _), Some cookie_csrf -> if Eqaf.equal param_csrf cookie_csrf then - lwt_ok {Api.meth = `POST params; host = get_base_url req; path; args} + lwt_ok {Api.meth = `POST params; host = !root_url; path; args} else lwt_fail (`Forbidden, "CSRF token mismatch") | None, None | None, Some _ -> - lwt_ok {Api.meth = `POST params; host = get_base_url req; path; args} + lwt_ok {Api.meth = `POST params; host = !root_url; path; args} | _, _ -> lwt_fail (`Forbidden, "Bad CSRF token") end diff --git a/src/server/learnocaml_server.mli b/src/server/learnocaml_server.mli index cc7c9a102..7d6735b91 100644 --- a/src/server/learnocaml_server.mli +++ b/src/server/learnocaml_server.mli @@ -10,6 +10,7 @@ val port: int ref val cert_key_files: (string * string) option ref +val root_url: string ref val args: (Arg.key * Arg.spec * Arg.doc) list From 53b3fd3d7da9a684a8fae8573ab38422a8cf04a4 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 15 Sep 2020 22:38:33 +0200 Subject: [PATCH 141/161] fix: strings escaping --- src/main/learnocaml_main.ml | 2 +- src/main/learnocaml_server_main.ml | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/main/learnocaml_main.ml b/src/main/learnocaml_main.ml index 1e129b7c6..4e59b27b2 100644 --- a/src/main/learnocaml_main.ml +++ b/src/main/learnocaml_main.ml @@ -397,7 +397,7 @@ let main o = in Unix.execv native_server (Array.of_list (native_server::server_args)) else - Printf.printf {|ROOT_URL: "%s"\n%!|} o.builder.Builder.root_url; + Printf.printf "ROOT_URL: \"%s\"\n%!" o.builder.Builder.root_url; Printf.printf "Starting server on port %d\n%!" !Learnocaml_server.port; Learnocaml_server.launch () diff --git a/src/main/learnocaml_server_main.ml b/src/main/learnocaml_server_main.ml index 7ab7136fc..3caf94e29 100644 --- a/src/main/learnocaml_server_main.ml +++ b/src/main/learnocaml_server_main.ml @@ -22,7 +22,7 @@ let signal_waiter = waiter let main o = - Printf.printf {|ROOT_URL: "%s"\n%!|} o.root_url; + Printf.printf "ROOT_URL: \"%s\"\n%!" o.root_url; Printf.printf "Learnocaml server v.%s starting on port %d\n%!" Learnocaml_api.version o.port; let rec run () = From 9d6d357722f89e5b3a9c6c3f297206a029c3b0ad Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 17 Sep 2020 11:32:33 +0200 Subject: [PATCH 142/161] fix: Api.Create_teacher_token should call Token_index.UserIndex.add --- src/server/learnocaml_server.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 79319dd51..f42bf70b5 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -490,8 +490,10 @@ module Request_handler = struct | Api.Create_teacher_token token -> verify_teacher_token token >?= fun () -> - Token.create_teacher () - >>= respond_json cache + Token.create_teacher () >>= fun token -> + let auth = Token_index.Token (token, false) in + Token_index.UserIndex.add !sync_dir auth >>= fun () -> + respond_json cache token | Api.Create_user (email, nick, password, secret) when config.ServerData.use_passwd -> valid_string_of_endp conn >?= fun conn -> From 93c14dd43c0bce21a6f56fa64c4f282a374b612b Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 17 Sep 2020 13:26:43 +0200 Subject: [PATCH 143/161] refactor(token_index.ml): Improve logging --- src/state/token_index.ml | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index e4503d9eb..ffe0dc371 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -13,7 +13,7 @@ let ( / ) dir f = if dir = "" then f else Filename.concat dir f let indexes_subdir = "data" let logfailwith str arg = - Printf.printf "[WARNING] %s (%s)\n%!" str arg; + Printf.printf "[ERROR] %s (%s)\n%!" str arg; failwith str let generate_random_hex len = @@ -120,7 +120,7 @@ module BaseTokenIndex (RW: IndexRW) = struct else Lwt.return acc ) "" [] in - Lwt_io.printl "Regenerating the token index..." >>= fun () -> + Lwt_io.printl "[INFO] Regenerating the token index..." >>= fun () -> found_indexes >>= RW.write rw (sync_dir / indexes_subdir / file) serialise_str let get_file sync_dir name = @@ -363,6 +363,7 @@ module BaseUserIndex (RW: IndexRW) = struct (fun () -> RW.read (sync_dir / indexes_subdir / file) parse) (fun _exn -> TokenIndex.get_tokens sync_dir >>= fun tokens -> + Lwt_io.printl "[INFO] Generating the user index from token index..." >>= fun () -> let users = token_list_to_users tokens in RW.write rw (sync_dir / indexes_subdir / file) serialise users >|= fun () -> users) @@ -565,8 +566,8 @@ module BaseUpgradeIndex (RW: IndexRW) = struct | [] -> Lwt.return_none | handle :: [] -> Lwt.return_some handle | handle :: _ -> - Printf.printf {|[WARNING] several ChangeEmail handles for %s|} - (Token.to_string token); + Lwt_io.printlf "[WARNING] several ChangeEmail handles for %s" + (Token.to_string token) >>= fun () -> Lwt.return_some handle let abort_email_change sync_dir token = From ddf6e26a6404d13c87aead051caa98709201e6fd Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 17 Sep 2020 14:05:38 +0200 Subject: [PATCH 144/161] fix: init_teacher_token * Avoid "[ERROR] BaseUserIndex.add: duplicate token" when "/sync" is empty * Refactor src/state/token_index.{ml,mli} accordingly --- src/server/learnocaml_server.ml | 16 +++++++++++++--- src/state/token_index.ml | 22 +++++++++++++--------- src/state/token_index.mli | 6 +++++- 3 files changed, 31 insertions(+), 13 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index f42bf70b5..55135108b 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -995,9 +995,19 @@ let init_teacher_token () = Token.Index.get () >>= function tokens -> match List.filter Token.is_teacher tokens with | [] -> - Token.create_teacher () >|= fun token -> - Printf.printf "Initial teacher token created: %s\n%!" - (Token.to_string token) + Token_index.UserIndex.create_index !sync_dir >>= fun _users -> + (* call [UserIndex.create_index] first as it will rely on + [TokenIndex.get_tokens] to populate the [UserIndex] (with no + tokens at that point) before calling [Token.create_teacher], + otherwise we would get: + [ERROR] BaseUserIndex.add: duplicate token (X-…-…-…-…) *) + Token.create_teacher () >>= fun token -> + let auth = Token_index.Token (token, false) in + Token_index.UserIndex.add !sync_dir auth >>= fun () -> + Printf.printf "Initial teacher token created: %s\n%!" + (Token.to_string token); + Lwt.return_unit + | teachers -> Printf.printf "Found the following teacher tokens:\n - %s\n%!" (String.concat "\n - " (List.map Token.to_string teachers)); diff --git a/src/state/token_index.ml b/src/state/token_index.ml index ffe0dc371..d37e22b92 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -354,19 +354,23 @@ module BaseUserIndex (RW: IndexRW) = struct let token_list_to_users = List.map (fun token -> Token (token, false)) - let create_index sync_dir tokens = - token_list_to_users tokens - |> RW.write rw (sync_dir / indexes_subdir / file) serialise + let create_index ?(tokens) sync_dir = + match tokens with + | Some tokens -> + let users = token_list_to_users tokens in + RW.write rw (sync_dir / indexes_subdir / file) serialise users >|= fun () -> + users + | None -> + TokenIndex.get_tokens sync_dir >>= fun tokens -> + Lwt_io.printl "[INFO] Generating the user index from token index..." >>= fun () -> + let users = token_list_to_users tokens in + RW.write rw (sync_dir / indexes_subdir / file) serialise users >|= fun () -> + users let get_data sync_dir = Lwt.catch (fun () -> RW.read (sync_dir / indexes_subdir / file) parse) - (fun _exn -> - TokenIndex.get_tokens sync_dir >>= fun tokens -> - Lwt_io.printl "[INFO] Generating the user index from token index..." >>= fun () -> - let users = token_list_to_users tokens in - RW.write rw (sync_dir / indexes_subdir / file) serialise users >|= fun () -> - users) + (fun _exn -> create_index sync_dir) let authenticate sync_dir auth = get_data sync_dir >|= diff --git a/src/state/token_index.mli b/src/state/token_index.mli index c2676a597..e95f07776 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -67,7 +67,11 @@ type authentication = | Passwd of (string * string) module UserIndex: sig - val create_index : string -> Learnocaml_data.Token.t list -> unit Lwt.t + + (* If [tokens = None], generate the index from [TokenIndex.get_tokens]; + * If [tokens = Some []], write the index with an empty list of users. *) + val create_index : ?tokens:(Learnocaml_data.Token.t list) -> string -> user list Lwt.t + val authenticate : string -> authentication -> Learnocaml_data.Token.t option Lwt.t val exists : string -> string -> bool Lwt.t val add : string -> user -> unit Lwt.t From aa9a51b4571486ecd78d8b58a7ac6c2ef1c3707b Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 17 Sep 2020 14:32:57 +0200 Subject: [PATCH 145/161] refactor: Don't say "legacy" if use_passwd = false --- src/app/learnocaml_index_main.ml | 4 +- translations/fr.po | 234 ++++++++++++++++--------------- 2 files changed, 122 insertions(+), 116 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 1a4f39686..b6233337b 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -926,7 +926,9 @@ let set_string_translations () = "txt_first_connection_consent", [%i"By submitting this form, I accept that the \ information entered will be used in the \ context of the Learn-OCaml plateform."]; - "txt_returning_with_token", [%i"Login with a legacy token"]; + "txt_returning_with_token", (if get_opt config##.enablePasswd + then [%i"Login with a legacy token"] + else [%i"Login with a token"]); "txt_returning_token", [%i"Token"]; "txt_token_returning", [%i"Connect"]; "txt_upgrade", [%i"Setup a password"]; diff --git a/translations/fr.po b/translations/fr.po index 58a7bea16..23ab4e74b 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,7 +5,7 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-13 15:37+0200\n" +"PO-Revision-Date: 2020-09-17 14:32+0200\n" "Last-Translator: Louis Gesbert \n" "Language-Team: OCamlPro\n" "Language: french\n" @@ -29,49 +29,49 @@ msgstr "OK" #: src/app/learnocaml_lti_main.ml:91,26--33 #: src/app/learnocaml_lti_main.ml:97,26--33 #: src/app/learnocaml_lti_main.ml:101,26--33 -#: src/app/learnocaml_index_main.ml:610,21--28 -#: src/app/learnocaml_index_main.ml:629,21--28 -#: src/app/learnocaml_index_main.ml:651,22--29 -#: src/app/learnocaml_index_main.ml:711,33--40 -#: src/app/learnocaml_index_main.ml:716,33--40 -#: src/app/learnocaml_index_main.ml:721,33--40 -#: src/app/learnocaml_index_main.ml:753,25--32 -#: src/app/learnocaml_index_main.ml:817,29--36 +#: src/app/learnocaml_index_main.ml:615,21--28 +#: src/app/learnocaml_index_main.ml:635,21--28 +#: src/app/learnocaml_index_main.ml:657,22--29 +#: src/app/learnocaml_index_main.ml:717,33--40 +#: src/app/learnocaml_index_main.ml:722,33--40 +#: src/app/learnocaml_index_main.ml:727,33--40 +#: src/app/learnocaml_index_main.ml:759,25--32 +#: src/app/learnocaml_index_main.ml:823,29--36 msgid "ERROR" msgstr "ERREUR" #: src/app/learnocaml_common.ml:146,58--66 #: src/app/learnocaml_common.ml:152,66--74 #: src/app/learnocaml_common.ml:427,12--20 -#: src/app/learnocaml_index_main.ml:619,12--20 -#: src/app/learnocaml_index_main.ml:638,12--20 -#: src/app/learnocaml_index_main.ml:771,19--27 -#: src/app/learnocaml_index_main.ml:807,20--28 +#: src/app/learnocaml_index_main.ml:624,12--20 +#: src/app/learnocaml_index_main.ml:644,12--20 +#: src/app/learnocaml_index_main.ml:777,19--27 +#: src/app/learnocaml_index_main.ml:813,20--28 msgid "Cancel" msgstr "Annuler" #: src/app/learnocaml_common.ml:419,26--41 -#: src/app/learnocaml_index_main.ml:614,25--40 -#: src/app/learnocaml_index_main.ml:633,25--40 -#: src/app/learnocaml_index_main.ml:766,32--47 -#: src/app/learnocaml_index_main.ml:802,33--48 +#: src/app/learnocaml_index_main.ml:619,25--40 +#: src/app/learnocaml_index_main.ml:639,25--40 +#: src/app/learnocaml_index_main.ml:772,32--47 +#: src/app/learnocaml_index_main.ml:808,33--48 msgid "REQUEST ERROR" msgstr "ERREUR DE REQUÊTE" #: src/app/learnocaml_common.ml:420,22--59 -#: src/app/learnocaml_index_main.ml:615,26--63 -#: src/app/learnocaml_index_main.ml:634,26--63 -#: src/app/learnocaml_index_main.ml:767,30--67 -#: src/app/learnocaml_index_main.ml:803,34--71 +#: src/app/learnocaml_index_main.ml:620,26--63 +#: src/app/learnocaml_index_main.ml:640,26--63 +#: src/app/learnocaml_index_main.ml:773,30--67 +#: src/app/learnocaml_index_main.ml:809,34--71 msgid "Could not retrieve data from server" msgstr "Échec lors du téléchargement des données du serveur" #: src/app/learnocaml_common.ml:423,12--19 #: src/app/learnocaml_common.ml:463,11--18 -#: src/app/learnocaml_index_main.ml:618,12--19 -#: src/app/learnocaml_index_main.ml:637,12--19 -#: src/app/learnocaml_index_main.ml:770,19--26 -#: src/app/learnocaml_index_main.ml:806,20--27 +#: src/app/learnocaml_index_main.ml:623,12--19 +#: src/app/learnocaml_index_main.ml:643,12--19 +#: src/app/learnocaml_index_main.ml:776,19--26 +#: src/app/learnocaml_index_main.ml:812,20--27 msgid "Retry" msgstr "Réessayer" @@ -147,7 +147,7 @@ msgid "Editor" msgstr "Éditeur" #: src/app/learnocaml_common.ml:791,41--51 -#: src/app/learnocaml_index_main.ml:1037,30--40 +#: src/app/learnocaml_index_main.ml:1054,30--40 msgid "Toplevel" msgstr "Toplevel" @@ -185,7 +185,7 @@ msgstr "Statistiques" #: src/app/learnocaml_common.ml:803,37--48 #: src/app/learnocaml_exercise_main.ml:200,23--34 -#: src/app/learnocaml_index_main.ml:1034,29--40 +#: src/app/learnocaml_index_main.ml:1051,29--40 #: src/app/learnocaml_teacher_tab.ml:328,18--29 msgid "Exercises" msgstr "Exercices" @@ -231,7 +231,7 @@ msgid "Show" msgstr "Montrer" #: src/app/learnocaml_common.ml:1005,18--36 -#: src/app/learnocaml_index_main.ml:904,27--45 +#: src/app/learnocaml_index_main.ml:910,27--45 msgid "Enter the secret" msgstr "Entrez le secret" @@ -462,21 +462,21 @@ msgid "Unexpected error:\n" msgstr "Erreur inattendue :\n" #: src/app/learnocaml_lti_main.ml:92,15--48 -#: src/app/learnocaml_index_main.ml:611,10--43 -#: src/app/learnocaml_index_main.ml:712,19--52 -#: src/app/learnocaml_index_main.ml:817,41--74 +#: src/app/learnocaml_index_main.ml:616,10--43 +#: src/app/learnocaml_index_main.ml:718,19--52 +#: src/app/learnocaml_index_main.ml:823,41--74 msgid "The entered e-mail was invalid." msgstr "L'e-mail entré est invalide." #: src/app/learnocaml_lti_main.ml:98,15--60 -#: src/app/learnocaml_index_main.ml:717,19--64 +#: src/app/learnocaml_index_main.ml:723,19--64 #: src/app/learnocaml_reset_main.ml:20,32--77 #: src/app/learnocaml_upgrade_main.ml:21,34--79 msgid "Password must be at least 8 characters long" msgstr "Le mot de passe doit comporter au moins 8 caractères" #: src/app/learnocaml_lti_main.ml:102,15--153 -#: src/app/learnocaml_index_main.ml:722,19--165 +#: src/app/learnocaml_index_main.ml:728,19--165 #: src/app/learnocaml_reset_main.ml:21,34--210 #: src/app/learnocaml_upgrade_main.ml:22,36--216 msgid "" @@ -487,51 +487,51 @@ msgstr "" "majuscule, et un caractère non-alphanumérique." #: src/app/learnocaml_lti_main.ml:117,21--42 -#: src/app/learnocaml_index_main.ml:739,28--49 +#: src/app/learnocaml_index_main.ml:745,28--49 msgid "VALIDATION REQUIRED" msgstr "VALIDATION REQUISE" #: src/app/learnocaml_lti_main.ml:117,47--101 -#: src/app/learnocaml_index_main.ml:740,14--68 +#: src/app/learnocaml_index_main.ml:746,14--68 msgid "A confirmation e-mail has been sent to your address." msgstr "Un courriel a été envoyé à votre adresse pour la confirmer." #: src/app/learnocaml_lti_main.ml:130,33--51 -#: src/app/learnocaml_index_main.ml:902,37--55 -#: src/app/learnocaml_index_main.ml:906,31--49 +#: src/app/learnocaml_index_main.ml:908,37--55 +#: src/app/learnocaml_index_main.ml:912,31--49 msgid "First connection" msgstr "Première connexion" #: src/app/learnocaml_lti_main.ml:131,39--55 #: src/app/learnocaml_lti_main.ml:143,32--48 -#: src/app/learnocaml_index_main.ml:907,37--53 -#: src/app/learnocaml_index_main.ml:916,30--46 +#: src/app/learnocaml_index_main.ml:913,37--53 +#: src/app/learnocaml_index_main.ml:922,30--46 #: src/app/learnocaml_upgrade_main.ml:26,32--48 msgid "E-mail address" msgstr "Adresse e-mail" #: src/app/learnocaml_lti_main.ml:132,42--52 -#: src/app/learnocaml_index_main.ml:908,40--50 -#: src/app/learnocaml_index_main.ml:939,9--19 +#: src/app/learnocaml_index_main.ml:914,40--50 +#: src/app/learnocaml_index_main.ml:947,9--19 #: src/app/learnocaml_teacher_tab.ml:557,22--32 msgid "Nickname" msgstr "Pseudonyme" #: src/app/learnocaml_lti_main.ml:133,42--52 #: src/app/learnocaml_lti_main.ml:144,35--45 -#: src/app/learnocaml_index_main.ml:909,40--50 -#: src/app/learnocaml_index_main.ml:917,33--43 +#: src/app/learnocaml_index_main.ml:915,40--50 +#: src/app/learnocaml_index_main.ml:923,33--43 #: src/app/learnocaml_upgrade_main.ml:27,35--45 msgid "Password" msgstr "Mot de passe" #: src/app/learnocaml_lti_main.ml:134,40--48 -#: src/app/learnocaml_index_main.ml:910,38--46 +#: src/app/learnocaml_index_main.ml:916,38--46 msgid "Secret" msgstr "Secret" #: src/app/learnocaml_lti_main.ml:135,29--198 -#: src/app/learnocaml_index_main.ml:911,27--192 +#: src/app/learnocaml_index_main.ml:917,27--192 msgid "" "The secret is an optional passphrase provided by your teacher. It may be " "required to create an account." @@ -540,7 +540,7 @@ msgstr "" "Celle-ci est alors requise pour s'inscrire." #: src/app/learnocaml_lti_main.ml:138,41--251 -#: src/app/learnocaml_index_main.ml:920,39--244 +#: src/app/learnocaml_index_main.ml:926,39--244 msgid "" "By submitting this form, I accept that the information entered will be used " "in the context of the Learn-OCaml plateform." @@ -549,29 +549,29 @@ msgstr "" "être utilisées dans le contexte de la plateforme Learn-OCaml." #: src/app/learnocaml_lti_main.ml:141,26--46 -#: src/app/learnocaml_index_main.ml:914,24--44 +#: src/app/learnocaml_index_main.ml:920,24--44 msgid "Create new account" msgstr "Créer un compte" #: src/app/learnocaml_lti_main.ml:142,26--42 -#: src/app/learnocaml_index_main.ml:915,24--40 +#: src/app/learnocaml_index_main.ml:921,24--40 msgid "Returning user" msgstr "Utilisateur existant" #: src/app/learnocaml_lti_main.ml:145,32--41 #: src/app/learnocaml_lti_main.ml:153,32--41 -#: src/app/learnocaml_index_main.ml:918,31--40 -#: src/app/learnocaml_index_main.ml:925,30--39 +#: src/app/learnocaml_index_main.ml:924,31--40 +#: src/app/learnocaml_index_main.ml:933,30--39 msgid "Connect" msgstr "Se connecter" #: src/app/learnocaml_lti_main.ml:146,32--55 -#: src/app/learnocaml_index_main.ml:919,30--53 +#: src/app/learnocaml_index_main.ml:925,30--53 msgid "Forgot your password?" msgstr "Mot de passe oublié ?" #: src/app/learnocaml_lti_main.ml:147,38--57 -#: src/app/learnocaml_index_main.ml:903,44--63 +#: src/app/learnocaml_index_main.ml:909,44--63 msgid "Choose a nickname" msgstr "Choisissez un identifiant" @@ -593,7 +593,7 @@ msgid "Reuse an account with a legacy token" msgstr "Réutiliser un compte avec un ancien token" #: src/app/learnocaml_lti_main.ml:155,32--39 -#: src/app/learnocaml_index_main.ml:924,30--37 +#: src/app/learnocaml_index_main.ml:932,30--37 #: src/app/learnocaml_teacher_tab.ml:559,22--29 msgid "Token" msgstr "Token" @@ -648,11 +648,11 @@ msgstr "Démarrage d'OCaml" msgid "Loading student info" msgstr "Chargement des informations sur les étudiants" -#: src/app/learnocaml_index_main.ml:574,26--50 +#: src/app/learnocaml_index_main.ml:575,26--50 msgid "Your Learn-OCaml token" msgstr "Votre token Learn-OCaml" -#: src/app/learnocaml_index_main.ml:575,24--153 +#: src/app/learnocaml_index_main.ml:576,24--153 msgid "" "Your token is displayed below. It identifies you and allows to share your " "workspace between devices." @@ -660,15 +660,15 @@ msgstr "" "Votre token est affiché ci-dessous. Il vous identifie et permet de partager " "un même espace de travail entre plusieurs machines." -#: src/app/learnocaml_index_main.ml:577,24--47 +#: src/app/learnocaml_index_main.ml:578,24--47 msgid "Please write it down." msgstr "Notez-le !" -#: src/app/learnocaml_index_main.ml:583,41--97 +#: src/app/learnocaml_index_main.ml:584,41--97 msgid "Moodle/LTI authentication is enabled for your account." msgstr "L'authentification par Moodle/LTI est activée pour votre compte." -#: src/app/learnocaml_index_main.ml:584,31--124 +#: src/app/learnocaml_index_main.ml:585,31--124 msgid "" "You might also want to associate your account with Moodle/LTI. Ask your " "teacher if need be." @@ -676,34 +676,39 @@ msgstr "" "Vous pourriez aussi vouloir associer votre compte à Moodle/LTI. Demandez à " "votre enseignant le cas échéant." -#: src/app/learnocaml_index_main.ml:588,24--47 +#: src/app/learnocaml_index_main.ml:590,29--52 msgid "No e-mail registered." msgstr "Pas d'e-mail enregistré." -#: src/app/learnocaml_index_main.ml:590,17--31 -#: src/app/learnocaml_index_main.ml:592,17--31 -#: src/app/learnocaml_index_main.ml:594,17--31 +#: src/app/learnocaml_index_main.ml:592,22--36 +#: src/app/learnocaml_index_main.ml:594,22--36 +#: src/app/learnocaml_index_main.ml:596,22--36 msgid "Your e-mail:" msgstr "Votre e-mail :" -#: src/app/learnocaml_index_main.ml:592,58--77 -#: src/app/learnocaml_index_main.ml:595,62--81 +#: src/app/learnocaml_index_main.ml:594,63--82 +#: src/app/learnocaml_index_main.ml:597,67--86 msgid "(to be confirmed)" msgstr "(à confirmer)" -#: src/app/learnocaml_index_main.ml:595,17--34 +#: src/app/learnocaml_index_main.ml:597,22--39 msgid "Pending change:" msgstr "Changement en cours :" -#: src/app/learnocaml_index_main.ml:599,26--50 +#: src/app/learnocaml_index_main.ml:604,26--50 msgid "Your Learn-OCaml login" msgstr "Votre login Learn-OCaml" -#: src/app/learnocaml_index_main.ml:605,11--50 +#: src/app/learnocaml_index_main.ml:609,21--41 +#: src/app/learnocaml_index_main.ml:629,24--44 +msgid "RESET REQUEST SENT" +msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" + +#: src/app/learnocaml_index_main.ml:610,11--50 msgid "A reset link was sent to the address:" msgstr "Un lien de réinitialisation a été envoyé à l'adresse :" -#: src/app/learnocaml_index_main.ml:606,41--82 +#: src/app/learnocaml_index_main.ml:611,41--82 msgid "" "\n" "(if it is associated with an account)" @@ -711,38 +716,33 @@ msgstr "" "\n" "(si elle est associée à un compte)" -#: src/app/learnocaml_index_main.ml:604,21--36 -#: src/app/learnocaml_index_main.ml:624,21--41 -msgid "RESET REQUEST SENT" -msgstr "REQUÊTE DE RÉINITIALISATION ENVOYÉE" - -#: src/app/learnocaml_index_main.ml:625,11--64 +#: src/app/learnocaml_index_main.ml:630,11--64 msgid "A confirmation e-mail has been sent to the address:" msgstr "Un lien de confirmation a été envoyé à l'adresse :" -#: src/app/learnocaml_index_main.ml:630,10--54 +#: src/app/learnocaml_index_main.ml:636,10--54 msgid "The entered e-mail couldn't be recognized." msgstr "L'e-mail entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:652,12--45 +#: src/app/learnocaml_index_main.ml:658,12--45 msgid "The entered e-mail is invalid: " msgstr "L'e-mail entré est invalide." -#: src/app/learnocaml_index_main.ml:762,28--45 -#: src/app/learnocaml_index_main.ml:798,29--46 +#: src/app/learnocaml_index_main.ml:768,28--45 +#: src/app/learnocaml_index_main.ml:804,29--46 msgid "TOKEN NOT FOUND" msgstr "TOKEN NON TROUVÉ" -#: src/app/learnocaml_index_main.ml:763,17--60 -#: src/app/learnocaml_index_main.ml:799,18--61 +#: src/app/learnocaml_index_main.ml:769,17--60 +#: src/app/learnocaml_index_main.ml:805,18--61 msgid "The entered token couldn't be recognized." msgstr "Le token entré n'a pas été reconnu." -#: src/app/learnocaml_index_main.ml:785,26--41 +#: src/app/learnocaml_index_main.ml:791,26--41 msgid "INVALID TOKEN" msgstr "TOKEN INVALIDE" -#: src/app/learnocaml_index_main.ml:786,31--200 +#: src/app/learnocaml_index_main.ml:792,31--200 msgid "" "This token is associated to an upgraded account, which only allows password-" "based%s authentication." @@ -750,94 +750,98 @@ msgstr "" "Ce token est associé à un compte, autorisant uniquement l'authentification " "par mot de passe%s." -#: src/app/learnocaml_index_main.ml:789,54--70 +#: src/app/learnocaml_index_main.ml:795,54--70 msgid " or Moodle/LTI" msgstr " ou avec Moodle/LTI" -#: src/app/learnocaml_index_main.ml:897,7--21 +#: src/app/learnocaml_index_main.ml:903,7--21 msgid "Connected as" msgstr "Connecté en tant que" -#: src/app/learnocaml_index_main.ml:899,7--19 +#: src/app/learnocaml_index_main.ml:905,7--19 msgid "Activities" msgstr "Activités" -#: src/app/learnocaml_index_main.ml:901,9--33 +#: src/app/learnocaml_index_main.ml:907,9--33 msgid "Welcome to Learn OCaml" msgstr "Bienvenue sur Learn OCaml" -#: src/app/learnocaml_index_main.ml:905,24--42 +#: src/app/learnocaml_index_main.ml:911,24--42 msgid "Create new token" msgstr "Nouveau token" -#: src/app/learnocaml_index_main.ml:923,35--62 +#: src/app/learnocaml_index_main.ml:930,41--68 msgid "Login with a legacy token" msgstr "Connexion avec un ancien token" -#: src/app/learnocaml_index_main.ml:926,22--40 +#: src/app/learnocaml_index_main.ml:931,41--61 +msgid "Login with a token" +msgstr "Connexion avec un token" + +#: src/app/learnocaml_index_main.ml:934,22--40 #: src/app/learnocaml_upgrade_main.ml:25,26--44 msgid "Setup a password" msgstr "Définir un mot de passe" -#: src/app/learnocaml_index_main.ml:928,33--183 +#: src/app/learnocaml_index_main.ml:936,33--183 msgid "" "Or you may want to login directly from Moodle (ask your teacher for details)" msgstr "" "Ou vous pouvez vous connecter directement depuis Moodle (demandez à votre " "enseignant pour plus de détails)" -#: src/app/learnocaml_index_main.ml:973,38--59 +#: src/app/learnocaml_index_main.ml:981,38--59 msgid "Choose an activity." msgstr "Sélectionnez une activité." -#: src/app/learnocaml_index_main.ml:996,31--51 +#: src/app/learnocaml_index_main.ml:1007,31--51 msgid "New e-mail address" msgstr "Nouvelle adresse e-mail" -#: src/app/learnocaml_index_main.ml:997,22--54 +#: src/app/learnocaml_index_main.ml:1008,22--54 msgid "Enter your new e-mail address:" msgstr "Entrez votre nouvelle adresse e-mail :" -#: src/app/learnocaml_index_main.ml:1011,14--31 -#: src/app/learnocaml_index_main.ml:1014,15--32 -#: src/app/learnocaml_index_main.ml:1016,14--31 +#: src/app/learnocaml_index_main.ml:1026,20--37 +#: src/app/learnocaml_index_main.ml:1029,20--37 +#: src/app/learnocaml_index_main.ml:1031,20--37 msgid "Change password" msgstr "Changer de mot de passe" -#: src/app/learnocaml_index_main.ml:1012,14--35 +#: src/app/learnocaml_index_main.ml:1027,20--41 msgid "Abort e-mail change" msgstr "Annuler le changement d'e-mail" -#: src/app/learnocaml_index_main.ml:1017,14--29 +#: src/app/learnocaml_index_main.ml:1032,20--35 msgid "Change e-mail" msgstr "Changer d'adresse e-mail" -#: src/app/learnocaml_index_main.ml:1030,30--41 +#: src/app/learnocaml_index_main.ml:1047,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:1032,29--38 +#: src/app/learnocaml_index_main.ml:1049,29--38 msgid "Lessons" msgstr "Cours" -#: src/app/learnocaml_index_main.ml:1039,32--44 +#: src/app/learnocaml_index_main.ml:1056,32--44 #: src/app/learnocaml_playground_main.ml:72,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:1042,28--35 +#: src/app/learnocaml_index_main.ml:1059,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:1142,17--71 +#: src/app/learnocaml_index_main.ml:1159,17--71 msgid "Be sure to write down your token before logging out:" msgstr "Assurez-vous d'avoir noté votre token :" -#: src/app/learnocaml_index_main.ml:1144,17--51 +#: src/app/learnocaml_index_main.ml:1161,17--51 msgid "Are you sure you want to logout?" msgstr "Êtes-vous sûr de vouloir vous déconnecter ?" -#: src/app/learnocaml_index_main.ml:1146,15--186 +#: src/app/learnocaml_index_main.ml:1163,15--186 msgid "" "WARNING: the data could not be synchronised with the server. Logging out " "will lose your local changes, be sure you exported a backup." @@ -846,37 +850,37 @@ msgstr "" "En vous déconnectant, vous perdrez tous les changements locaux, à moins " "d'avoir exporté votre espace de travail au préalable." -#: src/app/learnocaml_index_main.ml:1157,22--30 -#: src/app/learnocaml_index_main.ml:1157,45--53 -#: src/app/learnocaml_index_main.ml:1179,9--17 +#: src/app/learnocaml_index_main.ml:1174,22--30 +#: src/app/learnocaml_index_main.ml:1174,45--53 +#: src/app/learnocaml_index_main.ml:1196,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:1170,15--27 +#: src/app/learnocaml_index_main.ml:1187,15--27 msgid "Show login" msgstr "Afficher votre login" -#: src/app/learnocaml_index_main.ml:1171,15--27 +#: src/app/learnocaml_index_main.ml:1188,15--27 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:1173,9--25 +#: src/app/learnocaml_index_main.ml:1190,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:1176,9--25 +#: src/app/learnocaml_index_main.ml:1193,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:1177,9--17 +#: src/app/learnocaml_index_main.ml:1194,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:1178,9--36 +#: src/app/learnocaml_index_main.ml:1195,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:1184,38--44 +#: src/app/learnocaml_index_main.ml:1201,38--44 msgid "Menu" msgstr "Menu" From 825c1fca769c67fef32ea71ed5037a49e690583f Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 17 Sep 2020 16:11:48 +0200 Subject: [PATCH 146/161] fix: Api.Can_login * Refactor and revert part of 44bfe9e47650464cd4608506e0283c3658e05a5e --- src/server/learnocaml_server.ml | 13 +++++++------ src/state/token_index.ml | 8 +++++--- src/state/token_index.mli | 4 +++- 3 files changed, 15 insertions(+), 10 deletions(-) diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 55135108b..5d711e0f8 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -381,7 +381,8 @@ module Request_handler = struct if not (Eqaf.equal hmac new_hmac) then lwt_fail (`Forbidden, "bad hmac") else - Token_index.UserIndex.can_login !sync_dir token >>= fun canlogin -> + Token_index.UserIndex.can_login ~use_passwd:true ~use_moodle:true + !sync_dir token >>= fun canlogin -> if not canlogin then lwt_fail (`Forbidden, "Bad token (or token already used by an upgraded account)") else @@ -525,11 +526,11 @@ module Request_handler = struct | Api.Login _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Can_login token -> - if config.ServerData.use_passwd then - Token_index.UserIndex.can_login !sync_dir token >>= - respond_json cache - else - respond_json cache true + Token_index.UserIndex.can_login + ~use_passwd:config.ServerData.use_passwd + ~use_moodle:config.ServerData.use_moodle + !sync_dir token >>= + respond_json cache | Api.Fetch_save token -> lwt_catch_fail (fun () -> diff --git a/src/state/token_index.ml b/src/state/token_index.ml index d37e22b92..4f49276da 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -464,11 +464,13 @@ module BaseUserIndex (RW: IndexRW) = struct | elt -> elt) >>= RW.write rw (sync_dir / indexes_subdir / file) serialise - let can_login sync_dir token = + let can_login ?(use_passwd = true) ?(use_moodle = true) sync_dir token = get_data sync_dir >|= fun users -> List.find_opt (function - | Token (found_token, use_moodle) -> found_token = token && not use_moodle - | _ -> false) users <> None + | Token (found_token, moodle_account) + -> found_token = token && not (use_moodle && moodle_account) + | Password (found_token, _email, _passwd, _verify) -> + found_token = token && not use_passwd) users <> None let token_of_email sync_dir email = RW.read (sync_dir / indexes_subdir / file) parse >|= diff --git a/src/state/token_index.mli b/src/state/token_index.mli index e95f07776..b2430d4f8 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -86,7 +86,9 @@ module UserIndex: sig val update : string -> Learnocaml_data.Token.t -> string -> unit Lwt.t val confirm_email : string -> Learnocaml_data.Token.t -> unit Lwt.t - val can_login : string -> Learnocaml_data.Token.t -> bool Lwt.t + val can_login : + ?use_passwd:bool -> ?use_moodle:bool -> + string -> Learnocaml_data.Token.t -> bool Lwt.t val token_of_email : string -> string -> Learnocaml_data.Token.t option Lwt.t (** Four cases for the result: From 55b63d00c1c936314aaace97bb27b8b9d889b32a Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 17 Sep 2020 16:30:50 +0200 Subject: [PATCH 147/161] refactor(index-main): Improve 1 error message & fr.po --- src/app/learnocaml_index_main.ml | 5 +- translations/fr.po | 143 +++++++++++++++---------------- 2 files changed, 74 insertions(+), 74 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index b6233337b..f273106a3 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -789,8 +789,9 @@ let init_token_dialog () = Server_caller.request (Learnocaml_api.Can_login token) >>= function | Error _ | Ok false -> alert ~title:[%i"INVALID TOKEN"] @@ - Printf.sprintf [%if"This token is associated to an upgraded \ - account, which only allows \ + Printf.sprintf [%if"This token is invalid, \ + or associated to an upgraded account \ + that only allows \ password-based%s authentication."] (if get_opt config##.enableMoodle then [%i" or Moodle/LTI"] else ""); Lwt.return_none diff --git a/translations/fr.po b/translations/fr.po index 23ab4e74b..4fd65d56d 100644 --- a/translations/fr.po +++ b/translations/fr.po @@ -5,9 +5,9 @@ msgid "" msgstr "" "Project-Id-Version: learn-ocaml ~dev\n" -"PO-Revision-Date: 2020-09-17 14:32+0200\n" -"Last-Translator: Louis Gesbert \n" -"Language-Team: OCamlPro\n" +"PO-Revision-Date: 2020-09-17 16:28+0200\n" +"Last-Translator: Erik Martin-Dorel \n" +"Language-Team: Learn-OCaml\n" "Language: french\n" "MIME-Version: 1.0\n" "Content-Type: text/plain; charset=utf-8\n" @@ -36,7 +36,7 @@ msgstr "OK" #: src/app/learnocaml_index_main.ml:722,33--40 #: src/app/learnocaml_index_main.ml:727,33--40 #: src/app/learnocaml_index_main.ml:759,25--32 -#: src/app/learnocaml_index_main.ml:823,29--36 +#: src/app/learnocaml_index_main.ml:824,29--36 msgid "ERROR" msgstr "ERREUR" @@ -46,7 +46,7 @@ msgstr "ERREUR" #: src/app/learnocaml_index_main.ml:624,12--20 #: src/app/learnocaml_index_main.ml:644,12--20 #: src/app/learnocaml_index_main.ml:777,19--27 -#: src/app/learnocaml_index_main.ml:813,20--28 +#: src/app/learnocaml_index_main.ml:814,20--28 msgid "Cancel" msgstr "Annuler" @@ -54,7 +54,7 @@ msgstr "Annuler" #: src/app/learnocaml_index_main.ml:619,25--40 #: src/app/learnocaml_index_main.ml:639,25--40 #: src/app/learnocaml_index_main.ml:772,32--47 -#: src/app/learnocaml_index_main.ml:808,33--48 +#: src/app/learnocaml_index_main.ml:809,33--48 msgid "REQUEST ERROR" msgstr "ERREUR DE REQUÊTE" @@ -62,7 +62,7 @@ msgstr "ERREUR DE REQUÊTE" #: src/app/learnocaml_index_main.ml:620,26--63 #: src/app/learnocaml_index_main.ml:640,26--63 #: src/app/learnocaml_index_main.ml:773,30--67 -#: src/app/learnocaml_index_main.ml:809,34--71 +#: src/app/learnocaml_index_main.ml:810,34--71 msgid "Could not retrieve data from server" msgstr "Échec lors du téléchargement des données du serveur" @@ -71,7 +71,7 @@ msgstr "Échec lors du téléchargement des données du serveur" #: src/app/learnocaml_index_main.ml:623,12--19 #: src/app/learnocaml_index_main.ml:643,12--19 #: src/app/learnocaml_index_main.ml:776,19--26 -#: src/app/learnocaml_index_main.ml:812,20--27 +#: src/app/learnocaml_index_main.ml:813,20--27 msgid "Retry" msgstr "Réessayer" @@ -147,7 +147,7 @@ msgid "Editor" msgstr "Éditeur" #: src/app/learnocaml_common.ml:791,41--51 -#: src/app/learnocaml_index_main.ml:1054,30--40 +#: src/app/learnocaml_index_main.ml:1055,30--40 msgid "Toplevel" msgstr "Toplevel" @@ -185,7 +185,7 @@ msgstr "Statistiques" #: src/app/learnocaml_common.ml:803,37--48 #: src/app/learnocaml_exercise_main.ml:200,23--34 -#: src/app/learnocaml_index_main.ml:1051,29--40 +#: src/app/learnocaml_index_main.ml:1052,29--40 #: src/app/learnocaml_teacher_tab.ml:328,18--29 msgid "Exercises" msgstr "Exercices" @@ -231,7 +231,7 @@ msgid "Show" msgstr "Montrer" #: src/app/learnocaml_common.ml:1005,18--36 -#: src/app/learnocaml_index_main.ml:910,27--45 +#: src/app/learnocaml_index_main.ml:911,27--45 msgid "Enter the secret" msgstr "Entrez le secret" @@ -464,7 +464,7 @@ msgstr "Erreur inattendue :\n" #: src/app/learnocaml_lti_main.ml:92,15--48 #: src/app/learnocaml_index_main.ml:616,10--43 #: src/app/learnocaml_index_main.ml:718,19--52 -#: src/app/learnocaml_index_main.ml:823,41--74 +#: src/app/learnocaml_index_main.ml:824,41--74 msgid "The entered e-mail was invalid." msgstr "L'e-mail entré est invalide." @@ -497,41 +497,41 @@ msgid "A confirmation e-mail has been sent to your address." msgstr "Un courriel a été envoyé à votre adresse pour la confirmer." #: src/app/learnocaml_lti_main.ml:130,33--51 -#: src/app/learnocaml_index_main.ml:908,37--55 -#: src/app/learnocaml_index_main.ml:912,31--49 +#: src/app/learnocaml_index_main.ml:909,37--55 +#: src/app/learnocaml_index_main.ml:913,31--49 msgid "First connection" msgstr "Première connexion" #: src/app/learnocaml_lti_main.ml:131,39--55 #: src/app/learnocaml_lti_main.ml:143,32--48 -#: src/app/learnocaml_index_main.ml:913,37--53 -#: src/app/learnocaml_index_main.ml:922,30--46 +#: src/app/learnocaml_index_main.ml:914,37--53 +#: src/app/learnocaml_index_main.ml:923,30--46 #: src/app/learnocaml_upgrade_main.ml:26,32--48 msgid "E-mail address" msgstr "Adresse e-mail" #: src/app/learnocaml_lti_main.ml:132,42--52 -#: src/app/learnocaml_index_main.ml:914,40--50 -#: src/app/learnocaml_index_main.ml:947,9--19 +#: src/app/learnocaml_index_main.ml:915,40--50 +#: src/app/learnocaml_index_main.ml:948,9--19 #: src/app/learnocaml_teacher_tab.ml:557,22--32 msgid "Nickname" msgstr "Pseudonyme" #: src/app/learnocaml_lti_main.ml:133,42--52 #: src/app/learnocaml_lti_main.ml:144,35--45 -#: src/app/learnocaml_index_main.ml:915,40--50 -#: src/app/learnocaml_index_main.ml:923,33--43 +#: src/app/learnocaml_index_main.ml:916,40--50 +#: src/app/learnocaml_index_main.ml:924,33--43 #: src/app/learnocaml_upgrade_main.ml:27,35--45 msgid "Password" msgstr "Mot de passe" #: src/app/learnocaml_lti_main.ml:134,40--48 -#: src/app/learnocaml_index_main.ml:916,38--46 +#: src/app/learnocaml_index_main.ml:917,38--46 msgid "Secret" msgstr "Secret" #: src/app/learnocaml_lti_main.ml:135,29--198 -#: src/app/learnocaml_index_main.ml:917,27--192 +#: src/app/learnocaml_index_main.ml:918,27--192 msgid "" "The secret is an optional passphrase provided by your teacher. It may be " "required to create an account." @@ -540,7 +540,7 @@ msgstr "" "Celle-ci est alors requise pour s'inscrire." #: src/app/learnocaml_lti_main.ml:138,41--251 -#: src/app/learnocaml_index_main.ml:926,39--244 +#: src/app/learnocaml_index_main.ml:927,39--244 msgid "" "By submitting this form, I accept that the information entered will be used " "in the context of the Learn-OCaml plateform." @@ -549,29 +549,29 @@ msgstr "" "être utilisées dans le contexte de la plateforme Learn-OCaml." #: src/app/learnocaml_lti_main.ml:141,26--46 -#: src/app/learnocaml_index_main.ml:920,24--44 +#: src/app/learnocaml_index_main.ml:921,24--44 msgid "Create new account" msgstr "Créer un compte" #: src/app/learnocaml_lti_main.ml:142,26--42 -#: src/app/learnocaml_index_main.ml:921,24--40 +#: src/app/learnocaml_index_main.ml:922,24--40 msgid "Returning user" msgstr "Utilisateur existant" #: src/app/learnocaml_lti_main.ml:145,32--41 #: src/app/learnocaml_lti_main.ml:153,32--41 -#: src/app/learnocaml_index_main.ml:924,31--40 -#: src/app/learnocaml_index_main.ml:933,30--39 +#: src/app/learnocaml_index_main.ml:925,31--40 +#: src/app/learnocaml_index_main.ml:934,30--39 msgid "Connect" msgstr "Se connecter" #: src/app/learnocaml_lti_main.ml:146,32--55 -#: src/app/learnocaml_index_main.ml:925,30--53 +#: src/app/learnocaml_index_main.ml:926,30--53 msgid "Forgot your password?" msgstr "Mot de passe oublié ?" #: src/app/learnocaml_lti_main.ml:147,38--57 -#: src/app/learnocaml_index_main.ml:909,44--63 +#: src/app/learnocaml_index_main.ml:910,44--63 msgid "Choose a nickname" msgstr "Choisissez un identifiant" @@ -593,7 +593,7 @@ msgid "Reuse an account with a legacy token" msgstr "Réutiliser un compte avec un ancien token" #: src/app/learnocaml_lti_main.ml:155,32--39 -#: src/app/learnocaml_index_main.ml:932,30--37 +#: src/app/learnocaml_index_main.ml:933,30--37 #: src/app/learnocaml_teacher_tab.ml:559,22--29 msgid "Token" msgstr "Token" @@ -729,12 +729,12 @@ msgid "The entered e-mail is invalid: " msgstr "L'e-mail entré est invalide." #: src/app/learnocaml_index_main.ml:768,28--45 -#: src/app/learnocaml_index_main.ml:804,29--46 +#: src/app/learnocaml_index_main.ml:805,29--46 msgid "TOKEN NOT FOUND" msgstr "TOKEN NON TROUVÉ" #: src/app/learnocaml_index_main.ml:769,17--60 -#: src/app/learnocaml_index_main.ml:805,18--61 +#: src/app/learnocaml_index_main.ml:806,18--61 msgid "The entered token couldn't be recognized." msgstr "Le token entré n'a pas été reconnu." @@ -742,106 +742,105 @@ msgstr "Le token entré n'a pas été reconnu." msgid "INVALID TOKEN" msgstr "TOKEN INVALIDE" -#: src/app/learnocaml_index_main.ml:792,31--200 +#: src/app/learnocaml_index_main.ml:792,31--244 +#, fuzzy msgid "" -"This token is associated to an upgraded account, which only allows password-" -"based%s authentication." -msgstr "" -"Ce token est associé à un compte, autorisant uniquement l'authentification " -"par mot de passe%s." +"This token is invalid, or associated to an upgraded account that only allows " +"password-based%s authentication." +msgstr "Ce token est invalide, ou associé à un compte autorisant uniquement l'authentification par mot de passe%s." -#: src/app/learnocaml_index_main.ml:795,54--70 +#: src/app/learnocaml_index_main.ml:796,54--70 msgid " or Moodle/LTI" msgstr " ou avec Moodle/LTI" -#: src/app/learnocaml_index_main.ml:903,7--21 +#: src/app/learnocaml_index_main.ml:904,7--21 msgid "Connected as" msgstr "Connecté en tant que" -#: src/app/learnocaml_index_main.ml:905,7--19 +#: src/app/learnocaml_index_main.ml:906,7--19 msgid "Activities" msgstr "Activités" -#: src/app/learnocaml_index_main.ml:907,9--33 +#: src/app/learnocaml_index_main.ml:908,9--33 msgid "Welcome to Learn OCaml" msgstr "Bienvenue sur Learn OCaml" -#: src/app/learnocaml_index_main.ml:911,24--42 +#: src/app/learnocaml_index_main.ml:912,24--42 msgid "Create new token" msgstr "Nouveau token" -#: src/app/learnocaml_index_main.ml:930,41--68 +#: src/app/learnocaml_index_main.ml:931,41--68 msgid "Login with a legacy token" msgstr "Connexion avec un ancien token" -#: src/app/learnocaml_index_main.ml:931,41--61 +#: src/app/learnocaml_index_main.ml:932,41--61 msgid "Login with a token" msgstr "Connexion avec un token" -#: src/app/learnocaml_index_main.ml:934,22--40 +#: src/app/learnocaml_index_main.ml:935,22--40 #: src/app/learnocaml_upgrade_main.ml:25,26--44 msgid "Setup a password" msgstr "Définir un mot de passe" -#: src/app/learnocaml_index_main.ml:936,33--183 +#: src/app/learnocaml_index_main.ml:937,33--183 msgid "" "Or you may want to login directly from Moodle (ask your teacher for details)" msgstr "" "Ou vous pouvez vous connecter directement depuis Moodle (demandez à votre " "enseignant pour plus de détails)" -#: src/app/learnocaml_index_main.ml:981,38--59 +#: src/app/learnocaml_index_main.ml:982,38--59 msgid "Choose an activity." msgstr "Sélectionnez une activité." -#: src/app/learnocaml_index_main.ml:1007,31--51 +#: src/app/learnocaml_index_main.ml:1008,31--51 msgid "New e-mail address" msgstr "Nouvelle adresse e-mail" -#: src/app/learnocaml_index_main.ml:1008,22--54 +#: src/app/learnocaml_index_main.ml:1009,22--54 msgid "Enter your new e-mail address:" msgstr "Entrez votre nouvelle adresse e-mail :" -#: src/app/learnocaml_index_main.ml:1026,20--37 -#: src/app/learnocaml_index_main.ml:1029,20--37 -#: src/app/learnocaml_index_main.ml:1031,20--37 +#: src/app/learnocaml_index_main.ml:1027,20--37 +#: src/app/learnocaml_index_main.ml:1030,20--37 +#: src/app/learnocaml_index_main.ml:1032,20--37 msgid "Change password" msgstr "Changer de mot de passe" -#: src/app/learnocaml_index_main.ml:1027,20--41 +#: src/app/learnocaml_index_main.ml:1028,20--41 msgid "Abort e-mail change" msgstr "Annuler le changement d'e-mail" -#: src/app/learnocaml_index_main.ml:1032,20--35 +#: src/app/learnocaml_index_main.ml:1033,20--35 msgid "Change e-mail" msgstr "Changer d'adresse e-mail" -#: src/app/learnocaml_index_main.ml:1047,30--41 +#: src/app/learnocaml_index_main.ml:1048,30--41 msgid "Try OCaml" msgstr "Try OCaml" -#: src/app/learnocaml_index_main.ml:1049,29--38 +#: src/app/learnocaml_index_main.ml:1050,29--38 msgid "Lessons" msgstr "Cours" -#: src/app/learnocaml_index_main.ml:1056,32--44 +#: src/app/learnocaml_index_main.ml:1057,32--44 #: src/app/learnocaml_playground_main.ml:72,23--35 msgid "Playground" msgstr "Bac-à-sable" -#: src/app/learnocaml_index_main.ml:1059,28--35 +#: src/app/learnocaml_index_main.ml:1060,28--35 msgid "Teach" msgstr "Enseignement" -#: src/app/learnocaml_index_main.ml:1159,17--71 +#: src/app/learnocaml_index_main.ml:1160,17--71 msgid "Be sure to write down your token before logging out:" msgstr "Assurez-vous d'avoir noté votre token :" -#: src/app/learnocaml_index_main.ml:1161,17--51 +#: src/app/learnocaml_index_main.ml:1162,17--51 msgid "Are you sure you want to logout?" msgstr "Êtes-vous sûr de vouloir vous déconnecter ?" -#: src/app/learnocaml_index_main.ml:1163,15--186 +#: src/app/learnocaml_index_main.ml:1164,15--186 msgid "" "WARNING: the data could not be synchronised with the server. Logging out " "will lose your local changes, be sure you exported a backup." @@ -850,37 +849,37 @@ msgstr "" "En vous déconnectant, vous perdrez tous les changements locaux, à moins " "d'avoir exporté votre espace de travail au préalable." -#: src/app/learnocaml_index_main.ml:1174,22--30 -#: src/app/learnocaml_index_main.ml:1174,45--53 -#: src/app/learnocaml_index_main.ml:1196,9--17 +#: src/app/learnocaml_index_main.ml:1175,22--30 +#: src/app/learnocaml_index_main.ml:1175,45--53 +#: src/app/learnocaml_index_main.ml:1197,9--17 msgid "Logout" msgstr "Déconnexion" -#: src/app/learnocaml_index_main.ml:1187,15--27 +#: src/app/learnocaml_index_main.ml:1188,15--27 msgid "Show login" msgstr "Afficher votre login" -#: src/app/learnocaml_index_main.ml:1188,15--27 +#: src/app/learnocaml_index_main.ml:1189,15--27 msgid "Show token" msgstr "Afficher le token" -#: src/app/learnocaml_index_main.ml:1190,9--25 +#: src/app/learnocaml_index_main.ml:1191,9--25 msgid "Sync workspace" msgstr "Synchroniser" -#: src/app/learnocaml_index_main.ml:1193,9--25 +#: src/app/learnocaml_index_main.ml:1194,9--25 msgid "Export to file" msgstr "Exporter vers un fichier" -#: src/app/learnocaml_index_main.ml:1194,9--17 +#: src/app/learnocaml_index_main.ml:1195,9--17 msgid "Import" msgstr "Importer" -#: src/app/learnocaml_index_main.ml:1195,9--36 +#: src/app/learnocaml_index_main.ml:1196,9--36 msgid "Download all source files" msgstr "Télécharger tous les fichiers sources" -#: src/app/learnocaml_index_main.ml:1201,38--44 +#: src/app/learnocaml_index_main.ml:1202,38--44 msgid "Menu" msgstr "Menu" From 59b49e0b71d63b228efbd6db93cce73518be6d7b Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Sat, 19 Sep 2020 19:50:25 +0200 Subject: [PATCH 148/161] fix: docker-compose networks * Make all networks explicit (learnocaml-net & moodle-net), so that docker-compose does not create the "learn-ocaml_default" network. --- docker-compose.yml | 33 +++++++++------------------------ 1 file changed, 9 insertions(+), 24 deletions(-) diff --git a/docker-compose.yml b/docker-compose.yml index c179e9aeb..26cd61c6e 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -30,30 +30,6 @@ services: networks: - learnocaml-net restart: unless-stopped - networks: - - learnocaml-net - -# To uncomment for prod, see also: -# https://github.com/pfitaxel/docker-learn-ocaml/blob/master/docker-compose.yml -# -# postfix: -# container_name: postfix -# image: juanluisbaptiste/postfix -# environment: -# # (postfix variables) remote MTA credentials: -# SMTP_SERVER: "smtp.example.com" -# SMTP_USERNAME: "user@example.com" -# SMTP_PASSWORD_FILE: "/secrets/smtp_password" -# # (postfix variable) DNS of myself, the server sending mails: -# SERVER_HOSTNAME: "mail.localdomain" -# ALWAYS_ADD_MISSING_HEADERS: "yes" -# volumes: -# - "./secrets:/secrets" -# # DO NOT EXPOSE THESE PORTS! -# # ports: -# # - "25:25" -# networks: -# - learnocaml-net # Only useful for dev maildev: @@ -63,6 +39,9 @@ services: networks: - learnocaml-net +# For a prod configuration, see also: +# https://github.com/pfitaxel/docker-learn-ocaml/blob/master/docker-compose.yml + # BEGIN https://github.com/bitnami/bitnami-docker-moodle/blob/ffa8007ebb0ebc501eeeba62804d10b0efef3673/docker-compose.yml mariadb: @@ -73,6 +52,8 @@ services: - MARIADB_DATABASE=bitnami_moodle volumes: - 'mariadb_data:/bitnami/mariadb' + networks: + - moodle-net moodle: image: 'docker.io/bitnami/moodle:3-debian-10' ports: @@ -88,6 +69,8 @@ services: volumes: - 'moodle_data:/bitnami/moodle' - 'moodledata_data:/bitnami/moodledata' + networks: + - moodle-net depends_on: - mariadb @@ -107,3 +90,5 @@ networks: learnocaml-net: driver: bridge name: localdomain + moodle-net: + driver: bridge From dfe64ae15e015b524cdeb503efd1e37c7de06268 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Mon, 21 Sep 2020 12:30:36 +0200 Subject: [PATCH 149/161] fix(static): path of /icons/tryocaml_loading_*.gif --- static/exercise.html | 2 +- static/partition-view.html | 2 +- static/playground.html | 2 +- static/student-view.html | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/static/exercise.html b/static/exercise.html index 4f7fa580a..0a9ca9f29 100644 --- a/static/exercise.html +++ b/static/exercise.html @@ -33,7 +33,7 @@
    diff --git a/static/partition-view.html b/static/partition-view.html index beda4f4d1..7b4697c2a 100644 --- a/static/partition-view.html +++ b/static/partition-view.html @@ -33,7 +33,7 @@
    diff --git a/static/playground.html b/static/playground.html index fe7c7923c..e45d912c0 100644 --- a/static/playground.html +++ b/static/playground.html @@ -32,7 +32,7 @@
    diff --git a/static/student-view.html b/static/student-view.html index e274a1172..14ad779f3 100644 --- a/static/student-view.html +++ b/static/student-view.html @@ -33,7 +33,7 @@
    From 2df35d30db21b6a71e0091b633d64f9423c1a403 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Tue, 22 Sep 2020 21:05:59 +0200 Subject: [PATCH 150/161] fix(token_index): mutex issue * Make IndexRW.read use the mutex argument; * Use Lwt_mutex.with_lock (and Lwt_io.with_file) that behave better than Lwt_mutex.lock when a failure occurs => the mutex is unlocked. --- src/state/token_index.ml | 48 ++++++++++++++++++++------------------- src/state/token_index.mli | 2 +- 2 files changed, 26 insertions(+), 24 deletions(-) diff --git a/src/state/token_index.ml b/src/state/token_index.ml index 4f49276da..3b2935aa8 100644 --- a/src/state/token_index.ml +++ b/src/state/token_index.ml @@ -41,7 +41,7 @@ module type IndexRW = sig type t val init : unit -> t - val read : string -> (string -> 'a) -> 'a Lwt.t + val read : t -> string -> (string -> 'a) -> 'a Lwt.t val write : t -> string -> ('a -> string) -> 'a -> unit Lwt.t end @@ -51,19 +51,21 @@ module IndexFile: IndexRW = struct (* Unlocked by default *) let init = Lwt_mutex.create - let read filename parse = - Lwt_io.open_file ~mode:Lwt_io.Input filename >>= fun channel -> - Lwt_io.read channel >>= fun data -> - Lwt_io.close channel >>= fun () -> - Lwt.return @@ parse data + let read mutex filename parse = + Lwt_mutex.with_lock mutex @@ + fun () -> + Lwt_io.with_file ~mode:Lwt_io.Input filename @@ + fun channel -> + Lwt_io.read channel >>= fun data -> + Lwt.return @@ parse data let write mutex filename serialise data = - Lwt_mutex.lock mutex >>= fun () -> - Lwt_utils.mkdir_p ~perm:0o700 (Filename.dirname filename) >>= fun () -> - Lwt_io.open_file ~mode:Lwt_io.Output filename >>= fun channel -> - Lwt_io.write channel (serialise data) >>= fun () -> - Lwt_io.close channel >>= fun () -> - Lwt.return @@ Lwt_mutex.unlock mutex + Lwt_mutex.with_lock mutex @@ + fun () -> + Lwt_utils.mkdir_p ~perm:0o700 (Filename.dirname filename) >>= fun () -> + Lwt_io.with_file ~mode:Lwt_io.Output filename @@ + fun channel -> + Lwt_io.write channel (serialise data) end (* inspired from learnocaml_data.ml *) @@ -127,10 +129,10 @@ module BaseTokenIndex (RW: IndexRW) = struct let filename = (sync_dir / indexes_subdir / name) in let create () = create_index sync_dir >>= fun () -> - RW.read filename parse in + RW.read rw filename parse in if Sys.file_exists filename then Lwt.catch - (fun () -> RW.read filename parse) + (fun () -> RW.read rw filename parse) (fun _exn -> (* Note: this error handler may be adapted later to be more conservative? it does not matter now as sync/data/token.json is not a critical file, and @@ -166,7 +168,7 @@ module BaseMoodleIndex (RW: IndexRW) = struct let get_users sync_dir = Lwt.catch - (fun () -> RW.read (sync_dir / indexes_subdir / file) parse) + (fun () -> RW.read rw (sync_dir / indexes_subdir / file) parse) (fun _exn -> Lwt.return []) let user_exists sync_dir id = @@ -213,7 +215,7 @@ module BaseOauthIndex (RW: IndexRW) = struct (secret, []) in Lwt.catch (fun () -> - RW.read (sync_dir / indexes_subdir / file) parse >>= function + RW.read rw (sync_dir / indexes_subdir / file) parse >>= function | oauth :: _ -> Lwt.return oauth | [] -> create ()) (fun _exn -> create ()) @@ -227,7 +229,7 @@ module BaseOauthIndex (RW: IndexRW) = struct RW.write rw (sync_dir / indexes_subdir / file) serialise [oauth] let add_nonce sync_dir nonce = - RW.read (sync_dir / indexes_subdir / file) parse >>= fun oauth -> + RW.read rw (sync_dir / indexes_subdir / file) parse >>= fun oauth -> let oauth = match oauth with | (secret, nonces) :: r -> (secret, nonce :: nonces) :: r @@ -369,7 +371,7 @@ module BaseUserIndex (RW: IndexRW) = struct let get_data sync_dir = Lwt.catch - (fun () -> RW.read (sync_dir / indexes_subdir / file) parse) + (fun () -> RW.read rw (sync_dir / indexes_subdir / file) parse) (fun _exn -> create_index sync_dir) let authenticate sync_dir auth = @@ -473,14 +475,14 @@ module BaseUserIndex (RW: IndexRW) = struct found_token = token && not use_passwd) users <> None let token_of_email sync_dir email = - RW.read (sync_dir / indexes_subdir / file) parse >|= + RW.read rw (sync_dir / indexes_subdir / file) parse >|= List.fold_left (fun res elt -> match res, elt with | None, Password (token, found_email, _, _) when found_email = email -> Some token | _ -> res) None let emails_of_token sync_dir token = - RW.read (sync_dir / indexes_subdir / file) parse >|= + RW.read rw (sync_dir / indexes_subdir / file) parse >|= List.fold_left (fun res elt -> match res, elt with | None, Password (found_token, email, _, pending) when found_token = token -> @@ -492,7 +494,7 @@ module BaseUserIndex (RW: IndexRW) = struct if exists then logfailwith "BaseUserIndex.change_email: duplicate email" new_email) >>= fun () -> - RW.read (sync_dir / indexes_subdir / file) parse >|= + RW.read rw (sync_dir / indexes_subdir / file) parse >|= List.map (function | Password (found_token, email, passwd, _) when found_token = token -> Password (found_token, email, passwd, Some new_email) @@ -500,7 +502,7 @@ module BaseUserIndex (RW: IndexRW) = struct RW.write rw (sync_dir / indexes_subdir / file) serialise let abort_email_change sync_dir token = - RW.read (sync_dir / indexes_subdir / file) parse >|= + RW.read rw (sync_dir / indexes_subdir / file) parse >|= List.map (function | Password (found_token, email, passwd, Some pending) when found_token = token && email <> pending -> @@ -537,7 +539,7 @@ module BaseUpgradeIndex (RW: IndexRW) = struct let get_data sync_dir = Lwt.catch - (fun () -> RW.read (sync_dir / indexes_subdir / file) parse) + (fun () -> RW.read rw (sync_dir / indexes_subdir / file) parse) (fun _exn -> create_index sync_dir) let create_upgrade_operation kind sync_dir token = diff --git a/src/state/token_index.mli b/src/state/token_index.mli index b2430d4f8..e562c3f68 100644 --- a/src/state/token_index.mli +++ b/src/state/token_index.mli @@ -13,7 +13,7 @@ module type IndexRW = sig type t val init : unit -> t - val read : string -> (string -> 'a) -> 'a Lwt.t + val read : t -> string -> (string -> 'a) -> 'a Lwt.t val write : t -> string -> ('a -> string) -> 'a -> unit Lwt.t end From ab2f47d9a1959a14d899ed47b72b24c0a5dbd0df Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20Segond?= Date: Thu, 6 May 2021 00:08:00 +0200 Subject: [PATCH 151/161] fix: bug introduced by the merge --- src/main/learnocaml_server_main.ml | 2 +- src/server/learnocaml_server.ml | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/main/learnocaml_server_main.ml b/src/main/learnocaml_server_main.ml index 39096d4dd..213e42d1c 100644 --- a/src/main/learnocaml_server_main.ml +++ b/src/main/learnocaml_server_main.ml @@ -22,7 +22,7 @@ let signal_waiter = waiter let main o = - Printf.printf "ROOT_URL: \"%s\"\n%!" o.root_url; + Printf.printf "ROOT_URL: \"%s\"\n%!" o.base_url; Printf.printf "Learnocaml server v.%s starting on port %d\n%!" Learnocaml_api.version o.port; if o.base_url <> "" then diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index bb80a4c31..79e897a14 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -1166,7 +1166,7 @@ let launch () = then Server.respond ~status:`Not_modified ~body:Cohttp_lwt.Body.empty () else (match req.Request.meth with - | `GET -> lwt_ok {Api.meth = `GET; host = !root_url; path; args} + | `GET -> lwt_ok {Api.meth = `GET; host = !base_url; path; args} | `POST -> begin Cohttp_lwt.Body.to_string body @@ -1180,11 +1180,11 @@ let launch () = List.assoc_opt "csrf" cookies with | Some (param_csrf :: _), Some cookie_csrf -> if Eqaf.equal param_csrf cookie_csrf then - lwt_ok {Api.meth = `POST params; host = !root_url; path; args} + lwt_ok {Api.meth = `POST params; host = !base_url; path; args} else lwt_fail (`Forbidden, "CSRF token mismatch") | None, None | None, Some _ -> - lwt_ok {Api.meth = `POST params; host = !root_url; path; args} + lwt_ok {Api.meth = `POST params; host = !base_url; path; args} | _, _ -> lwt_fail (`Forbidden, "Bad CSRF token") end From 65bbf461fe0ea464223de2086afd9582ea2f35de Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20Segond?= Date: Thu, 6 May 2021 00:09:00 +0200 Subject: [PATCH 152/161] fix: correct Docker and txt_token_secret --- Dockerfile | 4 ++-- src/app/learnocaml_index_main.ml | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/Dockerfile b/Dockerfile index bd280f5ad..62e2e47aa 100644 --- a/Dockerfile +++ b/Dockerfile @@ -31,7 +31,7 @@ RUN opam install . --destdir /home/opam/install-prefix --locked FROM alpine:3.13 as client RUN apk update \ - && apk add ncurses-libs libev dumb-init openssl \ + && apk add ncurses-libs libev gmp dumb-init msmtp git openssl \ && addgroup learn-ocaml \ && adduser learn-ocaml -DG learn-ocaml @@ -53,7 +53,7 @@ LABEL org.opencontainers.image.vendor="The OCaml Software Foundation" FROM alpine:3.13 as program RUN apk update \ - && apk add ncurses-libs libev dumb-init git openssl \ + && apk add ncurses-libs libev gmp dumb-init msmtp git openssl \ && addgroup learn-ocaml \ && adduser learn-ocaml -DG learn-ocaml diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index f273106a3..31a3a5f61 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -908,7 +908,7 @@ let set_string_translations () = [%i"Welcome to Learn OCaml"]; "txt_token_first_connection", [%i"First connection"]; "txt_token_first_connection_dialog", [%i"Choose a nickname"]; - "txt_token_secret", [%i"Enter the secret"]; + "txt_first_connection_secret", [%i"Enter the secret"]; "txt_token_new", [%i"Create new token"]; "txt_first_connection", [%i"First connection"]; "txt_first_connection_email", [%i"E-mail address"]; From 9ec9f9f05f850108036017831ddf8ab7d7ddb416 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Thu, 6 May 2021 00:12:07 +0200 Subject: [PATCH 153/161] fix: Remove unneeded apk packages from learn-ocaml-client image --- Dockerfile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/Dockerfile b/Dockerfile index 62e2e47aa..cb1a8c698 100644 --- a/Dockerfile +++ b/Dockerfile @@ -31,7 +31,7 @@ RUN opam install . --destdir /home/opam/install-prefix --locked FROM alpine:3.13 as client RUN apk update \ - && apk add ncurses-libs libev gmp dumb-init msmtp git openssl \ + && apk add ncurses-libs libev dumb-init openssl \ && addgroup learn-ocaml \ && adduser learn-ocaml -DG learn-ocaml From 8f8bf7f70ae7b7792902b862a45d0c3d98a23312 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Fri, 7 May 2021 20:08:25 +0200 Subject: [PATCH 154/161] docs: Document the long time required by the first run of moodle --- docker-compose.yml | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/docker-compose.yml b/docker-compose.yml index 26cd61c6e..7de190982 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -2,6 +2,13 @@ # To deploy learn-ocaml, see e.g.: # https://github.com/pfitaxel/docker-learn-ocaml/blob/master/docker-compose.yml +# Note: regarding the very first run (sudo docker-compose up --build), +# the setup of the moodle container ("Running Moodle install script") +# may take a long time (up to 18'). +# Do NOT stop the docker-compose app too early, otherwise the database +# would be in a broken state, leading to a systematic error at further +# runs ("learn-ocaml_moodle_1 exited with code 1"). + version: '3.7' services: @@ -50,6 +57,7 @@ services: - ALLOW_EMPTY_PASSWORD=yes - MARIADB_USER=bn_moodle - MARIADB_DATABASE=bitnami_moodle + # - BITNAMI_DEBUG=true volumes: - 'mariadb_data:/bitnami/mariadb' networks: @@ -66,6 +74,7 @@ services: - MOODLE_DATABASE_USER=bn_moodle - MOODLE_DATABASE_NAME=bitnami_moodle - ALLOW_EMPTY_PASSWORD=yes + # - BITNAMI_DEBUG=true volumes: - 'moodle_data:/bitnami/moodle' - 'moodledata_data:/bitnami/moodledata' From 28cd64b9de980cd812d9b65db9be5e02a270fe98 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Mon, 10 May 2021 12:24:40 +0200 Subject: [PATCH 155/161] fix: Moodle/LTI authentication was broken, not using the full URL --- docker-compose.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/docker-compose.yml b/docker-compose.yml index 7de190982..d4734708b 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -20,7 +20,7 @@ services: - '8080:8080' environment: # (ocaml variable) root URL: - LEARNOCAML_ROOT_URL: "http://localhost:8080" + LEARNOCAML_BASE_URL: "http://localhost:8080" # (ocaml variable) .: FROM_DOMAIN: "backend.localdomain" # (alpine msmtp variable) hostname of the SMTP server: From 60bf26407bcbd5733f567c479d01eefe59bf0343 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20Segond?= Date: Wed, 26 May 2021 14:58:05 +0200 Subject: [PATCH 156/161] feat: add password confirmation lti + index --- src/app/learnocaml_index_main.ml | 16 ++++++++++++++-- src/app/learnocaml_lti_main.ml | 15 +++++++++++++-- src/app/learnocaml_upgrade_main.ml | 1 + static/index.html | 5 +++++ static/lti.html | 5 +++++ static/upgrade.html | 5 +++++ 6 files changed, 43 insertions(+), 4 deletions(-) diff --git a/src/app/learnocaml_index_main.ml b/src/app/learnocaml_index_main.ml index 31a3a5f61..3e08a9e92 100644 --- a/src/app/learnocaml_index_main.ml +++ b/src/app/learnocaml_index_main.ml @@ -56,6 +56,7 @@ module El = struct let reg_input_email_id, reg_input_email = id "register-email-input" let reg_input_nick_id, reg_input_nick = id "register-nick-input" let reg_input_password_id, reg_input_password = id "register-password-input" + let reg_input_confirmation_id, reg_input_confirmation = id "register-confirmation-input" let input_secret_id, input_secret = id "register-secret-input" let input_consent_id, input_consent = id "first-connection-consent" let button_new_id, button_new = id "login-new-button" @@ -697,20 +698,25 @@ let init_token_dialog () = if get_opt config##.enablePasswd then let email = Manip.value reg_input_email and password = Manip.value reg_input_password and + password_confirmation = Manip.value reg_input_confirmation and consent = Manip.checked input_consent and consent_label = find_component "txt_first_connection_consent" in let email_criteria = not (check_email_js email) and passwd_crit1 = not (Learnocaml_data.passwd_check_length password) and - passwd_crit2 = not (Learnocaml_data.passwd_check_strength password) in + passwd_crit2 = not (Learnocaml_data.passwd_check_strength password) and + passwd_crit3 = not (password = password_confirmation) in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; + Manip.SetCss.borderColor reg_input_confirmation ""; Manip.SetCss.fontWeight consent_label ""; - if email_criteria || passwd_crit1 || passwd_crit2 || not consent then + if email_criteria || passwd_crit1 || passwd_crit2 || passwd_crit3 || not consent then begin if email_criteria then Manip.SetCss.borderColor reg_input_email "#f44"; if passwd_crit1 || passwd_crit2 then Manip.SetCss.borderColor reg_input_password "#f44"; + if passwd_crit3 then + Manip.SetCss.borderColor reg_input_confirmation "#f44"; if not consent then Manip.SetCss.fontWeight consent_label "bold"; if email_criteria then begin @@ -729,6 +735,11 @@ let init_token_dialog () = one lower and upper letter, \ and one non-alphanumeric char."] (fun () -> Manip.focus reg_input_password) + end + else if passwd_crit3 then begin + cb_alert ~title:[%i"ERROR"] + [%i"The password and its confirmation are not the same"] + (fun () -> Manip.focus reg_input_confirmation) end; Lwt.return_none end @@ -914,6 +925,7 @@ let set_string_translations () = "txt_first_connection_email", [%i"E-mail address"]; "txt_first_connection_nickname", [%i"Nickname"]; "txt_first_connection_password", [%i"Password"]; + "txt_first_connection_confirmation", [%i"Password confirmation"]; "txt_first_connection_secret", [%i"Secret"]; "txt_secret_label", [%i"The secret is an optional passphrase \ provided by your teacher. It may be \ diff --git a/src/app/learnocaml_lti_main.ml b/src/app/learnocaml_lti_main.ml index d7415e42f..b965a0ad0 100644 --- a/src/app/learnocaml_lti_main.ml +++ b/src/app/learnocaml_lti_main.ml @@ -29,6 +29,7 @@ let login_returning_id, login_returning = id "login-returning" let reg_input_email_id, reg_input_email = id "register-email-input" let reg_input_nick_id, reg_input_nick = id "register-nick-input" let reg_input_password_id, reg_input_password = id "register-password-input" +let reg_input_confirmation_id, reg_input_confirmation = id "register-confirmation-input" let input_secret_id, input_secret = id "register-secret-input" let input_consent_id, input_consent = id "first-connection-consent" let login_new_button_id, login_new_button = id "login-new-button" @@ -70,21 +71,25 @@ let send_sync_request () = let create_token () = let email = Manip.value reg_input_email and password = Manip.value reg_input_password and + password_confirmation = Manip.value reg_input_confirmation and consent = Manip.checked input_consent and consent_label = find_component "txt_first_connection_consent" in (* 5 for a character, @, character, dot, character. *) let email_criteria = not (check_email_js email) and passwd_crit1 = not (Learnocaml_data.passwd_check_length password) and - passwd_crit2 = not (Learnocaml_data.passwd_check_strength password) in + passwd_crit2 = not (Learnocaml_data.passwd_check_strength password) and + passwd_crit3 = not (password = password_confirmation) in Manip.SetCss.borderColor reg_input_email ""; Manip.SetCss.borderColor reg_input_password ""; Manip.SetCss.fontWeight consent_label ""; - if email_criteria || passwd_crit1 || passwd_crit2 || not consent then + if email_criteria || passwd_crit1 || passwd_crit2 || passwd_crit3 || not consent then begin if email_criteria then Manip.SetCss.borderColor reg_input_email "#f44"; if passwd_crit1 || passwd_crit2 then Manip.SetCss.borderColor reg_input_password "#f44"; + if passwd_crit3 then + Manip.SetCss.borderColor reg_input_confirmation "#f44"; if not consent then Manip.SetCss.fontWeight consent_label "bold"; if email_criteria then begin @@ -102,6 +107,11 @@ let create_token () = [%i"Password must contain at least one digit, \ one lower and upper letter, \ and one non-alphanumeric char."]; + end + else if passwd_crit3 then begin + cb_alert ~title:[%i"ERROR"] + [%i"The password and its confirmation are not the same"] + (fun () -> Manip.focus reg_input_confirmation) end; Lwt.return_unit end @@ -131,6 +141,7 @@ let () = "txt_first_connection_email", [%i"E-mail address"]; "txt_first_connection_nickname", [%i"Nickname"]; "txt_first_connection_password", [%i"Password"]; + "txt_first_connection_confirmation", [%i"Password confirmation"]; "txt_first_connection_secret", [%i"Secret"]; "txt_secret_label", [%i"The secret is an optional passphrase \ provided by your teacher. It may be \ diff --git a/src/app/learnocaml_upgrade_main.ml b/src/app/learnocaml_upgrade_main.ml index a9e791fc3..c1012056f 100644 --- a/src/app/learnocaml_upgrade_main.ml +++ b/src/app/learnocaml_upgrade_main.ml @@ -25,6 +25,7 @@ let () = "txt_upgrade", [%i"Setup a password"]; "txt_upgrade_email", [%i"E-mail address"]; "txt_upgrade_password", [%i"Password"]; + (*"txt_upgrade_password_confirmation", [%i"Confirm password"];*) "txt_do_upgrade", [%i"Upgrade"]; "txt_info", [%i"An e-mail will be sent to your address to confirm it."]; ] diff --git a/static/index.html b/static/index.html index c5b016cc1..fc4a4cd1d 100644 --- a/static/index.html +++ b/static/index.html @@ -126,6 +126,11 @@

    +
    +
    +
    + +
    diff --git a/static/lti.html b/static/lti.html index 6b9930aff..b8b11adf4 100644 --- a/static/lti.html +++ b/static/lti.html @@ -67,6 +67,11 @@

    +
    +
    +
    + +
    diff --git a/static/upgrade.html b/static/upgrade.html index f90730f29..eccf9c45c 100644 --- a/static/upgrade.html +++ b/static/upgrade.html @@ -33,6 +33,11 @@

    +
      • From 55908ab1aec7cd9392cd575ef6259a39c451faa8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20Segond?= Date: Mon, 31 May 2021 14:21:57 +0200 Subject: [PATCH 157/161] feat: add password confirmation moodle->define password --- src/app/learnocaml_upgrade_main.ml | 2 +- src/server/learnocaml_server.ml | 6 ++++-- static/upgrade.html | 8 ++++---- 3 files changed, 9 insertions(+), 7 deletions(-) diff --git a/src/app/learnocaml_upgrade_main.ml b/src/app/learnocaml_upgrade_main.ml index c1012056f..65f55065d 100644 --- a/src/app/learnocaml_upgrade_main.ml +++ b/src/app/learnocaml_upgrade_main.ml @@ -25,7 +25,7 @@ let () = "txt_upgrade", [%i"Setup a password"]; "txt_upgrade_email", [%i"E-mail address"]; "txt_upgrade_password", [%i"Password"]; - (*"txt_upgrade_password_confirmation", [%i"Confirm password"];*) + "txt_upgrade_password_confirmation", [%i"Confirm password"]; "txt_do_upgrade", [%i"Upgrade"]; "txt_info", [%i"An e-mail will be sent to your address to confirm it."]; ] diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index 79e897a14..dff42fd83 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -942,12 +942,14 @@ module Request_handler = struct ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and email = List.assoc "email" params and - password = List.assoc "passwd" params in + password = List.assoc "passwd" params and + confirmation = List.assoc "confirmation" params in Token_index.UserIndex.exists !sync_dir email >>= fun exists -> if exists then lwt_fail (`Forbidden, "E-mail already used") else if not (Learnocaml_data.passwd_check_length password) || not (Learnocaml_data.passwd_check_strength password) - || not (check_email_ml email) then + || not (check_email_ml email) + || not (password = confirmation) then lwt_ok @@ Redirect { code=`See_other; url="/upgrade"; cookies } else let cookies = make_cookie ("token", Token.to_string token) :: cookies in diff --git a/static/upgrade.html b/static/upgrade.html index eccf9c45c..27a14c1ff 100644 --- a/static/upgrade.html +++ b/static/upgrade.html @@ -33,11 +33,11 @@

    -
    - -
    --> + +
      • From 0da0be2129eb96df01fc91448f8ee20ea587ef76 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20Segond?= Date: Tue, 1 Jun 2021 11:09:18 +0200 Subject: [PATCH 158/161] fix: secret label --- static/index.html | 6 +++--- static/lti.html | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/static/index.html b/static/index.html index fc4a4cd1d..0af08be94 100644 --- a/static/index.html +++ b/static/index.html @@ -131,12 +131,12 @@

    -
    +
    - + +
    -
    diff --git a/static/lti.html b/static/lti.html index b8b11adf4..5597f3063 100644 --- a/static/lti.html +++ b/static/lti.html @@ -72,10 +72,10 @@

    -
    +
    - +
    From 1ecf98c84c0b5f7cac1ca69c4e5d120433f3923e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?L=C3=A9o=20Segond?= Date: Wed, 9 Jun 2021 08:58:46 +0200 Subject: [PATCH 159/161] feat: add confirmation password on moodle account and add module for server_config --- src/app/learnocaml_upgrade_main.ml | 93 +++++++++++++++++++++++++++++- src/main/learnocaml_client.ml | 30 +++++++++- src/server/learnocaml_server.ml | 44 +++++--------- src/state/learnocaml_api.ml | 16 ++++- src/state/learnocaml_api.mli | 3 + static/upgrade.html | 54 +++++++++-------- 6 files changed, 179 insertions(+), 61 deletions(-) diff --git a/src/app/learnocaml_upgrade_main.ml b/src/app/learnocaml_upgrade_main.ml index 65f55065d..08c228a7c 100644 --- a/src/app/learnocaml_upgrade_main.ml +++ b/src/app/learnocaml_upgrade_main.ml @@ -6,7 +6,97 @@ * included LICENSE file for details. *) open Js_utils +open Lwt open Learnocaml_common +open Learnocaml_api + +module El = struct + let id s = s, find_component s + module Login_overlay = struct + let login_overlay_id, login_overlay = id "login-overlay" + let login_new_id, login_new = id "login-new" + + let upgrade_email_id, upgrade_email = id "upgrade-email-input" + let upgrade_password_id, upgrade_password = id "upgrade-password-input" + let upgrade_confirmation_id, upgrade_confirmation = id "upgrade-confirmation-input" + let upgrade_button_id, upgrade_button = id "upgrade-button" + end +end + +let check_email_js email = + let re = Regexp.regexp Learnocaml_data.email_regexp_js in + Learnocaml_data.email_check_length email + && match Regexp.string_match re email 0 with + | Some _ -> true + | None -> false + +let init_token_dialog () = + let open El.Login_overlay in + Manip.SetCss.display login_overlay "block"; + let got_token = match Lwt.task () with + |(_,got_tok) -> got_tok in + let create_token () = + let email = Manip.value upgrade_email and + password = Manip.value upgrade_password and + password_confirmation = Manip.value upgrade_confirmation in + let email_criteria = not (check_email_js email) and + passwd_crit1 = not (Learnocaml_data.passwd_check_length password) and + passwd_crit2 = not (Learnocaml_data.passwd_check_strength password) and + passwd_crit3 = not (password = password_confirmation) in + Manip.SetCss.borderColor upgrade_email ""; + Manip.SetCss.borderColor upgrade_password ""; + Manip.SetCss.borderColor upgrade_confirmation ""; + if email_criteria || passwd_crit1 || passwd_crit2 || passwd_crit3 then + begin + if email_criteria then + Manip.SetCss.borderColor upgrade_email "#f44"; + if passwd_crit1 || passwd_crit2 then + Manip.SetCss.borderColor upgrade_password "#f44"; + if passwd_crit3 then + Manip.SetCss.borderColor upgrade_confirmation "#f44"; + if email_criteria then begin + cb_alert ~title:[%i"ERROR"] + [%i"The entered e-mail was invalid."] + (fun () -> Manip.focus upgrade_email) + end + else if passwd_crit1 then begin + cb_alert ~title:[%i"ERROR"] + [%i"Password must be at least 8 characters long"] + (fun () -> Manip.focus upgrade_password) + end + else if passwd_crit2 then begin + cb_alert ~title:[%i"ERROR"] + [%i"Password must contain at least one digit, \ + one lower and upper letter, \ + and one non-alphanumeric char."] + (fun () -> Manip.focus upgrade_password) + end + else if passwd_crit3 then begin + cb_alert ~title:[%i"ERROR"] + [%i"The password and its confirmation are not the same"] + (fun () -> Manip.focus upgrade_confirmation) + end; + Lwt.return_none + end + else + let token = Learnocaml_data.Token.to_string (Learnocaml_local_storage.(retrieve sync_token)) in + retrieve (Learnocaml_api.Upgrade + ("email="^email^"&passwd="^password^"&token="^token)) + (*body exemple -> + email=&passwd=&confirmation=&csrf=Bfkxd/2TjpMAkq4bFGIs1hp9oxeBTZIKioMlQMUDlpk=&token=ZGB-GDD-SNB-41M*) + >>= fun _ -> cb_alert ~title:[%i"VALIDATION REQUIRED"] + [%i"A confirmation e-mail has been sent to your address."] + Js_utils.reload; + Lwt.return_none + in + let handler f t = fun _ -> + Lwt.async (fun () -> + f () >|= function + | Some token -> Lwt.wakeup got_token token + | None -> ()); + t + in + Manip.Ev.onclick upgrade_button (handler create_token false) let set_string_translations = List.iter @@ -28,6 +118,7 @@ let () = "txt_upgrade_password_confirmation", [%i"Confirm password"]; "txt_do_upgrade", [%i"Upgrade"]; "txt_info", [%i"An e-mail will be sent to your address to confirm it."]; - ] + ]; + init_token_dialog () with Not_found -> Learnocaml_common.alert ~title:[%i"NO TOKEN"] [%i"You are not logged in"] diff --git a/src/main/learnocaml_client.ml b/src/main/learnocaml_client.ml index b1183b438..c9c1331d1 100644 --- a/src/main/learnocaml_client.ml +++ b/src/main/learnocaml_client.ml @@ -1089,6 +1089,33 @@ module Exercise_list = struct Term.info ~man ~doc:doc "exercise-list" end +module Server_config = struct + let doc = "Get a structured json containing an information about the use_password compatibility" + + let server_config o = (*get_config_o ~allow_static:true o + >>= fun {ConfigFile.server;token} -> + fetch server (Learnocaml_api.Server_config) + >>= (fun index-> + let open Json_encoding in + let ezjsonm = (Json_encoding.construct + (tup2 Exercise.Index.enc (assoc float)) + index) + in + let json = + match ezjsonm with + | `O _ | `A _ as json -> json + | _ -> assert false + in + Ezjsonm.to_channel ~minify:false stdout json;*) + Lwt.return 0(**) + + let man = man doc + + let cmd = + use_global server_config, + Term.info ~man ~doc:doc "server-config" +end + module Main = struct let man = man @@ -1111,7 +1138,8 @@ let () = ; Print_server.cmd ; Template.cmd ; Create_token.cmd - ; Exercise_list.cmd] + ; Exercise_list.cmd + ; Server_config.cmd] with | exception Failure msg -> Printf.eprintf "[ERROR] %s\n" msg; diff --git a/src/server/learnocaml_server.ml b/src/server/learnocaml_server.ml index dff42fd83..17d3a0639 100644 --- a/src/server/learnocaml_server.ml +++ b/src/server/learnocaml_server.ml @@ -935,39 +935,27 @@ module Request_handler = struct let params = Uri.query_of_encoded body |> List.map (fun (a, b) -> a, String.concat "," b) in let token = Token.parse @@ List.assoc "token" params in - Token_index.UserIndex.emails_of_token !sync_dir token >>= - (function - | None -> - let make_cookie = Cohttp.Cookie.Set_cookie_hdr.make - ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in - let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and - email = List.assoc "email" params and - password = List.assoc "passwd" params and - confirmation = List.assoc "confirmation" params in - Token_index.UserIndex.exists !sync_dir email >>= fun exists -> - if exists then lwt_fail (`Forbidden, "E-mail already used") - else if not (Learnocaml_data.passwd_check_length password) - || not (Learnocaml_data.passwd_check_strength password) - || not (check_email_ml email) - || not (password = confirmation) then - lwt_ok @@ Redirect { code=`See_other; url="/upgrade"; cookies } - else - let cookies = make_cookie ("token", Token.to_string token) :: cookies in - Token_index.UserIndex.upgrade !sync_dir token email password >>= fun () -> - Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> - get_nickname token >>= fun nick -> - Learnocaml_sendmail.confirm_email - ~nick - ~url:(req.Api.host ^ "/confirm/" ^ handle) - email; - lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } - | Some _ -> lwt_fail (`Forbidden, "Already an account.")) - + let make_cookie = Cohttp.Cookie.Set_cookie_hdr.make + ~expiration:(`Max_age (Int64.of_int 60)) ~path:"/" in + let cookies = [make_cookie ~http_only:true ("csrf", "expired")] and + email = List.assoc "email" params and + password = List.assoc "passwd" params in + let cookies = make_cookie ("token", Token.to_string token) :: cookies in + Token_index.UserIndex.upgrade !sync_dir token email password >>= fun () -> + Token_index.UpgradeIndex.change_email !sync_dir token >>= fun handle -> + get_nickname token >>= fun nick -> + Learnocaml_sendmail.confirm_email + ~nick + ~url:(req.Api.host ^ "/confirm/" ^ handle) + email; + lwt_ok @@ Redirect { code=`See_other; url="/"; cookies } | Api.Upgrade_form _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") | Api.Upgrade _ -> lwt_fail (`Forbidden, "Users with passwords are disabled on this instance.") + | Api.Server_config _ -> + lwt_fail (`Forbidden, "pas encore fait") | Api.Invalid_request body -> lwt_fail (`Bad_request, body) diff --git a/src/state/learnocaml_api.ml b/src/state/learnocaml_api.ml index 54f30744d..0294a5a58 100644 --- a/src/state/learnocaml_api.ml +++ b/src/state/learnocaml_api.ml @@ -112,6 +112,8 @@ type _ request = string -> string request | Upgrade: string -> string request + | Server_config: + unit -> bool request | Invalid_request: string -> string request @@ -217,6 +219,8 @@ module Conversions (Json: JSON_CODEC) = struct | Upgrade_form _ -> str | Upgrade _ -> str + | Server_config () -> json J.bool + | Invalid_request _ -> str @@ -362,8 +366,11 @@ module Conversions (Json: JSON_CODEC) = struct | Upgrade_form _ -> assert false (* Reserved for a link *) - | Upgrade _ -> - assert false (* Reserved for a form *) + | Upgrade body -> + post ["do_upgrade"] body + + | Server_config () -> + get ["get_server_config"] | Invalid_request s -> failwith ("Error request "^s) @@ -547,7 +554,10 @@ module Server (Json: JSON_CODEC) (Rh: REQUEST_HANDLER) = struct | `POST body, ["upgrade"], _ -> Upgrade_form body |> k | `POST body, ["do_upgrade"], _ -> - Upgrade body |> k + Upgrade body |> k + + | `GET, ["get_server_config"], _ -> + Server_config () |> k | `GET, ["teacher"; "exercise-status.json"], Some token when Token.is_teacher token -> diff --git a/src/state/learnocaml_api.mli b/src/state/learnocaml_api.mli index 2a9723365..2374af3cc 100644 --- a/src/state/learnocaml_api.mli +++ b/src/state/learnocaml_api.mli @@ -126,6 +126,9 @@ type _ request = | Upgrade: string -> string request + | Server_config: + unit -> bool request + | Invalid_request: string -> string request (** Only for server-side handling: bound to requests not matching any case diff --git a/static/upgrade.html b/static/upgrade.html index 27a14c1ff..db3f3af7a 100644 --- a/static/upgrade.html +++ b/static/upgrade.html @@ -19,34 +19,32 @@
    -
    -
    -

    -
    -
    -
    -
    - -
    -
    -
    -
    - -
    -
    -
    -
    - -
    -
      -
      • -
      • -
    - - - -
    -
    +
    +

    +
    +
    +
    +
    + +
    +
    +
    +
    + +
    +
    +
    +
    + +
    +
      +
      • +
      • +
    + + + +
    From 18da15357a3578469df665c3a59c895d06d4db0b Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 9 Jun 2021 01:39:59 +0200 Subject: [PATCH 160/161] chore: Add deploy-oauth-moodle.yml to auto-build-and-push preprod images --- .github/workflows/deploy-oauth-moodle.yml | 49 +++++++++++++++++++++++ 1 file changed, 49 insertions(+) create mode 100644 .github/workflows/deploy-oauth-moodle.yml diff --git a/.github/workflows/deploy-oauth-moodle.yml b/.github/workflows/deploy-oauth-moodle.yml new file mode 100644 index 000000000..b94af8951 --- /dev/null +++ b/.github/workflows/deploy-oauth-moodle.yml @@ -0,0 +1,49 @@ +# Note: remove this file (squash-removing the underlying commit) before merging +name: Push oauth-moodle to DockerHub +on: + push: + branches: + - oauth-moodle + - oauth-moodle-dev +jobs: + push_server: + name: Push learn-ocaml image to Docker Hub + runs-on: ubuntu-latest + steps: + - name: Check out the repo + uses: actions/checkout@v2 + - name: Get branch name + run: branch="${{ github.ref }}"; echo "::set-output name=branch::${branch#refs/heads/}" + id: branch + - name: Push to Docker Hub + uses: docker/build-push-action@v1 + with: + always_pull: true + add_git_labels: true + labels: "org.opencontainers.image.version=${{ steps.branch.outputs.branch }}" + username: ${{ secrets.DOCKER_USERNAME }} + password: ${{ secrets.DOCKER_PASSWORD }} + # repository: ocamlsf/learn-ocaml + repository: pfitaxel/learn-ocaml + tags: ${{ steps.branch.outputs.branch }} + push_client: + name: Push learn-ocaml-client image to Docker Hub + runs-on: ubuntu-latest + steps: + - name: Check out the repo + uses: actions/checkout@v2 + - name: Get branch name + run: branch="${{ github.ref }}"; echo "::set-output name=branch::${branch#refs/heads/}" + id: branch + - name: Push to Docker Hub + uses: docker/build-push-action@v1 + with: + always_pull: true + add_git_labels: true + labels: "org.opencontainers.image.version=${{ steps.branch.outputs.branch }}" + username: ${{ secrets.DOCKER_USERNAME }} + password: ${{ secrets.DOCKER_PASSWORD }} + # repository: ocamlsf/learn-ocaml-client + repository: pfitaxel/learn-ocaml-client + target: client + tags: ${{ steps.branch.outputs.branch }} From ac11ad592684054bfa47dcd8bcb96778ded1d9b8 Mon Sep 17 00:00:00 2001 From: Erik Martin-Dorel Date: Wed, 9 Jun 2021 02:16:07 +0200 Subject: [PATCH 161/161] chore: Add push_emacs_client, a conditional deploy job --- .github/workflows/deploy-oauth-moodle.yml | 24 ++++ .../.dockerignore | 2 + ci/docker-emacs-learn-ocaml-client/.emacs | 105 ++++++++++++++++++ ci/docker-emacs-learn-ocaml-client/Dockerfile | 29 +++++ 4 files changed, 160 insertions(+) create mode 100644 ci/docker-emacs-learn-ocaml-client/.dockerignore create mode 100644 ci/docker-emacs-learn-ocaml-client/.emacs create mode 100644 ci/docker-emacs-learn-ocaml-client/Dockerfile diff --git a/.github/workflows/deploy-oauth-moodle.yml b/.github/workflows/deploy-oauth-moodle.yml index b94af8951..6e5979d9c 100644 --- a/.github/workflows/deploy-oauth-moodle.yml +++ b/.github/workflows/deploy-oauth-moodle.yml @@ -47,3 +47,27 @@ jobs: repository: pfitaxel/learn-ocaml-client target: client tags: ${{ steps.branch.outputs.branch }} + push_emacs_client: + name: Push emacs-learn-ocaml-client image to Docker Hub + needs: push_client + runs-on: ubuntu-latest + steps: + - name: Check out the repo + uses: actions/checkout@v2 + - name: Get branch name + run: branch="${{ github.ref }}"; echo "::set-output name=branch::${branch#refs/heads/}" + id: branch + - name: Push to Docker Hub + # https://github.com/docker/build-push-action/tree/releases/v1#readme + uses: docker/build-push-action@v1 + with: + path: ci/docker-emacs-learn-ocaml-client + build_args: "base=pfitaxel/learn-ocaml-client,version=${{ steps.branch.outputs.branch }}" + always_pull: true + add_git_labels: true + labels: "org.opencontainers.image.version=${{ steps.branch.outputs.branch }}" + username: ${{ secrets.DOCKER_USERNAME }} + password: ${{ secrets.DOCKER_PASSWORD }} + # repository: ocamlsf/learn-ocaml + repository: pfitaxel/emacs-learn-ocaml-client + tags: ${{ steps.branch.outputs.branch }} diff --git a/ci/docker-emacs-learn-ocaml-client/.dockerignore b/ci/docker-emacs-learn-ocaml-client/.dockerignore new file mode 100644 index 000000000..0caa6a8cd --- /dev/null +++ b/ci/docker-emacs-learn-ocaml-client/.dockerignore @@ -0,0 +1,2 @@ +* +!.emacs diff --git a/ci/docker-emacs-learn-ocaml-client/.emacs b/ci/docker-emacs-learn-ocaml-client/.emacs new file mode 100644 index 000000000..a94811e86 --- /dev/null +++ b/ci/docker-emacs-learn-ocaml-client/.emacs @@ -0,0 +1,105 @@ +;;; .emacs --- Emacs conf file -*- coding: utf-8 -*- + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Config de package.el, MELPA et use-package + +(require 'package) +(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t) +(package-initialize) + +(unless (package-installed-p 'use-package) + (package-refresh-contents) + (package-install 'use-package)) +(eval-when-compile + (require 'use-package)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Config de Tuareg, Merlin et Company + +(use-package tuareg + :ensure t + :defer t + :init + (setq tuareg-opam-insinuate t)) + +;; Merlin would require OPAM +; (use-package merlin +; :ensure t +; :hook +; ((tuareg-mode caml-mode) . merlin-mode) +; :config +; (setq merlin-command 'opam)) +; +; (use-package merlin-eldoc +; :ensure t +; :hook +; ((tuareg-mode caml-mode) . merlin-eldoc-setup) +; :bind (:map merlin-mode-map +; ("C-c " . merlin-eldoc-jump-to-prev-occurrence) +; ("C-c " . merlin-eldoc-jump-to-next-occurrence))) +; +; (use-package company +; :ensure t +; :hook +; ((tuareg-mode caml-mode) . company-mode) +; :config +; (bind-key "" 'company-complete)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Config de Magit + +; (use-package magit +; :ensure t +; :defer t +; :config +; (setq magit-diff-refine-hunk 'all) +; :bind (("C-x g" . magit-status) +; ("C-x M-g" . magit-dispatch-popup))) +; +; (use-package magit-gitflow +; :ensure t +; :after magit +; :config (add-hook 'magit-mode-hook 'turn-on-magit-gitflow)) +; +; ;; Protect against accident pushes to upstream +; (defadvice magit-push-current-to-upstream +; (around my-protect-accidental-magit-push-current-to-upstream) +; "Protect against accidental push to upstream. +; +; Causes `magit-git-push' to ask the user for confirmation first." +; (let ((my-magit-ask-before-push t)) +; ad-do-it)) +; +; (defadvice magit-git-push (around my-protect-accidental-magit-git-push) +; "Maybe ask the user for confirmation before pushing. +; +; Advice to `magit-push-current-to-upstream' triggers this query." +; (if (bound-and-true-p my-magit-ask-before-push) +; ;; Arglist is (BRANCH TARGET ARGS) +; (if (yes-or-no-p (format "Push %s branch upstream to %s? " +; (ad-get-arg 0) (ad-get-arg 1))) +; ad-do-it +; (error "Push to upstream aborted by user")) +; ad-do-it)) +; +; (ad-activate 'magit-push-current-to-upstream) +; (ad-activate 'magit-git-push) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Config générale + +(setq column-number-mode t + line-number-mode t + require-final-newline t) + +;; Marquage des parenthèses +(load-library "paren") +(show-paren-mode 1) + +;; Raccourcis C-c/C-x/C-v/C-z standards +;; au lieu de M-w/C-w/C-y/C-_ par défaut dans GNU Emacs +(cua-mode 1) diff --git a/ci/docker-emacs-learn-ocaml-client/Dockerfile b/ci/docker-emacs-learn-ocaml-client/Dockerfile new file mode 100644 index 000000000..8a6dcf441 --- /dev/null +++ b/ci/docker-emacs-learn-ocaml-client/Dockerfile @@ -0,0 +1,29 @@ +ARG base=ocamlsf/learn-ocaml-client +ARG version=master +FROM ${base}:${version} + +WORKDIR /home/learn-ocaml + +USER root + +RUN apk add --no-cache \ + curl \ + emacs-nox \ + && mkdir -p -v bin \ + && chown -v learn-ocaml:learn-ocaml bin + +ENV PATH /home/learn-ocaml/bin:${PATH} + +ENV LANG C.UTF-8 +# ENV LC_ALL C.UTF-8 +# ENV LANGUAGE en_US:en + +COPY --chown=learn-ocaml:learn-ocaml .emacs .emacs + +USER learn-ocaml + +# Do some automatic Emacs installation/byte-compilation: +RUN emacs --version && emacs --batch -l ${HOME}/.emacs + +ENTRYPOINT [] +CMD ["/bin/sh"]