Skip to content

Commit

Permalink
Offer better protections again solution overwriting
Browse files Browse the repository at this point in the history
Signed-off-by: Yann Regis-Gianas <yann@regis-gianas.org>
  • Loading branch information
yurug authored and erikmd committed Sep 16, 2021
1 parent f7bf420 commit 4bd1544
Show file tree
Hide file tree
Showing 12 changed files with 151 additions and 38 deletions.
30 changes: 27 additions & 3 deletions src/ace-lib/ace.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
(* This file is part of Learn-OCaml.
*
* Copyright (C) 2019 OCaml Software Foundation.
* 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
Expand All @@ -20,6 +20,8 @@ type 'a editor = {
editor: ('a editor * 'a option) Ace_types.editor Js.t;
mutable marks: int list;
mutable keybinding_menu: bool;
mutable synchronized : bool;
mutable sync_observers : (bool -> unit) list;
}

let ace : Ace_types.ace Js.t = Js.Unsafe.variable "ace"
Expand All @@ -30,10 +32,13 @@ let create_position r c =
pos##.row := r;
pos##.column := c;
pos

let greater_position p1 p2 =
p1##.row > p2##.row ||
(p1##.row = p2##.row && p1##.column > p2##.column)

let register_sync_observer editor obs =
editor.sync_observers <- obs :: editor.sync_observers

let create_range s e =
let range : range Js.t = Js.Unsafe.obj [||] in
Expand Down Expand Up @@ -71,15 +76,34 @@ let get_line {editor} line =
let document = (editor##getSession)##getDocument in
Js.to_string @@ document##(getLine line)

let create_editor editor_div =
let set_synchronized_status editor status =
List.iter (fun obs -> obs status) editor.sync_observers;
editor.synchronized <- status

let create_editor editor_div check_valid_state =
let editor = edit editor_div in
Js.Unsafe.set editor "$blockScrolling" (Js.Unsafe.variable "Infinity");
let data =
{ editor; editor_div; marks = []; keybinding_menu = false; } in
{ editor; editor_div;
marks = [];
keybinding_menu = false;
synchronized = true;
sync_observers = []
}
in
editor##.customData := (data, None);
editor##setOption (Js.string "displayIndentGuides") (Js.bool false);
editor##on (Js.string "change") (fun () ->
check_valid_state (set_contents data) ;
set_synchronized_status data false);
data

let set_synchronized editor =
set_synchronized_status editor true

let is_synchronized editor =
editor.synchronized

let get_custom_data { editor } =
match snd editor##.customData with
| None -> raise Not_found
Expand Down
8 changes: 7 additions & 1 deletion src/ace-lib/ace.mli
Original file line number Diff line number Diff line change
Expand Up @@ -17,7 +17,13 @@ type loc = {
loc_end: int * int;
}

val create_editor: Dom_html.divElement Js.t -> 'a editor
val create_editor: Dom_html.divElement Js.t -> ((string -> unit) -> unit) -> 'a editor

val is_synchronized : 'a editor -> bool

val set_synchronized : 'a editor -> unit

val register_sync_observer : 'a editor -> (bool -> unit) -> unit

val set_mode: 'a editor -> string -> unit

Expand Down
4 changes: 2 additions & 2 deletions src/ace-lib/ocaml_mode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -506,8 +506,8 @@ let do_delete ace_editor =
Ace.remove ace_editor "left"
end

let create_ocaml_editor div =
let ace = Ace.create_editor div in
let create_ocaml_editor div check_valid_state =
let ace = Ace.create_editor div check_valid_state in
Ace.set_mode ace "ace/mode/ocaml.ocp";
Ace.set_tab_size ace !config.indent.IndentConfig.i_base;
let editor = { ace; current_error = None; current_warnings = [] } in
Expand Down
2 changes: 1 addition & 1 deletion src/ace-lib/ocaml_mode.mli
Original file line number Diff line number Diff line change
Expand Up @@ -25,7 +25,7 @@ type warning = {
msg: string;
}

val create_ocaml_editor: Dom_html.divElement Js.t -> editor
val create_ocaml_editor: Dom_html.divElement Js.t -> ((string -> unit) -> unit) -> editor
val get_editor: editor -> editor Ace.editor

val report_error: editor -> ?set_class: bool -> error option -> warning list -> unit Lwt.t
Expand Down
80 changes: 66 additions & 14 deletions src/app/learnocaml_common.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
(* This file is part of Learn-OCaml.
*
* Copyright (C) 2019 OCaml Software Foundation.
* 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
Expand Down Expand Up @@ -432,30 +432,34 @@ let get_state_as_save_file ?(include_reports = false) () =
all_exercise_toplevel_histories = retrieve all_exercise_toplevel_histories;
}

let rec sync_save token save_file =
let rec sync_save token save_file on_sync =
Server_caller.request (Learnocaml_api.Update_save (token, save_file))
>>= function
| Ok save -> set_state_from_save_file ~token save; Lwt.return save
| Ok save ->
set_state_from_save_file ~token save;
on_sync ();
Lwt.return save
| Error (`Not_found _) ->
Server_caller.request_exn
(Learnocaml_api.Create_token ("", Some token, None)) >>= fun _token ->
assert (_token = token);
Server_caller.request_exn
(Learnocaml_api.Update_save (token, save_file)) >>= fun save ->
set_state_from_save_file ~token save;
on_sync ();
Lwt.return save
| Error e ->
lwt_alert ~title:[%i"SYNC FAILED"] [
H.p [H.txt [%i"Could not synchronise save with the server"]];
H.code [H.txt (Server_caller.string_of_error e)];
] ~buttons:[
[%i"Retry"], (fun () -> sync_save token save_file);
[%i"Ignore"], (fun () -> Lwt.return save_file);
[%i"Retry"], (fun () -> sync_save token save_file on_sync);
[%i"Ignore"], (fun () -> Lwt.return save_file);
]

let sync token = sync_save token (get_state_as_save_file ())
let sync token on_sync = sync_save token (get_state_as_save_file ()) on_sync

let sync_exercise token ?answer ?editor id =
let sync_exercise token ?answer ?editor id on_sync =
let handle_serverless () =
(* save the text at least locally (but not the report & grade, that could
be misleading) *)
Expand Down Expand Up @@ -492,7 +496,7 @@ let sync_exercise token ?answer ?editor id =
} in
match token with
| Some token ->
Lwt.catch (fun () -> sync_save token save_file)
Lwt.catch (fun () -> sync_save token save_file on_sync)
(fun e ->
handle_serverless ();
raise e)
Expand Down Expand Up @@ -706,11 +710,48 @@ let mouseover_toggle_signal elt sigvalue setter =
in
Manip.Ev.onmouseover elt hdl
(*
If a user has made no change to a solution for the exercise [id]
for 180 seconds, [check_valid_editor_state id] ensures that there is
no more recent version of this solution in the server. If this is
the case, the user is asked if we should download this solution
from the server.
This function reduces the risk of an involuntary overwriting of a
student solution when the solution is open in several clients.
*)
let check_valid_editor_state id =
let last_changed = ref (Unix.gettimeofday ()) in
fun update_content ->
let update_local_copy checking_time () =
match Learnocaml_local_storage.(retrieve (exercise_state id)) with
| { Answer.mtime; solution; _ } ->
if mtime > checking_time then (
if Js_utils.confirm
[%i "A more recent answer exists on the server. \
Do you want to update the current one?"]
then
update_content solution;
);
Lwt.return ()
| exception Not_found -> Lwt.return ()
in
let now = Unix.gettimeofday () in
if now -. !last_changed > 180. then (
let checking_time = !last_changed in
last_changed := now;
Lwt.async (update_local_copy checking_time)
)
let ace_display tab =
let ace = lazy (
let answer =
Ocaml_mode.create_ocaml_editor
(Tyxml_js.To_dom.of_div tab)
ignore
in
let ace = Ocaml_mode.get_editor answer in
Ace.set_font_size ace 16;
Expand Down Expand Up @@ -872,7 +913,8 @@ end
module Editor_button (E : Editor_info) = struct
let editor_button = button ~container:E.buttons_container ~theme:"light"
let editor_button =
button ~container:E.buttons_container ~theme:"light"
let cleanup template =
editor_button
Expand All @@ -898,16 +940,26 @@ module Editor_button (E : Editor_info) = struct
select_tab "toplevel";
Lwt.return_unit
let sync token id =
editor_button
let sync token id on_sync =
let state = button_state () in
(editor_button
~state
~icon: "sync" [%i"Sync"] @@ fun () ->
token >>= fun token ->
sync_exercise token id ~editor:(Ace.get_contents E.ace) >|= fun _save -> ()
sync_exercise token id ~editor:(Ace.get_contents E.ace) on_sync
>|= fun _save -> ());
Ace.register_sync_observer E.ace (fun sync ->
if sync then disable_button state else enable_button state)
end
let setup_editor solution =
let setup_editor id solution =
let editor_pane = find_component "learnocaml-exo-editor-pane" in
let editor = Ocaml_mode.create_ocaml_editor (Tyxml_js.To_dom.of_div editor_pane) in
let editor =
Ocaml_mode.create_ocaml_editor
(Tyxml_js.To_dom.of_div editor_pane)
(check_valid_editor_state id)
in
let ace = Ocaml_mode.get_editor editor in
Ace.set_contents ace ~reset_undo:true solution;
Ace.set_font_size ace 18;
Expand Down
19 changes: 12 additions & 7 deletions src/app/learnocaml_common.mli
Original file line number Diff line number Diff line change
Expand Up @@ -118,18 +118,23 @@ val set_state_from_save_file :
(** Gets a save file containing the locally stored data *)
val get_state_as_save_file : ?include_reports:bool -> unit -> Save.t

(** Sync the local save state with the server state, and returns the merged save
file. The save will be created on the server if it doesn't exist.
(**
[sync token on_sync] synchronizes the local save state with the server state,
and returns the merged save file. The save will be created on the server
if it doesn't exist. [on_sync ()] is called when this is done.
This syncs student {b,content}, but never the reports which are only synched
on "Grade" *)
val sync: Token.t -> Save.t Lwt.t
Notice that this function synchronizes student {b,content} but not the
reports which are only synchronized when an actual "grading" is done.
*)
val sync: Token.t -> (unit -> unit) -> Save.t Lwt.t

(** The same, but limiting the submission to the given exercise, using the given
answer if any, and the given editor text, if any. *)
val sync_exercise:
Token.t option -> ?answer:Learnocaml_data.Answer.t -> ?editor:string ->
Learnocaml_data.Exercise.id ->
(unit -> unit) ->
Save.t Lwt.t

val countdown:
Expand Down Expand Up @@ -210,10 +215,10 @@ module Editor_button (E : Editor_info) : sig
val cleanup : string -> unit
val download : string -> unit
val eval : Learnocaml_toplevel.t -> (string -> 'a) -> unit
val sync : Token.t option Lwt.t -> Learnocaml_data.SMap.key -> unit
val sync : Token.t option Lwt.t -> Learnocaml_data.SMap.key -> (unit -> unit) -> unit
end

val setup_editor : string -> Ocaml_mode.editor * Ocaml_mode.editor Ace.editor
val setup_editor : string -> string -> Ocaml_mode.editor * Ocaml_mode.editor Ace.editor

val typecheck :
Learnocaml_toplevel.t ->
Expand Down
11 changes: 6 additions & 5 deletions src/app/learnocaml_exercise_main.ml
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
(* This file is part of Learn-OCaml.
*
* Copyright (C) 2019 OCaml Software Foundation.
* 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
Expand Down Expand Up @@ -177,10 +177,10 @@ let () =
Tyxml_js.Html5.[ h1 [ txt ex_meta.Exercise.Meta.title ] ;
Tyxml_js.Of_dom.of_iFrame text_iframe ] ;
(* ---- editor pane --------------------------------------------------- *)
let editor, ace = setup_editor solution in
let editor, ace = setup_editor id solution in
let module EB = Editor_button (struct let ace = ace let buttons_container = editor_toolbar end) in
EB.cleanup (Learnocaml_exercise.(access File.template exo));
EB.sync token id;
EB.sync token id (fun () -> Ace.set_synchronized ace) ;
EB.download id;
EB.eval top select_tab;
let typecheck = typecheck top ace editor in
Expand Down Expand Up @@ -264,7 +264,8 @@ let () =
Some solution, None
in
token >>= fun token ->
sync_exercise token id ?answer ?editor >>= fun _save ->
sync_exercise token id ?answer ?editor (fun () -> Ace.set_synchronized ace)
>>= fun _save ->
select_tab "report" ;
Lwt_js.yield () >>= fun () ->
Ace.focus ace ;
Expand All @@ -283,7 +284,7 @@ let () =
Ace.focus ace ;
typecheck true
end ;
Window.onunload (fun _ev -> local_save ace id; true);
Window.onbeforeunload (fun _ -> (not (Ace.is_synchronized ace), false));
(* ---- return -------------------------------------------------------- *)
toplevel_launch >>= fun _ ->
typecheck false >>= fun () ->
Expand Down
2 changes: 1 addition & 1 deletion src/app/learnocaml_index_main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -811,7 +811,7 @@ let () =
Lwt.return_unit);
[%i"Sync workspace"], "sync", (fun () ->
catch_with_alert @@ fun () ->
sync () >>= fun _ -> Lwt.return_unit);
sync () ignore >>= fun _ -> Lwt.return_unit);
[%i"Export to file"], "download", download_save;
[%i"Import"], "upload", import_save;
[%i"Download all source files"], "download", download_all;
Expand Down
10 changes: 7 additions & 3 deletions src/app/learnocaml_playground_main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -26,8 +26,12 @@ let main () =
disable_button_group toplevel_buttons_group (* enabled after init *) ;
let toplevel_toolbar = find_component "learnocaml-exo-toplevel-toolbar" in
let editor_toolbar = find_component "learnocaml-exo-editor-toolbar" in
let toplevel_button =
button ~container: toplevel_toolbar ~theme: "dark" ~group:toplevel_buttons_group ?state:None in
let toplevel_button ~icon label cb =
ignore @@
button
~icon ~container: toplevel_toolbar
~theme: "dark" ~group:toplevel_buttons_group ?state:None label cb
in
let id = match Url.Current.path with
| "" :: "playground" :: p | "playground" :: p ->
String.concat "/" (List.map Url.urldecode (List.filter ((<>) "") p))
Expand Down Expand Up @@ -59,7 +63,7 @@ let main () =
(* ---- toplevel pane ------------------------------------------------- *)
init_toplevel_pane toplevel_launch top toplevel_buttons_group toplevel_button ;
(* ---- editor pane --------------------------------------------------- *)
let editor, ace = setup_editor solution in
let editor, ace = setup_editor id solution in
let module EB = Editor_button (struct let ace = ace let buttons_container = editor_toolbar end) in
EB.cleanup playground.Playground.template;
EB.download id;
Expand Down
10 changes: 10 additions & 0 deletions src/utils/js_utils.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1143,6 +1143,16 @@ module Window = struct
let head win = Tyxml_js.Of_dom.of_head win##.document##.head
let onunload ?(win = Dom_html.window) f =
win##.onunload := Dom_html.handler (fun ev -> Js.bool (f ev))
let onbeforeunload ?(win = Dom_html.window) f =
win##.onbeforeunload := Dom_html.handler (fun ev ->
let (status, propagate) = f ev in
if status then (
Js.bool propagate
) else
(
Js.(Unsafe.eval_string "undefined");
)
)
let onresize ?(win = Dom_html.window) f =
win##.onresize := Dom_html.handler (fun ev -> Js.bool (f ev))
let prompt ?(win = Dom_html.window) ?(value = "") msg =
Expand Down
3 changes: 3 additions & 0 deletions src/utils/js_utils.mli
Original file line number Diff line number Diff line change
Expand Up @@ -381,6 +381,9 @@ module Window : sig
val onunload:
?win:Dom_html.window Js.t ->
(Dom_html.event Js.t -> bool) -> unit
val onbeforeunload:
?win:Dom_html.window Js.t ->
(Dom_html.event Js.t -> bool * bool) -> unit
val onhashchange:
?win:Dom_html.window Js.t ->
(Dom_html.hashChangeEvent Js.t -> bool) -> unit
Expand Down
Loading

0 comments on commit 4bd1544

Please sign in to comment.